git-gui.sh

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3  if test "z$*" = zversion \
   4  || test "z$*" = z--version; \
   5  then \
   6         echo 'git-gui version @@GITGUI_VERSION@@'; \
   7         exit; \
   8  fi; \
   9  exec wish "$0" -- "$@"
  10
  11 set appvers {@@GITGUI_VERSION@@}
  12 set copyright {
  13 Copyright © 2006, 2007 Shawn Pearce, et. al.
  14
  15 This program is free software; you can redistribute it and/or modify
  16 it under the terms of the GNU General Public License as published by
  17 the Free Software Foundation; either version 2 of the License, or
  18 (at your option) any later version.
  19
  20 This program is distributed in the hope that it will be useful,
  21 but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 GNU General Public License for more details.
  24
  25 You should have received a copy of the GNU General Public License
  26 along with this program; if not, write to the Free Software
  27 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  28
  29 ######################################################################
  30 ##
  31 ## Tcl/Tk sanity check
  32
  33 if {[catch {package require Tcl 8.4} err]
  34  || [catch {package require Tk  8.4} err]
  35 } {
  36         catch {wm withdraw .}
  37         tk_messageBox \
  38                 -icon error \
  39                 -type ok \
  40                 -title "git-gui: fatal error" \
  41                 -message $err
  42         exit 1
  43 }
  44
  45 ######################################################################
  46 ##
  47 ## enable verbose loading?
  48
  49 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
  50         unset _verbose
  51         rename auto_load real__auto_load
  52         proc auto_load {name args} {
  53                 puts stderr "auto_load $name"
  54                 return [uplevel 1 real__auto_load $name $args]
  55         }
  56         rename source real__source
  57         proc source {name} {
  58                 puts stderr "source    $name"
  59                 uplevel 1 real__source $name
  60         }
  61 }
  62
  63 ######################################################################
  64 ##
  65 ## read only globals
  66
  67 set _appname [lindex [file split $argv0] end]
  68 set _gitdir {}
  69 set _gitexec {}
  70 set _reponame {}
  71 set _iscygwin {}
  72 set _search_path {}
  73
  74 proc appname {} {
  75         global _appname
  76         return $_appname
  77 }
  78
  79 proc gitdir {args} {
  80         global _gitdir
  81         if {$args eq {}} {
  82                 return $_gitdir
  83         }
  84         return [eval [list file join $_gitdir] $args]
  85 }
  86
  87 proc gitexec {args} {
  88         global _gitexec
  89         if {$_gitexec eq {}} {
  90                 if {[catch {set _gitexec [git --exec-path]} err]} {
  91                         error "Git not installed?\n\n$err"
  92                 }
  93                 if {[is_Cygwin]} {
  94                         set _gitexec [exec cygpath \
  95                                 --windows \
  96                                 --absolute \
  97                                 $_gitexec]
  98                 } else {
  99                         set _gitexec [file normalize $_gitexec]
 100                 }
 101         }
 102         if {$args eq {}} {
 103                 return $_gitexec
 104         }
 105         return [eval [list file join $_gitexec] $args]
 106 }
 107
 108 proc reponame {} {
 109         return $::_reponame
 110 }
 111
 112 proc is_MacOSX {} {
 113         if {[tk windowingsystem] eq {aqua}} {
 114                 return 1
 115         }
 116         return 0
 117 }
 118
 119 proc is_Windows {} {
 120         if {$::tcl_platform(platform) eq {windows}} {
 121                 return 1
 122         }
 123         return 0
 124 }
 125
 126 proc is_Cygwin {} {
 127         global _iscygwin
 128         if {$_iscygwin eq {}} {
 129                 if {$::tcl_platform(platform) eq {windows}} {
 130                         if {[catch {set p [exec cygpath --windir]} err]} {
 131                                 set _iscygwin 0
 132                         } else {
 133                                 set _iscygwin 1
 134                         }
 135                 } else {
 136                         set _iscygwin 0
 137                 }
 138         }
 139         return $_iscygwin
 140 }
 141
 142 proc is_enabled {option} {
 143         global enabled_options
 144         if {[catch {set on $enabled_options($option)}]} {return 0}
 145         return $on
 146 }
 147
 148 proc enable_option {option} {
 149         global enabled_options
 150         set enabled_options($option) 1
 151 }
 152
 153 proc disable_option {option} {
 154         global enabled_options
 155         set enabled_options($option) 0
 156 }
 157
 158 ######################################################################
 159 ##
 160 ## config
 161
 162 proc is_many_config {name} {
 163         switch -glob -- $name {
 164         remote.*.fetch -
 165         remote.*.push
 166                 {return 1}
 167         *
 168                 {return 0}
 169         }
 170 }
 171
 172 proc is_config_true {name} {
 173         global repo_config
 174         if {[catch {set v $repo_config($name)}]} {
 175                 return 0
 176         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 177                 return 1
 178         } else {
 179                 return 0
 180         }
 181 }
 182
 183 proc get_config {name} {
 184         global repo_config
 185         if {[catch {set v $repo_config($name)}]} {
 186                 return {}
 187         } else {
 188                 return $v
 189         }
 190 }
 191
 192 proc load_config {include_global} {
 193         global repo_config global_config default_config
 194
 195         array unset global_config
 196         if {$include_global} {
 197                 catch {
 198                         set fd_rc [git_read config --global --list]
 199                         while {[gets $fd_rc line] >= 0} {
 200                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 201                                         if {[is_many_config $name]} {
 202                                                 lappend global_config($name) $value
 203                                         } else {
 204                                                 set global_config($name) $value
 205                                         }
 206                                 }
 207                         }
 208                         close $fd_rc
 209                 }
 210         }
 211
 212         array unset repo_config
 213         catch {
 214                 set fd_rc [git_read config --list]
 215                 while {[gets $fd_rc line] >= 0} {
 216                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 217                                 if {[is_many_config $name]} {
 218                                         lappend repo_config($name) $value
 219                                 } else {
 220                                         set repo_config($name) $value
 221                                 }
 222                         }
 223                 }
 224                 close $fd_rc
 225         }
 226
 227         foreach name [array names default_config] {
 228                 if {[catch {set v $global_config($name)}]} {
 229                         set global_config($name) $default_config($name)
 230                 }
 231                 if {[catch {set v $repo_config($name)}]} {
 232                         set repo_config($name) $default_config($name)
 233                 }
 234         }
 235 }
 236
 237 ######################################################################
 238 ##
 239 ## handy utils
 240
 241 proc _git_cmd {name} {
 242         global _git_cmd_path
 243
 244         if {[catch {set v $_git_cmd_path($name)}]} {
 245                 switch -- $name {
 246                   version   -
 247                 --version   -
 248                 --exec-path { return [list $::_git $name] }
 249                 }
 250
 251                 set p [gitexec git-$name$::_search_exe]
 252                 if {[file exists $p]} {
 253                         set v [list $p]
 254                 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 255                         # Try to determine what sort of magic will make
 256                         # git-$name go and do its thing, because native
 257                         # Tcl on Windows doesn't know it.
 258                         #
 259                         set p [gitexec git-$name]
 260                         set f [open $p r]
 261                         set s [gets $f]
 262                         close $f
 263
 264                         switch -glob -- $s {
 265                         #!*sh     { set i sh     }
 266                         #!*perl   { set i perl   }
 267                         #!*python { set i python }
 268                         default   { error "git-$name is not supported: $s" }
 269                         }
 270
 271                         upvar #0 _$i interp
 272                         if {![info exists interp]} {
 273                                 set interp [_which $i]
 274                         }
 275                         if {$interp eq {}} {
 276                                 error "git-$name requires $i (not in PATH)"
 277                         }
 278                         set v [list $interp $p]
 279                 } else {
 280                         # Assume it is builtin to git somehow and we
 281                         # aren't actually able to see a file for it.
 282                         #
 283                         set v [list $::_git $name]
 284                 }
 285                 set _git_cmd_path($name) $v
 286         }
 287         return $v
 288 }
 289
 290 proc _which {what} {
 291         global env _search_exe _search_path
 292
 293         if {$_search_path eq {}} {
 294                 if {[is_Cygwin]} {
 295                         set _search_path [split [exec cygpath \
 296                                 --windows \
 297                                 --path \
 298                                 --absolute \
 299                                 $env(PATH)] {;}]
 300                         set _search_exe .exe
 301                 } elseif {[is_Windows]} {
 302                         set _search_path [split $env(PATH) {;}]
 303                         set _search_exe .exe
 304                 } else {
 305                         set _search_path [split $env(PATH) :]
 306                         set _search_exe {}
 307                 }
 308         }
 309
 310         foreach p $_search_path {
 311                 set p [file join $p $what$_search_exe]
 312                 if {[file exists $p]} {
 313                         return [file normalize $p]
 314                 }
 315         }
 316         return {}
 317 }
 318
 319 proc _lappend_nice {cmd_var} {
 320         global _nice
 321         upvar $cmd_var cmd
 322
 323         if {![info exists _nice]} {
 324                 set _nice [_which nice]
 325         }
 326         if {$_nice ne {}} {
 327                 lappend cmd $_nice
 328         }
 329 }
 330
 331 proc git {args} {
 332         set opt [list exec]
 333
 334         while {1} {
 335                 switch -- [lindex $args 0] {
 336                 --nice {
 337                         _lappend_nice opt
 338                 }
 339
 340                 default {
 341                         break
 342                 }
 343
 344                 }
 345
 346                 set args [lrange $args 1 end]
 347         }
 348
 349         set cmdp [_git_cmd [lindex $args 0]]
 350         set args [lrange $args 1 end]
 351
 352         return [eval $opt $cmdp $args]
 353 }
 354
 355 proc _open_stdout_stderr {cmd} {
 356         if {[catch {
 357                         set fd [open $cmd r]
 358                 } err]} {
 359                 if {   [lindex $cmd end] eq {2>@1}
 360                     && $err eq {can not find channel named "1"}
 361                         } {
 362                         # Older versions of Tcl 8.4 don't have this 2>@1 IO
 363                         # redirect operator.  Fallback to |& cat for those.
 364                         # The command was not actually started, so its safe
 365                         # to try to start it a second time.
 366                         #
 367                         set fd [open [concat \
 368                                 [lrange $cmd 0 end-1] \
 369                                 [list |& cat] \
 370                                 ] r]
 371                 } else {
 372                         error $err
 373                 }
 374         }
 375         fconfigure $fd -eofchar {}
 376         return $fd
 377 }
 378
 379 proc git_read {args} {
 380         set opt [list |]
 381
 382         while {1} {
 383                 switch -- [lindex $args 0] {
 384                 --nice {
 385                         _lappend_nice opt
 386                 }
 387
 388                 --stderr {
 389                         lappend args 2>@1
 390                 }
 391
 392                 default {
 393                         break
 394                 }
 395
 396                 }
 397
 398                 set args [lrange $args 1 end]
 399         }
 400
 401         set cmdp [_git_cmd [lindex $args 0]]
 402         set args [lrange $args 1 end]
 403
 404         return [_open_stdout_stderr [concat $opt $cmdp $args]]
 405 }
 406
 407 proc git_write {args} {
 408         set opt [list |]
 409
 410         while {1} {
 411                 switch -- [lindex $args 0] {
 412                 --nice {
 413                         _lappend_nice opt
 414                 }
 415
 416                 default {
 417                         break
 418                 }
 419
 420                 }
 421
 422                 set args [lrange $args 1 end]
 423         }
 424
 425         set cmdp [_git_cmd [lindex $args 0]]
 426         set args [lrange $args 1 end]
 427
 428         return [open [concat $opt $cmdp $args] w]
 429 }
 430
 431 proc sq {value} {
 432         regsub -all ' $value "'\\''" value
 433         return "'$value'"
 434 }
 435
 436 proc load_current_branch {} {
 437         global current_branch is_detached
 438
 439         set fd [open [gitdir HEAD] r]
 440         if {[gets $fd ref] < 1} {
 441                 set ref {}
 442         }
 443         close $fd
 444
 445         set pfx {ref: refs/heads/}
 446         set len [string length $pfx]
 447         if {[string equal -length $len $pfx $ref]} {
 448                 # We're on a branch.  It might not exist.  But
 449                 # HEAD looks good enough to be a branch.
 450                 #
 451                 set current_branch [string range $ref $len end]
 452                 set is_detached 0
 453         } else {
 454                 # Assume this is a detached head.
 455                 #
 456                 set current_branch HEAD
 457                 set is_detached 1
 458         }
 459 }
 460
 461 auto_load tk_optionMenu
 462 rename tk_optionMenu real__tkOptionMenu
 463 proc tk_optionMenu {w varName args} {
 464         set m [eval real__tkOptionMenu $w $varName $args]
 465         $m configure -font font_ui
 466         $w configure -font font_ui
 467         return $m
 468 }
 469
 470 ######################################################################
 471 ##
 472 ## find git
 473
 474 set _git  [_which git]
 475 if {$_git eq {}} {
 476         catch {wm withdraw .}
 477         error_popup "Cannot find git in PATH."
 478         exit 1
 479 }
 480
 481 ######################################################################
 482 ##
 483 ## version check
 484
 485 if {[catch {set _git_version [git --version]} err]} {
 486         catch {wm withdraw .}
 487         tk_messageBox \
 488                 -icon error \
 489                 -type ok \
 490                 -title "git-gui: fatal error" \
 491                 -message "Cannot determine Git version:
 492
 493 $err
 494
 495 [appname] requires Git 1.5.0 or later."
 496         exit 1
 497 }
 498 if {![regsub {^git version } $_git_version {} _git_version]} {
 499         catch {wm withdraw .}
 500         tk_messageBox \
 501                 -icon error \
 502                 -type ok \
 503                 -title "git-gui: fatal error" \
 504                 -message "Cannot parse Git version string:\n\n$_git_version"
 505         exit 1
 506 }
 507
 508 set _real_git_version $_git_version
 509 regsub -- {-dirty$} $_git_version {} _git_version
 510 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
 511 regsub {\.rc[0-9]+$} $_git_version {} _git_version
 512 regsub {\.GIT$} $_git_version {} _git_version
 513
 514 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
 515         catch {wm withdraw .}
 516         if {[tk_messageBox \
 517                 -icon warning \
 518                 -type yesno \
 519                 -default no \
 520                 -title "[appname]: warning" \
 521                 -message "Git version cannot be determined.
 522
 523 $_git claims it is version '$_real_git_version'.
 524
 525 [appname] requires at least Git 1.5.0 or later.
 526
 527 Assume '$_real_git_version' is version 1.5.0?
 528 "] eq {yes}} {
 529                 set _git_version 1.5.0
 530         } else {
 531                 exit 1
 532         }
 533 }
 534 unset _real_git_version
 535
 536 proc git-version {args} {
 537         global _git_version
 538
 539         switch [llength $args] {
 540         0 {
 541                 return $_git_version
 542         }
 543
 544         2 {
 545                 set op [lindex $args 0]
 546                 set vr [lindex $args 1]
 547                 set cm [package vcompare $_git_version $vr]
 548                 return [expr $cm $op 0]
 549         }
 550
 551         4 {
 552                 set type [lindex $args 0]
 553                 set name [lindex $args 1]
 554                 set parm [lindex $args 2]
 555                 set body [lindex $args 3]
 556
 557                 if {($type ne {proc} && $type ne {method})} {
 558                         error "Invalid arguments to git-version"
 559                 }
 560                 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
 561                         error "Last arm of $type $name must be default"
 562                 }
 563
 564                 foreach {op vr cb} [lrange $body 0 end-2] {
 565                         if {[git-version $op $vr]} {
 566                                 return [uplevel [list $type $name $parm $cb]]
 567                         }
 568                 }
 569
 570                 return [uplevel [list $type $name $parm [lindex $body end]]]
 571         }
 572
 573         default {
 574                 error "git-version >= x"
 575         }
 576
 577         }
 578 }
 579
 580 if {[git-version < 1.5]} {
 581         catch {wm withdraw .}
 582         tk_messageBox \
 583                 -icon error \
 584                 -type ok \
 585                 -title "git-gui: fatal error" \
 586                 -message "[appname] requires Git 1.5.0 or later.
 587
 588 You are using [git-version]:
 589
 590 [git --version]"
 591         exit 1
 592 }
 593
 594 ######################################################################
 595 ##
 596 ## configure our library
 597
 598 set oguilib {@@GITGUI_LIBDIR@@}
 599 set oguirel {@@GITGUI_RELATIVE@@}
 600 if {$oguirel eq {1}} {
 601         set oguilib [file dirname [file dirname [file normalize $argv0]]]
 602         set oguilib [file join $oguilib share git-gui lib]
 603 } elseif {[string match @@* $oguirel]} {
 604         set oguilib [file join [file dirname [file normalize $argv0]] lib]
 605 }
 606
 607 set idx [file join $oguilib tclIndex]
 608 if {[catch {set fd [open $idx r]} err]} {
 609         catch {wm withdraw .}
 610         tk_messageBox \
 611                 -icon error \
 612                 -type ok \
 613                 -title "git-gui: fatal error" \
 614                 -message $err
 615         exit 1
 616 }
 617 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
 618         set idx [list]
 619         while {[gets $fd n] >= 0} {
 620                 if {$n ne {} && ![string match #* $n]} {
 621                         lappend idx $n
 622                 }
 623         }
 624 } else {
 625         set idx {}
 626 }
 627 close $fd
 628
 629 if {$idx ne {}} {
 630         set loaded [list]
 631         foreach p $idx {
 632                 if {[lsearch -exact $loaded $p] >= 0} continue
 633                 source [file join $oguilib $p]
 634                 lappend loaded $p
 635         }
 636         unset loaded p
 637 } else {
 638         set auto_path [concat [list $oguilib] $auto_path]
 639 }
 640 unset -nocomplain oguirel idx fd
 641
 642 ######################################################################
 643 ##
 644 ## feature option selection
 645
 646 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
 647         unset _junk
 648 } else {
 649         set subcommand gui
 650 }
 651 if {$subcommand eq {gui.sh}} {
 652         set subcommand gui
 653 }
 654 if {$subcommand eq {gui} && [llength $argv] > 0} {
 655         set subcommand [lindex $argv 0]
 656         set argv [lrange $argv 1 end]
 657 }
 658
 659 enable_option multicommit
 660 enable_option branch
 661 enable_option transport
 662 disable_option bare
 663
 664 switch -- $subcommand {
 665 browser -
 666 blame {
 667         enable_option bare
 668
 669         disable_option multicommit
 670         disable_option branch
 671         disable_option transport
 672 }
 673 citool {
 674         enable_option singlecommit
 675
 676         disable_option multicommit
 677         disable_option branch
 678         disable_option transport
 679 }
 680 }
 681
 682 ######################################################################
 683 ##
 684 ## repository setup
 685
 686 if {[catch {
 687                 set _gitdir $env(GIT_DIR)
 688                 set _prefix {}
 689                 }]
 690         && [catch {
 691                 set _gitdir [git rev-parse --git-dir]
 692                 set _prefix [git rev-parse --show-prefix]
 693         } err]} {
 694         catch {wm withdraw .}
 695         error_popup "Cannot find the git directory:\n\n$err"
 696         exit 1
 697 }
 698 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 699         catch {set _gitdir [exec cygpath --unix $_gitdir]}
 700 }
 701 if {![file isdirectory $_gitdir]} {
 702         catch {wm withdraw .}
 703         error_popup "Git directory not found:\n\n$_gitdir"
 704         exit 1
 705 }
 706 if {![is_enabled bare]} {
 707         if {[lindex [file split $_gitdir] end] ne {.git}} {
 708                 catch {wm withdraw .}
 709                 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 710                 exit 1
 711         }
 712         if {[catch {cd [file dirname $_gitdir]} err]} {
 713                 catch {wm withdraw .}
 714                 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 715                 exit 1
 716         }
 717 }
 718 set _reponame [file split [file normalize $_gitdir]]
 719 if {[lindex $_reponame end] eq {.git}} {
 720         set _reponame [lindex $_reponame end-1]
 721 } else {
 722         set _reponame [lindex $_reponame end]
 723 }
 724
 725 ######################################################################
 726 ##
 727 ## global init
 728
 729 set current_diff_path {}
 730 set current_diff_side {}
 731 set diff_actions [list]
 732
 733 set HEAD {}
 734 set PARENT {}
 735 set MERGE_HEAD [list]
 736 set commit_type {}
 737 set empty_tree {}
 738 set current_branch {}
 739 set is_detached 0
 740 set current_diff_path {}
 741 set selected_commit_type new
 742
 743 ######################################################################
 744 ##
 745 ## task management
 746
 747 set rescan_active 0
 748 set diff_active 0
 749 set last_clicked {}
 750
 751 set disable_on_lock [list]
 752 set index_lock_type none
 753
 754 proc lock_index {type} {
 755         global index_lock_type disable_on_lock
 756
 757         if {$index_lock_type eq {none}} {
 758                 set index_lock_type $type
 759                 foreach w $disable_on_lock {
 760                         uplevel #0 $w disabled
 761                 }
 762                 return 1
 763         } elseif {$index_lock_type eq "begin-$type"} {
 764                 set index_lock_type $type
 765                 return 1
 766         }
 767         return 0
 768 }
 769
 770 proc unlock_index {} {
 771         global index_lock_type disable_on_lock
 772
 773         set index_lock_type none
 774         foreach w $disable_on_lock {
 775                 uplevel #0 $w normal
 776         }
 777 }
 778
 779 ######################################################################
 780 ##
 781 ## status
 782
 783 proc repository_state {ctvar hdvar mhvar} {
 784         global current_branch
 785         upvar $ctvar ct $hdvar hd $mhvar mh
 786
 787         set mh [list]
 788
 789         load_current_branch
 790         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
 791                 set hd {}
 792                 set ct initial
 793                 return
 794         }
 795
 796         set merge_head [gitdir MERGE_HEAD]
 797         if {[file exists $merge_head]} {
 798                 set ct merge
 799                 set fd_mh [open $merge_head r]
 800                 while {[gets $fd_mh line] >= 0} {
 801                         lappend mh $line
 802                 }
 803                 close $fd_mh
 804                 return
 805         }
 806
 807         set ct normal
 808 }
 809
 810 proc PARENT {} {
 811         global PARENT empty_tree
 812
 813         set p [lindex $PARENT 0]
 814         if {$p ne {}} {
 815                 return $p
 816         }
 817         if {$empty_tree eq {}} {
 818                 set empty_tree [git mktree << {}]
 819         }
 820         return $empty_tree
 821 }
 822
 823 proc rescan {after {honor_trustmtime 1}} {
 824         global HEAD PARENT MERGE_HEAD commit_type
 825         global ui_index ui_workdir ui_comm
 826         global rescan_active file_states
 827         global repo_config
 828
 829         if {$rescan_active > 0 || ![lock_index read]} return
 830
 831         repository_state newType newHEAD newMERGE_HEAD
 832         if {[string match amend* $commit_type]
 833                 && $newType eq {normal}
 834                 && $newHEAD eq $HEAD} {
 835         } else {
 836                 set HEAD $newHEAD
 837                 set PARENT $newHEAD
 838                 set MERGE_HEAD $newMERGE_HEAD
 839                 set commit_type $newType
 840         }
 841
 842         array unset file_states
 843
 844         if {!$::GITGUI_BCK_exists &&
 845                 (![$ui_comm edit modified]
 846                 || [string trim [$ui_comm get 0.0 end]] eq {})} {
 847                 if {[string match amend* $commit_type]} {
 848                 } elseif {[load_message GITGUI_MSG]} {
 849                 } elseif {[load_message MERGE_MSG]} {
 850                 } elseif {[load_message SQUASH_MSG]} {
 851                 }
 852                 $ui_comm edit reset
 853                 $ui_comm edit modified false
 854         }
 855
 856         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 857                 rescan_stage2 {} $after
 858         } else {
 859                 set rescan_active 1
 860                 ui_status {Refreshing file status...}
 861                 set fd_rf [git_read update-index \
 862                         -q \
 863                         --unmerged \
 864                         --ignore-missing \
 865                         --refresh \
 866                         ]
 867                 fconfigure $fd_rf -blocking 0 -translation binary
 868                 fileevent $fd_rf readable \
 869                         [list rescan_stage2 $fd_rf $after]
 870         }
 871 }
 872
 873 proc rescan_stage2 {fd after} {
 874         global rescan_active buf_rdi buf_rdf buf_rlo
 875
 876         if {$fd ne {}} {
 877                 read $fd
 878                 if {![eof $fd]} return
 879                 close $fd
 880         }
 881
 882         set ls_others [list --exclude-per-directory=.gitignore]
 883         set info_exclude [gitdir info exclude]
 884         if {[file readable $info_exclude]} {
 885                 lappend ls_others "--exclude-from=$info_exclude"
 886         }
 887         set user_exclude [get_config core.excludesfile]
 888         if {$user_exclude ne {} && [file readable $user_exclude]} {
 889                 lappend ls_others "--exclude-from=$user_exclude"
 890         }
 891
 892         set buf_rdi {}
 893         set buf_rdf {}
 894         set buf_rlo {}
 895
 896         set rescan_active 3
 897         ui_status {Scanning for modified files ...}
 898         set fd_di [git_read diff-index --cached -z [PARENT]]
 899         set fd_df [git_read diff-files -z]
 900         set fd_lo [eval git_read ls-files --others -z $ls_others]
 901
 902         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 903         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 904         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 905         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 906         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 907         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 908 }
 909
 910 proc load_message {file} {
 911         global ui_comm
 912
 913         set f [gitdir $file]
 914         if {[file isfile $f]} {
 915                 if {[catch {set fd [open $f r]}]} {
 916                         return 0
 917                 }
 918                 fconfigure $fd -eofchar {}
 919                 set content [string trim [read $fd]]
 920                 close $fd
 921                 regsub -all -line {[ \r\t]+$} $content {} content
 922                 $ui_comm delete 0.0 end
 923                 $ui_comm insert end $content
 924                 return 1
 925         }
 926         return 0
 927 }
 928
 929 proc read_diff_index {fd after} {
 930         global buf_rdi
 931
 932         append buf_rdi [read $fd]
 933         set c 0
 934         set n [string length $buf_rdi]
 935         while {$c < $n} {
 936                 set z1 [string first "\0" $buf_rdi $c]
 937                 if {$z1 == -1} break
 938                 incr z1
 939                 set z2 [string first "\0" $buf_rdi $z1]
 940                 if {$z2 == -1} break
 941
 942                 incr c
 943                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 944                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 945                 merge_state \
 946                         [encoding convertfrom $p] \
 947                         [lindex $i 4]? \
 948                         [list [lindex $i 0] [lindex $i 2]] \
 949                         [list]
 950                 set c $z2
 951                 incr c
 952         }
 953         if {$c < $n} {
 954                 set buf_rdi [string range $buf_rdi $c end]
 955         } else {
 956                 set buf_rdi {}
 957         }
 958
 959         rescan_done $fd buf_rdi $after
 960 }
 961
 962 proc read_diff_files {fd after} {
 963         global buf_rdf
 964
 965         append buf_rdf [read $fd]
 966         set c 0
 967         set n [string length $buf_rdf]
 968         while {$c < $n} {
 969                 set z1 [string first "\0" $buf_rdf $c]
 970                 if {$z1 == -1} break
 971                 incr z1
 972                 set z2 [string first "\0" $buf_rdf $z1]
 973                 if {$z2 == -1} break
 974
 975                 incr c
 976                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 977                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 978                 merge_state \
 979                         [encoding convertfrom $p] \
 980                         ?[lindex $i 4] \
 981                         [list] \
 982                         [list [lindex $i 0] [lindex $i 2]]
 983                 set c $z2
 984                 incr c
 985         }
 986         if {$c < $n} {
 987                 set buf_rdf [string range $buf_rdf $c end]
 988         } else {
 989                 set buf_rdf {}
 990         }
 991
 992         rescan_done $fd buf_rdf $after
 993 }
 994
 995 proc read_ls_others {fd after} {
 996         global buf_rlo
 997
 998         append buf_rlo [read $fd]
 999         set pck [split $buf_rlo "\0"]
1000         set buf_rlo [lindex $pck end]
1001         foreach p [lrange $pck 0 end-1] {
1002                 merge_state [encoding convertfrom $p] ?O
1003         }
1004         rescan_done $fd buf_rlo $after
1005 }
1006
1007 proc rescan_done {fd buf after} {
1008         global rescan_active current_diff_path
1009         global file_states repo_config
1010         upvar $buf to_clear
1011
1012         if {![eof $fd]} return
1013         set to_clear {}
1014         close $fd
1015         if {[incr rescan_active -1] > 0} return
1016
1017         prune_selection
1018         unlock_index
1019         display_all_files
1020         if {$current_diff_path ne {}} reshow_diff
1021         uplevel #0 $after
1022 }
1023
1024 proc prune_selection {} {
1025         global file_states selected_paths
1026
1027         foreach path [array names selected_paths] {
1028                 if {[catch {set still_here $file_states($path)}]} {
1029                         unset selected_paths($path)
1030                 }
1031         }
1032 }
1033
1034 ######################################################################
1035 ##
1036 ## ui helpers
1037
1038 proc mapicon {w state path} {
1039         global all_icons
1040
1041         if {[catch {set r $all_icons($state$w)}]} {
1042                 puts "error: no icon for $w state={$state} $path"
1043                 return file_plain
1044         }
1045         return $r
1046 }
1047
1048 proc mapdesc {state path} {
1049         global all_descs
1050
1051         if {[catch {set r $all_descs($state)}]} {
1052                 puts "error: no desc for state={$state} $path"
1053                 return $state
1054         }
1055         return $r
1056 }
1057
1058 proc ui_status {msg} {
1059         $::main_status show $msg
1060 }
1061
1062 proc ui_ready {{test {}}} {
1063         $::main_status show {Ready.} $test
1064 }
1065
1066 proc escape_path {path} {
1067         regsub -all {\\} $path "\\\\" path
1068         regsub -all "\n" $path "\\n" path
1069         return $path
1070 }
1071
1072 proc short_path {path} {
1073         return [escape_path [lindex [file split $path] end]]
1074 }
1075
1076 set next_icon_id 0
1077 set null_sha1 [string repeat 0 40]
1078
1079 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1080         global file_states next_icon_id null_sha1
1081
1082         set s0 [string index $new_state 0]
1083         set s1 [string index $new_state 1]
1084
1085         if {[catch {set info $file_states($path)}]} {
1086                 set state __
1087                 set icon n[incr next_icon_id]
1088         } else {
1089                 set state [lindex $info 0]
1090                 set icon [lindex $info 1]
1091                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1092                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1093         }
1094
1095         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1096         elseif {$s0 eq {_}} {set s0 _}
1097
1098         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1099         elseif {$s1 eq {_}} {set s1 _}
1100
1101         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1102                 set head_info [list 0 $null_sha1]
1103         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1104                 && $head_info eq {}} {
1105                 set head_info $index_info
1106         }
1107
1108         set file_states($path) [list $s0$s1 $icon \
1109                 $head_info $index_info \
1110                 ]
1111         return $state
1112 }
1113
1114 proc display_file_helper {w path icon_name old_m new_m} {
1115         global file_lists
1116
1117         if {$new_m eq {_}} {
1118                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1119                 if {$lno >= 0} {
1120                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1121                         incr lno
1122                         $w conf -state normal
1123                         $w delete $lno.0 [expr {$lno + 1}].0
1124                         $w conf -state disabled
1125                 }
1126         } elseif {$old_m eq {_} && $new_m ne {_}} {
1127                 lappend file_lists($w) $path
1128                 set file_lists($w) [lsort -unique $file_lists($w)]
1129                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1130                 incr lno
1131                 $w conf -state normal
1132                 $w image create $lno.0 \
1133                         -align center -padx 5 -pady 1 \
1134                         -name $icon_name \
1135                         -image [mapicon $w $new_m $path]
1136                 $w insert $lno.1 "[escape_path $path]\n"
1137                 $w conf -state disabled
1138         } elseif {$old_m ne $new_m} {
1139                 $w conf -state normal
1140                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1141                 $w conf -state disabled
1142         }
1143 }
1144
1145 proc display_file {path state} {
1146         global file_states selected_paths
1147         global ui_index ui_workdir
1148
1149         set old_m [merge_state $path $state]
1150         set s $file_states($path)
1151         set new_m [lindex $s 0]
1152         set icon_name [lindex $s 1]
1153
1154         set o [string index $old_m 0]
1155         set n [string index $new_m 0]
1156         if {$o eq {U}} {
1157                 set o _
1158         }
1159         if {$n eq {U}} {
1160                 set n _
1161         }
1162         display_file_helper     $ui_index $path $icon_name $o $n
1163
1164         if {[string index $old_m 0] eq {U}} {
1165                 set o U
1166         } else {
1167                 set o [string index $old_m 1]
1168         }
1169         if {[string index $new_m 0] eq {U}} {
1170                 set n U
1171         } else {
1172                 set n [string index $new_m 1]
1173         }
1174         display_file_helper     $ui_workdir $path $icon_name $o $n
1175
1176         if {$new_m eq {__}} {
1177                 unset file_states($path)
1178                 catch {unset selected_paths($path)}
1179         }
1180 }
1181
1182 proc display_all_files_helper {w path icon_name m} {
1183         global file_lists
1184
1185         lappend file_lists($w) $path
1186         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1187         $w image create end \
1188                 -align center -padx 5 -pady 1 \
1189                 -name $icon_name \
1190                 -image [mapicon $w $m $path]
1191         $w insert end "[escape_path $path]\n"
1192 }
1193
1194 proc display_all_files {} {
1195         global ui_index ui_workdir
1196         global file_states file_lists
1197         global last_clicked
1198
1199         $ui_index conf -state normal
1200         $ui_workdir conf -state normal
1201
1202         $ui_index delete 0.0 end
1203         $ui_workdir delete 0.0 end
1204         set last_clicked {}
1205
1206         set file_lists($ui_index) [list]
1207         set file_lists($ui_workdir) [list]
1208
1209         foreach path [lsort [array names file_states]] {
1210                 set s $file_states($path)
1211                 set m [lindex $s 0]
1212                 set icon_name [lindex $s 1]
1213
1214                 set s [string index $m 0]
1215                 if {$s ne {U} && $s ne {_}} {
1216                         display_all_files_helper $ui_index $path \
1217                                 $icon_name $s
1218                 }
1219
1220                 if {[string index $m 0] eq {U}} {
1221                         set s U
1222                 } else {
1223                         set s [string index $m 1]
1224                 }
1225                 if {$s ne {_}} {
1226                         display_all_files_helper $ui_workdir $path \
1227                                 $icon_name $s
1228                 }
1229         }
1230
1231         $ui_index conf -state disabled
1232         $ui_workdir conf -state disabled
1233 }
1234
1235 ######################################################################
1236 ##
1237 ## icons
1238
1239 set filemask {
1240 #define mask_width 14
1241 #define mask_height 15
1242 static unsigned char mask_bits[] = {
1243    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1244    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1245    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1246 }
1247
1248 image create bitmap file_plain -background white -foreground black -data {
1249 #define plain_width 14
1250 #define plain_height 15
1251 static unsigned char plain_bits[] = {
1252    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1253    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1254    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1255 } -maskdata $filemask
1256
1257 image create bitmap file_mod -background white -foreground blue -data {
1258 #define mod_width 14
1259 #define mod_height 15
1260 static unsigned char mod_bits[] = {
1261    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1262    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1263    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1264 } -maskdata $filemask
1265
1266 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1267 #define file_fulltick_width 14
1268 #define file_fulltick_height 15
1269 static unsigned char file_fulltick_bits[] = {
1270    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1271    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1272    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1273 } -maskdata $filemask
1274
1275 image create bitmap file_parttick -background white -foreground "#005050" -data {
1276 #define parttick_width 14
1277 #define parttick_height 15
1278 static unsigned char parttick_bits[] = {
1279    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1280    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1281    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1282 } -maskdata $filemask
1283
1284 image create bitmap file_question -background white -foreground black -data {
1285 #define file_question_width 14
1286 #define file_question_height 15
1287 static unsigned char file_question_bits[] = {
1288    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1289    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1290    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1291 } -maskdata $filemask
1292
1293 image create bitmap file_removed -background white -foreground red -data {
1294 #define file_removed_width 14
1295 #define file_removed_height 15
1296 static unsigned char file_removed_bits[] = {
1297    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1298    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1299    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1300 } -maskdata $filemask
1301
1302 image create bitmap file_merge -background white -foreground blue -data {
1303 #define file_merge_width 14
1304 #define file_merge_height 15
1305 static unsigned char file_merge_bits[] = {
1306    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1307    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1308    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1309 } -maskdata $filemask
1310
1311 set ui_index .vpane.files.index.list
1312 set ui_workdir .vpane.files.workdir.list
1313
1314 set all_icons(_$ui_index)   file_plain
1315 set all_icons(A$ui_index)   file_fulltick
1316 set all_icons(M$ui_index)   file_fulltick
1317 set all_icons(D$ui_index)   file_removed
1318 set all_icons(U$ui_index)   file_merge
1319
1320 set all_icons(_$ui_workdir) file_plain
1321 set all_icons(M$ui_workdir) file_mod
1322 set all_icons(D$ui_workdir) file_question
1323 set all_icons(U$ui_workdir) file_merge
1324 set all_icons(O$ui_workdir) file_plain
1325
1326 set max_status_desc 0
1327 foreach i {
1328                 {__ "Unmodified"}
1329
1330                 {_M "Modified, not staged"}
1331                 {M_ "Staged for commit"}
1332                 {MM "Portions staged for commit"}
1333                 {MD "Staged for commit, missing"}
1334
1335                 {_O "Untracked, not staged"}
1336                 {A_ "Staged for commit"}
1337                 {AM "Portions staged for commit"}
1338                 {AD "Staged for commit, missing"}
1339
1340                 {_D "Missing"}
1341                 {D_ "Staged for removal"}
1342                 {DO "Staged for removal, still present"}
1343
1344                 {U_ "Requires merge resolution"}
1345                 {UU "Requires merge resolution"}
1346                 {UM "Requires merge resolution"}
1347                 {UD "Requires merge resolution"}
1348         } {
1349         if {$max_status_desc < [string length [lindex $i 1]]} {
1350                 set max_status_desc [string length [lindex $i 1]]
1351         }
1352         set all_descs([lindex $i 0]) [lindex $i 1]
1353 }
1354 unset i
1355
1356 ######################################################################
1357 ##
1358 ## util
1359
1360 proc bind_button3 {w cmd} {
1361         bind $w <Any-Button-3> $cmd
1362         if {[is_MacOSX]} {
1363                 # Mac OS X sends Button-2 on right click through three-button mouse,
1364                 # or through trackpad right-clicking (two-finger touch + click).
1365                 bind $w <Any-Button-2> $cmd
1366                 bind $w <Control-Button-1> $cmd
1367         }
1368 }
1369
1370 proc scrollbar2many {list mode args} {
1371         foreach w $list {eval $w $mode $args}
1372 }
1373
1374 proc many2scrollbar {list mode sb top bottom} {
1375         $sb set $top $bottom
1376         foreach w $list {$w $mode moveto $top}
1377 }
1378
1379 proc incr_font_size {font {amt 1}} {
1380         set sz [font configure $font -size]
1381         incr sz $amt
1382         font configure $font -size $sz
1383         font configure ${font}bold -size $sz
1384         font configure ${font}italic -size $sz
1385 }
1386
1387 ######################################################################
1388 ##
1389 ## ui commands
1390
1391 set starting_gitk_msg {Starting gitk... please wait...}
1392
1393 proc do_gitk {revs} {
1394         # -- Always start gitk through whatever we were loaded with.  This
1395         #    lets us bypass using shell process on Windows systems.
1396         #
1397         set exe [file join [file dirname $::_git] gitk]
1398         set cmd [list [info nameofexecutable] $exe]
1399         if {! [file exists $exe]} {
1400                 error_popup "Unable to start gitk:\n\n$exe does not exist"
1401         } else {
1402                 eval exec $cmd $revs &
1403                 ui_status $::starting_gitk_msg
1404                 after 10000 {
1405                         ui_ready $starting_gitk_msg
1406                 }
1407         }
1408 }
1409
1410 set is_quitting 0
1411
1412 proc do_quit {} {
1413         global ui_comm is_quitting repo_config commit_type
1414         global GITGUI_BCK_exists GITGUI_BCK_i
1415
1416         if {$is_quitting} return
1417         set is_quitting 1
1418
1419         if {[winfo exists $ui_comm]} {
1420                 # -- Stash our current commit buffer.
1421                 #
1422                 set save [gitdir GITGUI_MSG]
1423                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1424                         file rename -force [gitdir GITGUI_BCK] $save
1425                         set GITGUI_BCK_exists 0
1426                 } else {
1427                         set msg [string trim [$ui_comm get 0.0 end]]
1428                         regsub -all -line {[ \r\t]+$} $msg {} msg
1429                         if {(![string match amend* $commit_type]
1430                                 || [$ui_comm edit modified])
1431                                 && $msg ne {}} {
1432                                 catch {
1433                                         set fd [open $save w]
1434                                         puts -nonewline $fd $msg
1435                                         close $fd
1436                                 }
1437                         } else {
1438                                 catch {file delete $save}
1439                         }
1440                 }
1441
1442                 # -- Remove our editor backup, its not needed.
1443                 #
1444                 after cancel $GITGUI_BCK_i
1445                 if {$GITGUI_BCK_exists} {
1446                         catch {file delete [gitdir GITGUI_BCK]}
1447                 }
1448
1449                 # -- Stash our current window geometry into this repository.
1450                 #
1451                 set cfg_geometry [list]
1452                 lappend cfg_geometry [wm geometry .]
1453                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1454                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1455                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1456                         set rc_geometry {}
1457                 }
1458                 if {$cfg_geometry ne $rc_geometry} {
1459                         catch {git config gui.geometry $cfg_geometry}
1460                 }
1461         }
1462
1463         destroy .
1464 }
1465
1466 proc do_rescan {} {
1467         rescan ui_ready
1468 }
1469
1470 proc do_commit {} {
1471         commit_tree
1472 }
1473
1474 proc toggle_or_diff {w x y} {
1475         global file_states file_lists current_diff_path ui_index ui_workdir
1476         global last_clicked selected_paths
1477
1478         set pos [split [$w index @$x,$y] .]
1479         set lno [lindex $pos 0]
1480         set col [lindex $pos 1]
1481         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1482         if {$path eq {}} {
1483                 set last_clicked {}
1484                 return
1485         }
1486
1487         set last_clicked [list $w $lno]
1488         array unset selected_paths
1489         $ui_index tag remove in_sel 0.0 end
1490         $ui_workdir tag remove in_sel 0.0 end
1491
1492         if {$col == 0} {
1493                 if {$current_diff_path eq $path} {
1494                         set after {reshow_diff;}
1495                 } else {
1496                         set after {}
1497                 }
1498                 if {$w eq $ui_index} {
1499                         update_indexinfo \
1500                                 "Unstaging [short_path $path] from commit" \
1501                                 [list $path] \
1502                                 [concat $after [list ui_ready]]
1503                 } elseif {$w eq $ui_workdir} {
1504                         update_index \
1505                                 "Adding [short_path $path]" \
1506                                 [list $path] \
1507                                 [concat $after [list ui_ready]]
1508                 }
1509         } else {
1510                 show_diff $path $w $lno
1511         }
1512 }
1513
1514 proc add_one_to_selection {w x y} {
1515         global file_lists last_clicked selected_paths
1516
1517         set lno [lindex [split [$w index @$x,$y] .] 0]
1518         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1519         if {$path eq {}} {
1520                 set last_clicked {}
1521                 return
1522         }
1523
1524         if {$last_clicked ne {}
1525                 && [lindex $last_clicked 0] ne $w} {
1526                 array unset selected_paths
1527                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1528         }
1529
1530         set last_clicked [list $w $lno]
1531         if {[catch {set in_sel $selected_paths($path)}]} {
1532                 set in_sel 0
1533         }
1534         if {$in_sel} {
1535                 unset selected_paths($path)
1536                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1537         } else {
1538                 set selected_paths($path) 1
1539                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1540         }
1541 }
1542
1543 proc add_range_to_selection {w x y} {
1544         global file_lists last_clicked selected_paths
1545
1546         if {[lindex $last_clicked 0] ne $w} {
1547                 toggle_or_diff $w $x $y
1548                 return
1549         }
1550
1551         set lno [lindex [split [$w index @$x,$y] .] 0]
1552         set lc [lindex $last_clicked 1]
1553         if {$lc < $lno} {
1554                 set begin $lc
1555                 set end $lno
1556         } else {
1557                 set begin $lno
1558                 set end $lc
1559         }
1560
1561         foreach path [lrange $file_lists($w) \
1562                 [expr {$begin - 1}] \
1563                 [expr {$end - 1}]] {
1564                 set selected_paths($path) 1
1565         }
1566         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1567 }
1568
1569 ######################################################################
1570 ##
1571 ## config defaults
1572
1573 set cursor_ptr arrow
1574 font create font_diff -family Courier -size 10
1575 font create font_ui
1576 catch {
1577         label .dummy
1578         eval font configure font_ui [font actual [.dummy cget -font]]
1579         destroy .dummy
1580 }
1581
1582 font create font_uiitalic
1583 font create font_uibold
1584 font create font_diffbold
1585 font create font_diffitalic
1586
1587 foreach class {Button Checkbutton Entry Label
1588                 Labelframe Listbox Menu Message
1589                 Radiobutton Spinbox Text} {
1590         option add *$class.font font_ui
1591 }
1592 unset class
1593
1594 if {[is_Windows] || [is_MacOSX]} {
1595         option add *Menu.tearOff 0
1596 }
1597
1598 if {[is_MacOSX]} {
1599         set M1B M1
1600         set M1T Cmd
1601 } else {
1602         set M1B Control
1603         set M1T Ctrl
1604 }
1605
1606 proc apply_config {} {
1607         global repo_config font_descs
1608
1609         foreach option $font_descs {
1610                 set name [lindex $option 0]
1611                 set font [lindex $option 1]
1612                 if {[catch {
1613                         foreach {cn cv} $repo_config(gui.$name) {
1614                                 font configure $font $cn $cv
1615                         }
1616                         } err]} {
1617                         error_popup "Invalid font specified in gui.$name:\n\n$err"
1618                 }
1619                 foreach {cn cv} [font configure $font] {
1620                         font configure ${font}bold $cn $cv
1621                         font configure ${font}italic $cn $cv
1622                 }
1623                 font configure ${font}bold -weight bold
1624                 font configure ${font}italic -slant italic
1625         }
1626 }
1627
1628 set default_config(merge.diffstat) true
1629 set default_config(merge.summary) false
1630 set default_config(merge.verbosity) 2
1631 set default_config(user.name) {}
1632 set default_config(user.email) {}
1633
1634 set default_config(gui.matchtrackingbranch) false
1635 set default_config(gui.pruneduringfetch) false
1636 set default_config(gui.trustmtime) false
1637 set default_config(gui.diffcontext) 5
1638 set default_config(gui.newbranchtemplate) {}
1639 set default_config(gui.fontui) [font configure font_ui]
1640 set default_config(gui.fontdiff) [font configure font_diff]
1641 set font_descs {
1642         {fontui   font_ui   {Main Font}}
1643         {fontdiff font_diff {Diff/Console Font}}
1644 }
1645 load_config 0
1646 apply_config
1647
1648 ######################################################################
1649 ##
1650 ## ui construction
1651
1652 set ui_comm {}
1653
1654 # -- Menu Bar
1655 #
1656 menu .mbar -tearoff 0
1657 .mbar add cascade -label Repository -menu .mbar.repository
1658 .mbar add cascade -label Edit -menu .mbar.edit
1659 if {[is_enabled branch]} {
1660         .mbar add cascade -label Branch -menu .mbar.branch
1661 }
1662 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1663         .mbar add cascade -label Commit -menu .mbar.commit
1664 }
1665 if {[is_enabled transport]} {
1666         .mbar add cascade -label Merge -menu .mbar.merge
1667         .mbar add cascade -label Fetch -menu .mbar.fetch
1668         .mbar add cascade -label Push -menu .mbar.push
1669 }
1670 . configure -menu .mbar
1671
1672 # -- Repository Menu
1673 #
1674 menu .mbar.repository
1675
1676 .mbar.repository add command \
1677         -label {Browse Current Branch's Files} \
1678         -command {browser::new $current_branch}
1679 set ui_browse_current [.mbar.repository index last]
1680 .mbar.repository add command \
1681         -label {Browse Branch Files...} \
1682         -command browser_open::dialog
1683 .mbar.repository add separator
1684
1685 .mbar.repository add command \
1686         -label {Visualize Current Branch's History} \
1687         -command {do_gitk $current_branch}
1688 set ui_visualize_current [.mbar.repository index last]
1689 .mbar.repository add command \
1690         -label {Visualize All Branch History} \
1691         -command {do_gitk --all}
1692 .mbar.repository add separator
1693
1694 proc current_branch_write {args} {
1695         global current_branch
1696         .mbar.repository entryconf $::ui_browse_current \
1697                 -label "Browse $current_branch's Files"
1698         .mbar.repository entryconf $::ui_visualize_current \
1699                 -label "Visualize $current_branch's History"
1700 }
1701 trace add variable current_branch write current_branch_write
1702
1703 if {[is_enabled multicommit]} {
1704         .mbar.repository add command -label {Database Statistics} \
1705                 -command do_stats
1706
1707         .mbar.repository add command -label {Compress Database} \
1708                 -command do_gc
1709
1710         .mbar.repository add command -label {Verify Database} \
1711                 -command do_fsck_objects
1712
1713         .mbar.repository add separator
1714
1715         if {[is_Cygwin]} {
1716                 .mbar.repository add command \
1717                         -label {Create Desktop Icon} \
1718                         -command do_cygwin_shortcut
1719         } elseif {[is_Windows]} {
1720                 .mbar.repository add command \
1721                         -label {Create Desktop Icon} \
1722                         -command do_windows_shortcut
1723         } elseif {[is_MacOSX]} {
1724                 .mbar.repository add command \
1725                         -label {Create Desktop Icon} \
1726                         -command do_macosx_app
1727         }
1728 }
1729
1730 .mbar.repository add command -label Quit \
1731         -command do_quit \
1732         -accelerator $M1T-Q
1733
1734 # -- Edit Menu
1735 #
1736 menu .mbar.edit
1737 .mbar.edit add command -label Undo \
1738         -command {catch {[focus] edit undo}} \
1739         -accelerator $M1T-Z
1740 .mbar.edit add command -label Redo \
1741         -command {catch {[focus] edit redo}} \
1742         -accelerator $M1T-Y
1743 .mbar.edit add separator
1744 .mbar.edit add command -label Cut \
1745         -command {catch {tk_textCut [focus]}} \
1746         -accelerator $M1T-X
1747 .mbar.edit add command -label Copy \
1748         -command {catch {tk_textCopy [focus]}} \
1749         -accelerator $M1T-C
1750 .mbar.edit add command -label Paste \
1751         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1752         -accelerator $M1T-V
1753 .mbar.edit add command -label Delete \
1754         -command {catch {[focus] delete sel.first sel.last}} \
1755         -accelerator Del
1756 .mbar.edit add separator
1757 .mbar.edit add command -label {Select All} \
1758         -command {catch {[focus] tag add sel 0.0 end}} \
1759         -accelerator $M1T-A
1760
1761 # -- Branch Menu
1762 #
1763 if {[is_enabled branch]} {
1764         menu .mbar.branch
1765
1766         .mbar.branch add command -label {Create...} \
1767                 -command branch_create::dialog \
1768                 -accelerator $M1T-N
1769         lappend disable_on_lock [list .mbar.branch entryconf \
1770                 [.mbar.branch index last] -state]
1771
1772         .mbar.branch add command -label {Checkout...} \
1773                 -command branch_checkout::dialog \
1774                 -accelerator $M1T-O
1775         lappend disable_on_lock [list .mbar.branch entryconf \
1776                 [.mbar.branch index last] -state]
1777
1778         .mbar.branch add command -label {Rename...} \
1779                 -command branch_rename::dialog
1780         lappend disable_on_lock [list .mbar.branch entryconf \
1781                 [.mbar.branch index last] -state]
1782
1783         .mbar.branch add command -label {Delete...} \
1784                 -command branch_delete::dialog
1785         lappend disable_on_lock [list .mbar.branch entryconf \
1786                 [.mbar.branch index last] -state]
1787
1788         .mbar.branch add command -label {Reset...} \
1789                 -command merge::reset_hard
1790         lappend disable_on_lock [list .mbar.branch entryconf \
1791                 [.mbar.branch index last] -state]
1792 }
1793
1794 # -- Commit Menu
1795 #
1796 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1797         menu .mbar.commit
1798
1799         .mbar.commit add radiobutton \
1800                 -label {New Commit} \
1801                 -command do_select_commit_type \
1802                 -variable selected_commit_type \
1803                 -value new
1804         lappend disable_on_lock \
1805                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1806
1807         .mbar.commit add radiobutton \
1808                 -label {Amend Last Commit} \
1809                 -command do_select_commit_type \
1810                 -variable selected_commit_type \
1811                 -value amend
1812         lappend disable_on_lock \
1813                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1814
1815         .mbar.commit add separator
1816
1817         .mbar.commit add command -label Rescan \
1818                 -command do_rescan \
1819                 -accelerator F5
1820         lappend disable_on_lock \
1821                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1822
1823         .mbar.commit add command -label {Stage To Commit} \
1824                 -command do_add_selection
1825         lappend disable_on_lock \
1826                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1827
1828         .mbar.commit add command -label {Stage Changed Files To Commit} \
1829                 -command do_add_all \
1830                 -accelerator $M1T-I
1831         lappend disable_on_lock \
1832                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1833
1834         .mbar.commit add command -label {Unstage From Commit} \
1835                 -command do_unstage_selection
1836         lappend disable_on_lock \
1837                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1838
1839         .mbar.commit add command -label {Revert Changes} \
1840                 -command do_revert_selection
1841         lappend disable_on_lock \
1842                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1843
1844         .mbar.commit add separator
1845
1846         .mbar.commit add command -label {Sign Off} \
1847                 -command do_signoff \
1848                 -accelerator $M1T-S
1849
1850         .mbar.commit add command -label Commit \
1851                 -command do_commit \
1852                 -accelerator $M1T-Return
1853         lappend disable_on_lock \
1854                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1855 }
1856
1857 # -- Merge Menu
1858 #
1859 if {[is_enabled branch]} {
1860         menu .mbar.merge
1861         .mbar.merge add command -label {Local Merge...} \
1862                 -command merge::dialog \
1863                 -accelerator $M1T-M
1864         lappend disable_on_lock \
1865                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1866         .mbar.merge add command -label {Abort Merge...} \
1867                 -command merge::reset_hard
1868         lappend disable_on_lock \
1869                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1870 }
1871
1872 # -- Transport Menu
1873 #
1874 if {[is_enabled transport]} {
1875         menu .mbar.fetch
1876
1877         menu .mbar.push
1878         .mbar.push add command -label {Push...} \
1879                 -command do_push_anywhere \
1880                 -accelerator $M1T-P
1881         .mbar.push add command -label {Delete...} \
1882                 -command remote_branch_delete::dialog
1883 }
1884
1885 if {[is_MacOSX]} {
1886         # -- Apple Menu (Mac OS X only)
1887         #
1888         .mbar add cascade -label Apple -menu .mbar.apple
1889         menu .mbar.apple
1890
1891         .mbar.apple add command -label "About [appname]" \
1892                 -command do_about
1893         .mbar.apple add command -label "Options..." \
1894                 -command do_options
1895 } else {
1896         # -- Edit Menu
1897         #
1898         .mbar.edit add separator
1899         .mbar.edit add command -label {Options...} \
1900                 -command do_options
1901 }
1902
1903 # -- Help Menu
1904 #
1905 .mbar add cascade -label Help -menu .mbar.help
1906 menu .mbar.help
1907
1908 if {![is_MacOSX]} {
1909         .mbar.help add command -label "About [appname]" \
1910                 -command do_about
1911 }
1912
1913 set browser {}
1914 catch {set browser $repo_config(instaweb.browser)}
1915 set doc_path [file dirname [gitexec]]
1916 set doc_path [file join $doc_path Documentation index.html]
1917
1918 if {[is_Cygwin]} {
1919         set doc_path [exec cygpath --mixed $doc_path]
1920 }
1921
1922 if {$browser eq {}} {
1923         if {[is_MacOSX]} {
1924                 set browser open
1925         } elseif {[is_Cygwin]} {
1926                 set program_files [file dirname [exec cygpath --windir]]
1927                 set program_files [file join $program_files {Program Files}]
1928                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1929                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1930                 if {[file exists $firefox]} {
1931                         set browser $firefox
1932                 } elseif {[file exists $ie]} {
1933                         set browser $ie
1934                 }
1935                 unset program_files firefox ie
1936         }
1937 }
1938
1939 if {[file isfile $doc_path]} {
1940         set doc_url "file:$doc_path"
1941 } else {
1942         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1943 }
1944
1945 if {$browser ne {}} {
1946         .mbar.help add command -label {Online Documentation} \
1947                 -command [list exec $browser $doc_url &]
1948 }
1949 unset browser doc_path doc_url
1950
1951 set root_exists 0
1952 bind . <Visibility> {
1953         bind . <Visibility> {}
1954         set root_exists 1
1955 }
1956
1957 # -- Standard bindings
1958 #
1959 wm protocol . WM_DELETE_WINDOW do_quit
1960 bind all <$M1B-Key-q> do_quit
1961 bind all <$M1B-Key-Q> do_quit
1962 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1963 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1964
1965 set subcommand_args {}
1966 proc usage {} {
1967         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1968         exit 1
1969 }
1970
1971 # -- Not a normal commit type invocation?  Do that instead!
1972 #
1973 switch -- $subcommand {
1974 browser -
1975 blame {
1976         set subcommand_args {rev? path}
1977         if {$argv eq {}} usage
1978         set head {}
1979         set path {}
1980         set is_path 0
1981         foreach a $argv {
1982                 if {$is_path || [file exists $_prefix$a]} {
1983                         if {$path ne {}} usage
1984                         set path $_prefix$a
1985                         break
1986                 } elseif {$a eq {--}} {
1987                         if {$path ne {}} {
1988                                 if {$head ne {}} usage
1989                                 set head $path
1990                                 set path {}
1991                         }
1992                         set is_path 1
1993                 } elseif {$head eq {}} {
1994                         if {$head ne {}} usage
1995                         set head $a
1996                         set is_path 1
1997                 } else {
1998                         usage
1999                 }
2000         }
2001         unset is_path
2002
2003         if {$head ne {} && $path eq {}} {
2004                 set path $_prefix$head
2005                 set head {}
2006         }
2007
2008         if {$head eq {}} {
2009                 load_current_branch
2010         } else {
2011                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2012                         if {[catch {
2013                                         set head [git rev-parse --verify $head]
2014                                 } err]} {
2015                                 puts stderr $err
2016                                 exit 1
2017                         }
2018                 }
2019                 set current_branch $head
2020         }
2021
2022         switch -- $subcommand {
2023         browser {
2024                 if {$head eq {}} {
2025                         if {$path ne {} && [file isdirectory $path]} {
2026                                 set head $current_branch
2027                         } else {
2028                                 set head $path
2029                                 set path {}
2030                         }
2031                 }
2032                 browser::new $head $path
2033         }
2034         blame   {
2035                 if {$head eq {} && ![file exists $path]} {
2036                         puts stderr "fatal: cannot stat path $path: No such file or directory"
2037                         exit 1
2038                 }
2039                 blame::new $head $path
2040         }
2041         }
2042         return
2043 }
2044 citool -
2045 gui {
2046         if {[llength $argv] != 0} {
2047                 puts -nonewline stderr "usage: $argv0"
2048                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2049                         puts -nonewline stderr " $subcommand"
2050                 }
2051                 puts stderr {}
2052                 exit 1
2053         }
2054         # fall through to setup UI for commits
2055 }
2056 default {
2057         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2058         exit 1
2059 }
2060 }
2061
2062 # -- Branch Control
2063 #
2064 frame .branch \
2065         -borderwidth 1 \
2066         -relief sunken
2067 label .branch.l1 \
2068         -text {Current Branch:} \
2069         -anchor w \
2070         -justify left
2071 label .branch.cb \
2072         -textvariable current_branch \
2073         -anchor w \
2074         -justify left
2075 pack .branch.l1 -side left
2076 pack .branch.cb -side left -fill x
2077 pack .branch -side top -fill x
2078
2079 # -- Main Window Layout
2080 #
2081 panedwindow .vpane -orient vertical
2082 panedwindow .vpane.files -orient horizontal
2083 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2084 pack .vpane -anchor n -side top -fill both -expand 1
2085
2086 # -- Index File List
2087 #
2088 frame .vpane.files.index -height 100 -width 200
2089 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2090         -background lightgreen
2091 text $ui_index -background white -borderwidth 0 \
2092         -width 20 -height 10 \
2093         -wrap none \
2094         -cursor $cursor_ptr \
2095         -xscrollcommand {.vpane.files.index.sx set} \
2096         -yscrollcommand {.vpane.files.index.sy set} \
2097         -state disabled
2098 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2099 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2100 pack .vpane.files.index.title -side top -fill x
2101 pack .vpane.files.index.sx -side bottom -fill x
2102 pack .vpane.files.index.sy -side right -fill y
2103 pack $ui_index -side left -fill both -expand 1
2104 .vpane.files add .vpane.files.index -sticky nsew
2105
2106 # -- Working Directory File List
2107 #
2108 frame .vpane.files.workdir -height 100 -width 200
2109 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2110         -background lightsalmon
2111 text $ui_workdir -background white -borderwidth 0 \
2112         -width 20 -height 10 \
2113         -wrap none \
2114         -cursor $cursor_ptr \
2115         -xscrollcommand {.vpane.files.workdir.sx set} \
2116         -yscrollcommand {.vpane.files.workdir.sy set} \
2117         -state disabled
2118 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2119 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2120 pack .vpane.files.workdir.title -side top -fill x
2121 pack .vpane.files.workdir.sx -side bottom -fill x
2122 pack .vpane.files.workdir.sy -side right -fill y
2123 pack $ui_workdir -side left -fill both -expand 1
2124 .vpane.files add .vpane.files.workdir -sticky nsew
2125
2126 foreach i [list $ui_index $ui_workdir] {
2127         $i tag conf in_diff -background lightgray
2128         $i tag conf in_sel  -background lightgray
2129 }
2130 unset i
2131
2132 # -- Diff and Commit Area
2133 #
2134 frame .vpane.lower -height 300 -width 400
2135 frame .vpane.lower.commarea
2136 frame .vpane.lower.diff -relief sunken -borderwidth 1
2137 pack .vpane.lower.commarea -side top -fill x
2138 pack .vpane.lower.diff -side bottom -fill both -expand 1
2139 .vpane add .vpane.lower -sticky nsew
2140
2141 # -- Commit Area Buttons
2142 #
2143 frame .vpane.lower.commarea.buttons
2144 label .vpane.lower.commarea.buttons.l -text {} \
2145         -anchor w \
2146         -justify left
2147 pack .vpane.lower.commarea.buttons.l -side top -fill x
2148 pack .vpane.lower.commarea.buttons -side left -fill y
2149
2150 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2151         -command do_rescan
2152 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2153 lappend disable_on_lock \
2154         {.vpane.lower.commarea.buttons.rescan conf -state}
2155
2156 button .vpane.lower.commarea.buttons.incall -text {Stage Changed} \
2157         -command do_add_all
2158 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2159 lappend disable_on_lock \
2160         {.vpane.lower.commarea.buttons.incall conf -state}
2161
2162 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2163         -command do_signoff
2164 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2165
2166 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2167         -command do_commit
2168 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2169 lappend disable_on_lock \
2170         {.vpane.lower.commarea.buttons.commit conf -state}
2171
2172 button .vpane.lower.commarea.buttons.push -text {Push} \
2173         -command do_push_anywhere
2174 pack .vpane.lower.commarea.buttons.push -side top -fill x
2175
2176 # -- Commit Message Buffer
2177 #
2178 frame .vpane.lower.commarea.buffer
2179 frame .vpane.lower.commarea.buffer.header
2180 set ui_comm .vpane.lower.commarea.buffer.t
2181 set ui_coml .vpane.lower.commarea.buffer.header.l
2182 radiobutton .vpane.lower.commarea.buffer.header.new \
2183         -text {New Commit} \
2184         -command do_select_commit_type \
2185         -variable selected_commit_type \
2186         -value new
2187 lappend disable_on_lock \
2188         [list .vpane.lower.commarea.buffer.header.new conf -state]
2189 radiobutton .vpane.lower.commarea.buffer.header.amend \
2190         -text {Amend Last Commit} \
2191         -command do_select_commit_type \
2192         -variable selected_commit_type \
2193         -value amend
2194 lappend disable_on_lock \
2195         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2196 label $ui_coml \
2197         -anchor w \
2198         -justify left
2199 proc trace_commit_type {varname args} {
2200         global ui_coml commit_type
2201         switch -glob -- $commit_type {
2202         initial       {set txt {Initial Commit Message:}}
2203         amend         {set txt {Amended Commit Message:}}
2204         amend-initial {set txt {Amended Initial Commit Message:}}
2205         amend-merge   {set txt {Amended Merge Commit Message:}}
2206         merge         {set txt {Merge Commit Message:}}
2207         *             {set txt {Commit Message:}}
2208         }
2209         $ui_coml conf -text $txt
2210 }
2211 trace add variable commit_type write trace_commit_type
2212 pack $ui_coml -side left -fill x
2213 pack .vpane.lower.commarea.buffer.header.amend -side right
2214 pack .vpane.lower.commarea.buffer.header.new -side right
2215
2216 text $ui_comm -background white -borderwidth 1 \
2217         -undo true \
2218         -maxundo 20 \
2219         -autoseparators true \
2220         -relief sunken \
2221         -width 75 -height 9 -wrap none \
2222         -font font_diff \
2223         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2224 scrollbar .vpane.lower.commarea.buffer.sby \
2225         -command [list $ui_comm yview]
2226 pack .vpane.lower.commarea.buffer.header -side top -fill x
2227 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2228 pack $ui_comm -side left -fill y
2229 pack .vpane.lower.commarea.buffer -side left -fill y
2230
2231 # -- Commit Message Buffer Context Menu
2232 #
2233 set ctxm .vpane.lower.commarea.buffer.ctxm
2234 menu $ctxm -tearoff 0
2235 $ctxm add command \
2236         -label {Cut} \
2237         -command {tk_textCut $ui_comm}
2238 $ctxm add command \
2239         -label {Copy} \
2240         -command {tk_textCopy $ui_comm}
2241 $ctxm add command \
2242         -label {Paste} \
2243         -command {tk_textPaste $ui_comm}
2244 $ctxm add command \
2245         -label {Delete} \
2246         -command {$ui_comm delete sel.first sel.last}
2247 $ctxm add separator
2248 $ctxm add command \
2249         -label {Select All} \
2250         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2251 $ctxm add command \
2252         -label {Copy All} \
2253         -command {
2254                 $ui_comm tag add sel 0.0 end
2255                 tk_textCopy $ui_comm
2256                 $ui_comm tag remove sel 0.0 end
2257         }
2258 $ctxm add separator
2259 $ctxm add command \
2260         -label {Sign Off} \
2261         -command do_signoff
2262 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2263
2264 # -- Diff Header
2265 #
2266 proc trace_current_diff_path {varname args} {
2267         global current_diff_path diff_actions file_states
2268         if {$current_diff_path eq {}} {
2269                 set s {}
2270                 set f {}
2271                 set p {}
2272                 set o disabled
2273         } else {
2274                 set p $current_diff_path
2275                 set s [mapdesc [lindex $file_states($p) 0] $p]
2276                 set f {File:}
2277                 set p [escape_path $p]
2278                 set o normal
2279         }
2280
2281         .vpane.lower.diff.header.status configure -text $s
2282         .vpane.lower.diff.header.file configure -text $f
2283         .vpane.lower.diff.header.path configure -text $p
2284         foreach w $diff_actions {
2285                 uplevel #0 $w $o
2286         }
2287 }
2288 trace add variable current_diff_path write trace_current_diff_path
2289
2290 frame .vpane.lower.diff.header -background gold
2291 label .vpane.lower.diff.header.status \
2292         -background gold \
2293         -width $max_status_desc \
2294         -anchor w \
2295         -justify left
2296 label .vpane.lower.diff.header.file \
2297         -background gold \
2298         -anchor w \
2299         -justify left
2300 label .vpane.lower.diff.header.path \
2301         -background gold \
2302         -anchor w \
2303         -justify left
2304 pack .vpane.lower.diff.header.status -side left
2305 pack .vpane.lower.diff.header.file -side left
2306 pack .vpane.lower.diff.header.path -fill x
2307 set ctxm .vpane.lower.diff.header.ctxm
2308 menu $ctxm -tearoff 0
2309 $ctxm add command \
2310         -label {Copy} \
2311         -command {
2312                 clipboard clear
2313                 clipboard append \
2314                         -format STRING \
2315                         -type STRING \
2316                         -- $current_diff_path
2317         }
2318 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2319 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2320
2321 # -- Diff Body
2322 #
2323 frame .vpane.lower.diff.body
2324 set ui_diff .vpane.lower.diff.body.t
2325 text $ui_diff -background white -borderwidth 0 \
2326         -width 80 -height 15 -wrap none \
2327         -font font_diff \
2328         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2329         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2330         -state disabled
2331 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2332         -command [list $ui_diff xview]
2333 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2334         -command [list $ui_diff yview]
2335 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2336 pack .vpane.lower.diff.body.sby -side right -fill y
2337 pack $ui_diff -side left -fill both -expand 1
2338 pack .vpane.lower.diff.header -side top -fill x
2339 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2340
2341 $ui_diff tag conf d_cr -elide true
2342 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2343 $ui_diff tag conf d_+ -foreground {#00a000}
2344 $ui_diff tag conf d_- -foreground red
2345
2346 $ui_diff tag conf d_++ -foreground {#00a000}
2347 $ui_diff tag conf d_-- -foreground red
2348 $ui_diff tag conf d_+s \
2349         -foreground {#00a000} \
2350         -background {#e2effa}
2351 $ui_diff tag conf d_-s \
2352         -foreground red \
2353         -background {#e2effa}
2354 $ui_diff tag conf d_s+ \
2355         -foreground {#00a000} \
2356         -background ivory1
2357 $ui_diff tag conf d_s- \
2358         -foreground red \
2359         -background ivory1
2360
2361 $ui_diff tag conf d<<<<<<< \
2362         -foreground orange \
2363         -font font_diffbold
2364 $ui_diff tag conf d======= \
2365         -foreground orange \
2366         -font font_diffbold
2367 $ui_diff tag conf d>>>>>>> \
2368         -foreground orange \
2369         -font font_diffbold
2370
2371 $ui_diff tag raise sel
2372
2373 # -- Diff Body Context Menu
2374 #
2375 set ctxm .vpane.lower.diff.body.ctxm
2376 menu $ctxm -tearoff 0
2377 $ctxm add command \
2378         -label {Refresh} \
2379         -command reshow_diff
2380 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2381 $ctxm add command \
2382         -label {Copy} \
2383         -command {tk_textCopy $ui_diff}
2384 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2385 $ctxm add command \
2386         -label {Select All} \
2387         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2388 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2389 $ctxm add command \
2390         -label {Copy All} \
2391         -command {
2392                 $ui_diff tag add sel 0.0 end
2393                 tk_textCopy $ui_diff
2394                 $ui_diff tag remove sel 0.0 end
2395         }
2396 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2397 $ctxm add separator
2398 $ctxm add command \
2399         -label {Apply/Reverse Hunk} \
2400         -command {apply_hunk $cursorX $cursorY}
2401 set ui_diff_applyhunk [$ctxm index last]
2402 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2403 $ctxm add separator
2404 $ctxm add command \
2405         -label {Decrease Font Size} \
2406         -command {incr_font_size font_diff -1}
2407 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2408 $ctxm add command \
2409         -label {Increase Font Size} \
2410         -command {incr_font_size font_diff 1}
2411 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2412 $ctxm add separator
2413 $ctxm add command \
2414         -label {Show Less Context} \
2415         -command {if {$repo_config(gui.diffcontext) >= 1} {
2416                 incr repo_config(gui.diffcontext) -1
2417                 reshow_diff
2418         }}
2419 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2420 $ctxm add command \
2421         -label {Show More Context} \
2422         -command {if {$repo_config(gui.diffcontext) < 99} {
2423                 incr repo_config(gui.diffcontext)
2424                 reshow_diff
2425         }}
2426 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2427 $ctxm add separator
2428 $ctxm add command -label {Options...} \
2429         -command do_options
2430 proc popup_diff_menu {ctxm x y X Y} {
2431         global current_diff_path file_states
2432         set ::cursorX $x
2433         set ::cursorY $y
2434         if {$::ui_index eq $::current_diff_side} {
2435                 $ctxm entryconf $::ui_diff_applyhunk \
2436                         -state normal \
2437                         -label {Unstage Hunk From Commit}
2438         } elseif {$current_diff_path eq {}
2439                 || ![info exists file_states($current_diff_path)]
2440                 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2441                 $ctxm entryconf $::ui_diff_applyhunk \
2442                         -state disabled \
2443                         -label {Stage Hunk For Commit}
2444         } else {
2445                 $ctxm entryconf $::ui_diff_applyhunk \
2446                         -state normal \
2447                         -label {Stage Hunk For Commit}
2448         }
2449         tk_popup $ctxm $X $Y
2450 }
2451 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2452
2453 # -- Status Bar
2454 #
2455 set main_status [::status_bar::new .status]
2456 pack .status -anchor w -side bottom -fill x
2457 $main_status show {Initializing...}
2458
2459 # -- Load geometry
2460 #
2461 catch {
2462 set gm $repo_config(gui.geometry)
2463 wm geometry . [lindex $gm 0]
2464 .vpane sash place 0 \
2465         [lindex [.vpane sash coord 0] 0] \
2466         [lindex $gm 1]
2467 .vpane.files sash place 0 \
2468         [lindex $gm 2] \
2469         [lindex [.vpane.files sash coord 0] 1]
2470 unset gm
2471 }
2472
2473 # -- Key Bindings
2474 #
2475 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2476 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2477 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2478 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2479 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2480 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2481 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2482 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2483 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2484 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2485 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2486
2487 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2488 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2489 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2490 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2491 bind $ui_diff <$M1B-Key-v> {break}
2492 bind $ui_diff <$M1B-Key-V> {break}
2493 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2494 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2495 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2496 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2497 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2498 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2499 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2500 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2501 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2502 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2503 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2504 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2505 bind $ui_diff <Button-1>   {focus %W}
2506
2507 if {[is_enabled branch]} {
2508         bind . <$M1B-Key-n> branch_create::dialog
2509         bind . <$M1B-Key-N> branch_create::dialog
2510         bind . <$M1B-Key-o> branch_checkout::dialog
2511         bind . <$M1B-Key-O> branch_checkout::dialog
2512         bind . <$M1B-Key-m> merge::dialog
2513         bind . <$M1B-Key-M> merge::dialog
2514 }
2515 if {[is_enabled transport]} {
2516         bind . <$M1B-Key-p> do_push_anywhere
2517         bind . <$M1B-Key-P> do_push_anywhere
2518 }
2519
2520 bind .   <Key-F5>     do_rescan
2521 bind .   <$M1B-Key-r> do_rescan
2522 bind .   <$M1B-Key-R> do_rescan
2523 bind .   <$M1B-Key-s> do_signoff
2524 bind .   <$M1B-Key-S> do_signoff
2525 bind .   <$M1B-Key-i> do_add_all
2526 bind .   <$M1B-Key-I> do_add_all
2527 bind .   <$M1B-Key-Return> do_commit
2528 foreach i [list $ui_index $ui_workdir] {
2529         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2530         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2531         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2532 }
2533 unset i
2534
2535 set file_lists($ui_index) [list]
2536 set file_lists($ui_workdir) [list]
2537
2538 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2539 focus -force $ui_comm
2540
2541 # -- Warn the user about environmental problems.  Cygwin's Tcl
2542 #    does *not* pass its env array onto any processes it spawns.
2543 #    This means that git processes get none of our environment.
2544 #
2545 if {[is_Cygwin]} {
2546         set ignored_env 0
2547         set suggest_user {}
2548         set msg "Possible environment issues exist.
2549
2550 The following environment variables are probably
2551 going to be ignored by any Git subprocess run
2552 by [appname]:
2553
2554 "
2555         foreach name [array names env] {
2556                 switch -regexp -- $name {
2557                 {^GIT_INDEX_FILE$} -
2558                 {^GIT_OBJECT_DIRECTORY$} -
2559                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2560                 {^GIT_DIFF_OPTS$} -
2561                 {^GIT_EXTERNAL_DIFF$} -
2562                 {^GIT_PAGER$} -
2563                 {^GIT_TRACE$} -
2564                 {^GIT_CONFIG$} -
2565                 {^GIT_CONFIG_LOCAL$} -
2566                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2567                         append msg " - $name\n"
2568                         incr ignored_env
2569                 }
2570                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2571                         append msg " - $name\n"
2572                         incr ignored_env
2573                         set suggest_user $name
2574                 }
2575                 }
2576         }
2577         if {$ignored_env > 0} {
2578                 append msg "
2579 This is due to a known issue with the
2580 Tcl binary distributed by Cygwin."
2581
2582                 if {$suggest_user ne {}} {
2583                         append msg "
2584
2585 A good replacement for $suggest_user
2586 is placing values for the user.name and
2587 user.email settings into your personal
2588 ~/.gitconfig file.
2589 "
2590                 }
2591                 warn_popup $msg
2592         }
2593         unset ignored_env msg suggest_user name
2594 }
2595
2596 # -- Only initialize complex UI if we are going to stay running.
2597 #
2598 if {[is_enabled transport]} {
2599         load_all_remotes
2600
2601         populate_fetch_menu
2602         populate_push_menu
2603 }
2604
2605 if {[winfo exists $ui_comm]} {
2606         set GITGUI_BCK_exists [load_message GITGUI_BCK]
2607
2608         # -- If both our backup and message files exist use the
2609         #    newer of the two files to initialize the buffer.
2610         #
2611         if {$GITGUI_BCK_exists} {
2612                 set m [gitdir GITGUI_MSG]
2613                 if {[file isfile $m]} {
2614                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2615                                 catch {file delete [gitdir GITGUI_MSG]}
2616                         } else {
2617                                 $ui_comm delete 0.0 end
2618                                 $ui_comm edit reset
2619                                 $ui_comm edit modified false
2620                                 catch {file delete [gitdir GITGUI_BCK]}
2621                                 set GITGUI_BCK_exists 0
2622                         }
2623                 }
2624                 unset m
2625         }
2626
2627         proc backup_commit_buffer {} {
2628                 global ui_comm GITGUI_BCK_exists
2629
2630                 set m [$ui_comm edit modified]
2631                 if {$m || $GITGUI_BCK_exists} {
2632                         set msg [string trim [$ui_comm get 0.0 end]]
2633                         regsub -all -line {[ \r\t]+$} $msg {} msg
2634
2635                         if {$msg eq {}} {
2636                                 if {$GITGUI_BCK_exists} {
2637                                         catch {file delete [gitdir GITGUI_BCK]}
2638                                         set GITGUI_BCK_exists 0
2639                                 }
2640                         } elseif {$m} {
2641                                 catch {
2642                                         set fd [open [gitdir GITGUI_BCK] w]
2643                                         puts -nonewline $fd $msg
2644                                         close $fd
2645                                         set GITGUI_BCK_exists 1
2646                                 }
2647                         }
2648
2649                         $ui_comm edit modified false
2650                 }
2651
2652                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2653         }
2654
2655         backup_commit_buffer
2656 }
2657
2658 lock_index begin-read
2659 if {![winfo ismapped .]} {
2660         wm deiconify .
2661 }
2662 after 1 do_rescan
2663 if {[is_enabled multicommit]} {
2664         after 1000 hint_gc
2665 }