git.oblomov.eu Git - git/blob - 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         .mbar.repository add command \
2740                 -label [mc "Git Bash"] \
2741                 -command {eval exec [auto_execok start] \
2742                                           [list "Git Bash" bash --login -l &]}
2743 }
2744
2745 if {[is_Windows] || ![is_bare]} {
2746         .mbar.repository add separator
2747 }
2748
2749 .mbar.repository add command \
2750         -label [mc "Browse Current Branch's Files"] \
2751         -command {browser::new $current_branch}
2752 set ui_browse_current [.mbar.repository index last]
2753 .mbar.repository add command \
2754         -label [mc "Browse Branch Files..."] \
2755         -command browser_open::dialog
2756 .mbar.repository add separator
2757
2758 .mbar.repository add command \
2759         -label [mc "Visualize Current Branch's History"] \
2760         -command {do_gitk $current_branch}
2761 set ui_visualize_current [.mbar.repository index last]
2762 .mbar.repository add command \
2763         -label [mc "Visualize All Branch History"] \
2764         -command {do_gitk --all}
2765 .mbar.repository add separator
2766
2767 proc current_branch_write {args} {
2768         global current_branch
2769         .mbar.repository entryconf $::ui_browse_current \
2770                 -label [mc "Browse %s's Files" $current_branch]
2771         .mbar.repository entryconf $::ui_visualize_current \
2772                 -label [mc "Visualize %s's History" $current_branch]
2773 }
2774 trace add variable current_branch write current_branch_write
2775
2776 if {[is_enabled multicommit]} {
2777         .mbar.repository add command -label [mc "Database Statistics"] \
2778                 -command do_stats
2779
2780         .mbar.repository add command -label [mc "Compress Database"] \
2781                 -command do_gc
2782
2783         .mbar.repository add command -label [mc "Verify Database"] \
2784                 -command do_fsck_objects
2785
2786         .mbar.repository add separator
2787
2788         if {[is_Cygwin]} {
2789                 .mbar.repository add command \
2790                         -label [mc "Create Desktop Icon"] \
2791                         -command do_cygwin_shortcut
2792         } elseif {[is_Windows]} {
2793                 .mbar.repository add command \
2794                         -label [mc "Create Desktop Icon"] \
2795                         -command do_windows_shortcut
2796         } elseif {[is_MacOSX]} {
2797                 .mbar.repository add command \
2798                         -label [mc "Create Desktop Icon"] \
2799                         -command do_macosx_app
2800         }
2801 }
2802
2803 if {[is_MacOSX]} {
2804         proc ::tk::mac::Quit {args} { do_quit }
2805 } else {
2806         .mbar.repository add command -label [mc Quit] \
2807                 -command do_quit \
2808                 -accelerator $M1T-Q
2809 }
2810
2811 # -- Edit Menu
2812 #
2813 menu .mbar.edit
2814 .mbar.edit add command -label [mc Undo] \
2815         -command {catch {[focus] edit undo}} \
2816         -accelerator $M1T-Z
2817 .mbar.edit add command -label [mc Redo] \
2818         -command {catch {[focus] edit redo}} \
2819         -accelerator $M1T-Y
2820 .mbar.edit add separator
2821 .mbar.edit add command -label [mc Cut] \
2822         -command {catch {tk_textCut [focus]}} \
2823         -accelerator $M1T-X
2824 .mbar.edit add command -label [mc Copy] \
2825         -command {catch {tk_textCopy [focus]}} \
2826         -accelerator $M1T-C
2827 .mbar.edit add command -label [mc Paste] \
2828         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2829         -accelerator $M1T-V
2830 .mbar.edit add command -label [mc Delete] \
2831         -command {catch {[focus] delete sel.first sel.last}} \
2832         -accelerator Del
2833 .mbar.edit add separator
2834 .mbar.edit add command -label [mc "Select All"] \
2835         -command {catch {[focus] tag add sel 0.0 end}} \
2836         -accelerator $M1T-A
2837
2838 # -- Branch Menu
2839 #
2840 if {[is_enabled branch]} {
2841         menu .mbar.branch
2842
2843         .mbar.branch add command -label [mc "Create..."] \
2844                 -command branch_create::dialog \
2845                 -accelerator $M1T-N
2846         lappend disable_on_lock [list .mbar.branch entryconf \
2847                 [.mbar.branch index last] -state]
2848
2849         .mbar.branch add command -label [mc "Checkout..."] \
2850                 -command branch_checkout::dialog \
2851                 -accelerator $M1T-O
2852         lappend disable_on_lock [list .mbar.branch entryconf \
2853                 [.mbar.branch index last] -state]
2854
2855         .mbar.branch add command -label [mc "Rename..."] \
2856                 -command branch_rename::dialog
2857         lappend disable_on_lock [list .mbar.branch entryconf \
2858                 [.mbar.branch index last] -state]
2859
2860         .mbar.branch add command -label [mc "Delete..."] \
2861                 -command branch_delete::dialog
2862         lappend disable_on_lock [list .mbar.branch entryconf \
2863                 [.mbar.branch index last] -state]
2864
2865         .mbar.branch add command -label [mc "Reset..."] \
2866                 -command merge::reset_hard
2867         lappend disable_on_lock [list .mbar.branch entryconf \
2868                 [.mbar.branch index last] -state]
2869 }
2870
2871 # -- Commit Menu
2872 #
2873 proc commit_btn_caption {} {
2874         if {[is_enabled nocommit]} {
2875                 return [mc "Done"]
2876         } else {
2877                 return [mc Commit@@verb]
2878         }
2879 }
2880
2881 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2882         menu .mbar.commit
2883
2884         if {![is_enabled nocommit]} {
2885                 .mbar.commit add checkbutton \
2886                         -label [mc "Amend Last Commit"] \
2887                         -accelerator $M1T-E \
2888                         -variable commit_type_is_amend \
2889                         -command do_select_commit_type
2890                 lappend disable_on_lock \
2891                         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2892
2893                 .mbar.commit add separator
2894         }
2895
2896         .mbar.commit add command -label [mc Rescan] \
2897                 -command ui_do_rescan \
2898                 -accelerator F5
2899         lappend disable_on_lock \
2900                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2901
2902         .mbar.commit add command -label [mc "Stage To Commit"] \
2903                 -command do_add_selection \
2904                 -accelerator $M1T-T
2905         lappend disable_on_lock \
2906                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2907
2908         .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2909                 -command do_add_all \
2910                 -accelerator $M1T-I
2911         lappend disable_on_lock \
2912                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2913
2914         .mbar.commit add command -label [mc "Unstage From Commit"] \
2915                 -command do_unstage_selection \
2916                 -accelerator $M1T-U
2917         lappend disable_on_lock \
2918                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2919
2920         .mbar.commit add command -label [mc "Revert Changes"] \
2921                 -command do_revert_selection \
2922                 -accelerator $M1T-J
2923         lappend disable_on_lock \
2924                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2925
2926         .mbar.commit add separator
2927
2928         .mbar.commit add command -label [mc "Show Less Context"] \
2929                 -command show_less_context \
2930                 -accelerator $M1T-\-
2931
2932         .mbar.commit add command -label [mc "Show More Context"] \
2933                 -command show_more_context \
2934                 -accelerator $M1T-=
2935
2936         .mbar.commit add separator
2937
2938         if {![is_enabled nocommitmsg]} {
2939                 .mbar.commit add command -label [mc "Sign Off"] \
2940                         -command do_signoff \
2941                         -accelerator $M1T-S
2942         }
2943
2944         .mbar.commit add command -label [commit_btn_caption] \
2945                 -command do_commit \
2946                 -accelerator $M1T-Return
2947         lappend disable_on_lock \
2948                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2949 }
2950
2951 # -- Merge Menu
2952 #
2953 if {[is_enabled branch]} {
2954         menu .mbar.merge
2955         .mbar.merge add command -label [mc "Local Merge..."] \
2956                 -command merge::dialog \
2957                 -accelerator $M1T-M
2958         lappend disable_on_lock \
2959                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2960         .mbar.merge add command -label [mc "Abort Merge..."] \
2961                 -command merge::reset_hard
2962         lappend disable_on_lock \
2963                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2964 }
2965
2966 # -- Transport Menu
2967 #
2968 if {[is_enabled transport]} {
2969         menu .mbar.remote
2970
2971         .mbar.remote add command \
2972                 -label [mc "Add..."] \
2973                 -command remote_add::dialog \
2974                 -accelerator $M1T-A
2975         .mbar.remote add command \
2976                 -label [mc "Push..."] \
2977                 -command do_push_anywhere \
2978                 -accelerator $M1T-P
2979         .mbar.remote add command \
2980                 -label [mc "Delete Branch..."] \
2981                 -command remote_branch_delete::dialog
2982 }
2983
2984 if {[is_MacOSX]} {
2985         proc ::tk::mac::ShowPreferences {} {do_options}
2986 } else {
2987         # -- Edit Menu
2988         #
2989         .mbar.edit add separator
2990         .mbar.edit add command -label [mc "Options..."] \
2991                 -command do_options
2992 }
2993
2994 # -- Tools Menu
2995 #
2996 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2997         set tools_menubar .mbar.tools
2998         menu $tools_menubar
2999         $tools_menubar add separator
3000         $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
3001         $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
3002         set tools_tailcnt 3
3003         if {[array names repo_config guitool.*.cmd] ne {}} {
3004                 tools_populate_all
3005         }
3006 }
3007
3008 # -- Help Menu
3009 #
3010 .mbar add cascade -label [mc Help] -menu .mbar.help
3011 menu .mbar.help
3012
3013 if {[is_MacOSX]} {
3014         .mbar.apple add command -label [mc "About %s" [appname]] \
3015                 -command do_about
3016         .mbar.apple add separator
3017 } else {
3018         .mbar.help add command -label [mc "About %s" [appname]] \
3019                 -command do_about
3020 }
3021 . configure -menu .mbar
3022
3023 set doc_path [githtmldir]
3024 if {$doc_path ne {}} {
3025         set doc_path [file join $doc_path index.html]
3026
3027         if {[is_Cygwin]} {
3028                 set doc_path [exec cygpath --mixed $doc_path]
3029         }
3030 }
3031
3032 if {[file isfile $doc_path]} {
3033         set doc_url "file:$doc_path"
3034 } else {
3035         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
3036 }
3037
3038 proc start_browser {url} {
3039         git "web--browse" $url
3040 }
3041
3042 .mbar.help add command -label [mc "Online Documentation"] \
3043         -command [list start_browser $doc_url]
3044
3045 .mbar.help add command -label [mc "Show SSH Key"] \
3046         -command do_ssh_key
3047
3048 unset doc_path doc_url
3049
3050 # -- Standard bindings
3051 #
3052 wm protocol . WM_DELETE_WINDOW do_quit
3053 bind all <$M1B-Key-q> do_quit
3054 bind all <$M1B-Key-Q> do_quit
3055
3056 set m1b_w_script {
3057         set toplvl_win [winfo toplevel %W]
3058
3059         # If we are destroying the main window, we should call do_quit to take
3060         # care of cleanup before exiting the program.
3061         if {$toplvl_win eq "."} {
3062                 do_quit
3063         } else {
3064                 destroy $toplvl_win
3065         }
3066 }
3067
3068 bind all <$M1B-Key-w> $m1b_w_script
3069 bind all <$M1B-Key-W> $m1b_w_script
3070
3071 unset m1b_w_script
3072
3073 set subcommand_args {}
3074 proc usage {} {
3075         set s "[mc usage:] $::argv0 $::subcommand $::subcommand_args"
3076         if {[tk windowingsystem] eq "win32"} {
3077                 wm withdraw .
3078                 tk_messageBox -icon info -message $s \
3079                         -title [mc "Usage"]
3080         } else {
3081                 puts stderr $s
3082         }
3083         exit 1
3084 }
3085
3086 proc normalize_relpath {path} {
3087         set elements {}
3088         foreach item [file split $path] {
3089                 if {$item eq {.}} continue
3090                 if {$item eq {..} && [llength $elements] > 0
3091                     && [lindex $elements end] ne {..}} {
3092                         set elements [lrange $elements 0 end-1]
3093                         continue
3094                 }
3095                 lappend elements $item
3096         }
3097         return [eval file join $elements]
3098 }
3099
3100 # -- Not a normal commit type invocation?  Do that instead!
3101 #
3102 switch -- $subcommand {
3103 browser -
3104 blame {
3105         if {$subcommand eq "blame"} {
3106                 set subcommand_args {[--line=<num>] rev? path}
3107         } else {
3108                 set subcommand_args {rev? path}
3109         }
3110         if {$argv eq {}} usage
3111         set head {}
3112         set path {}
3113         set jump_spec {}
3114         set is_path 0
3115         foreach a $argv {
3116                 set p [file join $_prefix $a]
3117
3118                 if {$is_path || [file exists $p]} {
3119                         if {$path ne {}} usage
3120                         set path [normalize_relpath $p]
3121                         break
3122                 } elseif {$a eq {--}} {
3123                         if {$path ne {}} {
3124                                 if {$head ne {}} usage
3125                                 set head $path
3126                                 set path {}
3127                         }
3128                         set is_path 1
3129                 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3130                         if {$jump_spec ne {} || $head ne {}} usage
3131                         set jump_spec [list $lnum]
3132                 } elseif {$head eq {}} {
3133                         if {$head ne {}} usage
3134                         set head $a
3135                         set is_path 1
3136                 } else {
3137                         usage
3138                 }
3139         }
3140         unset is_path
3141
3142         if {$head ne {} && $path eq {}} {
3143                 if {[string index $head 0] eq {/}} {
3144                         set path [normalize_relpath $head]
3145                         set head {}
3146                 } else {
3147                         set path [normalize_relpath $_prefix$head]
3148                         set head {}
3149                 }
3150         }
3151
3152         if {$head eq {}} {
3153                 load_current_branch
3154         } else {
3155                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3156                         if {[catch {
3157                                         set head [git rev-parse --verify $head]
3158                                 } err]} {
3159                                 if {[tk windowingsystem] eq "win32"} {
3160                                         tk_messageBox -icon error -title [mc Error] -message $err
3161                                 } else {
3162                                         puts stderr $err
3163                                 }
3164                                 exit 1
3165                         }
3166                 }
3167                 set current_branch $head
3168         }
3169
3170         wm deiconify .
3171         switch -- $subcommand {
3172         browser {
3173                 if {$jump_spec ne {}} usage
3174                 if {$head eq {}} {
3175                         if {$path ne {} && [file isdirectory $path]} {
3176                                 set head $current_branch
3177                         } else {
3178                                 set head $path
3179                                 set path {}
3180                         }
3181                 }
3182                 browser::new $head $path
3183         }
3184         blame   {
3185                 if {$head eq {} && ![file exists $path]} {
3186                         catch {wm withdraw .}
3187                         tk_messageBox \
3188                                 -icon error \
3189                                 -type ok \
3190                                 -title [mc "git-gui: fatal error"] \
3191                                 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3192                         exit 1
3193                 }
3194                 blame::new $head $path $jump_spec
3195         }
3196         }
3197         return
3198 }
3199 citool -
3200 gui {
3201         if {[llength $argv] != 0} {
3202                 usage
3203         }
3204         # fall through to setup UI for commits
3205 }
3206 default {
3207         set err "[mc usage:] $argv0 \[{blame|browser|citool}\]"
3208         if {[tk windowingsystem] eq "win32"} {
3209                 wm withdraw .
3210                 tk_messageBox -icon error -message $err \
3211                         -title [mc "Usage"]
3212         } else {
3213                 puts stderr $err
3214         }
3215         exit 1
3216 }
3217 }
3218
3219 # -- Branch Control
3220 #
3221 ${NS}::frame .branch
3222 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3223 ${NS}::label .branch.l1 \
3224         -text [mc "Current Branch:"] \
3225         -anchor w \
3226         -justify left
3227 ${NS}::label .branch.cb \
3228         -textvariable current_branch \
3229         -anchor w \
3230         -justify left
3231 pack .branch.l1 -side left
3232 pack .branch.cb -side left -fill x
3233 pack .branch -side top -fill x
3234
3235 # -- Main Window Layout
3236 #
3237 ${NS}::panedwindow .vpane -orient horizontal
3238 ${NS}::panedwindow .vpane.files -orient vertical
3239 if {$use_ttk} {
3240         .vpane add .vpane.files
3241 } else {
3242         .vpane add .vpane.files -sticky nsew -height 100 -width 200
3243 }
3244 pack .vpane -anchor n -side top -fill both -expand 1
3245
3246 # -- Working Directory File List
3247
3248 textframe .vpane.files.workdir -height 100 -width 200
3249 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3250         -background lightsalmon -foreground black
3251 ttext $ui_workdir -background white -foreground black \
3252         -borderwidth 0 \
3253         -width 20 -height 10 \
3254         -wrap none \
3255         -takefocus 1 -highlightthickness 1\
3256         -cursor $cursor_ptr \
3257         -xscrollcommand {.vpane.files.workdir.sx set} \
3258         -yscrollcommand {.vpane.files.workdir.sy set} \
3259         -state disabled
3260 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3261 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3262 pack .vpane.files.workdir.title -side top -fill x
3263 pack .vpane.files.workdir.sx -side bottom -fill x
3264 pack .vpane.files.workdir.sy -side right -fill y
3265 pack $ui_workdir -side left -fill both -expand 1
3266
3267 # -- Index File List
3268 #
3269 textframe .vpane.files.index -height 100 -width 200
3270 tlabel .vpane.files.index.title \
3271         -text [mc "Staged Changes (Will Commit)"] \
3272         -background lightgreen -foreground black
3273 ttext $ui_index -background white -foreground black \
3274         -borderwidth 0 \
3275         -width 20 -height 10 \
3276         -wrap none \
3277         -takefocus 1 -highlightthickness 1\
3278         -cursor $cursor_ptr \
3279         -xscrollcommand {.vpane.files.index.sx set} \
3280         -yscrollcommand {.vpane.files.index.sy set} \
3281         -state disabled
3282 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3283 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3284 pack .vpane.files.index.title -side top -fill x
3285 pack .vpane.files.index.sx -side bottom -fill x
3286 pack .vpane.files.index.sy -side right -fill y
3287 pack $ui_index -side left -fill both -expand 1
3288
3289 # -- Insert the workdir and index into the panes
3290 #
3291 .vpane.files add .vpane.files.workdir
3292 .vpane.files add .vpane.files.index
3293 if {!$use_ttk} {
3294         .vpane.files paneconfigure .vpane.files.workdir -sticky news
3295         .vpane.files paneconfigure .vpane.files.index -sticky news
3296 }
3297
3298 foreach i [list $ui_index $ui_workdir] {
3299         rmsel_tag $i
3300         $i tag conf in_diff -background [$i tag cget in_sel -background]
3301 }
3302 unset i
3303
3304 # -- Diff and Commit Area
3305 #
3306 if {$have_tk85} {
3307         ${NS}::panedwindow .vpane.lower -orient vertical
3308         ${NS}::frame .vpane.lower.commarea
3309         ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500
3310         .vpane.lower add .vpane.lower.diff
3311         .vpane.lower add .vpane.lower.commarea
3312         .vpane add .vpane.lower
3313         if {$use_ttk} {
3314                 .vpane.lower pane .vpane.lower.diff -weight 1
3315                 .vpane.lower pane .vpane.lower.commarea -weight 0
3316         } else {
3317                 .vpane.lower paneconfigure .vpane.lower.diff -stretch always
3318                 .vpane.lower paneconfigure .vpane.lower.commarea -stretch never
3319         }
3320 } else {
3321         frame .vpane.lower -height 300 -width 400
3322         frame .vpane.lower.commarea
3323         frame .vpane.lower.diff -relief sunken -borderwidth 1
3324         pack .vpane.lower.diff -fill both -expand 1
3325         pack .vpane.lower.commarea -side bottom -fill x
3326         .vpane add .vpane.lower
3327         .vpane paneconfigure .vpane.lower -sticky nsew
3328 }
3329
3330 # -- Commit Area Buttons
3331 #
3332 ${NS}::frame .vpane.lower.commarea.buttons
3333 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3334         -anchor w \
3335         -justify left
3336 pack .vpane.lower.commarea.buttons.l -side top -fill x
3337 pack .vpane.lower.commarea.buttons -side left -fill y
3338
3339 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3340         -command ui_do_rescan
3341 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3342 lappend disable_on_lock \
3343         {.vpane.lower.commarea.buttons.rescan conf -state}
3344
3345 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3346         -command do_add_all
3347 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3348 lappend disable_on_lock \
3349         {.vpane.lower.commarea.buttons.incall conf -state}
3350
3351 if {![is_enabled nocommitmsg]} {
3352         ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3353                 -command do_signoff
3354         pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3355 }
3356
3357 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3358         -command do_commit
3359 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3360 lappend disable_on_lock \
3361         {.vpane.lower.commarea.buttons.commit conf -state}
3362
3363 if {![is_enabled nocommit]} {
3364         ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3365                 -command do_push_anywhere
3366         pack .vpane.lower.commarea.buttons.push -side top -fill x
3367 }
3368
3369 # -- Commit Message Buffer
3370 #
3371 ${NS}::frame .vpane.lower.commarea.buffer
3372 ${NS}::frame .vpane.lower.commarea.buffer.header
3373 set ui_comm .vpane.lower.commarea.buffer.frame.t
3374 set ui_coml .vpane.lower.commarea.buffer.header.l
3375
3376 if {![is_enabled nocommit]} {
3377         ${NS}::checkbutton .vpane.lower.commarea.buffer.header.amend \
3378                 -text [mc "Amend Last Commit"] \
3379                 -variable commit_type_is_amend \
3380                 -command do_select_commit_type
3381         lappend disable_on_lock \
3382                 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3383 }
3384
3385 ${NS}::label $ui_coml \
3386         -anchor w \
3387         -justify left
3388 proc trace_commit_type {varname args} {
3389         global ui_coml commit_type
3390         switch -glob -- $commit_type {
3391         initial       {set txt [mc "Initial Commit Message:"]}
3392         amend         {set txt [mc "Amended Commit Message:"]}
3393         amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3394         amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
3395         merge         {set txt [mc "Merge Commit Message:"]}
3396         *             {set txt [mc "Commit Message:"]}
3397         }
3398         $ui_coml conf -text $txt
3399 }
3400 trace add variable commit_type write trace_commit_type
3401 pack $ui_coml -side left -fill x
3402
3403 if {![is_enabled nocommit]} {
3404         pack .vpane.lower.commarea.buffer.header.amend -side right
3405 }
3406
3407 textframe .vpane.lower.commarea.buffer.frame
3408 ttext $ui_comm -background white -foreground black \
3409         -borderwidth 1 \
3410         -undo true \
3411         -maxundo 20 \
3412         -autoseparators true \
3413         -takefocus 1 \
3414         -highlightthickness 1 \
3415         -relief sunken \
3416         -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3417         -font font_diff \
3418         -xscrollcommand {.vpane.lower.commarea.buffer.frame.sbx set} \
3419         -yscrollcommand {.vpane.lower.commarea.buffer.frame.sby set}
3420 ${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sbx \
3421         -orient horizontal \
3422         -command [list $ui_comm xview]
3423 ${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sby \
3424         -orient vertical \
3425         -command [list $ui_comm yview]
3426
3427 pack .vpane.lower.commarea.buffer.frame.sbx -side bottom -fill x
3428 pack .vpane.lower.commarea.buffer.frame.sby -side right -fill y
3429 pack $ui_comm -side left -fill y
3430 pack .vpane.lower.commarea.buffer.header -side top -fill x
3431 pack .vpane.lower.commarea.buffer.frame -side left -fill y
3432 pack .vpane.lower.commarea.buffer -side left -fill y
3433
3434 # -- Commit Message Buffer Context Menu
3435 #
3436 set ctxm .vpane.lower.commarea.buffer.ctxm
3437 menu $ctxm -tearoff 0
3438 $ctxm add command \
3439         -label [mc Cut] \
3440         -command {tk_textCut $ui_comm}
3441 $ctxm add command \
3442         -label [mc Copy] \
3443         -command {tk_textCopy $ui_comm}
3444 $ctxm add command \
3445         -label [mc Paste] \
3446         -command {tk_textPaste $ui_comm}
3447 $ctxm add command \
3448         -label [mc Delete] \
3449         -command {catch {$ui_comm delete sel.first sel.last}}
3450 $ctxm add separator
3451 $ctxm add command \
3452         -label [mc "Select All"] \
3453         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3454 $ctxm add command \
3455         -label [mc "Copy All"] \
3456         -command {
3457                 $ui_comm tag add sel 0.0 end
3458                 tk_textCopy $ui_comm
3459                 $ui_comm tag remove sel 0.0 end
3460         }
3461 $ctxm add separator
3462 $ctxm add command \
3463         -label [mc "Sign Off"] \
3464         -command do_signoff
3465 set ui_comm_ctxm $ctxm
3466
3467 # -- Diff Header
3468 #
3469 proc trace_current_diff_path {varname args} {
3470         global current_diff_path diff_actions file_states
3471         if {$current_diff_path eq {}} {
3472                 set s {}
3473                 set f {}
3474                 set p {}
3475                 set o disabled
3476         } else {
3477                 set p $current_diff_path
3478                 set s [mapdesc [lindex $file_states($p) 0] $p]
3479                 set f [mc "File:"]
3480                 set p [escape_path $p]
3481                 set o normal
3482         }
3483
3484         .vpane.lower.diff.header.status configure -text $s
3485         .vpane.lower.diff.header.file configure -text $f
3486         .vpane.lower.diff.header.path configure -text $p
3487         foreach w $diff_actions {
3488                 uplevel #0 $w $o
3489         }
3490 }
3491 trace add variable current_diff_path write trace_current_diff_path
3492
3493 gold_frame .vpane.lower.diff.header
3494 tlabel .vpane.lower.diff.header.status \
3495         -background gold \
3496         -foreground black \
3497         -width $max_status_desc \
3498         -anchor w \
3499         -justify left
3500 tlabel .vpane.lower.diff.header.file \
3501         -background gold \
3502         -foreground black \
3503         -anchor w \
3504         -justify left
3505 tlabel .vpane.lower.diff.header.path \
3506         -background gold \
3507         -foreground black \
3508         -anchor w \
3509         -justify left
3510 pack .vpane.lower.diff.header.status -side left
3511 pack .vpane.lower.diff.header.file -side left
3512 pack .vpane.lower.diff.header.path -fill x
3513 set ctxm .vpane.lower.diff.header.ctxm
3514 menu $ctxm -tearoff 0
3515 $ctxm add command \
3516         -label [mc Copy] \
3517         -command {
3518                 clipboard clear
3519                 clipboard append \
3520                         -format STRING \
3521                         -type STRING \
3522                         -- $current_diff_path
3523         }
3524 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3525 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3526
3527 # -- Diff Body
3528 #
3529 textframe .vpane.lower.diff.body
3530 set ui_diff .vpane.lower.diff.body.t
3531 ttext $ui_diff -background white -foreground black \
3532         -borderwidth 0 \
3533         -width 80 -height 5 -wrap none \
3534         -font font_diff \
3535         -takefocus 1 -highlightthickness 1 \
3536         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3537         -yscrollcommand {.vpane.lower.diff.body.sby set} \
3538         -state disabled
3539 catch {$ui_diff configure -tabstyle wordprocessor}
3540 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3541         -command [list $ui_diff xview]
3542 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3543         -command [list $ui_diff yview]
3544 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3545 pack .vpane.lower.diff.body.sby -side right -fill y
3546 pack $ui_diff -side left -fill both -expand 1
3547 pack .vpane.lower.diff.header -side top -fill x
3548 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3549
3550 foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3551         $ui_diff tag configure clr4$n -background $c
3552         $ui_diff tag configure clri4$n -foreground $c
3553         $ui_diff tag configure clr3$n -foreground $c
3554         $ui_diff tag configure clri3$n -background $c
3555 }
3556 $ui_diff tag configure clr1 -font font_diffbold
3557 $ui_diff tag configure clr4 -underline 1
3558
3559 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3560
3561 $ui_diff tag conf d_cr -elide true
3562 $ui_diff tag conf d_@ -font font_diffbold
3563 $ui_diff tag conf d_+ -foreground {#00a000}
3564 $ui_diff tag conf d_- -foreground red
3565
3566 $ui_diff tag conf d_++ -foreground {#00a000}
3567 $ui_diff tag conf d_-- -foreground red
3568 $ui_diff tag conf d_+s \
3569         -foreground {#00a000} \
3570         -background {#e2effa}
3571 $ui_diff tag conf d_-s \
3572         -foreground red \
3573         -background {#e2effa}
3574 $ui_diff tag conf d_s+ \
3575         -foreground {#00a000} \
3576         -background ivory1
3577 $ui_diff tag conf d_s- \
3578         -foreground red \
3579         -background ivory1
3580
3581 $ui_diff tag conf d< \
3582         -foreground orange \
3583         -font font_diffbold
3584 $ui_diff tag conf d| \
3585         -foreground orange \
3586         -font font_diffbold
3587 $ui_diff tag conf d= \
3588         -foreground orange \
3589         -font font_diffbold
3590 $ui_diff tag conf d> \
3591         -foreground orange \
3592         -font font_diffbold
3593
3594 $ui_diff tag raise sel
3595
3596 # -- Diff Body Context Menu
3597 #
3598
3599 proc create_common_diff_popup {ctxm} {
3600         $ctxm add command \
3601                 -label [mc Refresh] \
3602                 -command reshow_diff
3603         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3604         $ctxm add command \
3605                 -label [mc Copy] \
3606                 -command {tk_textCopy $ui_diff}
3607         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3608         $ctxm add command \
3609                 -label [mc "Select All"] \
3610                 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3611         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3612         $ctxm add command \
3613                 -label [mc "Copy All"] \
3614                 -command {
3615                         $ui_diff tag add sel 0.0 end
3616                         tk_textCopy $ui_diff
3617                         $ui_diff tag remove sel 0.0 end
3618                 }
3619         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3620         $ctxm add separator
3621         $ctxm add command \
3622                 -label [mc "Decrease Font Size"] \
3623                 -command {incr_font_size font_diff -1}
3624         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3625         $ctxm add command \
3626                 -label [mc "Increase Font Size"] \
3627                 -command {incr_font_size font_diff 1}
3628         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3629         $ctxm add separator
3630         set emenu $ctxm.enc
3631         menu $emenu
3632         build_encoding_menu $emenu [list force_diff_encoding]
3633         $ctxm add cascade \
3634                 -label [mc "Encoding"] \
3635                 -menu $emenu
3636         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3637         $ctxm add separator
3638         $ctxm add command -label [mc "Options..."] \
3639                 -command do_options
3640 }
3641
3642 set ctxm .vpane.lower.diff.body.ctxm
3643 menu $ctxm -tearoff 0
3644 $ctxm add command \
3645         -label [mc "Apply/Reverse Hunk"] \
3646         -command {apply_or_revert_hunk $cursorX $cursorY 0}
3647 set ui_diff_applyhunk [$ctxm index last]
3648 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3649 $ctxm add command \
3650         -label [mc "Apply/Reverse Line"] \
3651         -command {apply_or_revert_range_or_line $cursorX $cursorY 0; do_rescan}
3652 set ui_diff_applyline [$ctxm index last]
3653 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3654 $ctxm add separator
3655 $ctxm add command \
3656         -label [mc "Revert Hunk"] \
3657         -command {apply_or_revert_hunk $cursorX $cursorY 1}
3658 set ui_diff_reverthunk [$ctxm index last]
3659 lappend diff_actions [list $ctxm entryconf $ui_diff_reverthunk -state]
3660 $ctxm add command \
3661         -label [mc "Revert Line"] \
3662         -command {apply_or_revert_range_or_line $cursorX $cursorY 1; do_rescan}
3663 set ui_diff_revertline [$ctxm index last]
3664 lappend diff_actions [list $ctxm entryconf $ui_diff_revertline -state]
3665 $ctxm add command \
3666         -label [mc "Undo Last Revert"] \
3667         -command {undo_last_revert; do_rescan}
3668 set ui_diff_undorevert [$ctxm index last]
3669 lappend diff_actions [list $ctxm entryconf $ui_diff_undorevert -state]
3670 $ctxm add separator
3671 $ctxm add command \
3672         -label [mc "Show Less Context"] \
3673         -command show_less_context
3674 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3675 $ctxm add command \
3676         -label [mc "Show More Context"] \
3677         -command show_more_context
3678 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3679 $ctxm add separator
3680 create_common_diff_popup $ctxm
3681
3682 set ctxmmg .vpane.lower.diff.body.ctxmmg
3683 menu $ctxmmg -tearoff 0
3684 $ctxmmg add command \
3685         -label [mc "Run Merge Tool"] \
3686         -command {merge_resolve_tool}
3687 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3688 $ctxmmg add separator
3689 $ctxmmg add command \
3690         -label [mc "Use Remote Version"] \
3691         -command {merge_resolve_one 3}
3692 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3693 $ctxmmg add command \
3694         -label [mc "Use Local Version"] \
3695         -command {merge_resolve_one 2}
3696 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3697 $ctxmmg add command \
3698         -label [mc "Revert To Base"] \
3699         -command {merge_resolve_one 1}
3700 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3701 $ctxmmg add separator
3702 $ctxmmg add command \
3703         -label [mc "Show Less Context"] \
3704         -command show_less_context
3705 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3706 $ctxmmg add command \
3707         -label [mc "Show More Context"] \
3708         -command show_more_context
3709 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3710 $ctxmmg add separator
3711 create_common_diff_popup $ctxmmg
3712
3713 set ctxmsm .vpane.lower.diff.body.ctxmsm
3714 menu $ctxmsm -tearoff 0
3715 $ctxmsm add command \
3716         -label [mc "Visualize These Changes In The Submodule"] \
3717         -command {do_gitk -- true}
3718 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3719 $ctxmsm add command \
3720         -label [mc "Visualize Current Branch History In The Submodule"] \
3721         -command {do_gitk {} true}
3722 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3723 $ctxmsm add command \
3724         -label [mc "Visualize All Branch History In The Submodule"] \
3725         -command {do_gitk --all true}
3726 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3727 $ctxmsm add separator
3728 $ctxmsm add command \
3729         -label [mc "Start git gui In The Submodule"] \
3730         -command {do_git_gui}
3731 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3732 $ctxmsm add separator
3733 create_common_diff_popup $ctxmsm
3734
3735 proc has_textconv {path} {
3736         if {[is_config_false gui.textconv]} {
3737                 return 0
3738         }
3739         set filter [gitattr $path diff set]
3740         set textconv [get_config [join [list diff $filter textconv] .]]
3741         if {$filter ne {set} && $textconv ne {}} {
3742                 return 1
3743         } else {
3744                 return 0
3745         }
3746 }
3747
3748 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3749         global current_diff_path file_states last_revert
3750         set ::cursorX $x
3751         set ::cursorY $y
3752         if {[info exists file_states($current_diff_path)]} {
3753                 set state [lindex $file_states($current_diff_path) 0]
3754         } else {
3755                 set state {__}
3756         }
3757         if {[string first {U} $state] >= 0} {
3758                 tk_popup $ctxmmg $X $Y
3759         } elseif {$::is_submodule_diff} {
3760                 tk_popup $ctxmsm $X $Y
3761         } else {
3762                 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3763                 set u [mc "Undo Last Revert"]
3764                 if {$::ui_index eq $::current_diff_side} {
3765                         set l [mc "Unstage Hunk From Commit"]
3766                         set h [mc "Revert Hunk"]
3767
3768                         if {$has_range} {
3769                                 set t [mc "Unstage Lines From Commit"]
3770                                 set r [mc "Revert Lines"]
3771                         } else {
3772                                 set t [mc "Unstage Line From Commit"]
3773                                 set r [mc "Revert Line"]
3774                         }
3775                 } else {
3776                         set l [mc "Stage Hunk For Commit"]
3777                         set h [mc "Revert Hunk"]
3778
3779                         if {$has_range} {
3780                                 set t [mc "Stage Lines For Commit"]
3781                                 set r [mc "Revert Lines"]
3782                         } else {
3783                                 set t [mc "Stage Line For Commit"]
3784                                 set r [mc "Revert Line"]
3785                         }
3786                 }
3787                 if {$::is_3way_diff
3788                         || $current_diff_path eq {}
3789                         || {__} eq $state
3790                         || {_O} eq $state
3791                         || [string match {?T} $state]
3792                         || [string match {T?} $state]
3793                         || [has_textconv $current_diff_path]} {
3794                         set s disabled
3795                         set revert_state disabled
3796                 } else {
3797                         set s normal
3798
3799                         # Only allow reverting changes in the working tree. If
3800                         # the user wants to revert changes in the index, they
3801                         # need to unstage those first.
3802                         if {$::ui_workdir eq $::current_diff_side} {
3803                                 set revert_state normal
3804                         } else {
3805                                 set revert_state disabled
3806                         }
3807                 }
3808
3809                 if {$last_revert eq {}} {
3810                         set undo_state disabled
3811                 } else {
3812                         set undo_state normal
3813                 }
3814
3815                 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3816                 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3817                 $ctxm entryconf $::ui_diff_revertline -state $revert_state \
3818                         -label $r
3819                 $ctxm entryconf $::ui_diff_reverthunk -state $revert_state \
3820                         -label $h
3821                 $ctxm entryconf $::ui_diff_undorevert -state $undo_state \
3822                         -label $u
3823
3824                 tk_popup $ctxm $X $Y
3825         }
3826 }
3827 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3828
3829 # -- Status Bar
3830 #
3831 set main_status [::status_bar::new .status]
3832 pack .status -anchor w -side bottom -fill x
3833 $main_status show [mc "Initializing..."]
3834
3835 # -- Load geometry
3836 #
3837 proc on_ttk_pane_mapped {w pane pos} {
3838         bind $w <Map> {}
3839         after 0 [list after idle [list $w sashpos $pane $pos]]
3840 }
3841 proc on_tk_pane_mapped {w pane x y} {
3842         bind $w <Map> {}
3843         after 0 [list after idle [list $w sash place $pane $x $y]]
3844 }
3845 proc on_application_mapped {} {
3846         global repo_config use_ttk
3847         bind . <Map> {}
3848         set gm $repo_config(gui.geometry)
3849         if {$use_ttk} {
3850                 bind .vpane <Map> \
3851                     [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3852                 bind .vpane.files <Map> \
3853                     [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3854         } else {
3855                 bind .vpane <Map> \
3856                     [list on_tk_pane_mapped %W 0 \
3857                          [lindex $gm 1] \
3858                          [lindex [.vpane sash coord 0] 1]]
3859                 bind .vpane.files <Map> \
3860                     [list on_tk_pane_mapped %W 0 \
3861                          [lindex [.vpane.files sash coord 0] 0] \
3862                          [lindex $gm 2]]
3863         }
3864         wm geometry . [lindex $gm 0]
3865 }
3866 if {[info exists repo_config(gui.geometry)]} {
3867         bind . <Map> [list on_application_mapped]
3868         wm geometry . [lindex $repo_config(gui.geometry) 0]
3869 }
3870
3871 # -- Load window state
3872 #
3873 if {[info exists repo_config(gui.wmstate)]} {
3874         catch {wm state . $repo_config(gui.wmstate)}
3875 }
3876
3877 # -- Key Bindings
3878 #
3879 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3880 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3881 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3882 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3883 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3884 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3885 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3886 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3887 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3888 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3889 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3890 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3891 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3892 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3893 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3894 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3895 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3896 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3897 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3898 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3899 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3900 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3901
3902 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3903 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3904 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3905 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3906 bind $ui_diff <$M1B-Key-v> {break}
3907 bind $ui_diff <$M1B-Key-V> {break}
3908 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3909 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3910 bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
3911 bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
3912 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3913 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3914 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3915 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3916 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
3917 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
3918 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
3919 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
3920 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3921 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
3922 bind $ui_diff <Button-1>   {focus %W}
3923
3924 if {[is_enabled branch]} {
3925         bind . <$M1B-Key-n> branch_create::dialog
3926         bind . <$M1B-Key-N> branch_create::dialog
3927         bind . <$M1B-Key-o> branch_checkout::dialog
3928         bind . <$M1B-Key-O> branch_checkout::dialog
3929         bind . <$M1B-Key-m> merge::dialog
3930         bind . <$M1B-Key-M> merge::dialog
3931 }
3932 if {[is_enabled transport]} {
3933         bind . <$M1B-Key-p> do_push_anywhere
3934         bind . <$M1B-Key-P> do_push_anywhere
3935 }
3936
3937 bind .   <Key-F5>     ui_do_rescan
3938 bind .   <$M1B-Key-r> ui_do_rescan
3939 bind .   <$M1B-Key-R> ui_do_rescan
3940 bind .   <$M1B-Key-s> do_signoff
3941 bind .   <$M1B-Key-S> do_signoff
3942 bind .   <$M1B-Key-t> { toggle_or_diff toggle %W }
3943 bind .   <$M1B-Key-T> { toggle_or_diff toggle %W }
3944 bind .   <$M1B-Key-u> { toggle_or_diff toggle %W }
3945 bind .   <$M1B-Key-U> { toggle_or_diff toggle %W }
3946 bind .   <$M1B-Key-j> do_revert_selection
3947 bind .   <$M1B-Key-J> do_revert_selection
3948 bind .   <$M1B-Key-i> do_add_all
3949 bind .   <$M1B-Key-I> do_add_all
3950 bind .   <$M1B-Key-e> toggle_commit_type
3951 bind .   <$M1B-Key-E> toggle_commit_type
3952 bind .   <$M1B-Key-minus> {show_less_context;break}
3953 bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
3954 bind .   <$M1B-Key-equal> {show_more_context;break}
3955 bind .   <$M1B-Key-plus> {show_more_context;break}
3956 bind .   <$M1B-Key-KP_Add> {show_more_context;break}
3957 bind .   <$M1B-Key-Return> do_commit
3958 bind .   <$M1B-Key-KP_Enter> do_commit
3959 foreach i [list $ui_index $ui_workdir] {
3960         bind $i <Button-1>       { toggle_or_diff click %W %x %y; break }
3961         bind $i <$M1B-Button-1>  { add_one_to_selection %W %x %y; break }
3962         bind $i <Shift-Button-1> { add_range_to_selection %W %x %y; break }
3963         bind $i <Key-Up>         { toggle_or_diff up %W; break }
3964         bind $i <Key-Down>       { toggle_or_diff down %W; break }
3965 }
3966 unset i
3967
3968 bind .   <Alt-Key-1> {focus_widget $::ui_workdir}
3969 bind .   <Alt-Key-2> {focus_widget $::ui_index}
3970 bind .   <Alt-Key-3> {focus $::ui_diff}
3971 bind .   <Alt-Key-4> {focus $::ui_comm}
3972
3973 set file_lists_last_clicked($ui_index) {}
3974 set file_lists_last_clicked($ui_workdir) {}
3975
3976 set file_lists($ui_index) [list]
3977 set file_lists($ui_workdir) [list]
3978
3979 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3980 focus -force $ui_comm
3981
3982 # -- Warn the user about environmental problems.  Cygwin's Tcl
3983 #    does *not* pass its env array onto any processes it spawns.
3984 #    This means that git processes get none of our environment.
3985 #
3986 if {[is_Cygwin]} {
3987         set ignored_env 0
3988         set suggest_user {}
3989         set msg [mc "Possible environment issues exist.
3990
3991 The following environment variables are probably
3992 going to be ignored by any Git subprocess run
3993 by %s:
3994
3995 " [appname]]
3996         foreach name [array names env] {
3997                 switch -regexp -- $name {
3998                 {^GIT_INDEX_FILE$} -
3999                 {^GIT_OBJECT_DIRECTORY$} -
4000                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4001                 {^GIT_DIFF_OPTS$} -
4002                 {^GIT_EXTERNAL_DIFF$} -
4003                 {^GIT_PAGER$} -
4004                 {^GIT_TRACE$} -
4005                 {^GIT_CONFIG$} -
4006                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4007                         append msg " - $name\n"
4008                         incr ignored_env
4009                 }
4010                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4011                         append msg " - $name\n"
4012                         incr ignored_env
4013                         set suggest_user $name
4014                 }
4015                 }
4016         }
4017         if {$ignored_env > 0} {
4018                 append msg [mc "
4019 This is due to a known issue with the
4020 Tcl binary distributed by Cygwin."]
4021
4022                 if {$suggest_user ne {}} {
4023                         append msg [mc "
4024
4025 A good replacement for %s
4026 is placing values for the user.name and
4027 user.email settings into your personal
4028 ~/.gitconfig file.
4029 " $suggest_user]
4030                 }
4031                 warn_popup $msg
4032         }
4033         unset ignored_env msg suggest_user name
4034 }
4035
4036 # -- Only initialize complex UI if we are going to stay running.
4037 #
4038 if {[is_enabled transport]} {
4039         load_all_remotes
4040
4041         set n [.mbar.remote index end]
4042         populate_remotes_menu
4043         set n [expr {[.mbar.remote index end] - $n}]
4044         if {$n > 0} {
4045                 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
4046                 .mbar.remote insert $n separator
4047         }
4048         unset n
4049 }
4050
4051 if {[winfo exists $ui_comm]} {
4052         set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
4053
4054         # -- If both our backup and message files exist use the
4055         #    newer of the two files to initialize the buffer.
4056         #
4057         if {$GITGUI_BCK_exists} {
4058                 set m [gitdir GITGUI_MSG]
4059                 if {[file isfile $m]} {
4060                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
4061                                 catch {file delete [gitdir GITGUI_MSG]}
4062                         } else {
4063                                 $ui_comm delete 0.0 end
4064                                 $ui_comm edit reset
4065                                 $ui_comm edit modified false
4066                                 catch {file delete [gitdir GITGUI_BCK]}
4067                                 set GITGUI_BCK_exists 0
4068                         }
4069                 }
4070                 unset m
4071         }
4072
4073         proc backup_commit_buffer {} {
4074                 global ui_comm GITGUI_BCK_exists
4075
4076                 set m [$ui_comm edit modified]
4077                 if {$m || $GITGUI_BCK_exists} {
4078                         set msg [string trim [$ui_comm get 0.0 end]]
4079                         regsub -all -line {[ \r\t]+$} $msg {} msg
4080
4081                         if {$msg eq {}} {
4082                                 if {$GITGUI_BCK_exists} {
4083                                         catch {file delete [gitdir GITGUI_BCK]}
4084                                         set GITGUI_BCK_exists 0
4085                                 }
4086                         } elseif {$m} {
4087                                 catch {
4088                                         set fd [open [gitdir GITGUI_BCK] w]
4089                                         fconfigure $fd -encoding utf-8
4090                                         puts -nonewline $fd $msg
4091                                         close $fd
4092                                         set GITGUI_BCK_exists 1
4093                                 }
4094                         }
4095
4096                         $ui_comm edit modified false
4097                 }
4098
4099                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
4100         }
4101
4102         backup_commit_buffer
4103
4104         # -- If the user has aspell available we can drive it
4105         #    in pipe mode to spellcheck the commit message.
4106         #
4107         set spell_cmd [list |]
4108         set spell_dict [get_config gui.spellingdictionary]
4109         lappend spell_cmd aspell
4110         if {$spell_dict ne {}} {
4111                 lappend spell_cmd --master=$spell_dict
4112         }
4113         lappend spell_cmd --mode=none
4114         lappend spell_cmd --encoding=utf-8
4115         lappend spell_cmd pipe
4116         if {$spell_dict eq {none}
4117          || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
4118                 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
4119         } else {
4120                 set ui_comm_spell [spellcheck::init \
4121                         $spell_fd \
4122                         $ui_comm \
4123                         $ui_comm_ctxm \
4124                 ]
4125         }
4126         unset -nocomplain spell_cmd spell_fd spell_err spell_dict
4127 }
4128
4129 lock_index begin-read
4130 if {![winfo ismapped .]} {
4131         wm deiconify .
4132 }
4133 after 1 {
4134         if {[is_enabled initialamend]} {
4135                 force_amend
4136         } else {
4137                 do_rescan
4138         }
4139
4140         if {[is_enabled nocommitmsg]} {
4141                 $ui_comm configure -state disabled -background gray
4142         }
4143 }
4144 if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
4145         after 1000 hint_gc
4146 }
4147 if {[is_enabled retcode]} {
4148         bind . <Destroy> {+terminate_me %W}
4149 }
4150 if {$picked && [is_config_true gui.autoexplore]} {
4151         do_explore
4152 }
4153
4154 # Local variables:
4155 # mode: tcl
4156 # indent-tabs-mode: t
4157 # tab-width: 4
4158 # End: