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