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