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