git-gui.sh

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