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