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