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