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  exec wish "$0" -- "$@"
  10
  11 set appvers {@@GITGUI_VERSION@@}
  12 set copyright {
  13 Copyright © 2006, 2007 Shawn Pearce, et. al.
  14
  15 This program is free software; you can redistribute it and/or modify
  16 it under the terms of the GNU General Public License as published by
  17 the Free Software Foundation; either version 2 of the License, or
  18 (at your option) any later version.
  19
  20 This program is distributed in the hope that it will be useful,
  21 but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 GNU General Public License for more details.
  24
  25 You should have received a copy of the GNU General Public License
  26 along with this program; if not, write to the Free Software
  27 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  28
  29 ######################################################################
  30 ##
  31 ## Tcl/Tk sanity check
  32
  33 if {[catch {package require Tcl 8.4} err]
  34  || [catch {package require Tk  8.4} err]
  35 } {
  36         catch {wm withdraw .}
  37         tk_messageBox \
  38                 -icon error \
  39                 -type ok \
  40                 -title [mc "git-gui: fatal error"] \
  41                 -message $err
  42         exit 1
  43 }
  44
  45 catch {rename send {}} ; # What an evil concept...
  46
  47 ######################################################################
  48 ##
  49 ## locate our library
  50
  51 set oguilib {@@GITGUI_LIBDIR@@}
  52 set oguirel {@@GITGUI_RELATIVE@@}
  53 if {$oguirel eq {1}} {
  54         set oguilib [file dirname [file dirname [file normalize $argv0]]]
  55         set oguilib [file join $oguilib share git-gui lib]
  56         set oguimsg [file join $oguilib msgs]
  57 } elseif {[string match @@* $oguirel]} {
  58         set oguilib [file join [file dirname [file normalize $argv0]] lib]
  59         set oguimsg [file join [file dirname [file normalize $argv0]] po]
  60 } else {
  61         set oguimsg [file join $oguilib msgs]
  62 }
  63 unset oguirel
  64
  65 ######################################################################
  66 ##
  67 ## enable verbose loading?
  68
  69 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
  70         unset _verbose
  71         rename auto_load real__auto_load
  72         proc auto_load {name args} {
  73                 puts stderr "auto_load $name"
  74                 return [uplevel 1 real__auto_load $name $args]
  75         }
  76         rename source real__source
  77         proc source {name} {
  78                 puts stderr "source    $name"
  79                 uplevel 1 real__source $name
  80         }
  81 }
  82
  83 ######################################################################
  84 ##
  85 ## Internationalization (i18n) through msgcat and gettext. See
  86 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
  87
  88 package require msgcat
  89
  90 proc mc {fmt args} {
  91         set fmt [::msgcat::mc $fmt]
  92         set cmk [string first @@ $fmt]
  93         if {$cmk > 0} {
  94                 set fmt [string range $fmt 0 [expr {$cmk - 1}]]
  95         }
  96         return [eval [list format $fmt] $args]
  97 }
  98
  99 proc strcat {args} {
 100         return [join $args {}]
 101 }
 102
 103 ::msgcat::mcload $oguimsg
 104 unset oguimsg
 105
 106 ######################################################################
 107 ##
 108 ## read only globals
 109
 110 set _appname [lindex [file split $argv0] end]
 111 set _gitdir {}
 112 set _gitexec {}
 113 set _reponame {}
 114 set _iscygwin {}
 115 set _search_path {}
 116
 117 proc appname {} {
 118         global _appname
 119         return $_appname
 120 }
 121
 122 proc gitdir {args} {
 123         global _gitdir
 124         if {$args eq {}} {
 125                 return $_gitdir
 126         }
 127         return [eval [list file join $_gitdir] $args]
 128 }
 129
 130 proc gitexec {args} {
 131         global _gitexec
 132         if {$_gitexec eq {}} {
 133                 if {[catch {set _gitexec [git --exec-path]} err]} {
 134                         error "Git not installed?\n\n$err"
 135                 }
 136                 if {[is_Cygwin]} {
 137                         set _gitexec [exec cygpath \
 138                                 --windows \
 139                                 --absolute \
 140                                 $_gitexec]
 141                 } else {
 142                         set _gitexec [file normalize $_gitexec]
 143                 }
 144         }
 145         if {$args eq {}} {
 146                 return $_gitexec
 147         }
 148         return [eval [list file join $_gitexec] $args]
 149 }
 150
 151 proc reponame {} {
 152         return $::_reponame
 153 }
 154
 155 proc is_MacOSX {} {
 156         if {[tk windowingsystem] eq {aqua}} {
 157                 return 1
 158         }
 159         return 0
 160 }
 161
 162 proc is_Windows {} {
 163         if {$::tcl_platform(platform) eq {windows}} {
 164                 return 1
 165         }
 166         return 0
 167 }
 168
 169 proc is_Cygwin {} {
 170         global _iscygwin
 171         if {$_iscygwin eq {}} {
 172                 if {$::tcl_platform(platform) eq {windows}} {
 173                         if {[catch {set p [exec cygpath --windir]} err]} {
 174                                 set _iscygwin 0
 175                         } else {
 176                                 set _iscygwin 1
 177                         }
 178                 } else {
 179                         set _iscygwin 0
 180                 }
 181         }
 182         return $_iscygwin
 183 }
 184
 185 proc is_enabled {option} {
 186         global enabled_options
 187         if {[catch {set on $enabled_options($option)}]} {return 0}
 188         return $on
 189 }
 190
 191 proc enable_option {option} {
 192         global enabled_options
 193         set enabled_options($option) 1
 194 }
 195
 196 proc disable_option {option} {
 197         global enabled_options
 198         set enabled_options($option) 0
 199 }
 200
 201 ######################################################################
 202 ##
 203 ## config
 204
 205 proc is_many_config {name} {
 206         switch -glob -- $name {
 207         remote.*.fetch -
 208         remote.*.push
 209                 {return 1}
 210         *
 211                 {return 0}
 212         }
 213 }
 214
 215 proc is_config_true {name} {
 216         global repo_config
 217         if {[catch {set v $repo_config($name)}]} {
 218                 return 0
 219         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 220                 return 1
 221         } else {
 222                 return 0
 223         }
 224 }
 225
 226 proc get_config {name} {
 227         global repo_config
 228         if {[catch {set v $repo_config($name)}]} {
 229                 return {}
 230         } else {
 231                 return $v
 232         }
 233 }
 234
 235 proc load_config {include_global} {
 236         global repo_config global_config default_config
 237
 238         array unset global_config
 239         if {$include_global} {
 240                 catch {
 241                         set fd_rc [git_read config --global --list]
 242                         while {[gets $fd_rc line] >= 0} {
 243                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 244                                         if {[is_many_config $name]} {
 245                                                 lappend global_config($name) $value
 246                                         } else {
 247                                                 set global_config($name) $value
 248                                         }
 249                                 }
 250                         }
 251                         close $fd_rc
 252                 }
 253         }
 254
 255         array unset repo_config
 256         catch {
 257                 set fd_rc [git_read config --list]
 258                 while {[gets $fd_rc line] >= 0} {
 259                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 260                                 if {[is_many_config $name]} {
 261                                         lappend repo_config($name) $value
 262                                 } else {
 263                                         set repo_config($name) $value
 264                                 }
 265                         }
 266                 }
 267                 close $fd_rc
 268         }
 269
 270         foreach name [array names default_config] {
 271                 if {[catch {set v $global_config($name)}]} {
 272                         set global_config($name) $default_config($name)
 273                 }
 274                 if {[catch {set v $repo_config($name)}]} {
 275                         set repo_config($name) $default_config($name)
 276                 }
 277         }
 278 }
 279
 280 ######################################################################
 281 ##
 282 ## handy utils
 283
 284 proc _git_cmd {name} {
 285         global _git_cmd_path
 286
 287         if {[catch {set v $_git_cmd_path($name)}]} {
 288                 switch -- $name {
 289                   version   -
 290                 --version   -
 291                 --exec-path { return [list $::_git $name] }
 292                 }
 293
 294                 set p [gitexec git-$name$::_search_exe]
 295                 if {[file exists $p]} {
 296                         set v [list $p]
 297                 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 298                         # Try to determine what sort of magic will make
 299                         # git-$name go and do its thing, because native
 300                         # Tcl on Windows doesn't know it.
 301                         #
 302                         set p [gitexec git-$name]
 303                         set f [open $p r]
 304                         set s [gets $f]
 305                         close $f
 306
 307                         switch -glob -- [lindex $s 0] {
 308                         #!*sh     { set i sh     }
 309                         #!*perl   { set i perl   }
 310                         #!*python { set i python }
 311                         default   { error "git-$name is not supported: $s" }
 312                         }
 313
 314                         upvar #0 _$i interp
 315                         if {![info exists interp]} {
 316                                 set interp [_which $i]
 317                         }
 318                         if {$interp eq {}} {
 319                                 error "git-$name requires $i (not in PATH)"
 320                         }
 321                         set v [concat [list $interp] [lrange $s 1 end] [list $p]]
 322                 } else {
 323                         # Assume it is builtin to git somehow and we
 324                         # aren't actually able to see a file for it.
 325                         #
 326                         set v [list $::_git $name]
 327                 }
 328                 set _git_cmd_path($name) $v
 329         }
 330         return $v
 331 }
 332
 333 proc _which {what} {
 334         global env _search_exe _search_path
 335
 336         if {$_search_path eq {}} {
 337                 if {[is_Cygwin]} {
 338                         set _search_path [split [exec cygpath \
 339                                 --windows \
 340                                 --path \
 341                                 --absolute \
 342                                 $env(PATH)] {;}]
 343                         set _search_exe .exe
 344                 } elseif {[is_Windows]} {
 345                         set _search_path [split $env(PATH) {;}]
 346                         set _search_exe .exe
 347                 } else {
 348                         set _search_path [split $env(PATH) :]
 349                         set _search_exe {}
 350                 }
 351         }
 352
 353         foreach p $_search_path {
 354                 set p [file join $p $what$_search_exe]
 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 exec]
 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         return [eval $opt $cmdp $args]
 396 }
 397
 398 proc _open_stdout_stderr {cmd} {
 399         if {[catch {
 400                         set fd [open $cmd r]
 401                 } err]} {
 402                 if {   [lindex $cmd end] eq {2>@1}
 403                     && $err eq {can not find channel named "1"}
 404                         } {
 405                         # Older versions of Tcl 8.4 don't have this 2>@1 IO
 406                         # redirect operator.  Fallback to |& cat for those.
 407                         # The command was not actually started, so its safe
 408                         # to try to start it a second time.
 409                         #
 410                         set fd [open [concat \
 411                                 [lrange $cmd 0 end-1] \
 412                                 [list |& cat] \
 413                                 ] r]
 414                 } else {
 415                         error $err
 416                 }
 417         }
 418         fconfigure $fd -eofchar {}
 419         return $fd
 420 }
 421
 422 proc git_read {args} {
 423         set opt [list |]
 424
 425         while {1} {
 426                 switch -- [lindex $args 0] {
 427                 --nice {
 428                         _lappend_nice opt
 429                 }
 430
 431                 --stderr {
 432                         lappend args 2>@1
 433                 }
 434
 435                 default {
 436                         break
 437                 }
 438
 439                 }
 440
 441                 set args [lrange $args 1 end]
 442         }
 443
 444         set cmdp [_git_cmd [lindex $args 0]]
 445         set args [lrange $args 1 end]
 446
 447         return [_open_stdout_stderr [concat $opt $cmdp $args]]
 448 }
 449
 450 proc git_write {args} {
 451         set opt [list |]
 452
 453         while {1} {
 454                 switch -- [lindex $args 0] {
 455                 --nice {
 456                         _lappend_nice opt
 457                 }
 458
 459                 default {
 460                         break
 461                 }
 462
 463                 }
 464
 465                 set args [lrange $args 1 end]
 466         }
 467
 468         set cmdp [_git_cmd [lindex $args 0]]
 469         set args [lrange $args 1 end]
 470
 471         return [open [concat $opt $cmdp $args] w]
 472 }
 473
 474 proc sq {value} {
 475         regsub -all ' $value "'\\''" value
 476         return "'$value'"
 477 }
 478
 479 proc load_current_branch {} {
 480         global current_branch is_detached
 481
 482         set fd [open [gitdir HEAD] r]
 483         if {[gets $fd ref] < 1} {
 484                 set ref {}
 485         }
 486         close $fd
 487
 488         set pfx {ref: refs/heads/}
 489         set len [string length $pfx]
 490         if {[string equal -length $len $pfx $ref]} {
 491                 # We're on a branch.  It might not exist.  But
 492                 # HEAD looks good enough to be a branch.
 493                 #
 494                 set current_branch [string range $ref $len end]
 495                 set is_detached 0
 496         } else {
 497                 # Assume this is a detached head.
 498                 #
 499                 set current_branch HEAD
 500                 set is_detached 1
 501         }
 502 }
 503
 504 auto_load tk_optionMenu
 505 rename tk_optionMenu real__tkOptionMenu
 506 proc tk_optionMenu {w varName args} {
 507         set m [eval real__tkOptionMenu $w $varName $args]
 508         $m configure -font font_ui
 509         $w configure -font font_ui
 510         return $m
 511 }
 512
 513 ######################################################################
 514 ##
 515 ## find git
 516
 517 set _git  [_which git]
 518 if {$_git eq {}} {
 519         catch {wm withdraw .}
 520         error_popup [mc "Cannot find git in PATH."]
 521         exit 1
 522 }
 523
 524 ######################################################################
 525 ##
 526 ## version check
 527
 528 if {[catch {set _git_version [git --version]} err]} {
 529         catch {wm withdraw .}
 530         tk_messageBox \
 531                 -icon error \
 532                 -type ok \
 533                 -title [mc "git-gui: fatal error"] \
 534                 -message "Cannot determine Git version:
 535
 536 $err
 537
 538 [appname] requires Git 1.5.0 or later."
 539         exit 1
 540 }
 541 if {![regsub {^git version } $_git_version {} _git_version]} {
 542         catch {wm withdraw .}
 543         tk_messageBox \
 544                 -icon error \
 545                 -type ok \
 546                 -title [mc "git-gui: fatal error"] \
 547                 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
 548         exit 1
 549 }
 550
 551 set _real_git_version $_git_version
 552 regsub -- {-dirty$} $_git_version {} _git_version
 553 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
 554 regsub {\.rc[0-9]+$} $_git_version {} _git_version
 555 regsub {\.GIT$} $_git_version {} _git_version
 556
 557 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
 558         catch {wm withdraw .}
 559         if {[tk_messageBox \
 560                 -icon warning \
 561                 -type yesno \
 562                 -default no \
 563                 -title "[appname]: warning" \
 564                  -message [mc "Git version cannot be determined.
 565
 566 %s claims it is version '%s'.
 567
 568 %s requires at least Git 1.5.0 or later.
 569
 570 Assume '%s' is version 1.5.0?
 571 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
 572                 set _git_version 1.5.0
 573         } else {
 574                 exit 1
 575         }
 576 }
 577 unset _real_git_version
 578
 579 proc git-version {args} {
 580         global _git_version
 581
 582         switch [llength $args] {
 583         0 {
 584                 return $_git_version
 585         }
 586
 587         2 {
 588                 set op [lindex $args 0]
 589                 set vr [lindex $args 1]
 590                 set cm [package vcompare $_git_version $vr]
 591                 return [expr $cm $op 0]
 592         }
 593
 594         4 {
 595                 set type [lindex $args 0]
 596                 set name [lindex $args 1]
 597                 set parm [lindex $args 2]
 598                 set body [lindex $args 3]
 599
 600                 if {($type ne {proc} && $type ne {method})} {
 601                         error "Invalid arguments to git-version"
 602                 }
 603                 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
 604                         error "Last arm of $type $name must be default"
 605                 }
 606
 607                 foreach {op vr cb} [lrange $body 0 end-2] {
 608                         if {[git-version $op $vr]} {
 609                                 return [uplevel [list $type $name $parm $cb]]
 610                         }
 611                 }
 612
 613                 return [uplevel [list $type $name $parm [lindex $body end]]]
 614         }
 615
 616         default {
 617                 error "git-version >= x"
 618         }
 619
 620         }
 621 }
 622
 623 if {[git-version < 1.5]} {
 624         catch {wm withdraw .}
 625         tk_messageBox \
 626                 -icon error \
 627                 -type ok \
 628                 -title [mc "git-gui: fatal error"] \
 629                 -message "[appname] requires Git 1.5.0 or later.
 630
 631 You are using [git-version]:
 632
 633 [git --version]"
 634         exit 1
 635 }
 636
 637 ######################################################################
 638 ##
 639 ## configure our library
 640
 641 set idx [file join $oguilib tclIndex]
 642 if {[catch {set fd [open $idx r]} err]} {
 643         catch {wm withdraw .}
 644         tk_messageBox \
 645                 -icon error \
 646                 -type ok \
 647                 -title [mc "git-gui: fatal error"] \
 648                 -message $err
 649         exit 1
 650 }
 651 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
 652         set idx [list]
 653         while {[gets $fd n] >= 0} {
 654                 if {$n ne {} && ![string match #* $n]} {
 655                         lappend idx $n
 656                 }
 657         }
 658 } else {
 659         set idx {}
 660 }
 661 close $fd
 662
 663 if {$idx ne {}} {
 664         set loaded [list]
 665         foreach p $idx {
 666                 if {[lsearch -exact $loaded $p] >= 0} continue
 667                 source [file join $oguilib $p]
 668                 lappend loaded $p
 669         }
 670         unset loaded p
 671 } else {
 672         set auto_path [concat [list $oguilib] $auto_path]
 673 }
 674 unset -nocomplain idx fd
 675
 676 ######################################################################
 677 ##
 678 ## feature option selection
 679
 680 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
 681         unset _junk
 682 } else {
 683         set subcommand gui
 684 }
 685 if {$subcommand eq {gui.sh}} {
 686         set subcommand gui
 687 }
 688 if {$subcommand eq {gui} && [llength $argv] > 0} {
 689         set subcommand [lindex $argv 0]
 690         set argv [lrange $argv 1 end]
 691 }
 692
 693 enable_option multicommit
 694 enable_option branch
 695 enable_option transport
 696 disable_option bare
 697
 698 switch -- $subcommand {
 699 browser -
 700 blame {
 701         enable_option bare
 702
 703         disable_option multicommit
 704         disable_option branch
 705         disable_option transport
 706 }
 707 citool {
 708         enable_option singlecommit
 709
 710         disable_option multicommit
 711         disable_option branch
 712         disable_option transport
 713 }
 714 }
 715
 716 ######################################################################
 717 ##
 718 ## repository setup
 719
 720 if {[catch {
 721                 set _gitdir $env(GIT_DIR)
 722                 set _prefix {}
 723                 }]
 724         && [catch {
 725                 set _gitdir [git rev-parse --git-dir]
 726                 set _prefix [git rev-parse --show-prefix]
 727         } err]} {
 728         catch {wm withdraw .}
 729         error_popup [strcat [mc "Cannot find the git directory:"] "\n\n$err"]
 730         exit 1
 731 }
 732 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 733         catch {set _gitdir [exec cygpath --unix $_gitdir]}
 734 }
 735 if {![file isdirectory $_gitdir]} {
 736         catch {wm withdraw .}
 737         error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
 738         exit 1
 739 }
 740 if {$_prefix ne {}} {
 741         regsub -all {[^/]+/} $_prefix ../ cdup
 742         if {[catch {cd $cdup} err]} {
 743                 catch {wm withdraw .}
 744                 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
 745                 exit 1
 746         }
 747         unset cdup
 748 } elseif {![is_enabled bare]} {
 749         if {[lindex [file split $_gitdir] end] ne {.git}} {
 750                 catch {wm withdraw .}
 751                 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
 752                 exit 1
 753         }
 754         if {[catch {cd [file dirname $_gitdir]} err]} {
 755                 catch {wm withdraw .}
 756                 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
 757                 exit 1
 758         }
 759 }
 760 set _reponame [file split [file normalize $_gitdir]]
 761 if {[lindex $_reponame end] eq {.git}} {
 762         set _reponame [lindex $_reponame end-1]
 763 } else {
 764         set _reponame [lindex $_reponame end]
 765 }
 766
 767 ######################################################################
 768 ##
 769 ## global init
 770
 771 set current_diff_path {}
 772 set current_diff_side {}
 773 set diff_actions [list]
 774
 775 set HEAD {}
 776 set PARENT {}
 777 set MERGE_HEAD [list]
 778 set commit_type {}
 779 set empty_tree {}
 780 set current_branch {}
 781 set is_detached 0
 782 set current_diff_path {}
 783 set is_3way_diff 0
 784 set selected_commit_type new
 785
 786 ######################################################################
 787 ##
 788 ## task management
 789
 790 set rescan_active 0
 791 set diff_active 0
 792 set last_clicked {}
 793
 794 set disable_on_lock [list]
 795 set index_lock_type none
 796
 797 proc lock_index {type} {
 798         global index_lock_type disable_on_lock
 799
 800         if {$index_lock_type eq {none}} {
 801                 set index_lock_type $type
 802                 foreach w $disable_on_lock {
 803                         uplevel #0 $w disabled
 804                 }
 805                 return 1
 806         } elseif {$index_lock_type eq "begin-$type"} {
 807                 set index_lock_type $type
 808                 return 1
 809         }
 810         return 0
 811 }
 812
 813 proc unlock_index {} {
 814         global index_lock_type disable_on_lock
 815
 816         set index_lock_type none
 817         foreach w $disable_on_lock {
 818                 uplevel #0 $w normal
 819         }
 820 }
 821
 822 ######################################################################
 823 ##
 824 ## status
 825
 826 proc repository_state {ctvar hdvar mhvar} {
 827         global current_branch
 828         upvar $ctvar ct $hdvar hd $mhvar mh
 829
 830         set mh [list]
 831
 832         load_current_branch
 833         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
 834                 set hd {}
 835                 set ct initial
 836                 return
 837         }
 838
 839         set merge_head [gitdir MERGE_HEAD]
 840         if {[file exists $merge_head]} {
 841                 set ct merge
 842                 set fd_mh [open $merge_head r]
 843                 while {[gets $fd_mh line] >= 0} {
 844                         lappend mh $line
 845                 }
 846                 close $fd_mh
 847                 return
 848         }
 849
 850         set ct normal
 851 }
 852
 853 proc PARENT {} {
 854         global PARENT empty_tree
 855
 856         set p [lindex $PARENT 0]
 857         if {$p ne {}} {
 858                 return $p
 859         }
 860         if {$empty_tree eq {}} {
 861                 set empty_tree [git mktree << {}]
 862         }
 863         return $empty_tree
 864 }
 865
 866 proc rescan {after {honor_trustmtime 1}} {
 867         global HEAD PARENT MERGE_HEAD commit_type
 868         global ui_index ui_workdir ui_comm
 869         global rescan_active file_states
 870         global repo_config
 871
 872         if {$rescan_active > 0 || ![lock_index read]} return
 873
 874         repository_state newType newHEAD newMERGE_HEAD
 875         if {[string match amend* $commit_type]
 876                 && $newType eq {normal}
 877                 && $newHEAD eq $HEAD} {
 878         } else {
 879                 set HEAD $newHEAD
 880                 set PARENT $newHEAD
 881                 set MERGE_HEAD $newMERGE_HEAD
 882                 set commit_type $newType
 883         }
 884
 885         array unset file_states
 886
 887         if {!$::GITGUI_BCK_exists &&
 888                 (![$ui_comm edit modified]
 889                 || [string trim [$ui_comm get 0.0 end]] eq {})} {
 890                 if {[string match amend* $commit_type]} {
 891                 } elseif {[load_message GITGUI_MSG]} {
 892                 } elseif {[load_message MERGE_MSG]} {
 893                 } elseif {[load_message SQUASH_MSG]} {
 894                 }
 895                 $ui_comm edit reset
 896                 $ui_comm edit modified false
 897         }
 898
 899         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 900                 rescan_stage2 {} $after
 901         } else {
 902                 set rescan_active 1
 903                 ui_status [mc "Refreshing file status..."]
 904                 set fd_rf [git_read update-index \
 905                         -q \
 906                         --unmerged \
 907                         --ignore-missing \
 908                         --refresh \
 909                         ]
 910                 fconfigure $fd_rf -blocking 0 -translation binary
 911                 fileevent $fd_rf readable \
 912                         [list rescan_stage2 $fd_rf $after]
 913         }
 914 }
 915
 916 proc rescan_stage2 {fd after} {
 917         global rescan_active buf_rdi buf_rdf buf_rlo
 918
 919         if {$fd ne {}} {
 920                 read $fd
 921                 if {![eof $fd]} return
 922                 close $fd
 923         }
 924
 925         set ls_others [list --exclude-per-directory=.gitignore]
 926         set info_exclude [gitdir info exclude]
 927         if {[file readable $info_exclude]} {
 928                 lappend ls_others "--exclude-from=$info_exclude"
 929         }
 930         set user_exclude [get_config core.excludesfile]
 931         if {$user_exclude ne {} && [file readable $user_exclude]} {
 932                 lappend ls_others "--exclude-from=$user_exclude"
 933         }
 934
 935         set buf_rdi {}
 936         set buf_rdf {}
 937         set buf_rlo {}
 938
 939         set rescan_active 3
 940         ui_status [mc "Scanning for modified files ..."]
 941         set fd_di [git_read diff-index --cached -z [PARENT]]
 942         set fd_df [git_read diff-files -z]
 943         set fd_lo [eval git_read ls-files --others -z $ls_others]
 944
 945         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 946         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 947         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 948         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 949         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 950         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 951 }
 952
 953 proc load_message {file} {
 954         global ui_comm
 955
 956         set f [gitdir $file]
 957         if {[file isfile $f]} {
 958                 if {[catch {set fd [open $f r]}]} {
 959                         return 0
 960                 }
 961                 fconfigure $fd -eofchar {}
 962                 set content [string trim [read $fd]]
 963                 close $fd
 964                 regsub -all -line {[ \r\t]+$} $content {} content
 965                 $ui_comm delete 0.0 end
 966                 $ui_comm insert end $content
 967                 return 1
 968         }
 969         return 0
 970 }
 971
 972 proc read_diff_index {fd after} {
 973         global buf_rdi
 974
 975         append buf_rdi [read $fd]
 976         set c 0
 977         set n [string length $buf_rdi]
 978         while {$c < $n} {
 979                 set z1 [string first "\0" $buf_rdi $c]
 980                 if {$z1 == -1} break
 981                 incr z1
 982                 set z2 [string first "\0" $buf_rdi $z1]
 983                 if {$z2 == -1} break
 984
 985                 incr c
 986                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 987                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 988                 merge_state \
 989                         [encoding convertfrom $p] \
 990                         [lindex $i 4]? \
 991                         [list [lindex $i 0] [lindex $i 2]] \
 992                         [list]
 993                 set c $z2
 994                 incr c
 995         }
 996         if {$c < $n} {
 997                 set buf_rdi [string range $buf_rdi $c end]
 998         } else {
 999                 set buf_rdi {}
1000         }
1001
1002         rescan_done $fd buf_rdi $after
1003 }
1004
1005 proc read_diff_files {fd after} {
1006         global buf_rdf
1007
1008         append buf_rdf [read $fd]
1009         set c 0
1010         set n [string length $buf_rdf]
1011         while {$c < $n} {
1012                 set z1 [string first "\0" $buf_rdf $c]
1013                 if {$z1 == -1} break
1014                 incr z1
1015                 set z2 [string first "\0" $buf_rdf $z1]
1016                 if {$z2 == -1} break
1017
1018                 incr c
1019                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1020                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1021                 merge_state \
1022                         [encoding convertfrom $p] \
1023                         ?[lindex $i 4] \
1024                         [list] \
1025                         [list [lindex $i 0] [lindex $i 2]]
1026                 set c $z2
1027                 incr c
1028         }
1029         if {$c < $n} {
1030                 set buf_rdf [string range $buf_rdf $c end]
1031         } else {
1032                 set buf_rdf {}
1033         }
1034
1035         rescan_done $fd buf_rdf $after
1036 }
1037
1038 proc read_ls_others {fd after} {
1039         global buf_rlo
1040
1041         append buf_rlo [read $fd]
1042         set pck [split $buf_rlo "\0"]
1043         set buf_rlo [lindex $pck end]
1044         foreach p [lrange $pck 0 end-1] {
1045                 set p [encoding convertfrom $p]
1046                 if {[string index $p end] eq {/}} {
1047                         set p [string range $p 0 end-1]
1048                 }
1049                 merge_state $p ?O
1050         }
1051         rescan_done $fd buf_rlo $after
1052 }
1053
1054 proc rescan_done {fd buf after} {
1055         global rescan_active current_diff_path
1056         global file_states repo_config
1057         upvar $buf to_clear
1058
1059         if {![eof $fd]} return
1060         set to_clear {}
1061         close $fd
1062         if {[incr rescan_active -1] > 0} return
1063
1064         prune_selection
1065         unlock_index
1066         display_all_files
1067         if {$current_diff_path ne {}} reshow_diff
1068         uplevel #0 $after
1069 }
1070
1071 proc prune_selection {} {
1072         global file_states selected_paths
1073
1074         foreach path [array names selected_paths] {
1075                 if {[catch {set still_here $file_states($path)}]} {
1076                         unset selected_paths($path)
1077                 }
1078         }
1079 }
1080
1081 ######################################################################
1082 ##
1083 ## ui helpers
1084
1085 proc mapicon {w state path} {
1086         global all_icons
1087
1088         if {[catch {set r $all_icons($state$w)}]} {
1089                 puts "error: no icon for $w state={$state} $path"
1090                 return file_plain
1091         }
1092         return $r
1093 }
1094
1095 proc mapdesc {state path} {
1096         global all_descs
1097
1098         if {[catch {set r $all_descs($state)}]} {
1099                 puts "error: no desc for state={$state} $path"
1100                 return $state
1101         }
1102         return $r
1103 }
1104
1105 proc ui_status {msg} {
1106         $::main_status show $msg
1107 }
1108
1109 proc ui_ready {{test {}}} {
1110         $::main_status show [mc "Ready."] $test
1111 }
1112
1113 proc escape_path {path} {
1114         regsub -all {\\} $path "\\\\" path
1115         regsub -all "\n" $path "\\n" path
1116         return $path
1117 }
1118
1119 proc short_path {path} {
1120         return [escape_path [lindex [file split $path] end]]
1121 }
1122
1123 set next_icon_id 0
1124 set null_sha1 [string repeat 0 40]
1125
1126 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1127         global file_states next_icon_id null_sha1
1128
1129         set s0 [string index $new_state 0]
1130         set s1 [string index $new_state 1]
1131
1132         if {[catch {set info $file_states($path)}]} {
1133                 set state __
1134                 set icon n[incr next_icon_id]
1135         } else {
1136                 set state [lindex $info 0]
1137                 set icon [lindex $info 1]
1138                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1139                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1140         }
1141
1142         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1143         elseif {$s0 eq {_}} {set s0 _}
1144
1145         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1146         elseif {$s1 eq {_}} {set s1 _}
1147
1148         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1149                 set head_info [list 0 $null_sha1]
1150         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1151                 && $head_info eq {}} {
1152                 set head_info $index_info
1153         }
1154
1155         set file_states($path) [list $s0$s1 $icon \
1156                 $head_info $index_info \
1157                 ]
1158         return $state
1159 }
1160
1161 proc display_file_helper {w path icon_name old_m new_m} {
1162         global file_lists
1163
1164         if {$new_m eq {_}} {
1165                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1166                 if {$lno >= 0} {
1167                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1168                         incr lno
1169                         $w conf -state normal
1170                         $w delete $lno.0 [expr {$lno + 1}].0
1171                         $w conf -state disabled
1172                 }
1173         } elseif {$old_m eq {_} && $new_m ne {_}} {
1174                 lappend file_lists($w) $path
1175                 set file_lists($w) [lsort -unique $file_lists($w)]
1176                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1177                 incr lno
1178                 $w conf -state normal
1179                 $w image create $lno.0 \
1180                         -align center -padx 5 -pady 1 \
1181                         -name $icon_name \
1182                         -image [mapicon $w $new_m $path]
1183                 $w insert $lno.1 "[escape_path $path]\n"
1184                 $w conf -state disabled
1185         } elseif {$old_m ne $new_m} {
1186                 $w conf -state normal
1187                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1188                 $w conf -state disabled
1189         }
1190 }
1191
1192 proc display_file {path state} {
1193         global file_states selected_paths
1194         global ui_index ui_workdir
1195
1196         set old_m [merge_state $path $state]
1197         set s $file_states($path)
1198         set new_m [lindex $s 0]
1199         set icon_name [lindex $s 1]
1200
1201         set o [string index $old_m 0]
1202         set n [string index $new_m 0]
1203         if {$o eq {U}} {
1204                 set o _
1205         }
1206         if {$n eq {U}} {
1207                 set n _
1208         }
1209         display_file_helper     $ui_index $path $icon_name $o $n
1210
1211         if {[string index $old_m 0] eq {U}} {
1212                 set o U
1213         } else {
1214                 set o [string index $old_m 1]
1215         }
1216         if {[string index $new_m 0] eq {U}} {
1217                 set n U
1218         } else {
1219                 set n [string index $new_m 1]
1220         }
1221         display_file_helper     $ui_workdir $path $icon_name $o $n
1222
1223         if {$new_m eq {__}} {
1224                 unset file_states($path)
1225                 catch {unset selected_paths($path)}
1226         }
1227 }
1228
1229 proc display_all_files_helper {w path icon_name m} {
1230         global file_lists
1231
1232         lappend file_lists($w) $path
1233         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1234         $w image create end \
1235                 -align center -padx 5 -pady 1 \
1236                 -name $icon_name \
1237                 -image [mapicon $w $m $path]
1238         $w insert end "[escape_path $path]\n"
1239 }
1240
1241 proc display_all_files {} {
1242         global ui_index ui_workdir
1243         global file_states file_lists
1244         global last_clicked
1245
1246         $ui_index conf -state normal
1247         $ui_workdir conf -state normal
1248
1249         $ui_index delete 0.0 end
1250         $ui_workdir delete 0.0 end
1251         set last_clicked {}
1252
1253         set file_lists($ui_index) [list]
1254         set file_lists($ui_workdir) [list]
1255
1256         foreach path [lsort [array names file_states]] {
1257                 set s $file_states($path)
1258                 set m [lindex $s 0]
1259                 set icon_name [lindex $s 1]
1260
1261                 set s [string index $m 0]
1262                 if {$s ne {U} && $s ne {_}} {
1263                         display_all_files_helper $ui_index $path \
1264                                 $icon_name $s
1265                 }
1266
1267                 if {[string index $m 0] eq {U}} {
1268                         set s U
1269                 } else {
1270                         set s [string index $m 1]
1271                 }
1272                 if {$s ne {_}} {
1273                         display_all_files_helper $ui_workdir $path \
1274                                 $icon_name $s
1275                 }
1276         }
1277
1278         $ui_index conf -state disabled
1279         $ui_workdir conf -state disabled
1280 }
1281
1282 ######################################################################
1283 ##
1284 ## icons
1285
1286 set filemask {
1287 #define mask_width 14
1288 #define mask_height 15
1289 static unsigned char mask_bits[] = {
1290    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1291    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1292    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1293 }
1294
1295 image create bitmap file_plain -background white -foreground black -data {
1296 #define plain_width 14
1297 #define plain_height 15
1298 static unsigned char plain_bits[] = {
1299    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1300    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1301    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1302 } -maskdata $filemask
1303
1304 image create bitmap file_mod -background white -foreground blue -data {
1305 #define mod_width 14
1306 #define mod_height 15
1307 static unsigned char mod_bits[] = {
1308    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1309    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1310    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1311 } -maskdata $filemask
1312
1313 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1314 #define file_fulltick_width 14
1315 #define file_fulltick_height 15
1316 static unsigned char file_fulltick_bits[] = {
1317    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1318    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1319    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1320 } -maskdata $filemask
1321
1322 image create bitmap file_parttick -background white -foreground "#005050" -data {
1323 #define parttick_width 14
1324 #define parttick_height 15
1325 static unsigned char parttick_bits[] = {
1326    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1327    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1328    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1329 } -maskdata $filemask
1330
1331 image create bitmap file_question -background white -foreground black -data {
1332 #define file_question_width 14
1333 #define file_question_height 15
1334 static unsigned char file_question_bits[] = {
1335    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1336    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1337    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1338 } -maskdata $filemask
1339
1340 image create bitmap file_removed -background white -foreground red -data {
1341 #define file_removed_width 14
1342 #define file_removed_height 15
1343 static unsigned char file_removed_bits[] = {
1344    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1345    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1346    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1347 } -maskdata $filemask
1348
1349 image create bitmap file_merge -background white -foreground blue -data {
1350 #define file_merge_width 14
1351 #define file_merge_height 15
1352 static unsigned char file_merge_bits[] = {
1353    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1354    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1355    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1356 } -maskdata $filemask
1357
1358 set ui_index .vpane.files.index.list
1359 set ui_workdir .vpane.files.workdir.list
1360
1361 set all_icons(_$ui_index)   file_plain
1362 set all_icons(A$ui_index)   file_fulltick
1363 set all_icons(M$ui_index)   file_fulltick
1364 set all_icons(D$ui_index)   file_removed
1365 set all_icons(U$ui_index)   file_merge
1366
1367 set all_icons(_$ui_workdir) file_plain
1368 set all_icons(M$ui_workdir) file_mod
1369 set all_icons(D$ui_workdir) file_question
1370 set all_icons(U$ui_workdir) file_merge
1371 set all_icons(O$ui_workdir) file_plain
1372
1373 set max_status_desc 0
1374 foreach i {
1375                 {__ {mc "Unmodified"}}
1376
1377                 {_M {mc "Modified, not staged"}}
1378                 {M_ {mc "Staged for commit"}}
1379                 {MM {mc "Portions staged for commit"}}
1380                 {MD {mc "Staged for commit, missing"}}
1381
1382                 {_O {mc "Untracked, not staged"}}
1383                 {A_ {mc "Staged for commit"}}
1384                 {AM {mc "Portions staged for commit"}}
1385                 {AD {mc "Staged for commit, missing"}}
1386
1387                 {_D {mc "Missing"}}
1388                 {D_ {mc "Staged for removal"}}
1389                 {DO {mc "Staged for removal, still present"}}
1390
1391                 {U_ {mc "Requires merge resolution"}}
1392                 {UU {mc "Requires merge resolution"}}
1393                 {UM {mc "Requires merge resolution"}}
1394                 {UD {mc "Requires merge resolution"}}
1395         } {
1396         set text [eval [lindex $i 1]]
1397         if {$max_status_desc < [string length $text]} {
1398                 set max_status_desc [string length $text]
1399         }
1400         set all_descs([lindex $i 0]) $text
1401 }
1402 unset i
1403
1404 ######################################################################
1405 ##
1406 ## util
1407
1408 proc bind_button3 {w cmd} {
1409         bind $w <Any-Button-3> $cmd
1410         if {[is_MacOSX]} {
1411                 # Mac OS X sends Button-2 on right click through three-button mouse,
1412                 # or through trackpad right-clicking (two-finger touch + click).
1413                 bind $w <Any-Button-2> $cmd
1414                 bind $w <Control-Button-1> $cmd
1415         }
1416 }
1417
1418 proc scrollbar2many {list mode args} {
1419         foreach w $list {eval $w $mode $args}
1420 }
1421
1422 proc many2scrollbar {list mode sb top bottom} {
1423         $sb set $top $bottom
1424         foreach w $list {$w $mode moveto $top}
1425 }
1426
1427 proc incr_font_size {font {amt 1}} {
1428         set sz [font configure $font -size]
1429         incr sz $amt
1430         font configure $font -size $sz
1431         font configure ${font}bold -size $sz
1432         font configure ${font}italic -size $sz
1433 }
1434
1435 ######################################################################
1436 ##
1437 ## ui commands
1438
1439 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1440
1441 proc do_gitk {revs} {
1442         # -- Always start gitk through whatever we were loaded with.  This
1443         #    lets us bypass using shell process on Windows systems.
1444         #
1445         set exe [file join [file dirname $::_git] gitk]
1446         set cmd [list [info nameofexecutable] $exe]
1447         if {! [file exists $exe]} {
1448                 error_popup [mc "Unable to start gitk:\n\n%s does not exist" $exe]
1449         } else {
1450                 eval exec $cmd $revs &
1451                 ui_status $::starting_gitk_msg
1452                 after 10000 {
1453                         ui_ready $starting_gitk_msg
1454                 }
1455         }
1456 }
1457
1458 set is_quitting 0
1459
1460 proc do_quit {} {
1461         global ui_comm is_quitting repo_config commit_type
1462         global GITGUI_BCK_exists GITGUI_BCK_i
1463
1464         if {$is_quitting} return
1465         set is_quitting 1
1466
1467         if {[winfo exists $ui_comm]} {
1468                 # -- Stash our current commit buffer.
1469                 #
1470                 set save [gitdir GITGUI_MSG]
1471                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1472                         file rename -force [gitdir GITGUI_BCK] $save
1473                         set GITGUI_BCK_exists 0
1474                 } else {
1475                         set msg [string trim [$ui_comm get 0.0 end]]
1476                         regsub -all -line {[ \r\t]+$} $msg {} msg
1477                         if {(![string match amend* $commit_type]
1478                                 || [$ui_comm edit modified])
1479                                 && $msg ne {}} {
1480                                 catch {
1481                                         set fd [open $save w]
1482                                         puts -nonewline $fd $msg
1483                                         close $fd
1484                                 }
1485                         } else {
1486                                 catch {file delete $save}
1487                         }
1488                 }
1489
1490                 # -- Remove our editor backup, its not needed.
1491                 #
1492                 after cancel $GITGUI_BCK_i
1493                 if {$GITGUI_BCK_exists} {
1494                         catch {file delete [gitdir GITGUI_BCK]}
1495                 }
1496
1497                 # -- Stash our current window geometry into this repository.
1498                 #
1499                 set cfg_geometry [list]
1500                 lappend cfg_geometry [wm geometry .]
1501                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1502                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1503                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1504                         set rc_geometry {}
1505                 }
1506                 if {$cfg_geometry ne $rc_geometry} {
1507                         catch {git config gui.geometry $cfg_geometry}
1508                 }
1509         }
1510
1511         destroy .
1512 }
1513
1514 proc do_rescan {} {
1515         rescan ui_ready
1516 }
1517
1518 proc do_commit {} {
1519         commit_tree
1520 }
1521
1522 proc toggle_or_diff {w x y} {
1523         global file_states file_lists current_diff_path ui_index ui_workdir
1524         global last_clicked selected_paths
1525
1526         set pos [split [$w index @$x,$y] .]
1527         set lno [lindex $pos 0]
1528         set col [lindex $pos 1]
1529         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1530         if {$path eq {}} {
1531                 set last_clicked {}
1532                 return
1533         }
1534
1535         set last_clicked [list $w $lno]
1536         array unset selected_paths
1537         $ui_index tag remove in_sel 0.0 end
1538         $ui_workdir tag remove in_sel 0.0 end
1539
1540         if {$col == 0} {
1541                 if {$current_diff_path eq $path} {
1542                         set after {reshow_diff;}
1543                 } else {
1544                         set after {}
1545                 }
1546                 if {$w eq $ui_index} {
1547                         update_indexinfo \
1548                                 "Unstaging [short_path $path] from commit" \
1549                                 [list $path] \
1550                                 [concat $after [list ui_ready]]
1551                 } elseif {$w eq $ui_workdir} {
1552                         update_index \
1553                                 "Adding [short_path $path]" \
1554                                 [list $path] \
1555                                 [concat $after [list ui_ready]]
1556                 }
1557         } else {
1558                 show_diff $path $w $lno
1559         }
1560 }
1561
1562 proc add_one_to_selection {w x y} {
1563         global file_lists last_clicked selected_paths
1564
1565         set lno [lindex [split [$w index @$x,$y] .] 0]
1566         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1567         if {$path eq {}} {
1568                 set last_clicked {}
1569                 return
1570         }
1571
1572         if {$last_clicked ne {}
1573                 && [lindex $last_clicked 0] ne $w} {
1574                 array unset selected_paths
1575                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1576         }
1577
1578         set last_clicked [list $w $lno]
1579         if {[catch {set in_sel $selected_paths($path)}]} {
1580                 set in_sel 0
1581         }
1582         if {$in_sel} {
1583                 unset selected_paths($path)
1584                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1585         } else {
1586                 set selected_paths($path) 1
1587                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1588         }
1589 }
1590
1591 proc add_range_to_selection {w x y} {
1592         global file_lists last_clicked selected_paths
1593
1594         if {[lindex $last_clicked 0] ne $w} {
1595                 toggle_or_diff $w $x $y
1596                 return
1597         }
1598
1599         set lno [lindex [split [$w index @$x,$y] .] 0]
1600         set lc [lindex $last_clicked 1]
1601         if {$lc < $lno} {
1602                 set begin $lc
1603                 set end $lno
1604         } else {
1605                 set begin $lno
1606                 set end $lc
1607         }
1608
1609         foreach path [lrange $file_lists($w) \
1610                 [expr {$begin - 1}] \
1611                 [expr {$end - 1}]] {
1612                 set selected_paths($path) 1
1613         }
1614         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1615 }
1616
1617 ######################################################################
1618 ##
1619 ## config defaults
1620
1621 set cursor_ptr arrow
1622 font create font_diff -family Courier -size 10
1623 font create font_ui
1624 catch {
1625         label .dummy
1626         eval font configure font_ui [font actual [.dummy cget -font]]
1627         destroy .dummy
1628 }
1629
1630 font create font_uiitalic
1631 font create font_uibold
1632 font create font_diffbold
1633 font create font_diffitalic
1634
1635 foreach class {Button Checkbutton Entry Label
1636                 Labelframe Listbox Menu Message
1637                 Radiobutton Spinbox Text} {
1638         option add *$class.font font_ui
1639 }
1640 unset class
1641
1642 if {[is_Windows] || [is_MacOSX]} {
1643         option add *Menu.tearOff 0
1644 }
1645
1646 if {[is_MacOSX]} {
1647         set M1B M1
1648         set M1T Cmd
1649 } else {
1650         set M1B Control
1651         set M1T Ctrl
1652 }
1653
1654 proc apply_config {} {
1655         global repo_config font_descs
1656
1657         foreach option $font_descs {
1658                 set name [lindex $option 0]
1659                 set font [lindex $option 1]
1660                 if {[catch {
1661                         foreach {cn cv} $repo_config(gui.$name) {
1662                                 font configure $font $cn $cv
1663                         }
1664                         } err]} {
1665                         error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
1666                 }
1667                 foreach {cn cv} [font configure $font] {
1668                         font configure ${font}bold $cn $cv
1669                         font configure ${font}italic $cn $cv
1670                 }
1671                 font configure ${font}bold -weight bold
1672                 font configure ${font}italic -slant italic
1673         }
1674 }
1675
1676 set default_config(merge.diffstat) true
1677 set default_config(merge.summary) false
1678 set default_config(merge.verbosity) 2
1679 set default_config(user.name) {}
1680 set default_config(user.email) {}
1681
1682 set default_config(gui.matchtrackingbranch) false
1683 set default_config(gui.pruneduringfetch) false
1684 set default_config(gui.trustmtime) false
1685 set default_config(gui.diffcontext) 5
1686 set default_config(gui.newbranchtemplate) {}
1687 set default_config(gui.fontui) [font configure font_ui]
1688 set default_config(gui.fontdiff) [font configure font_diff]
1689 set font_descs {
1690         {fontui   font_ui   {mc "Main Font"}}
1691         {fontdiff font_diff {mc "Diff/Console Font"}}
1692 }
1693 load_config 0
1694 apply_config
1695
1696 ######################################################################
1697 ##
1698 ## ui construction
1699
1700 set ui_comm {}
1701
1702 # -- Menu Bar
1703 #
1704 menu .mbar -tearoff 0
1705 .mbar add cascade -label [mc Repository] -menu .mbar.repository
1706 .mbar add cascade -label [mc Edit] -menu .mbar.edit
1707 if {[is_enabled branch]} {
1708         .mbar add cascade -label [mc Branch] -menu .mbar.branch
1709 }
1710 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1711         .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
1712 }
1713 if {[is_enabled transport]} {
1714         .mbar add cascade -label [mc Merge] -menu .mbar.merge
1715         .mbar add cascade -label [mc Fetch] -menu .mbar.fetch
1716         .mbar add cascade -label [mc Push] -menu .mbar.push
1717 }
1718 . configure -menu .mbar
1719
1720 # -- Repository Menu
1721 #
1722 menu .mbar.repository
1723
1724 .mbar.repository add command \
1725         -label [mc "Browse Current Branch's Files"] \
1726         -command {browser::new $current_branch}
1727 set ui_browse_current [.mbar.repository index last]
1728 .mbar.repository add command \
1729         -label [mc "Browse Branch Files..."] \
1730         -command browser_open::dialog
1731 .mbar.repository add separator
1732
1733 .mbar.repository add command \
1734         -label [mc "Visualize Current Branch's History"] \
1735         -command {do_gitk $current_branch}
1736 set ui_visualize_current [.mbar.repository index last]
1737 .mbar.repository add command \
1738         -label [mc "Visualize All Branch History"] \
1739         -command {do_gitk --all}
1740 .mbar.repository add separator
1741
1742 proc current_branch_write {args} {
1743         global current_branch
1744         .mbar.repository entryconf $::ui_browse_current \
1745                 -label [mc "Browse %s's Files" $current_branch]
1746         .mbar.repository entryconf $::ui_visualize_current \
1747                 -label [mc "Visualize %s's History" $current_branch]
1748 }
1749 trace add variable current_branch write current_branch_write
1750
1751 if {[is_enabled multicommit]} {
1752         .mbar.repository add command -label [mc "Database Statistics"] \
1753                 -command do_stats
1754
1755         .mbar.repository add command -label [mc "Compress Database"] \
1756                 -command do_gc
1757
1758         .mbar.repository add command -label [mc "Verify Database"] \
1759                 -command do_fsck_objects
1760
1761         .mbar.repository add separator
1762
1763         if {[is_Cygwin]} {
1764                 .mbar.repository add command \
1765                         -label [mc "Create Desktop Icon"] \
1766                         -command do_cygwin_shortcut
1767         } elseif {[is_Windows]} {
1768                 .mbar.repository add command \
1769                         -label [mc "Create Desktop Icon"] \
1770                         -command do_windows_shortcut
1771         } elseif {[is_MacOSX]} {
1772                 .mbar.repository add command \
1773                         -label [mc "Create Desktop Icon"] \
1774                         -command do_macosx_app
1775         }
1776 }
1777
1778 .mbar.repository add command -label [mc Quit] \
1779         -command do_quit \
1780         -accelerator $M1T-Q
1781
1782 # -- Edit Menu
1783 #
1784 menu .mbar.edit
1785 .mbar.edit add command -label [mc Undo] \
1786         -command {catch {[focus] edit undo}} \
1787         -accelerator $M1T-Z
1788 .mbar.edit add command -label [mc Redo] \
1789         -command {catch {[focus] edit redo}} \
1790         -accelerator $M1T-Y
1791 .mbar.edit add separator
1792 .mbar.edit add command -label [mc Cut] \
1793         -command {catch {tk_textCut [focus]}} \
1794         -accelerator $M1T-X
1795 .mbar.edit add command -label [mc Copy] \
1796         -command {catch {tk_textCopy [focus]}} \
1797         -accelerator $M1T-C
1798 .mbar.edit add command -label [mc Paste] \
1799         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1800         -accelerator $M1T-V
1801 .mbar.edit add command -label [mc Delete] \
1802         -command {catch {[focus] delete sel.first sel.last}} \
1803         -accelerator Del
1804 .mbar.edit add separator
1805 .mbar.edit add command -label [mc "Select All"] \
1806         -command {catch {[focus] tag add sel 0.0 end}} \
1807         -accelerator $M1T-A
1808
1809 # -- Branch Menu
1810 #
1811 if {[is_enabled branch]} {
1812         menu .mbar.branch
1813
1814         .mbar.branch add command -label [mc "Create..."] \
1815                 -command branch_create::dialog \
1816                 -accelerator $M1T-N
1817         lappend disable_on_lock [list .mbar.branch entryconf \
1818                 [.mbar.branch index last] -state]
1819
1820         .mbar.branch add command -label [mc "Checkout..."] \
1821                 -command branch_checkout::dialog \
1822                 -accelerator $M1T-O
1823         lappend disable_on_lock [list .mbar.branch entryconf \
1824                 [.mbar.branch index last] -state]
1825
1826         .mbar.branch add command -label [mc "Rename..."] \
1827                 -command branch_rename::dialog
1828         lappend disable_on_lock [list .mbar.branch entryconf \
1829                 [.mbar.branch index last] -state]
1830
1831         .mbar.branch add command -label [mc "Delete..."] \
1832                 -command branch_delete::dialog
1833         lappend disable_on_lock [list .mbar.branch entryconf \
1834                 [.mbar.branch index last] -state]
1835
1836         .mbar.branch add command -label [mc "Reset..."] \
1837                 -command merge::reset_hard
1838         lappend disable_on_lock [list .mbar.branch entryconf \
1839                 [.mbar.branch index last] -state]
1840 }
1841
1842 # -- Commit Menu
1843 #
1844 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1845         menu .mbar.commit
1846
1847         .mbar.commit add radiobutton \
1848                 -label [mc "New Commit"] \
1849                 -command do_select_commit_type \
1850                 -variable selected_commit_type \
1851                 -value new
1852         lappend disable_on_lock \
1853                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1854
1855         .mbar.commit add radiobutton \
1856                 -label [mc "Amend Last Commit"] \
1857                 -command do_select_commit_type \
1858                 -variable selected_commit_type \
1859                 -value amend
1860         lappend disable_on_lock \
1861                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1862
1863         .mbar.commit add separator
1864
1865         .mbar.commit add command -label [mc Rescan] \
1866                 -command do_rescan \
1867                 -accelerator F5
1868         lappend disable_on_lock \
1869                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1870
1871         .mbar.commit add command -label [mc "Stage To Commit"] \
1872                 -command do_add_selection
1873         lappend disable_on_lock \
1874                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1875
1876         .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
1877                 -command do_add_all \
1878                 -accelerator $M1T-I
1879         lappend disable_on_lock \
1880                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1881
1882         .mbar.commit add command -label [mc "Unstage From Commit"] \
1883                 -command do_unstage_selection
1884         lappend disable_on_lock \
1885                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1886
1887         .mbar.commit add command -label [mc "Revert Changes"] \
1888                 -command do_revert_selection
1889         lappend disable_on_lock \
1890                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1891
1892         .mbar.commit add separator
1893
1894         .mbar.commit add command -label [mc "Sign Off"] \
1895                 -command do_signoff \
1896                 -accelerator $M1T-S
1897
1898         .mbar.commit add command -label [mc Commit@@verb] \
1899                 -command do_commit \
1900                 -accelerator $M1T-Return
1901         lappend disable_on_lock \
1902                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1903 }
1904
1905 # -- Merge Menu
1906 #
1907 if {[is_enabled branch]} {
1908         menu .mbar.merge
1909         .mbar.merge add command -label [mc "Local Merge..."] \
1910                 -command merge::dialog \
1911                 -accelerator $M1T-M
1912         lappend disable_on_lock \
1913                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1914         .mbar.merge add command -label [mc "Abort Merge..."] \
1915                 -command merge::reset_hard
1916         lappend disable_on_lock \
1917                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1918 }
1919
1920 # -- Transport Menu
1921 #
1922 if {[is_enabled transport]} {
1923         menu .mbar.fetch
1924
1925         menu .mbar.push
1926         .mbar.push add command -label [mc "Push..."] \
1927                 -command do_push_anywhere \
1928                 -accelerator $M1T-P
1929         .mbar.push add command -label [mc "Delete..."] \
1930                 -command remote_branch_delete::dialog
1931 }
1932
1933 if {[is_MacOSX]} {
1934         # -- Apple Menu (Mac OS X only)
1935         #
1936         .mbar add cascade -label [mc Apple] -menu .mbar.apple
1937         menu .mbar.apple
1938
1939         .mbar.apple add command -label [mc "About %s" [appname]] \
1940                 -command do_about
1941         .mbar.apple add command -label [mc "Options..."] \
1942                 -command do_options
1943 } else {
1944         # -- Edit Menu
1945         #
1946         .mbar.edit add separator
1947         .mbar.edit add command -label [mc "Options..."] \
1948                 -command do_options
1949 }
1950
1951 # -- Help Menu
1952 #
1953 .mbar add cascade -label [mc Help] -menu .mbar.help
1954 menu .mbar.help
1955
1956 if {![is_MacOSX]} {
1957         .mbar.help add command -label [mc "About %s" [appname]] \
1958                 -command do_about
1959 }
1960
1961 set browser {}
1962 catch {set browser $repo_config(instaweb.browser)}
1963 set doc_path [file dirname [gitexec]]
1964 set doc_path [file join $doc_path Documentation index.html]
1965
1966 if {[is_Cygwin]} {
1967         set doc_path [exec cygpath --mixed $doc_path]
1968 }
1969
1970 if {$browser eq {}} {
1971         if {[is_MacOSX]} {
1972                 set browser open
1973         } elseif {[is_Cygwin]} {
1974                 set program_files [file dirname [exec cygpath --windir]]
1975                 set program_files [file join $program_files {Program Files}]
1976                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1977                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1978                 if {[file exists $firefox]} {
1979                         set browser $firefox
1980                 } elseif {[file exists $ie]} {
1981                         set browser $ie
1982                 }
1983                 unset program_files firefox ie
1984         }
1985 }
1986
1987 if {[file isfile $doc_path]} {
1988         set doc_url "file:$doc_path"
1989 } else {
1990         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1991 }
1992
1993 if {$browser ne {}} {
1994         .mbar.help add command -label [mc "Online Documentation"] \
1995                 -command [list exec $browser $doc_url &]
1996 }
1997 unset browser doc_path doc_url
1998
1999 set root_exists 0
2000 bind . <Visibility> {
2001         bind . <Visibility> {}
2002         set root_exists 1
2003 }
2004
2005 # -- Standard bindings
2006 #
2007 wm protocol . WM_DELETE_WINDOW do_quit
2008 bind all <$M1B-Key-q> do_quit
2009 bind all <$M1B-Key-Q> do_quit
2010 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2011 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2012
2013 set subcommand_args {}
2014 proc usage {} {
2015         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2016         exit 1
2017 }
2018
2019 # -- Not a normal commit type invocation?  Do that instead!
2020 #
2021 switch -- $subcommand {
2022 browser -
2023 blame {
2024         set subcommand_args {rev? path}
2025         if {$argv eq {}} usage
2026         set head {}
2027         set path {}
2028         set is_path 0
2029         foreach a $argv {
2030                 if {$is_path || [file exists $_prefix$a]} {
2031                         if {$path ne {}} usage
2032                         set path $_prefix$a
2033                         break
2034                 } elseif {$a eq {--}} {
2035                         if {$path ne {}} {
2036                                 if {$head ne {}} usage
2037                                 set head $path
2038                                 set path {}
2039                         }
2040                         set is_path 1
2041                 } elseif {$head eq {}} {
2042                         if {$head ne {}} usage
2043                         set head $a
2044                         set is_path 1
2045                 } else {
2046                         usage
2047                 }
2048         }
2049         unset is_path
2050
2051         if {$head ne {} && $path eq {}} {
2052                 set path $_prefix$head
2053                 set head {}
2054         }
2055
2056         if {$head eq {}} {
2057                 load_current_branch
2058         } else {
2059                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2060                         if {[catch {
2061                                         set head [git rev-parse --verify $head]
2062                                 } err]} {
2063                                 puts stderr $err
2064                                 exit 1
2065                         }
2066                 }
2067                 set current_branch $head
2068         }
2069
2070         switch -- $subcommand {
2071         browser {
2072                 if {$head eq {}} {
2073                         if {$path ne {} && [file isdirectory $path]} {
2074                                 set head $current_branch
2075                         } else {
2076                                 set head $path
2077                                 set path {}
2078                         }
2079                 }
2080                 browser::new $head $path
2081         }
2082         blame   {
2083                 if {$head eq {} && ![file exists $path]} {
2084                         puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2085                         exit 1
2086                 }
2087                 blame::new $head $path
2088         }
2089         }
2090         return
2091 }
2092 citool -
2093 gui {
2094         if {[llength $argv] != 0} {
2095                 puts -nonewline stderr "usage: $argv0"
2096                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2097                         puts -nonewline stderr " $subcommand"
2098                 }
2099                 puts stderr {}
2100                 exit 1
2101         }
2102         # fall through to setup UI for commits
2103 }
2104 default {
2105         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2106         exit 1
2107 }
2108 }
2109
2110 # -- Branch Control
2111 #
2112 frame .branch \
2113         -borderwidth 1 \
2114         -relief sunken
2115 label .branch.l1 \
2116         -text [mc "Current Branch:"] \
2117         -anchor w \
2118         -justify left
2119 label .branch.cb \
2120         -textvariable current_branch \
2121         -anchor w \
2122         -justify left
2123 pack .branch.l1 -side left
2124 pack .branch.cb -side left -fill x
2125 pack .branch -side top -fill x
2126
2127 # -- Main Window Layout
2128 #
2129 panedwindow .vpane -orient vertical
2130 panedwindow .vpane.files -orient horizontal
2131 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2132 pack .vpane -anchor n -side top -fill both -expand 1
2133
2134 # -- Index File List
2135 #
2136 frame .vpane.files.index -height 100 -width 200
2137 label .vpane.files.index.title -text [mc "Staged Changes (Will Be Committed)"] \
2138         -background lightgreen
2139 text $ui_index -background white -borderwidth 0 \
2140         -width 20 -height 10 \
2141         -wrap none \
2142         -cursor $cursor_ptr \
2143         -xscrollcommand {.vpane.files.index.sx set} \
2144         -yscrollcommand {.vpane.files.index.sy set} \
2145         -state disabled
2146 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2147 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2148 pack .vpane.files.index.title -side top -fill x
2149 pack .vpane.files.index.sx -side bottom -fill x
2150 pack .vpane.files.index.sy -side right -fill y
2151 pack $ui_index -side left -fill both -expand 1
2152 .vpane.files add .vpane.files.index -sticky nsew
2153
2154 # -- Working Directory File List
2155 #
2156 frame .vpane.files.workdir -height 100 -width 200
2157 label .vpane.files.workdir.title -text [mc "Unstaged Changes (Will Not Be Committed)"] \
2158         -background lightsalmon
2159 text $ui_workdir -background white -borderwidth 0 \
2160         -width 20 -height 10 \
2161         -wrap none \
2162         -cursor $cursor_ptr \
2163         -xscrollcommand {.vpane.files.workdir.sx set} \
2164         -yscrollcommand {.vpane.files.workdir.sy set} \
2165         -state disabled
2166 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2167 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2168 pack .vpane.files.workdir.title -side top -fill x
2169 pack .vpane.files.workdir.sx -side bottom -fill x
2170 pack .vpane.files.workdir.sy -side right -fill y
2171 pack $ui_workdir -side left -fill both -expand 1
2172 .vpane.files add .vpane.files.workdir -sticky nsew
2173
2174 foreach i [list $ui_index $ui_workdir] {
2175         $i tag conf in_diff -background lightgray
2176         $i tag conf in_sel  -background lightgray
2177 }
2178 unset i
2179
2180 # -- Diff and Commit Area
2181 #
2182 frame .vpane.lower -height 300 -width 400
2183 frame .vpane.lower.commarea
2184 frame .vpane.lower.diff -relief sunken -borderwidth 1
2185 pack .vpane.lower.commarea -side top -fill x
2186 pack .vpane.lower.diff -side bottom -fill both -expand 1
2187 .vpane add .vpane.lower -sticky nsew
2188
2189 # -- Commit Area Buttons
2190 #
2191 frame .vpane.lower.commarea.buttons
2192 label .vpane.lower.commarea.buttons.l -text {} \
2193         -anchor w \
2194         -justify left
2195 pack .vpane.lower.commarea.buttons.l -side top -fill x
2196 pack .vpane.lower.commarea.buttons -side left -fill y
2197
2198 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2199         -command do_rescan
2200 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2201 lappend disable_on_lock \
2202         {.vpane.lower.commarea.buttons.rescan conf -state}
2203
2204 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2205         -command do_add_all
2206 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2207 lappend disable_on_lock \
2208         {.vpane.lower.commarea.buttons.incall conf -state}
2209
2210 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2211         -command do_signoff
2212 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2213
2214 button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2215         -command do_commit
2216 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2217 lappend disable_on_lock \
2218         {.vpane.lower.commarea.buttons.commit conf -state}
2219
2220 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2221         -command do_push_anywhere
2222 pack .vpane.lower.commarea.buttons.push -side top -fill x
2223
2224 # -- Commit Message Buffer
2225 #
2226 frame .vpane.lower.commarea.buffer
2227 frame .vpane.lower.commarea.buffer.header
2228 set ui_comm .vpane.lower.commarea.buffer.t
2229 set ui_coml .vpane.lower.commarea.buffer.header.l
2230 radiobutton .vpane.lower.commarea.buffer.header.new \
2231         -text [mc "New Commit"] \
2232         -command do_select_commit_type \
2233         -variable selected_commit_type \
2234         -value new
2235 lappend disable_on_lock \
2236         [list .vpane.lower.commarea.buffer.header.new conf -state]
2237 radiobutton .vpane.lower.commarea.buffer.header.amend \
2238         -text [mc "Amend Last Commit"] \
2239         -command do_select_commit_type \
2240         -variable selected_commit_type \
2241         -value amend
2242 lappend disable_on_lock \
2243         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2244 label $ui_coml \
2245         -anchor w \
2246         -justify left
2247 proc trace_commit_type {varname args} {
2248         global ui_coml commit_type
2249         switch -glob -- $commit_type {
2250         initial       {set txt [mc "Initial Commit Message:"]}
2251         amend         {set txt [mc "Amended Commit Message:"]}
2252         amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2253         amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
2254         merge         {set txt [mc "Merge Commit Message:"]}
2255         *             {set txt [mc "Commit Message:"]}
2256         }
2257         $ui_coml conf -text $txt
2258 }
2259 trace add variable commit_type write trace_commit_type
2260 pack $ui_coml -side left -fill x
2261 pack .vpane.lower.commarea.buffer.header.amend -side right
2262 pack .vpane.lower.commarea.buffer.header.new -side right
2263
2264 text $ui_comm -background white -borderwidth 1 \
2265         -undo true \
2266         -maxundo 20 \
2267         -autoseparators true \
2268         -relief sunken \
2269         -width 75 -height 9 -wrap none \
2270         -font font_diff \
2271         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2272 scrollbar .vpane.lower.commarea.buffer.sby \
2273         -command [list $ui_comm yview]
2274 pack .vpane.lower.commarea.buffer.header -side top -fill x
2275 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2276 pack $ui_comm -side left -fill y
2277 pack .vpane.lower.commarea.buffer -side left -fill y
2278
2279 # -- Commit Message Buffer Context Menu
2280 #
2281 set ctxm .vpane.lower.commarea.buffer.ctxm
2282 menu $ctxm -tearoff 0
2283 $ctxm add command \
2284         -label [mc Cut] \
2285         -command {tk_textCut $ui_comm}
2286 $ctxm add command \
2287         -label [mc Copy] \
2288         -command {tk_textCopy $ui_comm}
2289 $ctxm add command \
2290         -label [mc Paste] \
2291         -command {tk_textPaste $ui_comm}
2292 $ctxm add command \
2293         -label [mc Delete] \
2294         -command {$ui_comm delete sel.first sel.last}
2295 $ctxm add separator
2296 $ctxm add command \
2297         -label [mc "Select All"] \
2298         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2299 $ctxm add command \
2300         -label [mc "Copy All"] \
2301         -command {
2302                 $ui_comm tag add sel 0.0 end
2303                 tk_textCopy $ui_comm
2304                 $ui_comm tag remove sel 0.0 end
2305         }
2306 $ctxm add separator
2307 $ctxm add command \
2308         -label [mc "Sign Off"] \
2309         -command do_signoff
2310 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2311
2312 # -- Diff Header
2313 #
2314 proc trace_current_diff_path {varname args} {
2315         global current_diff_path diff_actions file_states
2316         if {$current_diff_path eq {}} {
2317                 set s {}
2318                 set f {}
2319                 set p {}
2320                 set o disabled
2321         } else {
2322                 set p $current_diff_path
2323                 set s [mapdesc [lindex $file_states($p) 0] $p]
2324                 set f [mc "File:"]
2325                 set p [escape_path $p]
2326                 set o normal
2327         }
2328
2329         .vpane.lower.diff.header.status configure -text $s
2330         .vpane.lower.diff.header.file configure -text $f
2331         .vpane.lower.diff.header.path configure -text $p
2332         foreach w $diff_actions {
2333                 uplevel #0 $w $o
2334         }
2335 }
2336 trace add variable current_diff_path write trace_current_diff_path
2337
2338 frame .vpane.lower.diff.header -background gold
2339 label .vpane.lower.diff.header.status \
2340         -background gold \
2341         -width $max_status_desc \
2342         -anchor w \
2343         -justify left
2344 label .vpane.lower.diff.header.file \
2345         -background gold \
2346         -anchor w \
2347         -justify left
2348 label .vpane.lower.diff.header.path \
2349         -background gold \
2350         -anchor w \
2351         -justify left
2352 pack .vpane.lower.diff.header.status -side left
2353 pack .vpane.lower.diff.header.file -side left
2354 pack .vpane.lower.diff.header.path -fill x
2355 set ctxm .vpane.lower.diff.header.ctxm
2356 menu $ctxm -tearoff 0
2357 $ctxm add command \
2358         -label [mc Copy] \
2359         -command {
2360                 clipboard clear
2361                 clipboard append \
2362                         -format STRING \
2363                         -type STRING \
2364                         -- $current_diff_path
2365         }
2366 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2367 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2368
2369 # -- Diff Body
2370 #
2371 frame .vpane.lower.diff.body
2372 set ui_diff .vpane.lower.diff.body.t
2373 text $ui_diff -background white -borderwidth 0 \
2374         -width 80 -height 15 -wrap none \
2375         -font font_diff \
2376         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2377         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2378         -state disabled
2379 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2380         -command [list $ui_diff xview]
2381 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2382         -command [list $ui_diff yview]
2383 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2384 pack .vpane.lower.diff.body.sby -side right -fill y
2385 pack $ui_diff -side left -fill both -expand 1
2386 pack .vpane.lower.diff.header -side top -fill x
2387 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2388
2389 $ui_diff tag conf d_cr -elide true
2390 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2391 $ui_diff tag conf d_+ -foreground {#00a000}
2392 $ui_diff tag conf d_- -foreground red
2393
2394 $ui_diff tag conf d_++ -foreground {#00a000}
2395 $ui_diff tag conf d_-- -foreground red
2396 $ui_diff tag conf d_+s \
2397         -foreground {#00a000} \
2398         -background {#e2effa}
2399 $ui_diff tag conf d_-s \
2400         -foreground red \
2401         -background {#e2effa}
2402 $ui_diff tag conf d_s+ \
2403         -foreground {#00a000} \
2404         -background ivory1
2405 $ui_diff tag conf d_s- \
2406         -foreground red \
2407         -background ivory1
2408
2409 $ui_diff tag conf d<<<<<<< \
2410         -foreground orange \
2411         -font font_diffbold
2412 $ui_diff tag conf d======= \
2413         -foreground orange \
2414         -font font_diffbold
2415 $ui_diff tag conf d>>>>>>> \
2416         -foreground orange \
2417         -font font_diffbold
2418
2419 $ui_diff tag raise sel
2420
2421 # -- Diff Body Context Menu
2422 #
2423 set ctxm .vpane.lower.diff.body.ctxm
2424 menu $ctxm -tearoff 0
2425 $ctxm add command \
2426         -label [mc Refresh] \
2427         -command reshow_diff
2428 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2429 $ctxm add command \
2430         -label [mc Copy] \
2431         -command {tk_textCopy $ui_diff}
2432 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2433 $ctxm add command \
2434         -label [mc "Select All"] \
2435         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2436 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2437 $ctxm add command \
2438         -label [mc "Copy All"] \
2439         -command {
2440                 $ui_diff tag add sel 0.0 end
2441                 tk_textCopy $ui_diff
2442                 $ui_diff tag remove sel 0.0 end
2443         }
2444 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2445 $ctxm add separator
2446 $ctxm add command \
2447         -label [mc "Apply/Reverse Hunk"] \
2448         -command {apply_hunk $cursorX $cursorY}
2449 set ui_diff_applyhunk [$ctxm index last]
2450 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2451 $ctxm add separator
2452 $ctxm add command \
2453         -label [mc "Decrease Font Size"] \
2454         -command {incr_font_size font_diff -1}
2455 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2456 $ctxm add command \
2457         -label [mc "Increase Font Size"] \
2458         -command {incr_font_size font_diff 1}
2459 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2460 $ctxm add separator
2461 $ctxm add command \
2462         -label [mc "Show Less Context"] \
2463         -command {if {$repo_config(gui.diffcontext) >= 1} {
2464                 incr repo_config(gui.diffcontext) -1
2465                 reshow_diff
2466         }}
2467 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2468 $ctxm add command \
2469         -label [mc "Show More Context"] \
2470         -command {if {$repo_config(gui.diffcontext) < 99} {
2471                 incr repo_config(gui.diffcontext)
2472                 reshow_diff
2473         }}
2474 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2475 $ctxm add separator
2476 $ctxm add command -label [mc "Options..."] \
2477         -command do_options
2478 proc popup_diff_menu {ctxm x y X Y} {
2479         global current_diff_path file_states
2480         set ::cursorX $x
2481         set ::cursorY $y
2482         if {$::ui_index eq $::current_diff_side} {
2483                 set l [mc "Unstage Hunk From Commit"]
2484         } else {
2485                 set l [mc "Stage Hunk For Commit"]
2486         }
2487         if {$::is_3way_diff
2488                 || $current_diff_path eq {}
2489                 || ![info exists file_states($current_diff_path)]
2490                 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2491                 set s disabled
2492         } else {
2493                 set s normal
2494         }
2495         $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2496         tk_popup $ctxm $X $Y
2497 }
2498 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2499
2500 # -- Status Bar
2501 #
2502 set main_status [::status_bar::new .status]
2503 pack .status -anchor w -side bottom -fill x
2504 $main_status show [mc "Initializing..."]
2505
2506 # -- Load geometry
2507 #
2508 catch {
2509 set gm $repo_config(gui.geometry)
2510 wm geometry . [lindex $gm 0]
2511 .vpane sash place 0 \
2512         [lindex [.vpane sash coord 0] 0] \
2513         [lindex $gm 1]
2514 .vpane.files sash place 0 \
2515         [lindex $gm 2] \
2516         [lindex [.vpane.files sash coord 0] 1]
2517 unset gm
2518 }
2519
2520 # -- Key Bindings
2521 #
2522 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2523 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2524 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2525 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2526 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2527 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2528 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2529 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2530 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2531 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2532 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2533
2534 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2535 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2536 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2537 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2538 bind $ui_diff <$M1B-Key-v> {break}
2539 bind $ui_diff <$M1B-Key-V> {break}
2540 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2541 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2542 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2543 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2544 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2545 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2546 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2547 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2548 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2549 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2550 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2551 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2552 bind $ui_diff <Button-1>   {focus %W}
2553
2554 if {[is_enabled branch]} {
2555         bind . <$M1B-Key-n> branch_create::dialog
2556         bind . <$M1B-Key-N> branch_create::dialog
2557         bind . <$M1B-Key-o> branch_checkout::dialog
2558         bind . <$M1B-Key-O> branch_checkout::dialog
2559         bind . <$M1B-Key-m> merge::dialog
2560         bind . <$M1B-Key-M> merge::dialog
2561 }
2562 if {[is_enabled transport]} {
2563         bind . <$M1B-Key-p> do_push_anywhere
2564         bind . <$M1B-Key-P> do_push_anywhere
2565 }
2566
2567 bind .   <Key-F5>     do_rescan
2568 bind .   <$M1B-Key-r> do_rescan
2569 bind .   <$M1B-Key-R> do_rescan
2570 bind .   <$M1B-Key-s> do_signoff
2571 bind .   <$M1B-Key-S> do_signoff
2572 bind .   <$M1B-Key-i> do_add_all
2573 bind .   <$M1B-Key-I> do_add_all
2574 bind .   <$M1B-Key-Return> do_commit
2575 foreach i [list $ui_index $ui_workdir] {
2576         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2577         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2578         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2579 }
2580 unset i
2581
2582 set file_lists($ui_index) [list]
2583 set file_lists($ui_workdir) [list]
2584
2585 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2586 focus -force $ui_comm
2587
2588 # -- Warn the user about environmental problems.  Cygwin's Tcl
2589 #    does *not* pass its env array onto any processes it spawns.
2590 #    This means that git processes get none of our environment.
2591 #
2592 if {[is_Cygwin]} {
2593         set ignored_env 0
2594         set suggest_user {}
2595         set msg [mc "Possible environment issues exist.
2596
2597 The following environment variables are probably
2598 going to be ignored by any Git subprocess run
2599 by %s:
2600
2601 " [appname]]
2602         foreach name [array names env] {
2603                 switch -regexp -- $name {
2604                 {^GIT_INDEX_FILE$} -
2605                 {^GIT_OBJECT_DIRECTORY$} -
2606                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2607                 {^GIT_DIFF_OPTS$} -
2608                 {^GIT_EXTERNAL_DIFF$} -
2609                 {^GIT_PAGER$} -
2610                 {^GIT_TRACE$} -
2611                 {^GIT_CONFIG$} -
2612                 {^GIT_CONFIG_LOCAL$} -
2613                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2614                         append msg " - $name\n"
2615                         incr ignored_env
2616                 }
2617                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2618                         append msg " - $name\n"
2619                         incr ignored_env
2620                         set suggest_user $name
2621                 }
2622                 }
2623         }
2624         if {$ignored_env > 0} {
2625                 append msg [mc "
2626 This is due to a known issue with the
2627 Tcl binary distributed by Cygwin."]
2628
2629                 if {$suggest_user ne {}} {
2630                         append msg [mc "
2631
2632 A good replacement for %s
2633 is placing values for the user.name and
2634 user.email settings into your personal
2635 ~/.gitconfig file.
2636 " $suggest_user]
2637                 }
2638                 warn_popup $msg
2639         }
2640         unset ignored_env msg suggest_user name
2641 }
2642
2643 # -- Only initialize complex UI if we are going to stay running.
2644 #
2645 if {[is_enabled transport]} {
2646         load_all_remotes
2647
2648         populate_fetch_menu
2649         populate_push_menu
2650 }
2651
2652 if {[winfo exists $ui_comm]} {
2653         set GITGUI_BCK_exists [load_message GITGUI_BCK]
2654
2655         # -- If both our backup and message files exist use the
2656         #    newer of the two files to initialize the buffer.
2657         #
2658         if {$GITGUI_BCK_exists} {
2659                 set m [gitdir GITGUI_MSG]
2660                 if {[file isfile $m]} {
2661                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2662                                 catch {file delete [gitdir GITGUI_MSG]}
2663                         } else {
2664                                 $ui_comm delete 0.0 end
2665                                 $ui_comm edit reset
2666                                 $ui_comm edit modified false
2667                                 catch {file delete [gitdir GITGUI_BCK]}
2668                                 set GITGUI_BCK_exists 0
2669                         }
2670                 }
2671                 unset m
2672         }
2673
2674         proc backup_commit_buffer {} {
2675                 global ui_comm GITGUI_BCK_exists
2676
2677                 set m [$ui_comm edit modified]
2678                 if {$m || $GITGUI_BCK_exists} {
2679                         set msg [string trim [$ui_comm get 0.0 end]]
2680                         regsub -all -line {[ \r\t]+$} $msg {} msg
2681
2682                         if {$msg eq {}} {
2683                                 if {$GITGUI_BCK_exists} {
2684                                         catch {file delete [gitdir GITGUI_BCK]}
2685                                         set GITGUI_BCK_exists 0
2686                                 }
2687                         } elseif {$m} {
2688                                 catch {
2689                                         set fd [open [gitdir GITGUI_BCK] w]
2690                                         puts -nonewline $fd $msg
2691                                         close $fd
2692                                         set GITGUI_BCK_exists 1
2693                                 }
2694                         }
2695
2696                         $ui_comm edit modified false
2697                 }
2698
2699                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2700         }
2701
2702         backup_commit_buffer
2703 }
2704
2705 lock_index begin-read
2706 if {![winfo ismapped .]} {
2707         wm deiconify .
2708 }
2709 after 1 do_rescan
2710 if {[is_enabled multicommit]} {
2711         after 1000 hint_gc
2712 }