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