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