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