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                 set p [encoding convertfrom $p]
1033                 if {[string index $p end] eq {/}} {
1034                         set p [string range $p 0 end-1]
1035                 }
1036                 merge_state $p ?O
1037         }
1038         rescan_done $fd buf_rlo $after
1039 }
1040
1041 proc rescan_done {fd buf after} {
1042         global rescan_active current_diff_path
1043         global file_states repo_config
1044         upvar $buf to_clear
1045
1046         if {![eof $fd]} return
1047         set to_clear {}
1048         close $fd
1049         if {[incr rescan_active -1] > 0} return
1050
1051         prune_selection
1052         unlock_index
1053         display_all_files
1054         if {$current_diff_path ne {}} reshow_diff
1055         uplevel #0 $after
1056 }
1057
1058 proc prune_selection {} {
1059         global file_states selected_paths
1060
1061         foreach path [array names selected_paths] {
1062                 if {[catch {set still_here $file_states($path)}]} {
1063                         unset selected_paths($path)
1064                 }
1065         }
1066 }
1067
1068 ######################################################################
1069 ##
1070 ## ui helpers
1071
1072 proc mapicon {w state path} {
1073         global all_icons
1074
1075         if {[catch {set r $all_icons($state$w)}]} {
1076                 puts "error: no icon for $w state={$state} $path"
1077                 return file_plain
1078         }
1079         return $r
1080 }
1081
1082 proc mapdesc {state path} {
1083         global all_descs
1084
1085         if {[catch {set r $all_descs($state)}]} {
1086                 puts "error: no desc for state={$state} $path"
1087                 return $state
1088         }
1089         return $r
1090 }
1091
1092 proc ui_status {msg} {
1093         $::main_status show $msg
1094 }
1095
1096 proc ui_ready {{test {}}} {
1097         $::main_status show [mc "Ready."] $test
1098 }
1099
1100 proc escape_path {path} {
1101         regsub -all {\\} $path "\\\\" path
1102         regsub -all "\n" $path "\\n" path
1103         return $path
1104 }
1105
1106 proc short_path {path} {
1107         return [escape_path [lindex [file split $path] end]]
1108 }
1109
1110 set next_icon_id 0
1111 set null_sha1 [string repeat 0 40]
1112
1113 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1114         global file_states next_icon_id null_sha1
1115
1116         set s0 [string index $new_state 0]
1117         set s1 [string index $new_state 1]
1118
1119         if {[catch {set info $file_states($path)}]} {
1120                 set state __
1121                 set icon n[incr next_icon_id]
1122         } else {
1123                 set state [lindex $info 0]
1124                 set icon [lindex $info 1]
1125                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1126                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1127         }
1128
1129         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1130         elseif {$s0 eq {_}} {set s0 _}
1131
1132         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1133         elseif {$s1 eq {_}} {set s1 _}
1134
1135         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1136                 set head_info [list 0 $null_sha1]
1137         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1138                 && $head_info eq {}} {
1139                 set head_info $index_info
1140         }
1141
1142         set file_states($path) [list $s0$s1 $icon \
1143                 $head_info $index_info \
1144                 ]
1145         return $state
1146 }
1147
1148 proc display_file_helper {w path icon_name old_m new_m} {
1149         global file_lists
1150
1151         if {$new_m eq {_}} {
1152                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1153                 if {$lno >= 0} {
1154                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1155                         incr lno
1156                         $w conf -state normal
1157                         $w delete $lno.0 [expr {$lno + 1}].0
1158                         $w conf -state disabled
1159                 }
1160         } elseif {$old_m eq {_} && $new_m ne {_}} {
1161                 lappend file_lists($w) $path
1162                 set file_lists($w) [lsort -unique $file_lists($w)]
1163                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1164                 incr lno
1165                 $w conf -state normal
1166                 $w image create $lno.0 \
1167                         -align center -padx 5 -pady 1 \
1168                         -name $icon_name \
1169                         -image [mapicon $w $new_m $path]
1170                 $w insert $lno.1 "[escape_path $path]\n"
1171                 $w conf -state disabled
1172         } elseif {$old_m ne $new_m} {
1173                 $w conf -state normal
1174                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1175                 $w conf -state disabled
1176         }
1177 }
1178
1179 proc display_file {path state} {
1180         global file_states selected_paths
1181         global ui_index ui_workdir
1182
1183         set old_m [merge_state $path $state]
1184         set s $file_states($path)
1185         set new_m [lindex $s 0]
1186         set icon_name [lindex $s 1]
1187
1188         set o [string index $old_m 0]
1189         set n [string index $new_m 0]
1190         if {$o eq {U}} {
1191                 set o _
1192         }
1193         if {$n eq {U}} {
1194                 set n _
1195         }
1196         display_file_helper     $ui_index $path $icon_name $o $n
1197
1198         if {[string index $old_m 0] eq {U}} {
1199                 set o U
1200         } else {
1201                 set o [string index $old_m 1]
1202         }
1203         if {[string index $new_m 0] eq {U}} {
1204                 set n U
1205         } else {
1206                 set n [string index $new_m 1]
1207         }
1208         display_file_helper     $ui_workdir $path $icon_name $o $n
1209
1210         if {$new_m eq {__}} {
1211                 unset file_states($path)
1212                 catch {unset selected_paths($path)}
1213         }
1214 }
1215
1216 proc display_all_files_helper {w path icon_name m} {
1217         global file_lists
1218
1219         lappend file_lists($w) $path
1220         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1221         $w image create end \
1222                 -align center -padx 5 -pady 1 \
1223                 -name $icon_name \
1224                 -image [mapicon $w $m $path]
1225         $w insert end "[escape_path $path]\n"
1226 }
1227
1228 proc display_all_files {} {
1229         global ui_index ui_workdir
1230         global file_states file_lists
1231         global last_clicked
1232
1233         $ui_index conf -state normal
1234         $ui_workdir conf -state normal
1235
1236         $ui_index delete 0.0 end
1237         $ui_workdir delete 0.0 end
1238         set last_clicked {}
1239
1240         set file_lists($ui_index) [list]
1241         set file_lists($ui_workdir) [list]
1242
1243         foreach path [lsort [array names file_states]] {
1244                 set s $file_states($path)
1245                 set m [lindex $s 0]
1246                 set icon_name [lindex $s 1]
1247
1248                 set s [string index $m 0]
1249                 if {$s ne {U} && $s ne {_}} {
1250                         display_all_files_helper $ui_index $path \
1251                                 $icon_name $s
1252                 }
1253
1254                 if {[string index $m 0] eq {U}} {
1255                         set s U
1256                 } else {
1257                         set s [string index $m 1]
1258                 }
1259                 if {$s ne {_}} {
1260                         display_all_files_helper $ui_workdir $path \
1261                                 $icon_name $s
1262                 }
1263         }
1264
1265         $ui_index conf -state disabled
1266         $ui_workdir conf -state disabled
1267 }
1268
1269 ######################################################################
1270 ##
1271 ## icons
1272
1273 set filemask {
1274 #define mask_width 14
1275 #define mask_height 15
1276 static unsigned char mask_bits[] = {
1277    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1278    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1279    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1280 }
1281
1282 image create bitmap file_plain -background white -foreground black -data {
1283 #define plain_width 14
1284 #define plain_height 15
1285 static unsigned char plain_bits[] = {
1286    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1287    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1288    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1289 } -maskdata $filemask
1290
1291 image create bitmap file_mod -background white -foreground blue -data {
1292 #define mod_width 14
1293 #define mod_height 15
1294 static unsigned char mod_bits[] = {
1295    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1296    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1297    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1298 } -maskdata $filemask
1299
1300 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1301 #define file_fulltick_width 14
1302 #define file_fulltick_height 15
1303 static unsigned char file_fulltick_bits[] = {
1304    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1305    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1306    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1307 } -maskdata $filemask
1308
1309 image create bitmap file_parttick -background white -foreground "#005050" -data {
1310 #define parttick_width 14
1311 #define parttick_height 15
1312 static unsigned char parttick_bits[] = {
1313    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1314    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1315    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1316 } -maskdata $filemask
1317
1318 image create bitmap file_question -background white -foreground black -data {
1319 #define file_question_width 14
1320 #define file_question_height 15
1321 static unsigned char file_question_bits[] = {
1322    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1323    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1324    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1325 } -maskdata $filemask
1326
1327 image create bitmap file_removed -background white -foreground red -data {
1328 #define file_removed_width 14
1329 #define file_removed_height 15
1330 static unsigned char file_removed_bits[] = {
1331    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1332    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1333    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1334 } -maskdata $filemask
1335
1336 image create bitmap file_merge -background white -foreground blue -data {
1337 #define file_merge_width 14
1338 #define file_merge_height 15
1339 static unsigned char file_merge_bits[] = {
1340    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1341    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1342    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1343 } -maskdata $filemask
1344
1345 set ui_index .vpane.files.index.list
1346 set ui_workdir .vpane.files.workdir.list
1347
1348 set all_icons(_$ui_index)   file_plain
1349 set all_icons(A$ui_index)   file_fulltick
1350 set all_icons(M$ui_index)   file_fulltick
1351 set all_icons(D$ui_index)   file_removed
1352 set all_icons(U$ui_index)   file_merge
1353
1354 set all_icons(_$ui_workdir) file_plain
1355 set all_icons(M$ui_workdir) file_mod
1356 set all_icons(D$ui_workdir) file_question
1357 set all_icons(U$ui_workdir) file_merge
1358 set all_icons(O$ui_workdir) file_plain
1359
1360 set max_status_desc 0
1361 foreach i {
1362                 {__ {mc "Unmodified"}}
1363
1364                 {_M {mc "Modified, not staged"}}
1365                 {M_ {mc "Staged for commit"}}
1366                 {MM {mc "Portions staged for commit"}}
1367                 {MD {mc "Staged for commit, missing"}}
1368
1369                 {_O {mc "Untracked, not staged"}}
1370                 {A_ {mc "Staged for commit"}}
1371                 {AM {mc "Portions staged for commit"}}
1372                 {AD {mc "Staged for commit, missing"}}
1373
1374                 {_D {mc "Missing"}}
1375                 {D_ {mc "Staged for removal"}}
1376                 {DO {mc "Staged for removal, still present"}}
1377
1378                 {U_ {mc "Requires merge resolution"}}
1379                 {UU {mc "Requires merge resolution"}}
1380                 {UM {mc "Requires merge resolution"}}
1381                 {UD {mc "Requires merge resolution"}}
1382         } {
1383         set text [eval [lindex $i 1]]
1384         if {$max_status_desc < [string length $text]} {
1385                 set max_status_desc [string length $text]
1386         }
1387         set all_descs([lindex $i 0]) $text
1388 }
1389 unset i
1390
1391 ######################################################################
1392 ##
1393 ## util
1394
1395 proc bind_button3 {w cmd} {
1396         bind $w <Any-Button-3> $cmd
1397         if {[is_MacOSX]} {
1398                 # Mac OS X sends Button-2 on right click through three-button mouse,
1399                 # or through trackpad right-clicking (two-finger touch + click).
1400                 bind $w <Any-Button-2> $cmd
1401                 bind $w <Control-Button-1> $cmd
1402         }
1403 }
1404
1405 proc scrollbar2many {list mode args} {
1406         foreach w $list {eval $w $mode $args}
1407 }
1408
1409 proc many2scrollbar {list mode sb top bottom} {
1410         $sb set $top $bottom
1411         foreach w $list {$w $mode moveto $top}
1412 }
1413
1414 proc incr_font_size {font {amt 1}} {
1415         set sz [font configure $font -size]
1416         incr sz $amt
1417         font configure $font -size $sz
1418         font configure ${font}bold -size $sz
1419         font configure ${font}italic -size $sz
1420 }
1421
1422 ######################################################################
1423 ##
1424 ## ui commands
1425
1426 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1427
1428 proc do_gitk {revs} {
1429         # -- Always start gitk through whatever we were loaded with.  This
1430         #    lets us bypass using shell process on Windows systems.
1431         #
1432         set exe [file join [file dirname $::_git] gitk]
1433         set cmd [list [info nameofexecutable] $exe]
1434         if {! [file exists $exe]} {
1435                 error_popup [mc "Unable to start gitk:\n\n%s does not exist" $exe]
1436         } else {
1437                 eval exec $cmd $revs &
1438                 ui_status $::starting_gitk_msg
1439                 after 10000 {
1440                         ui_ready $starting_gitk_msg
1441                 }
1442         }
1443 }
1444
1445 set is_quitting 0
1446
1447 proc do_quit {} {
1448         global ui_comm is_quitting repo_config commit_type
1449         global GITGUI_BCK_exists GITGUI_BCK_i
1450
1451         if {$is_quitting} return
1452         set is_quitting 1
1453
1454         if {[winfo exists $ui_comm]} {
1455                 # -- Stash our current commit buffer.
1456                 #
1457                 set save [gitdir GITGUI_MSG]
1458                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1459                         file rename -force [gitdir GITGUI_BCK] $save
1460                         set GITGUI_BCK_exists 0
1461                 } else {
1462                         set msg [string trim [$ui_comm get 0.0 end]]
1463                         regsub -all -line {[ \r\t]+$} $msg {} msg
1464                         if {(![string match amend* $commit_type]
1465                                 || [$ui_comm edit modified])
1466                                 && $msg ne {}} {
1467                                 catch {
1468                                         set fd [open $save w]
1469                                         puts -nonewline $fd $msg
1470                                         close $fd
1471                                 }
1472                         } else {
1473                                 catch {file delete $save}
1474                         }
1475                 }
1476
1477                 # -- Remove our editor backup, its not needed.
1478                 #
1479                 after cancel $GITGUI_BCK_i
1480                 if {$GITGUI_BCK_exists} {
1481                         catch {file delete [gitdir GITGUI_BCK]}
1482                 }
1483
1484                 # -- Stash our current window geometry into this repository.
1485                 #
1486                 set cfg_geometry [list]
1487                 lappend cfg_geometry [wm geometry .]
1488                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1489                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1490                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1491                         set rc_geometry {}
1492                 }
1493                 if {$cfg_geometry ne $rc_geometry} {
1494                         catch {git config gui.geometry $cfg_geometry}
1495                 }
1496         }
1497
1498         destroy .
1499 }
1500
1501 proc do_rescan {} {
1502         rescan ui_ready
1503 }
1504
1505 proc do_commit {} {
1506         commit_tree
1507 }
1508
1509 proc toggle_or_diff {w x y} {
1510         global file_states file_lists current_diff_path ui_index ui_workdir
1511         global last_clicked selected_paths
1512
1513         set pos [split [$w index @$x,$y] .]
1514         set lno [lindex $pos 0]
1515         set col [lindex $pos 1]
1516         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1517         if {$path eq {}} {
1518                 set last_clicked {}
1519                 return
1520         }
1521
1522         set last_clicked [list $w $lno]
1523         array unset selected_paths
1524         $ui_index tag remove in_sel 0.0 end
1525         $ui_workdir tag remove in_sel 0.0 end
1526
1527         if {$col == 0} {
1528                 if {$current_diff_path eq $path} {
1529                         set after {reshow_diff;}
1530                 } else {
1531                         set after {}
1532                 }
1533                 if {$w eq $ui_index} {
1534                         update_indexinfo \
1535                                 "Unstaging [short_path $path] from commit" \
1536                                 [list $path] \
1537                                 [concat $after [list ui_ready]]
1538                 } elseif {$w eq $ui_workdir} {
1539                         update_index \
1540                                 "Adding [short_path $path]" \
1541                                 [list $path] \
1542                                 [concat $after [list ui_ready]]
1543                 }
1544         } else {
1545                 show_diff $path $w $lno
1546         }
1547 }
1548
1549 proc add_one_to_selection {w x y} {
1550         global file_lists last_clicked selected_paths
1551
1552         set lno [lindex [split [$w index @$x,$y] .] 0]
1553         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1554         if {$path eq {}} {
1555                 set last_clicked {}
1556                 return
1557         }
1558
1559         if {$last_clicked ne {}
1560                 && [lindex $last_clicked 0] ne $w} {
1561                 array unset selected_paths
1562                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1563         }
1564
1565         set last_clicked [list $w $lno]
1566         if {[catch {set in_sel $selected_paths($path)}]} {
1567                 set in_sel 0
1568         }
1569         if {$in_sel} {
1570                 unset selected_paths($path)
1571                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1572         } else {
1573                 set selected_paths($path) 1
1574                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1575         }
1576 }
1577
1578 proc add_range_to_selection {w x y} {
1579         global file_lists last_clicked selected_paths
1580
1581         if {[lindex $last_clicked 0] ne $w} {
1582                 toggle_or_diff $w $x $y
1583                 return
1584         }
1585
1586         set lno [lindex [split [$w index @$x,$y] .] 0]
1587         set lc [lindex $last_clicked 1]
1588         if {$lc < $lno} {
1589                 set begin $lc
1590                 set end $lno
1591         } else {
1592                 set begin $lno
1593                 set end $lc
1594         }
1595
1596         foreach path [lrange $file_lists($w) \
1597                 [expr {$begin - 1}] \
1598                 [expr {$end - 1}]] {
1599                 set selected_paths($path) 1
1600         }
1601         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1602 }
1603
1604 ######################################################################
1605 ##
1606 ## config defaults
1607
1608 set cursor_ptr arrow
1609 font create font_diff -family Courier -size 10
1610 font create font_ui
1611 catch {
1612         label .dummy
1613         eval font configure font_ui [font actual [.dummy cget -font]]
1614         destroy .dummy
1615 }
1616
1617 font create font_uiitalic
1618 font create font_uibold
1619 font create font_diffbold
1620 font create font_diffitalic
1621
1622 foreach class {Button Checkbutton Entry Label
1623                 Labelframe Listbox Menu Message
1624                 Radiobutton Spinbox Text} {
1625         option add *$class.font font_ui
1626 }
1627 unset class
1628
1629 if {[is_Windows] || [is_MacOSX]} {
1630         option add *Menu.tearOff 0
1631 }
1632
1633 if {[is_MacOSX]} {
1634         set M1B M1
1635         set M1T Cmd
1636 } else {
1637         set M1B Control
1638         set M1T Ctrl
1639 }
1640
1641 proc apply_config {} {
1642         global repo_config font_descs
1643
1644         foreach option $font_descs {
1645                 set name [lindex $option 0]
1646                 set font [lindex $option 1]
1647                 if {[catch {
1648                         foreach {cn cv} $repo_config(gui.$name) {
1649                                 font configure $font $cn $cv
1650                         }
1651                         } err]} {
1652                         error_popup [append [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
1653                 }
1654                 foreach {cn cv} [font configure $font] {
1655                         font configure ${font}bold $cn $cv
1656                         font configure ${font}italic $cn $cv
1657                 }
1658                 font configure ${font}bold -weight bold
1659                 font configure ${font}italic -slant italic
1660         }
1661 }
1662
1663 set default_config(merge.diffstat) true
1664 set default_config(merge.summary) false
1665 set default_config(merge.verbosity) 2
1666 set default_config(user.name) {}
1667 set default_config(user.email) {}
1668
1669 set default_config(gui.matchtrackingbranch) false
1670 set default_config(gui.pruneduringfetch) false
1671 set default_config(gui.trustmtime) false
1672 set default_config(gui.diffcontext) 5
1673 set default_config(gui.newbranchtemplate) {}
1674 set default_config(gui.fontui) [font configure font_ui]
1675 set default_config(gui.fontdiff) [font configure font_diff]
1676 set font_descs {
1677         {fontui   font_ui   {mc "Main Font"}}
1678         {fontdiff font_diff {mc "Diff/Console Font"}}
1679 }
1680 load_config 0
1681 apply_config
1682
1683 ######################################################################
1684 ##
1685 ## ui construction
1686
1687 set ui_comm {}
1688
1689 # -- Menu Bar
1690 #
1691 menu .mbar -tearoff 0
1692 .mbar add cascade -label [mc Repository] -menu .mbar.repository
1693 .mbar add cascade -label [mc Edit] -menu .mbar.edit
1694 if {[is_enabled branch]} {
1695         .mbar add cascade -label [mc Branch] -menu .mbar.branch
1696 }
1697 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1698         .mbar add cascade -label [mc Commit] -menu .mbar.commit
1699 }
1700 if {[is_enabled transport]} {
1701         .mbar add cascade -label [mc Merge] -menu .mbar.merge
1702         .mbar add cascade -label [mc Fetch] -menu .mbar.fetch
1703         .mbar add cascade -label [mc Push] -menu .mbar.push
1704 }
1705 . configure -menu .mbar
1706
1707 # -- Repository Menu
1708 #
1709 menu .mbar.repository
1710
1711 .mbar.repository add command \
1712         -label [mc "Browse Current Branch's Files"] \
1713         -command {browser::new $current_branch}
1714 set ui_browse_current [.mbar.repository index last]
1715 .mbar.repository add command \
1716         -label [mc "Browse Branch Files..."] \
1717         -command browser_open::dialog
1718 .mbar.repository add separator
1719
1720 .mbar.repository add command \
1721         -label [mc "Visualize Current Branch's History"] \
1722         -command {do_gitk $current_branch}
1723 set ui_visualize_current [.mbar.repository index last]
1724 .mbar.repository add command \
1725         -label [mc "Visualize All Branch History"] \
1726         -command {do_gitk --all}
1727 .mbar.repository add separator
1728
1729 proc current_branch_write {args} {
1730         global current_branch
1731         .mbar.repository entryconf $::ui_browse_current \
1732                 -label [mc "Browse %s's Files" $current_branch]
1733         .mbar.repository entryconf $::ui_visualize_current \
1734                 -label [mc "Visualize %s's History" $current_branch]
1735 }
1736 trace add variable current_branch write current_branch_write
1737
1738 if {[is_enabled multicommit]} {
1739         .mbar.repository add command -label [mc "Database Statistics"] \
1740                 -command do_stats
1741
1742         .mbar.repository add command -label [mc "Compress Database"] \
1743                 -command do_gc
1744
1745         .mbar.repository add command -label [mc "Verify Database"] \
1746                 -command do_fsck_objects
1747
1748         .mbar.repository add separator
1749
1750         if {[is_Cygwin]} {
1751                 .mbar.repository add command \
1752                         -label [mc "Create Desktop Icon"] \
1753                         -command do_cygwin_shortcut
1754         } elseif {[is_Windows]} {
1755                 .mbar.repository add command \
1756                         -label [mc "Create Desktop Icon"] \
1757                         -command do_windows_shortcut
1758         } elseif {[is_MacOSX]} {
1759                 .mbar.repository add command \
1760                         -label [mc "Create Desktop Icon"] \
1761                         -command do_macosx_app
1762         }
1763 }
1764
1765 .mbar.repository add command -label [mc Quit] \
1766         -command do_quit \
1767         -accelerator $M1T-Q
1768
1769 # -- Edit Menu
1770 #
1771 menu .mbar.edit
1772 .mbar.edit add command -label [mc Undo] \
1773         -command {catch {[focus] edit undo}} \
1774         -accelerator $M1T-Z
1775 .mbar.edit add command -label [mc Redo] \
1776         -command {catch {[focus] edit redo}} \
1777         -accelerator $M1T-Y
1778 .mbar.edit add separator
1779 .mbar.edit add command -label [mc Cut] \
1780         -command {catch {tk_textCut [focus]}} \
1781         -accelerator $M1T-X
1782 .mbar.edit add command -label [mc Copy] \
1783         -command {catch {tk_textCopy [focus]}} \
1784         -accelerator $M1T-C
1785 .mbar.edit add command -label [mc Paste] \
1786         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1787         -accelerator $M1T-V
1788 .mbar.edit add command -label [mc Delete] \
1789         -command {catch {[focus] delete sel.first sel.last}} \
1790         -accelerator Del
1791 .mbar.edit add separator
1792 .mbar.edit add command -label [mc "Select All"] \
1793         -command {catch {[focus] tag add sel 0.0 end}} \
1794         -accelerator $M1T-A
1795
1796 # -- Branch Menu
1797 #
1798 if {[is_enabled branch]} {
1799         menu .mbar.branch
1800
1801         .mbar.branch add command -label [mc "Create..."] \
1802                 -command branch_create::dialog \
1803                 -accelerator $M1T-N
1804         lappend disable_on_lock [list .mbar.branch entryconf \
1805                 [.mbar.branch index last] -state]
1806
1807         .mbar.branch add command -label [mc "Checkout..."] \
1808                 -command branch_checkout::dialog \
1809                 -accelerator $M1T-O
1810         lappend disable_on_lock [list .mbar.branch entryconf \
1811                 [.mbar.branch index last] -state]
1812
1813         .mbar.branch add command -label [mc "Rename..."] \
1814                 -command branch_rename::dialog
1815         lappend disable_on_lock [list .mbar.branch entryconf \
1816                 [.mbar.branch index last] -state]
1817
1818         .mbar.branch add command -label [mc "Delete..."] \
1819                 -command branch_delete::dialog
1820         lappend disable_on_lock [list .mbar.branch entryconf \
1821                 [.mbar.branch index last] -state]
1822
1823         .mbar.branch add command -label [mc "Reset..."] \
1824                 -command merge::reset_hard
1825         lappend disable_on_lock [list .mbar.branch entryconf \
1826                 [.mbar.branch index last] -state]
1827 }
1828
1829 # -- Commit Menu
1830 #
1831 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1832         menu .mbar.commit
1833
1834         .mbar.commit add radiobutton \
1835                 -label [mc "New Commit"] \
1836                 -command do_select_commit_type \
1837                 -variable selected_commit_type \
1838                 -value new
1839         lappend disable_on_lock \
1840                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1841
1842         .mbar.commit add radiobutton \
1843                 -label [mc "Amend Last Commit"] \
1844                 -command do_select_commit_type \
1845                 -variable selected_commit_type \
1846                 -value amend
1847         lappend disable_on_lock \
1848                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1849
1850         .mbar.commit add separator
1851
1852         .mbar.commit add command -label [mc Rescan] \
1853                 -command do_rescan \
1854                 -accelerator F5
1855         lappend disable_on_lock \
1856                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1857
1858         .mbar.commit add command -label [mc "Stage To Commit"] \
1859                 -command do_add_selection
1860         lappend disable_on_lock \
1861                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1862
1863         .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
1864                 -command do_add_all \
1865                 -accelerator $M1T-I
1866         lappend disable_on_lock \
1867                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1868
1869         .mbar.commit add command -label [mc "Unstage From Commit"] \
1870                 -command do_unstage_selection
1871         lappend disable_on_lock \
1872                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1873
1874         .mbar.commit add command -label [mc "Revert Changes"] \
1875                 -command do_revert_selection
1876         lappend disable_on_lock \
1877                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1878
1879         .mbar.commit add separator
1880
1881         .mbar.commit add command -label [mc "Sign Off"] \
1882                 -command do_signoff \
1883                 -accelerator $M1T-S
1884
1885         .mbar.commit add command -label [mc Commit] \
1886                 -command do_commit \
1887                 -accelerator $M1T-Return
1888         lappend disable_on_lock \
1889                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1890 }
1891
1892 # -- Merge Menu
1893 #
1894 if {[is_enabled branch]} {
1895         menu .mbar.merge
1896         .mbar.merge add command -label [mc "Local Merge..."] \
1897                 -command merge::dialog \
1898                 -accelerator $M1T-M
1899         lappend disable_on_lock \
1900                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1901         .mbar.merge add command -label [mc "Abort Merge..."] \
1902                 -command merge::reset_hard
1903         lappend disable_on_lock \
1904                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1905 }
1906
1907 # -- Transport Menu
1908 #
1909 if {[is_enabled transport]} {
1910         menu .mbar.fetch
1911
1912         menu .mbar.push
1913         .mbar.push add command -label [mc "Push..."] \
1914                 -command do_push_anywhere \
1915                 -accelerator $M1T-P
1916         .mbar.push add command -label [mc "Delete..."] \
1917                 -command remote_branch_delete::dialog
1918 }
1919
1920 if {[is_MacOSX]} {
1921         # -- Apple Menu (Mac OS X only)
1922         #
1923         .mbar add cascade -label [mc Apple] -menu .mbar.apple
1924         menu .mbar.apple
1925
1926         .mbar.apple add command -label [mc "About %s" [appname]] \
1927                 -command do_about
1928         .mbar.apple add command -label [mc "Options..."] \
1929                 -command do_options
1930 } else {
1931         # -- Edit Menu
1932         #
1933         .mbar.edit add separator
1934         .mbar.edit add command -label [mc "Options..."] \
1935                 -command do_options
1936 }
1937
1938 # -- Help Menu
1939 #
1940 .mbar add cascade -label [mc Help] -menu .mbar.help
1941 menu .mbar.help
1942
1943 if {![is_MacOSX]} {
1944         .mbar.help add command -label [mc "About %s" [appname]] \
1945                 -command do_about
1946 }
1947
1948 set browser {}
1949 catch {set browser $repo_config(instaweb.browser)}
1950 set doc_path [file dirname [gitexec]]
1951 set doc_path [file join $doc_path Documentation index.html]
1952
1953 if {[is_Cygwin]} {
1954         set doc_path [exec cygpath --mixed $doc_path]
1955 }
1956
1957 if {$browser eq {}} {
1958         if {[is_MacOSX]} {
1959                 set browser open
1960         } elseif {[is_Cygwin]} {
1961                 set program_files [file dirname [exec cygpath --windir]]
1962                 set program_files [file join $program_files {Program Files}]
1963                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1964                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1965                 if {[file exists $firefox]} {
1966                         set browser $firefox
1967                 } elseif {[file exists $ie]} {
1968                         set browser $ie
1969                 }
1970                 unset program_files firefox ie
1971         }
1972 }
1973
1974 if {[file isfile $doc_path]} {
1975         set doc_url "file:$doc_path"
1976 } else {
1977         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1978 }
1979
1980 if {$browser ne {}} {
1981         .mbar.help add command -label [mc "Online Documentation"] \
1982                 -command [list exec $browser $doc_url &]
1983 }
1984 unset browser doc_path doc_url
1985
1986 set root_exists 0
1987 bind . <Visibility> {
1988         bind . <Visibility> {}
1989         set root_exists 1
1990 }
1991
1992 # -- Standard bindings
1993 #
1994 wm protocol . WM_DELETE_WINDOW do_quit
1995 bind all <$M1B-Key-q> do_quit
1996 bind all <$M1B-Key-Q> do_quit
1997 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1998 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1999
2000 set subcommand_args {}
2001 proc usage {} {
2002         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2003         exit 1
2004 }
2005
2006 # -- Not a normal commit type invocation?  Do that instead!
2007 #
2008 switch -- $subcommand {
2009 browser -
2010 blame {
2011         set subcommand_args {rev? path}
2012         if {$argv eq {}} usage
2013         set head {}
2014         set path {}
2015         set is_path 0
2016         foreach a $argv {
2017                 if {$is_path || [file exists $_prefix$a]} {
2018                         if {$path ne {}} usage
2019                         set path $_prefix$a
2020                         break
2021                 } elseif {$a eq {--}} {
2022                         if {$path ne {}} {
2023                                 if {$head ne {}} usage
2024                                 set head $path
2025                                 set path {}
2026                         }
2027                         set is_path 1
2028                 } elseif {$head eq {}} {
2029                         if {$head ne {}} usage
2030                         set head $a
2031                         set is_path 1
2032                 } else {
2033                         usage
2034                 }
2035         }
2036         unset is_path
2037
2038         if {$head ne {} && $path eq {}} {
2039                 set path $_prefix$head
2040                 set head {}
2041         }
2042
2043         if {$head eq {}} {
2044                 load_current_branch
2045         } else {
2046                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2047                         if {[catch {
2048                                         set head [git rev-parse --verify $head]
2049                                 } err]} {
2050                                 puts stderr $err
2051                                 exit 1
2052                         }
2053                 }
2054                 set current_branch $head
2055         }
2056
2057         switch -- $subcommand {
2058         browser {
2059                 if {$head eq {}} {
2060                         if {$path ne {} && [file isdirectory $path]} {
2061                                 set head $current_branch
2062                         } else {
2063                                 set head $path
2064                                 set path {}
2065                         }
2066                 }
2067                 browser::new $head $path
2068         }
2069         blame   {
2070                 if {$head eq {} && ![file exists $path]} {
2071                         puts stderr "fatal: cannot stat path $path: No such file or directory"
2072                         exit 1
2073                 }
2074                 blame::new $head $path
2075         }
2076         }
2077         return
2078 }
2079 citool -
2080 gui {
2081         if {[llength $argv] != 0} {
2082                 puts -nonewline stderr "usage: $argv0"
2083                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2084                         puts -nonewline stderr " $subcommand"
2085                 }
2086                 puts stderr {}
2087                 exit 1
2088         }
2089         # fall through to setup UI for commits
2090 }
2091 default {
2092         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2093         exit 1
2094 }
2095 }
2096
2097 # -- Branch Control
2098 #
2099 frame .branch \
2100         -borderwidth 1 \
2101         -relief sunken
2102 label .branch.l1 \
2103         -text [mc "Current Branch:"] \
2104         -anchor w \
2105         -justify left
2106 label .branch.cb \
2107         -textvariable current_branch \
2108         -anchor w \
2109         -justify left
2110 pack .branch.l1 -side left
2111 pack .branch.cb -side left -fill x
2112 pack .branch -side top -fill x
2113
2114 # -- Main Window Layout
2115 #
2116 panedwindow .vpane -orient vertical
2117 panedwindow .vpane.files -orient horizontal
2118 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2119 pack .vpane -anchor n -side top -fill both -expand 1
2120
2121 # -- Index File List
2122 #
2123 frame .vpane.files.index -height 100 -width 200
2124 label .vpane.files.index.title -text [mc "Staged Changes (Will Be Committed)"] \
2125         -background lightgreen
2126 text $ui_index -background white -borderwidth 0 \
2127         -width 20 -height 10 \
2128         -wrap none \
2129         -cursor $cursor_ptr \
2130         -xscrollcommand {.vpane.files.index.sx set} \
2131         -yscrollcommand {.vpane.files.index.sy set} \
2132         -state disabled
2133 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2134 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2135 pack .vpane.files.index.title -side top -fill x
2136 pack .vpane.files.index.sx -side bottom -fill x
2137 pack .vpane.files.index.sy -side right -fill y
2138 pack $ui_index -side left -fill both -expand 1
2139 .vpane.files add .vpane.files.index -sticky nsew
2140
2141 # -- Working Directory File List
2142 #
2143 frame .vpane.files.workdir -height 100 -width 200
2144 label .vpane.files.workdir.title -text [mc "Unstaged Changes (Will Not Be Committed)"] \
2145         -background lightsalmon
2146 text $ui_workdir -background white -borderwidth 0 \
2147         -width 20 -height 10 \
2148         -wrap none \
2149         -cursor $cursor_ptr \
2150         -xscrollcommand {.vpane.files.workdir.sx set} \
2151         -yscrollcommand {.vpane.files.workdir.sy set} \
2152         -state disabled
2153 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2154 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2155 pack .vpane.files.workdir.title -side top -fill x
2156 pack .vpane.files.workdir.sx -side bottom -fill x
2157 pack .vpane.files.workdir.sy -side right -fill y
2158 pack $ui_workdir -side left -fill both -expand 1
2159 .vpane.files add .vpane.files.workdir -sticky nsew
2160
2161 foreach i [list $ui_index $ui_workdir] {
2162         $i tag conf in_diff -background lightgray
2163         $i tag conf in_sel  -background lightgray
2164 }
2165 unset i
2166
2167 # -- Diff and Commit Area
2168 #
2169 frame .vpane.lower -height 300 -width 400
2170 frame .vpane.lower.commarea
2171 frame .vpane.lower.diff -relief sunken -borderwidth 1
2172 pack .vpane.lower.commarea -side top -fill x
2173 pack .vpane.lower.diff -side bottom -fill both -expand 1
2174 .vpane add .vpane.lower -sticky nsew
2175
2176 # -- Commit Area Buttons
2177 #
2178 frame .vpane.lower.commarea.buttons
2179 label .vpane.lower.commarea.buttons.l -text {} \
2180         -anchor w \
2181         -justify left
2182 pack .vpane.lower.commarea.buttons.l -side top -fill x
2183 pack .vpane.lower.commarea.buttons -side left -fill y
2184
2185 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2186         -command do_rescan
2187 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2188 lappend disable_on_lock \
2189         {.vpane.lower.commarea.buttons.rescan conf -state}
2190
2191 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2192         -command do_add_all
2193 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2194 lappend disable_on_lock \
2195         {.vpane.lower.commarea.buttons.incall conf -state}
2196
2197 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2198         -command do_signoff
2199 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2200
2201 button .vpane.lower.commarea.buttons.commit -text [mc Commit] \
2202         -command do_commit
2203 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2204 lappend disable_on_lock \
2205         {.vpane.lower.commarea.buttons.commit conf -state}
2206
2207 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2208         -command do_push_anywhere
2209 pack .vpane.lower.commarea.buttons.push -side top -fill x
2210
2211 # -- Commit Message Buffer
2212 #
2213 frame .vpane.lower.commarea.buffer
2214 frame .vpane.lower.commarea.buffer.header
2215 set ui_comm .vpane.lower.commarea.buffer.t
2216 set ui_coml .vpane.lower.commarea.buffer.header.l
2217 radiobutton .vpane.lower.commarea.buffer.header.new \
2218         -text [mc "New Commit"] \
2219         -command do_select_commit_type \
2220         -variable selected_commit_type \
2221         -value new
2222 lappend disable_on_lock \
2223         [list .vpane.lower.commarea.buffer.header.new conf -state]
2224 radiobutton .vpane.lower.commarea.buffer.header.amend \
2225         -text [mc "Amend Last Commit"] \
2226         -command do_select_commit_type \
2227         -variable selected_commit_type \
2228         -value amend
2229 lappend disable_on_lock \
2230         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2231 label $ui_coml \
2232         -anchor w \
2233         -justify left
2234 proc trace_commit_type {varname args} {
2235         global ui_coml commit_type
2236         switch -glob -- $commit_type {
2237         initial       {set txt [mc "Initial Commit Message:"]}
2238         amend         {set txt [mc "Amended Commit Message:"]}
2239         amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2240         amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
2241         merge         {set txt [mc "Merge Commit Message:"]}
2242         *             {set txt [mc "Commit Message:"]}
2243         }
2244         $ui_coml conf -text $txt
2245 }
2246 trace add variable commit_type write trace_commit_type
2247 pack $ui_coml -side left -fill x
2248 pack .vpane.lower.commarea.buffer.header.amend -side right
2249 pack .vpane.lower.commarea.buffer.header.new -side right
2250
2251 text $ui_comm -background white -borderwidth 1 \
2252         -undo true \
2253         -maxundo 20 \
2254         -autoseparators true \
2255         -relief sunken \
2256         -width 75 -height 9 -wrap none \
2257         -font font_diff \
2258         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2259 scrollbar .vpane.lower.commarea.buffer.sby \
2260         -command [list $ui_comm yview]
2261 pack .vpane.lower.commarea.buffer.header -side top -fill x
2262 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2263 pack $ui_comm -side left -fill y
2264 pack .vpane.lower.commarea.buffer -side left -fill y
2265
2266 # -- Commit Message Buffer Context Menu
2267 #
2268 set ctxm .vpane.lower.commarea.buffer.ctxm
2269 menu $ctxm -tearoff 0
2270 $ctxm add command \
2271         -label [mc Cut] \
2272         -command {tk_textCut $ui_comm}
2273 $ctxm add command \
2274         -label [mc Copy] \
2275         -command {tk_textCopy $ui_comm}
2276 $ctxm add command \
2277         -label [mc Paste] \
2278         -command {tk_textPaste $ui_comm}
2279 $ctxm add command \
2280         -label [mc Delete] \
2281         -command {$ui_comm delete sel.first sel.last}
2282 $ctxm add separator
2283 $ctxm add command \
2284         -label [mc "Select All"] \
2285         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2286 $ctxm add command \
2287         -label [mc "Copy All"] \
2288         -command {
2289                 $ui_comm tag add sel 0.0 end
2290                 tk_textCopy $ui_comm
2291                 $ui_comm tag remove sel 0.0 end
2292         }
2293 $ctxm add separator
2294 $ctxm add command \
2295         -label [mc "Sign Off"] \
2296         -command do_signoff
2297 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2298
2299 # -- Diff Header
2300 #
2301 proc trace_current_diff_path {varname args} {
2302         global current_diff_path diff_actions file_states
2303         if {$current_diff_path eq {}} {
2304                 set s {}
2305                 set f {}
2306                 set p {}
2307                 set o disabled
2308         } else {
2309                 set p $current_diff_path
2310                 set s [mapdesc [lindex $file_states($p) 0] $p]
2311                 set f [mc "File:"]
2312                 set p [escape_path $p]
2313                 set o normal
2314         }
2315
2316         .vpane.lower.diff.header.status configure -text $s
2317         .vpane.lower.diff.header.file configure -text $f
2318         .vpane.lower.diff.header.path configure -text $p
2319         foreach w $diff_actions {
2320                 uplevel #0 $w $o
2321         }
2322 }
2323 trace add variable current_diff_path write trace_current_diff_path
2324
2325 frame .vpane.lower.diff.header -background gold
2326 label .vpane.lower.diff.header.status \
2327         -background gold \
2328         -width $max_status_desc \
2329         -anchor w \
2330         -justify left
2331 label .vpane.lower.diff.header.file \
2332         -background gold \
2333         -anchor w \
2334         -justify left
2335 label .vpane.lower.diff.header.path \
2336         -background gold \
2337         -anchor w \
2338         -justify left
2339 pack .vpane.lower.diff.header.status -side left
2340 pack .vpane.lower.diff.header.file -side left
2341 pack .vpane.lower.diff.header.path -fill x
2342 set ctxm .vpane.lower.diff.header.ctxm
2343 menu $ctxm -tearoff 0
2344 $ctxm add command \
2345         -label [mc Copy] \
2346         -command {
2347                 clipboard clear
2348                 clipboard append \
2349                         -format STRING \
2350                         -type STRING \
2351                         -- $current_diff_path
2352         }
2353 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2354 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2355
2356 # -- Diff Body
2357 #
2358 frame .vpane.lower.diff.body
2359 set ui_diff .vpane.lower.diff.body.t
2360 text $ui_diff -background white -borderwidth 0 \
2361         -width 80 -height 15 -wrap none \
2362         -font font_diff \
2363         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2364         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2365         -state disabled
2366 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2367         -command [list $ui_diff xview]
2368 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2369         -command [list $ui_diff yview]
2370 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2371 pack .vpane.lower.diff.body.sby -side right -fill y
2372 pack $ui_diff -side left -fill both -expand 1
2373 pack .vpane.lower.diff.header -side top -fill x
2374 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2375
2376 $ui_diff tag conf d_cr -elide true
2377 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2378 $ui_diff tag conf d_+ -foreground {#00a000}
2379 $ui_diff tag conf d_- -foreground red
2380
2381 $ui_diff tag conf d_++ -foreground {#00a000}
2382 $ui_diff tag conf d_-- -foreground red
2383 $ui_diff tag conf d_+s \
2384         -foreground {#00a000} \
2385         -background {#e2effa}
2386 $ui_diff tag conf d_-s \
2387         -foreground red \
2388         -background {#e2effa}
2389 $ui_diff tag conf d_s+ \
2390         -foreground {#00a000} \
2391         -background ivory1
2392 $ui_diff tag conf d_s- \
2393         -foreground red \
2394         -background ivory1
2395
2396 $ui_diff tag conf d<<<<<<< \
2397         -foreground orange \
2398         -font font_diffbold
2399 $ui_diff tag conf d======= \
2400         -foreground orange \
2401         -font font_diffbold
2402 $ui_diff tag conf d>>>>>>> \
2403         -foreground orange \
2404         -font font_diffbold
2405
2406 $ui_diff tag raise sel
2407
2408 # -- Diff Body Context Menu
2409 #
2410 set ctxm .vpane.lower.diff.body.ctxm
2411 menu $ctxm -tearoff 0
2412 $ctxm add command \
2413         -label [mc Refresh] \
2414         -command reshow_diff
2415 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2416 $ctxm add command \
2417         -label [mc Copy] \
2418         -command {tk_textCopy $ui_diff}
2419 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2420 $ctxm add command \
2421         -label [mc "Select All"] \
2422         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2423 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2424 $ctxm add command \
2425         -label [mc "Copy All"] \
2426         -command {
2427                 $ui_diff tag add sel 0.0 end
2428                 tk_textCopy $ui_diff
2429                 $ui_diff tag remove sel 0.0 end
2430         }
2431 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2432 $ctxm add separator
2433 $ctxm add command \
2434         -label [mc "Apply/Reverse Hunk"] \
2435         -command {apply_hunk $cursorX $cursorY}
2436 set ui_diff_applyhunk [$ctxm index last]
2437 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2438 $ctxm add separator
2439 $ctxm add command \
2440         -label [mc "Decrease Font Size"] \
2441         -command {incr_font_size font_diff -1}
2442 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2443 $ctxm add command \
2444         -label [mc "Increase Font Size"] \
2445         -command {incr_font_size font_diff 1}
2446 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2447 $ctxm add separator
2448 $ctxm add command \
2449         -label [mc "Show Less Context"] \
2450         -command {if {$repo_config(gui.diffcontext) >= 1} {
2451                 incr repo_config(gui.diffcontext) -1
2452                 reshow_diff
2453         }}
2454 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2455 $ctxm add command \
2456         -label [mc "Show More Context"] \
2457         -command {if {$repo_config(gui.diffcontext) < 99} {
2458                 incr repo_config(gui.diffcontext)
2459                 reshow_diff
2460         }}
2461 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2462 $ctxm add separator
2463 $ctxm add command -label [mc "Options..."] \
2464         -command do_options
2465 proc popup_diff_menu {ctxm x y X Y} {
2466         global current_diff_path file_states
2467         set ::cursorX $x
2468         set ::cursorY $y
2469         if {$::ui_index eq $::current_diff_side} {
2470                 set l [mc "Unstage Hunk From Commit"]
2471         } else {
2472                 set l [mc "Stage Hunk For Commit"]
2473         }
2474         if {$::is_3way_diff
2475                 || $current_diff_path eq {}
2476                 || ![info exists file_states($current_diff_path)]
2477                 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2478                 set s disabled
2479         } else {
2480                 set s normal
2481         }
2482         $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2483         tk_popup $ctxm $X $Y
2484 }
2485 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2486
2487 # -- Status Bar
2488 #
2489 set main_status [::status_bar::new .status]
2490 pack .status -anchor w -side bottom -fill x
2491 $main_status show [mc "Initializing..."]
2492
2493 # -- Load geometry
2494 #
2495 catch {
2496 set gm $repo_config(gui.geometry)
2497 wm geometry . [lindex $gm 0]
2498 .vpane sash place 0 \
2499         [lindex [.vpane sash coord 0] 0] \
2500         [lindex $gm 1]
2501 .vpane.files sash place 0 \
2502         [lindex $gm 2] \
2503         [lindex [.vpane.files sash coord 0] 1]
2504 unset gm
2505 }
2506
2507 # -- Key Bindings
2508 #
2509 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2510 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2511 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2512 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2513 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2514 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2515 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2516 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2517 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2518 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2519 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2520
2521 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2522 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2523 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2524 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2525 bind $ui_diff <$M1B-Key-v> {break}
2526 bind $ui_diff <$M1B-Key-V> {break}
2527 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2528 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2529 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2530 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2531 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2532 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2533 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2534 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2535 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2536 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2537 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2538 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2539 bind $ui_diff <Button-1>   {focus %W}
2540
2541 if {[is_enabled branch]} {
2542         bind . <$M1B-Key-n> branch_create::dialog
2543         bind . <$M1B-Key-N> branch_create::dialog
2544         bind . <$M1B-Key-o> branch_checkout::dialog
2545         bind . <$M1B-Key-O> branch_checkout::dialog
2546         bind . <$M1B-Key-m> merge::dialog
2547         bind . <$M1B-Key-M> merge::dialog
2548 }
2549 if {[is_enabled transport]} {
2550         bind . <$M1B-Key-p> do_push_anywhere
2551         bind . <$M1B-Key-P> do_push_anywhere
2552 }
2553
2554 bind .   <Key-F5>     do_rescan
2555 bind .   <$M1B-Key-r> do_rescan
2556 bind .   <$M1B-Key-R> do_rescan
2557 bind .   <$M1B-Key-s> do_signoff
2558 bind .   <$M1B-Key-S> do_signoff
2559 bind .   <$M1B-Key-i> do_add_all
2560 bind .   <$M1B-Key-I> do_add_all
2561 bind .   <$M1B-Key-Return> do_commit
2562 foreach i [list $ui_index $ui_workdir] {
2563         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2564         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2565         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2566 }
2567 unset i
2568
2569 set file_lists($ui_index) [list]
2570 set file_lists($ui_workdir) [list]
2571
2572 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2573 focus -force $ui_comm
2574
2575 # -- Warn the user about environmental problems.  Cygwin's Tcl
2576 #    does *not* pass its env array onto any processes it spawns.
2577 #    This means that git processes get none of our environment.
2578 #
2579 if {[is_Cygwin]} {
2580         set ignored_env 0
2581         set suggest_user {}
2582         set msg "Possible environment issues exist.
2583
2584 The following environment variables are probably
2585 going to be ignored by any Git subprocess run
2586 by [appname]:
2587
2588 "
2589         foreach name [array names env] {
2590                 switch -regexp -- $name {
2591                 {^GIT_INDEX_FILE$} -
2592                 {^GIT_OBJECT_DIRECTORY$} -
2593                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2594                 {^GIT_DIFF_OPTS$} -
2595                 {^GIT_EXTERNAL_DIFF$} -
2596                 {^GIT_PAGER$} -
2597                 {^GIT_TRACE$} -
2598                 {^GIT_CONFIG$} -
2599                 {^GIT_CONFIG_LOCAL$} -
2600                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2601                         append msg " - $name\n"
2602                         incr ignored_env
2603                 }
2604                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2605                         append msg " - $name\n"
2606                         incr ignored_env
2607                         set suggest_user $name
2608                 }
2609                 }
2610         }
2611         if {$ignored_env > 0} {
2612                 append msg "
2613 This is due to a known issue with the
2614 Tcl binary distributed by Cygwin."
2615
2616                 if {$suggest_user ne {}} {
2617                         append msg "
2618
2619 A good replacement for $suggest_user
2620 is placing values for the user.name and
2621 user.email settings into your personal
2622 ~/.gitconfig file.
2623 "
2624                 }
2625                 warn_popup $msg
2626         }
2627         unset ignored_env msg suggest_user name
2628 }
2629
2630 # -- Only initialize complex UI if we are going to stay running.
2631 #
2632 if {[is_enabled transport]} {
2633         load_all_remotes
2634
2635         populate_fetch_menu
2636         populate_push_menu
2637 }
2638
2639 if {[winfo exists $ui_comm]} {
2640         set GITGUI_BCK_exists [load_message GITGUI_BCK]
2641
2642         # -- If both our backup and message files exist use the
2643         #    newer of the two files to initialize the buffer.
2644         #
2645         if {$GITGUI_BCK_exists} {
2646                 set m [gitdir GITGUI_MSG]
2647                 if {[file isfile $m]} {
2648                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2649                                 catch {file delete [gitdir GITGUI_MSG]}
2650                         } else {
2651                                 $ui_comm delete 0.0 end
2652                                 $ui_comm edit reset
2653                                 $ui_comm edit modified false
2654                                 catch {file delete [gitdir GITGUI_BCK]}
2655                                 set GITGUI_BCK_exists 0
2656                         }
2657                 }
2658                 unset m
2659         }
2660
2661         proc backup_commit_buffer {} {
2662                 global ui_comm GITGUI_BCK_exists
2663
2664                 set m [$ui_comm edit modified]
2665                 if {$m || $GITGUI_BCK_exists} {
2666                         set msg [string trim [$ui_comm get 0.0 end]]
2667                         regsub -all -line {[ \r\t]+$} $msg {} msg
2668
2669                         if {$msg eq {}} {
2670                                 if {$GITGUI_BCK_exists} {
2671                                         catch {file delete [gitdir GITGUI_BCK]}
2672                                         set GITGUI_BCK_exists 0
2673                                 }
2674                         } elseif {$m} {
2675                                 catch {
2676                                         set fd [open [gitdir GITGUI_BCK] w]
2677                                         puts -nonewline $fd $msg
2678                                         close $fd
2679                                         set GITGUI_BCK_exists 1
2680                                 }
2681                         }
2682
2683                         $ui_comm edit modified false
2684                 }
2685
2686                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2687         }
2688
2689         backup_commit_buffer
2690 }
2691
2692 lock_index begin-read
2693 if {![winfo ismapped .]} {
2694         wm deiconify .
2695 }
2696 after 1 do_rescan
2697 if {[is_enabled multicommit]} {
2698         after 1000 hint_gc
2699 }