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