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