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

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