git-gui.sh

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