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