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