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