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