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                 global env
1472
1473                 if {[info exists env(GIT_DIR)]} {
1474                         set old_GIT_DIR $env(GIT_DIR)
1475                 } else {
1476                         set old_GIT_DIR {}
1477                 }
1478
1479                 set pwd [pwd]
1480                 cd [file dirname [gitdir]]
1481                 set env(GIT_DIR) [file tail [gitdir]]
1482
1483                 eval exec $cmd $revs &
1484
1485                 if {$old_GIT_DIR eq {}} {
1486                         unset env(GIT_DIR)
1487                 } else {
1488                         set env(GIT_DIR) $old_GIT_DIR
1489                 }
1490                 cd $pwd
1491
1492                 ui_status $::starting_gitk_msg
1493                 after 10000 {
1494                         ui_ready $starting_gitk_msg
1495                 }
1496         }
1497 }
1498
1499 set is_quitting 0
1500
1501 proc do_quit {} {
1502         global ui_comm is_quitting repo_config commit_type
1503         global GITGUI_BCK_exists GITGUI_BCK_i
1504
1505         if {$is_quitting} return
1506         set is_quitting 1
1507
1508         if {[winfo exists $ui_comm]} {
1509                 # -- Stash our current commit buffer.
1510                 #
1511                 set save [gitdir GITGUI_MSG]
1512                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1513                         file rename -force [gitdir GITGUI_BCK] $save
1514                         set GITGUI_BCK_exists 0
1515                 } else {
1516                         set msg [string trim [$ui_comm get 0.0 end]]
1517                         regsub -all -line {[ \r\t]+$} $msg {} msg
1518                         if {(![string match amend* $commit_type]
1519                                 || [$ui_comm edit modified])
1520                                 && $msg ne {}} {
1521                                 catch {
1522                                         set fd [open $save w]
1523                                         puts -nonewline $fd $msg
1524                                         close $fd
1525                                 }
1526                         } else {
1527                                 catch {file delete $save}
1528                         }
1529                 }
1530
1531                 # -- Remove our editor backup, its not needed.
1532                 #
1533                 after cancel $GITGUI_BCK_i
1534                 if {$GITGUI_BCK_exists} {
1535                         catch {file delete [gitdir GITGUI_BCK]}
1536                 }
1537
1538                 # -- Stash our current window geometry into this repository.
1539                 #
1540                 set cfg_geometry [list]
1541                 lappend cfg_geometry [wm geometry .]
1542                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1543                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1544                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1545                         set rc_geometry {}
1546                 }
1547                 if {$cfg_geometry ne $rc_geometry} {
1548                         catch {git config gui.geometry $cfg_geometry}
1549                 }
1550         }
1551
1552         destroy .
1553 }
1554
1555 proc do_rescan {} {
1556         rescan ui_ready
1557 }
1558
1559 proc do_commit {} {
1560         commit_tree
1561 }
1562
1563 proc toggle_or_diff {w x y} {
1564         global file_states file_lists current_diff_path ui_index ui_workdir
1565         global last_clicked selected_paths
1566
1567         set pos [split [$w index @$x,$y] .]
1568         set lno [lindex $pos 0]
1569         set col [lindex $pos 1]
1570         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1571         if {$path eq {}} {
1572                 set last_clicked {}
1573                 return
1574         }
1575
1576         set last_clicked [list $w $lno]
1577         array unset selected_paths
1578         $ui_index tag remove in_sel 0.0 end
1579         $ui_workdir tag remove in_sel 0.0 end
1580
1581         if {$col == 0} {
1582                 if {$current_diff_path eq $path} {
1583                         set after {reshow_diff;}
1584                 } else {
1585                         set after {}
1586                 }
1587                 if {$w eq $ui_index} {
1588                         update_indexinfo \
1589                                 "Unstaging [short_path $path] from commit" \
1590                                 [list $path] \
1591                                 [concat $after [list ui_ready]]
1592                 } elseif {$w eq $ui_workdir} {
1593                         update_index \
1594                                 "Adding [short_path $path]" \
1595                                 [list $path] \
1596                                 [concat $after [list ui_ready]]
1597                 }
1598         } else {
1599                 show_diff $path $w $lno
1600         }
1601 }
1602
1603 proc add_one_to_selection {w x y} {
1604         global file_lists last_clicked selected_paths
1605
1606         set lno [lindex [split [$w index @$x,$y] .] 0]
1607         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1608         if {$path eq {}} {
1609                 set last_clicked {}
1610                 return
1611         }
1612
1613         if {$last_clicked ne {}
1614                 && [lindex $last_clicked 0] ne $w} {
1615                 array unset selected_paths
1616                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1617         }
1618
1619         set last_clicked [list $w $lno]
1620         if {[catch {set in_sel $selected_paths($path)}]} {
1621                 set in_sel 0
1622         }
1623         if {$in_sel} {
1624                 unset selected_paths($path)
1625                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1626         } else {
1627                 set selected_paths($path) 1
1628                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1629         }
1630 }
1631
1632 proc add_range_to_selection {w x y} {
1633         global file_lists last_clicked selected_paths
1634
1635         if {[lindex $last_clicked 0] ne $w} {
1636                 toggle_or_diff $w $x $y
1637                 return
1638         }
1639
1640         set lno [lindex [split [$w index @$x,$y] .] 0]
1641         set lc [lindex $last_clicked 1]
1642         if {$lc < $lno} {
1643                 set begin $lc
1644                 set end $lno
1645         } else {
1646                 set begin $lno
1647                 set end $lc
1648         }
1649
1650         foreach path [lrange $file_lists($w) \
1651                 [expr {$begin - 1}] \
1652                 [expr {$end - 1}]] {
1653                 set selected_paths($path) 1
1654         }
1655         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1656 }
1657
1658 ######################################################################
1659 ##
1660 ## config defaults
1661
1662 set cursor_ptr arrow
1663 font create font_diff -family Courier -size 10
1664 font create font_ui
1665 catch {
1666         label .dummy
1667         eval font configure font_ui [font actual [.dummy cget -font]]
1668         destroy .dummy
1669 }
1670
1671 font create font_uiitalic
1672 font create font_uibold
1673 font create font_diffbold
1674 font create font_diffitalic
1675
1676 foreach class {Button Checkbutton Entry Label
1677                 Labelframe Listbox Menu Message
1678                 Radiobutton Spinbox Text} {
1679         option add *$class.font font_ui
1680 }
1681 unset class
1682
1683 if {[is_Windows] || [is_MacOSX]} {
1684         option add *Menu.tearOff 0
1685 }
1686
1687 if {[is_MacOSX]} {
1688         set M1B M1
1689         set M1T Cmd
1690 } else {
1691         set M1B Control
1692         set M1T Ctrl
1693 }
1694
1695 proc apply_config {} {
1696         global repo_config font_descs
1697
1698         foreach option $font_descs {
1699                 set name [lindex $option 0]
1700                 set font [lindex $option 1]
1701                 if {[catch {
1702                         foreach {cn cv} $repo_config(gui.$name) {
1703                                 font configure $font $cn $cv -weight normal
1704                         }
1705                         } err]} {
1706                         error_popup "Invalid font specified in gui.$name:\n\n$err"
1707                 }
1708                 foreach {cn cv} [font configure $font] {
1709                         font configure ${font}bold $cn $cv
1710                         font configure ${font}italic $cn $cv
1711                 }
1712                 font configure ${font}bold -weight bold
1713                 font configure ${font}italic -slant italic
1714         }
1715 }
1716
1717 set default_config(merge.diffstat) true
1718 set default_config(merge.summary) false
1719 set default_config(merge.verbosity) 2
1720 set default_config(user.name) {}
1721 set default_config(user.email) {}
1722
1723 set default_config(gui.matchtrackingbranch) false
1724 set default_config(gui.pruneduringfetch) false
1725 set default_config(gui.trustmtime) false
1726 set default_config(gui.diffcontext) 5
1727 set default_config(gui.newbranchtemplate) {}
1728 set default_config(gui.fontui) [font configure font_ui]
1729 set default_config(gui.fontdiff) [font configure font_diff]
1730 set font_descs {
1731         {fontui   font_ui   {Main Font}}
1732         {fontdiff font_diff {Diff/Console Font}}
1733 }
1734 load_config 0
1735 apply_config
1736
1737 ######################################################################
1738 ##
1739 ## ui construction
1740
1741 set ui_comm {}
1742
1743 # -- Menu Bar
1744 #
1745 menu .mbar -tearoff 0
1746 .mbar add cascade -label Repository -menu .mbar.repository
1747 .mbar add cascade -label Edit -menu .mbar.edit
1748 if {[is_enabled branch]} {
1749         .mbar add cascade -label Branch -menu .mbar.branch
1750 }
1751 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1752         .mbar add cascade -label Commit -menu .mbar.commit
1753 }
1754 if {[is_enabled transport]} {
1755         .mbar add cascade -label Merge -menu .mbar.merge
1756         .mbar add cascade -label Fetch -menu .mbar.fetch
1757         .mbar add cascade -label Push -menu .mbar.push
1758 }
1759 . configure -menu .mbar
1760
1761 # -- Repository Menu
1762 #
1763 menu .mbar.repository
1764
1765 .mbar.repository add command \
1766         -label {Browse Current Branch's Files} \
1767         -command {browser::new $current_branch}
1768 set ui_browse_current [.mbar.repository index last]
1769 .mbar.repository add command \
1770         -label {Browse Branch Files...} \
1771         -command browser_open::dialog
1772 .mbar.repository add separator
1773
1774 .mbar.repository add command \
1775         -label {Visualize Current Branch's History} \
1776         -command {do_gitk $current_branch}
1777 set ui_visualize_current [.mbar.repository index last]
1778 .mbar.repository add command \
1779         -label {Visualize All Branch History} \
1780         -command {do_gitk --all}
1781 .mbar.repository add separator
1782
1783 proc current_branch_write {args} {
1784         global current_branch
1785         .mbar.repository entryconf $::ui_browse_current \
1786                 -label "Browse $current_branch's Files"
1787         .mbar.repository entryconf $::ui_visualize_current \
1788                 -label "Visualize $current_branch's History"
1789 }
1790 trace add variable current_branch write current_branch_write
1791
1792 if {[is_enabled multicommit]} {
1793         .mbar.repository add command -label {Database Statistics} \
1794                 -command do_stats
1795
1796         .mbar.repository add command -label {Compress Database} \
1797                 -command do_gc
1798
1799         .mbar.repository add command -label {Verify Database} \
1800                 -command do_fsck_objects
1801
1802         .mbar.repository add separator
1803
1804         if {[is_Cygwin]} {
1805                 .mbar.repository add command \
1806                         -label {Create Desktop Icon} \
1807                         -command do_cygwin_shortcut
1808         } elseif {[is_Windows]} {
1809                 .mbar.repository add command \
1810                         -label {Create Desktop Icon} \
1811                         -command do_windows_shortcut
1812         } elseif {[is_MacOSX]} {
1813                 .mbar.repository add command \
1814                         -label {Create Desktop Icon} \
1815                         -command do_macosx_app
1816         }
1817 }
1818
1819 .mbar.repository add command -label Quit \
1820         -command do_quit \
1821         -accelerator $M1T-Q
1822
1823 # -- Edit Menu
1824 #
1825 menu .mbar.edit
1826 .mbar.edit add command -label Undo \
1827         -command {catch {[focus] edit undo}} \
1828         -accelerator $M1T-Z
1829 .mbar.edit add command -label Redo \
1830         -command {catch {[focus] edit redo}} \
1831         -accelerator $M1T-Y
1832 .mbar.edit add separator
1833 .mbar.edit add command -label Cut \
1834         -command {catch {tk_textCut [focus]}} \
1835         -accelerator $M1T-X
1836 .mbar.edit add command -label Copy \
1837         -command {catch {tk_textCopy [focus]}} \
1838         -accelerator $M1T-C
1839 .mbar.edit add command -label Paste \
1840         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1841         -accelerator $M1T-V
1842 .mbar.edit add command -label Delete \
1843         -command {catch {[focus] delete sel.first sel.last}} \
1844         -accelerator Del
1845 .mbar.edit add separator
1846 .mbar.edit add command -label {Select All} \
1847         -command {catch {[focus] tag add sel 0.0 end}} \
1848         -accelerator $M1T-A
1849
1850 # -- Branch Menu
1851 #
1852 if {[is_enabled branch]} {
1853         menu .mbar.branch
1854
1855         .mbar.branch add command -label {Create...} \
1856                 -command branch_create::dialog \
1857                 -accelerator $M1T-N
1858         lappend disable_on_lock [list .mbar.branch entryconf \
1859                 [.mbar.branch index last] -state]
1860
1861         .mbar.branch add command -label {Checkout...} \
1862                 -command branch_checkout::dialog \
1863                 -accelerator $M1T-O
1864         lappend disable_on_lock [list .mbar.branch entryconf \
1865                 [.mbar.branch index last] -state]
1866
1867         .mbar.branch add command -label {Rename...} \
1868                 -command branch_rename::dialog
1869         lappend disable_on_lock [list .mbar.branch entryconf \
1870                 [.mbar.branch index last] -state]
1871
1872         .mbar.branch add command -label {Delete...} \
1873                 -command branch_delete::dialog
1874         lappend disable_on_lock [list .mbar.branch entryconf \
1875                 [.mbar.branch index last] -state]
1876
1877         .mbar.branch add command -label {Reset...} \
1878                 -command merge::reset_hard
1879         lappend disable_on_lock [list .mbar.branch entryconf \
1880                 [.mbar.branch index last] -state]
1881 }
1882
1883 # -- Commit Menu
1884 #
1885 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1886         menu .mbar.commit
1887
1888         .mbar.commit add radiobutton \
1889                 -label {New Commit} \
1890                 -command do_select_commit_type \
1891                 -variable selected_commit_type \
1892                 -value new
1893         lappend disable_on_lock \
1894                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1895
1896         .mbar.commit add radiobutton \
1897                 -label {Amend Last Commit} \
1898                 -command do_select_commit_type \
1899                 -variable selected_commit_type \
1900                 -value amend
1901         lappend disable_on_lock \
1902                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1903
1904         .mbar.commit add separator
1905
1906         .mbar.commit add command -label Rescan \
1907                 -command do_rescan \
1908                 -accelerator F5
1909         lappend disable_on_lock \
1910                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1911
1912         .mbar.commit add command -label {Stage To Commit} \
1913                 -command do_add_selection
1914         lappend disable_on_lock \
1915                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1916
1917         .mbar.commit add command -label {Stage Changed Files To Commit} \
1918                 -command do_add_all \
1919                 -accelerator $M1T-I
1920         lappend disable_on_lock \
1921                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1922
1923         .mbar.commit add command -label {Unstage From Commit} \
1924                 -command do_unstage_selection
1925         lappend disable_on_lock \
1926                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1927
1928         .mbar.commit add command -label {Revert Changes} \
1929                 -command do_revert_selection
1930         lappend disable_on_lock \
1931                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1932
1933         .mbar.commit add separator
1934
1935         .mbar.commit add command -label {Sign Off} \
1936                 -command do_signoff \
1937                 -accelerator $M1T-S
1938
1939         .mbar.commit add command -label Commit \
1940                 -command do_commit \
1941                 -accelerator $M1T-Return
1942         lappend disable_on_lock \
1943                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1944 }
1945
1946 # -- Merge Menu
1947 #
1948 if {[is_enabled branch]} {
1949         menu .mbar.merge
1950         .mbar.merge add command -label {Local Merge...} \
1951                 -command merge::dialog \
1952                 -accelerator $M1T-M
1953         lappend disable_on_lock \
1954                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1955         .mbar.merge add command -label {Abort Merge...} \
1956                 -command merge::reset_hard
1957         lappend disable_on_lock \
1958                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1959 }
1960
1961 # -- Transport Menu
1962 #
1963 if {[is_enabled transport]} {
1964         menu .mbar.fetch
1965
1966         menu .mbar.push
1967         .mbar.push add command -label {Push...} \
1968                 -command do_push_anywhere \
1969                 -accelerator $M1T-P
1970         .mbar.push add command -label {Delete...} \
1971                 -command remote_branch_delete::dialog
1972 }
1973
1974 if {[is_MacOSX]} {
1975         # -- Apple Menu (Mac OS X only)
1976         #
1977         .mbar add cascade -label Apple -menu .mbar.apple
1978         menu .mbar.apple
1979
1980         .mbar.apple add command -label "About [appname]" \
1981                 -command do_about
1982         .mbar.apple add command -label "Options..." \
1983                 -command do_options
1984 } else {
1985         # -- Edit Menu
1986         #
1987         .mbar.edit add separator
1988         .mbar.edit add command -label {Options...} \
1989                 -command do_options
1990 }
1991
1992 # -- Help Menu
1993 #
1994 .mbar add cascade -label Help -menu .mbar.help
1995 menu .mbar.help
1996
1997 if {![is_MacOSX]} {
1998         .mbar.help add command -label "About [appname]" \
1999                 -command do_about
2000 }
2001
2002 set browser {}
2003 catch {set browser $repo_config(instaweb.browser)}
2004 set doc_path [file dirname [gitexec]]
2005 set doc_path [file join $doc_path Documentation index.html]
2006
2007 if {[is_Cygwin]} {
2008         set doc_path [exec cygpath --mixed $doc_path]
2009 }
2010
2011 if {$browser eq {}} {
2012         if {[is_MacOSX]} {
2013                 set browser open
2014         } elseif {[is_Cygwin]} {
2015                 set program_files [file dirname [exec cygpath --windir]]
2016                 set program_files [file join $program_files {Program Files}]
2017                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2018                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2019                 if {[file exists $firefox]} {
2020                         set browser $firefox
2021                 } elseif {[file exists $ie]} {
2022                         set browser $ie
2023                 }
2024                 unset program_files firefox ie
2025         }
2026 }
2027
2028 if {[file isfile $doc_path]} {
2029         set doc_url "file:$doc_path"
2030 } else {
2031         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2032 }
2033
2034 if {$browser ne {}} {
2035         .mbar.help add command -label {Online Documentation} \
2036                 -command [list exec $browser $doc_url &]
2037 }
2038 unset browser doc_path doc_url
2039
2040 set root_exists 0
2041 bind . <Visibility> {
2042         bind . <Visibility> {}
2043         set root_exists 1
2044 }
2045
2046 # -- Standard bindings
2047 #
2048 wm protocol . WM_DELETE_WINDOW do_quit
2049 bind all <$M1B-Key-q> do_quit
2050 bind all <$M1B-Key-Q> do_quit
2051 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2052 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2053
2054 set subcommand_args {}
2055 proc usage {} {
2056         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2057         exit 1
2058 }
2059
2060 # -- Not a normal commit type invocation?  Do that instead!
2061 #
2062 switch -- $subcommand {
2063 browser -
2064 blame {
2065         set subcommand_args {rev? path}
2066         if {$argv eq {}} usage
2067         set head {}
2068         set path {}
2069         set is_path 0
2070         foreach a $argv {
2071                 if {$is_path || [file exists $_prefix$a]} {
2072                         if {$path ne {}} usage
2073                         set path $_prefix$a
2074                         break
2075                 } elseif {$a eq {--}} {
2076                         if {$path ne {}} {
2077                                 if {$head ne {}} usage
2078                                 set head $path
2079                                 set path {}
2080                         }
2081                         set is_path 1
2082                 } elseif {$head eq {}} {
2083                         if {$head ne {}} usage
2084                         set head $a
2085                         set is_path 1
2086                 } else {
2087                         usage
2088                 }
2089         }
2090         unset is_path
2091
2092         if {$head ne {} && $path eq {}} {
2093                 set path $_prefix$head
2094                 set head {}
2095         }
2096
2097         if {$head eq {}} {
2098                 load_current_branch
2099         } else {
2100                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2101                         if {[catch {
2102                                         set head [git rev-parse --verify $head]
2103                                 } err]} {
2104                                 puts stderr $err
2105                                 exit 1
2106                         }
2107                 }
2108                 set current_branch $head
2109         }
2110
2111         switch -- $subcommand {
2112         browser {
2113                 if {$head eq {}} {
2114                         if {$path ne {} && [file isdirectory $path]} {
2115                                 set head $current_branch
2116                         } else {
2117                                 set head $path
2118                                 set path {}
2119                         }
2120                 }
2121                 browser::new $head $path
2122         }
2123         blame   {
2124                 if {$head eq {} && ![file exists $path]} {
2125                         puts stderr "fatal: cannot stat path $path: No such file or directory"
2126                         exit 1
2127                 }
2128                 blame::new $head $path
2129         }
2130         }
2131         return
2132 }
2133 citool -
2134 gui {
2135         if {[llength $argv] != 0} {
2136                 puts -nonewline stderr "usage: $argv0"
2137                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2138                         puts -nonewline stderr " $subcommand"
2139                 }
2140                 puts stderr {}
2141                 exit 1
2142         }
2143         # fall through to setup UI for commits
2144 }
2145 default {
2146         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2147         exit 1
2148 }
2149 }
2150
2151 # -- Branch Control
2152 #
2153 frame .branch \
2154         -borderwidth 1 \
2155         -relief sunken
2156 label .branch.l1 \
2157         -text {Current Branch:} \
2158         -anchor w \
2159         -justify left
2160 label .branch.cb \
2161         -textvariable current_branch \
2162         -anchor w \
2163         -justify left
2164 pack .branch.l1 -side left
2165 pack .branch.cb -side left -fill x
2166 pack .branch -side top -fill x
2167
2168 # -- Main Window Layout
2169 #
2170 panedwindow .vpane -orient vertical
2171 panedwindow .vpane.files -orient horizontal
2172 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2173 pack .vpane -anchor n -side top -fill both -expand 1
2174
2175 # -- Index File List
2176 #
2177 frame .vpane.files.index -height 100 -width 200
2178 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2179         -background lightgreen
2180 text $ui_index -background white -borderwidth 0 \
2181         -width 20 -height 10 \
2182         -wrap none \
2183         -cursor $cursor_ptr \
2184         -xscrollcommand {.vpane.files.index.sx set} \
2185         -yscrollcommand {.vpane.files.index.sy set} \
2186         -state disabled
2187 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2188 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2189 pack .vpane.files.index.title -side top -fill x
2190 pack .vpane.files.index.sx -side bottom -fill x
2191 pack .vpane.files.index.sy -side right -fill y
2192 pack $ui_index -side left -fill both -expand 1
2193 .vpane.files add .vpane.files.index -sticky nsew
2194
2195 # -- Working Directory File List
2196 #
2197 frame .vpane.files.workdir -height 100 -width 200
2198 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2199         -background lightsalmon
2200 text $ui_workdir -background white -borderwidth 0 \
2201         -width 20 -height 10 \
2202         -wrap none \
2203         -cursor $cursor_ptr \
2204         -xscrollcommand {.vpane.files.workdir.sx set} \
2205         -yscrollcommand {.vpane.files.workdir.sy set} \
2206         -state disabled
2207 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2208 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2209 pack .vpane.files.workdir.title -side top -fill x
2210 pack .vpane.files.workdir.sx -side bottom -fill x
2211 pack .vpane.files.workdir.sy -side right -fill y
2212 pack $ui_workdir -side left -fill both -expand 1
2213 .vpane.files add .vpane.files.workdir -sticky nsew
2214
2215 foreach i [list $ui_index $ui_workdir] {
2216         rmsel_tag $i
2217         $i tag conf in_diff -background [$i tag cget in_sel -background]
2218 }
2219 unset i
2220
2221 # -- Diff and Commit Area
2222 #
2223 frame .vpane.lower -height 300 -width 400
2224 frame .vpane.lower.commarea
2225 frame .vpane.lower.diff -relief sunken -borderwidth 1
2226 pack .vpane.lower.commarea -side top -fill x
2227 pack .vpane.lower.diff -side bottom -fill both -expand 1
2228 .vpane add .vpane.lower -sticky nsew
2229
2230 # -- Commit Area Buttons
2231 #
2232 frame .vpane.lower.commarea.buttons
2233 label .vpane.lower.commarea.buttons.l -text {} \
2234         -anchor w \
2235         -justify left
2236 pack .vpane.lower.commarea.buttons.l -side top -fill x
2237 pack .vpane.lower.commarea.buttons -side left -fill y
2238
2239 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2240         -command do_rescan
2241 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2242 lappend disable_on_lock \
2243         {.vpane.lower.commarea.buttons.rescan conf -state}
2244
2245 button .vpane.lower.commarea.buttons.incall -text {Stage Changed} \
2246         -command do_add_all
2247 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2248 lappend disable_on_lock \
2249         {.vpane.lower.commarea.buttons.incall conf -state}
2250
2251 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2252         -command do_signoff
2253 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2254
2255 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2256         -command do_commit
2257 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2258 lappend disable_on_lock \
2259         {.vpane.lower.commarea.buttons.commit conf -state}
2260
2261 button .vpane.lower.commarea.buttons.push -text {Push} \
2262         -command do_push_anywhere
2263 pack .vpane.lower.commarea.buttons.push -side top -fill x
2264
2265 # -- Commit Message Buffer
2266 #
2267 frame .vpane.lower.commarea.buffer
2268 frame .vpane.lower.commarea.buffer.header
2269 set ui_comm .vpane.lower.commarea.buffer.t
2270 set ui_coml .vpane.lower.commarea.buffer.header.l
2271 radiobutton .vpane.lower.commarea.buffer.header.new \
2272         -text {New Commit} \
2273         -command do_select_commit_type \
2274         -variable selected_commit_type \
2275         -value new
2276 lappend disable_on_lock \
2277         [list .vpane.lower.commarea.buffer.header.new conf -state]
2278 radiobutton .vpane.lower.commarea.buffer.header.amend \
2279         -text {Amend Last Commit} \
2280         -command do_select_commit_type \
2281         -variable selected_commit_type \
2282         -value amend
2283 lappend disable_on_lock \
2284         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2285 label $ui_coml \
2286         -anchor w \
2287         -justify left
2288 proc trace_commit_type {varname args} {
2289         global ui_coml commit_type
2290         switch -glob -- $commit_type {
2291         initial       {set txt {Initial Commit Message:}}
2292         amend         {set txt {Amended Commit Message:}}
2293         amend-initial {set txt {Amended Initial Commit Message:}}
2294         amend-merge   {set txt {Amended Merge Commit Message:}}
2295         merge         {set txt {Merge Commit Message:}}
2296         *             {set txt {Commit Message:}}
2297         }
2298         $ui_coml conf -text $txt
2299 }
2300 trace add variable commit_type write trace_commit_type
2301 pack $ui_coml -side left -fill x
2302 pack .vpane.lower.commarea.buffer.header.amend -side right
2303 pack .vpane.lower.commarea.buffer.header.new -side right
2304
2305 text $ui_comm -background white -borderwidth 1 \
2306         -undo true \
2307         -maxundo 20 \
2308         -autoseparators true \
2309         -relief sunken \
2310         -width 75 -height 9 -wrap none \
2311         -font font_diff \
2312         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2313 scrollbar .vpane.lower.commarea.buffer.sby \
2314         -command [list $ui_comm yview]
2315 pack .vpane.lower.commarea.buffer.header -side top -fill x
2316 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2317 pack $ui_comm -side left -fill y
2318 pack .vpane.lower.commarea.buffer -side left -fill y
2319
2320 # -- Commit Message Buffer Context Menu
2321 #
2322 set ctxm .vpane.lower.commarea.buffer.ctxm
2323 menu $ctxm -tearoff 0
2324 $ctxm add command \
2325         -label {Cut} \
2326         -command {tk_textCut $ui_comm}
2327 $ctxm add command \
2328         -label {Copy} \
2329         -command {tk_textCopy $ui_comm}
2330 $ctxm add command \
2331         -label {Paste} \
2332         -command {tk_textPaste $ui_comm}
2333 $ctxm add command \
2334         -label {Delete} \
2335         -command {$ui_comm delete sel.first sel.last}
2336 $ctxm add separator
2337 $ctxm add command \
2338         -label {Select All} \
2339         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2340 $ctxm add command \
2341         -label {Copy All} \
2342         -command {
2343                 $ui_comm tag add sel 0.0 end
2344                 tk_textCopy $ui_comm
2345                 $ui_comm tag remove sel 0.0 end
2346         }
2347 $ctxm add separator
2348 $ctxm add command \
2349         -label {Sign Off} \
2350         -command do_signoff
2351 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2352
2353 # -- Diff Header
2354 #
2355 proc trace_current_diff_path {varname args} {
2356         global current_diff_path diff_actions file_states
2357         if {$current_diff_path eq {}} {
2358                 set s {}
2359                 set f {}
2360                 set p {}
2361                 set o disabled
2362         } else {
2363                 set p $current_diff_path
2364                 set s [mapdesc [lindex $file_states($p) 0] $p]
2365                 set f {File:}
2366                 set p [escape_path $p]
2367                 set o normal
2368         }
2369
2370         .vpane.lower.diff.header.status configure -text $s
2371         .vpane.lower.diff.header.file configure -text $f
2372         .vpane.lower.diff.header.path configure -text $p
2373         foreach w $diff_actions {
2374                 uplevel #0 $w $o
2375         }
2376 }
2377 trace add variable current_diff_path write trace_current_diff_path
2378
2379 frame .vpane.lower.diff.header -background gold
2380 label .vpane.lower.diff.header.status \
2381         -background gold \
2382         -width $max_status_desc \
2383         -anchor w \
2384         -justify left
2385 label .vpane.lower.diff.header.file \
2386         -background gold \
2387         -anchor w \
2388         -justify left
2389 label .vpane.lower.diff.header.path \
2390         -background gold \
2391         -anchor w \
2392         -justify left
2393 pack .vpane.lower.diff.header.status -side left
2394 pack .vpane.lower.diff.header.file -side left
2395 pack .vpane.lower.diff.header.path -fill x
2396 set ctxm .vpane.lower.diff.header.ctxm
2397 menu $ctxm -tearoff 0
2398 $ctxm add command \
2399         -label {Copy} \
2400         -command {
2401                 clipboard clear
2402                 clipboard append \
2403                         -format STRING \
2404                         -type STRING \
2405                         -- $current_diff_path
2406         }
2407 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2408 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2409
2410 # -- Diff Body
2411 #
2412 frame .vpane.lower.diff.body
2413 set ui_diff .vpane.lower.diff.body.t
2414 text $ui_diff -background white -borderwidth 0 \
2415         -width 80 -height 15 -wrap none \
2416         -font font_diff \
2417         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2418         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2419         -state disabled
2420 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2421         -command [list $ui_diff xview]
2422 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2423         -command [list $ui_diff yview]
2424 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2425 pack .vpane.lower.diff.body.sby -side right -fill y
2426 pack $ui_diff -side left -fill both -expand 1
2427 pack .vpane.lower.diff.header -side top -fill x
2428 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2429
2430 $ui_diff tag conf d_cr -elide true
2431 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2432 $ui_diff tag conf d_+ -foreground {#00a000}
2433 $ui_diff tag conf d_- -foreground red
2434
2435 $ui_diff tag conf d_++ -foreground {#00a000}
2436 $ui_diff tag conf d_-- -foreground red
2437 $ui_diff tag conf d_+s \
2438         -foreground {#00a000} \
2439         -background {#e2effa}
2440 $ui_diff tag conf d_-s \
2441         -foreground red \
2442         -background {#e2effa}
2443 $ui_diff tag conf d_s+ \
2444         -foreground {#00a000} \
2445         -background ivory1
2446 $ui_diff tag conf d_s- \
2447         -foreground red \
2448         -background ivory1
2449
2450 $ui_diff tag conf d<<<<<<< \
2451         -foreground orange \
2452         -font font_diffbold
2453 $ui_diff tag conf d======= \
2454         -foreground orange \
2455         -font font_diffbold
2456 $ui_diff tag conf d>>>>>>> \
2457         -foreground orange \
2458         -font font_diffbold
2459
2460 $ui_diff tag raise sel
2461
2462 # -- Diff Body Context Menu
2463 #
2464 set ctxm .vpane.lower.diff.body.ctxm
2465 menu $ctxm -tearoff 0
2466 $ctxm add command \
2467         -label {Refresh} \
2468         -command reshow_diff
2469 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2470 $ctxm add command \
2471         -label {Copy} \
2472         -command {tk_textCopy $ui_diff}
2473 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2474 $ctxm add command \
2475         -label {Select All} \
2476         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2477 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2478 $ctxm add command \
2479         -label {Copy All} \
2480         -command {
2481                 $ui_diff tag add sel 0.0 end
2482                 tk_textCopy $ui_diff
2483                 $ui_diff tag remove sel 0.0 end
2484         }
2485 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2486 $ctxm add separator
2487 $ctxm add command \
2488         -label {Apply/Reverse Hunk} \
2489         -command {apply_hunk $cursorX $cursorY}
2490 set ui_diff_applyhunk [$ctxm index last]
2491 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2492 $ctxm add separator
2493 $ctxm add command \
2494         -label {Decrease Font Size} \
2495         -command {incr_font_size font_diff -1}
2496 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2497 $ctxm add command \
2498         -label {Increase Font Size} \
2499         -command {incr_font_size font_diff 1}
2500 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2501 $ctxm add separator
2502 $ctxm add command \
2503         -label {Show Less Context} \
2504         -command {if {$repo_config(gui.diffcontext) >= 1} {
2505                 incr repo_config(gui.diffcontext) -1
2506                 reshow_diff
2507         }}
2508 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2509 $ctxm add command \
2510         -label {Show More Context} \
2511         -command {if {$repo_config(gui.diffcontext) < 99} {
2512                 incr repo_config(gui.diffcontext)
2513                 reshow_diff
2514         }}
2515 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2516 $ctxm add separator
2517 $ctxm add command -label {Options...} \
2518         -command do_options
2519 proc popup_diff_menu {ctxm x y X Y} {
2520         global current_diff_path file_states
2521         set ::cursorX $x
2522         set ::cursorY $y
2523         if {$::ui_index eq $::current_diff_side} {
2524                 set l "Unstage Hunk From Commit"
2525         } else {
2526                 set l "Stage Hunk For Commit"
2527         }
2528         if {$::is_3way_diff
2529                 || $current_diff_path eq {}
2530                 || ![info exists file_states($current_diff_path)]
2531                 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2532                 set s disabled
2533         } else {
2534                 set s normal
2535         }
2536         $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2537         tk_popup $ctxm $X $Y
2538 }
2539 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2540
2541 # -- Status Bar
2542 #
2543 set main_status [::status_bar::new .status]
2544 pack .status -anchor w -side bottom -fill x
2545 $main_status show {Initializing...}
2546
2547 # -- Load geometry
2548 #
2549 catch {
2550 set gm $repo_config(gui.geometry)
2551 wm geometry . [lindex $gm 0]
2552 .vpane sash place 0 \
2553         [lindex [.vpane sash coord 0] 0] \
2554         [lindex $gm 1]
2555 .vpane.files sash place 0 \
2556         [lindex $gm 2] \
2557         [lindex [.vpane.files sash coord 0] 1]
2558 unset gm
2559 }
2560
2561 # -- Key Bindings
2562 #
2563 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2564 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2565 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2566 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2567 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2568 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2569 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2570 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2571 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2572 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2573 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2574
2575 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2576 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2577 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2578 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2579 bind $ui_diff <$M1B-Key-v> {break}
2580 bind $ui_diff <$M1B-Key-V> {break}
2581 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2582 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2583 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2584 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2585 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2586 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2587 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2588 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2589 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2590 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2591 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2592 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2593 bind $ui_diff <Button-1>   {focus %W}
2594
2595 if {[is_enabled branch]} {
2596         bind . <$M1B-Key-n> branch_create::dialog
2597         bind . <$M1B-Key-N> branch_create::dialog
2598         bind . <$M1B-Key-o> branch_checkout::dialog
2599         bind . <$M1B-Key-O> branch_checkout::dialog
2600         bind . <$M1B-Key-m> merge::dialog
2601         bind . <$M1B-Key-M> merge::dialog
2602 }
2603 if {[is_enabled transport]} {
2604         bind . <$M1B-Key-p> do_push_anywhere
2605         bind . <$M1B-Key-P> do_push_anywhere
2606 }
2607
2608 bind .   <Key-F5>     do_rescan
2609 bind .   <$M1B-Key-r> do_rescan
2610 bind .   <$M1B-Key-R> do_rescan
2611 bind .   <$M1B-Key-s> do_signoff
2612 bind .   <$M1B-Key-S> do_signoff
2613 bind .   <$M1B-Key-i> do_add_all
2614 bind .   <$M1B-Key-I> do_add_all
2615 bind .   <$M1B-Key-Return> do_commit
2616 foreach i [list $ui_index $ui_workdir] {
2617         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2618         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2619         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2620 }
2621 unset i
2622
2623 set file_lists($ui_index) [list]
2624 set file_lists($ui_workdir) [list]
2625
2626 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2627 focus -force $ui_comm
2628
2629 # -- Warn the user about environmental problems.  Cygwin's Tcl
2630 #    does *not* pass its env array onto any processes it spawns.
2631 #    This means that git processes get none of our environment.
2632 #
2633 if {[is_Cygwin]} {
2634         set ignored_env 0
2635         set suggest_user {}
2636         set msg "Possible environment issues exist.
2637
2638 The following environment variables are probably
2639 going to be ignored by any Git subprocess run
2640 by [appname]:
2641
2642 "
2643         foreach name [array names env] {
2644                 switch -regexp -- $name {
2645                 {^GIT_INDEX_FILE$} -
2646                 {^GIT_OBJECT_DIRECTORY$} -
2647                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2648                 {^GIT_DIFF_OPTS$} -
2649                 {^GIT_EXTERNAL_DIFF$} -
2650                 {^GIT_PAGER$} -
2651                 {^GIT_TRACE$} -
2652                 {^GIT_CONFIG$} -
2653                 {^GIT_CONFIG_LOCAL$} -
2654                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2655                         append msg " - $name\n"
2656                         incr ignored_env
2657                 }
2658                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2659                         append msg " - $name\n"
2660                         incr ignored_env
2661                         set suggest_user $name
2662                 }
2663                 }
2664         }
2665         if {$ignored_env > 0} {
2666                 append msg "
2667 This is due to a known issue with the
2668 Tcl binary distributed by Cygwin."
2669
2670                 if {$suggest_user ne {}} {
2671                         append msg "
2672
2673 A good replacement for $suggest_user
2674 is placing values for the user.name and
2675 user.email settings into your personal
2676 ~/.gitconfig file.
2677 "
2678                 }
2679                 warn_popup $msg
2680         }
2681         unset ignored_env msg suggest_user name
2682 }
2683
2684 # -- Only initialize complex UI if we are going to stay running.
2685 #
2686 if {[is_enabled transport]} {
2687         load_all_remotes
2688
2689         populate_fetch_menu
2690         populate_push_menu
2691 }
2692
2693 if {[winfo exists $ui_comm]} {
2694         set GITGUI_BCK_exists [load_message GITGUI_BCK]
2695
2696         # -- If both our backup and message files exist use the
2697         #    newer of the two files to initialize the buffer.
2698         #
2699         if {$GITGUI_BCK_exists} {
2700                 set m [gitdir GITGUI_MSG]
2701                 if {[file isfile $m]} {
2702                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2703                                 catch {file delete [gitdir GITGUI_MSG]}
2704                         } else {
2705                                 $ui_comm delete 0.0 end
2706                                 $ui_comm edit reset
2707                                 $ui_comm edit modified false
2708                                 catch {file delete [gitdir GITGUI_BCK]}
2709                                 set GITGUI_BCK_exists 0
2710                         }
2711                 }
2712                 unset m
2713         }
2714
2715         proc backup_commit_buffer {} {
2716                 global ui_comm GITGUI_BCK_exists
2717
2718                 set m [$ui_comm edit modified]
2719                 if {$m || $GITGUI_BCK_exists} {
2720                         set msg [string trim [$ui_comm get 0.0 end]]
2721                         regsub -all -line {[ \r\t]+$} $msg {} msg
2722
2723                         if {$msg eq {}} {
2724                                 if {$GITGUI_BCK_exists} {
2725                                         catch {file delete [gitdir GITGUI_BCK]}
2726                                         set GITGUI_BCK_exists 0
2727                                 }
2728                         } elseif {$m} {
2729                                 catch {
2730                                         set fd [open [gitdir GITGUI_BCK] w]
2731                                         puts -nonewline $fd $msg
2732                                         close $fd
2733                                         set GITGUI_BCK_exists 1
2734                                 }
2735                         }
2736
2737                         $ui_comm edit modified false
2738                 }
2739
2740                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2741         }
2742
2743         backup_commit_buffer
2744 }
2745
2746 lock_index begin-read
2747 if {![winfo ismapped .]} {
2748         wm deiconify .
2749 }
2750 after 1 do_rescan
2751 if {[is_enabled multicommit]} {
2752         after 1000 hint_gc
2753 }