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