git-gui/git-gui.sh

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3  if test "z$*" = zversion \
   4  || test "z$*" = z--version; \
   5  then \
   6         echo 'git-gui version @@GITGUI_VERSION@@'; \
   7         exit; \
   8  fi; \
   9  argv0=$0; \
  10  exec wish "$argv0" -- "$@"
  11
  12 set appvers {@@GITGUI_VERSION@@}
  13 set copyright [string map [list (c) \u00a9] {
  14 Copyright (c) 2006-2010 Shawn Pearce, et. al.
  15
  16 This program is free software; you can redistribute it and/or modify
  17 it under the terms of the GNU General Public License as published by
  18 the Free Software Foundation; either version 2 of the License, or
  19 (at your option) any later version.
  20
  21 This program is distributed in the hope that it will be useful,
  22 but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 GNU General Public License for more details.
  25
  26 You should have received a copy of the GNU General Public License
  27 along with this program; if not, 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                 } else {
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                                 || [$ui_comm edit modified])
2313                                 && $msg ne {}} {
2314                                 catch {
2315                                         set fd [open $save w]
2316                                         fconfigure $fd -encoding utf-8
2317                                         puts -nonewline $fd $msg
2318                                         close $fd
2319                                 }
2320                         } else {
2321                                 catch {file delete $save}
2322                         }
2323                 }
2324
2325                 # -- Cancel our spellchecker if its running.
2326                 #
2327                 if {[info exists ui_comm_spell]} {
2328                         $ui_comm_spell stop
2329                 }
2330
2331                 # -- Remove our editor backup, its not needed.
2332                 #
2333                 after cancel $GITGUI_BCK_i
2334                 if {$GITGUI_BCK_exists} {
2335                         catch {file delete [gitdir GITGUI_BCK]}
2336                 }
2337
2338                 # -- Stash our current window geometry into this repository.
2339                 #
2340                 set cfg_wmstate [wm state .]
2341                 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2342                         set rc_wmstate {}
2343                 }
2344                 if {$cfg_wmstate ne $rc_wmstate} {
2345                         catch {git config gui.wmstate $cfg_wmstate}
2346                 }
2347                 if {$cfg_wmstate eq {zoomed}} {
2348                         # on Windows wm geometry will lie about window
2349                         # position (but not size) when window is zoomed
2350                         # restore the window before querying wm geometry
2351                         wm state . normal
2352                 }
2353                 set cfg_geometry [list]
2354                 lappend cfg_geometry [wm geometry .]
2355                 if {$use_ttk} {
2356                         lappend cfg_geometry [.vpane sashpos 0]
2357                         lappend cfg_geometry [.vpane.files sashpos 0]
2358                 } else {
2359                         lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2360                         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2361                 }
2362                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2363                         set rc_geometry {}
2364                 }
2365                 if {$cfg_geometry ne $rc_geometry} {
2366                         catch {git config gui.geometry $cfg_geometry}
2367                 }
2368         }
2369
2370         set ret_code $rc
2371
2372         # Briefly enable send again, working around Tk bug
2373         # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2374         tk appname [appname]
2375
2376         destroy .
2377 }
2378
2379 proc do_rescan {} {
2380         rescan ui_ready
2381 }
2382
2383 proc ui_do_rescan {} {
2384         rescan {force_first_diff ui_ready}
2385 }
2386
2387 proc do_commit {} {
2388         commit_tree
2389 }
2390
2391 proc next_diff {{after {}}} {
2392         global next_diff_p next_diff_w next_diff_i
2393         show_diff $next_diff_p $next_diff_w {} {} $after
2394 }
2395
2396 proc find_anchor_pos {lst name} {
2397         set lid [lsearch -sorted -exact $lst $name]
2398
2399         if {$lid == -1} {
2400                 set lid 0
2401                 foreach lname $lst {
2402                         if {$lname >= $name} break
2403                         incr lid
2404                 }
2405         }
2406
2407         return $lid
2408 }
2409
2410 proc find_file_from {flist idx delta path mmask} {
2411         global file_states
2412
2413         set len [llength $flist]
2414         while {$idx >= 0 && $idx < $len} {
2415                 set name [lindex $flist $idx]
2416
2417                 if {$name ne $path && [info exists file_states($name)]} {
2418                         set state [lindex $file_states($name) 0]
2419
2420                         if {$mmask eq {} || [regexp $mmask $state]} {
2421                                 return $idx
2422                         }
2423                 }
2424
2425                 incr idx $delta
2426         }
2427
2428         return {}
2429 }
2430
2431 proc find_next_diff {w path {lno {}} {mmask {}}} {
2432         global next_diff_p next_diff_w next_diff_i
2433         global file_lists ui_index ui_workdir
2434
2435         set flist $file_lists($w)
2436         if {$lno eq {}} {
2437                 set lno [find_anchor_pos $flist $path]
2438         } else {
2439                 incr lno -1
2440         }
2441
2442         if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2443                 if {$w eq $ui_index} {
2444                         set mmask "^$mmask"
2445                 } else {
2446                         set mmask "$mmask\$"
2447                 }
2448         }
2449
2450         set idx [find_file_from $flist $lno 1 $path $mmask]
2451         if {$idx eq {}} {
2452                 incr lno -1
2453                 set idx [find_file_from $flist $lno -1 $path $mmask]
2454         }
2455
2456         if {$idx ne {}} {
2457                 set next_diff_w $w
2458                 set next_diff_p [lindex $flist $idx]
2459                 set next_diff_i [expr {$idx+1}]
2460                 return 1
2461         } else {
2462                 return 0
2463         }
2464 }
2465
2466 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2467         global current_diff_path
2468
2469         if {$path ne $current_diff_path} {
2470                 return {}
2471         } elseif {[find_next_diff $w $path $lno $mmask]} {
2472                 return {next_diff;}
2473         } else {
2474                 return {reshow_diff;}
2475         }
2476 }
2477
2478 proc select_first_diff {after} {
2479         global ui_workdir
2480
2481         if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2482             [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2483                 next_diff $after
2484         } else {
2485                 uplevel #0 $after
2486         }
2487 }
2488
2489 proc force_first_diff {after} {
2490         global ui_workdir current_diff_path file_states
2491
2492         if {[info exists file_states($current_diff_path)]} {
2493                 set state [lindex $file_states($current_diff_path) 0]
2494         } else {
2495                 set state {OO}
2496         }
2497
2498         set reselect 0
2499         if {[string first {U} $state] >= 0} {
2500                 # Already a conflict, do nothing
2501         } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2502                 set reselect 1
2503         } elseif {[string index $state 1] ne {O}} {
2504                 # Already a diff & no conflicts, do nothing
2505         } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2506                 set reselect 1
2507         }
2508
2509         if {$reselect} {
2510                 next_diff $after
2511         } else {
2512                 uplevel #0 $after
2513         }
2514 }
2515
2516 proc toggle_or_diff {mode w args} {
2517         global file_states file_lists current_diff_path ui_index ui_workdir
2518         global last_clicked selected_paths file_lists_last_clicked
2519
2520         if {$mode eq "click"} {
2521                 foreach {x y} $args break
2522                 set pos [split [$w index @$x,$y] .]
2523                 foreach {lno col} $pos break
2524         } else {
2525                 if {$mode eq "toggle"} {
2526                         if {$w eq $ui_workdir} {
2527                                 do_add_selection
2528                                 set last_clicked {}
2529                                 return
2530                         }
2531                         if {$w eq $ui_index} {
2532                                 do_unstage_selection
2533                                 set last_clicked {}
2534                                 return
2535                         }
2536                 }
2537
2538                 if {$last_clicked ne {}} {
2539                         set lno [lindex $last_clicked 1]
2540                 } else {
2541                         if {![info exists file_lists]
2542                                 || ![info exists file_lists($w)]
2543                                 || [llength $file_lists($w)] == 0} {
2544                                 set last_clicked {}
2545                                 return
2546                         }
2547                         set lno [expr {int([lindex [$w tag ranges in_diff] 0])}]
2548                 }
2549                 if {$mode eq "toggle"} {
2550                         set col 0; set y 2
2551                 } else {
2552                         incr lno [expr {$mode eq "up" ? -1 : 1}]
2553                         set col 1
2554                 }
2555         }
2556
2557         if {![info exists file_lists]
2558                 || ![info exists file_lists($w)]
2559                 || [llength $file_lists($w)] < $lno - 1} {
2560                 set path {}
2561         } else {
2562                 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2563         }
2564         if {$path eq {}} {
2565                 set last_clicked {}
2566                 return
2567         }
2568
2569         set last_clicked [list $w $lno]
2570         focus $w
2571         array unset selected_paths
2572         $ui_index tag remove in_sel 0.0 end
2573         $ui_workdir tag remove in_sel 0.0 end
2574
2575         set file_lists_last_clicked($w) $path
2576
2577         # Determine the state of the file
2578         if {[info exists file_states($path)]} {
2579                 set state [lindex $file_states($path) 0]
2580         } else {
2581                 set state {__}
2582         }
2583
2584         # Restage the file, or simply show the diff
2585         if {$col == 0 && $y > 1} {
2586                 # Conflicts need special handling
2587                 if {[string first {U} $state] >= 0} {
2588                         # $w must always be $ui_workdir, but...
2589                         if {$w ne $ui_workdir} { set lno {} }
2590                         merge_stage_workdir $path $lno
2591                         return
2592                 }
2593
2594                 if {[string index $state 1] eq {O}} {
2595                         set mmask {}
2596                 } else {
2597                         set mmask {[^O]}
2598                 }
2599
2600                 set after [next_diff_after_action $w $path $lno $mmask]
2601
2602                 if {$w eq $ui_index} {
2603                         update_indexinfo \
2604                                 "Unstaging [short_path $path] from commit" \
2605                                 [list $path] \
2606                                 [concat $after {ui_ready;}]
2607                 } elseif {$w eq $ui_workdir} {
2608                         update_index \
2609                                 "Adding [short_path $path]" \
2610                                 [list $path] \
2611                                 [concat $after {ui_ready;}]
2612                 }
2613         } else {
2614                 set selected_paths($path) 1
2615                 show_diff $path $w $lno
2616         }
2617 }
2618
2619 proc add_one_to_selection {w x y} {
2620         global file_lists last_clicked selected_paths
2621
2622         set lno [lindex [split [$w index @$x,$y] .] 0]
2623         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2624         if {$path eq {}} {
2625                 set last_clicked {}
2626                 return
2627         }
2628
2629         if {$last_clicked ne {}
2630                 && [lindex $last_clicked 0] ne $w} {
2631                 array unset selected_paths
2632                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2633         }
2634
2635         set last_clicked [list $w $lno]
2636         if {[catch {set in_sel $selected_paths($path)}]} {
2637                 set in_sel 0
2638         }
2639         if {$in_sel} {
2640                 unset selected_paths($path)
2641                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2642         } else {
2643                 set selected_paths($path) 1
2644                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2645         }
2646 }
2647
2648 proc add_range_to_selection {w x y} {
2649         global file_lists last_clicked selected_paths
2650
2651         if {[lindex $last_clicked 0] ne $w} {
2652                 toggle_or_diff click $w $x $y
2653                 return
2654         }
2655
2656         set lno [lindex [split [$w index @$x,$y] .] 0]
2657         set lc [lindex $last_clicked 1]
2658         if {$lc < $lno} {
2659                 set begin $lc
2660                 set end $lno
2661         } else {
2662                 set begin $lno
2663                 set end $lc
2664         }
2665
2666         foreach path [lrange $file_lists($w) \
2667                 [expr {$begin - 1}] \
2668                 [expr {$end - 1}]] {
2669                 set selected_paths($path) 1
2670         }
2671         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2672 }
2673
2674 proc show_more_context {} {
2675         global repo_config
2676         if {$repo_config(gui.diffcontext) < 99} {
2677                 incr repo_config(gui.diffcontext)
2678                 reshow_diff
2679         }
2680 }
2681
2682 proc show_less_context {} {
2683         global repo_config
2684         if {$repo_config(gui.diffcontext) > 1} {
2685                 incr repo_config(gui.diffcontext) -1
2686                 reshow_diff
2687         }
2688 }
2689
2690 proc focus_widget {widget} {
2691         global file_lists last_clicked selected_paths
2692         global file_lists_last_clicked
2693
2694         if {[llength $file_lists($widget)] > 0} {
2695                 set path $file_lists_last_clicked($widget)
2696                 set index [lsearch -sorted -exact $file_lists($widget) $path]
2697                 if {$index < 0} {
2698                         set index 0
2699                         set path [lindex $file_lists($widget) $index]
2700                 }
2701
2702                 focus $widget
2703                 set last_clicked [list $widget [expr $index + 1]]
2704                 array unset selected_paths
2705                 set selected_paths($path) 1
2706                 show_diff $path $widget
2707         }
2708 }
2709
2710 proc toggle_commit_type {} {
2711         global commit_type_is_amend
2712         set commit_type_is_amend [expr !$commit_type_is_amend]
2713         do_select_commit_type
2714 }
2715
2716 ######################################################################
2717 ##
2718 ## ui construction
2719
2720 set ui_comm {}
2721
2722 # -- Menu Bar
2723 #
2724 menu .mbar -tearoff 0
2725 if {[is_MacOSX]} {
2726         # -- Apple Menu (Mac OS X only)
2727         #
2728         .mbar add cascade -label Apple -menu .mbar.apple
2729         menu .mbar.apple
2730 }
2731 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2732 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2733 if {[is_enabled branch]} {
2734         .mbar add cascade -label [mc Branch] -menu .mbar.branch
2735 }
2736 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2737         .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2738 }
2739 if {[is_enabled transport]} {
2740         .mbar add cascade -label [mc Merge] -menu .mbar.merge
2741         .mbar add cascade -label [mc Remote] -menu .mbar.remote
2742 }
2743 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2744         .mbar add cascade -label [mc Tools] -menu .mbar.tools
2745 }
2746
2747 # -- Repository Menu
2748 #
2749 menu .mbar.repository
2750
2751 if {![is_bare]} {
2752         .mbar.repository add command \
2753                 -label [mc "Explore Working Copy"] \
2754                 -command {do_explore}
2755 }
2756
2757 if {[is_Windows]} {
2758         # Use /git-bash.exe if available
2759         set normalized [file normalize $::argv0]
2760         regsub "/mingw../libexec/git-core/git-gui$" \
2761                 $normalized "/git-bash.exe" cmdLine
2762         if {$cmdLine != $normalized && [file exists $cmdLine]} {
2763                 set cmdLine [list "Git Bash" $cmdLine &]
2764         } else {
2765                 set cmdLine [list "Git Bash" bash --login -l &]
2766         }
2767         .mbar.repository add command \
2768                 -label [mc "Git Bash"] \
2769                 -command {eval exec [auto_execok start] $cmdLine}
2770 }
2771
2772 if {[is_Windows] || ![is_bare]} {
2773         .mbar.repository add separator
2774 }
2775
2776 .mbar.repository add command \
2777         -label [mc "Browse Current Branch's Files"] \
2778         -command {browser::new $current_branch}
2779 set ui_browse_current [.mbar.repository index last]
2780 .mbar.repository add command \
2781         -label [mc "Browse Branch Files..."] \
2782         -command browser_open::dialog
2783 .mbar.repository add separator
2784
2785 .mbar.repository add command \
2786         -label [mc "Visualize Current Branch's History"] \
2787         -command {do_gitk $current_branch}
2788 set ui_visualize_current [.mbar.repository index last]
2789 .mbar.repository add command \
2790         -label [mc "Visualize All Branch History"] \
2791         -command {do_gitk --all}
2792 .mbar.repository add separator
2793
2794 proc current_branch_write {args} {
2795         global current_branch
2796         .mbar.repository entryconf $::ui_browse_current \
2797                 -label [mc "Browse %s's Files" $current_branch]
2798         .mbar.repository entryconf $::ui_visualize_current \
2799                 -label [mc "Visualize %s's History" $current_branch]
2800 }
2801 trace add variable current_branch write current_branch_write
2802
2803 if {[is_enabled multicommit]} {
2804         .mbar.repository add command -label [mc "Database Statistics"] \
2805                 -command do_stats
2806
2807         .mbar.repository add command -label [mc "Compress Database"] \
2808                 -command do_gc
2809
2810         .mbar.repository add command -label [mc "Verify Database"] \
2811                 -command do_fsck_objects
2812
2813         .mbar.repository add separator
2814
2815         if {[is_Cygwin]} {
2816                 .mbar.repository add command \
2817                         -label [mc "Create Desktop Icon"] \
2818                         -command do_cygwin_shortcut
2819         } elseif {[is_Windows]} {
2820                 .mbar.repository add command \
2821                         -label [mc "Create Desktop Icon"] \
2822                         -command do_windows_shortcut
2823         } elseif {[is_MacOSX]} {
2824                 .mbar.repository add command \
2825                         -label [mc "Create Desktop Icon"] \
2826                         -command do_macosx_app
2827         }
2828 }
2829
2830 if {[is_MacOSX]} {
2831         proc ::tk::mac::Quit {args} { do_quit }
2832 } else {
2833         .mbar.repository add command -label [mc Quit] \
2834                 -command do_quit \
2835                 -accelerator $M1T-Q
2836 }
2837
2838 # -- Edit Menu
2839 #
2840 menu .mbar.edit
2841 .mbar.edit add command -label [mc Undo] \
2842         -command {catch {[focus] edit undo}} \
2843         -accelerator $M1T-Z
2844 .mbar.edit add command -label [mc Redo] \
2845         -command {catch {[focus] edit redo}} \
2846         -accelerator $M1T-Y
2847 .mbar.edit add separator
2848 .mbar.edit add command -label [mc Cut] \
2849         -command {catch {tk_textCut [focus]}} \
2850         -accelerator $M1T-X
2851 .mbar.edit add command -label [mc Copy] \
2852         -command {catch {tk_textCopy [focus]}} \
2853         -accelerator $M1T-C
2854 .mbar.edit add command -label [mc Paste] \
2855         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2856         -accelerator $M1T-V
2857 .mbar.edit add command -label [mc Delete] \
2858         -command {catch {[focus] delete sel.first sel.last}} \
2859         -accelerator Del
2860 .mbar.edit add separator
2861 .mbar.edit add command -label [mc "Select All"] \
2862         -command {catch {[focus] tag add sel 0.0 end}} \
2863         -accelerator $M1T-A
2864
2865 # -- Branch Menu
2866 #
2867 if {[is_enabled branch]} {
2868         menu .mbar.branch
2869
2870         .mbar.branch add command -label [mc "Create..."] \
2871                 -command branch_create::dialog \
2872                 -accelerator $M1T-N
2873         lappend disable_on_lock [list .mbar.branch entryconf \
2874                 [.mbar.branch index last] -state]
2875
2876         .mbar.branch add command -label [mc "Checkout..."] \
2877                 -command branch_checkout::dialog \
2878                 -accelerator $M1T-O
2879         lappend disable_on_lock [list .mbar.branch entryconf \
2880                 [.mbar.branch index last] -state]
2881
2882         .mbar.branch add command -label [mc "Rename..."] \
2883                 -command branch_rename::dialog
2884         lappend disable_on_lock [list .mbar.branch entryconf \
2885                 [.mbar.branch index last] -state]
2886
2887         .mbar.branch add command -label [mc "Delete..."] \
2888                 -command branch_delete::dialog
2889         lappend disable_on_lock [list .mbar.branch entryconf \
2890                 [.mbar.branch index last] -state]
2891
2892         .mbar.branch add command -label [mc "Reset..."] \
2893                 -command merge::reset_hard
2894         lappend disable_on_lock [list .mbar.branch entryconf \
2895                 [.mbar.branch index last] -state]
2896 }
2897
2898 # -- Commit Menu
2899 #
2900 proc commit_btn_caption {} {
2901         if {[is_enabled nocommit]} {
2902                 return [mc "Done"]
2903         } else {
2904                 return [mc Commit@@verb]
2905         }
2906 }
2907
2908 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2909         menu .mbar.commit
2910
2911         if {![is_enabled nocommit]} {
2912                 .mbar.commit add checkbutton \
2913                         -label [mc "Amend Last Commit"] \
2914                         -accelerator $M1T-E \
2915                         -variable commit_type_is_amend \
2916                         -command do_select_commit_type
2917                 lappend disable_on_lock \
2918                         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2919
2920                 .mbar.commit add separator
2921         }
2922
2923         .mbar.commit add command -label [mc Rescan] \
2924                 -command ui_do_rescan \
2925                 -accelerator F5
2926         lappend disable_on_lock \
2927                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2928
2929         .mbar.commit add command -label [mc "Stage To Commit"] \
2930                 -command do_add_selection \
2931                 -accelerator $M1T-T
2932         lappend disable_on_lock \
2933                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2934
2935         .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2936                 -command do_add_all \
2937                 -accelerator $M1T-I
2938         lappend disable_on_lock \
2939                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2940
2941         .mbar.commit add command -label [mc "Unstage From Commit"] \
2942                 -command do_unstage_selection \
2943                 -accelerator $M1T-U
2944         lappend disable_on_lock \
2945                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2946
2947         .mbar.commit add command -label [mc "Revert Changes"] \
2948                 -command do_revert_selection \
2949                 -accelerator $M1T-J
2950         lappend disable_on_lock \
2951                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2952
2953         .mbar.commit add separator
2954
2955         .mbar.commit add command -label [mc "Show Less Context"] \
2956                 -command show_less_context \
2957                 -accelerator $M1T-\-
2958
2959         .mbar.commit add command -label [mc "Show More Context"] \
2960                 -command show_more_context \
2961                 -accelerator $M1T-=
2962
2963         .mbar.commit add separator
2964
2965         if {![is_enabled nocommitmsg]} {
2966                 .mbar.commit add command -label [mc "Sign Off"] \
2967                         -command do_signoff \
2968                         -accelerator $M1T-S
2969         }
2970
2971         .mbar.commit add command -label [commit_btn_caption] \
2972                 -command do_commit \
2973                 -accelerator $M1T-Return
2974         lappend disable_on_lock \
2975                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2976 }
2977
2978 # -- Merge Menu
2979 #
2980 if {[is_enabled branch]} {
2981         menu .mbar.merge
2982         .mbar.merge add command -label [mc "Local Merge..."] \
2983                 -command merge::dialog \
2984                 -accelerator $M1T-M
2985         lappend disable_on_lock \
2986                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2987         .mbar.merge add command -label [mc "Abort Merge..."] \
2988                 -command merge::reset_hard
2989         lappend disable_on_lock \
2990                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2991 }
2992
2993 # -- Transport Menu
2994 #
2995 if {[is_enabled transport]} {
2996         menu .mbar.remote
2997
2998         .mbar.remote add command \
2999                 -label [mc "Add..."] \
3000                 -command remote_add::dialog \
3001                 -accelerator $M1T-A
3002         .mbar.remote add command \
3003                 -label [mc "Push..."] \
3004                 -command do_push_anywhere \
3005                 -accelerator $M1T-P
3006         .mbar.remote add command \
3007                 -label [mc "Delete Branch..."] \
3008                 -command remote_branch_delete::dialog
3009 }
3010
3011 if {[is_MacOSX]} {
3012         proc ::tk::mac::ShowPreferences {} {do_options}
3013 } else {
3014         # -- Edit Menu
3015         #
3016         .mbar.edit add separator
3017         .mbar.edit add command -label [mc "Options..."] \
3018                 -command do_options
3019 }
3020
3021 # -- Tools Menu
3022 #
3023 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
3024         set tools_menubar .mbar.tools
3025         menu $tools_menubar
3026         $tools_menubar add separator
3027         $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
3028         $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
3029         set tools_tailcnt 3
3030         if {[array names repo_config guitool.*.cmd] ne {}} {
3031                 tools_populate_all
3032         }
3033 }
3034
3035 # -- Help Menu
3036 #
3037 .mbar add cascade -label [mc Help] -menu .mbar.help
3038 menu .mbar.help
3039
3040 if {[is_MacOSX]} {
3041         .mbar.apple add command -label [mc "About %s" [appname]] \
3042                 -command do_about
3043         .mbar.apple add separator
3044 } else {
3045         .mbar.help add command -label [mc "About %s" [appname]] \
3046                 -command do_about
3047 }
3048 . configure -menu .mbar
3049
3050 set doc_path [githtmldir]
3051 if {$doc_path ne {}} {
3052         set doc_path [file join $doc_path index.html]
3053
3054         if {[is_Cygwin]} {
3055                 set doc_path [exec cygpath --mixed $doc_path]
3056         }
3057 }
3058
3059 if {[file isfile $doc_path]} {
3060         set doc_url "file:$doc_path"
3061 } else {
3062         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
3063 }
3064
3065 proc start_browser {url} {
3066         git "web--browse" $url
3067 }
3068
3069 .mbar.help add command -label [mc "Online Documentation"] \
3070         -command [list start_browser $doc_url]
3071
3072 .mbar.help add command -label [mc "Show SSH Key"] \
3073         -command do_ssh_key
3074
3075 unset doc_path doc_url
3076
3077 # -- Standard bindings
3078 #
3079 wm protocol . WM_DELETE_WINDOW do_quit
3080 bind all <$M1B-Key-q> do_quit
3081 bind all <$M1B-Key-Q> do_quit
3082
3083 set m1b_w_script {
3084         set toplvl_win [winfo toplevel %W]
3085
3086         # If we are destroying the main window, we should call do_quit to take
3087         # care of cleanup before exiting the program.
3088         if {$toplvl_win eq "."} {
3089                 do_quit
3090         } else {
3091                 destroy $toplvl_win
3092         }
3093 }
3094
3095 bind all <$M1B-Key-w> $m1b_w_script
3096 bind all <$M1B-Key-W> $m1b_w_script
3097
3098 unset m1b_w_script
3099
3100 set subcommand_args {}
3101 proc usage {} {
3102         set s "[mc usage:] $::argv0 $::subcommand $::subcommand_args"
3103         if {[tk windowingsystem] eq "win32"} {
3104                 wm withdraw .
3105                 tk_messageBox -icon info -message $s \
3106                         -title [mc "Usage"]
3107         } else {
3108                 puts stderr $s
3109         }
3110         exit 1
3111 }
3112
3113 proc normalize_relpath {path} {
3114         set elements {}
3115         foreach item [file split $path] {
3116                 if {$item eq {.}} continue
3117                 if {$item eq {..} && [llength $elements] > 0
3118                     && [lindex $elements end] ne {..}} {
3119                         set elements [lrange $elements 0 end-1]
3120                         continue
3121                 }
3122                 lappend elements $item
3123         }
3124         return [eval file join $elements]
3125 }
3126
3127 # -- Not a normal commit type invocation?  Do that instead!
3128 #
3129 switch -- $subcommand {
3130 browser -
3131 blame {
3132         if {$subcommand eq "blame"} {
3133                 set subcommand_args {[--line=<num>] rev? path}
3134         } else {
3135                 set subcommand_args {rev? path}
3136         }
3137         if {$argv eq {}} usage
3138         set head {}
3139         set path {}
3140         set jump_spec {}
3141         set is_path 0
3142         foreach a $argv {
3143                 set p [file join $_prefix $a]
3144
3145                 if {$is_path || [file exists $p]} {
3146                         if {$path ne {}} usage
3147                         set path [normalize_relpath $p]
3148                         break
3149                 } elseif {$a eq {--}} {
3150                         if {$path ne {}} {
3151                                 if {$head ne {}} usage
3152                                 set head $path
3153                                 set path {}
3154                         }
3155                         set is_path 1
3156                 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3157                         if {$jump_spec ne {} || $head ne {}} usage
3158                         set jump_spec [list $lnum]
3159                 } elseif {$head eq {}} {
3160                         if {$head ne {}} usage
3161                         set head $a
3162                         set is_path 1
3163                 } else {
3164                         usage
3165                 }
3166         }
3167         unset is_path
3168
3169         if {$head ne {} && $path eq {}} {
3170                 if {[string index $head 0] eq {/}} {
3171                         set path [normalize_relpath $head]
3172                         set head {}
3173                 } else {
3174                         set path [normalize_relpath $_prefix$head]
3175                         set head {}
3176                 }
3177         }
3178
3179         if {$head eq {}} {
3180                 load_current_branch
3181         } else {
3182                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3183                         if {[catch {
3184                                         set head [git rev-parse --verify $head]
3185                                 } err]} {
3186                                 if {[tk windowingsystem] eq "win32"} {
3187                                         tk_messageBox -icon error -title [mc Error] -message $err
3188                                 } else {
3189                                         puts stderr $err
3190                                 }
3191                                 exit 1
3192                         }
3193                 }
3194                 set current_branch $head
3195         }
3196
3197         wm deiconify .
3198         switch -- $subcommand {
3199         browser {
3200                 if {$jump_spec ne {}} usage
3201                 if {$head eq {}} {
3202                         if {$path ne {} && [file isdirectory $path]} {
3203                                 set head $current_branch
3204                         } else {
3205                                 set head $path
3206                                 set path {}
3207                         }
3208                 }
3209                 browser::new $head $path
3210         }
3211         blame   {
3212                 if {$head eq {} && ![file exists $path]} {
3213                         catch {wm withdraw .}
3214                         tk_messageBox \
3215                                 -icon error \
3216                                 -type ok \
3217                                 -title [mc "git-gui: fatal error"] \
3218                                 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3219                         exit 1
3220                 }
3221                 blame::new $head $path $jump_spec
3222         }
3223         }
3224         return
3225 }
3226 citool -
3227 gui {
3228         if {[llength $argv] != 0} {
3229                 usage
3230         }
3231         # fall through to setup UI for commits
3232 }
3233 default {
3234         set err "[mc usage:] $argv0 \[{blame|browser|citool}\]"
3235         if {[tk windowingsystem] eq "win32"} {
3236                 wm withdraw .
3237                 tk_messageBox -icon error -message $err \
3238                         -title [mc "Usage"]
3239         } else {
3240                 puts stderr $err
3241         }
3242         exit 1
3243 }
3244 }
3245
3246 # -- Branch Control
3247 #
3248 ${NS}::frame .branch
3249 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3250 ${NS}::label .branch.l1 \
3251         -text [mc "Current Branch:"] \
3252         -anchor w \
3253         -justify left
3254 ${NS}::label .branch.cb \
3255         -textvariable current_branch \
3256         -anchor w \
3257         -justify left
3258 pack .branch.l1 -side left
3259 pack .branch.cb -side left -fill x
3260 pack .branch -side top -fill x
3261
3262 # -- Main Window Layout
3263 #
3264 ${NS}::panedwindow .vpane -orient horizontal
3265 ${NS}::panedwindow .vpane.files -orient vertical
3266 if {$use_ttk} {
3267         .vpane add .vpane.files
3268 } else {
3269         .vpane add .vpane.files -sticky nsew -height 100 -width 200
3270 }
3271 pack .vpane -anchor n -side top -fill both -expand 1
3272
3273 # -- Working Directory File List
3274
3275 textframe .vpane.files.workdir -height 100 -width 200
3276 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3277         -background lightsalmon -foreground black
3278 ttext $ui_workdir \
3279         -borderwidth 0 \
3280         -width 20 -height 10 \
3281         -wrap none \
3282         -takefocus 1 -highlightthickness 1\
3283         -cursor $cursor_ptr \
3284         -xscrollcommand {.vpane.files.workdir.sx set} \
3285         -yscrollcommand {.vpane.files.workdir.sy set} \
3286         -state disabled
3287 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3288 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3289 pack .vpane.files.workdir.title -side top -fill x
3290 pack .vpane.files.workdir.sx -side bottom -fill x
3291 pack .vpane.files.workdir.sy -side right -fill y
3292 pack $ui_workdir -side left -fill both -expand 1
3293
3294 # -- Index File List
3295 #
3296 textframe .vpane.files.index -height 100 -width 200
3297 tlabel .vpane.files.index.title \
3298         -text [mc "Staged Changes (Will Commit)"] \
3299         -background lightgreen -foreground black
3300 ttext $ui_index \
3301         -borderwidth 0 \
3302         -width 20 -height 10 \
3303         -wrap none \
3304         -takefocus 1 -highlightthickness 1\
3305         -cursor $cursor_ptr \
3306         -xscrollcommand {.vpane.files.index.sx set} \
3307         -yscrollcommand {.vpane.files.index.sy set} \
3308         -state disabled
3309 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3310 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3311 pack .vpane.files.index.title -side top -fill x
3312 pack .vpane.files.index.sx -side bottom -fill x
3313 pack .vpane.files.index.sy -side right -fill y
3314 pack $ui_index -side left -fill both -expand 1
3315
3316 # -- Insert the workdir and index into the panes
3317 #
3318 .vpane.files add .vpane.files.workdir
3319 .vpane.files add .vpane.files.index
3320 if {!$use_ttk} {
3321         .vpane.files paneconfigure .vpane.files.workdir -sticky news
3322         .vpane.files paneconfigure .vpane.files.index -sticky news
3323 }
3324
3325 foreach i [list $ui_index $ui_workdir] {
3326         rmsel_tag $i
3327         $i tag conf in_diff \
3328                 -background $color::select_bg \
3329                 -foreground $color::select_fg
3330 }
3331 unset i
3332
3333 # -- Diff and Commit Area
3334 #
3335 if {$have_tk85} {
3336         ${NS}::panedwindow .vpane.lower -orient vertical
3337         ${NS}::frame .vpane.lower.commarea
3338         ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500
3339         .vpane.lower add .vpane.lower.diff
3340         .vpane.lower add .vpane.lower.commarea
3341         .vpane add .vpane.lower
3342         if {$use_ttk} {
3343                 .vpane.lower pane .vpane.lower.diff -weight 1
3344                 .vpane.lower pane .vpane.lower.commarea -weight 0
3345         } else {
3346                 .vpane.lower paneconfigure .vpane.lower.diff -stretch always
3347                 .vpane.lower paneconfigure .vpane.lower.commarea -stretch never
3348         }
3349 } else {
3350         frame .vpane.lower -height 300 -width 400
3351         frame .vpane.lower.commarea
3352         frame .vpane.lower.diff -relief sunken -borderwidth 1
3353         pack .vpane.lower.diff -fill both -expand 1
3354         pack .vpane.lower.commarea -side bottom -fill x
3355         .vpane add .vpane.lower
3356         .vpane paneconfigure .vpane.lower -sticky nsew
3357 }
3358
3359 # -- Commit Area Buttons
3360 #
3361 ${NS}::frame .vpane.lower.commarea.buttons
3362 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3363         -anchor w \
3364         -justify left
3365 pack .vpane.lower.commarea.buttons.l -side top -fill x
3366 pack .vpane.lower.commarea.buttons -side left -fill y
3367
3368 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3369         -command ui_do_rescan
3370 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3371 lappend disable_on_lock \
3372         {.vpane.lower.commarea.buttons.rescan conf -state}
3373
3374 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3375         -command do_add_all
3376 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3377 lappend disable_on_lock \
3378         {.vpane.lower.commarea.buttons.incall conf -state}
3379
3380 if {![is_enabled nocommitmsg]} {
3381         ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3382                 -command do_signoff
3383         pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3384 }
3385
3386 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3387         -command do_commit
3388 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3389 lappend disable_on_lock \
3390         {.vpane.lower.commarea.buttons.commit conf -state}
3391
3392 if {![is_enabled nocommit]} {
3393         ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3394                 -command do_push_anywhere
3395         pack .vpane.lower.commarea.buttons.push -side top -fill x
3396 }
3397
3398 # -- Commit Message Buffer
3399 #
3400 ${NS}::frame .vpane.lower.commarea.buffer
3401 ${NS}::frame .vpane.lower.commarea.buffer.header
3402 set ui_comm .vpane.lower.commarea.buffer.frame.t
3403 set ui_coml .vpane.lower.commarea.buffer.header.l
3404
3405 if {![is_enabled nocommit]} {
3406         ${NS}::checkbutton .vpane.lower.commarea.buffer.header.amend \
3407                 -text [mc "Amend Last Commit"] \
3408                 -variable commit_type_is_amend \
3409                 -command do_select_commit_type
3410         lappend disable_on_lock \
3411                 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3412 }
3413
3414 ${NS}::label $ui_coml \
3415         -anchor w \
3416         -justify left
3417 proc trace_commit_type {varname args} {
3418         global ui_coml commit_type
3419         switch -glob -- $commit_type {
3420         initial       {set txt [mc "Initial Commit Message:"]}
3421         amend         {set txt [mc "Amended Commit Message:"]}
3422         amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3423         amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
3424         merge         {set txt [mc "Merge Commit Message:"]}
3425         *             {set txt [mc "Commit Message:"]}
3426         }
3427         $ui_coml conf -text $txt
3428 }
3429 trace add variable commit_type write trace_commit_type
3430 pack $ui_coml -side left -fill x
3431
3432 if {![is_enabled nocommit]} {
3433         pack .vpane.lower.commarea.buffer.header.amend -side right
3434 }
3435
3436 textframe .vpane.lower.commarea.buffer.frame
3437 ttext $ui_comm \
3438         -borderwidth 1 \
3439         -undo true \
3440         -maxundo 20 \
3441         -autoseparators true \
3442         -takefocus 1 \
3443         -highlightthickness 1 \
3444         -relief sunken \
3445         -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3446         -font font_diff \
3447         -xscrollcommand {.vpane.lower.commarea.buffer.frame.sbx set} \
3448         -yscrollcommand {.vpane.lower.commarea.buffer.frame.sby set}
3449 ${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sbx \
3450         -orient horizontal \
3451         -command [list $ui_comm xview]
3452 ${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sby \
3453         -orient vertical \
3454         -command [list $ui_comm yview]
3455
3456 pack .vpane.lower.commarea.buffer.frame.sbx -side bottom -fill x
3457 pack .vpane.lower.commarea.buffer.frame.sby -side right -fill y
3458 pack $ui_comm -side left -fill y
3459 pack .vpane.lower.commarea.buffer.header -side top -fill x
3460 pack .vpane.lower.commarea.buffer.frame -side left -fill y
3461 pack .vpane.lower.commarea.buffer -side left -fill y
3462
3463 # -- Commit Message Buffer Context Menu
3464 #
3465 set ctxm .vpane.lower.commarea.buffer.ctxm
3466 menu $ctxm -tearoff 0
3467 $ctxm add command \
3468         -label [mc Cut] \
3469         -command {tk_textCut $ui_comm}
3470 $ctxm add command \
3471         -label [mc Copy] \
3472         -command {tk_textCopy $ui_comm}
3473 $ctxm add command \
3474         -label [mc Paste] \
3475         -command {tk_textPaste $ui_comm}
3476 $ctxm add command \
3477         -label [mc Delete] \
3478         -command {catch {$ui_comm delete sel.first sel.last}}
3479 $ctxm add separator
3480 $ctxm add command \
3481         -label [mc "Select All"] \
3482         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3483 $ctxm add command \
3484         -label [mc "Copy All"] \
3485         -command {
3486                 $ui_comm tag add sel 0.0 end
3487                 tk_textCopy $ui_comm
3488                 $ui_comm tag remove sel 0.0 end
3489         }
3490 $ctxm add separator
3491 $ctxm add command \
3492         -label [mc "Sign Off"] \
3493         -command do_signoff
3494 set ui_comm_ctxm $ctxm
3495
3496 # -- Diff Header
3497 #
3498 proc trace_current_diff_path {varname args} {
3499         global current_diff_path diff_actions file_states
3500         if {$current_diff_path eq {}} {
3501                 set s {}
3502                 set f {}
3503                 set p {}
3504                 set o disabled
3505         } else {
3506                 set p $current_diff_path
3507                 set s [mapdesc [lindex $file_states($p) 0] $p]
3508                 set f [mc "File:"]
3509                 set p [escape_path $p]
3510                 set o normal
3511         }
3512
3513         .vpane.lower.diff.header.status configure -text $s
3514         .vpane.lower.diff.header.file configure -text $f
3515         .vpane.lower.diff.header.path configure -text $p
3516         foreach w $diff_actions {
3517                 uplevel #0 $w $o
3518         }
3519 }
3520 trace add variable current_diff_path write trace_current_diff_path
3521
3522 gold_frame .vpane.lower.diff.header
3523 tlabel .vpane.lower.diff.header.status \
3524         -background gold \
3525         -foreground black \
3526         -width $max_status_desc \
3527         -anchor w \
3528         -justify left
3529 tlabel .vpane.lower.diff.header.file \
3530         -background gold \
3531         -foreground black \
3532         -anchor w \
3533         -justify left
3534 tlabel .vpane.lower.diff.header.path \
3535         -background gold \
3536         -foreground blue \
3537         -anchor w \
3538         -justify left \
3539         -font [eval font create [font configure font_ui] -underline 1] \
3540         -cursor hand2
3541 pack .vpane.lower.diff.header.status -side left
3542 pack .vpane.lower.diff.header.file -side left
3543 pack .vpane.lower.diff.header.path -fill x
3544 set ctxm .vpane.lower.diff.header.ctxm
3545 menu $ctxm -tearoff 0
3546 $ctxm add command \
3547         -label [mc Copy] \
3548         -command {
3549                 clipboard clear
3550                 clipboard append \
3551                         -format STRING \
3552                         -type STRING \
3553                         -- $current_diff_path
3554         }
3555 $ctxm add command \
3556         -label [mc Open] \
3557         -command {do_file_open $current_diff_path}
3558 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3559 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3560 bind .vpane.lower.diff.header.path <Button-1> {do_file_open $current_diff_path}
3561
3562 # -- Diff Body
3563 #
3564 textframe .vpane.lower.diff.body
3565 set ui_diff .vpane.lower.diff.body.t
3566 ttext $ui_diff \
3567         -borderwidth 0 \
3568         -width 80 -height 5 -wrap none \
3569         -font font_diff \
3570         -takefocus 1 -highlightthickness 1 \
3571         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3572         -yscrollcommand {.vpane.lower.diff.body.sby set} \
3573         -state disabled
3574 catch {$ui_diff configure -tabstyle wordprocessor}
3575 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3576         -command [list $ui_diff xview]
3577 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3578         -command [list $ui_diff yview]
3579 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3580 pack .vpane.lower.diff.body.sby -side right -fill y
3581 pack $ui_diff -side left -fill both -expand 1
3582 pack .vpane.lower.diff.header -side top -fill x
3583 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3584
3585 foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3586         $ui_diff tag configure clr4$n -background $c
3587         $ui_diff tag configure clri4$n -foreground $c
3588         $ui_diff tag configure clr3$n -foreground $c
3589         $ui_diff tag configure clri3$n -background $c
3590 }
3591 $ui_diff tag configure clr1 -font font_diffbold
3592 $ui_diff tag configure clr4 -underline 1
3593
3594 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3595
3596 $ui_diff tag conf d_cr -elide true
3597 $ui_diff tag conf d_@ -font font_diffbold
3598 $ui_diff tag conf d_+ -foreground {#00a000}
3599 $ui_diff tag conf d_- -foreground red
3600
3601 $ui_diff tag conf d_++ -foreground {#00a000}
3602 $ui_diff tag conf d_-- -foreground red
3603 $ui_diff tag conf d_+s \
3604         -foreground {#00a000} \
3605         -background {#e2effa}
3606 $ui_diff tag conf d_-s \
3607         -foreground red \
3608         -background {#e2effa}
3609 $ui_diff tag conf d_s+ \
3610         -foreground {#00a000} \
3611         -background ivory1
3612 $ui_diff tag conf d_s- \
3613         -foreground red \
3614         -background ivory1
3615
3616 $ui_diff tag conf d< \
3617         -foreground orange \
3618         -font font_diffbold
3619 $ui_diff tag conf d| \
3620         -foreground orange \
3621         -font font_diffbold
3622 $ui_diff tag conf d= \
3623         -foreground orange \
3624         -font font_diffbold
3625 $ui_diff tag conf d> \
3626         -foreground orange \
3627         -font font_diffbold
3628
3629 $ui_diff tag raise sel
3630
3631 # -- Diff Body Context Menu
3632 #
3633
3634 proc create_common_diff_popup {ctxm} {
3635         $ctxm add command \
3636                 -label [mc Refresh] \
3637                 -command reshow_diff
3638         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3639         $ctxm add command \
3640                 -label [mc Copy] \
3641                 -command {tk_textCopy $ui_diff}
3642         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3643         $ctxm add command \
3644                 -label [mc "Select All"] \
3645                 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3646         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3647         $ctxm add command \
3648                 -label [mc "Copy All"] \
3649                 -command {
3650                         $ui_diff tag add sel 0.0 end
3651                         tk_textCopy $ui_diff
3652                         $ui_diff tag remove sel 0.0 end
3653                 }
3654         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3655         $ctxm add separator
3656         $ctxm add command \
3657                 -label [mc "Decrease Font Size"] \
3658                 -command {incr_font_size font_diff -1}
3659         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3660         $ctxm add command \
3661                 -label [mc "Increase Font Size"] \
3662                 -command {incr_font_size font_diff 1}
3663         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3664         $ctxm add separator
3665         set emenu $ctxm.enc
3666         menu $emenu
3667         build_encoding_menu $emenu [list force_diff_encoding]
3668         $ctxm add cascade \
3669                 -label [mc "Encoding"] \
3670                 -menu $emenu
3671         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3672         $ctxm add separator
3673         $ctxm add command -label [mc "Options..."] \
3674                 -command do_options
3675 }
3676
3677 set ctxm .vpane.lower.diff.body.ctxm
3678 menu $ctxm -tearoff 0
3679 $ctxm add command \
3680         -label [mc "Apply/Reverse Hunk"] \
3681         -command {apply_or_revert_hunk $cursorX $cursorY 0}
3682 set ui_diff_applyhunk [$ctxm index last]
3683 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3684 $ctxm add command \
3685         -label [mc "Apply/Reverse Line"] \
3686         -command {apply_or_revert_range_or_line $cursorX $cursorY 0; do_rescan}
3687 set ui_diff_applyline [$ctxm index last]
3688 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3689 $ctxm add separator
3690 $ctxm add command \
3691         -label [mc "Revert Hunk"] \
3692         -command {apply_or_revert_hunk $cursorX $cursorY 1}
3693 set ui_diff_reverthunk [$ctxm index last]
3694 lappend diff_actions [list $ctxm entryconf $ui_diff_reverthunk -state]
3695 $ctxm add command \
3696         -label [mc "Revert Line"] \
3697         -command {apply_or_revert_range_or_line $cursorX $cursorY 1; do_rescan}
3698 set ui_diff_revertline [$ctxm index last]
3699 lappend diff_actions [list $ctxm entryconf $ui_diff_revertline -state]
3700 $ctxm add command \
3701         -label [mc "Undo Last Revert"] \
3702         -command {undo_last_revert; do_rescan}
3703 set ui_diff_undorevert [$ctxm index last]
3704 lappend diff_actions [list $ctxm entryconf $ui_diff_undorevert -state]
3705 $ctxm add separator
3706 $ctxm add command \
3707         -label [mc "Show Less Context"] \
3708         -command show_less_context
3709 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3710 $ctxm add command \
3711         -label [mc "Show More Context"] \
3712         -command show_more_context
3713 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3714 $ctxm add separator
3715 create_common_diff_popup $ctxm
3716
3717 set ctxmmg .vpane.lower.diff.body.ctxmmg
3718 menu $ctxmmg -tearoff 0
3719 $ctxmmg add command \
3720         -label [mc "Run Merge Tool"] \
3721         -command {merge_resolve_tool}
3722 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3723 $ctxmmg add separator
3724 $ctxmmg add command \
3725         -label [mc "Use Remote Version"] \
3726         -command {merge_resolve_one 3}
3727 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3728 $ctxmmg add command \
3729         -label [mc "Use Local Version"] \
3730         -command {merge_resolve_one 2}
3731 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3732 $ctxmmg add command \
3733         -label [mc "Revert To Base"] \
3734         -command {merge_resolve_one 1}
3735 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3736 $ctxmmg add separator
3737 $ctxmmg add command \
3738         -label [mc "Show Less Context"] \
3739         -command show_less_context
3740 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3741 $ctxmmg add command \
3742         -label [mc "Show More Context"] \
3743         -command show_more_context
3744 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3745 $ctxmmg add separator
3746 create_common_diff_popup $ctxmmg
3747
3748 set ctxmsm .vpane.lower.diff.body.ctxmsm
3749 menu $ctxmsm -tearoff 0
3750 $ctxmsm add command \
3751         -label [mc "Visualize These Changes In The Submodule"] \
3752         -command {do_gitk -- true}
3753 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3754 $ctxmsm add command \
3755         -label [mc "Visualize Current Branch History In The Submodule"] \
3756         -command {do_gitk {} true}
3757 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3758 $ctxmsm add command \
3759         -label [mc "Visualize All Branch History In The Submodule"] \
3760         -command {do_gitk --all true}
3761 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3762 $ctxmsm add separator
3763 $ctxmsm add command \
3764         -label [mc "Start git gui In The Submodule"] \
3765         -command {do_git_gui}
3766 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3767 $ctxmsm add separator
3768 create_common_diff_popup $ctxmsm
3769
3770 proc has_textconv {path} {
3771         if {[is_config_false gui.textconv]} {
3772                 return 0
3773         }
3774         set filter [gitattr $path diff set]
3775         set textconv [get_config [join [list diff $filter textconv] .]]
3776         if {$filter ne {set} && $textconv ne {}} {
3777                 return 1
3778         } else {
3779                 return 0
3780         }
3781 }
3782
3783 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3784         global current_diff_path file_states last_revert
3785         set ::cursorX $x
3786         set ::cursorY $y
3787         if {[info exists file_states($current_diff_path)]} {
3788                 set state [lindex $file_states($current_diff_path) 0]
3789         } else {
3790                 set state {__}
3791         }
3792         if {[string first {U} $state] >= 0} {
3793                 tk_popup $ctxmmg $X $Y
3794         } elseif {$::is_submodule_diff} {
3795                 tk_popup $ctxmsm $X $Y
3796         } else {
3797                 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3798                 set u [mc "Undo Last Revert"]
3799                 if {$::ui_index eq $::current_diff_side} {
3800                         set l [mc "Unstage Hunk From Commit"]
3801                         set h [mc "Revert Hunk"]
3802
3803                         if {$has_range} {
3804                                 set t [mc "Unstage Lines From Commit"]
3805                                 set r [mc "Revert Lines"]
3806                         } else {
3807                                 set t [mc "Unstage Line From Commit"]
3808                                 set r [mc "Revert Line"]
3809                         }
3810                 } else {
3811                         set l [mc "Stage Hunk For Commit"]
3812                         set h [mc "Revert Hunk"]
3813
3814                         if {$has_range} {
3815                                 set t [mc "Stage Lines For Commit"]
3816                                 set r [mc "Revert Lines"]
3817                         } else {
3818                                 set t [mc "Stage Line For Commit"]
3819                                 set r [mc "Revert Line"]
3820                         }
3821                 }
3822                 if {$::is_3way_diff
3823                         || $current_diff_path eq {}
3824                         || {__} eq $state
3825                         || {_O} eq $state
3826                         || [string match {?T} $state]
3827                         || [string match {T?} $state]
3828                         || [has_textconv $current_diff_path]} {
3829                         set s disabled
3830                         set revert_state disabled
3831                 } else {
3832                         set s normal
3833
3834                         # Only allow reverting changes in the working tree. If
3835                         # the user wants to revert changes in the index, they
3836                         # need to unstage those first.
3837                         if {$::ui_workdir eq $::current_diff_side} {
3838                                 set revert_state normal
3839                         } else {
3840                                 set revert_state disabled
3841                         }
3842                 }
3843
3844                 if {$last_revert eq {}} {
3845                         set undo_state disabled
3846                 } else {
3847                         set undo_state normal
3848                 }
3849
3850                 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3851                 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3852                 $ctxm entryconf $::ui_diff_revertline -state $revert_state \
3853                         -label $r
3854                 $ctxm entryconf $::ui_diff_reverthunk -state $revert_state \
3855                         -label $h
3856                 $ctxm entryconf $::ui_diff_undorevert -state $undo_state \
3857                         -label $u
3858
3859                 tk_popup $ctxm $X $Y
3860         }
3861 }
3862 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3863
3864 # -- Status Bar
3865 #
3866 set main_status [::status_bar::new .status]
3867 pack .status -anchor w -side bottom -fill x
3868 $main_status show [mc "Initializing..."]
3869
3870 # -- Load geometry
3871 #
3872 proc on_ttk_pane_mapped {w pane pos} {
3873         bind $w <Map> {}
3874         after 0 [list after idle [list $w sashpos $pane $pos]]
3875 }
3876 proc on_tk_pane_mapped {w pane x y} {
3877         bind $w <Map> {}
3878         after 0 [list after idle [list $w sash place $pane $x $y]]
3879 }
3880 proc on_application_mapped {} {
3881         global repo_config use_ttk
3882         bind . <Map> {}
3883         set gm $repo_config(gui.geometry)
3884         if {$use_ttk} {
3885                 bind .vpane <Map> \
3886                         [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3887                 bind .vpane.files <Map> \
3888                         [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3889         } else {
3890                 bind .vpane <Map> \
3891                         [list on_tk_pane_mapped %W 0 \
3892                         [lindex $gm 1] \
3893                         [lindex [.vpane sash coord 0] 1]]
3894                 bind .vpane.files <Map> \
3895                         [list on_tk_pane_mapped %W 0 \
3896                         [lindex [.vpane.files sash coord 0] 0] \
3897                         [lindex $gm 2]]
3898         }
3899         wm geometry . [lindex $gm 0]
3900 }
3901 if {[info exists repo_config(gui.geometry)]} {
3902         bind . <Map> [list on_application_mapped]
3903         wm geometry . [lindex $repo_config(gui.geometry) 0]
3904 }
3905
3906 # -- Load window state
3907 #
3908 if {[info exists repo_config(gui.wmstate)]} {
3909         catch {wm state . $repo_config(gui.wmstate)}
3910 }
3911
3912 # -- Key Bindings
3913 #
3914 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3915 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3916 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3917 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3918 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3919 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3920 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3921 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3922 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3923 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3924 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3925 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3926 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3927 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3928 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3929 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3930 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3931 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3932 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3933 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3934 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3935 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3936 bind $ui_comm <$M1B-Key-BackSpace> {event generate %W <Meta-Delete>;break}
3937 bind $ui_comm <$M1B-Key-Delete> {event generate %W <Meta-d>;break}
3938
3939 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3940 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3941 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3942 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3943 bind $ui_diff <$M1B-Key-v> {break}
3944 bind $ui_diff <$M1B-Key-V> {break}
3945 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3946 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3947 bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
3948 bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
3949 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3950 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3951 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3952 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3953 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
3954 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
3955 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
3956 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
3957 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3958 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
3959 bind $ui_diff <Button-1>   {focus %W}
3960
3961 if {[is_enabled branch]} {
3962         bind . <$M1B-Key-n> branch_create::dialog
3963         bind . <$M1B-Key-N> branch_create::dialog
3964         bind . <$M1B-Key-o> branch_checkout::dialog
3965         bind . <$M1B-Key-O> branch_checkout::dialog
3966         bind . <$M1B-Key-m> merge::dialog
3967         bind . <$M1B-Key-M> merge::dialog
3968 }
3969 if {[is_enabled transport]} {
3970         bind . <$M1B-Key-p> do_push_anywhere
3971         bind . <$M1B-Key-P> do_push_anywhere
3972 }
3973
3974 bind .   <Key-F5>     ui_do_rescan
3975 bind .   <$M1B-Key-r> ui_do_rescan
3976 bind .   <$M1B-Key-R> ui_do_rescan
3977 bind .   <$M1B-Key-s> do_signoff
3978 bind .   <$M1B-Key-S> do_signoff
3979 bind .   <$M1B-Key-t> { toggle_or_diff toggle %W }
3980 bind .   <$M1B-Key-T> { toggle_or_diff toggle %W }
3981 bind .   <$M1B-Key-u> { toggle_or_diff toggle %W }
3982 bind .   <$M1B-Key-U> { toggle_or_diff toggle %W }
3983 bind .   <$M1B-Key-j> do_revert_selection
3984 bind .   <$M1B-Key-J> do_revert_selection
3985 bind .   <$M1B-Key-i> do_add_all
3986 bind .   <$M1B-Key-I> do_add_all
3987 bind .   <$M1B-Key-e> toggle_commit_type
3988 bind .   <$M1B-Key-E> toggle_commit_type
3989 bind .   <$M1B-Key-minus> {show_less_context;break}
3990 bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
3991 bind .   <$M1B-Key-equal> {show_more_context;break}
3992 bind .   <$M1B-Key-plus> {show_more_context;break}
3993 bind .   <$M1B-Key-KP_Add> {show_more_context;break}
3994 bind .   <$M1B-Key-Return> do_commit
3995 bind .   <$M1B-Key-KP_Enter> do_commit
3996 foreach i [list $ui_index $ui_workdir] {
3997         bind $i <Button-1>       { toggle_or_diff click %W %x %y; break }
3998         bind $i <$M1B-Button-1>  { add_one_to_selection %W %x %y; break }
3999         bind $i <Shift-Button-1> { add_range_to_selection %W %x %y; break }
4000         bind $i <Key-Up>         { toggle_or_diff up %W; break }
4001         bind $i <Key-Down>       { toggle_or_diff down %W; break }
4002 }
4003 unset i
4004
4005 bind .   <Alt-Key-1> {focus_widget $::ui_workdir}
4006 bind .   <Alt-Key-2> {focus_widget $::ui_index}
4007 bind .   <Alt-Key-3> {focus $::ui_diff}
4008 bind .   <Alt-Key-4> {focus $::ui_comm}
4009
4010 set file_lists_last_clicked($ui_index) {}
4011 set file_lists_last_clicked($ui_workdir) {}
4012
4013 set file_lists($ui_index) [list]
4014 set file_lists($ui_workdir) [list]
4015
4016 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
4017 focus -force $ui_comm
4018
4019 # -- Warn the user about environmental problems.  Cygwin's Tcl
4020 #    does *not* pass its env array onto any processes it spawns.
4021 #    This means that git processes get none of our environment.
4022 #
4023 if {[is_Cygwin]} {
4024         set ignored_env 0
4025         set suggest_user {}
4026         set msg [mc "Possible environment issues exist.
4027
4028 The following environment variables are probably
4029 going to be ignored by any Git subprocess run
4030 by %s:
4031
4032 " [appname]]
4033         foreach name [array names env] {
4034                 switch -regexp -- $name {
4035                 {^GIT_INDEX_FILE$} -
4036                 {^GIT_OBJECT_DIRECTORY$} -
4037                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4038                 {^GIT_DIFF_OPTS$} -
4039                 {^GIT_EXTERNAL_DIFF$} -
4040                 {^GIT_PAGER$} -
4041                 {^GIT_TRACE$} -
4042                 {^GIT_CONFIG$} -
4043                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4044                         append msg " - $name\n"
4045                         incr ignored_env
4046                 }
4047                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4048                         append msg " - $name\n"
4049                         incr ignored_env
4050                         set suggest_user $name
4051                 }
4052                 }
4053         }
4054         if {$ignored_env > 0} {
4055                 append msg [mc "
4056 This is due to a known issue with the
4057 Tcl binary distributed by Cygwin."]
4058
4059                 if {$suggest_user ne {}} {
4060                         append msg [mc "
4061
4062 A good replacement for %s
4063 is placing values for the user.name and
4064 user.email settings into your personal
4065 ~/.gitconfig file.
4066 " $suggest_user]
4067                 }
4068                 warn_popup $msg
4069         }
4070         unset ignored_env msg suggest_user name
4071 }
4072
4073 # -- Only initialize complex UI if we are going to stay running.
4074 #
4075 if {[is_enabled transport]} {
4076         load_all_remotes
4077
4078         set n [.mbar.remote index end]
4079         populate_remotes_menu
4080         set n [expr {[.mbar.remote index end] - $n}]
4081         if {$n > 0} {
4082                 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
4083                 .mbar.remote insert $n separator
4084         }
4085         unset n
4086 }
4087
4088 if {[winfo exists $ui_comm]} {
4089         set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
4090
4091         # -- If both our backup and message files exist use the
4092         #    newer of the two files to initialize the buffer.
4093         #
4094         if {$GITGUI_BCK_exists} {
4095                 set m [gitdir GITGUI_MSG]
4096                 if {[file isfile $m]} {
4097                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
4098                                 catch {file delete [gitdir GITGUI_MSG]}
4099                         } else {
4100                                 $ui_comm delete 0.0 end
4101                                 $ui_comm edit reset
4102                                 $ui_comm edit modified false
4103                                 catch {file delete [gitdir GITGUI_BCK]}
4104                                 set GITGUI_BCK_exists 0
4105                         }
4106                 }
4107                 unset m
4108         }
4109
4110         proc backup_commit_buffer {} {
4111                 global ui_comm GITGUI_BCK_exists
4112
4113                 set m [$ui_comm edit modified]
4114                 if {$m || $GITGUI_BCK_exists} {
4115                         set msg [string trim [$ui_comm get 0.0 end]]
4116                         regsub -all -line {[ \r\t]+$} $msg {} msg
4117
4118                         if {$msg eq {}} {
4119                                 if {$GITGUI_BCK_exists} {
4120                                         catch {file delete [gitdir GITGUI_BCK]}
4121                                         set GITGUI_BCK_exists 0
4122                                 }
4123                         } elseif {$m} {
4124                                 catch {
4125                                         set fd [open [gitdir GITGUI_BCK] w]
4126                                         fconfigure $fd -encoding utf-8
4127                                         puts -nonewline $fd $msg
4128                                         close $fd
4129                                         set GITGUI_BCK_exists 1
4130                                 }
4131                         }
4132
4133                         $ui_comm edit modified false
4134                 }
4135
4136                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
4137         }
4138
4139         backup_commit_buffer
4140
4141         # -- If the user has aspell available we can drive it
4142         #    in pipe mode to spellcheck the commit message.
4143         #
4144         set spell_cmd [list |]
4145         set spell_dict [get_config gui.spellingdictionary]
4146         lappend spell_cmd aspell
4147         if {$spell_dict ne {}} {
4148                 lappend spell_cmd --master=$spell_dict
4149         }
4150         lappend spell_cmd --mode=none
4151         lappend spell_cmd --encoding=utf-8
4152         lappend spell_cmd pipe
4153         if {$spell_dict eq {none}
4154          || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
4155                 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
4156         } else {
4157                 set ui_comm_spell [spellcheck::init \
4158                         $spell_fd \
4159                         $ui_comm \
4160                         $ui_comm_ctxm \
4161                 ]
4162         }
4163         unset -nocomplain spell_cmd spell_fd spell_err spell_dict
4164 }
4165
4166 lock_index begin-read
4167 if {![winfo ismapped .]} {
4168         wm deiconify .
4169 }
4170 after 1 {
4171         if {[is_enabled initialamend]} {
4172                 force_amend
4173         } else {
4174                 do_rescan
4175         }
4176
4177         if {[is_enabled nocommitmsg]} {
4178                 $ui_comm configure -state disabled -background gray
4179         }
4180 }
4181 if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
4182         after 1000 hint_gc
4183 }
4184 if {[is_enabled retcode]} {
4185         bind . <Destroy> {+terminate_me %W}
4186 }
4187 if {$picked && [is_config_true gui.autoexplore]} {
4188         do_explore
4189 }
4190
4191 # Clear "Initializing..." status
4192 after 500 {$main_status show ""}
4193
4194 # Local variables:
4195 # mode: tcl
4196 # indent-tabs-mode: t
4197 # tab-width: 4
4198 # End: