git-gui.sh

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