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