git-gui/git-gui.sh

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