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