git-gui

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec 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
  14 set single_commit 0
  15 set status_active 0
  16 set diff_active 0
  17 set checkin_active 0
  18 set commit_active 0
  19 set update_index_fd {}
  20
  21 set disable_on_lock [list]
  22 set index_lock_type none
  23
  24 set HEAD {}
  25 set PARENT {}
  26 set commit_type {}
  27
  28 proc 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
  44 proc 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
  57 proc 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
  70 proc 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
 115 proc 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
 152 proc 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
 169 proc 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
 198 proc 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
 227 proc 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
 239 proc 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
 267 proc 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
 277 proc 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
 333 proc 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
 388 proc 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
 433 proc 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
 449 Its highly likely that another Git program modified the
 450 repository since our last scan.  A rescan is required
 451 before 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
 471 File $path has merge conflicts.
 472 You 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
 480 File $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
 488 You 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
 500 A 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
 536 proc 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
 636 proc 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
 644 proc pull_remote {remote branch} {
 645         set w [new_console "pull $remote $branch" \
 646                 "Pulling new changes from branch $branch in $remote"]
 647         set cmd [list git pull]
 648         lappend cmd $remote
 649         lappend cmd $branch
 650         console_exec $w $cmd [list post_pull_remote $remote $branch]
 651 }
 652
 653 proc post_pull_remote {remote branch success} {
 654         if {$success} {
 655                 update_status "Successfully pulled $branch from $remote."
 656         } else {
 657                 update_status "Conflicts detected while pulling $branch from $remote."
 658         }
 659 }
 660
 661 proc push_to {remote} {
 662         set w [new_console "push $remote" \
 663                 "Pushing changes to $remote"]
 664         set cmd [list git push]
 665         lappend cmd $remote
 666         console_exec $w $cmd
 667 }
 668
 669 ######################################################################
 670 ##
 671 ## ui helpers
 672
 673 proc mapcol {state path} {
 674         global all_cols ui_other
 675
 676         if {[catch {set r $all_cols($state)}]} {
 677                 puts "error: no column for state={$state} $path"
 678                 return $ui_other
 679         }
 680         return $r
 681 }
 682
 683 proc mapicon {state path} {
 684         global all_icons
 685
 686         if {[catch {set r $all_icons($state)}]} {
 687                 puts "error: no icon for state={$state} $path"
 688                 return file_plain
 689         }
 690         return $r
 691 }
 692
 693 proc mapdesc {state path} {
 694         global all_descs
 695
 696         if {[catch {set r $all_descs($state)}]} {
 697                 puts "error: no desc for state={$state} $path"
 698                 return $state
 699         }
 700         return $r
 701 }
 702
 703 proc bsearch {w path} {
 704         set hi [expr [lindex [split [$w index end] .] 0] - 2]
 705         if {$hi == 0} {
 706                 return -1
 707         }
 708         set lo 0
 709         while {$lo < $hi} {
 710                 set mi [expr [expr $lo + $hi] / 2]
 711                 set ti [expr $mi + 1]
 712                 set cmp [string compare [$w get $ti.1 $ti.end] $path]
 713                 if {$cmp < 0} {
 714                         set lo $ti
 715                 } elseif {$cmp == 0} {
 716                         return $mi
 717                 } else {
 718                         set hi $mi
 719                 }
 720         }
 721         return -[expr $lo + 1]
 722 }
 723
 724 set next_icon_id 0
 725
 726 proc merge_state {path new_state} {
 727         global file_states next_icon_id
 728
 729         set s0 [string index $new_state 0]
 730         set s1 [string index $new_state 1]
 731
 732         if {[catch {set info $file_states($path)}]} {
 733                 set state __
 734                 set icon n[incr next_icon_id]
 735         } else {
 736                 set state [lindex $info 0]
 737                 set icon [lindex $info 1]
 738         }
 739
 740         if {$s0 == {_}} {
 741                 set s0 [string index $state 0]
 742         } elseif {$s0 == {*}} {
 743                 set s0 _
 744         }
 745
 746         if {$s1 == {_}} {
 747                 set s1 [string index $state 1]
 748         } elseif {$s1 == {*}} {
 749                 set s1 _
 750         }
 751
 752         set file_states($path) [list $s0$s1 $icon]
 753         return $state
 754 }
 755
 756 proc display_file {path state} {
 757         global ui_index ui_other file_states status_active
 758
 759         set old_m [merge_state $path $state]
 760         if {$status_active} return
 761
 762         set s $file_states($path)
 763         set new_m [lindex $s 0]
 764         set new_w [mapcol $new_m $path]
 765         set old_w [mapcol $old_m $path]
 766         set new_icon [mapicon $new_m $path]
 767
 768         if {$new_w != $old_w} {
 769                 set lno [bsearch $old_w $path]
 770                 if {$lno >= 0} {
 771                         incr lno
 772                         $old_w conf -state normal
 773                         $old_w delete $lno.0 [expr $lno + 1].0
 774                         $old_w conf -state disabled
 775                 }
 776
 777                 set lno [expr abs([bsearch $new_w $path] + 1) + 1]
 778                 $new_w conf -state normal
 779                 $new_w image create $lno.0 \
 780                         -align center -padx 5 -pady 1 \
 781                         -name [lindex $s 1] \
 782                         -image [mapicon $m $path]
 783                 $new_w insert $lno.1 "$path\n"
 784                 $new_w conf -state disabled
 785         } elseif {$new_icon != [mapicon $old_m $path]} {
 786                 $new_w conf -state normal
 787                 $new_w image conf [lindex $s 1] -image $new_icon
 788                 $new_w conf -state disabled
 789         }
 790 }
 791
 792 proc display_all_files {} {
 793         global ui_index ui_other file_states
 794
 795         $ui_index conf -state normal
 796         $ui_other conf -state normal
 797
 798         foreach path [lsort [array names file_states]] {
 799                 set s $file_states($path)
 800                 set m [lindex $s 0]
 801                 set w [mapcol $m $path]
 802                 $w image create end \
 803                         -align center -padx 5 -pady 1 \
 804                         -name [lindex $s 1] \
 805                         -image [mapicon $m $path]
 806                 $w insert end "$path\n"
 807         }
 808
 809         $ui_index conf -state disabled
 810         $ui_other conf -state disabled
 811 }
 812
 813 proc with_update_index {body} {
 814         global update_index_fd
 815
 816         if {$update_index_fd == {}} {
 817                 if {![lock_index update]} return
 818                 set update_index_fd [open \
 819                         "| git update-index --add --remove -z --stdin" \
 820                         w]
 821                 fconfigure $update_index_fd -translation binary
 822                 uplevel 1 $body
 823                 close $update_index_fd
 824                 set update_index_fd {}
 825                 unlock_index
 826         } else {
 827                 uplevel 1 $body
 828         }
 829 }
 830
 831 proc update_index {path} {
 832         global update_index_fd
 833
 834         if {$update_index_fd == {}} {
 835                 error {not in with_update_index}
 836         } else {
 837                 puts -nonewline $update_index_fd "$path\0"
 838         }
 839 }
 840
 841 proc toggle_mode {path} {
 842         global file_states ui_fname_value
 843
 844         set s $file_states($path)
 845         set m [lindex $s 0]
 846
 847         switch -- $m {
 848         AM -
 849         _O {set new A*}
 850         _M -
 851         MM {set new M*}
 852         AD -
 853         _D {set new D*}
 854         default {return}
 855         }
 856
 857         with_update_index {update_index $path}
 858         display_file $path $new
 859         if {$ui_fname_value == $path} {
 860                 show_diff $path
 861         }
 862 }
 863
 864 ######################################################################
 865 ##
 866 ## config (fetch push pull)
 867
 868 proc load_repo_config {} {
 869         global repo_config
 870         global cfg_trust_mtime
 871
 872         array unset repo_config
 873         catch {
 874                 set fd_rc [open "| git repo-config --list" r]
 875                 while {[gets $fd_rc line] >= 0} {
 876                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 877                                 lappend repo_config($name) $value
 878                         }
 879                 }
 880                 close $fd_rc
 881         }
 882
 883         if {[catch {set cfg_trust_mtime $repo_config(gui.trustmtime)}]} {
 884                 set cfg_trust_mtime false
 885         }
 886 }
 887
 888 proc save_my_config {} {
 889         global repo_config
 890         global cfg_trust_mtime
 891
 892         if {[catch {set rc_trustMTime $repo_config(gui.trustmtime)}]} {
 893                 set rc_trustMTime false
 894         }
 895         if {$cfg_trust_mtime != $rc_trustMTime} {
 896                 exec git repo-config gui.trustMTime $cfg_trust_mtime
 897         }
 898 }
 899
 900 proc load_all_remotes {} {
 901         global gitdir all_remotes repo_config
 902
 903         set all_remotes [list]
 904         set rm_dir [file join $gitdir remotes]
 905         if {[file isdirectory $rm_dir]} {
 906                 set all_remotes [concat $all_remotes [glob \
 907                         -types f \
 908                         -tails \
 909                         -nocomplain \
 910                         -directory $rm_dir *]]
 911         }
 912
 913         foreach line [array names repo_config remote.*.url] {
 914                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
 915                         lappend all_remotes $name
 916                 }
 917         }
 918
 919         set all_remotes [lsort -unique $all_remotes]
 920 }
 921
 922 proc populate_remote_menu {m pfx op} {
 923         global all_remotes mainfont
 924
 925         foreach remote $all_remotes {
 926                 $m add command -label "$pfx $remote..." \
 927                         -command [list $op $remote] \
 928                         -font $mainfont
 929         }
 930 }
 931
 932 proc populate_pull_menu {m} {
 933         global gitdir repo_config all_remotes mainfont
 934
 935         foreach remote $all_remotes {
 936                 set rb {}
 937                 if {[array get repo_config remote.$remote.url] != {}} {
 938                         if {[array get repo_config remote.$remote.fetch] != {}} {
 939                                 regexp {^([^:]+):} \
 940                                         [lindex $repo_config(remote.$remote.fetch) 0] \
 941                                         line rb
 942                         }
 943                 } else {
 944                         catch {
 945                                 set fd [open [file join $gitdir remotes $remote] r]
 946                                 while {[gets $fd line] >= 0} {
 947                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
 948                                                 break
 949                                         }
 950                                 }
 951                                 close $fd
 952                         }
 953                 }
 954
 955                 set rb_short $rb
 956                 regsub ^refs/heads/ $rb {} rb_short
 957                 if {$rb_short != {}} {
 958                         $m add command \
 959                                 -label "Branch $rb_short from $remote..." \
 960                                 -command [list pull_remote $remote $rb] \
 961                                 -font $mainfont
 962                 }
 963         }
 964 }
 965
 966 ######################################################################
 967 ##
 968 ## icons
 969
 970 set filemask {
 971 #define mask_width 14
 972 #define mask_height 15
 973 static unsigned char mask_bits[] = {
 974    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 975    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 976    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
 977 }
 978
 979 image create bitmap file_plain -background white -foreground black -data {
 980 #define plain_width 14
 981 #define plain_height 15
 982 static unsigned char plain_bits[] = {
 983    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
 984    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
 985    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 986 } -maskdata $filemask
 987
 988 image create bitmap file_mod -background white -foreground blue -data {
 989 #define mod_width 14
 990 #define mod_height 15
 991 static unsigned char mod_bits[] = {
 992    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
 993    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
 994    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
 995 } -maskdata $filemask
 996
 997 image create bitmap file_fulltick -background white -foreground "#007000" -data {
 998 #define file_fulltick_width 14
 999 #define file_fulltick_height 15
1000 static unsigned char file_fulltick_bits[] = {
1001    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1002    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1003    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1004 } -maskdata $filemask
1005
1006 image create bitmap file_parttick -background white -foreground "#005050" -data {
1007 #define parttick_width 14
1008 #define parttick_height 15
1009 static unsigned char parttick_bits[] = {
1010    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1011    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1012    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1013 } -maskdata $filemask
1014
1015 image create bitmap file_question -background white -foreground black -data {
1016 #define file_question_width 14
1017 #define file_question_height 15
1018 static unsigned char file_question_bits[] = {
1019    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1020    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1021    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1022 } -maskdata $filemask
1023
1024 image create bitmap file_removed -background white -foreground red -data {
1025 #define file_removed_width 14
1026 #define file_removed_height 15
1027 static unsigned char file_removed_bits[] = {
1028    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1029    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1030    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1031 } -maskdata $filemask
1032
1033 image create bitmap file_merge -background white -foreground blue -data {
1034 #define file_merge_width 14
1035 #define file_merge_height 15
1036 static unsigned char file_merge_bits[] = {
1037    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1038    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1039    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1040 } -maskdata $filemask
1041
1042 set ui_index .vpane.files.index.list
1043 set ui_other .vpane.files.other.list
1044 set max_status_desc 0
1045 foreach i {
1046                 {__ i plain    "Unmodified"}
1047                 {_M i mod      "Modified"}
1048                 {M_ i fulltick "Checked in"}
1049                 {MM i parttick "Partially checked in"}
1050
1051                 {_O o plain    "Untracked"}
1052                 {A_ o fulltick "Added"}
1053                 {AM o parttick "Partially added"}
1054                 {AD o question "Added (but now gone)"}
1055
1056                 {_D i question "Missing"}
1057                 {D_ i removed  "Removed"}
1058                 {DD i removed  "Removed"}
1059                 {DO i removed  "Removed (still exists)"}
1060
1061                 {UM i merge    "Merge conflicts"}
1062                 {U_ i merge    "Merge conflicts"}
1063         } {
1064         if {$max_status_desc < [string length [lindex $i 3]]} {
1065                 set max_status_desc [string length [lindex $i 3]]
1066         }
1067         if {[lindex $i 1] == {i}} {
1068                 set all_cols([lindex $i 0]) $ui_index
1069         } else {
1070                 set all_cols([lindex $i 0]) $ui_other
1071         }
1072         set all_icons([lindex $i 0]) file_[lindex $i 2]
1073         set all_descs([lindex $i 0]) [lindex $i 3]
1074 }
1075 unset filemask i
1076
1077 ######################################################################
1078 ##
1079 ## util
1080
1081 proc error_popup {msg} {
1082         set w .error
1083         toplevel $w
1084         wm transient $w .
1085         show_msg $w $w $msg
1086 }
1087
1088 proc show_msg {w top msg} {
1089         global gitdir appname mainfont
1090
1091         message $w.m -text $msg -justify left -aspect 400
1092         pack $w.m -side top -fill x -padx 5 -pady 10
1093         button $w.ok -text OK \
1094                 -width 15 \
1095                 -font $mainfont \
1096                 -command "destroy $top"
1097         pack $w.ok -side bottom
1098         bind $top <Visibility> "grab $top; focus $top"
1099         bind $top <Key-Return> "destroy $top"
1100         wm title $w "$appname ([lindex [file split \
1101                 [file normalize [file dirname $gitdir]]] \
1102                 end]): error"
1103         tkwait window $top
1104 }
1105
1106 proc hook_failed_popup {hook msg} {
1107         global gitdir mainfont difffont appname
1108
1109         set w .hookfail
1110         toplevel $w
1111         wm transient $w .
1112
1113         frame $w.m
1114         label $w.m.l1 -text "$hook hook failed:" \
1115                 -anchor w \
1116                 -justify left \
1117                 -font [concat $mainfont bold]
1118         text $w.m.t \
1119                 -background white -borderwidth 1 \
1120                 -relief sunken \
1121                 -width 80 -height 10 \
1122                 -font $difffont \
1123                 -yscrollcommand [list $w.m.sby set]
1124         label $w.m.l2 \
1125                 -text {You must correct the above errors before committing.} \
1126                 -anchor w \
1127                 -justify left \
1128                 -font [concat $mainfont bold]
1129         scrollbar $w.m.sby -command [list $w.m.t yview]
1130         pack $w.m.l1 -side top -fill x
1131         pack $w.m.l2 -side bottom -fill x
1132         pack $w.m.sby -side right -fill y
1133         pack $w.m.t -side left -fill both -expand 1
1134         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1135
1136         $w.m.t insert 1.0 $msg
1137         $w.m.t conf -state disabled
1138
1139         button $w.ok -text OK \
1140                 -width 15 \
1141                 -font $mainfont \
1142                 -command "destroy $w"
1143         pack $w.ok -side bottom
1144
1145         bind $w <Visibility> "grab $w; focus $w"
1146         bind $w <Key-Return> "destroy $w"
1147         wm title $w "$appname ([lindex [file split \
1148                 [file normalize [file dirname $gitdir]]] \
1149                 end]): error"
1150         tkwait window $w
1151 }
1152
1153 set next_console_id 0
1154
1155 proc new_console {short_title long_title} {
1156         global next_console_id console_data
1157         set w .console[incr next_console_id]
1158         set console_data($w) [list $short_title $long_title]
1159         return [console_init $w]
1160 }
1161
1162 proc console_init {w} {
1163         global console_cr console_data
1164         global gitdir appname mainfont difffont
1165
1166         set console_cr($w) 1.0
1167         toplevel $w
1168         frame $w.m
1169         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1170                 -anchor w \
1171                 -justify left \
1172                 -font [concat $mainfont bold]
1173         text $w.m.t \
1174                 -background white -borderwidth 1 \
1175                 -relief sunken \
1176                 -width 80 -height 10 \
1177                 -font $difffont \
1178                 -state disabled \
1179                 -yscrollcommand [list $w.m.sby set]
1180         label $w.m.s -anchor w \
1181                 -justify left \
1182                 -font [concat $mainfont bold]
1183         scrollbar $w.m.sby -command [list $w.m.t yview]
1184         pack $w.m.l1 -side top -fill x
1185         pack $w.m.s -side bottom -fill x
1186         pack $w.m.sby -side right -fill y
1187         pack $w.m.t -side left -fill both -expand 1
1188         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1189
1190         button $w.ok -text {Running...} \
1191                 -width 15 \
1192                 -font $mainfont \
1193                 -state disabled \
1194                 -command "destroy $w"
1195         pack $w.ok -side bottom
1196
1197         bind $w <Visibility> "focus $w"
1198         wm title $w "$appname ([lindex [file split \
1199                 [file normalize [file dirname $gitdir]]] \
1200                 end]): [lindex $console_data($w) 0]"
1201         return $w
1202 }
1203
1204 proc console_exec {w cmd {after {}}} {
1205         global tcl_platform
1206
1207         # -- Windows tosses the enviroment when we exec our child.
1208         #    But most users need that so we have to relogin. :-(
1209         #
1210         if {$tcl_platform(platform) == {windows}} {
1211                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1212         }
1213
1214         # -- Tcl won't let us redirect both stdout and stderr to
1215         #    the same pipe.  So pass it through cat...
1216         #
1217         set cmd [concat | $cmd |& cat]
1218
1219         set fd_f [open $cmd r]
1220         fconfigure $fd_f -blocking 0 -translation binary
1221         fileevent $fd_f readable [list console_read $w $fd_f $after]
1222 }
1223
1224 proc console_read {w fd after} {
1225         global console_cr console_data
1226
1227         set buf [read $fd]
1228         if {$buf != {}} {
1229                 if {![winfo exists $w]} {console_init $w}
1230                 $w.m.t conf -state normal
1231                 set c 0
1232                 set n [string length $buf]
1233                 while {$c < $n} {
1234                         set cr [string first "\r" $buf $c]
1235                         set lf [string first "\n" $buf $c]
1236                         if {$cr < 0} {set cr [expr $n + 1]}
1237                         if {$lf < 0} {set lf [expr $n + 1]}
1238
1239                         if {$lf < $cr} {
1240                                 $w.m.t insert end [string range $buf $c $lf]
1241                                 set console_cr($w) [$w.m.t index {end -1c}]
1242                                 set c $lf
1243                                 incr c
1244                         } else {
1245                                 $w.m.t delete $console_cr($w) end
1246                                 $w.m.t insert end "\n"
1247                                 $w.m.t insert end [string range $buf $c $cr]
1248                                 set c $cr
1249                                 incr c
1250                         }
1251                 }
1252                 $w.m.t conf -state disabled
1253                 $w.m.t see end
1254         }
1255
1256         fconfigure $fd -blocking 1
1257         if {[eof $fd]} {
1258                 if {[catch {close $fd}]} {
1259                         if {![winfo exists $w]} {console_init $w}
1260                         $w.m.s conf -background red -text {Error: Command Failed}
1261                         $w.ok conf -text Close
1262                         $w.ok conf -state normal
1263                         set ok 0
1264                 } elseif {[winfo exists $w]} {
1265                         $w.m.s conf -background green -text {Success}
1266                         $w.ok conf -text Close
1267                         $w.ok conf -state normal
1268                         set ok 1
1269                 }
1270                 array unset console_cr $w
1271                 array unset console_data $w
1272                 if {$after != {}} {
1273                         uplevel #0 $after $ok
1274                 }
1275                 return
1276         }
1277         fconfigure $fd -blocking 0
1278 }
1279
1280 ######################################################################
1281 ##
1282 ## ui commands
1283
1284 set starting_gitk_msg {Please wait... Starting gitk...}
1285
1286 proc do_gitk {} {
1287         global tcl_platform ui_status_value starting_gitk_msg
1288
1289         set ui_status_value $starting_gitk_msg
1290         after 10000 {
1291                 if {$ui_status_value == $starting_gitk_msg} {
1292                         set ui_status_value {Ready.}
1293                 }
1294         }
1295
1296         if {$tcl_platform(platform) == {windows}} {
1297                 exec sh -c gitk &
1298         } else {
1299                 exec gitk &
1300         }
1301 }
1302
1303 proc do_repack {} {
1304         set w [new_console "repack" "Repacking the object database"]
1305         set cmd [list git repack]
1306         lappend cmd -a
1307         lappend cmd -d
1308         console_exec $w $cmd
1309 }
1310
1311 proc do_quit {} {
1312         global gitdir ui_comm
1313
1314         set save [file join $gitdir GITGUI_MSG]
1315         set msg [string trim [$ui_comm get 0.0 end]]
1316         if {[$ui_comm edit modified] && $msg != {}} {
1317                 catch {
1318                         set fd [open $save w]
1319                         puts $fd [string trim [$ui_comm get 0.0 end]]
1320                         close $fd
1321                 }
1322         } elseif {$msg == {} && [file exists $save]} {
1323                 file delete $save
1324         }
1325
1326         save_my_config
1327         destroy .
1328 }
1329
1330 proc do_rescan {} {
1331         update_status
1332 }
1333
1334 proc do_checkin_all {} {
1335         global checkin_active ui_status_value
1336
1337         if {$checkin_active || ![lock_index begin-update]} return
1338
1339         set checkin_active 1
1340         set ui_status_value {Checking in all files...}
1341         after 1 {
1342                 with_update_index {
1343                         foreach path [array names file_states] {
1344                                 set s $file_states($path)
1345                                 set m [lindex $s 0]
1346                                 switch -- $m {
1347                                 AM -
1348                                 MM -
1349                                 _M -
1350                                 _D {toggle_mode $path}
1351                                 }
1352                         }
1353                 }
1354                 set checkin_active 0
1355                 set ui_status_value {Ready.}
1356         }
1357 }
1358
1359 proc do_signoff {} {
1360         global ui_comm
1361
1362         catch {
1363                 set me [exec git var GIT_COMMITTER_IDENT]
1364                 if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1365                         set str "Signed-off-by: $name"
1366                         if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1367                                 $ui_comm insert end "\n"
1368                                 $ui_comm insert end $str
1369                                 $ui_comm see end
1370                         }
1371                 }
1372         }
1373 }
1374
1375 proc do_amend_last {} {
1376         load_last_commit
1377 }
1378
1379 proc do_commit {} {
1380         commit_tree
1381 }
1382
1383 # shift == 1: left click
1384 #          3: right click
1385 proc click {w x y shift wx wy} {
1386         global ui_index ui_other
1387
1388         set pos [split [$w index @$x,$y] .]
1389         set lno [lindex $pos 0]
1390         set col [lindex $pos 1]
1391         set path [$w get $lno.1 $lno.end]
1392         if {$path == {}} return
1393
1394         if {$col > 0 && $shift == 1} {
1395                 $ui_index tag remove in_diff 0.0 end
1396                 $ui_other tag remove in_diff 0.0 end
1397                 $w tag add in_diff $lno.0 [expr $lno + 1].0
1398                 show_diff $path
1399         }
1400 }
1401
1402 proc unclick {w x y} {
1403         set pos [split [$w index @$x,$y] .]
1404         set lno [lindex $pos 0]
1405         set col [lindex $pos 1]
1406         set path [$w get $lno.1 $lno.end]
1407         if {$path == {}} return
1408
1409         if {$col == 0} {
1410                 toggle_mode $path
1411         }
1412 }
1413
1414 ######################################################################
1415 ##
1416 ## ui init
1417
1418 set mainfont {Helvetica 10}
1419 set difffont {Courier 10}
1420 set maincursor [. cget -cursor]
1421
1422 switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1423 windows,*   {set M1B Control; set M1T Ctrl}
1424 unix,Darwin {set M1B M1; set M1T Cmd}
1425 default     {set M1B M1; set M1T M1}
1426 }
1427
1428 # -- Menu Bar
1429 menu .mbar -tearoff 0
1430 .mbar add cascade -label Project -menu .mbar.project
1431 .mbar add cascade -label Commit -menu .mbar.commit
1432 .mbar add cascade -label Fetch -menu .mbar.fetch
1433 .mbar add cascade -label Pull -menu .mbar.pull
1434 .mbar add cascade -label Push -menu .mbar.push
1435 .mbar add cascade -label Options -menu .mbar.options
1436 . configure -menu .mbar
1437
1438 # -- Project Menu
1439 menu .mbar.project
1440 .mbar.project add command -label Visualize \
1441         -command do_gitk \
1442         -font $mainfont
1443 .mbar.project add command -label {Repack Database} \
1444         -command do_repack \
1445         -font $mainfont
1446 .mbar.project add command -label Quit \
1447         -command do_quit \
1448         -accelerator $M1T-Q \
1449         -font $mainfont
1450
1451 # -- Commit Menu
1452 menu .mbar.commit
1453 .mbar.commit add command -label Rescan \
1454         -command do_rescan \
1455         -accelerator F5 \
1456         -font $mainfont
1457 lappend disable_on_lock \
1458         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1459 .mbar.commit add command -label {Amend Last Commit} \
1460         -command do_amend_last \
1461         -font $mainfont
1462 lappend disable_on_lock \
1463         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1464 .mbar.commit add command -label {Check-in All Files} \
1465         -command do_checkin_all \
1466         -accelerator $M1T-U \
1467         -font $mainfont
1468 lappend disable_on_lock \
1469         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1470 .mbar.commit add command -label {Sign Off} \
1471         -command do_signoff \
1472         -accelerator $M1T-S \
1473         -font $mainfont
1474 .mbar.commit add command -label Commit \
1475         -command do_commit \
1476         -accelerator $M1T-Return \
1477         -font $mainfont
1478 lappend disable_on_lock \
1479         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1480
1481 # -- Fetch Menu
1482 menu .mbar.fetch
1483
1484 # -- Pull Menu
1485 menu .mbar.pull
1486
1487 # -- Push Menu
1488 menu .mbar.push
1489
1490 # -- Options Menu
1491 menu .mbar.options
1492 .mbar.options add checkbutton -label {Trust File Modification Timestamp} \
1493         -offvalue false \
1494         -onvalue true \
1495         -variable cfg_trust_mtime
1496
1497 # -- Main Window Layout
1498 panedwindow .vpane -orient vertical
1499 panedwindow .vpane.files -orient horizontal
1500 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1501 pack .vpane -anchor n -side top -fill both -expand 1
1502
1503 # -- Index File List
1504 frame .vpane.files.index -height 100 -width 400
1505 label .vpane.files.index.title -text {Modified Files} \
1506         -background green \
1507         -font $mainfont
1508 text $ui_index -background white -borderwidth 0 \
1509         -width 40 -height 10 \
1510         -font $mainfont \
1511         -yscrollcommand {.vpane.files.index.sb set} \
1512         -cursor $maincursor \
1513         -state disabled
1514 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1515 pack .vpane.files.index.title -side top -fill x
1516 pack .vpane.files.index.sb -side right -fill y
1517 pack $ui_index -side left -fill both -expand 1
1518 .vpane.files add .vpane.files.index -sticky nsew
1519
1520 # -- Other (Add) File List
1521 frame .vpane.files.other -height 100 -width 100
1522 label .vpane.files.other.title -text {Untracked Files} \
1523         -background red \
1524         -font $mainfont
1525 text $ui_other -background white -borderwidth 0 \
1526         -width 40 -height 10 \
1527         -font $mainfont \
1528         -yscrollcommand {.vpane.files.other.sb set} \
1529         -cursor $maincursor \
1530         -state disabled
1531 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1532 pack .vpane.files.other.title -side top -fill x
1533 pack .vpane.files.other.sb -side right -fill y
1534 pack $ui_other -side left -fill both -expand 1
1535 .vpane.files add .vpane.files.other -sticky nsew
1536
1537 $ui_index tag conf in_diff -font [concat $mainfont bold]
1538 $ui_other tag conf in_diff -font [concat $mainfont bold]
1539
1540 # -- Diff and Commit Area
1541 frame .vpane.lower -height 400 -width 400
1542 frame .vpane.lower.commarea
1543 frame .vpane.lower.diff -relief sunken -borderwidth 1
1544 pack .vpane.lower.commarea -side top -fill x
1545 pack .vpane.lower.diff -side bottom -fill both -expand 1
1546 .vpane add .vpane.lower -stick nsew
1547
1548 # -- Commit Area Buttons
1549 frame .vpane.lower.commarea.buttons
1550 label .vpane.lower.commarea.buttons.l -text {} \
1551         -anchor w \
1552         -justify left \
1553         -font $mainfont
1554 pack .vpane.lower.commarea.buttons.l -side top -fill x
1555 pack .vpane.lower.commarea.buttons -side left -fill y
1556
1557 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1558         -command do_rescan \
1559         -font $mainfont
1560 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1561 lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1562
1563 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1564         -command do_amend_last \
1565         -font $mainfont
1566 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1567 lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1568
1569 button .vpane.lower.commarea.buttons.ciall -text {Check-in All} \
1570         -command do_checkin_all \
1571         -font $mainfont
1572 pack .vpane.lower.commarea.buttons.ciall -side top -fill x
1573 lappend disable_on_lock {.vpane.lower.commarea.buttons.ciall conf -state}
1574
1575 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1576         -command do_signoff \
1577         -font $mainfont
1578 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1579
1580 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1581         -command do_commit \
1582         -font $mainfont
1583 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1584 lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1585
1586 # -- Commit Message Buffer
1587 frame .vpane.lower.commarea.buffer
1588 set ui_comm .vpane.lower.commarea.buffer.t
1589 set ui_coml .vpane.lower.commarea.buffer.l
1590 label $ui_coml -text {Commit Message:} \
1591         -anchor w \
1592         -justify left \
1593         -font $mainfont
1594 trace add variable commit_type write {uplevel #0 {
1595         switch -glob $commit_type \
1596         initial {$ui_coml conf -text {Initial Commit Message:}} \
1597         amend   {$ui_coml conf -text {Amended Commit Message:}} \
1598         merge   {$ui_coml conf -text {Merge Commit Message:}} \
1599         *       {$ui_coml conf -text {Commit Message:}}
1600 }}
1601 text $ui_comm -background white -borderwidth 1 \
1602         -relief sunken \
1603         -width 75 -height 9 -wrap none \
1604         -font $difffont \
1605         -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1606         -cursor $maincursor
1607 scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1608 pack $ui_coml -side top -fill x
1609 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1610 pack $ui_comm -side left -fill y
1611 pack .vpane.lower.commarea.buffer -side left -fill y
1612
1613 # -- Diff Header
1614 set ui_fname_value {}
1615 set ui_fstatus_value {}
1616 frame .vpane.lower.diff.header -background orange
1617 label .vpane.lower.diff.header.l1 -text {File:} \
1618         -background orange \
1619         -font $mainfont
1620 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1621         -background orange \
1622         -anchor w \
1623         -justify left \
1624         -font $mainfont
1625 label .vpane.lower.diff.header.l3 -text {Status:} \
1626         -background orange \
1627         -font $mainfont
1628 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1629         -background orange \
1630         -width $max_status_desc \
1631         -anchor w \
1632         -justify left \
1633         -font $mainfont
1634 pack .vpane.lower.diff.header.l1 -side left
1635 pack .vpane.lower.diff.header.l2 -side left -fill x
1636 pack .vpane.lower.diff.header.l4 -side right
1637 pack .vpane.lower.diff.header.l3 -side right
1638
1639 # -- Diff Body
1640 frame .vpane.lower.diff.body
1641 set ui_diff .vpane.lower.diff.body.t
1642 text $ui_diff -background white -borderwidth 0 \
1643         -width 80 -height 15 -wrap none \
1644         -font $difffont \
1645         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1646         -yscrollcommand {.vpane.lower.diff.body.sby set} \
1647         -cursor $maincursor \
1648         -state disabled
1649 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1650         -command [list $ui_diff xview]
1651 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1652         -command [list $ui_diff yview]
1653 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1654 pack .vpane.lower.diff.body.sby -side right -fill y
1655 pack $ui_diff -side left -fill both -expand 1
1656 pack .vpane.lower.diff.header -side top -fill x
1657 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1658
1659 $ui_diff tag conf dm -foreground red
1660 $ui_diff tag conf dp -foreground blue
1661 $ui_diff tag conf da -font [concat $difffont bold]
1662 $ui_diff tag conf di -foreground "#00a000"
1663 $ui_diff tag conf dni -foreground "#a000a0"
1664 $ui_diff tag conf bold -font [concat $difffont bold]
1665
1666 # -- Status Bar
1667 set ui_status_value {Initializing...}
1668 label .status -textvariable ui_status_value \
1669         -anchor w \
1670         -justify left \
1671         -borderwidth 1 \
1672         -relief sunken \
1673         -font $mainfont
1674 pack .status -anchor w -side bottom -fill x
1675
1676 # -- Key Bindings
1677 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1678 bind .   <Destroy> do_quit
1679 bind all <Key-F5> do_rescan
1680 bind all <$M1B-Key-r> do_rescan
1681 bind all <$M1B-Key-R> do_rescan
1682 bind .   <$M1B-Key-s> do_signoff
1683 bind .   <$M1B-Key-S> do_signoff
1684 bind .   <$M1B-Key-u> do_checkin_all
1685 bind .   <$M1B-Key-U> do_checkin_all
1686 bind .   <$M1B-Key-Return> do_commit
1687 bind all <$M1B-Key-q> do_quit
1688 bind all <$M1B-Key-Q> do_quit
1689 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1690 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1691 foreach i [list $ui_index $ui_other] {
1692         bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1693         bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1694         bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1695 }
1696 unset i M1B M1T
1697
1698 ######################################################################
1699 ##
1700 ## main
1701
1702 set appname [lindex [file split $argv0] end]
1703 set gitdir {}
1704
1705 if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
1706         show_msg {} . "Cannot find the git directory: $err"
1707         exit 1
1708 }
1709 if {$cdup != ""} {
1710         cd $cdup
1711 }
1712 unset cdup
1713
1714 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1715         show_msg {} . "Cannot find the git directory: $err"
1716         exit 1
1717 }
1718
1719 if {$appname == {git-citool}} {
1720         set single_commit 1
1721 }
1722
1723 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1724 focus -force $ui_comm
1725 load_repo_config
1726 load_all_remotes
1727 populate_remote_menu .mbar.fetch From fetch_from
1728 populate_remote_menu .mbar.push To push_to
1729 populate_pull_menu .mbar.pull
1730 update_status