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