git-gui.sh

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