git-gui.sh

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