git-gui.sh

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