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