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