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