git.oblomov.eu Git - git/blob - git-gui.sh

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