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