git-gui.sh

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