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