git-gui.sh

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