git-gui/git-gui.sh

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