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