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