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