git-gui/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 [string map [list (c) \u00a9] {
  14 Copyright (c) 2006-2010 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, see <http://www.gnu.org/licenses/>.}]
  28
  29 ######################################################################
  30 ##
  31 ## Tcl/Tk sanity check
  32
  33 if {[catch {package require Tcl 8.4} err]
  34  || [catch {package require Tk  8.4} err]
  35 } {
  36         catch {wm withdraw .}
  37         tk_messageBox \
  38                 -icon error \
  39                 -type ok \
  40                 -title "git-gui: fatal error" \
  41                 -message $err
  42         exit 1
  43 }
  44
  45 catch {rename send {}} ; # What an evil concept...
  46
  47 ######################################################################
  48 ##
  49 ## locate our library
  50
  51 if { [info exists ::env(GIT_GUI_LIB_DIR) ] } {
  52         set oguilib $::env(GIT_GUI_LIB_DIR)
  53 } else {
  54         set oguilib {@@GITGUI_LIBDIR@@}
  55 }
  56 set oguirel {@@GITGUI_RELATIVE@@}
  57 if {$oguirel eq {1}} {
  58         set oguilib [file dirname [file normalize $argv0]]
  59         if {[file tail $oguilib] eq {git-core}} {
  60                 set oguilib [file dirname $oguilib]
  61         }
  62         set oguilib [file dirname $oguilib]
  63         set oguilib [file join $oguilib share git-gui lib]
  64         set oguimsg [file join $oguilib msgs]
  65 } elseif {[string match @@* $oguirel]} {
  66         set oguilib [file join [file dirname [file normalize $argv0]] lib]
  67         set oguimsg [file join [file dirname [file normalize $argv0]] po]
  68 } else {
  69         set oguimsg [file join $oguilib msgs]
  70 }
  71 unset oguirel
  72
  73 ######################################################################
  74 ##
  75 ## enable verbose loading?
  76
  77 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
  78         unset _verbose
  79         rename auto_load real__auto_load
  80         proc auto_load {name args} {
  81                 puts stderr "auto_load $name"
  82                 return [uplevel 1 real__auto_load $name $args]
  83         }
  84         rename source real__source
  85         proc source {args} {
  86                 puts stderr "source    $args"
  87                 uplevel 1 [linsert $args 0 real__source]
  88         }
  89         if {[tk windowingsystem] eq "win32"} { console show }
  90 }
  91
  92 ######################################################################
  93 ##
  94 ## Internationalization (i18n) through msgcat and gettext. See
  95 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
  96
  97 package require msgcat
  98
  99 # Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
 100 if {[tk windowingsystem] eq "win32"
 101         && [package vcompare [package provide msgcat] 1.4.4] < 0
 102 } then {
 103         proc _mc_update_locale {} {
 104                 set key {HKEY_CURRENT_USER\Control Panel\Desktop}
 105                 if {![catch {
 106                         package require registry
 107                         set uilocale [registry get $key "PreferredUILanguages"]
 108                         msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]
 109                 } uilocale]} {
 110                         if {[string length $uilocale] > 0} {
 111                                 msgcat::mclocale $uilocale
 112                         }
 113                 }
 114         }
 115         _mc_update_locale
 116 }
 117
 118 proc _mc_trim {fmt} {
 119         set cmk [string first @@ $fmt]
 120         if {$cmk > 0} {
 121                 return [string range $fmt 0 [expr {$cmk - 1}]]
 122         }
 123         return $fmt
 124 }
 125
 126 proc mc {en_fmt args} {
 127         set fmt [_mc_trim [::msgcat::mc $en_fmt]]
 128         if {[catch {set msg [eval [list format $fmt] $args]} err]} {
 129                 set msg [eval [list format [_mc_trim $en_fmt]] $args]
 130         }
 131         return $msg
 132 }
 133
 134 proc strcat {args} {
 135         return [join $args {}]
 136 }
 137
 138 ::msgcat::mcload $oguimsg
 139 unset oguimsg
 140
 141 ######################################################################
 142 ##
 143 ## On Mac, bring the current Wish process window to front
 144
 145 if {[tk windowingsystem] eq "aqua"} {
 146         catch {
 147                 exec osascript -e [format {
 148                         tell application "System Events"
 149                                 set frontmost of processes whose unix id is %d to true
 150                         end tell
 151                 } [pid]]
 152         }
 153 }
 154
 155 ######################################################################
 156 ##
 157 ## read only globals
 158
 159 set _appname {Git Gui}
 160 set _gitdir {}
 161 set _gitworktree {}
 162 set _isbare {}
 163 set _gitexec {}
 164 set _githtmldir {}
 165 set _reponame {}
 166 set _iscygwin {}
 167 set _search_path {}
 168 set _shellpath {@@SHELL_PATH@@}
 169
 170 set _trace [lsearch -exact $argv --trace]
 171 if {$_trace >= 0} {
 172         set argv [lreplace $argv $_trace $_trace]
 173         set _trace 1
 174         if {[tk windowingsystem] eq "win32"} { console show }
 175 } else {
 176         set _trace 0
 177 }
 178
 179 # variable for the last merged branch (useful for a default when deleting
 180 # branches).
 181 set _last_merged_branch {}
 182
 183 proc shellpath {} {
 184         global _shellpath env
 185         if {[string match @@* $_shellpath]} {
 186                 if {[info exists env(SHELL)]} {
 187                         return $env(SHELL)
 188                 } else {
 189                         return /bin/sh
 190                 }
 191         }
 192         return $_shellpath
 193 }
 194
 195 proc appname {} {
 196         global _appname
 197         return $_appname
 198 }
 199
 200 proc gitdir {args} {
 201         global _gitdir
 202         if {$args eq {}} {
 203                 return $_gitdir
 204         }
 205         return [eval [list file join $_gitdir] $args]
 206 }
 207
 208 proc gitexec {args} {
 209         global _gitexec
 210         if {$_gitexec eq {}} {
 211                 if {[catch {set _gitexec [git --exec-path]} err]} {
 212                         error "Git not installed?\n\n$err"
 213                 }
 214                 if {[is_Cygwin]} {
 215                         set _gitexec [exec cygpath \
 216                                 --windows \
 217                                 --absolute \
 218                                 $_gitexec]
 219                 } else {
 220                         set _gitexec [file normalize $_gitexec]
 221                 }
 222         }
 223         if {$args eq {}} {
 224                 return $_gitexec
 225         }
 226         return [eval [list file join $_gitexec] $args]
 227 }
 228
 229 proc githtmldir {args} {
 230         global _githtmldir
 231         if {$_githtmldir eq {}} {
 232                 if {[catch {set _githtmldir [git --html-path]}]} {
 233                         # Git not installed or option not yet supported
 234                         return {}
 235                 }
 236                 if {[is_Cygwin]} {
 237                         set _githtmldir [exec cygpath \
 238                                 --windows \
 239                                 --absolute \
 240                                 $_githtmldir]
 241                 } else {
 242                         set _githtmldir [file normalize $_githtmldir]
 243                 }
 244         }
 245         if {$args eq {}} {
 246                 return $_githtmldir
 247         }
 248         return [eval [list file join $_githtmldir] $args]
 249 }
 250
 251 proc reponame {} {
 252         return $::_reponame
 253 }
 254
 255 proc is_MacOSX {} {
 256         if {[tk windowingsystem] eq {aqua}} {
 257                 return 1
 258         }
 259         return 0
 260 }
 261
 262 proc is_Windows {} {
 263         if {$::tcl_platform(platform) eq {windows}} {
 264                 return 1
 265         }
 266         return 0
 267 }
 268
 269 proc is_Cygwin {} {
 270         global _iscygwin
 271         if {$_iscygwin eq {}} {
 272                 if {$::tcl_platform(platform) eq {windows}} {
 273                         if {[catch {set p [exec cygpath --windir]} err]} {
 274                                 set _iscygwin 0
 275                         } else {
 276                                 set _iscygwin 1
 277                                 # Handle MSys2 which is only cygwin when MSYSTEM is MSYS.
 278                                 if {[info exists ::env(MSYSTEM)] && $::env(MSYSTEM) ne "MSYS"} {
 279                                         set _iscygwin 0
 280                                 }
 281                         }
 282                 } else {
 283                         set _iscygwin 0
 284                 }
 285         }
 286         return $_iscygwin
 287 }
 288
 289 proc is_enabled {option} {
 290         global enabled_options
 291         if {[catch {set on $enabled_options($option)}]} {return 0}
 292         return $on
 293 }
 294
 295 proc enable_option {option} {
 296         global enabled_options
 297         set enabled_options($option) 1
 298 }
 299
 300 proc disable_option {option} {
 301         global enabled_options
 302         set enabled_options($option) 0
 303 }
 304
 305 ######################################################################
 306 ##
 307 ## config
 308
 309 proc is_many_config {name} {
 310         switch -glob -- $name {
 311         gui.recentrepo -
 312         remote.*.fetch -
 313         remote.*.push
 314                 {return 1}
 315         *
 316                 {return 0}
 317         }
 318 }
 319
 320 proc is_config_true {name} {
 321         global repo_config
 322         if {[catch {set v $repo_config($name)}]} {
 323                 return 0
 324         }
 325         set v [string tolower $v]
 326         if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
 327                 return 1
 328         } else {
 329                 return 0
 330         }
 331 }
 332
 333 proc is_config_false {name} {
 334         global repo_config
 335         if {[catch {set v $repo_config($name)}]} {
 336                 return 0
 337         }
 338         set v [string tolower $v]
 339         if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
 340                 return 1
 341         } else {
 342                 return 0
 343         }
 344 }
 345
 346 proc get_config {name} {
 347         global repo_config
 348         if {[catch {set v $repo_config($name)}]} {
 349                 return {}
 350         } else {
 351                 return $v
 352         }
 353 }
 354
 355 proc is_bare {} {
 356         global _isbare
 357         global _gitdir
 358         global _gitworktree
 359
 360         if {$_isbare eq {}} {
 361                 if {[catch {
 362                         set _bare [git rev-parse --is-bare-repository]
 363                         switch  -- $_bare {
 364                         true { set _isbare 1 }
 365                         false { set _isbare 0}
 366                         default { throw }
 367                         }
 368                 }]} {
 369                         if {[is_config_true core.bare]
 370                                 || ($_gitworktree eq {}
 371                                         && [lindex [file split $_gitdir] end] ne {.git})} {
 372                                 set _isbare 1
 373                         } else {
 374                                 set _isbare 0
 375                         }
 376                 }
 377         }
 378         return $_isbare
 379 }
 380
 381 ######################################################################
 382 ##
 383 ## handy utils
 384
 385 proc _trace_exec {cmd} {
 386         if {!$::_trace} return
 387         set d {}
 388         foreach v $cmd {
 389                 if {$d ne {}} {
 390                         append d { }
 391                 }
 392                 if {[regexp {[ \t\r\n'"$?*]} $v]} {
 393                         set v [sq $v]
 394                 }
 395                 append d $v
 396         }
 397         puts stderr $d
 398 }
 399
 400 #'"  fix poor old emacs font-lock mode
 401
 402 proc _git_cmd {name} {
 403         global _git_cmd_path
 404
 405         if {[catch {set v $_git_cmd_path($name)}]} {
 406                 switch -- $name {
 407                   version   -
 408                 --version   -
 409                 --exec-path { return [list $::_git $name] }
 410                 }
 411
 412                 set p [gitexec git-$name$::_search_exe]
 413                 if {[file exists $p]} {
 414                         set v [list $p]
 415                 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 416                         # Try to determine what sort of magic will make
 417                         # git-$name go and do its thing, because native
 418                         # Tcl on Windows doesn't know it.
 419                         #
 420                         set p [gitexec git-$name]
 421                         set f [open $p r]
 422                         set s [gets $f]
 423                         close $f
 424
 425                         switch -glob -- [lindex $s 0] {
 426                         #!*sh     { set i sh     }
 427                         #!*perl   { set i perl   }
 428                         #!*python { set i python }
 429                         default   { error "git-$name is not supported: $s" }
 430                         }
 431
 432                         upvar #0 _$i interp
 433                         if {![info exists interp]} {
 434                                 set interp [_which $i]
 435                         }
 436                         if {$interp eq {}} {
 437                                 error "git-$name requires $i (not in PATH)"
 438                         }
 439                         set v [concat [list $interp] [lrange $s 1 end] [list $p]]
 440                 } else {
 441                         # Assume it is builtin to git somehow and we
 442                         # aren't actually able to see a file for it.
 443                         #
 444                         set v [list $::_git $name]
 445                 }
 446                 set _git_cmd_path($name) $v
 447         }
 448         return $v
 449 }
 450
 451 proc _which {what args} {
 452         global env _search_exe _search_path
 453
 454         if {$_search_path eq {}} {
 455                 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
 456                         set _search_path [split [exec cygpath \
 457                                 --windows \
 458                                 --path \
 459                                 --absolute \
 460                                 $env(PATH)] {;}]
 461                         set _search_exe .exe
 462                 } elseif {[is_Windows]} {
 463                         set gitguidir [file dirname [info script]]
 464                         regsub -all ";" $gitguidir "\\;" gitguidir
 465                         set env(PATH) "$gitguidir;$env(PATH)"
 466                         set _search_path [split $env(PATH) {;}]
 467                         set _search_exe .exe
 468                 } else {
 469                         set _search_path [split $env(PATH) :]
 470                         set _search_exe {}
 471                 }
 472         }
 473
 474         if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
 475                 set suffix {}
 476         } else {
 477                 set suffix $_search_exe
 478         }
 479
 480         foreach p $_search_path {
 481                 set p [file join $p $what$suffix]
 482                 if {[file exists $p]} {
 483                         return [file normalize $p]
 484                 }
 485         }
 486         return {}
 487 }
 488
 489 # Test a file for a hashbang to identify executable scripts on Windows.
 490 proc is_shellscript {filename} {
 491         if {![file exists $filename]} {return 0}
 492         set f [open $filename r]
 493         fconfigure $f -encoding binary
 494         set magic [read $f 2]
 495         close $f
 496         return [expr {$magic eq "#!"}]
 497 }
 498
 499 # Run a command connected via pipes on stdout.
 500 # This is for use with textconv filters and uses sh -c "..." to allow it to
 501 # contain a command with arguments. On windows we must check for shell
 502 # scripts specifically otherwise just call the filter command.
 503 proc open_cmd_pipe {cmd path} {
 504         global env
 505         if {![file executable [shellpath]]} {
 506                 set exe [auto_execok [lindex $cmd 0]]
 507                 if {[is_shellscript [lindex $exe 0]]} {
 508                         set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
 509                 } else {
 510                         set run [concat $exe [lrange $cmd 1 end] $path]
 511                 }
 512         } else {
 513                 set run [list [shellpath] -c "$cmd \"\$0\"" $path]
 514         }
 515         return [open |$run r]
 516 }
 517
 518 proc _lappend_nice {cmd_var} {
 519         global _nice
 520         upvar $cmd_var cmd
 521
 522         if {![info exists _nice]} {
 523                 set _nice [_which nice]
 524                 if {[catch {exec $_nice git version}]} {
 525                         set _nice {}
 526                 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
 527                         set _nice {}
 528                 }
 529         }
 530         if {$_nice ne {}} {
 531                 lappend cmd $_nice
 532         }
 533 }
 534
 535 proc git {args} {
 536         set fd [eval [list git_read] $args]
 537         fconfigure $fd -translation binary -encoding utf-8
 538         set result [string trimright [read $fd] "\n"]
 539         close $fd
 540         if {$::_trace} {
 541                 puts stderr "< $result"
 542         }
 543         return $result
 544 }
 545
 546 proc _open_stdout_stderr {cmd} {
 547         _trace_exec $cmd
 548         if {[catch {
 549                         set fd [open [concat [list | ] $cmd] r]
 550                 } err]} {
 551                 if {   [lindex $cmd end] eq {2>@1}
 552                     && $err eq {can not find channel named "1"}
 553                         } {
 554                         # Older versions of Tcl 8.4 don't have this 2>@1 IO
 555                         # redirect operator.  Fallback to |& cat for those.
 556                         # The command was not actually started, so its safe
 557                         # to try to start it a second time.
 558                         #
 559                         set fd [open [concat \
 560                                 [list | ] \
 561                                 [lrange $cmd 0 end-1] \
 562                                 [list |& cat] \
 563                                 ] r]
 564                 } else {
 565                         error $err
 566                 }
 567         }
 568         fconfigure $fd -eofchar {}
 569         return $fd
 570 }
 571
 572 proc git_read {args} {
 573         set opt [list]
 574
 575         while {1} {
 576                 switch -- [lindex $args 0] {
 577                 --nice {
 578                         _lappend_nice opt
 579                 }
 580
 581                 --stderr {
 582                         lappend args 2>@1
 583                 }
 584
 585                 default {
 586                         break
 587                 }
 588
 589                 }
 590
 591                 set args [lrange $args 1 end]
 592         }
 593
 594         set cmdp [_git_cmd [lindex $args 0]]
 595         set args [lrange $args 1 end]
 596
 597         return [_open_stdout_stderr [concat $opt $cmdp $args]]
 598 }
 599
 600 proc git_write {args} {
 601         set opt [list]
 602
 603         while {1} {
 604                 switch -- [lindex $args 0] {
 605                 --nice {
 606                         _lappend_nice opt
 607                 }
 608
 609                 default {
 610                         break
 611                 }
 612
 613                 }
 614
 615                 set args [lrange $args 1 end]
 616         }
 617
 618         set cmdp [_git_cmd [lindex $args 0]]
 619         set args [lrange $args 1 end]
 620
 621         _trace_exec [concat $opt $cmdp $args]
 622         return [open [concat [list | ] $opt $cmdp $args] w]
 623 }
 624
 625 proc githook_read {hook_name args} {
 626         set pchook [gitdir hooks $hook_name]
 627         lappend args 2>@1
 628
 629         # On Windows [file executable] might lie so we need to ask
 630         # the shell if the hook is executable.  Yes that's annoying.
 631         #
 632         if {[is_Windows]} {
 633                 upvar #0 _sh interp
 634                 if {![info exists interp]} {
 635                         set interp [_which sh]
 636                 }
 637                 if {$interp eq {}} {
 638                         error "hook execution requires sh (not in PATH)"
 639                 }
 640
 641                 set scr {if test -x "$1";then exec "$@";fi}
 642                 set sh_c [list $interp -c $scr $interp $pchook]
 643                 return [_open_stdout_stderr [concat $sh_c $args]]
 644         }
 645
 646         if {[file executable $pchook]} {
 647                 return [_open_stdout_stderr [concat [list $pchook] $args]]
 648         }
 649
 650         return {}
 651 }
 652
 653 proc kill_file_process {fd} {
 654         set process [pid $fd]
 655
 656         catch {
 657                 if {[is_Windows]} {
 658                         exec taskkill /pid $process
 659                 } else {
 660                         exec kill $process
 661                 }
 662         }
 663 }
 664
 665 proc gitattr {path attr default} {
 666         if {[catch {set r [git check-attr $attr -- $path]}]} {
 667                 set r unspecified
 668         } else {
 669                 set r [join [lrange [split $r :] 2 end] :]
 670                 regsub {^ } $r {} r
 671         }
 672         if {$r eq {unspecified}} {
 673                 return $default
 674         }
 675         return $r
 676 }
 677
 678 proc sq {value} {
 679         regsub -all ' $value "'\\''" value
 680         return "'$value'"
 681 }
 682
 683 proc load_current_branch {} {
 684         global current_branch is_detached
 685
 686         set fd [open [gitdir HEAD] r]
 687         if {[gets $fd ref] < 1} {
 688                 set ref {}
 689         }
 690         close $fd
 691
 692         set pfx {ref: refs/heads/}
 693         set len [string length $pfx]
 694         if {[string equal -length $len $pfx $ref]} {
 695                 # We're on a branch.  It might not exist.  But
 696                 # HEAD looks good enough to be a branch.
 697                 #
 698                 set current_branch [string range $ref $len end]
 699                 set is_detached 0
 700         } else {
 701                 # Assume this is a detached head.
 702                 #
 703                 set current_branch HEAD
 704                 set is_detached 1
 705         }
 706 }
 707
 708 auto_load tk_optionMenu
 709 rename tk_optionMenu real__tkOptionMenu
 710 proc tk_optionMenu {w varName args} {
 711         set m [eval real__tkOptionMenu $w $varName $args]
 712         $m configure -font font_ui
 713         $w configure -font font_ui
 714         return $m
 715 }
 716
 717 proc rmsel_tag {text} {
 718         $text tag conf sel \
 719                 -background [$text cget -background] \
 720                 -foreground [$text cget -foreground] \
 721                 -borderwidth 0
 722         $text tag conf in_sel -background lightgray
 723         bind $text <Motion> break
 724         return $text
 725 }
 726
 727 wm withdraw .
 728 set root_exists 0
 729 bind . <Visibility> {
 730         bind . <Visibility> {}
 731         set root_exists 1
 732 }
 733
 734 if {[is_Windows]} {
 735         wm iconbitmap . -default $oguilib/git-gui.ico
 736         set ::tk::AlwaysShowSelection 1
 737         bind . <Control-F2> {console show}
 738
 739         # Spoof an X11 display for SSH
 740         if {![info exists env(DISPLAY)]} {
 741                 set env(DISPLAY) :9999
 742         }
 743 } else {
 744         catch {
 745                 image create photo gitlogo -width 16 -height 16
 746
 747                 gitlogo put #33CC33 -to  7  0  9  2
 748                 gitlogo put #33CC33 -to  4  2 12  4
 749                 gitlogo put #33CC33 -to  7  4  9  6
 750                 gitlogo put #CC3333 -to  4  6 12  8
 751                 gitlogo put gray26  -to  4  9  6 10
 752                 gitlogo put gray26  -to  3 10  6 12
 753                 gitlogo put gray26  -to  8  9 13 11
 754                 gitlogo put gray26  -to  8 11 10 12
 755                 gitlogo put gray26  -to 11 11 13 14
 756                 gitlogo put gray26  -to  3 12  5 14
 757                 gitlogo put gray26  -to  5 13
 758                 gitlogo put gray26  -to 10 13
 759                 gitlogo put gray26  -to  4 14 12 15
 760                 gitlogo put gray26  -to  5 15 11 16
 761                 gitlogo redither
 762
 763                 image create photo gitlogo32 -width 32 -height 32
 764                 gitlogo32 copy gitlogo -zoom 2 2
 765
 766                 wm iconphoto . -default gitlogo gitlogo32
 767         }
 768 }
 769
 770 ######################################################################
 771 ##
 772 ## config defaults
 773
 774 set cursor_ptr arrow
 775 font create font_ui
 776 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
 777         eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
 778         eval [linsert [font actual TkFixedFont] 0 font create font_diff]
 779 } else {
 780         font create font_diff -family Courier -size 10
 781         catch {
 782                 label .dummy
 783                 eval font configure font_ui [font actual [.dummy cget -font]]
 784                 destroy .dummy
 785         }
 786 }
 787
 788 font create font_uiitalic
 789 font create font_uibold
 790 font create font_diffbold
 791 font create font_diffitalic
 792
 793 foreach class {Button Checkbutton Entry Label
 794                 Labelframe Listbox Message
 795                 Radiobutton Spinbox Text} {
 796         option add *$class.font font_ui
 797 }
 798 if {![is_MacOSX]} {
 799         option add *Menu.font font_ui
 800         option add *Entry.borderWidth 1 startupFile
 801         option add *Entry.relief sunken startupFile
 802         option add *RadioButton.anchor w startupFile
 803 }
 804 unset class
 805
 806 if {[is_Windows] || [is_MacOSX]} {
 807         option add *Menu.tearOff 0
 808 }
 809
 810 if {[is_MacOSX]} {
 811         set M1B M1
 812         set M1T Cmd
 813 } else {
 814         set M1B Control
 815         set M1T Ctrl
 816 }
 817
 818 proc bind_button3 {w cmd} {
 819         bind $w <Any-Button-3> $cmd
 820         if {[is_MacOSX]} {
 821                 # Mac OS X sends Button-2 on right click through three-button mouse,
 822                 # or through trackpad right-clicking (two-finger touch + click).
 823                 bind $w <Any-Button-2> $cmd
 824                 bind $w <Control-Button-1> $cmd
 825         }
 826 }
 827
 828 proc apply_config {} {
 829         global repo_config font_descs
 830
 831         foreach option $font_descs {
 832                 set name [lindex $option 0]
 833                 set font [lindex $option 1]
 834                 if {[catch {
 835                         set need_weight 1
 836                         foreach {cn cv} $repo_config(gui.$name) {
 837                                 if {$cn eq {-weight}} {
 838                                         set need_weight 0
 839                                 }
 840                                 font configure $font $cn $cv
 841                         }
 842                         if {$need_weight} {
 843                                 font configure $font -weight normal
 844                         }
 845                         } err]} {
 846                         error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
 847                 }
 848                 foreach {cn cv} [font configure $font] {
 849                         font configure ${font}bold $cn $cv
 850                         font configure ${font}italic $cn $cv
 851                 }
 852                 font configure ${font}bold -weight bold
 853                 font configure ${font}italic -slant italic
 854         }
 855
 856         global use_ttk NS
 857         set use_ttk 0
 858         set NS {}
 859         if {$repo_config(gui.usettk)} {
 860                 set use_ttk [package vsatisfies [package provide Tk] 8.5]
 861                 if {$use_ttk} {
 862                         set NS ttk
 863                         bind [winfo class .] <<ThemeChanged>> [list InitTheme]
 864                         pave_toplevel .
 865                 }
 866         }
 867 }
 868
 869 set default_config(branch.autosetupmerge) true
 870 set default_config(merge.tool) {}
 871 set default_config(mergetool.keepbackup) true
 872 set default_config(merge.diffstat) true
 873 set default_config(merge.summary) false
 874 set default_config(merge.verbosity) 2
 875 set default_config(user.name) {}
 876 set default_config(user.email) {}
 877
 878 set default_config(gui.encoding) [encoding system]
 879 set default_config(gui.matchtrackingbranch) false
 880 set default_config(gui.textconv) true
 881 set default_config(gui.pruneduringfetch) false
 882 set default_config(gui.trustmtime) false
 883 set default_config(gui.fastcopyblame) false
 884 set default_config(gui.maxrecentrepo) 10
 885 set default_config(gui.copyblamethreshold) 40
 886 set default_config(gui.blamehistoryctx) 7
 887 set default_config(gui.diffcontext) 5
 888 set default_config(gui.diffopts) {}
 889 set default_config(gui.commitmsgwidth) 75
 890 set default_config(gui.newbranchtemplate) {}
 891 set default_config(gui.spellingdictionary) {}
 892 set default_config(gui.fontui) [font configure font_ui]
 893 set default_config(gui.fontdiff) [font configure font_diff]
 894 # TODO: this option should be added to the git-config documentation
 895 set default_config(gui.maxfilesdisplayed) 5000
 896 set default_config(gui.usettk) 1
 897 set default_config(gui.warndetachedcommit) 1
 898 set default_config(gui.tabsize) 8
 899 set font_descs {
 900         {fontui   font_ui   {mc "Main Font"}}
 901         {fontdiff font_diff {mc "Diff/Console Font"}}
 902 }
 903 set default_config(gui.stageuntracked) ask
 904 set default_config(gui.displayuntracked) true
 905
 906 ######################################################################
 907 ##
 908 ## find git
 909
 910 set _git  [_which git]
 911 if {$_git eq {}} {
 912         catch {wm withdraw .}
 913         tk_messageBox \
 914                 -icon error \
 915                 -type ok \
 916                 -title [mc "git-gui: fatal error"] \
 917                 -message [mc "Cannot find git in PATH."]
 918         exit 1
 919 }
 920
 921 ######################################################################
 922 ##
 923 ## version check
 924
 925 if {[catch {set _git_version [git --version]} err]} {
 926         catch {wm withdraw .}
 927         tk_messageBox \
 928                 -icon error \
 929                 -type ok \
 930                 -title [mc "git-gui: fatal error"] \
 931                 -message "Cannot determine Git version:
 932
 933 $err
 934
 935 [appname] requires Git 1.5.0 or later."
 936         exit 1
 937 }
 938 if {![regsub {^git version } $_git_version {} _git_version]} {
 939         catch {wm withdraw .}
 940         tk_messageBox \
 941                 -icon error \
 942                 -type ok \
 943                 -title [mc "git-gui: fatal error"] \
 944                 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
 945         exit 1
 946 }
 947
 948 proc get_trimmed_version {s} {
 949     set r {}
 950     foreach x [split $s -._] {
 951         if {[string is integer -strict $x]} {
 952             lappend r $x
 953         } else {
 954             break
 955         }
 956     }
 957     return [join $r .]
 958 }
 959 set _real_git_version $_git_version
 960 set _git_version [get_trimmed_version $_git_version]
 961
 962 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
 963         catch {wm withdraw .}
 964         if {[tk_messageBox \
 965                 -icon warning \
 966                 -type yesno \
 967                 -default no \
 968                 -title "[appname]: warning" \
 969                  -message [mc "Git version cannot be determined.
 970
 971 %s claims it is version '%s'.
 972
 973 %s requires at least Git 1.5.0 or later.
 974
 975 Assume '%s' is version 1.5.0?
 976 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
 977                 set _git_version 1.5.0
 978         } else {
 979                 exit 1
 980         }
 981 }
 982 unset _real_git_version
 983
 984 proc git-version {args} {
 985         global _git_version
 986
 987         switch [llength $args] {
 988         0 {
 989                 return $_git_version
 990         }
 991
 992         2 {
 993                 set op [lindex $args 0]
 994                 set vr [lindex $args 1]
 995                 set cm [package vcompare $_git_version $vr]
 996                 return [expr $cm $op 0]
 997         }
 998
 999         4 {
1000                 set type [lindex $args 0]
1001                 set name [lindex $args 1]
1002                 set parm [lindex $args 2]
1003                 set body [lindex $args 3]
1004
1005                 if {($type ne {proc} && $type ne {method})} {
1006                         error "Invalid arguments to git-version"
1007                 }
1008                 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
1009                         error "Last arm of $type $name must be default"
1010                 }
1011
1012                 foreach {op vr cb} [lrange $body 0 end-2] {
1013                         if {[git-version $op $vr]} {
1014                                 return [uplevel [list $type $name $parm $cb]]
1015                         }
1016                 }
1017
1018                 return [uplevel [list $type $name $parm [lindex $body end]]]
1019         }
1020
1021         default {
1022                 error "git-version >= x"
1023         }
1024
1025         }
1026 }
1027
1028 if {[git-version < 1.5]} {
1029         catch {wm withdraw .}
1030         tk_messageBox \
1031                 -icon error \
1032                 -type ok \
1033                 -title [mc "git-gui: fatal error"] \
1034                 -message "[appname] requires Git 1.5.0 or later.
1035
1036 You are using [git-version]:
1037
1038 [git --version]"
1039         exit 1
1040 }
1041
1042 ######################################################################
1043 ##
1044 ## configure our library
1045
1046 set idx [file join $oguilib tclIndex]
1047 if {[catch {set fd [open $idx r]} err]} {
1048         catch {wm withdraw .}
1049         tk_messageBox \
1050                 -icon error \
1051                 -type ok \
1052                 -title [mc "git-gui: fatal error"] \
1053                 -message $err
1054         exit 1
1055 }
1056 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1057         set idx [list]
1058         while {[gets $fd n] >= 0} {
1059                 if {$n ne {} && ![string match #* $n]} {
1060                         lappend idx $n
1061                 }
1062         }
1063 } else {
1064         set idx {}
1065 }
1066 close $fd
1067
1068 if {$idx ne {}} {
1069         set loaded [list]
1070         foreach p $idx {
1071                 if {[lsearch -exact $loaded $p] >= 0} continue
1072                 source [file join $oguilib $p]
1073                 lappend loaded $p
1074         }
1075         unset loaded p
1076 } else {
1077         set auto_path [concat [list $oguilib] $auto_path]
1078 }
1079 unset -nocomplain idx fd
1080
1081 ######################################################################
1082 ##
1083 ## config file parsing
1084
1085 git-version proc _parse_config {arr_name args} {
1086         >= 1.5.3 {
1087                 upvar $arr_name arr
1088                 array unset arr
1089                 set buf {}
1090                 catch {
1091                         set fd_rc [eval \
1092                                 [list git_read config] \
1093                                 $args \
1094                                 [list --null --list]]
1095                         fconfigure $fd_rc -translation binary -encoding utf-8
1096                         set buf [read $fd_rc]
1097                         close $fd_rc
1098                 }
1099                 foreach line [split $buf "\0"] {
1100                         if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1101                                 if {[is_many_config $name]} {
1102                                         lappend arr($name) $value
1103                                 } else {
1104                                         set arr($name) $value
1105                                 }
1106                         } elseif {[regexp {^([^\n]+)$} $line line name]} {
1107                                 # no value given, but interpreting them as
1108                                 # boolean will be handled as true
1109                                 set arr($name) {}
1110                         }
1111                 }
1112         }
1113         default {
1114                 upvar $arr_name arr
1115                 array unset arr
1116                 catch {
1117                         set fd_rc [eval [list git_read config --list] $args]
1118                         while {[gets $fd_rc line] >= 0} {
1119                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1120                                         if {[is_many_config $name]} {
1121                                                 lappend arr($name) $value
1122                                         } else {
1123                                                 set arr($name) $value
1124                                         }
1125                                 } elseif {[regexp {^([^=]+)$} $line line name]} {
1126                                         # no value given, but interpreting them as
1127                                         # boolean will be handled as true
1128                                         set arr($name) {}
1129                                 }
1130                         }
1131                         close $fd_rc
1132                 }
1133         }
1134 }
1135
1136 proc load_config {include_global} {
1137         global repo_config global_config system_config default_config
1138
1139         if {$include_global} {
1140                 _parse_config system_config --system
1141                 _parse_config global_config --global
1142         }
1143         _parse_config repo_config
1144
1145         foreach name [array names default_config] {
1146                 if {[catch {set v $system_config($name)}]} {
1147                         set system_config($name) $default_config($name)
1148                 }
1149         }
1150         foreach name [array names system_config] {
1151                 if {[catch {set v $global_config($name)}]} {
1152                         set global_config($name) $system_config($name)
1153                 }
1154                 if {[catch {set v $repo_config($name)}]} {
1155                         set repo_config($name) $system_config($name)
1156                 }
1157         }
1158 }
1159
1160 ######################################################################
1161 ##
1162 ## feature option selection
1163
1164 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1165         unset _junk
1166 } else {
1167         set subcommand gui
1168 }
1169 if {$subcommand eq {gui.sh}} {
1170         set subcommand gui
1171 }
1172 if {$subcommand eq {gui} && [llength $argv] > 0} {
1173         set subcommand [lindex $argv 0]
1174         set argv [lrange $argv 1 end]
1175 }
1176
1177 enable_option multicommit
1178 enable_option branch
1179 enable_option transport
1180 disable_option bare
1181
1182 switch -- $subcommand {
1183 browser -
1184 blame {
1185         enable_option bare
1186
1187         disable_option multicommit
1188         disable_option branch
1189         disable_option transport
1190 }
1191 citool {
1192         enable_option singlecommit
1193         enable_option retcode
1194
1195         disable_option multicommit
1196         disable_option branch
1197         disable_option transport
1198
1199         while {[llength $argv] > 0} {
1200                 set a [lindex $argv 0]
1201                 switch -- $a {
1202                 --amend {
1203                         enable_option initialamend
1204                 }
1205                 --nocommit {
1206                         enable_option nocommit
1207                         enable_option nocommitmsg
1208                 }
1209                 --commitmsg {
1210                         disable_option nocommitmsg
1211                 }
1212                 default {
1213                         break
1214                 }
1215                 }
1216
1217                 set argv [lrange $argv 1 end]
1218         }
1219 }
1220 }
1221
1222 ######################################################################
1223 ##
1224 ## execution environment
1225
1226 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1227
1228 # Suggest our implementation of askpass, if none is set
1229 if {![info exists env(SSH_ASKPASS)]} {
1230         set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1231 }
1232
1233 ######################################################################
1234 ##
1235 ## repository setup
1236
1237 set picked 0
1238 if {[catch {
1239                 set _gitdir $env(GIT_DIR)
1240                 set _prefix {}
1241                 }]
1242         && [catch {
1243                 # beware that from the .git dir this sets _gitdir to .
1244                 # and _prefix to the empty string
1245                 set _gitdir [git rev-parse --git-dir]
1246                 set _prefix [git rev-parse --show-prefix]
1247         } err]} {
1248         load_config 1
1249         apply_config
1250         choose_repository::pick
1251         set picked 1
1252 }
1253
1254 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1255 # run from the .git dir itself) lest the routines to find the worktree
1256 # get confused
1257 if {$_gitdir eq "."} {
1258         set _gitdir [pwd]
1259 }
1260
1261 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1262         catch {set _gitdir [exec cygpath --windows $_gitdir]}
1263 }
1264 if {![file isdirectory $_gitdir]} {
1265         catch {wm withdraw .}
1266         error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1267         exit 1
1268 }
1269 # _gitdir exists, so try loading the config
1270 load_config 0
1271 apply_config
1272
1273 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1274 if {[package vcompare $_git_version 1.7.0] >= 0} {
1275         if { [is_Cygwin] } {
1276                 catch {set _gitworktree [exec cygpath --windows [git rev-parse --show-toplevel]]}
1277         } else {
1278                 set _gitworktree [git rev-parse --show-toplevel]
1279         }
1280 } else {
1281         # try to set work tree from environment, core.worktree or use
1282         # cdup to obtain a relative path to the top of the worktree. If
1283         # run from the top, the ./ prefix ensures normalize expands pwd.
1284         if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1285                 set _gitworktree [get_config core.worktree]
1286                 if {$_gitworktree eq ""} {
1287                         set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1288                 }
1289         }
1290 }
1291
1292 if {$_prefix ne {}} {
1293         if {$_gitworktree eq {}} {
1294                 regsub -all {[^/]+/} $_prefix ../ cdup
1295         } else {
1296                 set cdup $_gitworktree
1297         }
1298         if {[catch {cd $cdup} err]} {
1299                 catch {wm withdraw .}
1300                 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1301                 exit 1
1302         }
1303         set _gitworktree [pwd]
1304         unset cdup
1305 } elseif {![is_enabled bare]} {
1306         if {[is_bare]} {
1307                 catch {wm withdraw .}
1308                 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1309                 exit 1
1310         }
1311         if {$_gitworktree eq {}} {
1312                 set _gitworktree [file dirname $_gitdir]
1313         }
1314         if {[catch {cd $_gitworktree} err]} {
1315                 catch {wm withdraw .}
1316                 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1317                 exit 1
1318         }
1319         set _gitworktree [pwd]
1320 }
1321 set _reponame [file split [file normalize $_gitdir]]
1322 if {[lindex $_reponame end] eq {.git}} {
1323         set _reponame [lindex $_reponame end-1]
1324 } else {
1325         set _reponame [lindex $_reponame end]
1326 }
1327
1328 set env(GIT_DIR) $_gitdir
1329 set env(GIT_WORK_TREE) $_gitworktree
1330
1331 ######################################################################
1332 ##
1333 ## global init
1334
1335 set current_diff_path {}
1336 set current_diff_side {}
1337 set diff_actions [list]
1338
1339 set HEAD {}
1340 set PARENT {}
1341 set MERGE_HEAD [list]
1342 set commit_type {}
1343 set commit_type_is_amend 0
1344 set empty_tree {}
1345 set current_branch {}
1346 set is_detached 0
1347 set current_diff_path {}
1348 set is_3way_diff 0
1349 set is_submodule_diff 0
1350 set is_conflict_diff 0
1351 set diff_empty_count 0
1352 set last_revert {}
1353 set last_revert_enc {}
1354
1355 set nullid "0000000000000000000000000000000000000000"
1356 set nullid2 "0000000000000000000000000000000000000001"
1357
1358 ######################################################################
1359 ##
1360 ## task management
1361
1362 set rescan_active 0
1363 set diff_active 0
1364 set last_clicked {}
1365
1366 set disable_on_lock [list]
1367 set index_lock_type none
1368
1369 proc lock_index {type} {
1370         global index_lock_type disable_on_lock
1371
1372         if {$index_lock_type eq {none}} {
1373                 set index_lock_type $type
1374                 foreach w $disable_on_lock {
1375                         uplevel #0 $w disabled
1376                 }
1377                 return 1
1378         } elseif {$index_lock_type eq "begin-$type"} {
1379                 set index_lock_type $type
1380                 return 1
1381         }
1382         return 0
1383 }
1384
1385 proc unlock_index {} {
1386         global index_lock_type disable_on_lock
1387
1388         set index_lock_type none
1389         foreach w $disable_on_lock {
1390                 uplevel #0 $w normal
1391         }
1392 }
1393
1394 ######################################################################
1395 ##
1396 ## status
1397
1398 proc repository_state {ctvar hdvar mhvar} {
1399         global current_branch
1400         upvar $ctvar ct $hdvar hd $mhvar mh
1401
1402         set mh [list]
1403
1404         load_current_branch
1405         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1406                 set hd {}
1407                 set ct initial
1408                 return
1409         }
1410
1411         set merge_head [gitdir MERGE_HEAD]
1412         if {[file exists $merge_head]} {
1413                 set ct merge
1414                 set fd_mh [open $merge_head r]
1415                 while {[gets $fd_mh line] >= 0} {
1416                         lappend mh $line
1417                 }
1418                 close $fd_mh
1419                 return
1420         }
1421
1422         set ct normal
1423 }
1424
1425 proc PARENT {} {
1426         global PARENT empty_tree
1427
1428         set p [lindex $PARENT 0]
1429         if {$p ne {}} {
1430                 return $p
1431         }
1432         if {$empty_tree eq {}} {
1433                 set empty_tree [git mktree << {}]
1434         }
1435         return $empty_tree
1436 }
1437
1438 proc force_amend {} {
1439         global commit_type_is_amend
1440         global HEAD PARENT MERGE_HEAD commit_type
1441
1442         repository_state newType newHEAD newMERGE_HEAD
1443         set HEAD $newHEAD
1444         set PARENT $newHEAD
1445         set MERGE_HEAD $newMERGE_HEAD
1446         set commit_type $newType
1447
1448         set commit_type_is_amend 1
1449         do_select_commit_type
1450 }
1451
1452 proc rescan {after {honor_trustmtime 1}} {
1453         global HEAD PARENT MERGE_HEAD commit_type
1454         global ui_index ui_workdir ui_comm
1455         global rescan_active file_states
1456         global repo_config
1457
1458         if {$rescan_active > 0 || ![lock_index read]} return
1459
1460         repository_state newType newHEAD newMERGE_HEAD
1461         if {[string match amend* $commit_type]
1462                 && $newType eq {normal}
1463                 && $newHEAD eq $HEAD} {
1464         } else {
1465                 set HEAD $newHEAD
1466                 set PARENT $newHEAD
1467                 set MERGE_HEAD $newMERGE_HEAD
1468                 set commit_type $newType
1469         }
1470
1471         array unset file_states
1472
1473         if {!$::GITGUI_BCK_exists &&
1474                 (![$ui_comm edit modified]
1475                 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1476                 if {[string match amend* $commit_type]} {
1477                 } elseif {[load_message GITGUI_MSG utf-8]} {
1478                 } elseif {[run_prepare_commit_msg_hook]} {
1479                 } elseif {[load_message MERGE_MSG]} {
1480                 } elseif {[load_message SQUASH_MSG]} {
1481                 }
1482                 $ui_comm edit reset
1483                 $ui_comm edit modified false
1484         }
1485
1486         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1487                 rescan_stage2 {} $after
1488         } else {
1489                 set rescan_active 1
1490                 ui_status [mc "Refreshing file status..."]
1491                 set fd_rf [git_read update-index \
1492                         -q \
1493                         --unmerged \
1494                         --ignore-missing \
1495                         --refresh \
1496                         ]
1497                 fconfigure $fd_rf -blocking 0 -translation binary
1498                 fileevent $fd_rf readable \
1499                         [list rescan_stage2 $fd_rf $after]
1500         }
1501 }
1502
1503 if {[is_Cygwin]} {
1504         set is_git_info_exclude {}
1505         proc have_info_exclude {} {
1506                 global is_git_info_exclude
1507
1508                 if {$is_git_info_exclude eq {}} {
1509                         if {[catch {exec test -f [gitdir info exclude]}]} {
1510                                 set is_git_info_exclude 0
1511                         } else {
1512                                 set is_git_info_exclude 1
1513                         }
1514                 }
1515                 return $is_git_info_exclude
1516         }
1517 } else {
1518         proc have_info_exclude {} {
1519                 return [file readable [gitdir info exclude]]
1520         }
1521 }
1522
1523 proc rescan_stage2 {fd after} {
1524         global rescan_active buf_rdi buf_rdf buf_rlo
1525
1526         if {$fd ne {}} {
1527                 read $fd
1528                 if {![eof $fd]} return
1529                 close $fd
1530         }
1531
1532         if {[package vcompare $::_git_version 1.6.3] >= 0} {
1533                 set ls_others [list --exclude-standard]
1534         } else {
1535                 set ls_others [list --exclude-per-directory=.gitignore]
1536                 if {[have_info_exclude]} {
1537                         lappend ls_others "--exclude-from=[gitdir info exclude]"
1538                 }
1539                 set user_exclude [get_config core.excludesfile]
1540                 if {$user_exclude ne {} && [file readable $user_exclude]} {
1541                         lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1542                 }
1543         }
1544
1545         set buf_rdi {}
1546         set buf_rdf {}
1547         set buf_rlo {}
1548
1549         set rescan_active 2
1550         ui_status [mc "Scanning for modified files ..."]
1551         if {[git-version >= "1.7.2"]} {
1552                 set fd_di [git_read diff-index --cached --ignore-submodules=dirty -z [PARENT]]
1553         } else {
1554                 set fd_di [git_read diff-index --cached -z [PARENT]]
1555         }
1556         set fd_df [git_read diff-files -z]
1557
1558         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1559         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1560
1561         fileevent $fd_di readable [list read_diff_index $fd_di $after]
1562         fileevent $fd_df readable [list read_diff_files $fd_df $after]
1563
1564         if {[is_config_true gui.displayuntracked]} {
1565                 set fd_lo [eval git_read ls-files --others -z $ls_others]
1566                 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1567                 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1568                 incr rescan_active
1569         }
1570 }
1571
1572 proc load_message {file {encoding {}}} {
1573         global ui_comm
1574
1575         set f [gitdir $file]
1576         if {[file isfile $f]} {
1577                 if {[catch {set fd [open $f r]}]} {
1578                         return 0
1579                 }
1580                 fconfigure $fd -eofchar {}
1581                 if {$encoding ne {}} {
1582                         fconfigure $fd -encoding $encoding
1583                 }
1584                 set content [string trim [read $fd]]
1585                 close $fd
1586                 regsub -all -line {[ \r\t]+$} $content {} content
1587                 $ui_comm delete 0.0 end
1588                 $ui_comm insert end $content
1589                 return 1
1590         }
1591         return 0
1592 }
1593
1594 proc run_prepare_commit_msg_hook {} {
1595         global pch_error
1596
1597         # prepare-commit-msg requires PREPARE_COMMIT_MSG exist.  From git-gui
1598         # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1599         # empty file but existent file.
1600
1601         set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1602
1603         if {[file isfile [gitdir MERGE_MSG]]} {
1604                 set pcm_source "merge"
1605                 set fd_mm [open [gitdir MERGE_MSG] r]
1606                 fconfigure $fd_mm -encoding utf-8
1607                 puts -nonewline $fd_pcm [read $fd_mm]
1608                 close $fd_mm
1609         } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1610                 set pcm_source "squash"
1611                 set fd_sm [open [gitdir SQUASH_MSG] r]
1612                 fconfigure $fd_sm -encoding utf-8
1613                 puts -nonewline $fd_pcm [read $fd_sm]
1614                 close $fd_sm
1615         } else {
1616                 set pcm_source ""
1617         }
1618
1619         close $fd_pcm
1620
1621         set fd_ph [githook_read prepare-commit-msg \
1622                         [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1623         if {$fd_ph eq {}} {
1624                 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1625                 return 0;
1626         }
1627
1628         ui_status [mc "Calling prepare-commit-msg hook..."]
1629         set pch_error {}
1630
1631         fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1632         fileevent $fd_ph readable \
1633                 [list prepare_commit_msg_hook_wait $fd_ph]
1634
1635         return 1;
1636 }
1637
1638 proc prepare_commit_msg_hook_wait {fd_ph} {
1639         global pch_error
1640
1641         append pch_error [read $fd_ph]
1642         fconfigure $fd_ph -blocking 1
1643         if {[eof $fd_ph]} {
1644                 if {[catch {close $fd_ph}]} {
1645                         ui_status [mc "Commit declined by prepare-commit-msg hook."]
1646                         hook_failed_popup prepare-commit-msg $pch_error
1647                         catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1648                         exit 1
1649                 } else {
1650                         load_message PREPARE_COMMIT_MSG
1651                 }
1652                 set pch_error {}
1653                 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1654                 return
1655         }
1656         fconfigure $fd_ph -blocking 0
1657         catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1658 }
1659
1660 proc read_diff_index {fd after} {
1661         global buf_rdi
1662
1663         append buf_rdi [read $fd]
1664         set c 0
1665         set n [string length $buf_rdi]
1666         while {$c < $n} {
1667                 set z1 [string first "\0" $buf_rdi $c]
1668                 if {$z1 == -1} break
1669                 incr z1
1670                 set z2 [string first "\0" $buf_rdi $z1]
1671                 if {$z2 == -1} break
1672
1673                 incr c
1674                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1675                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1676                 merge_state \
1677                         [encoding convertfrom utf-8 $p] \
1678                         [lindex $i 4]? \
1679                         [list [lindex $i 0] [lindex $i 2]] \
1680                         [list]
1681                 set c $z2
1682                 incr c
1683         }
1684         if {$c < $n} {
1685                 set buf_rdi [string range $buf_rdi $c end]
1686         } else {
1687                 set buf_rdi {}
1688         }
1689
1690         rescan_done $fd buf_rdi $after
1691 }
1692
1693 proc read_diff_files {fd after} {
1694         global buf_rdf
1695
1696         append buf_rdf [read $fd]
1697         set c 0
1698         set n [string length $buf_rdf]
1699         while {$c < $n} {
1700                 set z1 [string first "\0" $buf_rdf $c]
1701                 if {$z1 == -1} break
1702                 incr z1
1703                 set z2 [string first "\0" $buf_rdf $z1]
1704                 if {$z2 == -1} break
1705
1706                 incr c
1707                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1708                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1709                 merge_state \
1710                         [encoding convertfrom utf-8 $p] \
1711                         ?[lindex $i 4] \
1712                         [list] \
1713                         [list [lindex $i 0] [lindex $i 2]]
1714                 set c $z2
1715                 incr c
1716         }
1717         if {$c < $n} {
1718                 set buf_rdf [string range $buf_rdf $c end]
1719         } else {
1720                 set buf_rdf {}
1721         }
1722
1723         rescan_done $fd buf_rdf $after
1724 }
1725
1726 proc read_ls_others {fd after} {
1727         global buf_rlo
1728
1729         append buf_rlo [read $fd]
1730         set pck [split $buf_rlo "\0"]
1731         set buf_rlo [lindex $pck end]
1732         foreach p [lrange $pck 0 end-1] {
1733                 set p [encoding convertfrom utf-8 $p]
1734                 if {[string index $p end] eq {/}} {
1735                         set p [string range $p 0 end-1]
1736                 }
1737                 merge_state $p ?O
1738         }
1739         rescan_done $fd buf_rlo $after
1740 }
1741
1742 proc rescan_done {fd buf after} {
1743         global rescan_active current_diff_path
1744         global file_states repo_config
1745         upvar $buf to_clear
1746
1747         if {![eof $fd]} return
1748         set to_clear {}
1749         close $fd
1750         if {[incr rescan_active -1] > 0} return
1751
1752         prune_selection
1753         unlock_index
1754         display_all_files
1755         if {$current_diff_path ne {}} { reshow_diff $after }
1756         if {$current_diff_path eq {}} { select_first_diff $after }
1757 }
1758
1759 proc prune_selection {} {
1760         global file_states selected_paths
1761
1762         foreach path [array names selected_paths] {
1763                 if {[catch {set still_here $file_states($path)}]} {
1764                         unset selected_paths($path)
1765                 }
1766         }
1767 }
1768
1769 ######################################################################
1770 ##
1771 ## ui helpers
1772
1773 proc mapicon {w state path} {
1774         global all_icons
1775
1776         if {[catch {set r $all_icons($state$w)}]} {
1777                 puts "error: no icon for $w state={$state} $path"
1778                 return file_plain
1779         }
1780         return $r
1781 }
1782
1783 proc mapdesc {state path} {
1784         global all_descs
1785
1786         if {[catch {set r $all_descs($state)}]} {
1787                 puts "error: no desc for state={$state} $path"
1788                 return $state
1789         }
1790         return $r
1791 }
1792
1793 proc ui_status {msg} {
1794         global main_status
1795         if {[info exists main_status]} {
1796                 $main_status show $msg
1797         }
1798 }
1799
1800 proc ui_ready {{test {}}} {
1801         global main_status
1802         if {[info exists main_status]} {
1803                 $main_status show [mc "Ready."] $test
1804         }
1805 }
1806
1807 proc escape_path {path} {
1808         regsub -all {\\} $path "\\\\" path
1809         regsub -all "\n" $path "\\n" path
1810         return $path
1811 }
1812
1813 proc short_path {path} {
1814         return [escape_path [lindex [file split $path] end]]
1815 }
1816
1817 set next_icon_id 0
1818 set null_sha1 [string repeat 0 40]
1819
1820 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1821         global file_states next_icon_id null_sha1
1822
1823         set s0 [string index $new_state 0]
1824         set s1 [string index $new_state 1]
1825
1826         if {[catch {set info $file_states($path)}]} {
1827                 set state __
1828                 set icon n[incr next_icon_id]
1829         } else {
1830                 set state [lindex $info 0]
1831                 set icon [lindex $info 1]
1832                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1833                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1834         }
1835
1836         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1837         elseif {$s0 eq {_}} {set s0 _}
1838
1839         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1840         elseif {$s1 eq {_}} {set s1 _}
1841
1842         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1843                 set head_info [list 0 $null_sha1]
1844         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1845                 && $head_info eq {}} {
1846                 set head_info $index_info
1847         } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1848                 set index_info $head_info
1849                 set head_info {}
1850         }
1851
1852         set file_states($path) [list $s0$s1 $icon \
1853                 $head_info $index_info \
1854                 ]
1855         return $state
1856 }
1857
1858 proc display_file_helper {w path icon_name old_m new_m} {
1859         global file_lists
1860
1861         if {$new_m eq {_}} {
1862                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1863                 if {$lno >= 0} {
1864                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1865                         incr lno
1866                         $w conf -state normal
1867                         $w delete $lno.0 [expr {$lno + 1}].0
1868                         $w conf -state disabled
1869                 }
1870         } elseif {$old_m eq {_} && $new_m ne {_}} {
1871                 lappend file_lists($w) $path
1872                 set file_lists($w) [lsort -unique $file_lists($w)]
1873                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1874                 incr lno
1875                 $w conf -state normal
1876                 $w image create $lno.0 \
1877                         -align center -padx 5 -pady 1 \
1878                         -name $icon_name \
1879                         -image [mapicon $w $new_m $path]
1880                 $w insert $lno.1 "[escape_path $path]\n"
1881                 $w conf -state disabled
1882         } elseif {$old_m ne $new_m} {
1883                 $w conf -state normal
1884                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1885                 $w conf -state disabled
1886         }
1887 }
1888
1889 proc display_file {path state} {
1890         global file_states selected_paths
1891         global ui_index ui_workdir
1892
1893         set old_m [merge_state $path $state]
1894         set s $file_states($path)
1895         set new_m [lindex $s 0]
1896         set icon_name [lindex $s 1]
1897
1898         set o [string index $old_m 0]
1899         set n [string index $new_m 0]
1900         if {$o eq {U}} {
1901                 set o _
1902         }
1903         if {$n eq {U}} {
1904                 set n _
1905         }
1906         display_file_helper     $ui_index $path $icon_name $o $n
1907
1908         if {[string index $old_m 0] eq {U}} {
1909                 set o U
1910         } else {
1911                 set o [string index $old_m 1]
1912         }
1913         if {[string index $new_m 0] eq {U}} {
1914                 set n U
1915         } else {
1916                 set n [string index $new_m 1]
1917         }
1918         display_file_helper     $ui_workdir $path $icon_name $o $n
1919
1920         if {$new_m eq {__}} {
1921                 unset file_states($path)
1922                 catch {unset selected_paths($path)}
1923         }
1924 }
1925
1926 proc display_all_files_helper {w path icon_name m} {
1927         global file_lists
1928
1929         lappend file_lists($w) $path
1930         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1931         $w image create end \
1932                 -align center -padx 5 -pady 1 \
1933                 -name $icon_name \
1934                 -image [mapicon $w $m $path]
1935         $w insert end "[escape_path $path]\n"
1936 }
1937
1938 set files_warning 0
1939 proc display_all_files {} {
1940         global ui_index ui_workdir
1941         global file_states file_lists
1942         global last_clicked
1943         global files_warning
1944
1945         $ui_index conf -state normal
1946         $ui_workdir conf -state normal
1947
1948         $ui_index delete 0.0 end
1949         $ui_workdir delete 0.0 end
1950         set last_clicked {}
1951
1952         set file_lists($ui_index) [list]
1953         set file_lists($ui_workdir) [list]
1954
1955         set to_display [lsort [array names file_states]]
1956         set display_limit [get_config gui.maxfilesdisplayed]
1957         set displayed 0
1958         foreach path $to_display {
1959                 set s $file_states($path)
1960                 set m [lindex $s 0]
1961                 set icon_name [lindex $s 1]
1962
1963                 if {$displayed > $display_limit && [string index $m 1] eq {O} } {
1964                         if {!$files_warning} {
1965                                 # do not repeatedly warn:
1966                                 set files_warning 1
1967                                 info_popup [mc "Display limit (gui.maxfilesdisplayed = %s) reached, not showing all %s files." \
1968                                         $display_limit [llength $to_display]]
1969                         }
1970                         continue
1971                 }
1972
1973                 set s [string index $m 0]
1974                 if {$s ne {U} && $s ne {_}} {
1975                         display_all_files_helper $ui_index $path \
1976                                 $icon_name $s
1977                 }
1978
1979                 if {[string index $m 0] eq {U}} {
1980                         set s U
1981                 } else {
1982                         set s [string index $m 1]
1983                 }
1984                 if {$s ne {_}} {
1985                         display_all_files_helper $ui_workdir $path \
1986                                 $icon_name $s
1987                         incr displayed
1988                 }
1989         }
1990
1991         $ui_index conf -state disabled
1992         $ui_workdir conf -state disabled
1993 }
1994
1995 ######################################################################
1996 ##
1997 ## icons
1998
1999 set filemask {
2000 #define mask_width 14
2001 #define mask_height 15
2002 static unsigned char mask_bits[] = {
2003    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2004    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2005    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2006 }
2007
2008 image create bitmap file_plain -background white -foreground black -data {
2009 #define plain_width 14
2010 #define plain_height 15
2011 static unsigned char plain_bits[] = {
2012    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2013    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2014    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2015 } -maskdata $filemask
2016
2017 image create bitmap file_mod -background white -foreground blue -data {
2018 #define mod_width 14
2019 #define mod_height 15
2020 static unsigned char mod_bits[] = {
2021    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2022    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2023    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2024 } -maskdata $filemask
2025
2026 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2027 #define file_fulltick_width 14
2028 #define file_fulltick_height 15
2029 static unsigned char file_fulltick_bits[] = {
2030    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2031    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2032    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2033 } -maskdata $filemask
2034
2035 image create bitmap file_question -background white -foreground black -data {
2036 #define file_question_width 14
2037 #define file_question_height 15
2038 static unsigned char file_question_bits[] = {
2039    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2040    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2041    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2042 } -maskdata $filemask
2043
2044 image create bitmap file_removed -background white -foreground red -data {
2045 #define file_removed_width 14
2046 #define file_removed_height 15
2047 static unsigned char file_removed_bits[] = {
2048    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2049    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2050    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2051 } -maskdata $filemask
2052
2053 image create bitmap file_merge -background white -foreground blue -data {
2054 #define file_merge_width 14
2055 #define file_merge_height 15
2056 static unsigned char file_merge_bits[] = {
2057    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2058    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2059    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2060 } -maskdata $filemask
2061
2062 image create bitmap file_statechange -background white -foreground green -data {
2063 #define file_statechange_width 14
2064 #define file_statechange_height 15
2065 static unsigned char file_statechange_bits[] = {
2066    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2067    0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2068    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2069 } -maskdata $filemask
2070
2071 set ui_index .vpane.files.index.list
2072 set ui_workdir .vpane.files.workdir.list
2073
2074 set all_icons(_$ui_index)   file_plain
2075 set all_icons(A$ui_index)   file_plain
2076 set all_icons(M$ui_index)   file_fulltick
2077 set all_icons(D$ui_index)   file_removed
2078 set all_icons(U$ui_index)   file_merge
2079 set all_icons(T$ui_index)   file_statechange
2080
2081 set all_icons(_$ui_workdir) file_plain
2082 set all_icons(M$ui_workdir) file_mod
2083 set all_icons(D$ui_workdir) file_question
2084 set all_icons(U$ui_workdir) file_merge
2085 set all_icons(O$ui_workdir) file_plain
2086 set all_icons(T$ui_workdir) file_statechange
2087
2088 set max_status_desc 0
2089 foreach i {
2090                 {__ {mc "Unmodified"}}
2091
2092                 {_M {mc "Modified, not staged"}}
2093                 {M_ {mc "Staged for commit"}}
2094                 {MM {mc "Portions staged for commit"}}
2095                 {MD {mc "Staged for commit, missing"}}
2096
2097                 {_T {mc "File type changed, not staged"}}
2098                 {MT {mc "File type changed, old type staged for commit"}}
2099                 {AT {mc "File type changed, old type staged for commit"}}
2100                 {T_ {mc "File type changed, staged"}}
2101                 {TM {mc "File type change staged, modification not staged"}}
2102                 {TD {mc "File type change staged, file missing"}}
2103
2104                 {_O {mc "Untracked, not staged"}}
2105                 {A_ {mc "Staged for commit"}}
2106                 {AM {mc "Portions staged for commit"}}
2107                 {AD {mc "Staged for commit, missing"}}
2108
2109                 {_D {mc "Missing"}}
2110                 {D_ {mc "Staged for removal"}}
2111                 {DO {mc "Staged for removal, still present"}}
2112
2113                 {_U {mc "Requires merge resolution"}}
2114                 {U_ {mc "Requires merge resolution"}}
2115                 {UU {mc "Requires merge resolution"}}
2116                 {UM {mc "Requires merge resolution"}}
2117                 {UD {mc "Requires merge resolution"}}
2118                 {UT {mc "Requires merge resolution"}}
2119         } {
2120         set text [eval [lindex $i 1]]
2121         if {$max_status_desc < [string length $text]} {
2122                 set max_status_desc [string length $text]
2123         }
2124         set all_descs([lindex $i 0]) $text
2125 }
2126 unset i
2127
2128 ######################################################################
2129 ##
2130 ## util
2131
2132 proc scrollbar2many {list mode args} {
2133         foreach w $list {eval $w $mode $args}
2134 }
2135
2136 proc many2scrollbar {list mode sb top bottom} {
2137         $sb set $top $bottom
2138         foreach w $list {$w $mode moveto $top}
2139 }
2140
2141 proc incr_font_size {font {amt 1}} {
2142         set sz [font configure $font -size]
2143         incr sz $amt
2144         font configure $font -size $sz
2145         font configure ${font}bold -size $sz
2146         font configure ${font}italic -size $sz
2147 }
2148
2149 ######################################################################
2150 ##
2151 ## ui commands
2152
2153 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2154
2155 proc do_gitk {revs {is_submodule false}} {
2156         global current_diff_path file_states current_diff_side ui_index
2157         global _gitdir _gitworktree
2158
2159         # -- Always start gitk through whatever we were loaded with.  This
2160         #    lets us bypass using shell process on Windows systems.
2161         #
2162         set exe [_which gitk -script]
2163         set cmd [list [info nameofexecutable] $exe]
2164         if {$exe eq {}} {
2165                 error_popup [mc "Couldn't find gitk in PATH"]
2166         } else {
2167                 global env
2168
2169                 set pwd [pwd]
2170
2171                 if {!$is_submodule} {
2172                         if {![is_bare]} {
2173                                 cd $_gitworktree
2174                         }
2175                 } else {
2176                         cd $current_diff_path
2177                         if {$revs eq {--}} {
2178                                 set s $file_states($current_diff_path)
2179                                 set old_sha1 {}
2180                                 set new_sha1 {}
2181                                 switch -glob -- [lindex $s 0] {
2182                                 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2183                                 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2184                                 MM {
2185                                         if {$current_diff_side eq $ui_index} {
2186                                                 set old_sha1 [lindex [lindex $s 2] 1]
2187                                                 set new_sha1 [lindex [lindex $s 3] 1]
2188                                         } else {
2189                                                 set old_sha1 [lindex [lindex $s 3] 1]
2190                                         }
2191                                 }
2192                                 }
2193                                 set revs $old_sha1...$new_sha1
2194                         }
2195                         # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2196                         # we've been using for the main repository, so unset them.
2197                         # TODO we could make life easier (start up faster?) for gitk
2198                         # by setting these to the appropriate values to allow gitk
2199                         # to skip the heuristics to find their proper value
2200                         unset env(GIT_DIR)
2201                         unset env(GIT_WORK_TREE)
2202                 }
2203                 eval exec $cmd $revs "--" "--" &
2204
2205                 set env(GIT_DIR) $_gitdir
2206                 set env(GIT_WORK_TREE) $_gitworktree
2207                 cd $pwd
2208
2209                 ui_status $::starting_gitk_msg
2210                 after 10000 {
2211                         ui_ready $starting_gitk_msg
2212                 }
2213         }
2214 }
2215
2216 proc do_git_gui {} {
2217         global current_diff_path
2218
2219         # -- Always start git gui through whatever we were loaded with.  This
2220         #    lets us bypass using shell process on Windows systems.
2221         #
2222         set exe [list [_which git]]
2223         if {$exe eq {}} {
2224                 error_popup [mc "Couldn't find git gui in PATH"]
2225         } else {
2226                 global env
2227                 global _gitdir _gitworktree
2228
2229                 # see note in do_gitk about unsetting these vars when
2230                 # running tools in a submodule
2231                 unset env(GIT_DIR)
2232                 unset env(GIT_WORK_TREE)
2233
2234                 set pwd [pwd]
2235                 cd $current_diff_path
2236
2237                 eval exec $exe gui &
2238
2239                 set env(GIT_DIR) $_gitdir
2240                 set env(GIT_WORK_TREE) $_gitworktree
2241                 cd $pwd
2242
2243                 ui_status $::starting_gitk_msg
2244                 after 10000 {
2245                         ui_ready $starting_gitk_msg
2246                 }
2247         }
2248 }
2249
2250 proc do_explore {} {
2251         global _gitworktree
2252         set explorer {}
2253         if {[is_Cygwin] || [is_Windows]} {
2254                 set explorer "explorer.exe"
2255         } elseif {[is_MacOSX]} {
2256                 set explorer "open"
2257         } else {
2258                 # freedesktop.org-conforming system is our best shot
2259                 set explorer "xdg-open"
2260         }
2261         eval exec $explorer [list [file nativename $_gitworktree]] &
2262 }
2263
2264 set is_quitting 0
2265 set ret_code    1
2266
2267 proc terminate_me {win} {
2268         global ret_code
2269         if {$win ne {.}} return
2270         exit $ret_code
2271 }
2272
2273 proc do_quit {{rc {1}}} {
2274         global ui_comm is_quitting repo_config commit_type
2275         global GITGUI_BCK_exists GITGUI_BCK_i
2276         global ui_comm_spell
2277         global ret_code use_ttk
2278
2279         if {$is_quitting} return
2280         set is_quitting 1
2281
2282         if {[winfo exists $ui_comm]} {
2283                 # -- Stash our current commit buffer.
2284                 #
2285                 set save [gitdir GITGUI_MSG]
2286                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2287                         file rename -force [gitdir GITGUI_BCK] $save
2288                         set GITGUI_BCK_exists 0
2289                 } else {
2290                         set msg [string trim [$ui_comm get 0.0 end]]
2291                         regsub -all -line {[ \r\t]+$} $msg {} msg
2292                         if {(![string match amend* $commit_type]
2293                                 || [$ui_comm edit modified])
2294                                 && $msg ne {}} {
2295                                 catch {
2296                                         set fd [open $save w]
2297                                         fconfigure $fd -encoding utf-8
2298                                         puts -nonewline $fd $msg
2299                                         close $fd
2300                                 }
2301                         } else {
2302                                 catch {file delete $save}
2303                         }
2304                 }
2305
2306                 # -- Cancel our spellchecker if its running.
2307                 #
2308                 if {[info exists ui_comm_spell]} {
2309                         $ui_comm_spell stop
2310                 }
2311
2312                 # -- Remove our editor backup, its not needed.
2313                 #
2314                 after cancel $GITGUI_BCK_i
2315                 if {$GITGUI_BCK_exists} {
2316                         catch {file delete [gitdir GITGUI_BCK]}
2317                 }
2318
2319                 # -- Stash our current window geometry into this repository.
2320                 #
2321                 set cfg_wmstate [wm state .]
2322                 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2323                         set rc_wmstate {}
2324                 }
2325                 if {$cfg_wmstate ne $rc_wmstate} {
2326                         catch {git config gui.wmstate $cfg_wmstate}
2327                 }
2328                 if {$cfg_wmstate eq {zoomed}} {
2329                         # on Windows wm geometry will lie about window
2330                         # position (but not size) when window is zoomed
2331                         # restore the window before querying wm geometry
2332                         wm state . normal
2333                 }
2334                 set cfg_geometry [list]
2335                 lappend cfg_geometry [wm geometry .]
2336                 if {$use_ttk} {
2337                         lappend cfg_geometry [.vpane sashpos 0]
2338                         lappend cfg_geometry [.vpane.files sashpos 0]
2339                 } else {
2340                         lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2341                         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2342                 }
2343                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2344                         set rc_geometry {}
2345                 }
2346                 if {$cfg_geometry ne $rc_geometry} {
2347                         catch {git config gui.geometry $cfg_geometry}
2348                 }
2349         }
2350
2351         set ret_code $rc
2352
2353         # Briefly enable send again, working around Tk bug
2354         # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2355         tk appname [appname]
2356
2357         destroy .
2358 }
2359
2360 proc do_rescan {} {
2361         rescan ui_ready
2362 }
2363
2364 proc ui_do_rescan {} {
2365         rescan {force_first_diff ui_ready}
2366 }
2367
2368 proc do_commit {} {
2369         commit_tree
2370 }
2371
2372 proc next_diff {{after {}}} {
2373         global next_diff_p next_diff_w next_diff_i
2374         show_diff $next_diff_p $next_diff_w {} {} $after
2375 }
2376
2377 proc find_anchor_pos {lst name} {
2378         set lid [lsearch -sorted -exact $lst $name]
2379
2380         if {$lid == -1} {
2381                 set lid 0
2382                 foreach lname $lst {
2383                         if {$lname >= $name} break
2384                         incr lid
2385                 }
2386         }
2387
2388         return $lid
2389 }
2390
2391 proc find_file_from {flist idx delta path mmask} {
2392         global file_states
2393
2394         set len [llength $flist]
2395         while {$idx >= 0 && $idx < $len} {
2396                 set name [lindex $flist $idx]
2397
2398                 if {$name ne $path && [info exists file_states($name)]} {
2399                         set state [lindex $file_states($name) 0]
2400
2401                         if {$mmask eq {} || [regexp $mmask $state]} {
2402                                 return $idx
2403                         }
2404                 }
2405
2406                 incr idx $delta
2407         }
2408
2409         return {}
2410 }
2411
2412 proc find_next_diff {w path {lno {}} {mmask {}}} {
2413         global next_diff_p next_diff_w next_diff_i
2414         global file_lists ui_index ui_workdir
2415
2416         set flist $file_lists($w)
2417         if {$lno eq {}} {
2418                 set lno [find_anchor_pos $flist $path]
2419         } else {
2420                 incr lno -1
2421         }
2422
2423         if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2424                 if {$w eq $ui_index} {
2425                         set mmask "^$mmask"
2426                 } else {
2427                         set mmask "$mmask\$"
2428                 }
2429         }
2430
2431         set idx [find_file_from $flist $lno 1 $path $mmask]
2432         if {$idx eq {}} {
2433                 incr lno -1
2434                 set idx [find_file_from $flist $lno -1 $path $mmask]
2435         }
2436
2437         if {$idx ne {}} {
2438                 set next_diff_w $w
2439                 set next_diff_p [lindex $flist $idx]
2440                 set next_diff_i [expr {$idx+1}]
2441                 return 1
2442         } else {
2443                 return 0
2444         }
2445 }
2446
2447 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2448         global current_diff_path
2449
2450         if {$path ne $current_diff_path} {
2451                 return {}
2452         } elseif {[find_next_diff $w $path $lno $mmask]} {
2453                 return {next_diff;}
2454         } else {
2455                 return {reshow_diff;}
2456         }
2457 }
2458
2459 proc select_first_diff {after} {
2460         global ui_workdir
2461
2462         if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2463             [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2464                 next_diff $after
2465         } else {
2466                 uplevel #0 $after
2467         }
2468 }
2469
2470 proc force_first_diff {after} {
2471         global ui_workdir current_diff_path file_states
2472
2473         if {[info exists file_states($current_diff_path)]} {
2474                 set state [lindex $file_states($current_diff_path) 0]
2475         } else {
2476                 set state {OO}
2477         }
2478
2479         set reselect 0
2480         if {[string first {U} $state] >= 0} {
2481                 # Already a conflict, do nothing
2482         } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2483                 set reselect 1
2484         } elseif {[string index $state 1] ne {O}} {
2485                 # Already a diff & no conflicts, do nothing
2486         } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2487                 set reselect 1
2488         }
2489
2490         if {$reselect} {
2491                 next_diff $after
2492         } else {
2493                 uplevel #0 $after
2494         }
2495 }
2496
2497 proc toggle_or_diff {mode w args} {
2498         global file_states file_lists current_diff_path ui_index ui_workdir
2499         global last_clicked selected_paths file_lists_last_clicked
2500
2501         if {$mode eq "click"} {
2502                 foreach {x y} $args break
2503                 set pos [split [$w index @$x,$y] .]
2504                 foreach {lno col} $pos break
2505         } else {
2506                 if {$mode eq "toggle"} {
2507                         if {$w eq $ui_workdir} {
2508                                 do_add_selection
2509                                 set last_clicked {}
2510                                 return
2511                         }
2512                         if {$w eq $ui_index} {
2513                                 do_unstage_selection
2514                                 set last_clicked {}
2515                                 return
2516                         }
2517                 }
2518
2519                 if {$last_clicked ne {}} {
2520                         set lno [lindex $last_clicked 1]
2521                 } else {
2522                         if {![info exists file_lists]
2523                                 || ![info exists file_lists($w)]
2524                                 || [llength $file_lists($w)] == 0} {
2525                                 set last_clicked {}
2526                                 return
2527                         }
2528                         set lno [expr {int([lindex [$w tag ranges in_diff] 0])}]
2529                 }
2530                 if {$mode eq "toggle"} {
2531                         set col 0; set y 2
2532                 } else {
2533                         incr lno [expr {$mode eq "up" ? -1 : 1}]
2534                         set col 1
2535                 }
2536         }
2537
2538         if {![info exists file_lists]
2539                 || ![info exists file_lists($w)]
2540                 || [llength $file_lists($w)] < $lno - 1} {
2541                 set path {}
2542         } else {
2543                 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2544         }
2545         if {$path eq {}} {
2546                 set last_clicked {}
2547                 return
2548         }
2549
2550         set last_clicked [list $w $lno]
2551         focus $w
2552         array unset selected_paths
2553         $ui_index tag remove in_sel 0.0 end
2554         $ui_workdir tag remove in_sel 0.0 end
2555
2556         set file_lists_last_clicked($w) $path
2557
2558         # Determine the state of the file
2559         if {[info exists file_states($path)]} {
2560                 set state [lindex $file_states($path) 0]
2561         } else {
2562                 set state {__}
2563         }
2564
2565         # Restage the file, or simply show the diff
2566         if {$col == 0 && $y > 1} {
2567                 # Conflicts need special handling
2568                 if {[string first {U} $state] >= 0} {
2569                         # $w must always be $ui_workdir, but...
2570                         if {$w ne $ui_workdir} { set lno {} }
2571                         merge_stage_workdir $path $lno
2572                         return
2573                 }
2574
2575                 if {[string index $state 1] eq {O}} {
2576                         set mmask {}
2577                 } else {
2578                         set mmask {[^O]}
2579                 }
2580
2581                 set after [next_diff_after_action $w $path $lno $mmask]
2582
2583                 if {$w eq $ui_index} {
2584                         update_indexinfo \
2585                                 "Unstaging [short_path $path] from commit" \
2586                                 [list $path] \
2587                                 [concat $after [list ui_ready]]
2588                 } elseif {$w eq $ui_workdir} {
2589                         update_index \
2590                                 "Adding [short_path $path]" \
2591                                 [list $path] \
2592                                 [concat $after [list ui_ready]]
2593                 }
2594         } else {
2595                 set selected_paths($path) 1
2596                 show_diff $path $w $lno
2597         }
2598 }
2599
2600 proc add_one_to_selection {w x y} {
2601         global file_lists last_clicked selected_paths
2602
2603         set lno [lindex [split [$w index @$x,$y] .] 0]
2604         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2605         if {$path eq {}} {
2606                 set last_clicked {}
2607                 return
2608         }
2609
2610         if {$last_clicked ne {}
2611                 && [lindex $last_clicked 0] ne $w} {
2612                 array unset selected_paths
2613                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2614         }
2615
2616         set last_clicked [list $w $lno]
2617         if {[catch {set in_sel $selected_paths($path)}]} {
2618                 set in_sel 0
2619         }
2620         if {$in_sel} {
2621                 unset selected_paths($path)
2622                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2623         } else {
2624                 set selected_paths($path) 1
2625                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2626         }
2627 }
2628
2629 proc add_range_to_selection {w x y} {
2630         global file_lists last_clicked selected_paths
2631
2632         if {[lindex $last_clicked 0] ne $w} {
2633                 toggle_or_diff click $w $x $y
2634                 return
2635         }
2636
2637         set lno [lindex [split [$w index @$x,$y] .] 0]
2638         set lc [lindex $last_clicked 1]
2639         if {$lc < $lno} {
2640                 set begin $lc
2641                 set end $lno
2642         } else {
2643                 set begin $lno
2644                 set end $lc
2645         }
2646
2647         foreach path [lrange $file_lists($w) \
2648                 [expr {$begin - 1}] \
2649                 [expr {$end - 1}]] {
2650                 set selected_paths($path) 1
2651         }
2652         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2653 }
2654
2655 proc show_more_context {} {
2656         global repo_config
2657         if {$repo_config(gui.diffcontext) < 99} {
2658                 incr repo_config(gui.diffcontext)
2659                 reshow_diff
2660         }
2661 }
2662
2663 proc show_less_context {} {
2664         global repo_config
2665         if {$repo_config(gui.diffcontext) > 1} {
2666                 incr repo_config(gui.diffcontext) -1
2667                 reshow_diff
2668         }
2669 }
2670
2671 proc focus_widget {widget} {
2672         global file_lists last_clicked selected_paths
2673         global file_lists_last_clicked
2674
2675         if {[llength $file_lists($widget)] > 0} {
2676                 set path $file_lists_last_clicked($widget)
2677                 set index [lsearch -sorted -exact $file_lists($widget) $path]
2678                 if {$index < 0} {
2679                         set index 0
2680                         set path [lindex $file_lists($widget) $index]
2681                 }
2682
2683                 focus $widget
2684                 set last_clicked [list $widget [expr $index + 1]]
2685                 array unset selected_paths
2686                 set selected_paths($path) 1
2687                 show_diff $path $widget
2688         }
2689 }
2690
2691 proc toggle_commit_type {} {
2692         global commit_type_is_amend
2693         set commit_type_is_amend [expr !$commit_type_is_amend]
2694         do_select_commit_type
2695 }
2696
2697 ######################################################################
2698 ##
2699 ## ui construction
2700
2701 set ui_comm {}
2702
2703 # -- Menu Bar
2704 #
2705 menu .mbar -tearoff 0
2706 if {[is_MacOSX]} {
2707         # -- Apple Menu (Mac OS X only)
2708         #
2709         .mbar add cascade -label Apple -menu .mbar.apple
2710         menu .mbar.apple
2711 }
2712 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2713 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2714 if {[is_enabled branch]} {
2715         .mbar add cascade -label [mc Branch] -menu .mbar.branch
2716 }
2717 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2718         .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2719 }
2720 if {[is_enabled transport]} {
2721         .mbar add cascade -label [mc Merge] -menu .mbar.merge
2722         .mbar add cascade -label [mc Remote] -menu .mbar.remote
2723 }
2724 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2725         .mbar add cascade -label [mc Tools] -menu .mbar.tools
2726 }
2727
2728 # -- Repository Menu
2729 #
2730 menu .mbar.repository
2731
2732 if {![is_bare]} {
2733         .mbar.repository add command \
2734                 -label [mc "Explore Working Copy"] \
2735                 -command {do_explore}
2736 }
2737
2738 if {[is_Windows]} {
2739         # Use /git-bash.exe if available
2740         set normalized [file normalize $::argv0]
2741         regsub "/mingw../libexec/git-core/git-gui$" \
2742                 $normalized "/git-bash.exe" cmdLine
2743         if {$cmdLine != $normalized && [file exists $cmdLine]} {
2744                 set cmdLine [list "Git Bash" $cmdLine &]
2745         } else {
2746                 set cmdLine [list "Git Bash" bash --login -l &]
2747         }
2748         .mbar.repository add command \
2749                 -label [mc "Git Bash"] \
2750                 -command {eval exec [auto_execok start] $cmdLine}
2751 }
2752
2753 if {[is_Windows] || ![is_bare]} {
2754         .mbar.repository add separator
2755 }
2756
2757 .mbar.repository add command \
2758         -label [mc "Browse Current Branch's Files"] \
2759         -command {browser::new $current_branch}
2760 set ui_browse_current [.mbar.repository index last]
2761 .mbar.repository add command \
2762         -label [mc "Browse Branch Files..."] \
2763         -command browser_open::dialog
2764 .mbar.repository add separator
2765
2766 .mbar.repository add command \
2767         -label [mc "Visualize Current Branch's History"] \
2768         -command {do_gitk $current_branch}
2769 set ui_visualize_current [.mbar.repository index last]
2770 .mbar.repository add command \
2771         -label [mc "Visualize All Branch History"] \
2772         -command {do_gitk --all}
2773 .mbar.repository add separator
2774
2775 proc current_branch_write {args} {
2776         global current_branch
2777         .mbar.repository entryconf $::ui_browse_current \
2778                 -label [mc "Browse %s's Files" $current_branch]
2779         .mbar.repository entryconf $::ui_visualize_current \
2780                 -label [mc "Visualize %s's History" $current_branch]
2781 }
2782 trace add variable current_branch write current_branch_write
2783
2784 if {[is_enabled multicommit]} {
2785         .mbar.repository add command -label [mc "Database Statistics"] \
2786                 -command do_stats
2787
2788         .mbar.repository add command -label [mc "Compress Database"] \
2789                 -command do_gc
2790
2791         .mbar.repository add command -label [mc "Verify Database"] \
2792                 -command do_fsck_objects
2793
2794         .mbar.repository add separator
2795
2796         if {[is_Cygwin]} {
2797                 .mbar.repository add command \
2798                         -label [mc "Create Desktop Icon"] \
2799                         -command do_cygwin_shortcut
2800         } elseif {[is_Windows]} {
2801                 .mbar.repository add command \
2802                         -label [mc "Create Desktop Icon"] \
2803                         -command do_windows_shortcut
2804         } elseif {[is_MacOSX]} {
2805                 .mbar.repository add command \
2806                         -label [mc "Create Desktop Icon"] \
2807                         -command do_macosx_app
2808         }
2809 }
2810
2811 if {[is_MacOSX]} {
2812         proc ::tk::mac::Quit {args} { do_quit }
2813 } else {
2814         .mbar.repository add command -label [mc Quit] \
2815                 -command do_quit \
2816                 -accelerator $M1T-Q
2817 }
2818
2819 # -- Edit Menu
2820 #
2821 menu .mbar.edit
2822 .mbar.edit add command -label [mc Undo] \
2823         -command {catch {[focus] edit undo}} \
2824         -accelerator $M1T-Z
2825 .mbar.edit add command -label [mc Redo] \
2826         -command {catch {[focus] edit redo}} \
2827         -accelerator $M1T-Y
2828 .mbar.edit add separator
2829 .mbar.edit add command -label [mc Cut] \
2830         -command {catch {tk_textCut [focus]}} \
2831         -accelerator $M1T-X
2832 .mbar.edit add command -label [mc Copy] \
2833         -command {catch {tk_textCopy [focus]}} \
2834         -accelerator $M1T-C
2835 .mbar.edit add command -label [mc Paste] \
2836         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2837         -accelerator $M1T-V
2838 .mbar.edit add command -label [mc Delete] \
2839         -command {catch {[focus] delete sel.first sel.last}} \
2840         -accelerator Del
2841 .mbar.edit add separator
2842 .mbar.edit add command -label [mc "Select All"] \
2843         -command {catch {[focus] tag add sel 0.0 end}} \
2844         -accelerator $M1T-A
2845
2846 # -- Branch Menu
2847 #
2848 if {[is_enabled branch]} {
2849         menu .mbar.branch
2850
2851         .mbar.branch add command -label [mc "Create..."] \
2852                 -command branch_create::dialog \
2853                 -accelerator $M1T-N
2854         lappend disable_on_lock [list .mbar.branch entryconf \
2855                 [.mbar.branch index last] -state]
2856
2857         .mbar.branch add command -label [mc "Checkout..."] \
2858                 -command branch_checkout::dialog \
2859                 -accelerator $M1T-O
2860         lappend disable_on_lock [list .mbar.branch entryconf \
2861                 [.mbar.branch index last] -state]
2862
2863         .mbar.branch add command -label [mc "Rename..."] \
2864                 -command branch_rename::dialog
2865         lappend disable_on_lock [list .mbar.branch entryconf \
2866                 [.mbar.branch index last] -state]
2867
2868         .mbar.branch add command -label [mc "Delete..."] \
2869                 -command branch_delete::dialog
2870         lappend disable_on_lock [list .mbar.branch entryconf \
2871                 [.mbar.branch index last] -state]
2872
2873         .mbar.branch add command -label [mc "Reset..."] \
2874                 -command merge::reset_hard
2875         lappend disable_on_lock [list .mbar.branch entryconf \
2876                 [.mbar.branch index last] -state]
2877 }
2878
2879 # -- Commit Menu
2880 #
2881 proc commit_btn_caption {} {
2882         if {[is_enabled nocommit]} {
2883                 return [mc "Done"]
2884         } else {
2885                 return [mc Commit@@verb]
2886         }
2887 }
2888
2889 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2890         menu .mbar.commit
2891
2892         if {![is_enabled nocommit]} {
2893                 .mbar.commit add checkbutton \
2894                         -label [mc "Amend Last Commit"] \
2895                         -accelerator $M1T-E \
2896                         -variable commit_type_is_amend \
2897                         -command do_select_commit_type
2898                 lappend disable_on_lock \
2899                         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2900
2901                 .mbar.commit add separator
2902         }
2903
2904         .mbar.commit add command -label [mc Rescan] \
2905                 -command ui_do_rescan \
2906                 -accelerator F5
2907         lappend disable_on_lock \
2908                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2909
2910         .mbar.commit add command -label [mc "Stage To Commit"] \
2911                 -command do_add_selection \
2912                 -accelerator $M1T-T
2913         lappend disable_on_lock \
2914                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2915
2916         .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2917                 -command do_add_all \
2918                 -accelerator $M1T-I
2919         lappend disable_on_lock \
2920                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2921
2922         .mbar.commit add command -label [mc "Unstage From Commit"] \
2923                 -command do_unstage_selection \
2924                 -accelerator $M1T-U
2925         lappend disable_on_lock \
2926                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2927
2928         .mbar.commit add command -label [mc "Revert Changes"] \
2929                 -command do_revert_selection \
2930                 -accelerator $M1T-J
2931         lappend disable_on_lock \
2932                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2933
2934         .mbar.commit add separator
2935
2936         .mbar.commit add command -label [mc "Show Less Context"] \
2937                 -command show_less_context \
2938                 -accelerator $M1T-\-
2939
2940         .mbar.commit add command -label [mc "Show More Context"] \
2941                 -command show_more_context \
2942                 -accelerator $M1T-=
2943
2944         .mbar.commit add separator
2945
2946         if {![is_enabled nocommitmsg]} {
2947                 .mbar.commit add command -label [mc "Sign Off"] \
2948                         -command do_signoff \
2949                         -accelerator $M1T-S
2950         }
2951
2952         .mbar.commit add command -label [commit_btn_caption] \
2953                 -command do_commit \
2954                 -accelerator $M1T-Return
2955         lappend disable_on_lock \
2956                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2957 }
2958
2959 # -- Merge Menu
2960 #
2961 if {[is_enabled branch]} {
2962         menu .mbar.merge
2963         .mbar.merge add command -label [mc "Local Merge..."] \
2964                 -command merge::dialog \
2965                 -accelerator $M1T-M
2966         lappend disable_on_lock \
2967                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2968         .mbar.merge add command -label [mc "Abort Merge..."] \
2969                 -command merge::reset_hard
2970         lappend disable_on_lock \
2971                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2972 }
2973
2974 # -- Transport Menu
2975 #
2976 if {[is_enabled transport]} {
2977         menu .mbar.remote
2978
2979         .mbar.remote add command \
2980                 -label [mc "Add..."] \
2981                 -command remote_add::dialog \
2982                 -accelerator $M1T-A
2983         .mbar.remote add command \
2984                 -label [mc "Push..."] \
2985                 -command do_push_anywhere \
2986                 -accelerator $M1T-P
2987         .mbar.remote add command \
2988                 -label [mc "Delete Branch..."] \
2989                 -command remote_branch_delete::dialog
2990 }
2991
2992 if {[is_MacOSX]} {
2993         proc ::tk::mac::ShowPreferences {} {do_options}
2994 } else {
2995         # -- Edit Menu
2996         #
2997         .mbar.edit add separator
2998         .mbar.edit add command -label [mc "Options..."] \
2999                 -command do_options
3000 }
3001
3002 # -- Tools Menu
3003 #
3004 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
3005         set tools_menubar .mbar.tools
3006         menu $tools_menubar
3007         $tools_menubar add separator
3008         $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
3009         $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
3010         set tools_tailcnt 3
3011         if {[array names repo_config guitool.*.cmd] ne {}} {
3012                 tools_populate_all
3013         }
3014 }
3015
3016 # -- Help Menu
3017 #
3018 .mbar add cascade -label [mc Help] -menu .mbar.help
3019 menu .mbar.help
3020
3021 if {[is_MacOSX]} {
3022         .mbar.apple add command -label [mc "About %s" [appname]] \
3023                 -command do_about
3024         .mbar.apple add separator
3025 } else {
3026         .mbar.help add command -label [mc "About %s" [appname]] \
3027                 -command do_about
3028 }
3029 . configure -menu .mbar
3030
3031 set doc_path [githtmldir]
3032 if {$doc_path ne {}} {
3033         set doc_path [file join $doc_path index.html]
3034
3035         if {[is_Cygwin]} {
3036                 set doc_path [exec cygpath --mixed $doc_path]
3037         }
3038 }
3039
3040 if {[file isfile $doc_path]} {
3041         set doc_url "file:$doc_path"
3042 } else {
3043         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
3044 }
3045
3046 proc start_browser {url} {
3047         git "web--browse" $url
3048 }
3049
3050 .mbar.help add command -label [mc "Online Documentation"] \
3051         -command [list start_browser $doc_url]
3052
3053 .mbar.help add command -label [mc "Show SSH Key"] \
3054         -command do_ssh_key
3055
3056 unset doc_path doc_url
3057
3058 # -- Standard bindings
3059 #
3060 wm protocol . WM_DELETE_WINDOW do_quit
3061 bind all <$M1B-Key-q> do_quit
3062 bind all <$M1B-Key-Q> do_quit
3063
3064 set m1b_w_script {
3065         set toplvl_win [winfo toplevel %W]
3066
3067         # If we are destroying the main window, we should call do_quit to take
3068         # care of cleanup before exiting the program.
3069         if {$toplvl_win eq "."} {
3070                 do_quit
3071         } else {
3072                 destroy $toplvl_win
3073         }
3074 }
3075
3076 bind all <$M1B-Key-w> $m1b_w_script
3077 bind all <$M1B-Key-W> $m1b_w_script
3078
3079 unset m1b_w_script
3080
3081 set subcommand_args {}
3082 proc usage {} {
3083         set s "[mc usage:] $::argv0 $::subcommand $::subcommand_args"
3084         if {[tk windowingsystem] eq "win32"} {
3085                 wm withdraw .
3086                 tk_messageBox -icon info -message $s \
3087                         -title [mc "Usage"]
3088         } else {
3089                 puts stderr $s
3090         }
3091         exit 1
3092 }
3093
3094 proc normalize_relpath {path} {
3095         set elements {}
3096         foreach item [file split $path] {
3097                 if {$item eq {.}} continue
3098                 if {$item eq {..} && [llength $elements] > 0
3099                     && [lindex $elements end] ne {..}} {
3100                         set elements [lrange $elements 0 end-1]
3101                         continue
3102                 }
3103                 lappend elements $item
3104         }
3105         return [eval file join $elements]
3106 }
3107
3108 # -- Not a normal commit type invocation?  Do that instead!
3109 #
3110 switch -- $subcommand {
3111 browser -
3112 blame {
3113         if {$subcommand eq "blame"} {
3114                 set subcommand_args {[--line=<num>] rev? path}
3115         } else {
3116                 set subcommand_args {rev? path}
3117         }
3118         if {$argv eq {}} usage
3119         set head {}
3120         set path {}
3121         set jump_spec {}
3122         set is_path 0
3123         foreach a $argv {
3124                 set p [file join $_prefix $a]
3125
3126                 if {$is_path || [file exists $p]} {
3127                         if {$path ne {}} usage
3128                         set path [normalize_relpath $p]
3129                         break
3130                 } elseif {$a eq {--}} {
3131                         if {$path ne {}} {
3132                                 if {$head ne {}} usage
3133                                 set head $path
3134                                 set path {}
3135                         }
3136                         set is_path 1
3137                 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3138                         if {$jump_spec ne {} || $head ne {}} usage
3139                         set jump_spec [list $lnum]
3140                 } elseif {$head eq {}} {
3141                         if {$head ne {}} usage
3142                         set head $a
3143                         set is_path 1
3144                 } else {
3145                         usage
3146                 }
3147         }
3148         unset is_path
3149
3150         if {$head ne {} && $path eq {}} {
3151                 if {[string index $head 0] eq {/}} {
3152                         set path [normalize_relpath $head]
3153                         set head {}
3154                 } else {
3155                         set path [normalize_relpath $_prefix$head]
3156                         set head {}
3157                 }
3158         }
3159
3160         if {$head eq {}} {
3161                 load_current_branch
3162         } else {
3163                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3164                         if {[catch {
3165                                         set head [git rev-parse --verify $head]
3166                                 } err]} {
3167                                 if {[tk windowingsystem] eq "win32"} {
3168                                         tk_messageBox -icon error -title [mc Error] -message $err
3169                                 } else {
3170                                         puts stderr $err
3171                                 }
3172                                 exit 1
3173                         }
3174                 }
3175                 set current_branch $head
3176         }
3177
3178         wm deiconify .
3179         switch -- $subcommand {
3180         browser {
3181                 if {$jump_spec ne {}} usage
3182                 if {$head eq {}} {
3183                         if {$path ne {} && [file isdirectory $path]} {
3184                                 set head $current_branch
3185                         } else {
3186                                 set head $path
3187                                 set path {}
3188                         }
3189                 }
3190                 browser::new $head $path
3191         }
3192         blame   {
3193                 if {$head eq {} && ![file exists $path]} {
3194                         catch {wm withdraw .}
3195                         tk_messageBox \
3196                                 -icon error \
3197                                 -type ok \
3198                                 -title [mc "git-gui: fatal error"] \
3199                                 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3200                         exit 1
3201                 }
3202                 blame::new $head $path $jump_spec
3203         }
3204         }
3205         return
3206 }
3207 citool -
3208 gui {
3209         if {[llength $argv] != 0} {
3210                 usage
3211         }
3212         # fall through to setup UI for commits
3213 }
3214 default {
3215         set err "[mc usage:] $argv0 \[{blame|browser|citool}\]"
3216         if {[tk windowingsystem] eq "win32"} {
3217                 wm withdraw .
3218                 tk_messageBox -icon error -message $err \
3219                         -title [mc "Usage"]
3220         } else {
3221                 puts stderr $err
3222         }
3223         exit 1
3224 }
3225 }
3226
3227 # -- Branch Control
3228 #
3229 ${NS}::frame .branch
3230 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3231 ${NS}::label .branch.l1 \
3232         -text [mc "Current Branch:"] \
3233         -anchor w \
3234         -justify left
3235 ${NS}::label .branch.cb \
3236         -textvariable current_branch \
3237         -anchor w \
3238         -justify left
3239 pack .branch.l1 -side left
3240 pack .branch.cb -side left -fill x
3241 pack .branch -side top -fill x
3242
3243 # -- Main Window Layout
3244 #
3245 ${NS}::panedwindow .vpane -orient horizontal
3246 ${NS}::panedwindow .vpane.files -orient vertical
3247 if {$use_ttk} {
3248         .vpane add .vpane.files
3249 } else {
3250         .vpane add .vpane.files -sticky nsew -height 100 -width 200
3251 }
3252 pack .vpane -anchor n -side top -fill both -expand 1
3253
3254 # -- Working Directory File List
3255
3256 textframe .vpane.files.workdir -height 100 -width 200
3257 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3258         -background lightsalmon -foreground black
3259 ttext $ui_workdir -background white -foreground black \
3260         -borderwidth 0 \
3261         -width 20 -height 10 \
3262         -wrap none \
3263         -takefocus 1 -highlightthickness 1\
3264         -cursor $cursor_ptr \
3265         -xscrollcommand {.vpane.files.workdir.sx set} \
3266         -yscrollcommand {.vpane.files.workdir.sy set} \
3267         -state disabled
3268 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3269 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3270 pack .vpane.files.workdir.title -side top -fill x
3271 pack .vpane.files.workdir.sx -side bottom -fill x
3272 pack .vpane.files.workdir.sy -side right -fill y
3273 pack $ui_workdir -side left -fill both -expand 1
3274
3275 # -- Index File List
3276 #
3277 textframe .vpane.files.index -height 100 -width 200
3278 tlabel .vpane.files.index.title \
3279         -text [mc "Staged Changes (Will Commit)"] \
3280         -background lightgreen -foreground black
3281 ttext $ui_index -background white -foreground black \
3282         -borderwidth 0 \
3283         -width 20 -height 10 \
3284         -wrap none \
3285         -takefocus 1 -highlightthickness 1\
3286         -cursor $cursor_ptr \
3287         -xscrollcommand {.vpane.files.index.sx set} \
3288         -yscrollcommand {.vpane.files.index.sy set} \
3289         -state disabled
3290 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3291 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3292 pack .vpane.files.index.title -side top -fill x
3293 pack .vpane.files.index.sx -side bottom -fill x
3294 pack .vpane.files.index.sy -side right -fill y
3295 pack $ui_index -side left -fill both -expand 1
3296
3297 # -- Insert the workdir and index into the panes
3298 #
3299 .vpane.files add .vpane.files.workdir
3300 .vpane.files add .vpane.files.index
3301 if {!$use_ttk} {
3302         .vpane.files paneconfigure .vpane.files.workdir -sticky news
3303         .vpane.files paneconfigure .vpane.files.index -sticky news
3304 }
3305
3306 foreach i [list $ui_index $ui_workdir] {
3307         rmsel_tag $i
3308         $i tag conf in_diff -background [$i tag cget in_sel -background]
3309 }
3310 unset i
3311
3312 # -- Diff and Commit Area
3313 #
3314 if {$have_tk85} {
3315         ${NS}::panedwindow .vpane.lower -orient vertical
3316         ${NS}::frame .vpane.lower.commarea
3317         ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500
3318         .vpane.lower add .vpane.lower.diff
3319         .vpane.lower add .vpane.lower.commarea
3320         .vpane add .vpane.lower
3321         if {$use_ttk} {
3322                 .vpane.lower pane .vpane.lower.diff -weight 1
3323                 .vpane.lower pane .vpane.lower.commarea -weight 0
3324         } else {
3325                 .vpane.lower paneconfigure .vpane.lower.diff -stretch always
3326                 .vpane.lower paneconfigure .vpane.lower.commarea -stretch never
3327         }
3328 } else {
3329         frame .vpane.lower -height 300 -width 400
3330         frame .vpane.lower.commarea
3331         frame .vpane.lower.diff -relief sunken -borderwidth 1
3332         pack .vpane.lower.diff -fill both -expand 1
3333         pack .vpane.lower.commarea -side bottom -fill x
3334         .vpane add .vpane.lower
3335         .vpane paneconfigure .vpane.lower -sticky nsew
3336 }
3337
3338 # -- Commit Area Buttons
3339 #
3340 ${NS}::frame .vpane.lower.commarea.buttons
3341 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3342         -anchor w \
3343         -justify left
3344 pack .vpane.lower.commarea.buttons.l -side top -fill x
3345 pack .vpane.lower.commarea.buttons -side left -fill y
3346
3347 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3348         -command ui_do_rescan
3349 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3350 lappend disable_on_lock \
3351         {.vpane.lower.commarea.buttons.rescan conf -state}
3352
3353 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3354         -command do_add_all
3355 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3356 lappend disable_on_lock \
3357         {.vpane.lower.commarea.buttons.incall conf -state}
3358
3359 if {![is_enabled nocommitmsg]} {
3360         ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3361                 -command do_signoff
3362         pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3363 }
3364
3365 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3366         -command do_commit
3367 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3368 lappend disable_on_lock \
3369         {.vpane.lower.commarea.buttons.commit conf -state}
3370
3371 if {![is_enabled nocommit]} {
3372         ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3373                 -command do_push_anywhere
3374         pack .vpane.lower.commarea.buttons.push -side top -fill x
3375 }
3376
3377 # -- Commit Message Buffer
3378 #
3379 ${NS}::frame .vpane.lower.commarea.buffer
3380 ${NS}::frame .vpane.lower.commarea.buffer.header
3381 set ui_comm .vpane.lower.commarea.buffer.frame.t
3382 set ui_coml .vpane.lower.commarea.buffer.header.l
3383
3384 if {![is_enabled nocommit]} {
3385         ${NS}::checkbutton .vpane.lower.commarea.buffer.header.amend \
3386                 -text [mc "Amend Last Commit"] \
3387                 -variable commit_type_is_amend \
3388                 -command do_select_commit_type
3389         lappend disable_on_lock \
3390                 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3391 }
3392
3393 ${NS}::label $ui_coml \
3394         -anchor w \
3395         -justify left
3396 proc trace_commit_type {varname args} {
3397         global ui_coml commit_type
3398         switch -glob -- $commit_type {
3399         initial       {set txt [mc "Initial Commit Message:"]}
3400         amend         {set txt [mc "Amended Commit Message:"]}
3401         amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3402         amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
3403         merge         {set txt [mc "Merge Commit Message:"]}
3404         *             {set txt [mc "Commit Message:"]}
3405         }
3406         $ui_coml conf -text $txt
3407 }
3408 trace add variable commit_type write trace_commit_type
3409 pack $ui_coml -side left -fill x
3410
3411 if {![is_enabled nocommit]} {
3412         pack .vpane.lower.commarea.buffer.header.amend -side right
3413 }
3414
3415 textframe .vpane.lower.commarea.buffer.frame
3416 ttext $ui_comm -background white -foreground black \
3417         -borderwidth 1 \
3418         -undo true \
3419         -maxundo 20 \
3420         -autoseparators true \
3421         -takefocus 1 \
3422         -highlightthickness 1 \
3423         -relief sunken \
3424         -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3425         -font font_diff \
3426         -xscrollcommand {.vpane.lower.commarea.buffer.frame.sbx set} \
3427         -yscrollcommand {.vpane.lower.commarea.buffer.frame.sby set}
3428 ${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sbx \
3429         -orient horizontal \
3430         -command [list $ui_comm xview]
3431 ${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sby \
3432         -orient vertical \
3433         -command [list $ui_comm yview]
3434
3435 pack .vpane.lower.commarea.buffer.frame.sbx -side bottom -fill x
3436 pack .vpane.lower.commarea.buffer.frame.sby -side right -fill y
3437 pack $ui_comm -side left -fill y
3438 pack .vpane.lower.commarea.buffer.header -side top -fill x
3439 pack .vpane.lower.commarea.buffer.frame -side left -fill y
3440 pack .vpane.lower.commarea.buffer -side left -fill y
3441
3442 # -- Commit Message Buffer Context Menu
3443 #
3444 set ctxm .vpane.lower.commarea.buffer.ctxm
3445 menu $ctxm -tearoff 0
3446 $ctxm add command \
3447         -label [mc Cut] \
3448         -command {tk_textCut $ui_comm}
3449 $ctxm add command \
3450         -label [mc Copy] \
3451         -command {tk_textCopy $ui_comm}
3452 $ctxm add command \
3453         -label [mc Paste] \
3454         -command {tk_textPaste $ui_comm}
3455 $ctxm add command \
3456         -label [mc Delete] \
3457         -command {catch {$ui_comm delete sel.first sel.last}}
3458 $ctxm add separator
3459 $ctxm add command \
3460         -label [mc "Select All"] \
3461         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3462 $ctxm add command \
3463         -label [mc "Copy All"] \
3464         -command {
3465                 $ui_comm tag add sel 0.0 end
3466                 tk_textCopy $ui_comm
3467                 $ui_comm tag remove sel 0.0 end
3468         }
3469 $ctxm add separator
3470 $ctxm add command \
3471         -label [mc "Sign Off"] \
3472         -command do_signoff
3473 set ui_comm_ctxm $ctxm
3474
3475 # -- Diff Header
3476 #
3477 proc trace_current_diff_path {varname args} {
3478         global current_diff_path diff_actions file_states
3479         if {$current_diff_path eq {}} {
3480                 set s {}
3481                 set f {}
3482                 set p {}
3483                 set o disabled
3484         } else {
3485                 set p $current_diff_path
3486                 set s [mapdesc [lindex $file_states($p) 0] $p]
3487                 set f [mc "File:"]
3488                 set p [escape_path $p]
3489                 set o normal
3490         }
3491
3492         .vpane.lower.diff.header.status configure -text $s
3493         .vpane.lower.diff.header.file configure -text $f
3494         .vpane.lower.diff.header.path configure -text $p
3495         foreach w $diff_actions {
3496                 uplevel #0 $w $o
3497         }
3498 }
3499 trace add variable current_diff_path write trace_current_diff_path
3500
3501 gold_frame .vpane.lower.diff.header
3502 tlabel .vpane.lower.diff.header.status \
3503         -background gold \
3504         -foreground black \
3505         -width $max_status_desc \
3506         -anchor w \
3507         -justify left
3508 tlabel .vpane.lower.diff.header.file \
3509         -background gold \
3510         -foreground black \
3511         -anchor w \
3512         -justify left
3513 tlabel .vpane.lower.diff.header.path \
3514         -background gold \
3515         -foreground black \
3516         -anchor w \
3517         -justify left
3518 pack .vpane.lower.diff.header.status -side left
3519 pack .vpane.lower.diff.header.file -side left
3520 pack .vpane.lower.diff.header.path -fill x
3521 set ctxm .vpane.lower.diff.header.ctxm
3522 menu $ctxm -tearoff 0
3523 $ctxm add command \
3524         -label [mc Copy] \
3525         -command {
3526                 clipboard clear
3527                 clipboard append \
3528                         -format STRING \
3529                         -type STRING \
3530                         -- $current_diff_path
3531         }
3532 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3533 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3534
3535 # -- Diff Body
3536 #
3537 textframe .vpane.lower.diff.body
3538 set ui_diff .vpane.lower.diff.body.t
3539 ttext $ui_diff -background white -foreground black \
3540         -borderwidth 0 \
3541         -width 80 -height 5 -wrap none \
3542         -font font_diff \
3543         -takefocus 1 -highlightthickness 1 \
3544         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3545         -yscrollcommand {.vpane.lower.diff.body.sby set} \
3546         -state disabled
3547 catch {$ui_diff configure -tabstyle wordprocessor}
3548 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3549         -command [list $ui_diff xview]
3550 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3551         -command [list $ui_diff yview]
3552 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3553 pack .vpane.lower.diff.body.sby -side right -fill y
3554 pack $ui_diff -side left -fill both -expand 1
3555 pack .vpane.lower.diff.header -side top -fill x
3556 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3557
3558 foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3559         $ui_diff tag configure clr4$n -background $c
3560         $ui_diff tag configure clri4$n -foreground $c
3561         $ui_diff tag configure clr3$n -foreground $c
3562         $ui_diff tag configure clri3$n -background $c
3563 }
3564 $ui_diff tag configure clr1 -font font_diffbold
3565 $ui_diff tag configure clr4 -underline 1
3566
3567 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3568
3569 $ui_diff tag conf d_cr -elide true
3570 $ui_diff tag conf d_@ -font font_diffbold
3571 $ui_diff tag conf d_+ -foreground {#00a000}
3572 $ui_diff tag conf d_- -foreground red
3573
3574 $ui_diff tag conf d_++ -foreground {#00a000}
3575 $ui_diff tag conf d_-- -foreground red
3576 $ui_diff tag conf d_+s \
3577         -foreground {#00a000} \
3578         -background {#e2effa}
3579 $ui_diff tag conf d_-s \
3580         -foreground red \
3581         -background {#e2effa}
3582 $ui_diff tag conf d_s+ \
3583         -foreground {#00a000} \
3584         -background ivory1
3585 $ui_diff tag conf d_s- \
3586         -foreground red \
3587         -background ivory1
3588
3589 $ui_diff tag conf d< \
3590         -foreground orange \
3591         -font font_diffbold
3592 $ui_diff tag conf d| \
3593         -foreground orange \
3594         -font font_diffbold
3595 $ui_diff tag conf d= \
3596         -foreground orange \
3597         -font font_diffbold
3598 $ui_diff tag conf d> \
3599         -foreground orange \
3600         -font font_diffbold
3601
3602 $ui_diff tag raise sel
3603
3604 # -- Diff Body Context Menu
3605 #
3606
3607 proc create_common_diff_popup {ctxm} {
3608         $ctxm add command \
3609                 -label [mc Refresh] \
3610                 -command reshow_diff
3611         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3612         $ctxm add command \
3613                 -label [mc Copy] \
3614                 -command {tk_textCopy $ui_diff}
3615         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3616         $ctxm add command \
3617                 -label [mc "Select All"] \
3618                 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3619         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3620         $ctxm add command \
3621                 -label [mc "Copy All"] \
3622                 -command {
3623                         $ui_diff tag add sel 0.0 end
3624                         tk_textCopy $ui_diff
3625                         $ui_diff tag remove sel 0.0 end
3626                 }
3627         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3628         $ctxm add separator
3629         $ctxm add command \
3630                 -label [mc "Decrease Font Size"] \
3631                 -command {incr_font_size font_diff -1}
3632         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3633         $ctxm add command \
3634                 -label [mc "Increase Font Size"] \
3635                 -command {incr_font_size font_diff 1}
3636         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3637         $ctxm add separator
3638         set emenu $ctxm.enc
3639         menu $emenu
3640         build_encoding_menu $emenu [list force_diff_encoding]
3641         $ctxm add cascade \
3642                 -label [mc "Encoding"] \
3643                 -menu $emenu
3644         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3645         $ctxm add separator
3646         $ctxm add command -label [mc "Options..."] \
3647                 -command do_options
3648 }
3649
3650 set ctxm .vpane.lower.diff.body.ctxm
3651 menu $ctxm -tearoff 0
3652 $ctxm add command \
3653         -label [mc "Apply/Reverse Hunk"] \
3654         -command {apply_or_revert_hunk $cursorX $cursorY 0}
3655 set ui_diff_applyhunk [$ctxm index last]
3656 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3657 $ctxm add command \
3658         -label [mc "Apply/Reverse Line"] \
3659         -command {apply_or_revert_range_or_line $cursorX $cursorY 0; do_rescan}
3660 set ui_diff_applyline [$ctxm index last]
3661 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3662 $ctxm add separator
3663 $ctxm add command \
3664         -label [mc "Revert Hunk"] \
3665         -command {apply_or_revert_hunk $cursorX $cursorY 1}
3666 set ui_diff_reverthunk [$ctxm index last]
3667 lappend diff_actions [list $ctxm entryconf $ui_diff_reverthunk -state]
3668 $ctxm add command \
3669         -label [mc "Revert Line"] \
3670         -command {apply_or_revert_range_or_line $cursorX $cursorY 1; do_rescan}
3671 set ui_diff_revertline [$ctxm index last]
3672 lappend diff_actions [list $ctxm entryconf $ui_diff_revertline -state]
3673 $ctxm add command \
3674         -label [mc "Undo Last Revert"] \
3675         -command {undo_last_revert; do_rescan}
3676 set ui_diff_undorevert [$ctxm index last]
3677 lappend diff_actions [list $ctxm entryconf $ui_diff_undorevert -state]
3678 $ctxm add separator
3679 $ctxm add command \
3680         -label [mc "Show Less Context"] \
3681         -command show_less_context
3682 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3683 $ctxm add command \
3684         -label [mc "Show More Context"] \
3685         -command show_more_context
3686 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3687 $ctxm add separator
3688 create_common_diff_popup $ctxm
3689
3690 set ctxmmg .vpane.lower.diff.body.ctxmmg
3691 menu $ctxmmg -tearoff 0
3692 $ctxmmg add command \
3693         -label [mc "Run Merge Tool"] \
3694         -command {merge_resolve_tool}
3695 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3696 $ctxmmg add separator
3697 $ctxmmg add command \
3698         -label [mc "Use Remote Version"] \
3699         -command {merge_resolve_one 3}
3700 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3701 $ctxmmg add command \
3702         -label [mc "Use Local Version"] \
3703         -command {merge_resolve_one 2}
3704 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3705 $ctxmmg add command \
3706         -label [mc "Revert To Base"] \
3707         -command {merge_resolve_one 1}
3708 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3709 $ctxmmg add separator
3710 $ctxmmg add command \
3711         -label [mc "Show Less Context"] \
3712         -command show_less_context
3713 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3714 $ctxmmg add command \
3715         -label [mc "Show More Context"] \
3716         -command show_more_context
3717 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3718 $ctxmmg add separator
3719 create_common_diff_popup $ctxmmg
3720
3721 set ctxmsm .vpane.lower.diff.body.ctxmsm
3722 menu $ctxmsm -tearoff 0
3723 $ctxmsm add command \
3724         -label [mc "Visualize These Changes In The Submodule"] \
3725         -command {do_gitk -- true}
3726 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3727 $ctxmsm add command \
3728         -label [mc "Visualize Current Branch History In The Submodule"] \
3729         -command {do_gitk {} true}
3730 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3731 $ctxmsm add command \
3732         -label [mc "Visualize All Branch History In The Submodule"] \
3733         -command {do_gitk --all true}
3734 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3735 $ctxmsm add separator
3736 $ctxmsm add command \
3737         -label [mc "Start git gui In The Submodule"] \
3738         -command {do_git_gui}
3739 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3740 $ctxmsm add separator
3741 create_common_diff_popup $ctxmsm
3742
3743 proc has_textconv {path} {
3744         if {[is_config_false gui.textconv]} {
3745                 return 0
3746         }
3747         set filter [gitattr $path diff set]
3748         set textconv [get_config [join [list diff $filter textconv] .]]
3749         if {$filter ne {set} && $textconv ne {}} {
3750                 return 1
3751         } else {
3752                 return 0
3753         }
3754 }
3755
3756 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3757         global current_diff_path file_states last_revert
3758         set ::cursorX $x
3759         set ::cursorY $y
3760         if {[info exists file_states($current_diff_path)]} {
3761                 set state [lindex $file_states($current_diff_path) 0]
3762         } else {
3763                 set state {__}
3764         }
3765         if {[string first {U} $state] >= 0} {
3766                 tk_popup $ctxmmg $X $Y
3767         } elseif {$::is_submodule_diff} {
3768                 tk_popup $ctxmsm $X $Y
3769         } else {
3770                 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3771                 set u [mc "Undo Last Revert"]
3772                 if {$::ui_index eq $::current_diff_side} {
3773                         set l [mc "Unstage Hunk From Commit"]
3774                         set h [mc "Revert Hunk"]
3775
3776                         if {$has_range} {
3777                                 set t [mc "Unstage Lines From Commit"]
3778                                 set r [mc "Revert Lines"]
3779                         } else {
3780                                 set t [mc "Unstage Line From Commit"]
3781                                 set r [mc "Revert Line"]
3782                         }
3783                 } else {
3784                         set l [mc "Stage Hunk For Commit"]
3785                         set h [mc "Revert Hunk"]
3786
3787                         if {$has_range} {
3788                                 set t [mc "Stage Lines For Commit"]
3789                                 set r [mc "Revert Lines"]
3790                         } else {
3791                                 set t [mc "Stage Line For Commit"]
3792                                 set r [mc "Revert Line"]
3793                         }
3794                 }
3795                 if {$::is_3way_diff
3796                         || $current_diff_path eq {}
3797                         || {__} eq $state
3798                         || {_O} eq $state
3799                         || [string match {?T} $state]
3800                         || [string match {T?} $state]
3801                         || [has_textconv $current_diff_path]} {
3802                         set s disabled
3803                         set revert_state disabled
3804                 } else {
3805                         set s normal
3806
3807                         # Only allow reverting changes in the working tree. If
3808                         # the user wants to revert changes in the index, they
3809                         # need to unstage those first.
3810                         if {$::ui_workdir eq $::current_diff_side} {
3811                                 set revert_state normal
3812                         } else {
3813                                 set revert_state disabled
3814                         }
3815                 }
3816
3817                 if {$last_revert eq {}} {
3818                         set undo_state disabled
3819                 } else {
3820                         set undo_state normal
3821                 }
3822
3823                 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3824                 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3825                 $ctxm entryconf $::ui_diff_revertline -state $revert_state \
3826                         -label $r
3827                 $ctxm entryconf $::ui_diff_reverthunk -state $revert_state \
3828                         -label $h
3829                 $ctxm entryconf $::ui_diff_undorevert -state $undo_state \
3830                         -label $u
3831
3832                 tk_popup $ctxm $X $Y
3833         }
3834 }
3835 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3836
3837 # -- Status Bar
3838 #
3839 set main_status [::status_bar::new .status]
3840 pack .status -anchor w -side bottom -fill x
3841 $main_status show [mc "Initializing..."]
3842
3843 # -- Load geometry
3844 #
3845 proc on_ttk_pane_mapped {w pane pos} {
3846         bind $w <Map> {}
3847         after 0 [list after idle [list $w sashpos $pane $pos]]
3848 }
3849 proc on_tk_pane_mapped {w pane x y} {
3850         bind $w <Map> {}
3851         after 0 [list after idle [list $w sash place $pane $x $y]]
3852 }
3853 proc on_application_mapped {} {
3854         global repo_config use_ttk
3855         bind . <Map> {}
3856         set gm $repo_config(gui.geometry)
3857         if {$use_ttk} {
3858                 bind .vpane <Map> \
3859                     [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3860                 bind .vpane.files <Map> \
3861                     [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3862         } else {
3863                 bind .vpane <Map> \
3864                     [list on_tk_pane_mapped %W 0 \
3865                          [lindex $gm 1] \
3866                          [lindex [.vpane sash coord 0] 1]]
3867                 bind .vpane.files <Map> \
3868                     [list on_tk_pane_mapped %W 0 \
3869                          [lindex [.vpane.files sash coord 0] 0] \
3870                          [lindex $gm 2]]
3871         }
3872         wm geometry . [lindex $gm 0]
3873 }
3874 if {[info exists repo_config(gui.geometry)]} {
3875         bind . <Map> [list on_application_mapped]
3876         wm geometry . [lindex $repo_config(gui.geometry) 0]
3877 }
3878
3879 # -- Load window state
3880 #
3881 if {[info exists repo_config(gui.wmstate)]} {
3882         catch {wm state . $repo_config(gui.wmstate)}
3883 }
3884
3885 # -- Key Bindings
3886 #
3887 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3888 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3889 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3890 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3891 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3892 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3893 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3894 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3895 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3896 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3897 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3898 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3899 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3900 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3901 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3902 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3903 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3904 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3905 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3906 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3907 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3908 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3909
3910 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3911 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3912 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3913 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3914 bind $ui_diff <$M1B-Key-v> {break}
3915 bind $ui_diff <$M1B-Key-V> {break}
3916 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3917 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3918 bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
3919 bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
3920 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3921 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3922 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3923 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3924 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
3925 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
3926 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
3927 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
3928 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3929 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
3930 bind $ui_diff <Button-1>   {focus %W}
3931
3932 if {[is_enabled branch]} {
3933         bind . <$M1B-Key-n> branch_create::dialog
3934         bind . <$M1B-Key-N> branch_create::dialog
3935         bind . <$M1B-Key-o> branch_checkout::dialog
3936         bind . <$M1B-Key-O> branch_checkout::dialog
3937         bind . <$M1B-Key-m> merge::dialog
3938         bind . <$M1B-Key-M> merge::dialog
3939 }
3940 if {[is_enabled transport]} {
3941         bind . <$M1B-Key-p> do_push_anywhere
3942         bind . <$M1B-Key-P> do_push_anywhere
3943 }
3944
3945 bind .   <Key-F5>     ui_do_rescan
3946 bind .   <$M1B-Key-r> ui_do_rescan
3947 bind .   <$M1B-Key-R> ui_do_rescan
3948 bind .   <$M1B-Key-s> do_signoff
3949 bind .   <$M1B-Key-S> do_signoff
3950 bind .   <$M1B-Key-t> { toggle_or_diff toggle %W }
3951 bind .   <$M1B-Key-T> { toggle_or_diff toggle %W }
3952 bind .   <$M1B-Key-u> { toggle_or_diff toggle %W }
3953 bind .   <$M1B-Key-U> { toggle_or_diff toggle %W }
3954 bind .   <$M1B-Key-j> do_revert_selection
3955 bind .   <$M1B-Key-J> do_revert_selection
3956 bind .   <$M1B-Key-i> do_add_all
3957 bind .   <$M1B-Key-I> do_add_all
3958 bind .   <$M1B-Key-e> toggle_commit_type
3959 bind .   <$M1B-Key-E> toggle_commit_type
3960 bind .   <$M1B-Key-minus> {show_less_context;break}
3961 bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
3962 bind .   <$M1B-Key-equal> {show_more_context;break}
3963 bind .   <$M1B-Key-plus> {show_more_context;break}
3964 bind .   <$M1B-Key-KP_Add> {show_more_context;break}
3965 bind .   <$M1B-Key-Return> do_commit
3966 bind .   <$M1B-Key-KP_Enter> do_commit
3967 foreach i [list $ui_index $ui_workdir] {
3968         bind $i <Button-1>       { toggle_or_diff click %W %x %y; break }
3969         bind $i <$M1B-Button-1>  { add_one_to_selection %W %x %y; break }
3970         bind $i <Shift-Button-1> { add_range_to_selection %W %x %y; break }
3971         bind $i <Key-Up>         { toggle_or_diff up %W; break }
3972         bind $i <Key-Down>       { toggle_or_diff down %W; break }
3973 }
3974 unset i
3975
3976 bind .   <Alt-Key-1> {focus_widget $::ui_workdir}
3977 bind .   <Alt-Key-2> {focus_widget $::ui_index}
3978 bind .   <Alt-Key-3> {focus $::ui_diff}
3979 bind .   <Alt-Key-4> {focus $::ui_comm}
3980
3981 set file_lists_last_clicked($ui_index) {}
3982 set file_lists_last_clicked($ui_workdir) {}
3983
3984 set file_lists($ui_index) [list]
3985 set file_lists($ui_workdir) [list]
3986
3987 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3988 focus -force $ui_comm
3989
3990 # -- Warn the user about environmental problems.  Cygwin's Tcl
3991 #    does *not* pass its env array onto any processes it spawns.
3992 #    This means that git processes get none of our environment.
3993 #
3994 if {[is_Cygwin]} {
3995         set ignored_env 0
3996         set suggest_user {}
3997         set msg [mc "Possible environment issues exist.
3998
3999 The following environment variables are probably
4000 going to be ignored by any Git subprocess run
4001 by %s:
4002
4003 " [appname]]
4004         foreach name [array names env] {
4005                 switch -regexp -- $name {
4006                 {^GIT_INDEX_FILE$} -
4007                 {^GIT_OBJECT_DIRECTORY$} -
4008                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4009                 {^GIT_DIFF_OPTS$} -
4010                 {^GIT_EXTERNAL_DIFF$} -
4011                 {^GIT_PAGER$} -
4012                 {^GIT_TRACE$} -
4013                 {^GIT_CONFIG$} -
4014                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4015                         append msg " - $name\n"
4016                         incr ignored_env
4017                 }
4018                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4019                         append msg " - $name\n"
4020                         incr ignored_env
4021                         set suggest_user $name
4022                 }
4023                 }
4024         }
4025         if {$ignored_env > 0} {
4026                 append msg [mc "
4027 This is due to a known issue with the
4028 Tcl binary distributed by Cygwin."]
4029
4030                 if {$suggest_user ne {}} {
4031                         append msg [mc "
4032
4033 A good replacement for %s
4034 is placing values for the user.name and
4035 user.email settings into your personal
4036 ~/.gitconfig file.
4037 " $suggest_user]
4038                 }
4039                 warn_popup $msg
4040         }
4041         unset ignored_env msg suggest_user name
4042 }
4043
4044 # -- Only initialize complex UI if we are going to stay running.
4045 #
4046 if {[is_enabled transport]} {
4047         load_all_remotes
4048
4049         set n [.mbar.remote index end]
4050         populate_remotes_menu
4051         set n [expr {[.mbar.remote index end] - $n}]
4052         if {$n > 0} {
4053                 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
4054                 .mbar.remote insert $n separator
4055         }
4056         unset n
4057 }
4058
4059 if {[winfo exists $ui_comm]} {
4060         set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
4061
4062         # -- If both our backup and message files exist use the
4063         #    newer of the two files to initialize the buffer.
4064         #
4065         if {$GITGUI_BCK_exists} {
4066                 set m [gitdir GITGUI_MSG]
4067                 if {[file isfile $m]} {
4068                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
4069                                 catch {file delete [gitdir GITGUI_MSG]}
4070                         } else {
4071                                 $ui_comm delete 0.0 end
4072                                 $ui_comm edit reset
4073                                 $ui_comm edit modified false
4074                                 catch {file delete [gitdir GITGUI_BCK]}
4075                                 set GITGUI_BCK_exists 0
4076                         }
4077                 }
4078                 unset m
4079         }
4080
4081         proc backup_commit_buffer {} {
4082                 global ui_comm GITGUI_BCK_exists
4083
4084                 set m [$ui_comm edit modified]
4085                 if {$m || $GITGUI_BCK_exists} {
4086                         set msg [string trim [$ui_comm get 0.0 end]]
4087                         regsub -all -line {[ \r\t]+$} $msg {} msg
4088
4089                         if {$msg eq {}} {
4090                                 if {$GITGUI_BCK_exists} {
4091                                         catch {file delete [gitdir GITGUI_BCK]}
4092                                         set GITGUI_BCK_exists 0
4093                                 }
4094                         } elseif {$m} {
4095                                 catch {
4096                                         set fd [open [gitdir GITGUI_BCK] w]
4097                                         fconfigure $fd -encoding utf-8
4098                                         puts -nonewline $fd $msg
4099                                         close $fd
4100                                         set GITGUI_BCK_exists 1
4101                                 }
4102                         }
4103
4104                         $ui_comm edit modified false
4105                 }
4106
4107                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
4108         }
4109
4110         backup_commit_buffer
4111
4112         # -- If the user has aspell available we can drive it
4113         #    in pipe mode to spellcheck the commit message.
4114         #
4115         set spell_cmd [list |]
4116         set spell_dict [get_config gui.spellingdictionary]
4117         lappend spell_cmd aspell
4118         if {$spell_dict ne {}} {
4119                 lappend spell_cmd --master=$spell_dict
4120         }
4121         lappend spell_cmd --mode=none
4122         lappend spell_cmd --encoding=utf-8
4123         lappend spell_cmd pipe
4124         if {$spell_dict eq {none}
4125          || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
4126                 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
4127         } else {
4128                 set ui_comm_spell [spellcheck::init \
4129                         $spell_fd \
4130                         $ui_comm \
4131                         $ui_comm_ctxm \
4132                 ]
4133         }
4134         unset -nocomplain spell_cmd spell_fd spell_err spell_dict
4135 }
4136
4137 lock_index begin-read
4138 if {![winfo ismapped .]} {
4139         wm deiconify .
4140 }
4141 after 1 {
4142         if {[is_enabled initialamend]} {
4143                 force_amend
4144         } else {
4145                 do_rescan
4146         }
4147
4148         if {[is_enabled nocommitmsg]} {
4149                 $ui_comm configure -state disabled -background gray
4150         }
4151 }
4152 if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
4153         after 1000 hint_gc
4154 }
4155 if {[is_enabled retcode]} {
4156         bind . <Destroy> {+terminate_me %W}
4157 }
4158 if {$picked && [is_config_true gui.autoexplore]} {
4159         do_explore
4160 }
4161
4162 # Local variables:
4163 # mode: tcl
4164 # indent-tabs-mode: t
4165 # tab-width: 4
4166 # End: