git-guion commit git-gui: Pluralize timestamps within the options menu. (2bc5b34)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10######################################################################
  11##
  12## task management
  13
  14set single_commit 0
  15set status_active 0
  16set diff_active 0
  17set checkin_active 0
  18set commit_active 0
  19set update_index_fd {}
  20
  21set disable_on_lock [list]
  22set index_lock_type none
  23
  24set HEAD {}
  25set PARENT {}
  26set commit_type {}
  27
  28proc lock_index {type} {
  29        global index_lock_type disable_on_lock
  30
  31        if {$index_lock_type == {none}} {
  32                set index_lock_type $type
  33                foreach w $disable_on_lock {
  34                        uplevel #0 $w disabled
  35                }
  36                return 1
  37        } elseif {$index_lock_type == {begin-update} && $type == {update}} {
  38                set index_lock_type $type
  39                return 1
  40        }
  41        return 0
  42}
  43
  44proc unlock_index {} {
  45        global index_lock_type disable_on_lock
  46
  47        set index_lock_type none
  48        foreach w $disable_on_lock {
  49                uplevel #0 $w normal
  50        }
  51}
  52
  53######################################################################
  54##
  55## status
  56
  57proc repository_state {hdvar ctvar} {
  58        global gitdir
  59        upvar $hdvar hd $ctvar ct
  60
  61        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
  62                set ct initial
  63        } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
  64                set ct merge
  65        } else {
  66                set ct normal
  67        }
  68}
  69
  70proc update_status {{final Ready.}} {
  71        global HEAD PARENT commit_type
  72        global ui_index ui_other ui_status_value ui_comm
  73        global status_active file_states
  74        global cfg_trust_mtime
  75
  76        if {$status_active || ![lock_index read]} return
  77
  78        repository_state new_HEAD new_type
  79        if {$commit_type == {amend} 
  80                && $new_type == {normal}
  81                && $new_HEAD == $HEAD} {
  82        } else {
  83                set HEAD $new_HEAD
  84                set PARENT $new_HEAD
  85                set commit_type $new_type
  86        }
  87
  88        array unset file_states
  89        foreach w [list $ui_index $ui_other] {
  90                $w conf -state normal
  91                $w delete 0.0 end
  92                $w conf -state disabled
  93        }
  94
  95        if {![$ui_comm edit modified]
  96                || [string trim [$ui_comm get 0.0 end]] == {}} {
  97                if {[load_message GITGUI_MSG]} {
  98                } elseif {[load_message MERGE_MSG]} {
  99                } elseif {[load_message SQUASH_MSG]} {
 100                }
 101                $ui_comm edit modified false
 102        }
 103
 104        if {$cfg_trust_mtime == {true}} {
 105                update_status_stage2 {} $final
 106        } else {
 107                set status_active 1
 108                set ui_status_value {Refreshing file status...}
 109                set fd_rf [open "| git update-index -q --unmerged --refresh" r]
 110                fconfigure $fd_rf -blocking 0 -translation binary
 111                fileevent $fd_rf readable [list update_status_stage2 $fd_rf $final]
 112        }
 113}
 114
 115proc update_status_stage2 {fd final} {
 116        global gitdir PARENT commit_type
 117        global ui_index ui_other ui_status_value ui_comm
 118        global status_active file_states
 119        global buf_rdi buf_rdf buf_rlo
 120
 121        if {$fd != {}} {
 122                read $fd
 123                if {![eof $fd]} return
 124                close $fd
 125        }
 126
 127        set ls_others [list | git ls-files --others -z \
 128                --exclude-per-directory=.gitignore]
 129        set info_exclude [file join $gitdir info exclude]
 130        if {[file readable $info_exclude]} {
 131                lappend ls_others "--exclude-from=$info_exclude"
 132        }
 133
 134        set buf_rdi {}
 135        set buf_rdf {}
 136        set buf_rlo {}
 137
 138        set status_active 3
 139        set ui_status_value {Scanning for modified files ...}
 140        set fd_di [open "| git diff-index --cached -z $PARENT" r]
 141        set fd_df [open "| git diff-files -z" r]
 142        set fd_lo [open $ls_others r]
 143
 144        fconfigure $fd_di -blocking 0 -translation binary
 145        fconfigure $fd_df -blocking 0 -translation binary
 146        fconfigure $fd_lo -blocking 0 -translation binary
 147        fileevent $fd_di readable [list read_diff_index $fd_di $final]
 148        fileevent $fd_df readable [list read_diff_files $fd_df $final]
 149        fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
 150}
 151
 152proc load_message {file} {
 153        global gitdir ui_comm
 154
 155        set f [file join $gitdir $file]
 156        if {[file isfile $f]} {
 157                if {[catch {set fd [open $f r]}]} {
 158                        return 0
 159                }
 160                set content [string trim [read $fd]]
 161                close $fd
 162                $ui_comm delete 0.0 end
 163                $ui_comm insert end $content
 164                return 1
 165        }
 166        return 0
 167}
 168
 169proc read_diff_index {fd final} {
 170        global buf_rdi
 171
 172        append buf_rdi [read $fd]
 173        set c 0
 174        set n [string length $buf_rdi]
 175        while {$c < $n} {
 176                set z1 [string first "\0" $buf_rdi $c]
 177                if {$z1 == -1} break
 178                incr z1
 179                set z2 [string first "\0" $buf_rdi $z1]
 180                if {$z2 == -1} break
 181
 182                set c $z2
 183                incr z2 -1
 184                display_file \
 185                        [string range $buf_rdi $z1 $z2] \
 186                        [string index $buf_rdi [expr $z1 - 2]]_
 187                incr c
 188        }
 189        if {$c < $n} {
 190                set buf_rdi [string range $buf_rdi $c end]
 191        } else {
 192                set buf_rdi {}
 193        }
 194
 195        status_eof $fd buf_rdi $final
 196}
 197
 198proc read_diff_files {fd final} {
 199        global buf_rdf
 200
 201        append buf_rdf [read $fd]
 202        set c 0
 203        set n [string length $buf_rdf]
 204        while {$c < $n} {
 205                set z1 [string first "\0" $buf_rdf $c]
 206                if {$z1 == -1} break
 207                incr z1
 208                set z2 [string first "\0" $buf_rdf $z1]
 209                if {$z2 == -1} break
 210
 211                set c $z2
 212                incr z2 -1
 213                display_file \
 214                        [string range $buf_rdf $z1 $z2] \
 215                        _[string index $buf_rdf [expr $z1 - 2]]
 216                incr c
 217        }
 218        if {$c < $n} {
 219                set buf_rdf [string range $buf_rdf $c end]
 220        } else {
 221                set buf_rdf {}
 222        }
 223
 224        status_eof $fd buf_rdf $final
 225}
 226
 227proc read_ls_others {fd final} {
 228        global buf_rlo
 229
 230        append buf_rlo [read $fd]
 231        set pck [split $buf_rlo "\0"]
 232        set buf_rlo [lindex $pck end]
 233        foreach p [lrange $pck 0 end-1] {
 234                display_file $p _O
 235        }
 236        status_eof $fd buf_rlo $final
 237}
 238
 239proc status_eof {fd buf final} {
 240        global status_active $buf
 241        global ui_fname_value ui_status_value file_states
 242
 243        if {[eof $fd]} {
 244                set $buf {}
 245                close $fd
 246
 247                if {[incr status_active -1] == 0} {
 248                        unlock_index
 249
 250                        display_all_files
 251                        set ui_status_value $final
 252
 253                        if {$ui_fname_value != {} && [array names file_states \
 254                                -exact $ui_fname_value] != {}}  {
 255                                show_diff $ui_fname_value
 256                        } else {
 257                                clear_diff
 258                        }
 259                }
 260        }
 261}
 262
 263######################################################################
 264##
 265## diff
 266
 267proc clear_diff {} {
 268        global ui_diff ui_fname_value ui_fstatus_value
 269
 270        $ui_diff conf -state normal
 271        $ui_diff delete 0.0 end
 272        $ui_diff conf -state disabled
 273        set ui_fname_value {}
 274        set ui_fstatus_value {}
 275}
 276
 277proc show_diff {path} {
 278        global file_states PARENT diff_3way diff_active
 279        global ui_diff ui_fname_value ui_fstatus_value ui_status_value
 280
 281        if {$diff_active || ![lock_index read]} return
 282
 283        clear_diff
 284        set s $file_states($path)
 285        set m [lindex $s 0]
 286        set diff_3way 0
 287        set diff_active 1
 288        set ui_fname_value $path
 289        set ui_fstatus_value [mapdesc $m $path]
 290        set ui_status_value "Loading diff of $path..."
 291
 292        set cmd [list | git diff-index -p $PARENT -- $path]
 293        switch $m {
 294        AM {
 295        }
 296        MM {
 297                set cmd [list | git diff-index -p -c $PARENT $path]
 298        }
 299        _O {
 300                if {[catch {
 301                                set fd [open $path r]
 302                                set content [read $fd]
 303                                close $fd
 304                        } err ]} {
 305                        set diff_active 0
 306                        unlock_index
 307                        set ui_status_value "Unable to display $path"
 308                        error_popup "Error loading file:\n$err"
 309                        return
 310                }
 311                $ui_diff conf -state normal
 312                $ui_diff insert end $content
 313                $ui_diff conf -state disabled
 314                set diff_active 0
 315                unlock_index
 316                set ui_status_value {Ready.}
 317                return
 318        }
 319        }
 320
 321        if {[catch {set fd [open $cmd r]} err]} {
 322                set diff_active 0
 323                unlock_index
 324                set ui_status_value "Unable to display $path"
 325                error_popup "Error loading diff:\n$err"
 326                return
 327        }
 328
 329        fconfigure $fd -blocking 0 -translation auto
 330        fileevent $fd readable [list read_diff $fd]
 331}
 332
 333proc read_diff {fd} {
 334        global ui_diff ui_status_value diff_3way diff_active
 335
 336        while {[gets $fd line] >= 0} {
 337                if {[string match {diff --git *} $line]} continue
 338                if {[string match {diff --combined *} $line]} continue
 339                if {[string match {--- *} $line]} continue
 340                if {[string match {+++ *} $line]} continue
 341                if {[string match index* $line]} {
 342                        if {[string first , $line] >= 0} {
 343                                set diff_3way 1
 344                        }
 345                }
 346
 347                $ui_diff conf -state normal
 348                if {!$diff_3way} {
 349                        set x [string index $line 0]
 350                        switch -- $x {
 351                        "@" {set tags da}
 352                        "+" {set tags dp}
 353                        "-" {set tags dm}
 354                        default {set tags {}}
 355                        }
 356                } else {
 357                        set x [string range $line 0 1]
 358                        switch -- $x {
 359                        default {set tags {}}
 360                        "@@" {set tags da}
 361                        "++" {set tags dp; set x " +"}
 362                        " +" {set tags {di bold}; set x "++"}
 363                        "+ " {set tags dni; set x "-+"}
 364                        "--" {set tags dm; set x " -"}
 365                        " -" {set tags {dm bold}; set x "--"}
 366                        "- " {set tags di; set x "+-"}
 367                        default {set tags {}}
 368                        }
 369                        set line [string replace $line 0 1 $x]
 370                }
 371                $ui_diff insert end $line $tags
 372                $ui_diff insert end "\n"
 373                $ui_diff conf -state disabled
 374        }
 375
 376        if {[eof $fd]} {
 377                close $fd
 378                set diff_active 0
 379                unlock_index
 380                set ui_status_value {Ready.}
 381        }
 382}
 383
 384######################################################################
 385##
 386## commit
 387
 388proc load_last_commit {} {
 389        global HEAD PARENT commit_type ui_comm
 390
 391        if {$commit_type == {amend}} return
 392        if {$commit_type != {normal}} {
 393                error_popup "Can't amend a $commit_type commit."
 394                return
 395        }
 396
 397        set msg {}
 398        set parent {}
 399        set parent_count 0
 400        if {[catch {
 401                        set fd [open "| git cat-file commit $HEAD" r]
 402                        while {[gets $fd line] > 0} {
 403                                if {[string match {parent *} $line]} {
 404                                        set parent [string range $line 7 end]
 405                                        incr parent_count
 406                                }
 407                        }
 408                        set msg [string trim [read $fd]]
 409                        close $fd
 410                } err]} {
 411                error_popup "Error loading commit data for amend:\n$err"
 412                return
 413        }
 414
 415        if {$parent_count == 0} {
 416                set commit_type amend
 417                set HEAD {}
 418                set PARENT {}
 419                update_status
 420        } elseif {$parent_count == 1} {
 421                set commit_type amend
 422                set PARENT $parent
 423                $ui_comm delete 0.0 end
 424                $ui_comm insert end $msg
 425                $ui_comm edit modified false
 426                update_status
 427        } else {
 428                error_popup {You can't amend a merge commit.}
 429                return
 430        }
 431}
 432
 433proc commit_tree {} {
 434        global tcl_platform HEAD gitdir commit_type file_states
 435        global commit_active ui_status_value
 436        global ui_comm
 437
 438        if {$commit_active || ![lock_index update]} return
 439
 440        # -- Our in memory state should match the repository.
 441        #
 442        repository_state curHEAD cur_type
 443        if {$commit_type == {amend} 
 444                && $cur_type == {normal}
 445                && $curHEAD == $HEAD} {
 446        } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
 447                error_popup {Last scanned state does not match repository state.
 448
 449Its highly likely that another Git program modified the
 450repository since our last scan.  A rescan is required
 451before committing.
 452}
 453                unlock_index
 454                update_status
 455                return
 456        }
 457
 458        # -- At least one file should differ in the index.
 459        #
 460        set files_ready 0
 461        foreach path [array names file_states] {
 462                set s $file_states($path)
 463                switch -glob -- [lindex $s 0] {
 464                _* {continue}
 465                A* -
 466                D* -
 467                M* {set files_ready 1; break}
 468                U* {
 469                        error_popup "Unmerged files cannot be committed.
 470
 471File $path has merge conflicts.
 472You must resolve them and check the file in before committing.
 473"
 474                        unlock_index
 475                        return
 476                }
 477                default {
 478                        error_popup "Unknown file state [lindex $s 0] detected.
 479
 480File $path cannot be committed by this program.
 481"
 482                }
 483                }
 484        }
 485        if {!$files_ready} {
 486                error_popup {No checked-in files to commit.
 487
 488You must check-in at least 1 file before you can commit.
 489}
 490                unlock_index
 491                return
 492        }
 493
 494        # -- A message is required.
 495        #
 496        set msg [string trim [$ui_comm get 1.0 end]]
 497        if {$msg == {}} {
 498                error_popup {Please supply a commit message.
 499
 500A good commit message has the following format:
 501
 502- First line: Describe in one sentance what you did.
 503- Second line: Blank
 504- Remaining lines: Describe why this change is good.
 505}
 506                unlock_index
 507                return
 508        }
 509
 510        # -- Ask the pre-commit hook for the go-ahead.
 511        #
 512        set pchook [file join $gitdir hooks pre-commit]
 513        if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
 514                set pchook [list sh -c \
 515                        "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
 516        } elseif {[file executable $pchook]} {
 517                set pchook [list $pchook]
 518        } else {
 519                set pchook {}
 520        }
 521        if {$pchook != {} && [catch {eval exec $pchook} err]} {
 522                hook_failed_popup pre-commit $err
 523                unlock_index
 524                return
 525        }
 526
 527        # -- Write the tree in the background.
 528        #
 529        set commit_active 1
 530        set ui_status_value {Committing changes...}
 531
 532        set fd_wt [open "| git write-tree" r]
 533        fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
 534}
 535
 536proc commit_stage2 {fd_wt curHEAD msg} {
 537        global single_commit gitdir PARENT commit_type
 538        global commit_active ui_status_value ui_comm
 539
 540        gets $fd_wt tree_id
 541        close $fd_wt
 542
 543        if {$tree_id == {}} {
 544                error_popup "write-tree failed"
 545                set commit_active 0
 546                set ui_status_value {Commit failed.}
 547                unlock_index
 548                return
 549        }
 550
 551        # -- Create the commit.
 552        #
 553        set cmd [list git commit-tree $tree_id]
 554        if {$PARENT != {}} {
 555                lappend cmd -p $PARENT
 556        }
 557        if {$commit_type == {merge}} {
 558                if {[catch {
 559                                set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 560                                while {[gets $fd_mh merge_head] >= 0} {
 561                                        lappend cmd -p $merge_head
 562                                }
 563                                close $fd_mh
 564                        } err]} {
 565                        error_popup "Loading MERGE_HEADs failed:\n$err"
 566                        set commit_active 0
 567                        set ui_status_value {Commit failed.}
 568                        unlock_index
 569                        return
 570                }
 571        }
 572        if {$PARENT == {}} {
 573                # git commit-tree writes to stderr during initial commit.
 574                lappend cmd 2>/dev/null
 575        }
 576        lappend cmd << $msg
 577        if {[catch {set cmt_id [eval exec $cmd]} err]} {
 578                error_popup "commit-tree failed:\n$err"
 579                set commit_active 0
 580                set ui_status_value {Commit failed.}
 581                unlock_index
 582                return
 583        }
 584
 585        # -- Update the HEAD ref.
 586        #
 587        set reflogm commit
 588        if {$commit_type != {normal}} {
 589                append reflogm " ($commit_type)"
 590        }
 591        set i [string first "\n" $msg]
 592        if {$i >= 0} {
 593                append reflogm {: } [string range $msg 0 [expr $i - 1]]
 594        } else {
 595                append reflogm {: } $msg
 596        }
 597        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 598        if {[catch {eval exec $cmd} err]} {
 599                error_popup "update-ref failed:\n$err"
 600                set commit_active 0
 601                set ui_status_value {Commit failed.}
 602                unlock_index
 603                return
 604        }
 605
 606        # -- Cleanup after ourselves.
 607        #
 608        catch {file delete [file join $gitdir MERGE_HEAD]}
 609        catch {file delete [file join $gitdir MERGE_MSG]}
 610        catch {file delete [file join $gitdir SQUASH_MSG]}
 611        catch {file delete [file join $gitdir GITGUI_MSG]}
 612
 613        # -- Let rerere do its thing.
 614        #
 615        if {[file isdirectory [file join $gitdir rr-cache]]} {
 616                catch {exec git rerere}
 617        }
 618
 619        $ui_comm delete 0.0 end
 620        $ui_comm edit modified false
 621
 622        if {$single_commit} do_quit
 623
 624        set commit_type {}
 625        set commit_active 0
 626        set HEAD $cmt_id
 627        set PARENT $cmt_id
 628        unlock_index
 629        update_status "Changes committed as $cmt_id."
 630}
 631
 632######################################################################
 633##
 634## fetch pull push
 635
 636proc fetch_from {remote} {
 637        set w [new_console "fetch $remote" \
 638                "Fetching new changes from $remote"]
 639        set cmd [list git fetch]
 640        lappend cmd $remote
 641        console_exec $w $cmd
 642}
 643
 644proc pull_remote {remote branch} {
 645        if {![lock_index update]} return
 646        set w [new_console "pull $remote $branch" \
 647                "Pulling new changes from branch $branch in $remote"]
 648        set cmd [list git pull]
 649        lappend cmd $remote
 650        lappend cmd $branch
 651        console_exec $w $cmd [list post_pull_remote $remote $branch]
 652}
 653
 654proc post_pull_remote {remote branch success} {
 655        unlock_index
 656        if {$success} {
 657                update_status "Successfully pulled $branch from $remote."
 658        } else {
 659                update_status "Conflicts detected while pulling $branch from $remote."
 660        }
 661}
 662
 663proc push_to {remote} {
 664        set w [new_console "push $remote" \
 665                "Pushing changes to $remote"]
 666        set cmd [list git push]
 667        lappend cmd $remote
 668        console_exec $w $cmd
 669}
 670
 671######################################################################
 672##
 673## ui helpers
 674
 675proc mapcol {state path} {
 676        global all_cols ui_other
 677
 678        if {[catch {set r $all_cols($state)}]} {
 679                puts "error: no column for state={$state} $path"
 680                return $ui_other
 681        }
 682        return $r
 683}
 684
 685proc mapicon {state path} {
 686        global all_icons
 687
 688        if {[catch {set r $all_icons($state)}]} {
 689                puts "error: no icon for state={$state} $path"
 690                return file_plain
 691        }
 692        return $r
 693}
 694
 695proc mapdesc {state path} {
 696        global all_descs
 697
 698        if {[catch {set r $all_descs($state)}]} {
 699                puts "error: no desc for state={$state} $path"
 700                return $state
 701        }
 702        return $r
 703}
 704
 705proc bsearch {w path} {
 706        set hi [expr [lindex [split [$w index end] .] 0] - 2]
 707        if {$hi == 0} {
 708                return -1
 709        }
 710        set lo 0
 711        while {$lo < $hi} {
 712                set mi [expr [expr $lo + $hi] / 2]
 713                set ti [expr $mi + 1]
 714                set cmp [string compare [$w get $ti.1 $ti.end] $path]
 715                if {$cmp < 0} {
 716                        set lo $ti
 717                } elseif {$cmp == 0} {
 718                        return $mi
 719                } else {
 720                        set hi $mi
 721                }
 722        }
 723        return -[expr $lo + 1]
 724}
 725
 726set next_icon_id 0
 727
 728proc merge_state {path new_state} {
 729        global file_states next_icon_id
 730
 731        set s0 [string index $new_state 0]
 732        set s1 [string index $new_state 1]
 733
 734        if {[catch {set info $file_states($path)}]} {
 735                set state __
 736                set icon n[incr next_icon_id]
 737        } else {
 738                set state [lindex $info 0]
 739                set icon [lindex $info 1]
 740        }
 741
 742        if {$s0 == {_}} {
 743                set s0 [string index $state 0]
 744        } elseif {$s0 == {*}} {
 745                set s0 _
 746        }
 747
 748        if {$s1 == {_}} {
 749                set s1 [string index $state 1]
 750        } elseif {$s1 == {*}} {
 751                set s1 _
 752        }
 753
 754        set file_states($path) [list $s0$s1 $icon]
 755        return $state
 756}
 757
 758proc display_file {path state} {
 759        global ui_index ui_other file_states status_active
 760
 761        set old_m [merge_state $path $state]
 762        if {$status_active} return
 763
 764        set s $file_states($path)
 765        set new_m [lindex $s 0]
 766        set new_w [mapcol $new_m $path] 
 767        set old_w [mapcol $old_m $path]
 768        set new_icon [mapicon $new_m $path]
 769
 770        if {$new_w != $old_w} {
 771                set lno [bsearch $old_w $path]
 772                if {$lno >= 0} {
 773                        incr lno
 774                        $old_w conf -state normal
 775                        $old_w delete $lno.0 [expr $lno + 1].0
 776                        $old_w conf -state disabled
 777                }
 778
 779                set lno [expr abs([bsearch $new_w $path] + 1) + 1]
 780                $new_w conf -state normal
 781                $new_w image create $lno.0 \
 782                        -align center -padx 5 -pady 1 \
 783                        -name [lindex $s 1] \
 784                        -image [mapicon $m $path]
 785                $new_w insert $lno.1 "$path\n"
 786                $new_w conf -state disabled
 787        } elseif {$new_icon != [mapicon $old_m $path]} {
 788                $new_w conf -state normal
 789                $new_w image conf [lindex $s 1] -image $new_icon
 790                $new_w conf -state disabled
 791        }
 792}
 793
 794proc display_all_files {} {
 795        global ui_index ui_other file_states
 796
 797        $ui_index conf -state normal
 798        $ui_other conf -state normal
 799
 800        foreach path [lsort [array names file_states]] {
 801                set s $file_states($path)
 802                set m [lindex $s 0]
 803                set w [mapcol $m $path]
 804                $w image create end \
 805                        -align center -padx 5 -pady 1 \
 806                        -name [lindex $s 1] \
 807                        -image [mapicon $m $path]
 808                $w insert end "$path\n"
 809        }
 810
 811        $ui_index conf -state disabled
 812        $ui_other conf -state disabled
 813}
 814
 815proc with_update_index {body} {
 816        global update_index_fd
 817
 818        if {$update_index_fd == {}} {
 819                if {![lock_index update]} return
 820                set update_index_fd [open \
 821                        "| git update-index --add --remove -z --stdin" \
 822                        w]
 823                fconfigure $update_index_fd -translation binary
 824                uplevel 1 $body
 825                close $update_index_fd
 826                set update_index_fd {}
 827                unlock_index
 828        } else {
 829                uplevel 1 $body
 830        }
 831}
 832
 833proc update_index {path} {
 834        global update_index_fd
 835
 836        if {$update_index_fd == {}} {
 837                error {not in with_update_index}
 838        } else {
 839                puts -nonewline $update_index_fd "$path\0"
 840        }
 841}
 842
 843proc toggle_mode {path} {
 844        global file_states ui_fname_value
 845
 846        set s $file_states($path)
 847        set m [lindex $s 0]
 848
 849        switch -- $m {
 850        AM -
 851        _O {set new A*}
 852        _M -
 853        MM {set new M*}
 854        AD -
 855        _D {set new D*}
 856        default {return}
 857        }
 858
 859        with_update_index {update_index $path}
 860        display_file $path $new
 861        if {$ui_fname_value == $path} {
 862                show_diff $path
 863        }
 864}
 865
 866######################################################################
 867##
 868## config (fetch push pull)
 869
 870proc load_repo_config {} {
 871        global repo_config
 872        global cfg_trust_mtime
 873
 874        array unset repo_config
 875        catch {
 876                set fd_rc [open "| git repo-config --list" r]
 877                while {[gets $fd_rc line] >= 0} {
 878                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 879                                lappend repo_config($name) $value
 880                        }
 881                }
 882                close $fd_rc
 883        }
 884
 885        if {[catch {set cfg_trust_mtime $repo_config(gui.trustmtime)}]} {
 886                set cfg_trust_mtime false
 887        }
 888}
 889
 890proc save_my_config {} {
 891        global repo_config
 892        global cfg_trust_mtime
 893
 894        if {[catch {set rc_trustMTime $repo_config(gui.trustmtime)}]} {
 895                set rc_trustMTime false
 896        }
 897        if {$cfg_trust_mtime != $rc_trustMTime} {
 898                exec git repo-config gui.trustMTime $cfg_trust_mtime
 899        }
 900}
 901
 902proc load_all_remotes {} {
 903        global gitdir all_remotes repo_config
 904
 905        set all_remotes [list]
 906        set rm_dir [file join $gitdir remotes]
 907        if {[file isdirectory $rm_dir]} {
 908                set all_remotes [concat $all_remotes [glob \
 909                        -types f \
 910                        -tails \
 911                        -nocomplain \
 912                        -directory $rm_dir *]]
 913        }
 914
 915        foreach line [array names repo_config remote.*.url] {
 916                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
 917                        lappend all_remotes $name
 918                }
 919        }
 920
 921        set all_remotes [lsort -unique $all_remotes]
 922}
 923
 924proc populate_remote_menu {m pfx op} {
 925        global all_remotes mainfont
 926
 927        foreach remote $all_remotes {
 928                $m add command -label "$pfx $remote..." \
 929                        -command [list $op $remote] \
 930                        -font $mainfont
 931        }
 932}
 933
 934proc populate_pull_menu {m} {
 935        global gitdir repo_config all_remotes mainfont
 936
 937        foreach remote $all_remotes {
 938                set rb {}
 939                if {[array get repo_config remote.$remote.url] != {}} {
 940                        if {[array get repo_config remote.$remote.fetch] != {}} {
 941                                regexp {^([^:]+):} \
 942                                        [lindex $repo_config(remote.$remote.fetch) 0] \
 943                                        line rb
 944                        }
 945                } else {
 946                        catch {
 947                                set fd [open [file join $gitdir remotes $remote] r]
 948                                while {[gets $fd line] >= 0} {
 949                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
 950                                                break
 951                                        }
 952                                }
 953                                close $fd
 954                        }
 955                }
 956
 957                set rb_short $rb
 958                regsub ^refs/heads/ $rb {} rb_short
 959                if {$rb_short != {}} {
 960                        $m add command \
 961                                -label "Branch $rb_short from $remote..." \
 962                                -command [list pull_remote $remote $rb] \
 963                                -font $mainfont
 964                }
 965        }
 966}
 967
 968######################################################################
 969##
 970## icons
 971
 972set filemask {
 973#define mask_width 14
 974#define mask_height 15
 975static unsigned char mask_bits[] = {
 976   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 977   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 978   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
 979}
 980
 981image create bitmap file_plain -background white -foreground black -data {
 982#define plain_width 14
 983#define plain_height 15
 984static unsigned char plain_bits[] = {
 985   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
 986   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
 987   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 988} -maskdata $filemask
 989
 990image create bitmap file_mod -background white -foreground blue -data {
 991#define mod_width 14
 992#define mod_height 15
 993static unsigned char mod_bits[] = {
 994   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
 995   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
 996   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
 997} -maskdata $filemask
 998
 999image create bitmap file_fulltick -background white -foreground "#007000" -data {
1000#define file_fulltick_width 14
1001#define file_fulltick_height 15
1002static unsigned char file_fulltick_bits[] = {
1003   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1004   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1005   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1006} -maskdata $filemask
1007
1008image create bitmap file_parttick -background white -foreground "#005050" -data {
1009#define parttick_width 14
1010#define parttick_height 15
1011static unsigned char parttick_bits[] = {
1012   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1013   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1014   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1015} -maskdata $filemask
1016
1017image create bitmap file_question -background white -foreground black -data {
1018#define file_question_width 14
1019#define file_question_height 15
1020static unsigned char file_question_bits[] = {
1021   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1022   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1023   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1024} -maskdata $filemask
1025
1026image create bitmap file_removed -background white -foreground red -data {
1027#define file_removed_width 14
1028#define file_removed_height 15
1029static unsigned char file_removed_bits[] = {
1030   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1031   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1032   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1033} -maskdata $filemask
1034
1035image create bitmap file_merge -background white -foreground blue -data {
1036#define file_merge_width 14
1037#define file_merge_height 15
1038static unsigned char file_merge_bits[] = {
1039   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1040   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1041   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1042} -maskdata $filemask
1043
1044set ui_index .vpane.files.index.list
1045set ui_other .vpane.files.other.list
1046set max_status_desc 0
1047foreach i {
1048                {__ i plain    "Unmodified"}
1049                {_M i mod      "Modified"}
1050                {M_ i fulltick "Checked in"}
1051                {MM i parttick "Partially checked in"}
1052
1053                {_O o plain    "Untracked"}
1054                {A_ o fulltick "Added"}
1055                {AM o parttick "Partially added"}
1056                {AD o question "Added (but now gone)"}
1057
1058                {_D i question "Missing"}
1059                {D_ i removed  "Removed"}
1060                {DD i removed  "Removed"}
1061                {DO i removed  "Removed (still exists)"}
1062
1063                {UM i merge    "Merge conflicts"}
1064                {U_ i merge    "Merge conflicts"}
1065        } {
1066        if {$max_status_desc < [string length [lindex $i 3]]} {
1067                set max_status_desc [string length [lindex $i 3]]
1068        }
1069        if {[lindex $i 1] == {i}} {
1070                set all_cols([lindex $i 0]) $ui_index
1071        } else {
1072                set all_cols([lindex $i 0]) $ui_other
1073        }
1074        set all_icons([lindex $i 0]) file_[lindex $i 2]
1075        set all_descs([lindex $i 0]) [lindex $i 3]
1076}
1077unset filemask i
1078
1079######################################################################
1080##
1081## util
1082
1083proc error_popup {msg} {
1084        set w .error
1085        toplevel $w
1086        wm transient $w .
1087        show_msg $w $w $msg
1088}
1089
1090proc show_msg {w top msg} {
1091        global gitdir appname mainfont
1092
1093        message $w.m -text $msg -justify left -aspect 400
1094        pack $w.m -side top -fill x -padx 5 -pady 10
1095        button $w.ok -text OK \
1096                -width 15 \
1097                -font $mainfont \
1098                -command "destroy $top"
1099        pack $w.ok -side bottom
1100        bind $top <Visibility> "grab $top; focus $top"
1101        bind $top <Key-Return> "destroy $top"
1102        wm title $w "$appname ([lindex [file split \
1103                [file normalize [file dirname $gitdir]]] \
1104                end]): error"
1105        tkwait window $top
1106}
1107
1108proc hook_failed_popup {hook msg} {
1109        global gitdir mainfont difffont appname
1110
1111        set w .hookfail
1112        toplevel $w
1113        wm transient $w .
1114
1115        frame $w.m
1116        label $w.m.l1 -text "$hook hook failed:" \
1117                -anchor w \
1118                -justify left \
1119                -font [concat $mainfont bold]
1120        text $w.m.t \
1121                -background white -borderwidth 1 \
1122                -relief sunken \
1123                -width 80 -height 10 \
1124                -font $difffont \
1125                -yscrollcommand [list $w.m.sby set]
1126        label $w.m.l2 \
1127                -text {You must correct the above errors before committing.} \
1128                -anchor w \
1129                -justify left \
1130                -font [concat $mainfont bold]
1131        scrollbar $w.m.sby -command [list $w.m.t yview]
1132        pack $w.m.l1 -side top -fill x
1133        pack $w.m.l2 -side bottom -fill x
1134        pack $w.m.sby -side right -fill y
1135        pack $w.m.t -side left -fill both -expand 1
1136        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1137
1138        $w.m.t insert 1.0 $msg
1139        $w.m.t conf -state disabled
1140
1141        button $w.ok -text OK \
1142                -width 15 \
1143                -font $mainfont \
1144                -command "destroy $w"
1145        pack $w.ok -side bottom
1146
1147        bind $w <Visibility> "grab $w; focus $w"
1148        bind $w <Key-Return> "destroy $w"
1149        wm title $w "$appname ([lindex [file split \
1150                [file normalize [file dirname $gitdir]]] \
1151                end]): error"
1152        tkwait window $w
1153}
1154
1155set next_console_id 0
1156
1157proc new_console {short_title long_title} {
1158        global next_console_id console_data
1159        set w .console[incr next_console_id]
1160        set console_data($w) [list $short_title $long_title]
1161        return [console_init $w]
1162}
1163
1164proc console_init {w} {
1165        global console_cr console_data
1166        global gitdir appname mainfont difffont
1167
1168        set console_cr($w) 1.0
1169        toplevel $w
1170        frame $w.m
1171        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1172                -anchor w \
1173                -justify left \
1174                -font [concat $mainfont bold]
1175        text $w.m.t \
1176                -background white -borderwidth 1 \
1177                -relief sunken \
1178                -width 80 -height 10 \
1179                -font $difffont \
1180                -state disabled \
1181                -yscrollcommand [list $w.m.sby set]
1182        label $w.m.s -anchor w \
1183                -justify left \
1184                -font [concat $mainfont bold]
1185        scrollbar $w.m.sby -command [list $w.m.t yview]
1186        pack $w.m.l1 -side top -fill x
1187        pack $w.m.s -side bottom -fill x
1188        pack $w.m.sby -side right -fill y
1189        pack $w.m.t -side left -fill both -expand 1
1190        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1191
1192        button $w.ok -text {Running...} \
1193                -width 15 \
1194                -font $mainfont \
1195                -state disabled \
1196                -command "destroy $w"
1197        pack $w.ok -side bottom
1198
1199        bind $w <Visibility> "focus $w"
1200        wm title $w "$appname ([lindex [file split \
1201                [file normalize [file dirname $gitdir]]] \
1202                end]): [lindex $console_data($w) 0]"
1203        return $w
1204}
1205
1206proc console_exec {w cmd {after {}}} {
1207        global tcl_platform
1208
1209        # -- Windows tosses the enviroment when we exec our child.
1210        #    But most users need that so we have to relogin. :-(
1211        #
1212        if {$tcl_platform(platform) == {windows}} {
1213                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1214        }
1215
1216        # -- Tcl won't let us redirect both stdout and stderr to
1217        #    the same pipe.  So pass it through cat...
1218        #
1219        set cmd [concat | $cmd |& cat]
1220
1221        set fd_f [open $cmd r]
1222        fconfigure $fd_f -blocking 0 -translation binary
1223        fileevent $fd_f readable [list console_read $w $fd_f $after]
1224}
1225
1226proc console_read {w fd after} {
1227        global console_cr console_data
1228
1229        set buf [read $fd]
1230        if {$buf != {}} {
1231                if {![winfo exists $w]} {console_init $w}
1232                $w.m.t conf -state normal
1233                set c 0
1234                set n [string length $buf]
1235                while {$c < $n} {
1236                        set cr [string first "\r" $buf $c]
1237                        set lf [string first "\n" $buf $c]
1238                        if {$cr < 0} {set cr [expr $n + 1]}
1239                        if {$lf < 0} {set lf [expr $n + 1]}
1240
1241                        if {$lf < $cr} {
1242                                $w.m.t insert end [string range $buf $c $lf]
1243                                set console_cr($w) [$w.m.t index {end -1c}]
1244                                set c $lf
1245                                incr c
1246                        } else {
1247                                $w.m.t delete $console_cr($w) end
1248                                $w.m.t insert end "\n"
1249                                $w.m.t insert end [string range $buf $c $cr]
1250                                set c $cr
1251                                incr c
1252                        }
1253                }
1254                $w.m.t conf -state disabled
1255                $w.m.t see end
1256        }
1257
1258        fconfigure $fd -blocking 1
1259        if {[eof $fd]} {
1260                if {[catch {close $fd}]} {
1261                        if {![winfo exists $w]} {console_init $w}
1262                        $w.m.s conf -background red -text {Error: Command Failed}
1263                        $w.ok conf -text Close
1264                        $w.ok conf -state normal
1265                        set ok 0
1266                } elseif {[winfo exists $w]} {
1267                        $w.m.s conf -background green -text {Success}
1268                        $w.ok conf -text Close
1269                        $w.ok conf -state normal
1270                        set ok 1
1271                }
1272                array unset console_cr $w
1273                array unset console_data $w
1274                if {$after != {}} {
1275                        uplevel #0 $after $ok
1276                }
1277                return
1278        }
1279        fconfigure $fd -blocking 0
1280}
1281
1282######################################################################
1283##
1284## ui commands
1285
1286set starting_gitk_msg {Please wait... Starting gitk...}
1287
1288proc do_gitk {} {
1289        global tcl_platform ui_status_value starting_gitk_msg
1290
1291        set ui_status_value $starting_gitk_msg
1292        after 10000 {
1293                if {$ui_status_value == $starting_gitk_msg} {
1294                        set ui_status_value {Ready.}
1295                }
1296        }
1297
1298        if {$tcl_platform(platform) == {windows}} {
1299                exec sh -c gitk &
1300        } else {
1301                exec gitk &
1302        }
1303}
1304
1305proc do_repack {} {
1306        set w [new_console "repack" "Repacking the object database"]
1307        set cmd [list git repack]
1308        lappend cmd -a
1309        lappend cmd -d
1310        console_exec $w $cmd
1311}
1312
1313proc do_quit {} {
1314        global gitdir ui_comm
1315
1316        set save [file join $gitdir GITGUI_MSG]
1317        set msg [string trim [$ui_comm get 0.0 end]]
1318        if {[$ui_comm edit modified] && $msg != {}} {
1319                catch {
1320                        set fd [open $save w]
1321                        puts $fd [string trim [$ui_comm get 0.0 end]]
1322                        close $fd
1323                }
1324        } elseif {$msg == {} && [file exists $save]} {
1325                file delete $save
1326        }
1327
1328        save_my_config
1329        destroy .
1330}
1331
1332proc do_rescan {} {
1333        update_status
1334}
1335
1336proc do_checkin_all {} {
1337        global checkin_active ui_status_value
1338
1339        if {$checkin_active || ![lock_index begin-update]} return
1340
1341        set checkin_active 1
1342        set ui_status_value {Checking in all files...}
1343        after 1 {
1344                with_update_index {
1345                        foreach path [array names file_states] {
1346                                set s $file_states($path)
1347                                set m [lindex $s 0]
1348                                switch -- $m {
1349                                AM -
1350                                MM -
1351                                _M -
1352                                _D {toggle_mode $path}
1353                                }
1354                        }
1355                }
1356                set checkin_active 0
1357                set ui_status_value {Ready.}
1358        }
1359}
1360
1361proc do_signoff {} {
1362        global ui_comm
1363
1364        catch {
1365                set me [exec git var GIT_COMMITTER_IDENT]
1366                if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1367                        set str "Signed-off-by: $name"
1368                        if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1369                                $ui_comm insert end "\n"
1370                                $ui_comm insert end $str
1371                                $ui_comm see end
1372                        }
1373                }
1374        }
1375}
1376
1377proc do_amend_last {} {
1378        load_last_commit
1379}
1380
1381proc do_commit {} {
1382        commit_tree
1383}
1384
1385# shift == 1: left click
1386#          3: right click  
1387proc click {w x y shift wx wy} {
1388        global ui_index ui_other
1389
1390        set pos [split [$w index @$x,$y] .]
1391        set lno [lindex $pos 0]
1392        set col [lindex $pos 1]
1393        set path [$w get $lno.1 $lno.end]
1394        if {$path == {}} return
1395
1396        if {$col > 0 && $shift == 1} {
1397                $ui_index tag remove in_diff 0.0 end
1398                $ui_other tag remove in_diff 0.0 end
1399                $w tag add in_diff $lno.0 [expr $lno + 1].0
1400                show_diff $path
1401        }
1402}
1403
1404proc unclick {w x y} {
1405        set pos [split [$w index @$x,$y] .]
1406        set lno [lindex $pos 0]
1407        set col [lindex $pos 1]
1408        set path [$w get $lno.1 $lno.end]
1409        if {$path == {}} return
1410
1411        if {$col == 0} {
1412                toggle_mode $path
1413        }
1414}
1415
1416######################################################################
1417##
1418## ui init
1419
1420set mainfont {Helvetica 10}
1421set difffont {Courier 10}
1422set maincursor [. cget -cursor]
1423
1424switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1425windows,*   {set M1B Control; set M1T Ctrl}
1426unix,Darwin {set M1B M1; set M1T Cmd}
1427default     {set M1B M1; set M1T M1}
1428}
1429
1430# -- Menu Bar
1431menu .mbar -tearoff 0
1432.mbar add cascade -label Project -menu .mbar.project
1433.mbar add cascade -label Commit -menu .mbar.commit
1434.mbar add cascade -label Fetch -menu .mbar.fetch
1435.mbar add cascade -label Pull -menu .mbar.pull
1436.mbar add cascade -label Push -menu .mbar.push
1437.mbar add cascade -label Options -menu .mbar.options
1438. configure -menu .mbar
1439
1440# -- Project Menu
1441menu .mbar.project
1442.mbar.project add command -label Visualize \
1443        -command do_gitk \
1444        -font $mainfont
1445.mbar.project add command -label {Repack Database} \
1446        -command do_repack \
1447        -font $mainfont
1448.mbar.project add command -label Quit \
1449        -command do_quit \
1450        -accelerator $M1T-Q \
1451        -font $mainfont
1452
1453# -- Commit Menu
1454menu .mbar.commit
1455.mbar.commit add command -label Rescan \
1456        -command do_rescan \
1457        -accelerator F5 \
1458        -font $mainfont
1459lappend disable_on_lock \
1460        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1461.mbar.commit add command -label {Amend Last Commit} \
1462        -command do_amend_last \
1463        -font $mainfont
1464lappend disable_on_lock \
1465        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1466.mbar.commit add command -label {Check-in All Files} \
1467        -command do_checkin_all \
1468        -accelerator $M1T-U \
1469        -font $mainfont
1470lappend disable_on_lock \
1471        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1472.mbar.commit add command -label {Sign Off} \
1473        -command do_signoff \
1474        -accelerator $M1T-S \
1475        -font $mainfont
1476.mbar.commit add command -label Commit \
1477        -command do_commit \
1478        -accelerator $M1T-Return \
1479        -font $mainfont
1480lappend disable_on_lock \
1481        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1482
1483# -- Fetch Menu
1484menu .mbar.fetch
1485
1486# -- Pull Menu
1487menu .mbar.pull
1488
1489# -- Push Menu
1490menu .mbar.push
1491
1492# -- Options Menu
1493menu .mbar.options
1494.mbar.options add checkbutton -label {Trust File Modification Timestamps} \
1495        -offvalue false \
1496        -onvalue true \
1497        -variable cfg_trust_mtime
1498
1499# -- Main Window Layout
1500panedwindow .vpane -orient vertical
1501panedwindow .vpane.files -orient horizontal
1502.vpane add .vpane.files -sticky nsew -height 100 -width 400
1503pack .vpane -anchor n -side top -fill both -expand 1
1504
1505# -- Index File List
1506frame .vpane.files.index -height 100 -width 400
1507label .vpane.files.index.title -text {Modified Files} \
1508        -background green \
1509        -font $mainfont
1510text $ui_index -background white -borderwidth 0 \
1511        -width 40 -height 10 \
1512        -font $mainfont \
1513        -yscrollcommand {.vpane.files.index.sb set} \
1514        -cursor $maincursor \
1515        -state disabled
1516scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1517pack .vpane.files.index.title -side top -fill x
1518pack .vpane.files.index.sb -side right -fill y
1519pack $ui_index -side left -fill both -expand 1
1520.vpane.files add .vpane.files.index -sticky nsew
1521
1522# -- Other (Add) File List
1523frame .vpane.files.other -height 100 -width 100
1524label .vpane.files.other.title -text {Untracked Files} \
1525        -background red \
1526        -font $mainfont
1527text $ui_other -background white -borderwidth 0 \
1528        -width 40 -height 10 \
1529        -font $mainfont \
1530        -yscrollcommand {.vpane.files.other.sb set} \
1531        -cursor $maincursor \
1532        -state disabled
1533scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1534pack .vpane.files.other.title -side top -fill x
1535pack .vpane.files.other.sb -side right -fill y
1536pack $ui_other -side left -fill both -expand 1
1537.vpane.files add .vpane.files.other -sticky nsew
1538
1539$ui_index tag conf in_diff -font [concat $mainfont bold]
1540$ui_other tag conf in_diff -font [concat $mainfont bold]
1541
1542# -- Diff and Commit Area
1543frame .vpane.lower -height 400 -width 400
1544frame .vpane.lower.commarea
1545frame .vpane.lower.diff -relief sunken -borderwidth 1
1546pack .vpane.lower.commarea -side top -fill x
1547pack .vpane.lower.diff -side bottom -fill both -expand 1
1548.vpane add .vpane.lower -stick nsew
1549
1550# -- Commit Area Buttons
1551frame .vpane.lower.commarea.buttons
1552label .vpane.lower.commarea.buttons.l -text {} \
1553        -anchor w \
1554        -justify left \
1555        -font $mainfont
1556pack .vpane.lower.commarea.buttons.l -side top -fill x
1557pack .vpane.lower.commarea.buttons -side left -fill y
1558
1559button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1560        -command do_rescan \
1561        -font $mainfont
1562pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1563lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1564
1565button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1566        -command do_amend_last \
1567        -font $mainfont
1568pack .vpane.lower.commarea.buttons.amend -side top -fill x
1569lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1570
1571button .vpane.lower.commarea.buttons.ciall -text {Check-in All} \
1572        -command do_checkin_all \
1573        -font $mainfont
1574pack .vpane.lower.commarea.buttons.ciall -side top -fill x
1575lappend disable_on_lock {.vpane.lower.commarea.buttons.ciall conf -state}
1576
1577button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1578        -command do_signoff \
1579        -font $mainfont
1580pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1581
1582button .vpane.lower.commarea.buttons.commit -text {Commit} \
1583        -command do_commit \
1584        -font $mainfont
1585pack .vpane.lower.commarea.buttons.commit -side top -fill x
1586lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1587
1588# -- Commit Message Buffer
1589frame .vpane.lower.commarea.buffer
1590set ui_comm .vpane.lower.commarea.buffer.t
1591set ui_coml .vpane.lower.commarea.buffer.l
1592label $ui_coml -text {Commit Message:} \
1593        -anchor w \
1594        -justify left \
1595        -font $mainfont
1596trace add variable commit_type write {uplevel #0 {
1597        switch -glob $commit_type \
1598        initial {$ui_coml conf -text {Initial Commit Message:}} \
1599        amend   {$ui_coml conf -text {Amended Commit Message:}} \
1600        merge   {$ui_coml conf -text {Merge Commit Message:}} \
1601        *       {$ui_coml conf -text {Commit Message:}}
1602}}
1603text $ui_comm -background white -borderwidth 1 \
1604        -relief sunken \
1605        -width 75 -height 9 -wrap none \
1606        -font $difffont \
1607        -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1608        -cursor $maincursor
1609scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1610pack $ui_coml -side top -fill x
1611pack .vpane.lower.commarea.buffer.sby -side right -fill y
1612pack $ui_comm -side left -fill y
1613pack .vpane.lower.commarea.buffer -side left -fill y
1614
1615# -- Diff Header
1616set ui_fname_value {}
1617set ui_fstatus_value {}
1618frame .vpane.lower.diff.header -background orange
1619label .vpane.lower.diff.header.l1 -text {File:} \
1620        -background orange \
1621        -font $mainfont
1622label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1623        -background orange \
1624        -anchor w \
1625        -justify left \
1626        -font $mainfont
1627label .vpane.lower.diff.header.l3 -text {Status:} \
1628        -background orange \
1629        -font $mainfont
1630label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1631        -background orange \
1632        -width $max_status_desc \
1633        -anchor w \
1634        -justify left \
1635        -font $mainfont
1636pack .vpane.lower.diff.header.l1 -side left
1637pack .vpane.lower.diff.header.l2 -side left -fill x
1638pack .vpane.lower.diff.header.l4 -side right
1639pack .vpane.lower.diff.header.l3 -side right
1640
1641# -- Diff Body
1642frame .vpane.lower.diff.body
1643set ui_diff .vpane.lower.diff.body.t
1644text $ui_diff -background white -borderwidth 0 \
1645        -width 80 -height 15 -wrap none \
1646        -font $difffont \
1647        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1648        -yscrollcommand {.vpane.lower.diff.body.sby set} \
1649        -cursor $maincursor \
1650        -state disabled
1651scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1652        -command [list $ui_diff xview]
1653scrollbar .vpane.lower.diff.body.sby -orient vertical \
1654        -command [list $ui_diff yview]
1655pack .vpane.lower.diff.body.sbx -side bottom -fill x
1656pack .vpane.lower.diff.body.sby -side right -fill y
1657pack $ui_diff -side left -fill both -expand 1
1658pack .vpane.lower.diff.header -side top -fill x
1659pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1660
1661$ui_diff tag conf dm -foreground red
1662$ui_diff tag conf dp -foreground blue
1663$ui_diff tag conf da -font [concat $difffont bold]
1664$ui_diff tag conf di -foreground "#00a000"
1665$ui_diff tag conf dni -foreground "#a000a0"
1666$ui_diff tag conf bold -font [concat $difffont bold]
1667
1668# -- Status Bar
1669set ui_status_value {Initializing...}
1670label .status -textvariable ui_status_value \
1671        -anchor w \
1672        -justify left \
1673        -borderwidth 1 \
1674        -relief sunken \
1675        -font $mainfont
1676pack .status -anchor w -side bottom -fill x
1677
1678# -- Key Bindings
1679bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1680bind .   <Destroy> do_quit
1681bind all <Key-F5> do_rescan
1682bind all <$M1B-Key-r> do_rescan
1683bind all <$M1B-Key-R> do_rescan
1684bind .   <$M1B-Key-s> do_signoff
1685bind .   <$M1B-Key-S> do_signoff
1686bind .   <$M1B-Key-u> do_checkin_all
1687bind .   <$M1B-Key-U> do_checkin_all
1688bind .   <$M1B-Key-Return> do_commit
1689bind all <$M1B-Key-q> do_quit
1690bind all <$M1B-Key-Q> do_quit
1691bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1692bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1693foreach i [list $ui_index $ui_other] {
1694        bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1695        bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1696        bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1697}
1698unset i M1B M1T
1699
1700######################################################################
1701##
1702## main
1703
1704set appname [lindex [file split $argv0] end]
1705set gitdir {}
1706
1707if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
1708        show_msg {} . "Cannot find the git directory: $err"
1709        exit 1
1710}
1711if {$cdup != ""} {
1712        cd $cdup
1713}
1714unset cdup
1715
1716if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1717        show_msg {} . "Cannot find the git directory: $err"
1718        exit 1
1719}
1720
1721if {$appname == {git-citool}} {
1722        set single_commit 1
1723}
1724
1725wm title . "$appname ([file normalize [file dirname $gitdir]])"
1726focus -force $ui_comm
1727load_repo_config
1728load_all_remotes
1729populate_remote_menu .mbar.fetch From fetch_from
1730populate_remote_menu .mbar.push To push_to
1731populate_pull_menu .mbar.pull
1732update_status