Code

37da8fde3b51a71ec0922d26245c25e363f7662a
[git.git] / 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" -- "$@"
12 set appvers {@@GITGUI_VERSION@@}
13 set copyright {
14 Copyright © 2006, 2007 Shawn Pearce, et. al.
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.
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.
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}
30 ######################################################################
31 ##
32 ## Tcl/Tk sanity check
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 }
46 catch {rename send {}} ; # What an evil concept...
48 ######################################################################
49 ##
50 ## locate our library
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
66 ######################################################################
67 ##
68 ## enable verbose loading?
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 }
84 ######################################################################
85 ##
86 ## Internationalization (i18n) through msgcat and gettext. See
87 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
89 package require msgcat
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 }
100 proc strcat {args} {
101         return [join $args {}]
104 ::msgcat::mcload $oguimsg
105 unset oguimsg
107 ######################################################################
108 ##
109 ## read only globals
111 set _appname [lindex [file split $argv0] end]
112 set _gitdir {}
113 set _gitexec {}
114 set _reponame {}
115 set _iscygwin {}
116 set _search_path {}
118 proc appname {} {
119         global _appname
120         return $_appname
123 proc gitdir {args} {
124         global _gitdir
125         if {$args eq {}} {
126                 return $_gitdir
127         }
128         return [eval [list file join $_gitdir] $args]
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]
152 proc reponame {} {
153         return $::_reponame
156 proc is_MacOSX {} {
157         if {[tk windowingsystem] eq {aqua}} {
158                 return 1
159         }
160         return 0
163 proc is_Windows {} {
164         if {$::tcl_platform(platform) eq {windows}} {
165                 return 1
166         }
167         return 0
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
186 proc is_enabled {option} {
187         global enabled_options
188         if {[catch {set on $enabled_options($option)}]} {return 0}
189         return $on
192 proc enable_option {option} {
193         global enabled_options
194         set enabled_options($option) 1
197 proc disable_option {option} {
198         global enabled_options
199         set enabled_options($option) 0
202 ######################################################################
203 ##
204 ## config
206 proc is_many_config {name} {
207         switch -glob -- $name {
208         remote.*.fetch -
209         remote.*.push
210                 {return 1}
211         *
212                 {return 0}
213         }
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         }
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         }
236 proc load_config {include_global} {
237         global repo_config global_config default_config
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         }
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         }
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         }
281 ######################################################################
282 ##
283 ## handy utils
285 proc _git_cmd {name} {
286         global _git_cmd_path
288         if {[catch {set v $_git_cmd_path($name)}]} {
289                 switch -- $name {
290                   version   -
291                 --version   -
292                 --exec-path { return [list $::_git $name] }
293                 }
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
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                         }
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
334 proc _which {what} {
335         global env _search_exe _search_path
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         }
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 {}
363 proc _lappend_nice {cmd_var} {
364         global _nice
365         upvar $cmd_var cmd
367         if {![info exists _nice]} {
368                 set _nice [_which nice]
369         }
370         if {$_nice ne {}} {
371                 lappend cmd $_nice
372         }
375 proc git {args} {
376         set opt [list exec]
378         while {1} {
379                 switch -- [lindex $args 0] {
380                 --nice {
381                         _lappend_nice opt
382                 }
384                 default {
385                         break
386                 }
388                 }
390                 set args [lrange $args 1 end]
391         }
393         set cmdp [_git_cmd [lindex $args 0]]
394         set args [lrange $args 1 end]
396         return [eval $opt $cmdp $args]
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
423 proc git_read {args} {
424         set opt [list |]
426         while {1} {
427                 switch -- [lindex $args 0] {
428                 --nice {
429                         _lappend_nice opt
430                 }
432                 --stderr {
433                         lappend args 2>@1
434                 }
436                 default {
437                         break
438                 }
440                 }
442                 set args [lrange $args 1 end]
443         }
445         set cmdp [_git_cmd [lindex $args 0]]
446         set args [lrange $args 1 end]
448         return [_open_stdout_stderr [concat $opt $cmdp $args]]
451 proc git_write {args} {
452         set opt [list |]
454         while {1} {
455                 switch -- [lindex $args 0] {
456                 --nice {
457                         _lappend_nice opt
458                 }
460                 default {
461                         break
462                 }
464                 }
466                 set args [lrange $args 1 end]
467         }
469         set cmdp [_git_cmd [lindex $args 0]]
470         set args [lrange $args 1 end]
472         return [open [concat $opt $cmdp $args] w]
475 proc sq {value} {
476         regsub -all ' $value "'\\''" value
477         return "'$value'"
480 proc load_current_branch {} {
481         global current_branch is_detached
483         set fd [open [gitdir HEAD] r]
484         if {[gets $fd ref] < 1} {
485                 set ref {}
486         }
487         close $fd
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         }
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
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
524 set root_exists 0
525 bind . <Visibility> {
526         bind . <Visibility> {}
527         set root_exists 1
530 ######################################################################
531 ##
532 ## config defaults
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
543 font create font_uiitalic
544 font create font_uibold
545 font create font_diffbold
546 font create font_diffitalic
548 foreach class {Button Checkbutton Entry Label
549                 Labelframe Listbox Menu Message
550                 Radiobutton Spinbox Text} {
551         option add *$class.font font_ui
553 unset class
555 if {[is_Windows] || [is_MacOSX]} {
556         option add *Menu.tearOff 0
559 if {[is_MacOSX]} {
560         set M1B M1
561         set M1T Cmd
562 } else {
563         set M1B Control
564         set M1T Ctrl
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         }
577 proc apply_config {} {
578         global repo_config font_descs
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         }
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) {}
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"}}
617 ######################################################################
618 ##
619 ## find git
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
632 ######################################################################
633 ##
634 ## version check
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:
644 $err
646 [appname] requires Git 1.5.0 or later."
647         exit 1
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
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
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.
674 %s claims it is version '%s'.
676 %s requires at least Git 1.5.0 or later.
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         }
685 unset _real_git_version
687 proc git-version {args} {
688         global _git_version
690         switch [llength $args] {
691         0 {
692                 return $_git_version
693         }
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         }
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]
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                 }
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                 }
721                 return [uplevel [list $type $name $parm [lindex $body end]]]
722         }
724         default {
725                 error "git-version >= x"
726         }
728         }
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.
739 You are using [git-version]:
741 [git --version]"
742         exit 1
745 ######################################################################
746 ##
747 ## configure our library
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
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 {}
769 close $fd
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]
782 unset -nocomplain idx fd
784 ######################################################################
785 ##
786 ## feature option selection
788 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
789         unset _junk
790 } else {
791         set subcommand gui
793 if {$subcommand eq {gui.sh}} {
794         set subcommand gui
796 if {$subcommand eq {gui} && [llength $argv] > 0} {
797         set subcommand [lindex $argv 0]
798         set argv [lrange $argv 1 end]
801 enable_option multicommit
802 enable_option branch
803 enable_option transport
804 disable_option bare
806 switch -- $subcommand {
807 browser -
808 blame {
809         enable_option bare
811         disable_option multicommit
812         disable_option branch
813         disable_option transport
815 citool {
816         enable_option singlecommit
818         disable_option multicommit
819         disable_option branch
820         disable_option transport
824 ######################################################################
825 ##
826 ## repository setup
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         load_config 1
837         apply_config
838         choose_repository::pick
840 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
841         catch {set _gitdir [exec cygpath --windows $_gitdir]}
843 if {![file isdirectory $_gitdir]} {
844         catch {wm withdraw .}
845         error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
846         exit 1
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         }
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]
875 ######################################################################
876 ##
877 ## global init
879 set current_diff_path {}
880 set current_diff_side {}
881 set diff_actions [list]
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
894 ######################################################################
895 ##
896 ## task management
898 set rescan_active 0
899 set diff_active 0
900 set last_clicked {}
902 set disable_on_lock [list]
903 set index_lock_type none
905 proc lock_index {type} {
906         global index_lock_type disable_on_lock
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
921 proc unlock_index {} {
922         global index_lock_type disable_on_lock
924         set index_lock_type none
925         foreach w $disable_on_lock {
926                 uplevel #0 $w normal
927         }
930 ######################################################################
931 ##
932 ## status
934 proc repository_state {ctvar hdvar mhvar} {
935         global current_branch
936         upvar $ctvar ct $hdvar hd $mhvar mh
938         set mh [list]
940         load_current_branch
941         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
942                 set hd {}
943                 set ct initial
944                 return
945         }
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         }
958         set ct normal
961 proc PARENT {} {
962         global PARENT empty_tree
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
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
980         if {$rescan_active > 0 || ![lock_index read]} return
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         }
993         array unset file_states
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         }
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         }
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
1030                 if {$is_git_info_link eq {}} {
1031                         set is_git_info_link [file isfile [gitdir info.lnk]]
1032                 }
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         }
1053 proc rescan_stage2 {fd after} {
1054         global rescan_active buf_rdi buf_rdf buf_rlo
1056         if {$fd ne {}} {
1057                 read $fd
1058                 if {![eof $fd]} return
1059                 close $fd
1060         }
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         }
1071         set buf_rdi {}
1072         set buf_rdf {}
1073         set buf_rlo {}
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]
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]
1089 proc load_message {file} {
1090         global ui_comm
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
1108 proc read_diff_index {fd after} {
1109         global buf_rdi
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
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         }
1138         rescan_done $fd buf_rdi $after
1141 proc read_diff_files {fd after} {
1142         global buf_rdf
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
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         }
1171         rescan_done $fd buf_rdf $after
1174 proc read_ls_others {fd after} {
1175         global buf_rlo
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
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
1195         if {![eof $fd]} return
1196         set to_clear {}
1197         close $fd
1198         if {[incr rescan_active -1] > 0} return
1200         prune_selection
1201         unlock_index
1202         display_all_files
1203         if {$current_diff_path ne {}} reshow_diff
1204         uplevel #0 $after
1207 proc prune_selection {} {
1208         global file_states selected_paths
1210         foreach path [array names selected_paths] {
1211                 if {[catch {set still_here $file_states($path)}]} {
1212                         unset selected_paths($path)
1213                 }
1214         }
1217 ######################################################################
1218 ##
1219 ## ui helpers
1221 proc mapicon {w state path} {
1222         global all_icons
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
1231 proc mapdesc {state path} {
1232         global all_descs
1234         if {[catch {set r $all_descs($state)}]} {
1235                 puts "error: no desc for state={$state} $path"
1236                 return $state
1237         }
1238         return $r
1241 proc ui_status {msg} {
1242         $::main_status show $msg
1245 proc ui_ready {{test {}}} {
1246         $::main_status show [mc "Ready."] $test
1249 proc escape_path {path} {
1250         regsub -all {\\} $path "\\\\" path
1251         regsub -all "\n" $path "\\n" path
1252         return $path
1255 proc short_path {path} {
1256         return [escape_path [lindex [file split $path] end]]
1259 set next_icon_id 0
1260 set null_sha1 [string repeat 0 40]
1262 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1263         global file_states next_icon_id null_sha1
1265         set s0 [string index $new_state 0]
1266         set s1 [string index $new_state 1]
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         }
1278         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1279         elseif {$s0 eq {_}} {set s0 _}
1281         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1282         elseif {$s1 eq {_}} {set s1 _}
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         }
1291         set file_states($path) [list $s0$s1 $icon \
1292                 $head_info $index_info \
1293                 ]
1294         return $state
1297 proc display_file_helper {w path icon_name old_m new_m} {
1298         global file_lists
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         }
1328 proc display_file {path state} {
1329         global file_states selected_paths
1330         global ui_index ui_workdir
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]
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
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
1359         if {$new_m eq {__}} {
1360                 unset file_states($path)
1361                 catch {unset selected_paths($path)}
1362         }
1365 proc display_all_files_helper {w path icon_name m} {
1366         global file_lists
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"
1377 proc display_all_files {} {
1378         global ui_index ui_workdir
1379         global file_states file_lists
1380         global last_clicked
1382         $ui_index conf -state normal
1383         $ui_workdir conf -state normal
1385         $ui_index delete 0.0 end
1386         $ui_workdir delete 0.0 end
1387         set last_clicked {}
1389         set file_lists($ui_index) [list]
1390         set file_lists($ui_workdir) [list]
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]
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                 }
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         }
1414         $ui_index conf -state disabled
1415         $ui_workdir conf -state disabled
1418 ######################################################################
1419 ##
1420 ## icons
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};
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
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
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
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
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
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
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
1494 set ui_index .vpane.files.index.list
1495 set ui_workdir .vpane.files.workdir.list
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
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
1509 set max_status_desc 0
1510 foreach i {
1511                 {__ {mc "Unmodified"}}
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"}}
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"}}
1523                 {_D {mc "Missing"}}
1524                 {D_ {mc "Staged for removal"}}
1525                 {DO {mc "Staged for removal, still present"}}
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
1538 unset i
1540 ######################################################################
1541 ##
1542 ## util
1544 proc scrollbar2many {list mode args} {
1545         foreach w $list {eval $w $mode $args}
1548 proc many2scrollbar {list mode sb top bottom} {
1549         $sb set $top $bottom
1550         foreach w $list {$w $mode moveto $top}
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
1561 ######################################################################
1562 ##
1563 ## ui commands
1565 set starting_gitk_msg [mc "Starting gitk... please wait..."]
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         }
1584 set is_quitting 0
1586 proc do_quit {} {
1587         global ui_comm is_quitting repo_config commit_type
1588         global GITGUI_BCK_exists GITGUI_BCK_i
1590         if {$is_quitting} return
1591         set is_quitting 1
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                 }
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                 }
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         }
1637         destroy .
1640 proc do_rescan {} {
1641         rescan ui_ready
1644 proc do_commit {} {
1645         commit_tree
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
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         }
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
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         }
1688 proc add_one_to_selection {w x y} {
1689         global file_lists last_clicked selected_paths
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         }
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         }
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         }
1717 proc add_range_to_selection {w x y} {
1718         global file_lists last_clicked selected_paths
1720         if {[lindex $last_clicked 0] ne $w} {
1721                 toggle_or_diff $w $x $y
1722                 return
1723         }
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         }
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
1743 ######################################################################
1744 ##
1745 ## ui construction
1747 load_config 0
1748 apply_config
1749 set ui_comm {}
1751 # -- Menu Bar
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
1759 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1760         .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
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
1767 . configure -menu .mbar
1769 # -- Repository Menu
1771 menu .mbar.repository
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
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
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]
1798 trace add variable current_branch write current_branch_write
1800 if {[is_enabled multicommit]} {
1801         .mbar.repository add command -label [mc "Database Statistics"] \
1802                 -command do_stats
1804         .mbar.repository add command -label [mc "Compress Database"] \
1805                 -command do_gc
1807         .mbar.repository add command -label [mc "Verify Database"] \
1808                 -command do_fsck_objects
1810         .mbar.repository add separator
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         }
1827 .mbar.repository add command -label [mc Quit] \
1828         -command do_quit \
1829         -accelerator $M1T-Q
1831 # -- Edit Menu
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
1858 # -- Branch Menu
1860 if {[is_enabled branch]} {
1861         menu .mbar.branch
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]
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]
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]
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]
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]
1891 # -- Commit Menu
1893 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1894         menu .mbar.commit
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]
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]
1912         .mbar.commit add separator
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]
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]
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]
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]
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]
1941         .mbar.commit add separator
1943         .mbar.commit add command -label [mc "Sign Off"] \
1944                 -command do_signoff \
1945                 -accelerator $M1T-S
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]
1954 # -- Merge Menu
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]
1969 # -- Transport Menu
1971 if {[is_enabled transport]} {
1972         menu .mbar.fetch
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
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
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
2000 # -- Help Menu
2002 .mbar add cascade -label [mc Help] -menu .mbar.help
2003 menu .mbar.help
2005 if {![is_MacOSX]} {
2006         .mbar.help add command -label [mc "About %s" [appname]] \
2007                 -command do_about
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]
2015 if {[is_Cygwin]} {
2016         set doc_path [exec cygpath --mixed $doc_path]
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         }
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/}
2042 if {$browser ne {}} {
2043         .mbar.help add command -label [mc "Online Documentation"] \
2044                 -command [list exec $browser $doc_url &]
2046 unset browser doc_path doc_url
2048 # -- Standard bindings
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]}
2056 set subcommand_args {}
2057 proc usage {} {
2058         puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2059         exit 1
2062 # -- Not a normal commit type invocation?  Do that instead!
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
2094         if {$head ne {} && $path eq {}} {
2095                 set path $_prefix$head
2096                 set head {}
2097         }
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         }
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
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
2147 default {
2148         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2149         exit 1
2153 # -- Branch Control
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
2170 # -- Main Window Layout
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
2177 # -- Index File List
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
2197 # -- Working Directory File List
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
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]
2221 unset i
2223 # -- Diff and Commit Area
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
2232 # -- Commit Area Buttons
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
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}
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}
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
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}
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
2267 # -- Commit Message Buffer
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
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
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
2322 # -- Commit Message Buffer Context Menu
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"
2355 # -- Diff Header
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         }
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         }
2379 trace add variable current_diff_path write trace_current_diff_path
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"
2412 # -- Diff Body
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
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
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
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
2462 $ui_diff tag raise sel
2464 # -- Diff Body Context Menu
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
2541 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2543 # -- Status Bar
2545 set main_status [::status_bar::new .status]
2546 pack .status -anchor w -side bottom -fill x
2547 $main_status show [mc "Initializing..."]
2549 # -- Load geometry
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
2563 # -- Key Bindings
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}
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}
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
2605 if {[is_enabled transport]} {
2606         bind . <$M1B-Key-p> do_push_anywhere
2607         bind . <$M1B-Key-P> do_push_anywhere
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"
2623 unset i
2625 set file_lists($ui_index) [list]
2626 set file_lists($ui_workdir) [list]
2628 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2629 focus -force $ui_comm
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.
2635 if {[is_Cygwin]} {
2636         set ignored_env 0
2637         set suggest_user {}
2638         set msg [mc "Possible environment issues exist.
2640 The following environment variables are probably
2641 going to be ignored by any Git subprocess run
2642 by %s:
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."]
2672                 if {$suggest_user ne {}} {
2673                         append msg [mc "
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
2686 # -- Only initialize complex UI if we are going to stay running.
2688 if {[is_enabled transport]} {
2689         load_all_remotes
2691         populate_fetch_menu
2692         populate_push_menu
2695 if {[winfo exists $ui_comm]} {
2696         set GITGUI_BCK_exists [load_message GITGUI_BCK]
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         }
2717         proc backup_commit_buffer {} {
2718                 global ui_comm GITGUI_BCK_exists
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
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                         }
2739                         $ui_comm edit modified false
2740                 }
2742                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2743         }
2745         backup_commit_buffer
2748 lock_index begin-read
2749 if {![winfo ismapped .]} {
2750         wm deiconify .
2752 after 1 do_rescan
2753 if {[is_enabled multicommit]} {
2754         after 1000 hint_gc