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