git-gui.sh

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