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