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