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