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