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