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