git.oblomov.eu Git - git/blob - git-gui.sh

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