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 if {[is_Cygwin]} {
 911         set is_git_info_link {}
 912         set is_git_info_exclude {}
 913         proc have_info_exclude {} {
 914                 global is_git_info_link is_git_info_exclude
 915
 916                 if {$is_git_info_link eq {}} {
 917                         set is_git_info_link [file isfile [gitdir info.lnk]]
 918                 }
 919
 920                 if {$is_git_info_link} {
 921                         if {$is_git_info_exclude eq {}} {
 922                                 if {[catch {exec test -f [gitdir info exclude]}]} {
 923                                         set is_git_info_exclude 0
 924                                 } else {
 925                                         set is_git_info_exclude 1
 926                                 }
 927                         }
 928                         return $is_git_info_exclude
 929                 } else {
 930                         return [file readable [gitdir info exclude]]
 931                 }
 932         }
 933 } else {
 934         proc have_info_exclude {} {
 935                 return [file readable [gitdir info exclude]]
 936         }
 937 }
 938
 939 proc rescan_stage2 {fd after} {
 940         global rescan_active buf_rdi buf_rdf buf_rlo
 941
 942         if {$fd ne {}} {
 943                 read $fd
 944                 if {![eof $fd]} return
 945                 close $fd
 946         }
 947
 948         set ls_others [list --exclude-per-directory=.gitignore]
 949         if {[have_info_exclude]} {
 950                 lappend ls_others "--exclude-from=[gitdir info exclude]"
 951         }
 952         set user_exclude [get_config core.excludesfile]
 953         if {$user_exclude ne {} && [file readable $user_exclude]} {
 954                 lappend ls_others "--exclude-from=$user_exclude"
 955         }
 956
 957         set buf_rdi {}
 958         set buf_rdf {}
 959         set buf_rlo {}
 960
 961         set rescan_active 3
 962         ui_status {Scanning for modified files ...}
 963         set fd_di [git_read diff-index --cached -z [PARENT]]
 964         set fd_df [git_read diff-files -z]
 965         set fd_lo [eval git_read ls-files --others -z $ls_others]
 966
 967         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 968         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 969         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 970         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 971         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 972         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 973 }
 974
 975 proc load_message {file} {
 976         global ui_comm
 977
 978         set f [gitdir $file]
 979         if {[file isfile $f]} {
 980                 if {[catch {set fd [open $f r]}]} {
 981                         return 0
 982                 }
 983                 fconfigure $fd -eofchar {}
 984                 set content [string trim [read $fd]]
 985                 close $fd
 986                 regsub -all -line {[ \r\t]+$} $content {} content
 987                 $ui_comm delete 0.0 end
 988                 $ui_comm insert end $content
 989                 return 1
 990         }
 991         return 0
 992 }
 993
 994 proc read_diff_index {fd after} {
 995         global buf_rdi
 996
 997         append buf_rdi [read $fd]
 998         set c 0
 999         set n [string length $buf_rdi]
1000         while {$c < $n} {
1001                 set z1 [string first "\0" $buf_rdi $c]
1002                 if {$z1 == -1} break
1003                 incr z1
1004                 set z2 [string first "\0" $buf_rdi $z1]
1005                 if {$z2 == -1} break
1006
1007                 incr c
1008                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1009                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1010                 merge_state \
1011                         [encoding convertfrom $p] \
1012                         [lindex $i 4]? \
1013                         [list [lindex $i 0] [lindex $i 2]] \
1014                         [list]
1015                 set c $z2
1016                 incr c
1017         }
1018         if {$c < $n} {
1019                 set buf_rdi [string range $buf_rdi $c end]
1020         } else {
1021                 set buf_rdi {}
1022         }
1023
1024         rescan_done $fd buf_rdi $after
1025 }
1026
1027 proc read_diff_files {fd after} {
1028         global buf_rdf
1029
1030         append buf_rdf [read $fd]
1031         set c 0
1032         set n [string length $buf_rdf]
1033         while {$c < $n} {
1034                 set z1 [string first "\0" $buf_rdf $c]
1035                 if {$z1 == -1} break
1036                 incr z1
1037                 set z2 [string first "\0" $buf_rdf $z1]
1038                 if {$z2 == -1} break
1039
1040                 incr c
1041                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1042                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1043                 merge_state \
1044                         [encoding convertfrom $p] \
1045                         ?[lindex $i 4] \
1046                         [list] \
1047                         [list [lindex $i 0] [lindex $i 2]]
1048                 set c $z2
1049                 incr c
1050         }
1051         if {$c < $n} {
1052                 set buf_rdf [string range $buf_rdf $c end]
1053         } else {
1054                 set buf_rdf {}
1055         }
1056
1057         rescan_done $fd buf_rdf $after
1058 }
1059
1060 proc read_ls_others {fd after} {
1061         global buf_rlo
1062
1063         append buf_rlo [read $fd]
1064         set pck [split $buf_rlo "\0"]
1065         set buf_rlo [lindex $pck end]
1066         foreach p [lrange $pck 0 end-1] {
1067                 set p [encoding convertfrom $p]
1068                 if {[string index $p end] eq {/}} {
1069                         set p [string range $p 0 end-1]
1070                 }
1071                 merge_state $p ?O
1072         }
1073         rescan_done $fd buf_rlo $after
1074 }
1075
1076 proc rescan_done {fd buf after} {
1077         global rescan_active current_diff_path
1078         global file_states repo_config
1079         upvar $buf to_clear
1080
1081         if {![eof $fd]} return
1082         set to_clear {}
1083         close $fd
1084         if {[incr rescan_active -1] > 0} return
1085
1086         prune_selection
1087         unlock_index
1088         display_all_files
1089         if {$current_diff_path ne {}} reshow_diff
1090         uplevel #0 $after
1091 }
1092
1093 proc prune_selection {} {
1094         global file_states selected_paths
1095
1096         foreach path [array names selected_paths] {
1097                 if {[catch {set still_here $file_states($path)}]} {
1098                         unset selected_paths($path)
1099                 }
1100         }
1101 }
1102
1103 ######################################################################
1104 ##
1105 ## ui helpers
1106
1107 proc mapicon {w state path} {
1108         global all_icons
1109
1110         if {[catch {set r $all_icons($state$w)}]} {
1111                 puts "error: no icon for $w state={$state} $path"
1112                 return file_plain
1113         }
1114         return $r
1115 }
1116
1117 proc mapdesc {state path} {
1118         global all_descs
1119
1120         if {[catch {set r $all_descs($state)}]} {
1121                 puts "error: no desc for state={$state} $path"
1122                 return $state
1123         }
1124         return $r
1125 }
1126
1127 proc ui_status {msg} {
1128         $::main_status show $msg
1129 }
1130
1131 proc ui_ready {{test {}}} {
1132         $::main_status show {Ready.} $test
1133 }
1134
1135 proc escape_path {path} {
1136         regsub -all {\\} $path "\\\\" path
1137         regsub -all "\n" $path "\\n" path
1138         return $path
1139 }
1140
1141 proc short_path {path} {
1142         return [escape_path [lindex [file split $path] end]]
1143 }
1144
1145 set next_icon_id 0
1146 set null_sha1 [string repeat 0 40]
1147
1148 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1149         global file_states next_icon_id null_sha1
1150
1151         set s0 [string index $new_state 0]
1152         set s1 [string index $new_state 1]
1153
1154         if {[catch {set info $file_states($path)}]} {
1155                 set state __
1156                 set icon n[incr next_icon_id]
1157         } else {
1158                 set state [lindex $info 0]
1159                 set icon [lindex $info 1]
1160                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1161                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1162         }
1163
1164         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1165         elseif {$s0 eq {_}} {set s0 _}
1166
1167         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1168         elseif {$s1 eq {_}} {set s1 _}
1169
1170         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1171                 set head_info [list 0 $null_sha1]
1172         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1173                 && $head_info eq {}} {
1174                 set head_info $index_info
1175         }
1176
1177         set file_states($path) [list $s0$s1 $icon \
1178                 $head_info $index_info \
1179                 ]
1180         return $state
1181 }
1182
1183 proc display_file_helper {w path icon_name old_m new_m} {
1184         global file_lists
1185
1186         if {$new_m eq {_}} {
1187                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1188                 if {$lno >= 0} {
1189                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1190                         incr lno
1191                         $w conf -state normal
1192                         $w delete $lno.0 [expr {$lno + 1}].0
1193                         $w conf -state disabled
1194                 }
1195         } elseif {$old_m eq {_} && $new_m ne {_}} {
1196                 lappend file_lists($w) $path
1197                 set file_lists($w) [lsort -unique $file_lists($w)]
1198                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1199                 incr lno
1200                 $w conf -state normal
1201                 $w image create $lno.0 \
1202                         -align center -padx 5 -pady 1 \
1203                         -name $icon_name \
1204                         -image [mapicon $w $new_m $path]
1205                 $w insert $lno.1 "[escape_path $path]\n"
1206                 $w conf -state disabled
1207         } elseif {$old_m ne $new_m} {
1208                 $w conf -state normal
1209                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1210                 $w conf -state disabled
1211         }
1212 }
1213
1214 proc display_file {path state} {
1215         global file_states selected_paths
1216         global ui_index ui_workdir
1217
1218         set old_m [merge_state $path $state]
1219         set s $file_states($path)
1220         set new_m [lindex $s 0]
1221         set icon_name [lindex $s 1]
1222
1223         set o [string index $old_m 0]
1224         set n [string index $new_m 0]
1225         if {$o eq {U}} {
1226                 set o _
1227         }
1228         if {$n eq {U}} {
1229                 set n _
1230         }
1231         display_file_helper     $ui_index $path $icon_name $o $n
1232
1233         if {[string index $old_m 0] eq {U}} {
1234                 set o U
1235         } else {
1236                 set o [string index $old_m 1]
1237         }
1238         if {[string index $new_m 0] eq {U}} {
1239                 set n U
1240         } else {
1241                 set n [string index $new_m 1]
1242         }
1243         display_file_helper     $ui_workdir $path $icon_name $o $n
1244
1245         if {$new_m eq {__}} {
1246                 unset file_states($path)
1247                 catch {unset selected_paths($path)}
1248         }
1249 }
1250
1251 proc display_all_files_helper {w path icon_name m} {
1252         global file_lists
1253
1254         lappend file_lists($w) $path
1255         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1256         $w image create end \
1257                 -align center -padx 5 -pady 1 \
1258                 -name $icon_name \
1259                 -image [mapicon $w $m $path]
1260         $w insert end "[escape_path $path]\n"
1261 }
1262
1263 proc display_all_files {} {
1264         global ui_index ui_workdir
1265         global file_states file_lists
1266         global last_clicked
1267
1268         $ui_index conf -state normal
1269         $ui_workdir conf -state normal
1270
1271         $ui_index delete 0.0 end
1272         $ui_workdir delete 0.0 end
1273         set last_clicked {}
1274
1275         set file_lists($ui_index) [list]
1276         set file_lists($ui_workdir) [list]
1277
1278         foreach path [lsort [array names file_states]] {
1279                 set s $file_states($path)
1280                 set m [lindex $s 0]
1281                 set icon_name [lindex $s 1]
1282
1283                 set s [string index $m 0]
1284                 if {$s ne {U} && $s ne {_}} {
1285                         display_all_files_helper $ui_index $path \
1286                                 $icon_name $s
1287                 }
1288
1289                 if {[string index $m 0] eq {U}} {
1290                         set s U
1291                 } else {
1292                         set s [string index $m 1]
1293                 }
1294                 if {$s ne {_}} {
1295                         display_all_files_helper $ui_workdir $path \
1296                                 $icon_name $s
1297                 }
1298         }
1299
1300         $ui_index conf -state disabled
1301         $ui_workdir conf -state disabled
1302 }
1303
1304 ######################################################################
1305 ##
1306 ## icons
1307
1308 set filemask {
1309 #define mask_width 14
1310 #define mask_height 15
1311 static unsigned char mask_bits[] = {
1312    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1313    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1314    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1315 }
1316
1317 image create bitmap file_plain -background white -foreground black -data {
1318 #define plain_width 14
1319 #define plain_height 15
1320 static unsigned char plain_bits[] = {
1321    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1322    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1323    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1324 } -maskdata $filemask
1325
1326 image create bitmap file_mod -background white -foreground blue -data {
1327 #define mod_width 14
1328 #define mod_height 15
1329 static unsigned char mod_bits[] = {
1330    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1331    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1332    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1333 } -maskdata $filemask
1334
1335 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1336 #define file_fulltick_width 14
1337 #define file_fulltick_height 15
1338 static unsigned char file_fulltick_bits[] = {
1339    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1340    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1341    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1342 } -maskdata $filemask
1343
1344 image create bitmap file_parttick -background white -foreground "#005050" -data {
1345 #define parttick_width 14
1346 #define parttick_height 15
1347 static unsigned char parttick_bits[] = {
1348    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1349    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1350    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1351 } -maskdata $filemask
1352
1353 image create bitmap file_question -background white -foreground black -data {
1354 #define file_question_width 14
1355 #define file_question_height 15
1356 static unsigned char file_question_bits[] = {
1357    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1358    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1359    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1360 } -maskdata $filemask
1361
1362 image create bitmap file_removed -background white -foreground red -data {
1363 #define file_removed_width 14
1364 #define file_removed_height 15
1365 static unsigned char file_removed_bits[] = {
1366    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1367    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1368    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1369 } -maskdata $filemask
1370
1371 image create bitmap file_merge -background white -foreground blue -data {
1372 #define file_merge_width 14
1373 #define file_merge_height 15
1374 static unsigned char file_merge_bits[] = {
1375    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1376    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1377    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1378 } -maskdata $filemask
1379
1380 set ui_index .vpane.files.index.list
1381 set ui_workdir .vpane.files.workdir.list
1382
1383 set all_icons(_$ui_index)   file_plain
1384 set all_icons(A$ui_index)   file_fulltick
1385 set all_icons(M$ui_index)   file_fulltick
1386 set all_icons(D$ui_index)   file_removed
1387 set all_icons(U$ui_index)   file_merge
1388
1389 set all_icons(_$ui_workdir) file_plain
1390 set all_icons(M$ui_workdir) file_mod
1391 set all_icons(D$ui_workdir) file_question
1392 set all_icons(U$ui_workdir) file_merge
1393 set all_icons(O$ui_workdir) file_plain
1394
1395 set max_status_desc 0
1396 foreach i {
1397                 {__ "Unmodified"}
1398
1399                 {_M "Modified, not staged"}
1400                 {M_ "Staged for commit"}
1401                 {MM "Portions staged for commit"}
1402                 {MD "Staged for commit, missing"}
1403
1404                 {_O "Untracked, not staged"}
1405                 {A_ "Staged for commit"}
1406                 {AM "Portions staged for commit"}
1407                 {AD "Staged for commit, missing"}
1408
1409                 {_D "Missing"}
1410                 {D_ "Staged for removal"}
1411                 {DO "Staged for removal, still present"}
1412
1413                 {U_ "Requires merge resolution"}
1414                 {UU "Requires merge resolution"}
1415                 {UM "Requires merge resolution"}
1416                 {UD "Requires merge resolution"}
1417         } {
1418         if {$max_status_desc < [string length [lindex $i 1]]} {
1419                 set max_status_desc [string length [lindex $i 1]]
1420         }
1421         set all_descs([lindex $i 0]) [lindex $i 1]
1422 }
1423 unset i
1424
1425 ######################################################################
1426 ##
1427 ## util
1428
1429 proc bind_button3 {w cmd} {
1430         bind $w <Any-Button-3> $cmd
1431         if {[is_MacOSX]} {
1432                 # Mac OS X sends Button-2 on right click through three-button mouse,
1433                 # or through trackpad right-clicking (two-finger touch + click).
1434                 bind $w <Any-Button-2> $cmd
1435                 bind $w <Control-Button-1> $cmd
1436         }
1437 }
1438
1439 proc scrollbar2many {list mode args} {
1440         foreach w $list {eval $w $mode $args}
1441 }
1442
1443 proc many2scrollbar {list mode sb top bottom} {
1444         $sb set $top $bottom
1445         foreach w $list {$w $mode moveto $top}
1446 }
1447
1448 proc incr_font_size {font {amt 1}} {
1449         set sz [font configure $font -size]
1450         incr sz $amt
1451         font configure $font -size $sz
1452         font configure ${font}bold -size $sz
1453         font configure ${font}italic -size $sz
1454 }
1455
1456 ######################################################################
1457 ##
1458 ## ui commands
1459
1460 set starting_gitk_msg {Starting gitk... please wait...}
1461
1462 proc do_gitk {revs} {
1463         # -- Always start gitk through whatever we were loaded with.  This
1464         #    lets us bypass using shell process on Windows systems.
1465         #
1466         set exe [file join [file dirname $::_git] gitk]
1467         set cmd [list [info nameofexecutable] $exe]
1468         if {! [file exists $exe]} {
1469                 error_popup "Unable to start gitk:\n\n$exe does not exist"
1470         } else {
1471                 eval exec $cmd $revs &
1472                 ui_status $::starting_gitk_msg
1473                 after 10000 {
1474                         ui_ready $starting_gitk_msg
1475                 }
1476         }
1477 }
1478
1479 set is_quitting 0
1480
1481 proc do_quit {} {
1482         global ui_comm is_quitting repo_config commit_type
1483         global GITGUI_BCK_exists GITGUI_BCK_i
1484
1485         if {$is_quitting} return
1486         set is_quitting 1
1487
1488         if {[winfo exists $ui_comm]} {
1489                 # -- Stash our current commit buffer.
1490                 #
1491                 set save [gitdir GITGUI_MSG]
1492                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1493                         file rename -force [gitdir GITGUI_BCK] $save
1494                         set GITGUI_BCK_exists 0
1495                 } else {
1496                         set msg [string trim [$ui_comm get 0.0 end]]
1497                         regsub -all -line {[ \r\t]+$} $msg {} msg
1498                         if {(![string match amend* $commit_type]
1499                                 || [$ui_comm edit modified])
1500                                 && $msg ne {}} {
1501                                 catch {
1502                                         set fd [open $save w]
1503                                         puts -nonewline $fd $msg
1504                                         close $fd
1505                                 }
1506                         } else {
1507                                 catch {file delete $save}
1508                         }
1509                 }
1510
1511                 # -- Remove our editor backup, its not needed.
1512                 #
1513                 after cancel $GITGUI_BCK_i
1514                 if {$GITGUI_BCK_exists} {
1515                         catch {file delete [gitdir GITGUI_BCK]}
1516                 }
1517
1518                 # -- Stash our current window geometry into this repository.
1519                 #
1520                 set cfg_geometry [list]
1521                 lappend cfg_geometry [wm geometry .]
1522                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1523                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1524                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1525                         set rc_geometry {}
1526                 }
1527                 if {$cfg_geometry ne $rc_geometry} {
1528                         catch {git config gui.geometry $cfg_geometry}
1529                 }
1530         }
1531
1532         destroy .
1533 }
1534
1535 proc do_rescan {} {
1536         rescan ui_ready
1537 }
1538
1539 proc do_commit {} {
1540         commit_tree
1541 }
1542
1543 proc toggle_or_diff {w x y} {
1544         global file_states file_lists current_diff_path ui_index ui_workdir
1545         global last_clicked selected_paths
1546
1547         set pos [split [$w index @$x,$y] .]
1548         set lno [lindex $pos 0]
1549         set col [lindex $pos 1]
1550         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1551         if {$path eq {}} {
1552                 set last_clicked {}
1553                 return
1554         }
1555
1556         set last_clicked [list $w $lno]
1557         array unset selected_paths
1558         $ui_index tag remove in_sel 0.0 end
1559         $ui_workdir tag remove in_sel 0.0 end
1560
1561         if {$col == 0} {
1562                 if {$current_diff_path eq $path} {
1563                         set after {reshow_diff;}
1564                 } else {
1565                         set after {}
1566                 }
1567                 if {$w eq $ui_index} {
1568                         update_indexinfo \
1569                                 "Unstaging [short_path $path] from commit" \
1570                                 [list $path] \
1571                                 [concat $after [list ui_ready]]
1572                 } elseif {$w eq $ui_workdir} {
1573                         update_index \
1574                                 "Adding [short_path $path]" \
1575                                 [list $path] \
1576                                 [concat $after [list ui_ready]]
1577                 }
1578         } else {
1579                 show_diff $path $w $lno
1580         }
1581 }
1582
1583 proc add_one_to_selection {w x y} {
1584         global file_lists last_clicked selected_paths
1585
1586         set lno [lindex [split [$w index @$x,$y] .] 0]
1587         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1588         if {$path eq {}} {
1589                 set last_clicked {}
1590                 return
1591         }
1592
1593         if {$last_clicked ne {}
1594                 && [lindex $last_clicked 0] ne $w} {
1595                 array unset selected_paths
1596                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1597         }
1598
1599         set last_clicked [list $w $lno]
1600         if {[catch {set in_sel $selected_paths($path)}]} {
1601                 set in_sel 0
1602         }
1603         if {$in_sel} {
1604                 unset selected_paths($path)
1605                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1606         } else {
1607                 set selected_paths($path) 1
1608                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1609         }
1610 }
1611
1612 proc add_range_to_selection {w x y} {
1613         global file_lists last_clicked selected_paths
1614
1615         if {[lindex $last_clicked 0] ne $w} {
1616                 toggle_or_diff $w $x $y
1617                 return
1618         }
1619
1620         set lno [lindex [split [$w index @$x,$y] .] 0]
1621         set lc [lindex $last_clicked 1]
1622         if {$lc < $lno} {
1623                 set begin $lc
1624                 set end $lno
1625         } else {
1626                 set begin $lno
1627                 set end $lc
1628         }
1629
1630         foreach path [lrange $file_lists($w) \
1631                 [expr {$begin - 1}] \
1632                 [expr {$end - 1}]] {
1633                 set selected_paths($path) 1
1634         }
1635         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1636 }
1637
1638 ######################################################################
1639 ##
1640 ## config defaults
1641
1642 set cursor_ptr arrow
1643 font create font_diff -family Courier -size 10
1644 font create font_ui
1645 catch {
1646         label .dummy
1647         eval font configure font_ui [font actual [.dummy cget -font]]
1648         destroy .dummy
1649 }
1650
1651 font create font_uiitalic
1652 font create font_uibold
1653 font create font_diffbold
1654 font create font_diffitalic
1655
1656 foreach class {Button Checkbutton Entry Label
1657                 Labelframe Listbox Menu Message
1658                 Radiobutton Spinbox Text} {
1659         option add *$class.font font_ui
1660 }
1661 unset class
1662
1663 if {[is_Windows] || [is_MacOSX]} {
1664         option add *Menu.tearOff 0
1665 }
1666
1667 if {[is_MacOSX]} {
1668         set M1B M1
1669         set M1T Cmd
1670 } else {
1671         set M1B Control
1672         set M1T Ctrl
1673 }
1674
1675 proc apply_config {} {
1676         global repo_config font_descs
1677
1678         foreach option $font_descs {
1679                 set name [lindex $option 0]
1680                 set font [lindex $option 1]
1681                 if {[catch {
1682                         foreach {cn cv} $repo_config(gui.$name) {
1683                                 font configure $font $cn $cv -weight normal
1684                         }
1685                         } err]} {
1686                         error_popup "Invalid font specified in gui.$name:\n\n$err"
1687                 }
1688                 foreach {cn cv} [font configure $font] {
1689                         font configure ${font}bold $cn $cv
1690                         font configure ${font}italic $cn $cv
1691                 }
1692                 font configure ${font}bold -weight bold
1693                 font configure ${font}italic -slant italic
1694         }
1695 }
1696
1697 set default_config(merge.diffstat) true
1698 set default_config(merge.summary) false
1699 set default_config(merge.verbosity) 2
1700 set default_config(user.name) {}
1701 set default_config(user.email) {}
1702
1703 set default_config(gui.matchtrackingbranch) false
1704 set default_config(gui.pruneduringfetch) false
1705 set default_config(gui.trustmtime) false
1706 set default_config(gui.diffcontext) 5
1707 set default_config(gui.newbranchtemplate) {}
1708 set default_config(gui.fontui) [font configure font_ui]
1709 set default_config(gui.fontdiff) [font configure font_diff]
1710 set font_descs {
1711         {fontui   font_ui   {Main Font}}
1712         {fontdiff font_diff {Diff/Console Font}}
1713 }
1714 load_config 0
1715 apply_config
1716
1717 ######################################################################
1718 ##
1719 ## ui construction
1720
1721 set ui_comm {}
1722
1723 # -- Menu Bar
1724 #
1725 menu .mbar -tearoff 0
1726 .mbar add cascade -label Repository -menu .mbar.repository
1727 .mbar add cascade -label Edit -menu .mbar.edit
1728 if {[is_enabled branch]} {
1729         .mbar add cascade -label Branch -menu .mbar.branch
1730 }
1731 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1732         .mbar add cascade -label Commit -menu .mbar.commit
1733 }
1734 if {[is_enabled transport]} {
1735         .mbar add cascade -label Merge -menu .mbar.merge
1736         .mbar add cascade -label Fetch -menu .mbar.fetch
1737         .mbar add cascade -label Push -menu .mbar.push
1738 }
1739 . configure -menu .mbar
1740
1741 # -- Repository Menu
1742 #
1743 menu .mbar.repository
1744
1745 .mbar.repository add command \
1746         -label {Browse Current Branch's Files} \
1747         -command {browser::new $current_branch}
1748 set ui_browse_current [.mbar.repository index last]
1749 .mbar.repository add command \
1750         -label {Browse Branch Files...} \
1751         -command browser_open::dialog
1752 .mbar.repository add separator
1753
1754 .mbar.repository add command \
1755         -label {Visualize Current Branch's History} \
1756         -command {do_gitk $current_branch}
1757 set ui_visualize_current [.mbar.repository index last]
1758 .mbar.repository add command \
1759         -label {Visualize All Branch History} \
1760         -command {do_gitk --all}
1761 .mbar.repository add separator
1762
1763 proc current_branch_write {args} {
1764         global current_branch
1765         .mbar.repository entryconf $::ui_browse_current \
1766                 -label "Browse $current_branch's Files"
1767         .mbar.repository entryconf $::ui_visualize_current \
1768                 -label "Visualize $current_branch's History"
1769 }
1770 trace add variable current_branch write current_branch_write
1771
1772 if {[is_enabled multicommit]} {
1773         .mbar.repository add command -label {Database Statistics} \
1774                 -command do_stats
1775
1776         .mbar.repository add command -label {Compress Database} \
1777                 -command do_gc
1778
1779         .mbar.repository add command -label {Verify Database} \
1780                 -command do_fsck_objects
1781
1782         .mbar.repository add separator
1783
1784         if {[is_Cygwin]} {
1785                 .mbar.repository add command \
1786                         -label {Create Desktop Icon} \
1787                         -command do_cygwin_shortcut
1788         } elseif {[is_Windows]} {
1789                 .mbar.repository add command \
1790                         -label {Create Desktop Icon} \
1791                         -command do_windows_shortcut
1792         } elseif {[is_MacOSX]} {
1793                 .mbar.repository add command \
1794                         -label {Create Desktop Icon} \
1795                         -command do_macosx_app
1796         }
1797 }
1798
1799 .mbar.repository add command -label Quit \
1800         -command do_quit \
1801         -accelerator $M1T-Q
1802
1803 # -- Edit Menu
1804 #
1805 menu .mbar.edit
1806 .mbar.edit add command -label Undo \
1807         -command {catch {[focus] edit undo}} \
1808         -accelerator $M1T-Z
1809 .mbar.edit add command -label Redo \
1810         -command {catch {[focus] edit redo}} \
1811         -accelerator $M1T-Y
1812 .mbar.edit add separator
1813 .mbar.edit add command -label Cut \
1814         -command {catch {tk_textCut [focus]}} \
1815         -accelerator $M1T-X
1816 .mbar.edit add command -label Copy \
1817         -command {catch {tk_textCopy [focus]}} \
1818         -accelerator $M1T-C
1819 .mbar.edit add command -label Paste \
1820         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1821         -accelerator $M1T-V
1822 .mbar.edit add command -label Delete \
1823         -command {catch {[focus] delete sel.first sel.last}} \
1824         -accelerator Del
1825 .mbar.edit add separator
1826 .mbar.edit add command -label {Select All} \
1827         -command {catch {[focus] tag add sel 0.0 end}} \
1828         -accelerator $M1T-A
1829
1830 # -- Branch Menu
1831 #
1832 if {[is_enabled branch]} {
1833         menu .mbar.branch
1834
1835         .mbar.branch add command -label {Create...} \
1836                 -command branch_create::dialog \
1837                 -accelerator $M1T-N
1838         lappend disable_on_lock [list .mbar.branch entryconf \
1839                 [.mbar.branch index last] -state]
1840
1841         .mbar.branch add command -label {Checkout...} \
1842                 -command branch_checkout::dialog \
1843                 -accelerator $M1T-O
1844         lappend disable_on_lock [list .mbar.branch entryconf \
1845                 [.mbar.branch index last] -state]
1846
1847         .mbar.branch add command -label {Rename...} \
1848                 -command branch_rename::dialog
1849         lappend disable_on_lock [list .mbar.branch entryconf \
1850                 [.mbar.branch index last] -state]
1851
1852         .mbar.branch add command -label {Delete...} \
1853                 -command branch_delete::dialog
1854         lappend disable_on_lock [list .mbar.branch entryconf \
1855                 [.mbar.branch index last] -state]
1856
1857         .mbar.branch add command -label {Reset...} \
1858                 -command merge::reset_hard
1859         lappend disable_on_lock [list .mbar.branch entryconf \
1860                 [.mbar.branch index last] -state]
1861 }
1862
1863 # -- Commit Menu
1864 #
1865 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1866         menu .mbar.commit
1867
1868         .mbar.commit add radiobutton \
1869                 -label {New Commit} \
1870                 -command do_select_commit_type \
1871                 -variable selected_commit_type \
1872                 -value new
1873         lappend disable_on_lock \
1874                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1875
1876         .mbar.commit add radiobutton \
1877                 -label {Amend Last Commit} \
1878                 -command do_select_commit_type \
1879                 -variable selected_commit_type \
1880                 -value amend
1881         lappend disable_on_lock \
1882                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1883
1884         .mbar.commit add separator
1885
1886         .mbar.commit add command -label Rescan \
1887                 -command do_rescan \
1888                 -accelerator F5
1889         lappend disable_on_lock \
1890                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1891
1892         .mbar.commit add command -label {Stage To Commit} \
1893                 -command do_add_selection
1894         lappend disable_on_lock \
1895                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1896
1897         .mbar.commit add command -label {Stage Changed Files To Commit} \
1898                 -command do_add_all \
1899                 -accelerator $M1T-I
1900         lappend disable_on_lock \
1901                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1902
1903         .mbar.commit add command -label {Unstage From Commit} \
1904                 -command do_unstage_selection
1905         lappend disable_on_lock \
1906                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1907
1908         .mbar.commit add command -label {Revert Changes} \
1909                 -command do_revert_selection
1910         lappend disable_on_lock \
1911                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1912
1913         .mbar.commit add separator
1914
1915         .mbar.commit add command -label {Sign Off} \
1916                 -command do_signoff \
1917                 -accelerator $M1T-S
1918
1919         .mbar.commit add command -label Commit \
1920                 -command do_commit \
1921                 -accelerator $M1T-Return
1922         lappend disable_on_lock \
1923                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1924 }
1925
1926 # -- Merge Menu
1927 #
1928 if {[is_enabled branch]} {
1929         menu .mbar.merge
1930         .mbar.merge add command -label {Local Merge...} \
1931                 -command merge::dialog \
1932                 -accelerator $M1T-M
1933         lappend disable_on_lock \
1934                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1935         .mbar.merge add command -label {Abort Merge...} \
1936                 -command merge::reset_hard
1937         lappend disable_on_lock \
1938                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1939 }
1940
1941 # -- Transport Menu
1942 #
1943 if {[is_enabled transport]} {
1944         menu .mbar.fetch
1945
1946         menu .mbar.push
1947         .mbar.push add command -label {Push...} \
1948                 -command do_push_anywhere \
1949                 -accelerator $M1T-P
1950         .mbar.push add command -label {Delete...} \
1951                 -command remote_branch_delete::dialog
1952 }
1953
1954 if {[is_MacOSX]} {
1955         # -- Apple Menu (Mac OS X only)
1956         #
1957         .mbar add cascade -label Apple -menu .mbar.apple
1958         menu .mbar.apple
1959
1960         .mbar.apple add command -label "About [appname]" \
1961                 -command do_about
1962         .mbar.apple add command -label "Options..." \
1963                 -command do_options
1964 } else {
1965         # -- Edit Menu
1966         #
1967         .mbar.edit add separator
1968         .mbar.edit add command -label {Options...} \
1969                 -command do_options
1970 }
1971
1972 # -- Help Menu
1973 #
1974 .mbar add cascade -label Help -menu .mbar.help
1975 menu .mbar.help
1976
1977 if {![is_MacOSX]} {
1978         .mbar.help add command -label "About [appname]" \
1979                 -command do_about
1980 }
1981
1982 set browser {}
1983 catch {set browser $repo_config(instaweb.browser)}
1984 set doc_path [file dirname [gitexec]]
1985 set doc_path [file join $doc_path Documentation index.html]
1986
1987 if {[is_Cygwin]} {
1988         set doc_path [exec cygpath --mixed $doc_path]
1989 }
1990
1991 if {$browser eq {}} {
1992         if {[is_MacOSX]} {
1993                 set browser open
1994         } elseif {[is_Cygwin]} {
1995                 set program_files [file dirname [exec cygpath --windir]]
1996                 set program_files [file join $program_files {Program Files}]
1997                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1998                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1999                 if {[file exists $firefox]} {
2000                         set browser $firefox
2001                 } elseif {[file exists $ie]} {
2002                         set browser $ie
2003                 }
2004                 unset program_files firefox ie
2005         }
2006 }
2007
2008 if {[file isfile $doc_path]} {
2009         set doc_url "file:$doc_path"
2010 } else {
2011         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2012 }
2013
2014 if {$browser ne {}} {
2015         .mbar.help add command -label {Online Documentation} \
2016                 -command [list exec $browser $doc_url &]
2017 }
2018 unset browser doc_path doc_url
2019
2020 set root_exists 0
2021 bind . <Visibility> {
2022         bind . <Visibility> {}
2023         set root_exists 1
2024 }
2025
2026 # -- Standard bindings
2027 #
2028 wm protocol . WM_DELETE_WINDOW do_quit
2029 bind all <$M1B-Key-q> do_quit
2030 bind all <$M1B-Key-Q> do_quit
2031 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2032 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2033
2034 set subcommand_args {}
2035 proc usage {} {
2036         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2037         exit 1
2038 }
2039
2040 # -- Not a normal commit type invocation?  Do that instead!
2041 #
2042 switch -- $subcommand {
2043 browser -
2044 blame {
2045         set subcommand_args {rev? path}
2046         if {$argv eq {}} usage
2047         set head {}
2048         set path {}
2049         set is_path 0
2050         foreach a $argv {
2051                 if {$is_path || [file exists $_prefix$a]} {
2052                         if {$path ne {}} usage
2053                         set path $_prefix$a
2054                         break
2055                 } elseif {$a eq {--}} {
2056                         if {$path ne {}} {
2057                                 if {$head ne {}} usage
2058                                 set head $path
2059                                 set path {}
2060                         }
2061                         set is_path 1
2062                 } elseif {$head eq {}} {
2063                         if {$head ne {}} usage
2064                         set head $a
2065                         set is_path 1
2066                 } else {
2067                         usage
2068                 }
2069         }
2070         unset is_path
2071
2072         if {$head ne {} && $path eq {}} {
2073                 set path $_prefix$head
2074                 set head {}
2075         }
2076
2077         if {$head eq {}} {
2078                 load_current_branch
2079         } else {
2080                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2081                         if {[catch {
2082                                         set head [git rev-parse --verify $head]
2083                                 } err]} {
2084                                 puts stderr $err
2085                                 exit 1
2086                         }
2087                 }
2088                 set current_branch $head
2089         }
2090
2091         switch -- $subcommand {
2092         browser {
2093                 if {$head eq {}} {
2094                         if {$path ne {} && [file isdirectory $path]} {
2095                                 set head $current_branch
2096                         } else {
2097                                 set head $path
2098                                 set path {}
2099                         }
2100                 }
2101                 browser::new $head $path
2102         }
2103         blame   {
2104                 if {$head eq {} && ![file exists $path]} {
2105                         puts stderr "fatal: cannot stat path $path: No such file or directory"
2106                         exit 1
2107                 }
2108                 blame::new $head $path
2109         }
2110         }
2111         return
2112 }
2113 citool -
2114 gui {
2115         if {[llength $argv] != 0} {
2116                 puts -nonewline stderr "usage: $argv0"
2117                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2118                         puts -nonewline stderr " $subcommand"
2119                 }
2120                 puts stderr {}
2121                 exit 1
2122         }
2123         # fall through to setup UI for commits
2124 }
2125 default {
2126         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2127         exit 1
2128 }
2129 }
2130
2131 # -- Branch Control
2132 #
2133 frame .branch \
2134         -borderwidth 1 \
2135         -relief sunken
2136 label .branch.l1 \
2137         -text {Current Branch:} \
2138         -anchor w \
2139         -justify left
2140 label .branch.cb \
2141         -textvariable current_branch \
2142         -anchor w \
2143         -justify left
2144 pack .branch.l1 -side left
2145 pack .branch.cb -side left -fill x
2146 pack .branch -side top -fill x
2147
2148 # -- Main Window Layout
2149 #
2150 panedwindow .vpane -orient vertical
2151 panedwindow .vpane.files -orient horizontal
2152 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2153 pack .vpane -anchor n -side top -fill both -expand 1
2154
2155 # -- Index File List
2156 #
2157 frame .vpane.files.index -height 100 -width 200
2158 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2159         -background lightgreen
2160 text $ui_index -background white -borderwidth 0 \
2161         -width 20 -height 10 \
2162         -wrap none \
2163         -cursor $cursor_ptr \
2164         -xscrollcommand {.vpane.files.index.sx set} \
2165         -yscrollcommand {.vpane.files.index.sy set} \
2166         -state disabled
2167 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2168 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2169 pack .vpane.files.index.title -side top -fill x
2170 pack .vpane.files.index.sx -side bottom -fill x
2171 pack .vpane.files.index.sy -side right -fill y
2172 pack $ui_index -side left -fill both -expand 1
2173 .vpane.files add .vpane.files.index -sticky nsew
2174
2175 # -- Working Directory File List
2176 #
2177 frame .vpane.files.workdir -height 100 -width 200
2178 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2179         -background lightsalmon
2180 text $ui_workdir -background white -borderwidth 0 \
2181         -width 20 -height 10 \
2182         -wrap none \
2183         -cursor $cursor_ptr \
2184         -xscrollcommand {.vpane.files.workdir.sx set} \
2185         -yscrollcommand {.vpane.files.workdir.sy set} \
2186         -state disabled
2187 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2188 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2189 pack .vpane.files.workdir.title -side top -fill x
2190 pack .vpane.files.workdir.sx -side bottom -fill x
2191 pack .vpane.files.workdir.sy -side right -fill y
2192 pack $ui_workdir -side left -fill both -expand 1
2193 .vpane.files add .vpane.files.workdir -sticky nsew
2194
2195 foreach i [list $ui_index $ui_workdir] {
2196         rmsel_tag $i
2197         $i tag conf in_diff -background [$i tag cget in_sel -background]
2198 }
2199 unset i
2200
2201 # -- Diff and Commit Area
2202 #
2203 frame .vpane.lower -height 300 -width 400
2204 frame .vpane.lower.commarea
2205 frame .vpane.lower.diff -relief sunken -borderwidth 1
2206 pack .vpane.lower.commarea -side top -fill x
2207 pack .vpane.lower.diff -side bottom -fill both -expand 1
2208 .vpane add .vpane.lower -sticky nsew
2209
2210 # -- Commit Area Buttons
2211 #
2212 frame .vpane.lower.commarea.buttons
2213 label .vpane.lower.commarea.buttons.l -text {} \
2214         -anchor w \
2215         -justify left
2216 pack .vpane.lower.commarea.buttons.l -side top -fill x
2217 pack .vpane.lower.commarea.buttons -side left -fill y
2218
2219 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2220         -command do_rescan
2221 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2222 lappend disable_on_lock \
2223         {.vpane.lower.commarea.buttons.rescan conf -state}
2224
2225 button .vpane.lower.commarea.buttons.incall -text {Stage Changed} \
2226         -command do_add_all
2227 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2228 lappend disable_on_lock \
2229         {.vpane.lower.commarea.buttons.incall conf -state}
2230
2231 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2232         -command do_signoff
2233 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2234
2235 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2236         -command do_commit
2237 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2238 lappend disable_on_lock \
2239         {.vpane.lower.commarea.buttons.commit conf -state}
2240
2241 button .vpane.lower.commarea.buttons.push -text {Push} \
2242         -command do_push_anywhere
2243 pack .vpane.lower.commarea.buttons.push -side top -fill x
2244
2245 # -- Commit Message Buffer
2246 #
2247 frame .vpane.lower.commarea.buffer
2248 frame .vpane.lower.commarea.buffer.header
2249 set ui_comm .vpane.lower.commarea.buffer.t
2250 set ui_coml .vpane.lower.commarea.buffer.header.l
2251 radiobutton .vpane.lower.commarea.buffer.header.new \
2252         -text {New Commit} \
2253         -command do_select_commit_type \
2254         -variable selected_commit_type \
2255         -value new
2256 lappend disable_on_lock \
2257         [list .vpane.lower.commarea.buffer.header.new conf -state]
2258 radiobutton .vpane.lower.commarea.buffer.header.amend \
2259         -text {Amend Last Commit} \
2260         -command do_select_commit_type \
2261         -variable selected_commit_type \
2262         -value amend
2263 lappend disable_on_lock \
2264         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2265 label $ui_coml \
2266         -anchor w \
2267         -justify left
2268 proc trace_commit_type {varname args} {
2269         global ui_coml commit_type
2270         switch -glob -- $commit_type {
2271         initial       {set txt {Initial Commit Message:}}
2272         amend         {set txt {Amended Commit Message:}}
2273         amend-initial {set txt {Amended Initial Commit Message:}}
2274         amend-merge   {set txt {Amended Merge Commit Message:}}
2275         merge         {set txt {Merge Commit Message:}}
2276         *             {set txt {Commit Message:}}
2277         }
2278         $ui_coml conf -text $txt
2279 }
2280 trace add variable commit_type write trace_commit_type
2281 pack $ui_coml -side left -fill x
2282 pack .vpane.lower.commarea.buffer.header.amend -side right
2283 pack .vpane.lower.commarea.buffer.header.new -side right
2284
2285 text $ui_comm -background white -borderwidth 1 \
2286         -undo true \
2287         -maxundo 20 \
2288         -autoseparators true \
2289         -relief sunken \
2290         -width 75 -height 9 -wrap none \
2291         -font font_diff \
2292         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2293 scrollbar .vpane.lower.commarea.buffer.sby \
2294         -command [list $ui_comm yview]
2295 pack .vpane.lower.commarea.buffer.header -side top -fill x
2296 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2297 pack $ui_comm -side left -fill y
2298 pack .vpane.lower.commarea.buffer -side left -fill y
2299
2300 # -- Commit Message Buffer Context Menu
2301 #
2302 set ctxm .vpane.lower.commarea.buffer.ctxm
2303 menu $ctxm -tearoff 0
2304 $ctxm add command \
2305         -label {Cut} \
2306         -command {tk_textCut $ui_comm}
2307 $ctxm add command \
2308         -label {Copy} \
2309         -command {tk_textCopy $ui_comm}
2310 $ctxm add command \
2311         -label {Paste} \
2312         -command {tk_textPaste $ui_comm}
2313 $ctxm add command \
2314         -label {Delete} \
2315         -command {$ui_comm delete sel.first sel.last}
2316 $ctxm add separator
2317 $ctxm add command \
2318         -label {Select All} \
2319         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2320 $ctxm add command \
2321         -label {Copy All} \
2322         -command {
2323                 $ui_comm tag add sel 0.0 end
2324                 tk_textCopy $ui_comm
2325                 $ui_comm tag remove sel 0.0 end
2326         }
2327 $ctxm add separator
2328 $ctxm add command \
2329         -label {Sign Off} \
2330         -command do_signoff
2331 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2332
2333 # -- Diff Header
2334 #
2335 proc trace_current_diff_path {varname args} {
2336         global current_diff_path diff_actions file_states
2337         if {$current_diff_path eq {}} {
2338                 set s {}
2339                 set f {}
2340                 set p {}
2341                 set o disabled
2342         } else {
2343                 set p $current_diff_path
2344                 set s [mapdesc [lindex $file_states($p) 0] $p]
2345                 set f {File:}
2346                 set p [escape_path $p]
2347                 set o normal
2348         }
2349
2350         .vpane.lower.diff.header.status configure -text $s
2351         .vpane.lower.diff.header.file configure -text $f
2352         .vpane.lower.diff.header.path configure -text $p
2353         foreach w $diff_actions {
2354                 uplevel #0 $w $o
2355         }
2356 }
2357 trace add variable current_diff_path write trace_current_diff_path
2358
2359 frame .vpane.lower.diff.header -background gold
2360 label .vpane.lower.diff.header.status \
2361         -background gold \
2362         -width $max_status_desc \
2363         -anchor w \
2364         -justify left
2365 label .vpane.lower.diff.header.file \
2366         -background gold \
2367         -anchor w \
2368         -justify left
2369 label .vpane.lower.diff.header.path \
2370         -background gold \
2371         -anchor w \
2372         -justify left
2373 pack .vpane.lower.diff.header.status -side left
2374 pack .vpane.lower.diff.header.file -side left
2375 pack .vpane.lower.diff.header.path -fill x
2376 set ctxm .vpane.lower.diff.header.ctxm
2377 menu $ctxm -tearoff 0
2378 $ctxm add command \
2379         -label {Copy} \
2380         -command {
2381                 clipboard clear
2382                 clipboard append \
2383                         -format STRING \
2384                         -type STRING \
2385                         -- $current_diff_path
2386         }
2387 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2388 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2389
2390 # -- Diff Body
2391 #
2392 frame .vpane.lower.diff.body
2393 set ui_diff .vpane.lower.diff.body.t
2394 text $ui_diff -background white -borderwidth 0 \
2395         -width 80 -height 15 -wrap none \
2396         -font font_diff \
2397         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2398         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2399         -state disabled
2400 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2401         -command [list $ui_diff xview]
2402 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2403         -command [list $ui_diff yview]
2404 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2405 pack .vpane.lower.diff.body.sby -side right -fill y
2406 pack $ui_diff -side left -fill both -expand 1
2407 pack .vpane.lower.diff.header -side top -fill x
2408 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2409
2410 $ui_diff tag conf d_cr -elide true
2411 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2412 $ui_diff tag conf d_+ -foreground {#00a000}
2413 $ui_diff tag conf d_- -foreground red
2414
2415 $ui_diff tag conf d_++ -foreground {#00a000}
2416 $ui_diff tag conf d_-- -foreground red
2417 $ui_diff tag conf d_+s \
2418         -foreground {#00a000} \
2419         -background {#e2effa}
2420 $ui_diff tag conf d_-s \
2421         -foreground red \
2422         -background {#e2effa}
2423 $ui_diff tag conf d_s+ \
2424         -foreground {#00a000} \
2425         -background ivory1
2426 $ui_diff tag conf d_s- \
2427         -foreground red \
2428         -background ivory1
2429
2430 $ui_diff tag conf d<<<<<<< \
2431         -foreground orange \
2432         -font font_diffbold
2433 $ui_diff tag conf d======= \
2434         -foreground orange \
2435         -font font_diffbold
2436 $ui_diff tag conf d>>>>>>> \
2437         -foreground orange \
2438         -font font_diffbold
2439
2440 $ui_diff tag raise sel
2441
2442 # -- Diff Body Context Menu
2443 #
2444 set ctxm .vpane.lower.diff.body.ctxm
2445 menu $ctxm -tearoff 0
2446 $ctxm add command \
2447         -label {Refresh} \
2448         -command reshow_diff
2449 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2450 $ctxm add command \
2451         -label {Copy} \
2452         -command {tk_textCopy $ui_diff}
2453 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2454 $ctxm add command \
2455         -label {Select All} \
2456         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2457 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2458 $ctxm add command \
2459         -label {Copy All} \
2460         -command {
2461                 $ui_diff tag add sel 0.0 end
2462                 tk_textCopy $ui_diff
2463                 $ui_diff tag remove sel 0.0 end
2464         }
2465 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2466 $ctxm add separator
2467 $ctxm add command \
2468         -label {Apply/Reverse Hunk} \
2469         -command {apply_hunk $cursorX $cursorY}
2470 set ui_diff_applyhunk [$ctxm index last]
2471 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2472 $ctxm add separator
2473 $ctxm add command \
2474         -label {Decrease Font Size} \
2475         -command {incr_font_size font_diff -1}
2476 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2477 $ctxm add command \
2478         -label {Increase Font Size} \
2479         -command {incr_font_size font_diff 1}
2480 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2481 $ctxm add separator
2482 $ctxm add command \
2483         -label {Show Less Context} \
2484         -command {if {$repo_config(gui.diffcontext) >= 1} {
2485                 incr repo_config(gui.diffcontext) -1
2486                 reshow_diff
2487         }}
2488 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2489 $ctxm add command \
2490         -label {Show More Context} \
2491         -command {if {$repo_config(gui.diffcontext) < 99} {
2492                 incr repo_config(gui.diffcontext)
2493                 reshow_diff
2494         }}
2495 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2496 $ctxm add separator
2497 $ctxm add command -label {Options...} \
2498         -command do_options
2499 proc popup_diff_menu {ctxm x y X Y} {
2500         global current_diff_path file_states
2501         set ::cursorX $x
2502         set ::cursorY $y
2503         if {$::ui_index eq $::current_diff_side} {
2504                 set l "Unstage Hunk From Commit"
2505         } else {
2506                 set l "Stage Hunk For Commit"
2507         }
2508         if {$::is_3way_diff
2509                 || $current_diff_path eq {}
2510                 || ![info exists file_states($current_diff_path)]
2511                 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2512                 set s disabled
2513         } else {
2514                 set s normal
2515         }
2516         $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2517         tk_popup $ctxm $X $Y
2518 }
2519 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2520
2521 # -- Status Bar
2522 #
2523 set main_status [::status_bar::new .status]
2524 pack .status -anchor w -side bottom -fill x
2525 $main_status show {Initializing...}
2526
2527 # -- Load geometry
2528 #
2529 catch {
2530 set gm $repo_config(gui.geometry)
2531 wm geometry . [lindex $gm 0]
2532 .vpane sash place 0 \
2533         [lindex [.vpane sash coord 0] 0] \
2534         [lindex $gm 1]
2535 .vpane.files sash place 0 \
2536         [lindex $gm 2] \
2537         [lindex [.vpane.files sash coord 0] 1]
2538 unset gm
2539 }
2540
2541 # -- Key Bindings
2542 #
2543 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2544 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2545 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2546 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2547 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2548 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2549 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2550 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2551 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2552 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2553 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2554
2555 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2556 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2557 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2558 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2559 bind $ui_diff <$M1B-Key-v> {break}
2560 bind $ui_diff <$M1B-Key-V> {break}
2561 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2562 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2563 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2564 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2565 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2566 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2567 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2568 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2569 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2570 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2571 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2572 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2573 bind $ui_diff <Button-1>   {focus %W}
2574
2575 if {[is_enabled branch]} {
2576         bind . <$M1B-Key-n> branch_create::dialog
2577         bind . <$M1B-Key-N> branch_create::dialog
2578         bind . <$M1B-Key-o> branch_checkout::dialog
2579         bind . <$M1B-Key-O> branch_checkout::dialog
2580         bind . <$M1B-Key-m> merge::dialog
2581         bind . <$M1B-Key-M> merge::dialog
2582 }
2583 if {[is_enabled transport]} {
2584         bind . <$M1B-Key-p> do_push_anywhere
2585         bind . <$M1B-Key-P> do_push_anywhere
2586 }
2587
2588 bind .   <Key-F5>     do_rescan
2589 bind .   <$M1B-Key-r> do_rescan
2590 bind .   <$M1B-Key-R> do_rescan
2591 bind .   <$M1B-Key-s> do_signoff
2592 bind .   <$M1B-Key-S> do_signoff
2593 bind .   <$M1B-Key-i> do_add_all
2594 bind .   <$M1B-Key-I> do_add_all
2595 bind .   <$M1B-Key-Return> do_commit
2596 foreach i [list $ui_index $ui_workdir] {
2597         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2598         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2599         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2600 }
2601 unset i
2602
2603 set file_lists($ui_index) [list]
2604 set file_lists($ui_workdir) [list]
2605
2606 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2607 focus -force $ui_comm
2608
2609 # -- Warn the user about environmental problems.  Cygwin's Tcl
2610 #    does *not* pass its env array onto any processes it spawns.
2611 #    This means that git processes get none of our environment.
2612 #
2613 if {[is_Cygwin]} {
2614         set ignored_env 0
2615         set suggest_user {}
2616         set msg "Possible environment issues exist.
2617
2618 The following environment variables are probably
2619 going to be ignored by any Git subprocess run
2620 by [appname]:
2621
2622 "
2623         foreach name [array names env] {
2624                 switch -regexp -- $name {
2625                 {^GIT_INDEX_FILE$} -
2626                 {^GIT_OBJECT_DIRECTORY$} -
2627                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2628                 {^GIT_DIFF_OPTS$} -
2629                 {^GIT_EXTERNAL_DIFF$} -
2630                 {^GIT_PAGER$} -
2631                 {^GIT_TRACE$} -
2632                 {^GIT_CONFIG$} -
2633                 {^GIT_CONFIG_LOCAL$} -
2634                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2635                         append msg " - $name\n"
2636                         incr ignored_env
2637                 }
2638                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2639                         append msg " - $name\n"
2640                         incr ignored_env
2641                         set suggest_user $name
2642                 }
2643                 }
2644         }
2645         if {$ignored_env > 0} {
2646                 append msg "
2647 This is due to a known issue with the
2648 Tcl binary distributed by Cygwin."
2649
2650                 if {$suggest_user ne {}} {
2651                         append msg "
2652
2653 A good replacement for $suggest_user
2654 is placing values for the user.name and
2655 user.email settings into your personal
2656 ~/.gitconfig file.
2657 "
2658                 }
2659                 warn_popup $msg
2660         }
2661         unset ignored_env msg suggest_user name
2662 }
2663
2664 # -- Only initialize complex UI if we are going to stay running.
2665 #
2666 if {[is_enabled transport]} {
2667         load_all_remotes
2668
2669         populate_fetch_menu
2670         populate_push_menu
2671 }
2672
2673 if {[winfo exists $ui_comm]} {
2674         set GITGUI_BCK_exists [load_message GITGUI_BCK]
2675
2676         # -- If both our backup and message files exist use the
2677         #    newer of the two files to initialize the buffer.
2678         #
2679         if {$GITGUI_BCK_exists} {
2680                 set m [gitdir GITGUI_MSG]
2681                 if {[file isfile $m]} {
2682                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2683                                 catch {file delete [gitdir GITGUI_MSG]}
2684                         } else {
2685                                 $ui_comm delete 0.0 end
2686                                 $ui_comm edit reset
2687                                 $ui_comm edit modified false
2688                                 catch {file delete [gitdir GITGUI_BCK]}
2689                                 set GITGUI_BCK_exists 0
2690                         }
2691                 }
2692                 unset m
2693         }
2694
2695         proc backup_commit_buffer {} {
2696                 global ui_comm GITGUI_BCK_exists
2697
2698                 set m [$ui_comm edit modified]
2699                 if {$m || $GITGUI_BCK_exists} {
2700                         set msg [string trim [$ui_comm get 0.0 end]]
2701                         regsub -all -line {[ \r\t]+$} $msg {} msg
2702
2703                         if {$msg eq {}} {
2704                                 if {$GITGUI_BCK_exists} {
2705                                         catch {file delete [gitdir GITGUI_BCK]}
2706                                         set GITGUI_BCK_exists 0
2707                                 }
2708                         } elseif {$m} {
2709                                 catch {
2710                                         set fd [open [gitdir GITGUI_BCK] w]
2711                                         puts -nonewline $fd $msg
2712                                         close $fd
2713                                         set GITGUI_BCK_exists 1
2714                                 }
2715                         }
2716
2717                         $ui_comm edit modified false
2718                 }
2719
2720                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2721         }
2722
2723         backup_commit_buffer
2724 }
2725
2726 lock_index begin-read
2727 if {![winfo ismapped .]} {
2728         wm deiconify .
2729 }
2730 after 1 do_rescan
2731 if {[is_enabled multicommit]} {
2732         after 1000 hint_gc
2733 }