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