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