Pileus Git - ~andy/git/blob - git-gui.sh

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