git-gui.sh

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