git-gui.sh

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