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