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