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