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         global env starting_gitk_msg
1307
1308         # -- Always start gitk through whatever we were loaded with.  This
1309         #    lets us bypass using shell process on Windows systems.
1310         #
1311         set cmd [list [info nameofexecutable]]
1312         set exe [gitexec gitk]
1313         lappend cmd $exe
1314         if {$revs ne {}} {
1315                 append cmd { }
1316                 append cmd $revs
1317         }
1318
1319         if {! [file exists $exe]} {
1320                 error_popup "Unable to start gitk:\n\n$exe does not exist"
1321         } else {
1322                 eval exec $cmd &
1323                 ui_status $starting_gitk_msg
1324                 after 10000 {
1325                         ui_ready $starting_gitk_msg
1326                 }
1327         }
1328 }
1329
1330 set is_quitting 0
1331
1332 proc do_quit {} {
1333         global ui_comm is_quitting repo_config commit_type
1334
1335         if {$is_quitting} return
1336         set is_quitting 1
1337
1338         if {[winfo exists $ui_comm]} {
1339                 # -- Stash our current commit buffer.
1340                 #
1341                 set save [gitdir GITGUI_MSG]
1342                 set msg [string trim [$ui_comm get 0.0 end]]
1343                 regsub -all -line {[ \r\t]+$} $msg {} msg
1344                 if {(![string match amend* $commit_type]
1345                         || [$ui_comm edit modified])
1346                         && $msg ne {}} {
1347                         catch {
1348                                 set fd [open $save w]
1349                                 puts -nonewline $fd $msg
1350                                 close $fd
1351                         }
1352                 } else {
1353                         catch {file delete $save}
1354                 }
1355
1356                 # -- Stash our current window geometry into this repository.
1357                 #
1358                 set cfg_geometry [list]
1359                 lappend cfg_geometry [wm geometry .]
1360                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1361                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1362                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1363                         set rc_geometry {}
1364                 }
1365                 if {$cfg_geometry ne $rc_geometry} {
1366                         catch {git config gui.geometry $cfg_geometry}
1367                 }
1368         }
1369
1370         destroy .
1371 }
1372
1373 proc do_rescan {} {
1374         rescan ui_ready
1375 }
1376
1377 proc do_commit {} {
1378         commit_tree
1379 }
1380
1381 proc toggle_or_diff {w x y} {
1382         global file_states file_lists current_diff_path ui_index ui_workdir
1383         global last_clicked selected_paths
1384
1385         set pos [split [$w index @$x,$y] .]
1386         set lno [lindex $pos 0]
1387         set col [lindex $pos 1]
1388         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1389         if {$path eq {}} {
1390                 set last_clicked {}
1391                 return
1392         }
1393
1394         set last_clicked [list $w $lno]
1395         array unset selected_paths
1396         $ui_index tag remove in_sel 0.0 end
1397         $ui_workdir tag remove in_sel 0.0 end
1398
1399         if {$col == 0} {
1400                 if {$current_diff_path eq $path} {
1401                         set after {reshow_diff;}
1402                 } else {
1403                         set after {}
1404                 }
1405                 if {$w eq $ui_index} {
1406                         update_indexinfo \
1407                                 "Unstaging [short_path $path] from commit" \
1408                                 [list $path] \
1409                                 [concat $after [list ui_ready]]
1410                 } elseif {$w eq $ui_workdir} {
1411                         update_index \
1412                                 "Adding [short_path $path]" \
1413                                 [list $path] \
1414                                 [concat $after [list ui_ready]]
1415                 }
1416         } else {
1417                 show_diff $path $w $lno
1418         }
1419 }
1420
1421 proc add_one_to_selection {w x y} {
1422         global file_lists last_clicked selected_paths
1423
1424         set lno [lindex [split [$w index @$x,$y] .] 0]
1425         set path [lindex $file_lists($w) [expr {$lno - 1}]]
1426         if {$path eq {}} {
1427                 set last_clicked {}
1428                 return
1429         }
1430
1431         if {$last_clicked ne {}
1432                 && [lindex $last_clicked 0] ne $w} {
1433                 array unset selected_paths
1434                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1435         }
1436
1437         set last_clicked [list $w $lno]
1438         if {[catch {set in_sel $selected_paths($path)}]} {
1439                 set in_sel 0
1440         }
1441         if {$in_sel} {
1442                 unset selected_paths($path)
1443                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1444         } else {
1445                 set selected_paths($path) 1
1446                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1447         }
1448 }
1449
1450 proc add_range_to_selection {w x y} {
1451         global file_lists last_clicked selected_paths
1452
1453         if {[lindex $last_clicked 0] ne $w} {
1454                 toggle_or_diff $w $x $y
1455                 return
1456         }
1457
1458         set lno [lindex [split [$w index @$x,$y] .] 0]
1459         set lc [lindex $last_clicked 1]
1460         if {$lc < $lno} {
1461                 set begin $lc
1462                 set end $lno
1463         } else {
1464                 set begin $lno
1465                 set end $lc
1466         }
1467
1468         foreach path [lrange $file_lists($w) \
1469                 [expr {$begin - 1}] \
1470                 [expr {$end - 1}]] {
1471                 set selected_paths($path) 1
1472         }
1473         $w tag add in_sel $begin.0 [expr {$end + 1}].0
1474 }
1475
1476 ######################################################################
1477 ##
1478 ## config defaults
1479
1480 set cursor_ptr arrow
1481 font create font_diff -family Courier -size 10
1482 font create font_ui
1483 catch {
1484         label .dummy
1485         eval font configure font_ui [font actual [.dummy cget -font]]
1486         destroy .dummy
1487 }
1488
1489 font create font_uiitalic
1490 font create font_uibold
1491 font create font_diffbold
1492 font create font_diffitalic
1493
1494 foreach class {Button Checkbutton Entry Label
1495                 Labelframe Listbox Menu Message
1496                 Radiobutton Spinbox Text} {
1497         option add *$class.font font_ui
1498 }
1499 unset class
1500
1501 if {[is_Windows] || [is_MacOSX]} {
1502         option add *Menu.tearOff 0
1503 }
1504
1505 if {[is_MacOSX]} {
1506         set M1B M1
1507         set M1T Cmd
1508 } else {
1509         set M1B Control
1510         set M1T Ctrl
1511 }
1512
1513 proc apply_config {} {
1514         global repo_config font_descs
1515
1516         foreach option $font_descs {
1517                 set name [lindex $option 0]
1518                 set font [lindex $option 1]
1519                 if {[catch {
1520                         foreach {cn cv} $repo_config(gui.$name) {
1521                                 font configure $font $cn $cv
1522                         }
1523                         } err]} {
1524                         error_popup "Invalid font specified in gui.$name:\n\n$err"
1525                 }
1526                 foreach {cn cv} [font configure $font] {
1527                         font configure ${font}bold $cn $cv
1528                         font configure ${font}italic $cn $cv
1529                 }
1530                 font configure ${font}bold -weight bold
1531                 font configure ${font}italic -slant italic
1532         }
1533 }
1534
1535 set default_config(merge.diffstat) true
1536 set default_config(merge.summary) false
1537 set default_config(merge.verbosity) 2
1538 set default_config(user.name) {}
1539 set default_config(user.email) {}
1540
1541 set default_config(gui.matchtrackingbranch) false
1542 set default_config(gui.pruneduringfetch) false
1543 set default_config(gui.trustmtime) false
1544 set default_config(gui.diffcontext) 5
1545 set default_config(gui.newbranchtemplate) {}
1546 set default_config(gui.fontui) [font configure font_ui]
1547 set default_config(gui.fontdiff) [font configure font_diff]
1548 set font_descs {
1549         {fontui   font_ui   {Main Font}}
1550         {fontdiff font_diff {Diff/Console Font}}
1551 }
1552 load_config 0
1553 apply_config
1554
1555 ######################################################################
1556 ##
1557 ## feature option selection
1558
1559 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
1560         unset _junk
1561 } else {
1562         set subcommand gui
1563 }
1564 if {$subcommand eq {gui.sh}} {
1565         set subcommand gui
1566 }
1567 if {$subcommand eq {gui} && [llength $argv] > 0} {
1568         set subcommand [lindex $argv 0]
1569         set argv [lrange $argv 1 end]
1570 }
1571
1572 enable_option multicommit
1573 enable_option branch
1574 enable_option transport
1575
1576 switch -- $subcommand {
1577 browser -
1578 blame {
1579         disable_option multicommit
1580         disable_option branch
1581         disable_option transport
1582 }
1583 citool {
1584         enable_option singlecommit
1585
1586         disable_option multicommit
1587         disable_option branch
1588         disable_option transport
1589 }
1590 }
1591
1592 ######################################################################
1593 ##
1594 ## ui construction
1595
1596 set ui_comm {}
1597
1598 # -- Menu Bar
1599 #
1600 menu .mbar -tearoff 0
1601 .mbar add cascade -label Repository -menu .mbar.repository
1602 .mbar add cascade -label Edit -menu .mbar.edit
1603 if {[is_enabled branch]} {
1604         .mbar add cascade -label Branch -menu .mbar.branch
1605 }
1606 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1607         .mbar add cascade -label Commit -menu .mbar.commit
1608 }
1609 if {[is_enabled transport]} {
1610         .mbar add cascade -label Merge -menu .mbar.merge
1611         .mbar add cascade -label Fetch -menu .mbar.fetch
1612         .mbar add cascade -label Push -menu .mbar.push
1613 }
1614 . configure -menu .mbar
1615
1616 # -- Repository Menu
1617 #
1618 menu .mbar.repository
1619
1620 .mbar.repository add command \
1621         -label {Browse Current Branch} \
1622         -command {browser::new $current_branch}
1623 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1624 .mbar.repository add separator
1625
1626 .mbar.repository add command \
1627         -label {Visualize Current Branch} \
1628         -command {do_gitk $current_branch}
1629 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1630 .mbar.repository add command \
1631         -label {Visualize All Branches} \
1632         -command {do_gitk --all}
1633 .mbar.repository add separator
1634
1635 if {[is_enabled multicommit]} {
1636         .mbar.repository add command -label {Database Statistics} \
1637                 -command do_stats
1638
1639         .mbar.repository add command -label {Compress Database} \
1640                 -command do_gc
1641
1642         .mbar.repository add command -label {Verify Database} \
1643                 -command do_fsck_objects
1644
1645         .mbar.repository add separator
1646
1647         if {[is_Cygwin]} {
1648                 .mbar.repository add command \
1649                         -label {Create Desktop Icon} \
1650                         -command do_cygwin_shortcut
1651         } elseif {[is_Windows]} {
1652                 .mbar.repository add command \
1653                         -label {Create Desktop Icon} \
1654                         -command do_windows_shortcut
1655         } elseif {[is_MacOSX]} {
1656                 .mbar.repository add command \
1657                         -label {Create Desktop Icon} \
1658                         -command do_macosx_app
1659         }
1660 }
1661
1662 .mbar.repository add command -label Quit \
1663         -command do_quit \
1664         -accelerator $M1T-Q
1665
1666 # -- Edit Menu
1667 #
1668 menu .mbar.edit
1669 .mbar.edit add command -label Undo \
1670         -command {catch {[focus] edit undo}} \
1671         -accelerator $M1T-Z
1672 .mbar.edit add command -label Redo \
1673         -command {catch {[focus] edit redo}} \
1674         -accelerator $M1T-Y
1675 .mbar.edit add separator
1676 .mbar.edit add command -label Cut \
1677         -command {catch {tk_textCut [focus]}} \
1678         -accelerator $M1T-X
1679 .mbar.edit add command -label Copy \
1680         -command {catch {tk_textCopy [focus]}} \
1681         -accelerator $M1T-C
1682 .mbar.edit add command -label Paste \
1683         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1684         -accelerator $M1T-V
1685 .mbar.edit add command -label Delete \
1686         -command {catch {[focus] delete sel.first sel.last}} \
1687         -accelerator Del
1688 .mbar.edit add separator
1689 .mbar.edit add command -label {Select All} \
1690         -command {catch {[focus] tag add sel 0.0 end}} \
1691         -accelerator $M1T-A
1692
1693 # -- Branch Menu
1694 #
1695 if {[is_enabled branch]} {
1696         menu .mbar.branch
1697
1698         .mbar.branch add command -label {Create...} \
1699                 -command branch_create::dialog \
1700                 -accelerator $M1T-N
1701         lappend disable_on_lock [list .mbar.branch entryconf \
1702                 [.mbar.branch index last] -state]
1703
1704         .mbar.branch add command -label {Checkout...} \
1705                 -command branch_checkout::dialog \
1706                 -accelerator $M1T-O
1707         lappend disable_on_lock [list .mbar.branch entryconf \
1708                 [.mbar.branch index last] -state]
1709
1710         .mbar.branch add command -label {Rename...} \
1711                 -command branch_rename::dialog
1712         lappend disable_on_lock [list .mbar.branch entryconf \
1713                 [.mbar.branch index last] -state]
1714
1715         .mbar.branch add command -label {Delete...} \
1716                 -command branch_delete::dialog
1717         lappend disable_on_lock [list .mbar.branch entryconf \
1718                 [.mbar.branch index last] -state]
1719
1720         .mbar.branch add command -label {Reset...} \
1721                 -command merge::reset_hard
1722         lappend disable_on_lock [list .mbar.branch entryconf \
1723                 [.mbar.branch index last] -state]
1724 }
1725
1726 # -- Commit Menu
1727 #
1728 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1729         menu .mbar.commit
1730
1731         .mbar.commit add radiobutton \
1732                 -label {New Commit} \
1733                 -command do_select_commit_type \
1734                 -variable selected_commit_type \
1735                 -value new
1736         lappend disable_on_lock \
1737                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1738
1739         .mbar.commit add radiobutton \
1740                 -label {Amend Last Commit} \
1741                 -command do_select_commit_type \
1742                 -variable selected_commit_type \
1743                 -value amend
1744         lappend disable_on_lock \
1745                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1746
1747         .mbar.commit add separator
1748
1749         .mbar.commit add command -label Rescan \
1750                 -command do_rescan \
1751                 -accelerator F5
1752         lappend disable_on_lock \
1753                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1754
1755         .mbar.commit add command -label {Add To Commit} \
1756                 -command do_add_selection
1757         lappend disable_on_lock \
1758                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1759
1760         .mbar.commit add command -label {Add Existing To Commit} \
1761                 -command do_add_all \
1762                 -accelerator $M1T-I
1763         lappend disable_on_lock \
1764                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1765
1766         .mbar.commit add command -label {Unstage From Commit} \
1767                 -command do_unstage_selection
1768         lappend disable_on_lock \
1769                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1770
1771         .mbar.commit add command -label {Revert Changes} \
1772                 -command do_revert_selection
1773         lappend disable_on_lock \
1774                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1775
1776         .mbar.commit add separator
1777
1778         .mbar.commit add command -label {Sign Off} \
1779                 -command do_signoff \
1780                 -accelerator $M1T-S
1781
1782         .mbar.commit add command -label Commit \
1783                 -command do_commit \
1784                 -accelerator $M1T-Return
1785         lappend disable_on_lock \
1786                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1787 }
1788
1789 # -- Merge Menu
1790 #
1791 if {[is_enabled branch]} {
1792         menu .mbar.merge
1793         .mbar.merge add command -label {Local Merge...} \
1794                 -command merge::dialog
1795         lappend disable_on_lock \
1796                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1797         .mbar.merge add command -label {Abort Merge...} \
1798                 -command merge::reset_hard
1799         lappend disable_on_lock \
1800                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1801
1802 }
1803
1804 # -- Transport Menu
1805 #
1806 if {[is_enabled transport]} {
1807         menu .mbar.fetch
1808
1809         menu .mbar.push
1810         .mbar.push add command -label {Push...} \
1811                 -command do_push_anywhere \
1812                 -accelerator $M1T-P
1813         .mbar.push add command -label {Delete...} \
1814                 -command remote_branch_delete::dialog
1815 }
1816
1817 if {[is_MacOSX]} {
1818         # -- Apple Menu (Mac OS X only)
1819         #
1820         .mbar add cascade -label Apple -menu .mbar.apple
1821         menu .mbar.apple
1822
1823         .mbar.apple add command -label "About [appname]" \
1824                 -command do_about
1825         .mbar.apple add command -label "Options..." \
1826                 -command do_options
1827 } else {
1828         # -- Edit Menu
1829         #
1830         .mbar.edit add separator
1831         .mbar.edit add command -label {Options...} \
1832                 -command do_options
1833
1834         # -- Tools Menu
1835         #
1836         if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
1837         proc do_miga {} {
1838                 if {![lock_index update]} return
1839                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1840                 set miga_fd [open "|$cmd" r]
1841                 fconfigure $miga_fd -blocking 0
1842                 fileevent $miga_fd readable [list miga_done $miga_fd]
1843                 ui_status {Running miga...}
1844         }
1845         proc miga_done {fd} {
1846                 read $fd 512
1847                 if {[eof $fd]} {
1848                         close $fd
1849                         unlock_index
1850                         rescan ui_ready
1851                 }
1852         }
1853         .mbar add cascade -label Tools -menu .mbar.tools
1854         menu .mbar.tools
1855         .mbar.tools add command -label "Migrate" \
1856                 -command do_miga
1857         lappend disable_on_lock \
1858                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
1859         }
1860 }
1861
1862 # -- Help Menu
1863 #
1864 .mbar add cascade -label Help -menu .mbar.help
1865 menu .mbar.help
1866
1867 if {![is_MacOSX]} {
1868         .mbar.help add command -label "About [appname]" \
1869                 -command do_about
1870 }
1871
1872 set browser {}
1873 catch {set browser $repo_config(instaweb.browser)}
1874 set doc_path [file dirname [gitexec]]
1875 set doc_path [file join $doc_path Documentation index.html]
1876
1877 if {[is_Cygwin]} {
1878         set doc_path [exec cygpath --mixed $doc_path]
1879 }
1880
1881 if {$browser eq {}} {
1882         if {[is_MacOSX]} {
1883                 set browser open
1884         } elseif {[is_Cygwin]} {
1885                 set program_files [file dirname [exec cygpath --windir]]
1886                 set program_files [file join $program_files {Program Files}]
1887                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1888                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1889                 if {[file exists $firefox]} {
1890                         set browser $firefox
1891                 } elseif {[file exists $ie]} {
1892                         set browser $ie
1893                 }
1894                 unset program_files firefox ie
1895         }
1896 }
1897
1898 if {[file isfile $doc_path]} {
1899         set doc_url "file:$doc_path"
1900 } else {
1901         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1902 }
1903
1904 if {$browser ne {}} {
1905         .mbar.help add command -label {Online Documentation} \
1906                 -command [list exec $browser $doc_url &]
1907 }
1908 unset browser doc_path doc_url
1909
1910 # -- Standard bindings
1911 #
1912 wm protocol . WM_DELETE_WINDOW do_quit
1913 bind all <$M1B-Key-q> do_quit
1914 bind all <$M1B-Key-Q> do_quit
1915 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1916 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1917
1918 set subcommand_args {}
1919 proc usage {} {
1920         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1921         exit 1
1922 }
1923
1924 # -- Not a normal commit type invocation?  Do that instead!
1925 #
1926 switch -- $subcommand {
1927 browser {
1928         set subcommand_args {rev?}
1929         switch [llength $argv] {
1930         0 { load_current_branch }
1931         1 {
1932                 set current_branch [lindex $argv 0]
1933                 if {[regexp {^[0-9a-f]{1,39}$} $current_branch]} {
1934                         if {[catch {
1935                                         set current_branch \
1936                                         [git rev-parse --verify $current_branch]
1937                                 } err]} {
1938                                 puts stderr $err
1939                                 exit 1
1940                         }
1941                 }
1942         }
1943         default usage
1944         }
1945         browser::new $current_branch
1946         return
1947 }
1948 blame {
1949         set subcommand_args {rev? path?}
1950         set head {}
1951         set path {}
1952         set is_path 0
1953         foreach a $argv {
1954                 if {$is_path || [file exists $_prefix$a]} {
1955                         if {$path ne {}} usage
1956                         set path $_prefix$a
1957                         break
1958                 } elseif {$a eq {--}} {
1959                         if {$path ne {}} {
1960                                 if {$head ne {}} usage
1961                                 set head $path
1962                                 set path {}
1963                         }
1964                         set is_path 1
1965                 } elseif {$head eq {}} {
1966                         if {$head ne {}} usage
1967                         set head $a
1968                 } else {
1969                         usage
1970                 }
1971         }
1972         unset is_path
1973
1974         if {$head eq {}} {
1975                 load_current_branch
1976         } else {
1977                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
1978                         if {[catch {
1979                                         set head [git rev-parse --verify $head]
1980                                 } err]} {
1981                                 puts stderr $err
1982                                 exit 1
1983                         }
1984                 }
1985                 set current_branch $head
1986         }
1987
1988         if {$path eq {}} usage
1989         blame::new $head $path
1990         return
1991 }
1992 citool -
1993 gui {
1994         if {[llength $argv] != 0} {
1995                 puts -nonewline stderr "usage: $argv0"
1996                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
1997                         puts -nonewline stderr " $subcommand"
1998                 }
1999                 puts stderr {}
2000                 exit 1
2001         }
2002         # fall through to setup UI for commits
2003 }
2004 default {
2005         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2006         exit 1
2007 }
2008 }
2009
2010 # -- Branch Control
2011 #
2012 frame .branch \
2013         -borderwidth 1 \
2014         -relief sunken
2015 label .branch.l1 \
2016         -text {Current Branch:} \
2017         -anchor w \
2018         -justify left
2019 label .branch.cb \
2020         -textvariable current_branch \
2021         -anchor w \
2022         -justify left
2023 pack .branch.l1 -side left
2024 pack .branch.cb -side left -fill x
2025 pack .branch -side top -fill x
2026
2027 # -- Main Window Layout
2028 #
2029 panedwindow .vpane -orient vertical
2030 panedwindow .vpane.files -orient horizontal
2031 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2032 pack .vpane -anchor n -side top -fill both -expand 1
2033
2034 # -- Index File List
2035 #
2036 frame .vpane.files.index -height 100 -width 200
2037 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2038         -background lightgreen
2039 text $ui_index -background white -borderwidth 0 \
2040         -width 20 -height 10 \
2041         -wrap none \
2042         -cursor $cursor_ptr \
2043         -xscrollcommand {.vpane.files.index.sx set} \
2044         -yscrollcommand {.vpane.files.index.sy set} \
2045         -state disabled
2046 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2047 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2048 pack .vpane.files.index.title -side top -fill x
2049 pack .vpane.files.index.sx -side bottom -fill x
2050 pack .vpane.files.index.sy -side right -fill y
2051 pack $ui_index -side left -fill both -expand 1
2052 .vpane.files add .vpane.files.index -sticky nsew
2053
2054 # -- Working Directory File List
2055 #
2056 frame .vpane.files.workdir -height 100 -width 200
2057 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2058         -background lightsalmon
2059 text $ui_workdir -background white -borderwidth 0 \
2060         -width 20 -height 10 \
2061         -wrap none \
2062         -cursor $cursor_ptr \
2063         -xscrollcommand {.vpane.files.workdir.sx set} \
2064         -yscrollcommand {.vpane.files.workdir.sy set} \
2065         -state disabled
2066 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2067 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2068 pack .vpane.files.workdir.title -side top -fill x
2069 pack .vpane.files.workdir.sx -side bottom -fill x
2070 pack .vpane.files.workdir.sy -side right -fill y
2071 pack $ui_workdir -side left -fill both -expand 1
2072 .vpane.files add .vpane.files.workdir -sticky nsew
2073
2074 foreach i [list $ui_index $ui_workdir] {
2075         $i tag conf in_diff -background lightgray
2076         $i tag conf in_sel  -background lightgray
2077 }
2078 unset i
2079
2080 # -- Diff and Commit Area
2081 #
2082 frame .vpane.lower -height 300 -width 400
2083 frame .vpane.lower.commarea
2084 frame .vpane.lower.diff -relief sunken -borderwidth 1
2085 pack .vpane.lower.commarea -side top -fill x
2086 pack .vpane.lower.diff -side bottom -fill both -expand 1
2087 .vpane add .vpane.lower -sticky nsew
2088
2089 # -- Commit Area Buttons
2090 #
2091 frame .vpane.lower.commarea.buttons
2092 label .vpane.lower.commarea.buttons.l -text {} \
2093         -anchor w \
2094         -justify left
2095 pack .vpane.lower.commarea.buttons.l -side top -fill x
2096 pack .vpane.lower.commarea.buttons -side left -fill y
2097
2098 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2099         -command do_rescan
2100 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2101 lappend disable_on_lock \
2102         {.vpane.lower.commarea.buttons.rescan conf -state}
2103
2104 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
2105         -command do_add_all
2106 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2107 lappend disable_on_lock \
2108         {.vpane.lower.commarea.buttons.incall conf -state}
2109
2110 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2111         -command do_signoff
2112 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2113
2114 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2115         -command do_commit
2116 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2117 lappend disable_on_lock \
2118         {.vpane.lower.commarea.buttons.commit conf -state}
2119
2120 button .vpane.lower.commarea.buttons.push -text {Push} \
2121         -command do_push_anywhere
2122 pack .vpane.lower.commarea.buttons.push -side top -fill x
2123
2124 # -- Commit Message Buffer
2125 #
2126 frame .vpane.lower.commarea.buffer
2127 frame .vpane.lower.commarea.buffer.header
2128 set ui_comm .vpane.lower.commarea.buffer.t
2129 set ui_coml .vpane.lower.commarea.buffer.header.l
2130 radiobutton .vpane.lower.commarea.buffer.header.new \
2131         -text {New Commit} \
2132         -command do_select_commit_type \
2133         -variable selected_commit_type \
2134         -value new
2135 lappend disable_on_lock \
2136         [list .vpane.lower.commarea.buffer.header.new conf -state]
2137 radiobutton .vpane.lower.commarea.buffer.header.amend \
2138         -text {Amend Last Commit} \
2139         -command do_select_commit_type \
2140         -variable selected_commit_type \
2141         -value amend
2142 lappend disable_on_lock \
2143         [list .vpane.lower.commarea.buffer.header.amend conf -state]
2144 label $ui_coml \
2145         -anchor w \
2146         -justify left
2147 proc trace_commit_type {varname args} {
2148         global ui_coml commit_type
2149         switch -glob -- $commit_type {
2150         initial       {set txt {Initial Commit Message:}}
2151         amend         {set txt {Amended Commit Message:}}
2152         amend-initial {set txt {Amended Initial Commit Message:}}
2153         amend-merge   {set txt {Amended Merge Commit Message:}}
2154         merge         {set txt {Merge Commit Message:}}
2155         *             {set txt {Commit Message:}}
2156         }
2157         $ui_coml conf -text $txt
2158 }
2159 trace add variable commit_type write trace_commit_type
2160 pack $ui_coml -side left -fill x
2161 pack .vpane.lower.commarea.buffer.header.amend -side right
2162 pack .vpane.lower.commarea.buffer.header.new -side right
2163
2164 text $ui_comm -background white -borderwidth 1 \
2165         -undo true \
2166         -maxundo 20 \
2167         -autoseparators true \
2168         -relief sunken \
2169         -width 75 -height 9 -wrap none \
2170         -font font_diff \
2171         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2172 scrollbar .vpane.lower.commarea.buffer.sby \
2173         -command [list $ui_comm yview]
2174 pack .vpane.lower.commarea.buffer.header -side top -fill x
2175 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2176 pack $ui_comm -side left -fill y
2177 pack .vpane.lower.commarea.buffer -side left -fill y
2178
2179 # -- Commit Message Buffer Context Menu
2180 #
2181 set ctxm .vpane.lower.commarea.buffer.ctxm
2182 menu $ctxm -tearoff 0
2183 $ctxm add command \
2184         -label {Cut} \
2185         -command {tk_textCut $ui_comm}
2186 $ctxm add command \
2187         -label {Copy} \
2188         -command {tk_textCopy $ui_comm}
2189 $ctxm add command \
2190         -label {Paste} \
2191         -command {tk_textPaste $ui_comm}
2192 $ctxm add command \
2193         -label {Delete} \
2194         -command {$ui_comm delete sel.first sel.last}
2195 $ctxm add separator
2196 $ctxm add command \
2197         -label {Select All} \
2198         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2199 $ctxm add command \
2200         -label {Copy All} \
2201         -command {
2202                 $ui_comm tag add sel 0.0 end
2203                 tk_textCopy $ui_comm
2204                 $ui_comm tag remove sel 0.0 end
2205         }
2206 $ctxm add separator
2207 $ctxm add command \
2208         -label {Sign Off} \
2209         -command do_signoff
2210 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2211
2212 # -- Diff Header
2213 #
2214 proc trace_current_diff_path {varname args} {
2215         global current_diff_path diff_actions file_states
2216         if {$current_diff_path eq {}} {
2217                 set s {}
2218                 set f {}
2219                 set p {}
2220                 set o disabled
2221         } else {
2222                 set p $current_diff_path
2223                 set s [mapdesc [lindex $file_states($p) 0] $p]
2224                 set f {File:}
2225                 set p [escape_path $p]
2226                 set o normal
2227         }
2228
2229         .vpane.lower.diff.header.status configure -text $s
2230         .vpane.lower.diff.header.file configure -text $f
2231         .vpane.lower.diff.header.path configure -text $p
2232         foreach w $diff_actions {
2233                 uplevel #0 $w $o
2234         }
2235 }
2236 trace add variable current_diff_path write trace_current_diff_path
2237
2238 frame .vpane.lower.diff.header -background gold
2239 label .vpane.lower.diff.header.status \
2240         -background gold \
2241         -width $max_status_desc \
2242         -anchor w \
2243         -justify left
2244 label .vpane.lower.diff.header.file \
2245         -background gold \
2246         -anchor w \
2247         -justify left
2248 label .vpane.lower.diff.header.path \
2249         -background gold \
2250         -anchor w \
2251         -justify left
2252 pack .vpane.lower.diff.header.status -side left
2253 pack .vpane.lower.diff.header.file -side left
2254 pack .vpane.lower.diff.header.path -fill x
2255 set ctxm .vpane.lower.diff.header.ctxm
2256 menu $ctxm -tearoff 0
2257 $ctxm add command \
2258         -label {Copy} \
2259         -command {
2260                 clipboard clear
2261                 clipboard append \
2262                         -format STRING \
2263                         -type STRING \
2264                         -- $current_diff_path
2265         }
2266 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2267 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2268
2269 # -- Diff Body
2270 #
2271 frame .vpane.lower.diff.body
2272 set ui_diff .vpane.lower.diff.body.t
2273 text $ui_diff -background white -borderwidth 0 \
2274         -width 80 -height 15 -wrap none \
2275         -font font_diff \
2276         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2277         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2278         -state disabled
2279 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2280         -command [list $ui_diff xview]
2281 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2282         -command [list $ui_diff yview]
2283 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2284 pack .vpane.lower.diff.body.sby -side right -fill y
2285 pack $ui_diff -side left -fill both -expand 1
2286 pack .vpane.lower.diff.header -side top -fill x
2287 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2288
2289 $ui_diff tag conf d_cr -elide true
2290 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2291 $ui_diff tag conf d_+ -foreground {#00a000}
2292 $ui_diff tag conf d_- -foreground red
2293
2294 $ui_diff tag conf d_++ -foreground {#00a000}
2295 $ui_diff tag conf d_-- -foreground red
2296 $ui_diff tag conf d_+s \
2297         -foreground {#00a000} \
2298         -background {#e2effa}
2299 $ui_diff tag conf d_-s \
2300         -foreground red \
2301         -background {#e2effa}
2302 $ui_diff tag conf d_s+ \
2303         -foreground {#00a000} \
2304         -background ivory1
2305 $ui_diff tag conf d_s- \
2306         -foreground red \
2307         -background ivory1
2308
2309 $ui_diff tag conf d<<<<<<< \
2310         -foreground orange \
2311         -font font_diffbold
2312 $ui_diff tag conf d======= \
2313         -foreground orange \
2314         -font font_diffbold
2315 $ui_diff tag conf d>>>>>>> \
2316         -foreground orange \
2317         -font font_diffbold
2318
2319 $ui_diff tag raise sel
2320
2321 # -- Diff Body Context Menu
2322 #
2323 set ctxm .vpane.lower.diff.body.ctxm
2324 menu $ctxm -tearoff 0
2325 $ctxm add command \
2326         -label {Refresh} \
2327         -command reshow_diff
2328 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2329 $ctxm add command \
2330         -label {Copy} \
2331         -command {tk_textCopy $ui_diff}
2332 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2333 $ctxm add command \
2334         -label {Select All} \
2335         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2336 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2337 $ctxm add command \
2338         -label {Copy All} \
2339         -command {
2340                 $ui_diff tag add sel 0.0 end
2341                 tk_textCopy $ui_diff
2342                 $ui_diff tag remove sel 0.0 end
2343         }
2344 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2345 $ctxm add separator
2346 $ctxm add command \
2347         -label {Apply/Reverse Hunk} \
2348         -command {apply_hunk $cursorX $cursorY}
2349 set ui_diff_applyhunk [$ctxm index last]
2350 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2351 $ctxm add separator
2352 $ctxm add command \
2353         -label {Decrease Font Size} \
2354         -command {incr_font_size font_diff -1}
2355 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2356 $ctxm add command \
2357         -label {Increase Font Size} \
2358         -command {incr_font_size font_diff 1}
2359 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2360 $ctxm add separator
2361 $ctxm add command \
2362         -label {Show Less Context} \
2363         -command {if {$repo_config(gui.diffcontext) >= 1} {
2364                 incr repo_config(gui.diffcontext) -1
2365                 reshow_diff
2366         }}
2367 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2368 $ctxm add command \
2369         -label {Show More Context} \
2370         -command {if {$repo_config(gui.diffcontext) < 99} {
2371                 incr repo_config(gui.diffcontext)
2372                 reshow_diff
2373         }}
2374 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2375 $ctxm add separator
2376 $ctxm add command -label {Options...} \
2377         -command do_options
2378 bind_button3 $ui_diff "
2379         set cursorX %x
2380         set cursorY %y
2381         if {\$ui_index eq \$current_diff_side} {
2382                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2383         } else {
2384                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2385         }
2386         tk_popup $ctxm %X %Y
2387 "
2388 unset ui_diff_applyhunk
2389
2390 # -- Status Bar
2391 #
2392 set main_status [::status_bar::new .status]
2393 pack .status -anchor w -side bottom -fill x
2394 $main_status show {Initializing...}
2395
2396 # -- Load geometry
2397 #
2398 catch {
2399 set gm $repo_config(gui.geometry)
2400 wm geometry . [lindex $gm 0]
2401 .vpane sash place 0 \
2402         [lindex [.vpane sash coord 0] 0] \
2403         [lindex $gm 1]
2404 .vpane.files sash place 0 \
2405         [lindex $gm 2] \
2406         [lindex [.vpane.files sash coord 0] 1]
2407 unset gm
2408 }
2409
2410 # -- Key Bindings
2411 #
2412 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2413 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2414 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2415 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2416 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2417 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2418 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2419 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2420 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2421 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2422 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2423
2424 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2425 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2426 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2427 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2428 bind $ui_diff <$M1B-Key-v> {break}
2429 bind $ui_diff <$M1B-Key-V> {break}
2430 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2431 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2432 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2433 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2434 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2435 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2436 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2437 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2438 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2439 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2440 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2441 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2442 bind $ui_diff <Button-1>   {focus %W}
2443
2444 if {[is_enabled branch]} {
2445         bind . <$M1B-Key-n> branch_create::dialog
2446         bind . <$M1B-Key-N> branch_create::dialog
2447         bind . <$M1B-Key-o> branch_checkout::dialog
2448         bind . <$M1B-Key-O> branch_checkout::dialog
2449 }
2450 if {[is_enabled transport]} {
2451         bind . <$M1B-Key-p> do_push_anywhere
2452         bind . <$M1B-Key-P> do_push_anywhere
2453 }
2454
2455 bind .   <Key-F5>     do_rescan
2456 bind .   <$M1B-Key-r> do_rescan
2457 bind .   <$M1B-Key-R> do_rescan
2458 bind .   <$M1B-Key-s> do_signoff
2459 bind .   <$M1B-Key-S> do_signoff
2460 bind .   <$M1B-Key-i> do_add_all
2461 bind .   <$M1B-Key-I> do_add_all
2462 bind .   <$M1B-Key-Return> do_commit
2463 foreach i [list $ui_index $ui_workdir] {
2464         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2465         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2466         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2467 }
2468 unset i
2469
2470 set file_lists($ui_index) [list]
2471 set file_lists($ui_workdir) [list]
2472
2473 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2474 focus -force $ui_comm
2475
2476 # -- Warn the user about environmental problems.  Cygwin's Tcl
2477 #    does *not* pass its env array onto any processes it spawns.
2478 #    This means that git processes get none of our environment.
2479 #
2480 if {[is_Cygwin]} {
2481         set ignored_env 0
2482         set suggest_user {}
2483         set msg "Possible environment issues exist.
2484
2485 The following environment variables are probably
2486 going to be ignored by any Git subprocess run
2487 by [appname]:
2488
2489 "
2490         foreach name [array names env] {
2491                 switch -regexp -- $name {
2492                 {^GIT_INDEX_FILE$} -
2493                 {^GIT_OBJECT_DIRECTORY$} -
2494                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2495                 {^GIT_DIFF_OPTS$} -
2496                 {^GIT_EXTERNAL_DIFF$} -
2497                 {^GIT_PAGER$} -
2498                 {^GIT_TRACE$} -
2499                 {^GIT_CONFIG$} -
2500                 {^GIT_CONFIG_LOCAL$} -
2501                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2502                         append msg " - $name\n"
2503                         incr ignored_env
2504                 }
2505                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2506                         append msg " - $name\n"
2507                         incr ignored_env
2508                         set suggest_user $name
2509                 }
2510                 }
2511         }
2512         if {$ignored_env > 0} {
2513                 append msg "
2514 This is due to a known issue with the
2515 Tcl binary distributed by Cygwin."
2516
2517                 if {$suggest_user ne {}} {
2518                         append msg "
2519
2520 A good replacement for $suggest_user
2521 is placing values for the user.name and
2522 user.email settings into your personal
2523 ~/.gitconfig file.
2524 "
2525                 }
2526                 warn_popup $msg
2527         }
2528         unset ignored_env msg suggest_user name
2529 }
2530
2531 # -- Only initialize complex UI if we are going to stay running.
2532 #
2533 if {[is_enabled transport]} {
2534         load_all_remotes
2535
2536         populate_fetch_menu
2537         populate_push_menu
2538 }
2539
2540 # -- Only suggest a gc run if we are going to stay running.
2541 #
2542 if {[is_enabled multicommit]} {
2543         set object_limit 2000
2544         if {[is_Windows]} {set object_limit 200}
2545         regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
2546         if {$objects_current >= $object_limit} {
2547                 if {[ask_popup \
2548                         "This repository currently has $objects_current loose objects.
2549
2550 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2551
2552 Compress the database now?"] eq yes} {
2553                         do_gc
2554                 }
2555         }
2556         unset object_limit _junk objects_current
2557 }
2558
2559 lock_index begin-read
2560 after 1 do_rescan