git-gui.sh

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