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's Files} \
1674         -command {browser::new $current_branch}
1675 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch's Files\" ;#"
1676 .mbar.repository add command \
1677         -label {Browse Branch Files...} \
1678         -command browser_open::dialog
1679 .mbar.repository add separator
1680
1681 .mbar.repository add command \
1682         -label {Visualize Current Branch's History} \
1683         -command {do_gitk $current_branch}
1684 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch's History\" ;#"
1685 .mbar.repository add command \
1686         -label {Visualize All Branch History} \
1687         -command {do_gitk --all}
1688 .mbar.repository add separator
1689
1690 if {[is_enabled multicommit]} {
1691         .mbar.repository add command -label {Database Statistics} \
1692                 -command do_stats
1693
1694         .mbar.repository add command -label {Compress Database} \
1695                 -command do_gc
1696
1697         .mbar.repository add command -label {Verify Database} \
1698                 -command do_fsck_objects
1699
1700         .mbar.repository add separator
1701
1702         if {[is_Cygwin]} {
1703                 .mbar.repository add command \
1704                         -label {Create Desktop Icon} \
1705                         -command do_cygwin_shortcut
1706         } elseif {[is_Windows]} {
1707                 .mbar.repository add command \
1708                         -label {Create Desktop Icon} \
1709                         -command do_windows_shortcut
1710         } elseif {[is_MacOSX]} {
1711                 .mbar.repository add command \
1712                         -label {Create Desktop Icon} \
1713                         -command do_macosx_app
1714         }
1715 }
1716
1717 .mbar.repository add command -label Quit \
1718         -command do_quit \
1719         -accelerator $M1T-Q
1720
1721 # -- Edit Menu
1722 #
1723 menu .mbar.edit
1724 .mbar.edit add command -label Undo \
1725         -command {catch {[focus] edit undo}} \
1726         -accelerator $M1T-Z
1727 .mbar.edit add command -label Redo \
1728         -command {catch {[focus] edit redo}} \
1729         -accelerator $M1T-Y
1730 .mbar.edit add separator
1731 .mbar.edit add command -label Cut \
1732         -command {catch {tk_textCut [focus]}} \
1733         -accelerator $M1T-X
1734 .mbar.edit add command -label Copy \
1735         -command {catch {tk_textCopy [focus]}} \
1736         -accelerator $M1T-C
1737 .mbar.edit add command -label Paste \
1738         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1739         -accelerator $M1T-V
1740 .mbar.edit add command -label Delete \
1741         -command {catch {[focus] delete sel.first sel.last}} \
1742         -accelerator Del
1743 .mbar.edit add separator
1744 .mbar.edit add command -label {Select All} \
1745         -command {catch {[focus] tag add sel 0.0 end}} \
1746         -accelerator $M1T-A
1747
1748 # -- Branch Menu
1749 #
1750 if {[is_enabled branch]} {
1751         menu .mbar.branch
1752
1753         .mbar.branch add command -label {Create...} \
1754                 -command branch_create::dialog \
1755                 -accelerator $M1T-N
1756         lappend disable_on_lock [list .mbar.branch entryconf \
1757                 [.mbar.branch index last] -state]
1758
1759         .mbar.branch add command -label {Checkout...} \
1760                 -command branch_checkout::dialog \
1761                 -accelerator $M1T-O
1762         lappend disable_on_lock [list .mbar.branch entryconf \
1763                 [.mbar.branch index last] -state]
1764
1765         .mbar.branch add command -label {Rename...} \
1766                 -command branch_rename::dialog
1767         lappend disable_on_lock [list .mbar.branch entryconf \
1768                 [.mbar.branch index last] -state]
1769
1770         .mbar.branch add command -label {Delete...} \
1771                 -command branch_delete::dialog
1772         lappend disable_on_lock [list .mbar.branch entryconf \
1773                 [.mbar.branch index last] -state]
1774
1775         .mbar.branch add command -label {Reset...} \
1776                 -command merge::reset_hard
1777         lappend disable_on_lock [list .mbar.branch entryconf \
1778                 [.mbar.branch index last] -state]
1779 }
1780
1781 # -- Commit Menu
1782 #
1783 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1784         menu .mbar.commit
1785
1786         .mbar.commit add radiobutton \
1787                 -label {New Commit} \
1788                 -command do_select_commit_type \
1789                 -variable selected_commit_type \
1790                 -value new
1791         lappend disable_on_lock \
1792                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1793
1794         .mbar.commit add radiobutton \
1795                 -label {Amend Last Commit} \
1796                 -command do_select_commit_type \
1797                 -variable selected_commit_type \
1798                 -value amend
1799         lappend disable_on_lock \
1800                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1801
1802         .mbar.commit add separator
1803
1804         .mbar.commit add command -label Rescan \
1805                 -command do_rescan \
1806                 -accelerator F5
1807         lappend disable_on_lock \
1808                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1809
1810         .mbar.commit add command -label {Add To Commit} \
1811                 -command do_add_selection
1812         lappend disable_on_lock \
1813                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1814
1815         .mbar.commit add command -label {Add Existing To Commit} \
1816                 -command do_add_all \
1817                 -accelerator $M1T-I
1818         lappend disable_on_lock \
1819                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1820
1821         .mbar.commit add command -label {Unstage From Commit} \
1822                 -command do_unstage_selection
1823         lappend disable_on_lock \
1824                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1825
1826         .mbar.commit add command -label {Revert Changes} \
1827                 -command do_revert_selection
1828         lappend disable_on_lock \
1829                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1830
1831         .mbar.commit add separator
1832
1833         .mbar.commit add command -label {Sign Off} \
1834                 -command do_signoff \
1835                 -accelerator $M1T-S
1836
1837         .mbar.commit add command -label Commit \
1838                 -command do_commit \
1839                 -accelerator $M1T-Return
1840         lappend disable_on_lock \
1841                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1842 }
1843
1844 # -- Merge Menu
1845 #
1846 if {[is_enabled branch]} {
1847         menu .mbar.merge
1848         .mbar.merge add command -label {Local Merge...} \
1849                 -command merge::dialog
1850         lappend disable_on_lock \
1851                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1852         .mbar.merge add command -label {Abort Merge...} \
1853                 -command merge::reset_hard
1854         lappend disable_on_lock \
1855                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1856
1857 }
1858
1859 # -- Transport Menu
1860 #
1861 if {[is_enabled transport]} {
1862         menu .mbar.fetch
1863
1864         menu .mbar.push
1865         .mbar.push add command -label {Push...} \
1866                 -command do_push_anywhere \
1867                 -accelerator $M1T-P
1868         .mbar.push add command -label {Delete...} \
1869                 -command remote_branch_delete::dialog
1870 }
1871
1872 if {[is_MacOSX]} {
1873         # -- Apple Menu (Mac OS X only)
1874         #
1875         .mbar add cascade -label Apple -menu .mbar.apple
1876         menu .mbar.apple
1877
1878         .mbar.apple add command -label "About [appname]" \
1879                 -command do_about
1880         .mbar.apple add command -label "Options..." \
1881                 -command do_options
1882 } else {
1883         # -- Edit Menu
1884         #
1885         .mbar.edit add separator
1886         .mbar.edit add command -label {Options...} \
1887                 -command do_options
1888
1889         # -- Tools Menu
1890         #
1891         if {[is_Cygwin]
1892                 && [is_enabled multicommit]
1893                 && [file exists /usr/local/miga/lib/gui-miga]} {
1894         proc do_miga {} {
1895                 if {![lock_index update]} return
1896                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1897                 set miga_fd [open "|$cmd" r]
1898                 fconfigure $miga_fd -blocking 0
1899                 fileevent $miga_fd readable [list miga_done $miga_fd]
1900                 ui_status {Running miga...}
1901         }
1902         proc miga_done {fd} {
1903                 read $fd 512
1904                 if {[eof $fd]} {
1905                         close $fd
1906                         unlock_index
1907                         rescan ui_ready
1908                 }
1909         }
1910         .mbar add cascade -label Tools -menu .mbar.tools
1911         menu .mbar.tools
1912         .mbar.tools add command -label "Migrate" \
1913                 -command do_miga
1914         lappend disable_on_lock \
1915                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
1916         }
1917 }
1918
1919 # -- Help Menu
1920 #
1921 .mbar add cascade -label Help -menu .mbar.help
1922 menu .mbar.help
1923
1924 if {![is_MacOSX]} {
1925         .mbar.help add command -label "About [appname]" \
1926                 -command do_about
1927 }
1928
1929 set browser {}
1930 catch {set browser $repo_config(instaweb.browser)}
1931 set doc_path [file dirname [gitexec]]
1932 set doc_path [file join $doc_path Documentation index.html]
1933
1934 if {[is_Cygwin]} {
1935         set doc_path [exec cygpath --mixed $doc_path]
1936 }
1937
1938 if {$browser eq {}} {
1939         if {[is_MacOSX]} {
1940                 set browser open
1941         } elseif {[is_Cygwin]} {
1942                 set program_files [file dirname [exec cygpath --windir]]
1943                 set program_files [file join $program_files {Program Files}]
1944                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1945                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1946                 if {[file exists $firefox]} {
1947                         set browser $firefox
1948                 } elseif {[file exists $ie]} {
1949                         set browser $ie
1950                 }
1951                 unset program_files firefox ie
1952         }
1953 }
1954
1955 if {[file isfile $doc_path]} {
1956         set doc_url "file:$doc_path"
1957 } else {
1958         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1959 }
1960
1961 if {$browser ne {}} {
1962         .mbar.help add command -label {Online Documentation} \
1963                 -command [list exec $browser $doc_url &]
1964 }
1965 unset browser doc_path doc_url
1966
1967 # -- Standard bindings
1968 #
1969 wm protocol . WM_DELETE_WINDOW do_quit
1970 bind all <$M1B-Key-q> do_quit
1971 bind all <$M1B-Key-Q> do_quit
1972 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1973 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1974
1975 set subcommand_args {}
1976 proc usage {} {
1977         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1978         exit 1
1979 }
1980
1981 # -- Not a normal commit type invocation?  Do that instead!
1982 #
1983 switch -- $subcommand {
1984 browser -
1985 blame {
1986         set subcommand_args {rev? path}
1987         if {$argv eq {}} usage
1988         set head {}
1989         set path {}
1990         set is_path 0
1991         foreach a $argv {
1992                 if {$is_path || [file exists $_prefix$a]} {
1993                         if {$path ne {}} usage
1994                         set path $_prefix$a
1995                         break
1996                 } elseif {$a eq {--}} {
1997                         if {$path ne {}} {
1998                                 if {$head ne {}} usage
1999                                 set head $path
2000                                 set path {}
2001                         }
2002                         set is_path 1
2003                 } elseif {$head eq {}} {
2004                         if {$head ne {}} usage
2005                         set head $a
2006                         set is_path 1
2007                 } else {
2008                         usage
2009                 }
2010         }
2011         unset is_path
2012
2013         if {$head ne {} && $path eq {}} {
2014                 set path $_prefix$head
2015                 set head {}
2016         }
2017
2018         if {$head eq {}} {
2019                 load_current_branch
2020         } else {
2021                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2022                         if {[catch {
2023                                         set head [git rev-parse --verify $head]
2024                                 } err]} {
2025                                 puts stderr $err
2026                                 exit 1
2027                         }
2028                 }
2029                 set current_branch $head
2030         }
2031
2032         switch -- $subcommand {
2033         browser {
2034                 if {$head eq {}} {
2035                         if {$path ne {} && [file isdirectory $path]} {
2036                                 set head $current_branch
2037                         } else {
2038                                 set head $path
2039                                 set path {}
2040                         }
2041                 }
2042                 browser::new $head $path
2043         }
2044         blame   {
2045                 if {$head eq {} && ![file exists $path]} {
2046                         puts stderr "fatal: cannot stat path $path: No such file or directory"
2047                         exit 1
2048                 }
2049                 blame::new $head $path
2050         }
2051         }
2052         return
2053 }
2054 citool -
2055 gui {
2056         if {[llength $argv] != 0} {
2057                 puts -nonewline stderr "usage: $argv0"
2058                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2059                         puts -nonewline stderr " $subcommand"
2060                 }
2061                 puts stderr {}
2062                 exit 1
2063         }
2064         # fall through to setup UI for commits
2065 }
2066 default {
2067         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2068         exit 1
2069 }
2070 }
2071
2072 # -- Branch Control
2073 #
2074 frame .branch \
2075         -borderwidth 1 \
2076         -relief sunken
2077 label .branch.l1 \
2078         -text {Current Branch:} \
2079         -anchor w \
2080         -justify left
2081 label .branch.cb \
2082         -textvariable current_branch \
2083         -anchor w \
2084         -justify left
2085 pack .branch.l1 -side left
2086 pack .branch.cb -side left -fill x
2087 pack .branch -side top -fill x
2088
2089 # -- Main Window Layout
2090 #
2091 panedwindow .vpane -orient vertical
2092 panedwindow .vpane.files -orient horizontal
2093 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2094 pack .vpane -anchor n -side top -fill both -expand 1
2095
2096 # -- Index File List
2097 #
2098 frame .vpane.files.index -height 100 -width 200
2099 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2100         -background lightgreen
2101 text $ui_index -background white -borderwidth 0 \
2102         -width 20 -height 10 \
2103         -wrap none \
2104         -cursor $cursor_ptr \
2105         -xscrollcommand {.vpane.files.index.sx set} \
2106         -yscrollcommand {.vpane.files.index.sy set} \
2107         -state disabled
2108 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2109 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2110 pack .vpane.files.index.title -side top -fill x
2111 pack .vpane.files.index.sx -side bottom -fill x
2112 pack .vpane.files.index.sy -side right -fill y
2113 pack $ui_index -side left -fill both -expand 1
2114 .vpane.files add .vpane.files.index -sticky nsew
2115
2116 # -- Working Directory File List
2117 #
2118 frame .vpane.files.workdir -height 100 -width 200
2119 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2120         -background lightsalmon
2121 text $ui_workdir -background white -borderwidth 0 \
2122         -width 20 -height 10 \
2123         -wrap none \
2124         -cursor $cursor_ptr \
2125         -xscrollcommand {.vpane.files.workdir.sx set} \
2126         -yscrollcommand {.vpane.files.workdir.sy set} \
2127         -state disabled
2128 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2129 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2130 pack .vpane.files.workdir.title -side top -fill x
2131 pack .vpane.files.workdir.sx -side bottom -fill x
2132 pack .vpane.files.workdir.sy -side right -fill y
2133 pack $ui_workdir -side left -fill both -expand 1
2134 .vpane.files add .vpane.files.workdir -sticky nsew
2135
2136 foreach i [list $ui_index $ui_workdir] {
2137         $i tag conf in_diff -background lightgray
2138         $i tag conf in_sel  -background lightgray
2139 }
2140 unset i
2141
2142 # -- Diff and Commit Area
2143 #
2144 frame .vpane.lower -height 300 -width 400
2145 frame .vpane.lower.commarea
2146 frame .vpane.lower.diff -relief sunken -borderwidth 1
2147 pack .vpane.lower.commarea -side top -fill x
2148 pack .vpane.lower.diff -side bottom -fill both -expand 1
2149 .vpane add .vpane.lower -sticky nsew
2150
2151 # -- Commit Area Buttons
2152 #
2153 frame .vpane.lower.commarea.buttons
2154 label .vpane.lower.commarea.buttons.l -text {} \
2155         -anchor w \
2156         -justify left
2157 pack .vpane.lower.commarea.buttons.l -side top -fill x
2158 pack .vpane.lower.commarea.buttons -side left -fill y
2159
2160 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2161         -command do_rescan
2162 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2163 lappend disable_on_lock \
2164         {.vpane.lower.commarea.buttons.rescan conf -state}
2165
2166 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
2167         -command do_add_all
2168 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2169 lappend disable_on_lock \
2170         {.vpane.lower.commarea.buttons.incall conf -state}
2171
2172 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2173         -command do_signoff
2174 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2175
2176 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2177         -command do_commit
2178 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2179 lappend disable_on_lock \
2180         {.vpane.lower.commarea.buttons.commit conf -state}
2181
2182 button .vpane.lower.commarea.buttons.push -text {Push} \
2183         -command do_push_anywhere
2184 pack .vpane.lower.commarea.buttons.push -side top -fill x
2185
2186 # -- Commit Message Buffer
2187 #
2188 frame .vpane.lower.commarea.buffer
2189 frame .vpane.lower.commarea.buffer.header
2190 set ui_comm .vpane.lower.commarea.buffer.t
2191 set ui_coml .vpane.lower.commarea.buffer.header.l
2192 radiobutton .vpane.lower.commarea.buffer.header.new \
2193         -text {New Commit} \
2194         -command do_select_commit_type \
2195         -variable selected_commit_type \
2196         -value new
2197 lappend disable_on_lock \
2198         [list .vpane.lower.commarea.buffer.header.new conf -state]
2199 radiobutton .vpane.lower.commarea.buffer.header.amend \
2200         -text {Amend Last Commit} \
2201         -command do_select_commit_type \
2202         -variable selected_commit_type \
2203         -value amend
2204 lappend disable_on_lock \
2205         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2206 label $ui_coml \
2207         -anchor w \
2208         -justify left
2209 proc trace_commit_type {varname args} {
2210         global ui_coml commit_type
2211         switch -glob -- $commit_type {
2212         initial       {set txt {Initial Commit Message:}}
2213         amend         {set txt {Amended Commit Message:}}
2214         amend-initial {set txt {Amended Initial Commit Message:}}
2215         amend-merge   {set txt {Amended Merge Commit Message:}}
2216         merge         {set txt {Merge Commit Message:}}
2217         *             {set txt {Commit Message:}}
2218         }
2219         $ui_coml conf -text $txt
2220 }
2221 trace add variable commit_type write trace_commit_type
2222 pack $ui_coml -side left -fill x
2223 pack .vpane.lower.commarea.buffer.header.amend -side right
2224 pack .vpane.lower.commarea.buffer.header.new -side right
2225
2226 text $ui_comm -background white -borderwidth 1 \
2227         -undo true \
2228         -maxundo 20 \
2229         -autoseparators true \
2230         -relief sunken \
2231         -width 75 -height 9 -wrap none \
2232         -font font_diff \
2233         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2234 scrollbar .vpane.lower.commarea.buffer.sby \
2235         -command [list $ui_comm yview]
2236 pack .vpane.lower.commarea.buffer.header -side top -fill x
2237 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2238 pack $ui_comm -side left -fill y
2239 pack .vpane.lower.commarea.buffer -side left -fill y
2240
2241 # -- Commit Message Buffer Context Menu
2242 #
2243 set ctxm .vpane.lower.commarea.buffer.ctxm
2244 menu $ctxm -tearoff 0
2245 $ctxm add command \
2246         -label {Cut} \
2247         -command {tk_textCut $ui_comm}
2248 $ctxm add command \
2249         -label {Copy} \
2250         -command {tk_textCopy $ui_comm}
2251 $ctxm add command \
2252         -label {Paste} \
2253         -command {tk_textPaste $ui_comm}
2254 $ctxm add command \
2255         -label {Delete} \
2256         -command {$ui_comm delete sel.first sel.last}
2257 $ctxm add separator
2258 $ctxm add command \
2259         -label {Select All} \
2260         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2261 $ctxm add command \
2262         -label {Copy All} \
2263         -command {
2264                 $ui_comm tag add sel 0.0 end
2265                 tk_textCopy $ui_comm
2266                 $ui_comm tag remove sel 0.0 end
2267         }
2268 $ctxm add separator
2269 $ctxm add command \
2270         -label {Sign Off} \
2271         -command do_signoff
2272 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2273
2274 # -- Diff Header
2275 #
2276 proc trace_current_diff_path {varname args} {
2277         global current_diff_path diff_actions file_states
2278         if {$current_diff_path eq {}} {
2279                 set s {}
2280                 set f {}
2281                 set p {}
2282                 set o disabled
2283         } else {
2284                 set p $current_diff_path
2285                 set s [mapdesc [lindex $file_states($p) 0] $p]
2286                 set f {File:}
2287                 set p [escape_path $p]
2288                 set o normal
2289         }
2290
2291         .vpane.lower.diff.header.status configure -text $s
2292         .vpane.lower.diff.header.file configure -text $f
2293         .vpane.lower.diff.header.path configure -text $p
2294         foreach w $diff_actions {
2295                 uplevel #0 $w $o
2296         }
2297 }
2298 trace add variable current_diff_path write trace_current_diff_path
2299
2300 frame .vpane.lower.diff.header -background gold
2301 label .vpane.lower.diff.header.status \
2302         -background gold \
2303         -width $max_status_desc \
2304         -anchor w \
2305         -justify left
2306 label .vpane.lower.diff.header.file \
2307         -background gold \
2308         -anchor w \
2309         -justify left
2310 label .vpane.lower.diff.header.path \
2311         -background gold \
2312         -anchor w \
2313         -justify left
2314 pack .vpane.lower.diff.header.status -side left
2315 pack .vpane.lower.diff.header.file -side left
2316 pack .vpane.lower.diff.header.path -fill x
2317 set ctxm .vpane.lower.diff.header.ctxm
2318 menu $ctxm -tearoff 0
2319 $ctxm add command \
2320         -label {Copy} \
2321         -command {
2322                 clipboard clear
2323                 clipboard append \
2324                         -format STRING \
2325                         -type STRING \
2326                         -- $current_diff_path
2327         }
2328 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2329 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2330
2331 # -- Diff Body
2332 #
2333 frame .vpane.lower.diff.body
2334 set ui_diff .vpane.lower.diff.body.t
2335 text $ui_diff -background white -borderwidth 0 \
2336         -width 80 -height 15 -wrap none \
2337         -font font_diff \
2338         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2339         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2340         -state disabled
2341 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2342         -command [list $ui_diff xview]
2343 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2344         -command [list $ui_diff yview]
2345 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2346 pack .vpane.lower.diff.body.sby -side right -fill y
2347 pack $ui_diff -side left -fill both -expand 1
2348 pack .vpane.lower.diff.header -side top -fill x
2349 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2350
2351 $ui_diff tag conf d_cr -elide true
2352 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2353 $ui_diff tag conf d_+ -foreground {#00a000}
2354 $ui_diff tag conf d_- -foreground red
2355
2356 $ui_diff tag conf d_++ -foreground {#00a000}
2357 $ui_diff tag conf d_-- -foreground red
2358 $ui_diff tag conf d_+s \
2359         -foreground {#00a000} \
2360         -background {#e2effa}
2361 $ui_diff tag conf d_-s \
2362         -foreground red \
2363         -background {#e2effa}
2364 $ui_diff tag conf d_s+ \
2365         -foreground {#00a000} \
2366         -background ivory1
2367 $ui_diff tag conf d_s- \
2368         -foreground red \
2369         -background ivory1
2370
2371 $ui_diff tag conf d<<<<<<< \
2372         -foreground orange \
2373         -font font_diffbold
2374 $ui_diff tag conf d======= \
2375         -foreground orange \
2376         -font font_diffbold
2377 $ui_diff tag conf d>>>>>>> \
2378         -foreground orange \
2379         -font font_diffbold
2380
2381 $ui_diff tag raise sel
2382
2383 # -- Diff Body Context Menu
2384 #
2385 set ctxm .vpane.lower.diff.body.ctxm
2386 menu $ctxm -tearoff 0
2387 $ctxm add command \
2388         -label {Refresh} \
2389         -command reshow_diff
2390 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2391 $ctxm add command \
2392         -label {Copy} \
2393         -command {tk_textCopy $ui_diff}
2394 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2395 $ctxm add command \
2396         -label {Select All} \
2397         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2398 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2399 $ctxm add command \
2400         -label {Copy All} \
2401         -command {
2402                 $ui_diff tag add sel 0.0 end
2403                 tk_textCopy $ui_diff
2404                 $ui_diff tag remove sel 0.0 end
2405         }
2406 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2407 $ctxm add separator
2408 $ctxm add command \
2409         -label {Apply/Reverse Hunk} \
2410         -command {apply_hunk $cursorX $cursorY}
2411 set ui_diff_applyhunk [$ctxm index last]
2412 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2413 $ctxm add separator
2414 $ctxm add command \
2415         -label {Decrease Font Size} \
2416         -command {incr_font_size font_diff -1}
2417 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2418 $ctxm add command \
2419         -label {Increase Font Size} \
2420         -command {incr_font_size font_diff 1}
2421 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2422 $ctxm add separator
2423 $ctxm add command \
2424         -label {Show Less Context} \
2425         -command {if {$repo_config(gui.diffcontext) >= 1} {
2426                 incr repo_config(gui.diffcontext) -1
2427                 reshow_diff
2428         }}
2429 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2430 $ctxm add command \
2431         -label {Show More Context} \
2432         -command {if {$repo_config(gui.diffcontext) < 99} {
2433                 incr repo_config(gui.diffcontext)
2434                 reshow_diff
2435         }}
2436 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2437 $ctxm add separator
2438 $ctxm add command -label {Options...} \
2439         -command do_options
2440 bind_button3 $ui_diff "
2441         set cursorX %x
2442         set cursorY %y
2443         if {\$ui_index eq \$current_diff_side} {
2444                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2445         } else {
2446                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2447         }
2448         tk_popup $ctxm %X %Y
2449 "
2450 unset ui_diff_applyhunk
2451
2452 # -- Status Bar
2453 #
2454 set main_status [::status_bar::new .status]
2455 pack .status -anchor w -side bottom -fill x
2456 $main_status show {Initializing...}
2457
2458 # -- Load geometry
2459 #
2460 catch {
2461 set gm $repo_config(gui.geometry)
2462 wm geometry . [lindex $gm 0]
2463 .vpane sash place 0 \
2464         [lindex [.vpane sash coord 0] 0] \
2465         [lindex $gm 1]
2466 .vpane.files sash place 0 \
2467         [lindex $gm 2] \
2468         [lindex [.vpane.files sash coord 0] 1]
2469 unset gm
2470 }
2471
2472 # -- Key Bindings
2473 #
2474 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2475 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2476 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2477 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2478 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2479 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2480 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2481 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2482 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2483 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2484 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2485
2486 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2487 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2488 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2489 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2490 bind $ui_diff <$M1B-Key-v> {break}
2491 bind $ui_diff <$M1B-Key-V> {break}
2492 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2493 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2494 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2495 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2496 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2497 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2498 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2499 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2500 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2501 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2502 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2503 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2504 bind $ui_diff <Button-1>   {focus %W}
2505
2506 if {[is_enabled branch]} {
2507         bind . <$M1B-Key-n> branch_create::dialog
2508         bind . <$M1B-Key-N> branch_create::dialog
2509         bind . <$M1B-Key-o> branch_checkout::dialog
2510         bind . <$M1B-Key-O> branch_checkout::dialog
2511 }
2512 if {[is_enabled transport]} {
2513         bind . <$M1B-Key-p> do_push_anywhere
2514         bind . <$M1B-Key-P> do_push_anywhere
2515 }
2516
2517 bind .   <Key-F5>     do_rescan
2518 bind .   <$M1B-Key-r> do_rescan
2519 bind .   <$M1B-Key-R> do_rescan
2520 bind .   <$M1B-Key-s> do_signoff
2521 bind .   <$M1B-Key-S> do_signoff
2522 bind .   <$M1B-Key-i> do_add_all
2523 bind .   <$M1B-Key-I> do_add_all
2524 bind .   <$M1B-Key-Return> do_commit
2525 foreach i [list $ui_index $ui_workdir] {
2526         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2527         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2528         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2529 }
2530 unset i
2531
2532 set file_lists($ui_index) [list]
2533 set file_lists($ui_workdir) [list]
2534
2535 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2536 focus -force $ui_comm
2537
2538 # -- Warn the user about environmental problems.  Cygwin's Tcl
2539 #    does *not* pass its env array onto any processes it spawns.
2540 #    This means that git processes get none of our environment.
2541 #
2542 if {[is_Cygwin]} {
2543         set ignored_env 0
2544         set suggest_user {}
2545         set msg "Possible environment issues exist.
2546
2547 The following environment variables are probably
2548 going to be ignored by any Git subprocess run
2549 by [appname]:
2550
2551 "
2552         foreach name [array names env] {
2553                 switch -regexp -- $name {
2554                 {^GIT_INDEX_FILE$} -
2555                 {^GIT_OBJECT_DIRECTORY$} -
2556                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2557                 {^GIT_DIFF_OPTS$} -
2558                 {^GIT_EXTERNAL_DIFF$} -
2559                 {^GIT_PAGER$} -
2560                 {^GIT_TRACE$} -
2561                 {^GIT_CONFIG$} -
2562                 {^GIT_CONFIG_LOCAL$} -
2563                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2564                         append msg " - $name\n"
2565                         incr ignored_env
2566                 }
2567                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2568                         append msg " - $name\n"
2569                         incr ignored_env
2570                         set suggest_user $name
2571                 }
2572                 }
2573         }
2574         if {$ignored_env > 0} {
2575                 append msg "
2576 This is due to a known issue with the
2577 Tcl binary distributed by Cygwin."
2578
2579                 if {$suggest_user ne {}} {
2580                         append msg "
2581
2582 A good replacement for $suggest_user
2583 is placing values for the user.name and
2584 user.email settings into your personal
2585 ~/.gitconfig file.
2586 "
2587                 }
2588                 warn_popup $msg
2589         }
2590         unset ignored_env msg suggest_user name
2591 }
2592
2593 # -- Only initialize complex UI if we are going to stay running.
2594 #
2595 if {[is_enabled transport]} {
2596         load_all_remotes
2597
2598         populate_fetch_menu
2599         populate_push_menu
2600 }
2601
2602 lock_index begin-read
2603 if {![winfo ismapped .]} {
2604         wm deiconify .
2605 }
2606 after 1 do_rescan
2607 if {[is_enabled multicommit]} {
2608         after 1000 hint_gc
2609 }