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