git-gui.sh

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