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