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