Revert "git-gui: set GIT_DIR and GIT_WORK_TREE after setup"
[git/dscho.git] / git-gui / git-gui.sh
blob05193a040ac521eed78e9a3b62d2d041c37800a1
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 [encoding convertfrom utf-8 {
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 ######################################################################
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
46 catch {rename send {}} ; # What an evil concept...
48 ######################################################################
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 normalize $argv0]]
56 if {[file tail $oguilib] eq {git-core}} {
57 set oguilib [file dirname $oguilib]
59 set oguilib [file dirname $oguilib]
60 set oguilib [file join $oguilib share git-gui lib]
61 set oguimsg [file join $oguilib msgs]
62 } elseif {[string match @@* $oguirel]} {
63 set oguilib [file join [file dirname [file normalize $argv0]] lib]
64 set oguimsg [file join [file dirname [file normalize $argv0]] po]
65 } else {
66 set oguimsg [file join $oguilib msgs]
68 unset oguirel
70 ######################################################################
72 ## enable verbose loading?
74 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
75 unset _verbose
76 rename auto_load real__auto_load
77 proc auto_load {name args} {
78 puts stderr "auto_load $name"
79 return [uplevel 1 real__auto_load $name $args]
81 rename source real__source
82 proc source {name} {
83 puts stderr "source $name"
84 uplevel 1 real__source $name
88 ######################################################################
90 ## Internationalization (i18n) through msgcat and gettext. See
91 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93 package require msgcat
95 proc _mc_trim {fmt} {
96 set cmk [string first @@ $fmt]
97 if {$cmk > 0} {
98 return [string range $fmt 0 [expr {$cmk - 1}]]
100 return $fmt
103 proc mc {en_fmt args} {
104 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
105 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
106 set msg [eval [list format [_mc_trim $en_fmt]] $args]
108 return $msg
111 proc strcat {args} {
112 return [join $args {}]
115 ::msgcat::mcload $oguimsg
116 unset oguimsg
118 ######################################################################
120 ## read only globals
122 set _appname {Git Gui}
123 set _gitdir {}
124 set _gitworktree {}
125 set _isbare {}
126 set _gitexec {}
127 set _githtmldir {}
128 set _reponame {}
129 set _iscygwin {}
130 set _search_path {}
132 set _trace [lsearch -exact $argv --trace]
133 if {$_trace >= 0} {
134 set argv [lreplace $argv $_trace $_trace]
135 set _trace 1
136 } else {
137 set _trace 0
140 proc appname {} {
141 global _appname
142 return $_appname
145 proc gitdir {args} {
146 global _gitdir
147 if {$args eq {}} {
148 return $_gitdir
150 return [eval [list file join $_gitdir] $args]
153 proc gitexec {args} {
154 global _gitexec
155 if {$_gitexec eq {}} {
156 if {[catch {set _gitexec [git --exec-path]} err]} {
157 error "Git not installed?\n\n$err"
159 if {[is_Cygwin]} {
160 set _gitexec [exec cygpath \
161 --windows \
162 --absolute \
163 $_gitexec]
164 } else {
165 set _gitexec [file normalize $_gitexec]
168 if {$args eq {}} {
169 return $_gitexec
171 return [eval [list file join $_gitexec] $args]
174 proc githtmldir {args} {
175 global _githtmldir
176 if {$_githtmldir eq {}} {
177 if {[catch {set _githtmldir [git --html-path]}]} {
178 # Git not installed or option not yet supported
179 return {}
181 if {[is_Cygwin]} {
182 set _githtmldir [exec cygpath \
183 --windows \
184 --absolute \
185 $_githtmldir]
186 } else {
187 set _githtmldir [file normalize $_githtmldir]
190 if {$args eq {}} {
191 return $_githtmldir
193 return [eval [list file join $_githtmldir] $args]
196 proc reponame {} {
197 return $::_reponame
200 proc is_MacOSX {} {
201 if {[tk windowingsystem] eq {aqua}} {
202 return 1
204 return 0
207 proc is_Windows {} {
208 if {$::tcl_platform(platform) eq {windows}} {
209 return 1
211 return 0
214 proc is_Cygwin {} {
215 global _iscygwin
216 if {$_iscygwin eq {}} {
217 if {$::tcl_platform(platform) eq {windows}} {
218 if {[catch {set p [exec cygpath --windir]} err]} {
219 set _iscygwin 0
220 } else {
221 set _iscygwin 1
223 } else {
224 set _iscygwin 0
227 return $_iscygwin
230 proc is_enabled {option} {
231 global enabled_options
232 if {[catch {set on $enabled_options($option)}]} {return 0}
233 return $on
236 proc enable_option {option} {
237 global enabled_options
238 set enabled_options($option) 1
241 proc disable_option {option} {
242 global enabled_options
243 set enabled_options($option) 0
246 ######################################################################
248 ## config
250 proc is_many_config {name} {
251 switch -glob -- $name {
252 gui.recentrepo -
253 remote.*.fetch -
254 remote.*.push
255 {return 1}
257 {return 0}
261 proc is_config_true {name} {
262 global repo_config
263 if {[catch {set v $repo_config($name)}]} {
264 return 0
265 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
266 return 1
267 } else {
268 return 0
272 proc get_config {name} {
273 global repo_config
274 if {[catch {set v $repo_config($name)}]} {
275 return {}
276 } else {
277 return $v
281 proc is_bare {} {
282 global _isbare
283 global _gitdir
284 global _gitworktree
286 if {$_isbare eq {}} {
287 if {[catch {
288 set _bare [git rev-parse --is-bare-repository]
289 switch -- $_bare {
290 true { set _isbare 1 }
291 false { set _isbare 0}
292 default { throw }
294 }]} {
295 if {[is_config_true core.bare]
296 || ($_gitworktree eq {}
297 && [lindex [file split $_gitdir] end] ne {.git})} {
298 set _isbare 1
299 } else {
300 set _isbare 0
304 return $_isbare
307 ######################################################################
309 ## handy utils
311 proc _trace_exec {cmd} {
312 if {!$::_trace} return
313 set d {}
314 foreach v $cmd {
315 if {$d ne {}} {
316 append d { }
318 if {[regexp {[ \t\r\n'"$?*]} $v]} {
319 set v [sq $v]
321 append d $v
323 puts stderr $d
326 proc _git_cmd {name} {
327 global _git_cmd_path
329 if {[catch {set v $_git_cmd_path($name)}]} {
330 switch -- $name {
331 version -
332 --version -
333 --exec-path { return [list $::_git $name] }
336 set p [gitexec git-$name$::_search_exe]
337 if {[file exists $p]} {
338 set v [list $p]
339 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
340 # Try to determine what sort of magic will make
341 # git-$name go and do its thing, because native
342 # Tcl on Windows doesn't know it.
344 set p [gitexec git-$name]
345 set f [open $p r]
346 set s [gets $f]
347 close $f
349 switch -glob -- [lindex $s 0] {
350 #!*sh { set i sh }
351 #!*perl { set i perl }
352 #!*python { set i python }
353 default { error "git-$name is not supported: $s" }
356 upvar #0 _$i interp
357 if {![info exists interp]} {
358 set interp [_which $i]
360 if {$interp eq {}} {
361 error "git-$name requires $i (not in PATH)"
363 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
364 } else {
365 # Assume it is builtin to git somehow and we
366 # aren't actually able to see a file for it.
368 set v [list $::_git $name]
370 set _git_cmd_path($name) $v
372 return $v
375 proc _which {what args} {
376 global env _search_exe _search_path
378 if {$_search_path eq {}} {
379 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
380 set _search_path [split [exec cygpath \
381 --windows \
382 --path \
383 --absolute \
384 $env(PATH)] {;}]
385 set _search_exe .exe
386 } elseif {[is_Windows]} {
387 set gitguidir [file dirname [info script]]
388 regsub -all ";" $gitguidir "\\;" gitguidir
389 set env(PATH) "$gitguidir;$env(PATH)"
390 set _search_path [split $env(PATH) {;}]
391 set _search_exe .exe
392 } else {
393 set _search_path [split $env(PATH) :]
394 set _search_exe {}
398 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
399 set suffix {}
400 } else {
401 set suffix $_search_exe
404 foreach p $_search_path {
405 set p [file join $p $what$suffix]
406 if {[file exists $p]} {
407 return [file normalize $p]
410 return {}
413 proc _lappend_nice {cmd_var} {
414 global _nice
415 upvar $cmd_var cmd
417 if {![info exists _nice]} {
418 set _nice [_which nice]
420 if {$_nice ne {}} {
421 lappend cmd $_nice
425 proc git {args} {
426 set opt [list]
428 while {1} {
429 switch -- [lindex $args 0] {
430 --nice {
431 _lappend_nice opt
434 default {
435 break
440 set args [lrange $args 1 end]
443 set cmdp [_git_cmd [lindex $args 0]]
444 set args [lrange $args 1 end]
446 _trace_exec [concat $opt $cmdp $args]
447 set result [eval exec $opt $cmdp $args]
448 if {$::_trace} {
449 puts stderr "< $result"
451 return $result
454 proc _open_stdout_stderr {cmd} {
455 _trace_exec $cmd
456 if {[catch {
457 set fd [open [concat [list | ] $cmd] r]
458 } err]} {
459 if { [lindex $cmd end] eq {2>@1}
460 && $err eq {can not find channel named "1"}
462 # Older versions of Tcl 8.4 don't have this 2>@1 IO
463 # redirect operator. Fallback to |& cat for those.
464 # The command was not actually started, so its safe
465 # to try to start it a second time.
467 set fd [open [concat \
468 [list | ] \
469 [lrange $cmd 0 end-1] \
470 [list |& cat] \
471 ] r]
472 } else {
473 error $err
476 fconfigure $fd -eofchar {}
477 return $fd
480 proc git_read {args} {
481 set opt [list]
483 while {1} {
484 switch -- [lindex $args 0] {
485 --nice {
486 _lappend_nice opt
489 --stderr {
490 lappend args 2>@1
493 default {
494 break
499 set args [lrange $args 1 end]
502 set cmdp [_git_cmd [lindex $args 0]]
503 set args [lrange $args 1 end]
505 return [_open_stdout_stderr [concat $opt $cmdp $args]]
508 proc git_write {args} {
509 set opt [list]
511 while {1} {
512 switch -- [lindex $args 0] {
513 --nice {
514 _lappend_nice opt
517 default {
518 break
523 set args [lrange $args 1 end]
526 set cmdp [_git_cmd [lindex $args 0]]
527 set args [lrange $args 1 end]
529 _trace_exec [concat $opt $cmdp $args]
530 return [open [concat [list | ] $opt $cmdp $args] w]
533 proc githook_read {hook_name args} {
534 set pchook [gitdir hooks $hook_name]
535 lappend args 2>@1
537 # On Windows [file executable] might lie so we need to ask
538 # the shell if the hook is executable. Yes that's annoying.
540 if {[is_Windows]} {
541 upvar #0 _sh interp
542 if {![info exists interp]} {
543 set interp [_which sh]
545 if {$interp eq {}} {
546 error "hook execution requires sh (not in PATH)"
549 set scr {if test -x "$1";then exec "$@";fi}
550 set sh_c [list $interp -c $scr $interp $pchook]
551 return [_open_stdout_stderr [concat $sh_c $args]]
554 if {[file executable $pchook]} {
555 return [_open_stdout_stderr [concat [list $pchook] $args]]
558 return {}
561 proc kill_file_process {fd} {
562 set process [pid $fd]
564 catch {
565 if {[is_Windows]} {
566 # Use a Cygwin-specific flag to allow killing
567 # native Windows processes
568 exec kill -f $process
569 } else {
570 exec kill $process
575 proc gitattr {path attr default} {
576 if {[catch {set r [git check-attr $attr -- $path]}]} {
577 set r unspecified
578 } else {
579 set r [join [lrange [split $r :] 2 end] :]
580 regsub {^ } $r {} r
582 if {$r eq {unspecified}} {
583 return $default
585 return $r
588 proc sq {value} {
589 regsub -all ' $value "'\\''" value
590 return "'$value'"
593 proc load_current_branch {} {
594 global current_branch is_detached
596 set fd [open [gitdir HEAD] r]
597 if {[gets $fd ref] < 1} {
598 set ref {}
600 close $fd
602 set pfx {ref: refs/heads/}
603 set len [string length $pfx]
604 if {[string equal -length $len $pfx $ref]} {
605 # We're on a branch. It might not exist. But
606 # HEAD looks good enough to be a branch.
608 set current_branch [string range $ref $len end]
609 set is_detached 0
610 } else {
611 # Assume this is a detached head.
613 set current_branch HEAD
614 set is_detached 1
618 auto_load tk_optionMenu
619 rename tk_optionMenu real__tkOptionMenu
620 proc tk_optionMenu {w varName args} {
621 set m [eval real__tkOptionMenu $w $varName $args]
622 $m configure -font font_ui
623 $w configure -font font_ui
624 return $m
627 proc rmsel_tag {text} {
628 $text tag conf sel \
629 -background [$text cget -background] \
630 -foreground [$text cget -foreground] \
631 -borderwidth 0
632 $text tag conf in_sel -background lightgray
633 bind $text <Motion> break
634 return $text
637 set root_exists 0
638 bind . <Visibility> {
639 bind . <Visibility> {}
640 set root_exists 1
643 if {[is_Windows]} {
644 wm iconbitmap . -default $oguilib/git-gui.ico
645 set ::tk::AlwaysShowSelection 1
647 # Spoof an X11 display for SSH
648 if {![info exists env(DISPLAY)]} {
649 set env(DISPLAY) :9999
651 } else {
652 catch {
653 image create photo gitlogo -width 16 -height 16
655 gitlogo put #33CC33 -to 7 0 9 2
656 gitlogo put #33CC33 -to 4 2 12 4
657 gitlogo put #33CC33 -to 7 4 9 6
658 gitlogo put #CC3333 -to 4 6 12 8
659 gitlogo put gray26 -to 4 9 6 10
660 gitlogo put gray26 -to 3 10 6 12
661 gitlogo put gray26 -to 8 9 13 11
662 gitlogo put gray26 -to 8 11 10 12
663 gitlogo put gray26 -to 11 11 13 14
664 gitlogo put gray26 -to 3 12 5 14
665 gitlogo put gray26 -to 5 13
666 gitlogo put gray26 -to 10 13
667 gitlogo put gray26 -to 4 14 12 15
668 gitlogo put gray26 -to 5 15 11 16
669 gitlogo redither
671 wm iconphoto . -default gitlogo
675 ######################################################################
677 ## config defaults
679 set cursor_ptr arrow
680 font create font_ui
681 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
682 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
683 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
684 } else {
685 font create font_diff -family Courier -size 10
686 catch {
687 label .dummy
688 eval font configure font_ui [font actual [.dummy cget -font]]
689 destroy .dummy
693 font create font_uiitalic
694 font create font_uibold
695 font create font_diffbold
696 font create font_diffitalic
698 foreach class {Button Checkbutton Entry Label
699 Labelframe Listbox Message
700 Radiobutton Spinbox Text} {
701 option add *$class.font font_ui
703 if {![is_MacOSX]} {
704 option add *Menu.font font_ui
705 option add *Entry.borderWidth 1 startupFile
706 option add *Entry.relief sunken startupFile
707 option add *RadioButton.anchor w startupFile
709 unset class
711 if {[is_Windows] || [is_MacOSX]} {
712 option add *Menu.tearOff 0
715 if {[is_MacOSX]} {
716 set M1B M1
717 set M1T Cmd
718 } else {
719 set M1B Control
720 set M1T Ctrl
723 proc bind_button3 {w cmd} {
724 bind $w <Any-Button-3> $cmd
725 if {[is_MacOSX]} {
726 # Mac OS X sends Button-2 on right click through three-button mouse,
727 # or through trackpad right-clicking (two-finger touch + click).
728 bind $w <Any-Button-2> $cmd
729 bind $w <Control-Button-1> $cmd
733 proc apply_config {} {
734 global repo_config font_descs
736 foreach option $font_descs {
737 set name [lindex $option 0]
738 set font [lindex $option 1]
739 if {[catch {
740 set need_weight 1
741 foreach {cn cv} $repo_config(gui.$name) {
742 if {$cn eq {-weight}} {
743 set need_weight 0
745 font configure $font $cn $cv
747 if {$need_weight} {
748 font configure $font -weight normal
750 } err]} {
751 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
753 foreach {cn cv} [font configure $font] {
754 font configure ${font}bold $cn $cv
755 font configure ${font}italic $cn $cv
757 font configure ${font}bold -weight bold
758 font configure ${font}italic -slant italic
761 global use_ttk NS
762 set use_ttk 0
763 set NS {}
764 if {$repo_config(gui.usettk)} {
765 set use_ttk [package vsatisfies [package provide Tk] 8.5]
766 if {$use_ttk} {
767 set NS ttk
768 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
769 pave_toplevel .
774 set default_config(branch.autosetupmerge) true
775 set default_config(merge.tool) {}
776 set default_config(mergetool.keepbackup) true
777 set default_config(merge.diffstat) true
778 set default_config(merge.summary) false
779 set default_config(merge.verbosity) 2
780 set default_config(user.name) {}
781 set default_config(user.email) {}
783 set default_config(gui.encoding) [encoding system]
784 set default_config(gui.matchtrackingbranch) false
785 set default_config(gui.pruneduringfetch) false
786 set default_config(gui.trustmtime) false
787 set default_config(gui.fastcopyblame) false
788 set default_config(gui.copyblamethreshold) 40
789 set default_config(gui.blamehistoryctx) 7
790 set default_config(gui.diffcontext) 5
791 set default_config(gui.commitmsgwidth) 75
792 set default_config(gui.newbranchtemplate) {}
793 set default_config(gui.spellingdictionary) {}
794 set default_config(gui.fontui) [font configure font_ui]
795 set default_config(gui.fontdiff) [font configure font_diff]
796 # TODO: this option should be added to the git-config documentation
797 set default_config(gui.maxfilesdisplayed) 5000
798 set default_config(gui.usettk) 1
799 set font_descs {
800 {fontui font_ui {mc "Main Font"}}
801 {fontdiff font_diff {mc "Diff/Console Font"}}
804 ######################################################################
806 ## find git
808 set _git [_which git]
809 if {$_git eq {}} {
810 catch {wm withdraw .}
811 tk_messageBox \
812 -icon error \
813 -type ok \
814 -title [mc "git-gui: fatal error"] \
815 -message [mc "Cannot find git in PATH."]
816 exit 1
819 ######################################################################
821 ## version check
823 if {[catch {set _git_version [git --version]} err]} {
824 catch {wm withdraw .}
825 tk_messageBox \
826 -icon error \
827 -type ok \
828 -title [mc "git-gui: fatal error"] \
829 -message "Cannot determine Git version:
831 $err
833 [appname] requires Git 1.5.0 or later."
834 exit 1
836 if {![regsub {^git version } $_git_version {} _git_version]} {
837 catch {wm withdraw .}
838 tk_messageBox \
839 -icon error \
840 -type ok \
841 -title [mc "git-gui: fatal error"] \
842 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
843 exit 1
846 set _real_git_version $_git_version
847 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
848 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
849 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
850 regsub {\.GIT$} $_git_version {} _git_version
851 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
853 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
854 catch {wm withdraw .}
855 if {[tk_messageBox \
856 -icon warning \
857 -type yesno \
858 -default no \
859 -title "[appname]: warning" \
860 -message [mc "Git version cannot be determined.
862 %s claims it is version '%s'.
864 %s requires at least Git 1.5.0 or later.
866 Assume '%s' is version 1.5.0?
867 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
868 set _git_version 1.5.0
869 } else {
870 exit 1
873 unset _real_git_version
875 proc git-version {args} {
876 global _git_version
878 switch [llength $args] {
880 return $_git_version
884 set op [lindex $args 0]
885 set vr [lindex $args 1]
886 set cm [package vcompare $_git_version $vr]
887 return [expr $cm $op 0]
891 set type [lindex $args 0]
892 set name [lindex $args 1]
893 set parm [lindex $args 2]
894 set body [lindex $args 3]
896 if {($type ne {proc} && $type ne {method})} {
897 error "Invalid arguments to git-version"
899 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
900 error "Last arm of $type $name must be default"
903 foreach {op vr cb} [lrange $body 0 end-2] {
904 if {[git-version $op $vr]} {
905 return [uplevel [list $type $name $parm $cb]]
909 return [uplevel [list $type $name $parm [lindex $body end]]]
912 default {
913 error "git-version >= x"
919 if {[git-version < 1.5]} {
920 catch {wm withdraw .}
921 tk_messageBox \
922 -icon error \
923 -type ok \
924 -title [mc "git-gui: fatal error"] \
925 -message "[appname] requires Git 1.5.0 or later.
927 You are using [git-version]:
929 [git --version]"
930 exit 1
933 ######################################################################
935 ## configure our library
937 set idx [file join $oguilib tclIndex]
938 if {[catch {set fd [open $idx r]} err]} {
939 catch {wm withdraw .}
940 tk_messageBox \
941 -icon error \
942 -type ok \
943 -title [mc "git-gui: fatal error"] \
944 -message $err
945 exit 1
947 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
948 set idx [list]
949 while {[gets $fd n] >= 0} {
950 if {$n ne {} && ![string match #* $n]} {
951 lappend idx $n
954 } else {
955 set idx {}
957 close $fd
959 if {$idx ne {}} {
960 set loaded [list]
961 foreach p $idx {
962 if {[lsearch -exact $loaded $p] >= 0} continue
963 source [file join $oguilib $p]
964 lappend loaded $p
966 unset loaded p
967 } else {
968 set auto_path [concat [list $oguilib] $auto_path]
970 unset -nocomplain idx fd
972 ######################################################################
974 ## config file parsing
976 git-version proc _parse_config {arr_name args} {
977 >= 1.5.3 {
978 upvar $arr_name arr
979 array unset arr
980 set buf {}
981 catch {
982 set fd_rc [eval \
983 [list git_read config] \
984 $args \
985 [list --null --list]]
986 fconfigure $fd_rc -translation binary
987 set buf [read $fd_rc]
988 close $fd_rc
990 foreach line [split $buf "\0"] {
991 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
992 if {[is_many_config $name]} {
993 lappend arr($name) $value
994 } else {
995 set arr($name) $value
1000 default {
1001 upvar $arr_name arr
1002 array unset arr
1003 catch {
1004 set fd_rc [eval [list git_read config --list] $args]
1005 while {[gets $fd_rc line] >= 0} {
1006 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1007 if {[is_many_config $name]} {
1008 lappend arr($name) $value
1009 } else {
1010 set arr($name) $value
1014 close $fd_rc
1019 proc load_config {include_global} {
1020 global repo_config global_config system_config default_config
1022 if {$include_global} {
1023 _parse_config system_config --system
1024 _parse_config global_config --global
1026 _parse_config repo_config
1028 foreach name [array names default_config] {
1029 if {[catch {set v $system_config($name)}]} {
1030 set system_config($name) $default_config($name)
1033 foreach name [array names system_config] {
1034 if {[catch {set v $global_config($name)}]} {
1035 set global_config($name) $system_config($name)
1037 if {[catch {set v $repo_config($name)}]} {
1038 set repo_config($name) $system_config($name)
1043 ######################################################################
1045 ## feature option selection
1047 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1048 unset _junk
1049 } else {
1050 set subcommand gui
1052 if {$subcommand eq {gui.sh}} {
1053 set subcommand gui
1055 if {$subcommand eq {gui} && [llength $argv] > 0} {
1056 set subcommand [lindex $argv 0]
1057 set argv [lrange $argv 1 end]
1060 enable_option multicommit
1061 enable_option branch
1062 enable_option transport
1063 disable_option bare
1065 switch -- $subcommand {
1066 browser -
1067 blame {
1068 enable_option bare
1070 disable_option multicommit
1071 disable_option branch
1072 disable_option transport
1074 citool {
1075 enable_option singlecommit
1076 enable_option retcode
1078 disable_option multicommit
1079 disable_option branch
1080 disable_option transport
1082 while {[llength $argv] > 0} {
1083 set a [lindex $argv 0]
1084 switch -- $a {
1085 --amend {
1086 enable_option initialamend
1088 --nocommit {
1089 enable_option nocommit
1090 enable_option nocommitmsg
1092 --commitmsg {
1093 disable_option nocommitmsg
1095 default {
1096 break
1100 set argv [lrange $argv 1 end]
1105 ######################################################################
1107 ## execution environment
1109 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1111 # Suggest our implementation of askpass, if none is set
1112 if {![info exists env(SSH_ASKPASS)]} {
1113 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1116 ######################################################################
1118 ## repository setup
1120 set picked 0
1121 if {[catch {
1122 set _gitdir $env(GIT_DIR)
1123 set _prefix {}
1125 && [catch {
1126 # beware that from the .git dir this sets _gitdir to .
1127 # and _prefix to the empty string
1128 set _gitdir [git rev-parse --git-dir]
1129 set _prefix [git rev-parse --show-prefix]
1130 } err]} {
1131 load_config 1
1132 apply_config
1133 choose_repository::pick
1134 set picked 1
1137 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1138 # run from the .git dir itself) lest the routines to find the worktree
1139 # get confused
1140 if {$_gitdir eq "."} {
1141 set _gitdir [pwd]
1144 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1145 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1147 if {![file isdirectory $_gitdir]} {
1148 catch {wm withdraw .}
1149 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1150 exit 1
1152 # _gitdir exists, so try loading the config
1153 load_config 0
1154 apply_config
1155 # try to set work tree from environment, falling back to core.worktree
1156 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1157 set _gitworktree [get_config core.worktree]
1159 if {$_prefix ne {}} {
1160 if {$_gitworktree eq {}} {
1161 regsub -all {[^/]+/} $_prefix ../ cdup
1162 } else {
1163 set cdup $_gitworktree
1165 if {[catch {cd $cdup} err]} {
1166 catch {wm withdraw .}
1167 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1168 exit 1
1170 set _gitworktree [pwd]
1171 unset cdup
1172 } elseif {![is_enabled bare]} {
1173 if {[is_bare]} {
1174 catch {wm withdraw .}
1175 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1176 exit 1
1178 if {$_gitworktree eq {}} {
1179 set _gitworktree [file dirname $_gitdir]
1181 if {[catch {cd $_gitworktree} err]} {
1182 catch {wm withdraw .}
1183 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1184 exit 1
1186 set _gitworktree [pwd]
1188 set _reponame [file split [file normalize $_gitdir]]
1189 if {[lindex $_reponame end] eq {.git}} {
1190 set _reponame [lindex $_reponame end-1]
1191 } else {
1192 set _reponame [lindex $_reponame end]
1195 ######################################################################
1197 ## global init
1199 set current_diff_path {}
1200 set current_diff_side {}
1201 set diff_actions [list]
1203 set HEAD {}
1204 set PARENT {}
1205 set MERGE_HEAD [list]
1206 set commit_type {}
1207 set empty_tree {}
1208 set current_branch {}
1209 set is_detached 0
1210 set current_diff_path {}
1211 set is_3way_diff 0
1212 set is_submodule_diff 0
1213 set is_conflict_diff 0
1214 set selected_commit_type new
1215 set diff_empty_count 0
1217 set nullid "0000000000000000000000000000000000000000"
1218 set nullid2 "0000000000000000000000000000000000000001"
1220 ######################################################################
1222 ## task management
1224 set rescan_active 0
1225 set diff_active 0
1226 set last_clicked {}
1228 set disable_on_lock [list]
1229 set index_lock_type none
1231 proc lock_index {type} {
1232 global index_lock_type disable_on_lock
1234 if {$index_lock_type eq {none}} {
1235 set index_lock_type $type
1236 foreach w $disable_on_lock {
1237 uplevel #0 $w disabled
1239 return 1
1240 } elseif {$index_lock_type eq "begin-$type"} {
1241 set index_lock_type $type
1242 return 1
1244 return 0
1247 proc unlock_index {} {
1248 global index_lock_type disable_on_lock
1250 set index_lock_type none
1251 foreach w $disable_on_lock {
1252 uplevel #0 $w normal
1256 ######################################################################
1258 ## status
1260 proc repository_state {ctvar hdvar mhvar} {
1261 global current_branch
1262 upvar $ctvar ct $hdvar hd $mhvar mh
1264 set mh [list]
1266 load_current_branch
1267 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1268 set hd {}
1269 set ct initial
1270 return
1273 set merge_head [gitdir MERGE_HEAD]
1274 if {[file exists $merge_head]} {
1275 set ct merge
1276 set fd_mh [open $merge_head r]
1277 while {[gets $fd_mh line] >= 0} {
1278 lappend mh $line
1280 close $fd_mh
1281 return
1284 set ct normal
1287 proc PARENT {} {
1288 global PARENT empty_tree
1290 set p [lindex $PARENT 0]
1291 if {$p ne {}} {
1292 return $p
1294 if {$empty_tree eq {}} {
1295 set empty_tree [git mktree << {}]
1297 return $empty_tree
1300 proc force_amend {} {
1301 global selected_commit_type
1302 global HEAD PARENT MERGE_HEAD commit_type
1304 repository_state newType newHEAD newMERGE_HEAD
1305 set HEAD $newHEAD
1306 set PARENT $newHEAD
1307 set MERGE_HEAD $newMERGE_HEAD
1308 set commit_type $newType
1310 set selected_commit_type amend
1311 do_select_commit_type
1314 proc rescan {after {honor_trustmtime 1}} {
1315 global HEAD PARENT MERGE_HEAD commit_type
1316 global ui_index ui_workdir ui_comm
1317 global rescan_active file_states
1318 global repo_config
1320 if {$rescan_active > 0 || ![lock_index read]} return
1322 repository_state newType newHEAD newMERGE_HEAD
1323 if {[string match amend* $commit_type]
1324 && $newType eq {normal}
1325 && $newHEAD eq $HEAD} {
1326 } else {
1327 set HEAD $newHEAD
1328 set PARENT $newHEAD
1329 set MERGE_HEAD $newMERGE_HEAD
1330 set commit_type $newType
1333 array unset file_states
1335 if {!$::GITGUI_BCK_exists &&
1336 (![$ui_comm edit modified]
1337 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1338 if {[string match amend* $commit_type]} {
1339 } elseif {[load_message GITGUI_MSG]} {
1340 } elseif {[run_prepare_commit_msg_hook]} {
1341 } elseif {[load_message MERGE_MSG]} {
1342 } elseif {[load_message SQUASH_MSG]} {
1344 $ui_comm edit reset
1345 $ui_comm edit modified false
1348 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1349 rescan_stage2 {} $after
1350 } else {
1351 set rescan_active 1
1352 ui_status [mc "Refreshing file status..."]
1353 set fd_rf [git_read update-index \
1354 -q \
1355 --unmerged \
1356 --ignore-missing \
1357 --refresh \
1359 fconfigure $fd_rf -blocking 0 -translation binary
1360 fileevent $fd_rf readable \
1361 [list rescan_stage2 $fd_rf $after]
1365 if {[is_Cygwin]} {
1366 set is_git_info_exclude {}
1367 proc have_info_exclude {} {
1368 global is_git_info_exclude
1370 if {$is_git_info_exclude eq {}} {
1371 if {[catch {exec test -f [gitdir info exclude]}]} {
1372 set is_git_info_exclude 0
1373 } else {
1374 set is_git_info_exclude 1
1377 return $is_git_info_exclude
1379 } else {
1380 proc have_info_exclude {} {
1381 return [file readable [gitdir info exclude]]
1385 proc rescan_stage2 {fd after} {
1386 global rescan_active buf_rdi buf_rdf buf_rlo
1388 if {$fd ne {}} {
1389 read $fd
1390 if {![eof $fd]} return
1391 close $fd
1394 set ls_others [list --exclude-per-directory=.gitignore]
1395 if {[have_info_exclude]} {
1396 lappend ls_others "--exclude-from=[gitdir info exclude]"
1398 set user_exclude [get_config core.excludesfile]
1399 if {$user_exclude ne {} && [file readable $user_exclude]} {
1400 lappend ls_others "--exclude-from=$user_exclude"
1403 set buf_rdi {}
1404 set buf_rdf {}
1405 set buf_rlo {}
1407 set rescan_active 3
1408 ui_status [mc "Scanning for modified files ..."]
1409 set fd_di [git_read diff-index --cached -z [PARENT]]
1410 set fd_df [git_read diff-files -z]
1411 set fd_lo [eval git_read ls-files --others -z $ls_others]
1413 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1414 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1415 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1416 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1417 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1418 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1421 proc load_message {file} {
1422 global ui_comm
1424 set f [gitdir $file]
1425 if {[file isfile $f]} {
1426 if {[catch {set fd [open $f r]}]} {
1427 return 0
1429 fconfigure $fd -eofchar {}
1430 set content [string trim [read $fd]]
1431 close $fd
1432 regsub -all -line {[ \r\t]+$} $content {} content
1433 $ui_comm delete 0.0 end
1434 $ui_comm insert end $content
1435 return 1
1437 return 0
1440 proc run_prepare_commit_msg_hook {} {
1441 global pch_error
1443 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1444 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1445 # empty file but existant file.
1447 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1449 if {[file isfile [gitdir MERGE_MSG]]} {
1450 set pcm_source "merge"
1451 set fd_mm [open [gitdir MERGE_MSG] r]
1452 puts -nonewline $fd_pcm [read $fd_mm]
1453 close $fd_mm
1454 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1455 set pcm_source "squash"
1456 set fd_sm [open [gitdir SQUASH_MSG] r]
1457 puts -nonewline $fd_pcm [read $fd_sm]
1458 close $fd_sm
1459 } else {
1460 set pcm_source ""
1463 close $fd_pcm
1465 set fd_ph [githook_read prepare-commit-msg \
1466 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1467 if {$fd_ph eq {}} {
1468 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1469 return 0;
1472 ui_status [mc "Calling prepare-commit-msg hook..."]
1473 set pch_error {}
1475 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1476 fileevent $fd_ph readable \
1477 [list prepare_commit_msg_hook_wait $fd_ph]
1479 return 1;
1482 proc prepare_commit_msg_hook_wait {fd_ph} {
1483 global pch_error
1485 append pch_error [read $fd_ph]
1486 fconfigure $fd_ph -blocking 1
1487 if {[eof $fd_ph]} {
1488 if {[catch {close $fd_ph}]} {
1489 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1490 hook_failed_popup prepare-commit-msg $pch_error
1491 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1492 exit 1
1493 } else {
1494 load_message PREPARE_COMMIT_MSG
1496 set pch_error {}
1497 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1498 return
1500 fconfigure $fd_ph -blocking 0
1501 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1504 proc read_diff_index {fd after} {
1505 global buf_rdi
1507 append buf_rdi [read $fd]
1508 set c 0
1509 set n [string length $buf_rdi]
1510 while {$c < $n} {
1511 set z1 [string first "\0" $buf_rdi $c]
1512 if {$z1 == -1} break
1513 incr z1
1514 set z2 [string first "\0" $buf_rdi $z1]
1515 if {$z2 == -1} break
1517 incr c
1518 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1519 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1520 merge_state \
1521 [encoding convertfrom $p] \
1522 [lindex $i 4]? \
1523 [list [lindex $i 0] [lindex $i 2]] \
1524 [list]
1525 set c $z2
1526 incr c
1528 if {$c < $n} {
1529 set buf_rdi [string range $buf_rdi $c end]
1530 } else {
1531 set buf_rdi {}
1534 rescan_done $fd buf_rdi $after
1537 proc read_diff_files {fd after} {
1538 global buf_rdf
1540 append buf_rdf [read $fd]
1541 set c 0
1542 set n [string length $buf_rdf]
1543 while {$c < $n} {
1544 set z1 [string first "\0" $buf_rdf $c]
1545 if {$z1 == -1} break
1546 incr z1
1547 set z2 [string first "\0" $buf_rdf $z1]
1548 if {$z2 == -1} break
1550 incr c
1551 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1552 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1553 merge_state \
1554 [encoding convertfrom $p] \
1555 ?[lindex $i 4] \
1556 [list] \
1557 [list [lindex $i 0] [lindex $i 2]]
1558 set c $z2
1559 incr c
1561 if {$c < $n} {
1562 set buf_rdf [string range $buf_rdf $c end]
1563 } else {
1564 set buf_rdf {}
1567 rescan_done $fd buf_rdf $after
1570 proc read_ls_others {fd after} {
1571 global buf_rlo
1573 append buf_rlo [read $fd]
1574 set pck [split $buf_rlo "\0"]
1575 set buf_rlo [lindex $pck end]
1576 foreach p [lrange $pck 0 end-1] {
1577 set p [encoding convertfrom $p]
1578 if {[string index $p end] eq {/}} {
1579 set p [string range $p 0 end-1]
1581 merge_state $p ?O
1583 rescan_done $fd buf_rlo $after
1586 proc rescan_done {fd buf after} {
1587 global rescan_active current_diff_path
1588 global file_states repo_config
1589 upvar $buf to_clear
1591 if {![eof $fd]} return
1592 set to_clear {}
1593 close $fd
1594 if {[incr rescan_active -1] > 0} return
1596 prune_selection
1597 unlock_index
1598 display_all_files
1599 if {$current_diff_path ne {}} { reshow_diff $after }
1600 if {$current_diff_path eq {}} { select_first_diff $after }
1603 proc prune_selection {} {
1604 global file_states selected_paths
1606 foreach path [array names selected_paths] {
1607 if {[catch {set still_here $file_states($path)}]} {
1608 unset selected_paths($path)
1613 ######################################################################
1615 ## ui helpers
1617 proc mapicon {w state path} {
1618 global all_icons
1620 if {[catch {set r $all_icons($state$w)}]} {
1621 puts "error: no icon for $w state={$state} $path"
1622 return file_plain
1624 return $r
1627 proc mapdesc {state path} {
1628 global all_descs
1630 if {[catch {set r $all_descs($state)}]} {
1631 puts "error: no desc for state={$state} $path"
1632 return $state
1634 return $r
1637 proc ui_status {msg} {
1638 global main_status
1639 if {[info exists main_status]} {
1640 $main_status show $msg
1644 proc ui_ready {{test {}}} {
1645 global main_status
1646 if {[info exists main_status]} {
1647 $main_status show [mc "Ready."] $test
1651 proc escape_path {path} {
1652 regsub -all {\\} $path "\\\\" path
1653 regsub -all "\n" $path "\\n" path
1654 return $path
1657 proc short_path {path} {
1658 return [escape_path [lindex [file split $path] end]]
1661 set next_icon_id 0
1662 set null_sha1 [string repeat 0 40]
1664 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1665 global file_states next_icon_id null_sha1
1667 set s0 [string index $new_state 0]
1668 set s1 [string index $new_state 1]
1670 if {[catch {set info $file_states($path)}]} {
1671 set state __
1672 set icon n[incr next_icon_id]
1673 } else {
1674 set state [lindex $info 0]
1675 set icon [lindex $info 1]
1676 if {$head_info eq {}} {set head_info [lindex $info 2]}
1677 if {$index_info eq {}} {set index_info [lindex $info 3]}
1680 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1681 elseif {$s0 eq {_}} {set s0 _}
1683 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1684 elseif {$s1 eq {_}} {set s1 _}
1686 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1687 set head_info [list 0 $null_sha1]
1688 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1689 && $head_info eq {}} {
1690 set head_info $index_info
1691 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1692 set index_info $head_info
1693 set head_info {}
1696 set file_states($path) [list $s0$s1 $icon \
1697 $head_info $index_info \
1699 return $state
1702 proc display_file_helper {w path icon_name old_m new_m} {
1703 global file_lists
1705 if {$new_m eq {_}} {
1706 set lno [lsearch -sorted -exact $file_lists($w) $path]
1707 if {$lno >= 0} {
1708 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1709 incr lno
1710 $w conf -state normal
1711 $w delete $lno.0 [expr {$lno + 1}].0
1712 $w conf -state disabled
1714 } elseif {$old_m eq {_} && $new_m ne {_}} {
1715 lappend file_lists($w) $path
1716 set file_lists($w) [lsort -unique $file_lists($w)]
1717 set lno [lsearch -sorted -exact $file_lists($w) $path]
1718 incr lno
1719 $w conf -state normal
1720 $w image create $lno.0 \
1721 -align center -padx 5 -pady 1 \
1722 -name $icon_name \
1723 -image [mapicon $w $new_m $path]
1724 $w insert $lno.1 "[escape_path $path]\n"
1725 $w conf -state disabled
1726 } elseif {$old_m ne $new_m} {
1727 $w conf -state normal
1728 $w image conf $icon_name -image [mapicon $w $new_m $path]
1729 $w conf -state disabled
1733 proc display_file {path state} {
1734 global file_states selected_paths
1735 global ui_index ui_workdir
1737 set old_m [merge_state $path $state]
1738 set s $file_states($path)
1739 set new_m [lindex $s 0]
1740 set icon_name [lindex $s 1]
1742 set o [string index $old_m 0]
1743 set n [string index $new_m 0]
1744 if {$o eq {U}} {
1745 set o _
1747 if {$n eq {U}} {
1748 set n _
1750 display_file_helper $ui_index $path $icon_name $o $n
1752 if {[string index $old_m 0] eq {U}} {
1753 set o U
1754 } else {
1755 set o [string index $old_m 1]
1757 if {[string index $new_m 0] eq {U}} {
1758 set n U
1759 } else {
1760 set n [string index $new_m 1]
1762 display_file_helper $ui_workdir $path $icon_name $o $n
1764 if {$new_m eq {__}} {
1765 unset file_states($path)
1766 catch {unset selected_paths($path)}
1770 proc display_all_files_helper {w path icon_name m} {
1771 global file_lists
1773 lappend file_lists($w) $path
1774 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1775 $w image create end \
1776 -align center -padx 5 -pady 1 \
1777 -name $icon_name \
1778 -image [mapicon $w $m $path]
1779 $w insert end "[escape_path $path]\n"
1782 set files_warning 0
1783 proc display_all_files {} {
1784 global ui_index ui_workdir
1785 global file_states file_lists
1786 global last_clicked
1787 global files_warning
1789 $ui_index conf -state normal
1790 $ui_workdir conf -state normal
1792 $ui_index delete 0.0 end
1793 $ui_workdir delete 0.0 end
1794 set last_clicked {}
1796 set file_lists($ui_index) [list]
1797 set file_lists($ui_workdir) [list]
1799 set to_display [lsort [array names file_states]]
1800 set display_limit [get_config gui.maxfilesdisplayed]
1801 if {[llength $to_display] > $display_limit} {
1802 if {!$files_warning} {
1803 # do not repeatedly warn:
1804 set files_warning 1
1805 info_popup [mc "Displaying only %s of %s files." \
1806 $display_limit [llength $to_display]]
1808 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1810 foreach path $to_display {
1811 set s $file_states($path)
1812 set m [lindex $s 0]
1813 set icon_name [lindex $s 1]
1815 set s [string index $m 0]
1816 if {$s ne {U} && $s ne {_}} {
1817 display_all_files_helper $ui_index $path \
1818 $icon_name $s
1821 if {[string index $m 0] eq {U}} {
1822 set s U
1823 } else {
1824 set s [string index $m 1]
1826 if {$s ne {_}} {
1827 display_all_files_helper $ui_workdir $path \
1828 $icon_name $s
1832 $ui_index conf -state disabled
1833 $ui_workdir conf -state disabled
1836 ######################################################################
1838 ## icons
1840 set filemask {
1841 #define mask_width 14
1842 #define mask_height 15
1843 static unsigned char mask_bits[] = {
1844 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1845 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1846 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1849 image create bitmap file_plain -background white -foreground black -data {
1850 #define plain_width 14
1851 #define plain_height 15
1852 static unsigned char plain_bits[] = {
1853 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1854 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1855 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1856 } -maskdata $filemask
1858 image create bitmap file_mod -background white -foreground blue -data {
1859 #define mod_width 14
1860 #define mod_height 15
1861 static unsigned char mod_bits[] = {
1862 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1863 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1864 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1865 } -maskdata $filemask
1867 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1868 #define file_fulltick_width 14
1869 #define file_fulltick_height 15
1870 static unsigned char file_fulltick_bits[] = {
1871 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1872 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1873 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1874 } -maskdata $filemask
1876 image create bitmap file_question -background white -foreground black -data {
1877 #define file_question_width 14
1878 #define file_question_height 15
1879 static unsigned char file_question_bits[] = {
1880 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1881 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1882 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1883 } -maskdata $filemask
1885 image create bitmap file_removed -background white -foreground red -data {
1886 #define file_removed_width 14
1887 #define file_removed_height 15
1888 static unsigned char file_removed_bits[] = {
1889 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1890 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1891 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1892 } -maskdata $filemask
1894 image create bitmap file_merge -background white -foreground blue -data {
1895 #define file_merge_width 14
1896 #define file_merge_height 15
1897 static unsigned char file_merge_bits[] = {
1898 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1899 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1900 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1901 } -maskdata $filemask
1903 image create bitmap file_statechange -background white -foreground green -data {
1904 #define file_merge_width 14
1905 #define file_merge_height 15
1906 static unsigned char file_statechange_bits[] = {
1907 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1908 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1909 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1910 } -maskdata $filemask
1912 set ui_index .vpane.files.index.list
1913 set ui_workdir .vpane.files.workdir.list
1915 set all_icons(_$ui_index) file_plain
1916 set all_icons(A$ui_index) file_plain
1917 set all_icons(M$ui_index) file_fulltick
1918 set all_icons(D$ui_index) file_removed
1919 set all_icons(U$ui_index) file_merge
1920 set all_icons(T$ui_index) file_statechange
1922 set all_icons(_$ui_workdir) file_plain
1923 set all_icons(M$ui_workdir) file_mod
1924 set all_icons(D$ui_workdir) file_question
1925 set all_icons(U$ui_workdir) file_merge
1926 set all_icons(O$ui_workdir) file_plain
1927 set all_icons(T$ui_workdir) file_statechange
1929 set max_status_desc 0
1930 foreach i {
1931 {__ {mc "Unmodified"}}
1933 {_M {mc "Modified, not staged"}}
1934 {M_ {mc "Staged for commit"}}
1935 {MM {mc "Portions staged for commit"}}
1936 {MD {mc "Staged for commit, missing"}}
1938 {_T {mc "File type changed, not staged"}}
1939 {T_ {mc "File type changed, staged"}}
1941 {_O {mc "Untracked, not staged"}}
1942 {A_ {mc "Staged for commit"}}
1943 {AM {mc "Portions staged for commit"}}
1944 {AD {mc "Staged for commit, missing"}}
1946 {_D {mc "Missing"}}
1947 {D_ {mc "Staged for removal"}}
1948 {DO {mc "Staged for removal, still present"}}
1950 {_U {mc "Requires merge resolution"}}
1951 {U_ {mc "Requires merge resolution"}}
1952 {UU {mc "Requires merge resolution"}}
1953 {UM {mc "Requires merge resolution"}}
1954 {UD {mc "Requires merge resolution"}}
1955 {UT {mc "Requires merge resolution"}}
1957 set text [eval [lindex $i 1]]
1958 if {$max_status_desc < [string length $text]} {
1959 set max_status_desc [string length $text]
1961 set all_descs([lindex $i 0]) $text
1963 unset i
1965 ######################################################################
1967 ## util
1969 proc scrollbar2many {list mode args} {
1970 foreach w $list {eval $w $mode $args}
1973 proc many2scrollbar {list mode sb top bottom} {
1974 $sb set $top $bottom
1975 foreach w $list {$w $mode moveto $top}
1978 proc incr_font_size {font {amt 1}} {
1979 set sz [font configure $font -size]
1980 incr sz $amt
1981 font configure $font -size $sz
1982 font configure ${font}bold -size $sz
1983 font configure ${font}italic -size $sz
1986 ######################################################################
1988 ## ui commands
1990 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1992 proc do_gitk {revs {is_submodule false}} {
1993 global current_diff_path file_states current_diff_side ui_index
1994 global _gitworktree
1996 # -- Always start gitk through whatever we were loaded with. This
1997 # lets us bypass using shell process on Windows systems.
1999 set exe [_which gitk -script]
2000 set cmd [list [info nameofexecutable] $exe]
2001 if {$exe eq {}} {
2002 error_popup [mc "Couldn't find gitk in PATH"]
2003 } else {
2004 global env
2006 if {[info exists env(GIT_DIR)]} {
2007 set old_GIT_DIR $env(GIT_DIR)
2008 } else {
2009 set old_GIT_DIR {}
2012 set pwd [pwd]
2014 if {!$is_submodule} {
2015 if {![is_bare]} {
2016 cd $_gitworktree
2018 set env(GIT_DIR) [file normalize [gitdir]]
2019 } else {
2020 cd $current_diff_path
2021 if {$revs eq {--}} {
2022 set s $file_states($current_diff_path)
2023 set old_sha1 {}
2024 set new_sha1 {}
2025 switch -glob -- [lindex $s 0] {
2026 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2027 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2028 MM {
2029 if {$current_diff_side eq $ui_index} {
2030 set old_sha1 [lindex [lindex $s 2] 1]
2031 set new_sha1 [lindex [lindex $s 3] 1]
2032 } else {
2033 set old_sha1 [lindex [lindex $s 3] 1]
2037 set revs $old_sha1...$new_sha1
2039 if {[info exists env(GIT_DIR)]} {
2040 unset env(GIT_DIR)
2043 eval exec $cmd $revs "--" "--" &
2045 if {$old_GIT_DIR ne {}} {
2046 set env(GIT_DIR) $old_GIT_DIR
2048 cd $pwd
2050 ui_status $::starting_gitk_msg
2051 after 10000 {
2052 ui_ready $starting_gitk_msg
2057 proc do_git_gui {} {
2058 global current_diff_path
2060 # -- Always start git gui through whatever we were loaded with. This
2061 # lets us bypass using shell process on Windows systems.
2063 set exe [list [_which git]]
2064 if {$exe eq {}} {
2065 error_popup [mc "Couldn't find git gui in PATH"]
2066 } else {
2067 global env
2069 if {[info exists env(GIT_DIR)]} {
2070 set old_GIT_DIR $env(GIT_DIR)
2071 unset env(GIT_DIR)
2072 } else {
2073 set old_GIT_DIR {}
2076 set pwd [pwd]
2077 cd $current_diff_path
2079 eval exec $exe gui &
2081 if {$old_GIT_DIR ne {}} {
2082 set env(GIT_DIR) $old_GIT_DIR
2084 cd $pwd
2086 ui_status $::starting_gitk_msg
2087 after 10000 {
2088 ui_ready $starting_gitk_msg
2093 proc do_explore {} {
2094 global _gitworktree
2095 set explorer {}
2096 if {[is_Cygwin] || [is_Windows]} {
2097 set explorer "explorer.exe"
2098 } elseif {[is_MacOSX]} {
2099 set explorer "open"
2100 } else {
2101 # freedesktop.org-conforming system is our best shot
2102 set explorer "xdg-open"
2104 eval exec $explorer $_gitworktree &
2107 set is_quitting 0
2108 set ret_code 1
2110 proc terminate_me {win} {
2111 global ret_code
2112 if {$win ne {.}} return
2113 exit $ret_code
2116 proc do_quit {{rc {1}}} {
2117 global ui_comm is_quitting repo_config commit_type
2118 global GITGUI_BCK_exists GITGUI_BCK_i
2119 global ui_comm_spell
2120 global ret_code use_ttk
2122 if {$is_quitting} return
2123 set is_quitting 1
2125 if {[winfo exists $ui_comm]} {
2126 # -- Stash our current commit buffer.
2128 set save [gitdir GITGUI_MSG]
2129 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2130 file rename -force [gitdir GITGUI_BCK] $save
2131 set GITGUI_BCK_exists 0
2132 } else {
2133 set msg [string trim [$ui_comm get 0.0 end]]
2134 regsub -all -line {[ \r\t]+$} $msg {} msg
2135 if {(![string match amend* $commit_type]
2136 || [$ui_comm edit modified])
2137 && $msg ne {}} {
2138 catch {
2139 set fd [open $save w]
2140 puts -nonewline $fd $msg
2141 close $fd
2143 } else {
2144 catch {file delete $save}
2148 # -- Cancel our spellchecker if its running.
2150 if {[info exists ui_comm_spell]} {
2151 $ui_comm_spell stop
2154 # -- Remove our editor backup, its not needed.
2156 after cancel $GITGUI_BCK_i
2157 if {$GITGUI_BCK_exists} {
2158 catch {file delete [gitdir GITGUI_BCK]}
2161 # -- Stash our current window geometry into this repository.
2163 set cfg_wmstate [wm state .]
2164 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2165 set rc_wmstate {}
2167 if {$cfg_wmstate ne $rc_wmstate} {
2168 catch {git config gui.wmstate $cfg_wmstate}
2170 if {$cfg_wmstate eq {zoomed}} {
2171 # on Windows wm geometry will lie about window
2172 # position (but not size) when window is zoomed
2173 # restore the window before querying wm geometry
2174 wm state . normal
2176 set cfg_geometry [list]
2177 lappend cfg_geometry [wm geometry .]
2178 if {$use_ttk} {
2179 lappend cfg_geometry [.vpane sashpos 0]
2180 lappend cfg_geometry [.vpane.files sashpos 0]
2181 } else {
2182 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2183 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2185 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2186 set rc_geometry {}
2188 if {$cfg_geometry ne $rc_geometry} {
2189 catch {git config gui.geometry $cfg_geometry}
2193 set ret_code $rc
2195 # Briefly enable send again, working around Tk bug
2196 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2197 tk appname [appname]
2199 destroy .
2202 proc do_rescan {} {
2203 rescan ui_ready
2206 proc ui_do_rescan {} {
2207 rescan {force_first_diff ui_ready}
2210 proc do_commit {} {
2211 commit_tree
2214 proc next_diff {{after {}}} {
2215 global next_diff_p next_diff_w next_diff_i
2216 show_diff $next_diff_p $next_diff_w {} {} $after
2219 proc find_anchor_pos {lst name} {
2220 set lid [lsearch -sorted -exact $lst $name]
2222 if {$lid == -1} {
2223 set lid 0
2224 foreach lname $lst {
2225 if {$lname >= $name} break
2226 incr lid
2230 return $lid
2233 proc find_file_from {flist idx delta path mmask} {
2234 global file_states
2236 set len [llength $flist]
2237 while {$idx >= 0 && $idx < $len} {
2238 set name [lindex $flist $idx]
2240 if {$name ne $path && [info exists file_states($name)]} {
2241 set state [lindex $file_states($name) 0]
2243 if {$mmask eq {} || [regexp $mmask $state]} {
2244 return $idx
2248 incr idx $delta
2251 return {}
2254 proc find_next_diff {w path {lno {}} {mmask {}}} {
2255 global next_diff_p next_diff_w next_diff_i
2256 global file_lists ui_index ui_workdir
2258 set flist $file_lists($w)
2259 if {$lno eq {}} {
2260 set lno [find_anchor_pos $flist $path]
2261 } else {
2262 incr lno -1
2265 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2266 if {$w eq $ui_index} {
2267 set mmask "^$mmask"
2268 } else {
2269 set mmask "$mmask\$"
2273 set idx [find_file_from $flist $lno 1 $path $mmask]
2274 if {$idx eq {}} {
2275 incr lno -1
2276 set idx [find_file_from $flist $lno -1 $path $mmask]
2279 if {$idx ne {}} {
2280 set next_diff_w $w
2281 set next_diff_p [lindex $flist $idx]
2282 set next_diff_i [expr {$idx+1}]
2283 return 1
2284 } else {
2285 return 0
2289 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2290 global current_diff_path
2292 if {$path ne $current_diff_path} {
2293 return {}
2294 } elseif {[find_next_diff $w $path $lno $mmask]} {
2295 return {next_diff;}
2296 } else {
2297 return {reshow_diff;}
2301 proc select_first_diff {after} {
2302 global ui_workdir
2304 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2305 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2306 next_diff $after
2307 } else {
2308 uplevel #0 $after
2312 proc force_first_diff {after} {
2313 global ui_workdir current_diff_path file_states
2315 if {[info exists file_states($current_diff_path)]} {
2316 set state [lindex $file_states($current_diff_path) 0]
2317 } else {
2318 set state {OO}
2321 set reselect 0
2322 if {[string first {U} $state] >= 0} {
2323 # Already a conflict, do nothing
2324 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2325 set reselect 1
2326 } elseif {[string index $state 1] ne {O}} {
2327 # Already a diff & no conflicts, do nothing
2328 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2329 set reselect 1
2332 if {$reselect} {
2333 next_diff $after
2334 } else {
2335 uplevel #0 $after
2339 proc toggle_or_diff {w x y} {
2340 global file_states file_lists current_diff_path ui_index ui_workdir
2341 global last_clicked selected_paths
2343 set pos [split [$w index @$x,$y] .]
2344 set lno [lindex $pos 0]
2345 set col [lindex $pos 1]
2346 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2347 if {$path eq {}} {
2348 set last_clicked {}
2349 return
2352 set last_clicked [list $w $lno]
2353 array unset selected_paths
2354 $ui_index tag remove in_sel 0.0 end
2355 $ui_workdir tag remove in_sel 0.0 end
2357 # Determine the state of the file
2358 if {[info exists file_states($path)]} {
2359 set state [lindex $file_states($path) 0]
2360 } else {
2361 set state {__}
2364 # Restage the file, or simply show the diff
2365 if {$col == 0 && $y > 1} {
2366 # Conflicts need special handling
2367 if {[string first {U} $state] >= 0} {
2368 # $w must always be $ui_workdir, but...
2369 if {$w ne $ui_workdir} { set lno {} }
2370 merge_stage_workdir $path $lno
2371 return
2374 if {[string index $state 1] eq {O}} {
2375 set mmask {}
2376 } else {
2377 set mmask {[^O]}
2380 set after [next_diff_after_action $w $path $lno $mmask]
2382 if {$w eq $ui_index} {
2383 update_indexinfo \
2384 "Unstaging [short_path $path] from commit" \
2385 [list $path] \
2386 [concat $after [list ui_ready]]
2387 } elseif {$w eq $ui_workdir} {
2388 update_index \
2389 "Adding [short_path $path]" \
2390 [list $path] \
2391 [concat $after [list ui_ready]]
2393 } else {
2394 show_diff $path $w $lno
2398 proc add_one_to_selection {w x y} {
2399 global file_lists last_clicked selected_paths
2401 set lno [lindex [split [$w index @$x,$y] .] 0]
2402 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2403 if {$path eq {}} {
2404 set last_clicked {}
2405 return
2408 if {$last_clicked ne {}
2409 && [lindex $last_clicked 0] ne $w} {
2410 array unset selected_paths
2411 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2414 set last_clicked [list $w $lno]
2415 if {[catch {set in_sel $selected_paths($path)}]} {
2416 set in_sel 0
2418 if {$in_sel} {
2419 unset selected_paths($path)
2420 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2421 } else {
2422 set selected_paths($path) 1
2423 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2427 proc add_range_to_selection {w x y} {
2428 global file_lists last_clicked selected_paths
2430 if {[lindex $last_clicked 0] ne $w} {
2431 toggle_or_diff $w $x $y
2432 return
2435 set lno [lindex [split [$w index @$x,$y] .] 0]
2436 set lc [lindex $last_clicked 1]
2437 if {$lc < $lno} {
2438 set begin $lc
2439 set end $lno
2440 } else {
2441 set begin $lno
2442 set end $lc
2445 foreach path [lrange $file_lists($w) \
2446 [expr {$begin - 1}] \
2447 [expr {$end - 1}]] {
2448 set selected_paths($path) 1
2450 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2453 proc show_more_context {} {
2454 global repo_config
2455 if {$repo_config(gui.diffcontext) < 99} {
2456 incr repo_config(gui.diffcontext)
2457 reshow_diff
2461 proc show_less_context {} {
2462 global repo_config
2463 if {$repo_config(gui.diffcontext) > 1} {
2464 incr repo_config(gui.diffcontext) -1
2465 reshow_diff
2469 ######################################################################
2471 ## ui construction
2473 set ui_comm {}
2475 # -- Menu Bar
2477 menu .mbar -tearoff 0
2478 if {[is_MacOSX]} {
2479 # -- Apple Menu (Mac OS X only)
2481 .mbar add cascade -label Apple -menu .mbar.apple
2482 menu .mbar.apple
2484 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2485 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2486 if {[is_enabled branch]} {
2487 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2489 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2490 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2492 if {[is_enabled transport]} {
2493 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2494 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2496 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2497 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2500 # -- Repository Menu
2502 menu .mbar.repository
2504 if {![is_bare]} {
2505 .mbar.repository add command \
2506 -label [mc "Explore Working Copy"] \
2507 -command {do_explore}
2508 .mbar.repository add separator
2511 .mbar.repository add command \
2512 -label [mc "Browse Current Branch's Files"] \
2513 -command {browser::new $current_branch}
2514 set ui_browse_current [.mbar.repository index last]
2515 .mbar.repository add command \
2516 -label [mc "Browse Branch Files..."] \
2517 -command browser_open::dialog
2518 .mbar.repository add separator
2520 .mbar.repository add command \
2521 -label [mc "Visualize Current Branch's History"] \
2522 -command {do_gitk $current_branch}
2523 set ui_visualize_current [.mbar.repository index last]
2524 .mbar.repository add command \
2525 -label [mc "Visualize All Branch History"] \
2526 -command {do_gitk --all}
2527 .mbar.repository add separator
2529 proc current_branch_write {args} {
2530 global current_branch
2531 .mbar.repository entryconf $::ui_browse_current \
2532 -label [mc "Browse %s's Files" $current_branch]
2533 .mbar.repository entryconf $::ui_visualize_current \
2534 -label [mc "Visualize %s's History" $current_branch]
2536 trace add variable current_branch write current_branch_write
2538 if {[is_enabled multicommit]} {
2539 .mbar.repository add command -label [mc "Database Statistics"] \
2540 -command do_stats
2542 .mbar.repository add command -label [mc "Compress Database"] \
2543 -command do_gc
2545 .mbar.repository add command -label [mc "Verify Database"] \
2546 -command do_fsck_objects
2548 .mbar.repository add separator
2550 if {[is_Cygwin]} {
2551 .mbar.repository add command \
2552 -label [mc "Create Desktop Icon"] \
2553 -command do_cygwin_shortcut
2554 } elseif {[is_Windows]} {
2555 .mbar.repository add command \
2556 -label [mc "Create Desktop Icon"] \
2557 -command do_windows_shortcut
2558 } elseif {[is_MacOSX]} {
2559 .mbar.repository add command \
2560 -label [mc "Create Desktop Icon"] \
2561 -command do_macosx_app
2565 if {[is_MacOSX]} {
2566 proc ::tk::mac::Quit {args} { do_quit }
2567 } else {
2568 .mbar.repository add command -label [mc Quit] \
2569 -command do_quit \
2570 -accelerator $M1T-Q
2573 # -- Edit Menu
2575 menu .mbar.edit
2576 .mbar.edit add command -label [mc Undo] \
2577 -command {catch {[focus] edit undo}} \
2578 -accelerator $M1T-Z
2579 .mbar.edit add command -label [mc Redo] \
2580 -command {catch {[focus] edit redo}} \
2581 -accelerator $M1T-Y
2582 .mbar.edit add separator
2583 .mbar.edit add command -label [mc Cut] \
2584 -command {catch {tk_textCut [focus]}} \
2585 -accelerator $M1T-X
2586 .mbar.edit add command -label [mc Copy] \
2587 -command {catch {tk_textCopy [focus]}} \
2588 -accelerator $M1T-C
2589 .mbar.edit add command -label [mc Paste] \
2590 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2591 -accelerator $M1T-V
2592 .mbar.edit add command -label [mc Delete] \
2593 -command {catch {[focus] delete sel.first sel.last}} \
2594 -accelerator Del
2595 .mbar.edit add separator
2596 .mbar.edit add command -label [mc "Select All"] \
2597 -command {catch {[focus] tag add sel 0.0 end}} \
2598 -accelerator $M1T-A
2600 # -- Branch Menu
2602 if {[is_enabled branch]} {
2603 menu .mbar.branch
2605 .mbar.branch add command -label [mc "Create..."] \
2606 -command branch_create::dialog \
2607 -accelerator $M1T-N
2608 lappend disable_on_lock [list .mbar.branch entryconf \
2609 [.mbar.branch index last] -state]
2611 .mbar.branch add command -label [mc "Checkout..."] \
2612 -command branch_checkout::dialog \
2613 -accelerator $M1T-O
2614 lappend disable_on_lock [list .mbar.branch entryconf \
2615 [.mbar.branch index last] -state]
2617 .mbar.branch add command -label [mc "Rename..."] \
2618 -command branch_rename::dialog
2619 lappend disable_on_lock [list .mbar.branch entryconf \
2620 [.mbar.branch index last] -state]
2622 .mbar.branch add command -label [mc "Delete..."] \
2623 -command branch_delete::dialog
2624 lappend disable_on_lock [list .mbar.branch entryconf \
2625 [.mbar.branch index last] -state]
2627 .mbar.branch add command -label [mc "Reset..."] \
2628 -command merge::reset_hard
2629 lappend disable_on_lock [list .mbar.branch entryconf \
2630 [.mbar.branch index last] -state]
2633 # -- Commit Menu
2635 proc commit_btn_caption {} {
2636 if {[is_enabled nocommit]} {
2637 return [mc "Done"]
2638 } else {
2639 return [mc Commit@@verb]
2643 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2644 menu .mbar.commit
2646 if {![is_enabled nocommit]} {
2647 .mbar.commit add radiobutton \
2648 -label [mc "New Commit"] \
2649 -command do_select_commit_type \
2650 -variable selected_commit_type \
2651 -value new
2652 lappend disable_on_lock \
2653 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2655 .mbar.commit add radiobutton \
2656 -label [mc "Amend Last Commit"] \
2657 -command do_select_commit_type \
2658 -variable selected_commit_type \
2659 -value amend
2660 lappend disable_on_lock \
2661 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2663 .mbar.commit add separator
2666 .mbar.commit add command -label [mc Rescan] \
2667 -command ui_do_rescan \
2668 -accelerator F5
2669 lappend disable_on_lock \
2670 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2672 .mbar.commit add command -label [mc "Stage To Commit"] \
2673 -command do_add_selection \
2674 -accelerator $M1T-T
2675 lappend disable_on_lock \
2676 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2678 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2679 -command do_add_all \
2680 -accelerator $M1T-I
2681 lappend disable_on_lock \
2682 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2684 .mbar.commit add command -label [mc "Unstage From Commit"] \
2685 -command do_unstage_selection \
2686 -accelerator $M1T-U
2687 lappend disable_on_lock \
2688 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2690 .mbar.commit add command -label [mc "Revert Changes"] \
2691 -command do_revert_selection \
2692 -accelerator $M1T-J
2693 lappend disable_on_lock \
2694 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2696 .mbar.commit add separator
2698 .mbar.commit add command -label [mc "Show Less Context"] \
2699 -command show_less_context \
2700 -accelerator $M1T-\-
2702 .mbar.commit add command -label [mc "Show More Context"] \
2703 -command show_more_context \
2704 -accelerator $M1T-=
2706 .mbar.commit add separator
2708 if {![is_enabled nocommitmsg]} {
2709 .mbar.commit add command -label [mc "Sign Off"] \
2710 -command do_signoff \
2711 -accelerator $M1T-S
2714 .mbar.commit add command -label [commit_btn_caption] \
2715 -command do_commit \
2716 -accelerator $M1T-Return
2717 lappend disable_on_lock \
2718 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2721 # -- Merge Menu
2723 if {[is_enabled branch]} {
2724 menu .mbar.merge
2725 .mbar.merge add command -label [mc "Local Merge..."] \
2726 -command merge::dialog \
2727 -accelerator $M1T-M
2728 lappend disable_on_lock \
2729 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2730 .mbar.merge add command -label [mc "Abort Merge..."] \
2731 -command merge::reset_hard
2732 lappend disable_on_lock \
2733 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2736 # -- Transport Menu
2738 if {[is_enabled transport]} {
2739 menu .mbar.remote
2741 .mbar.remote add command \
2742 -label [mc "Add..."] \
2743 -command remote_add::dialog \
2744 -accelerator $M1T-A
2745 .mbar.remote add command \
2746 -label [mc "Push..."] \
2747 -command do_push_anywhere \
2748 -accelerator $M1T-P
2749 .mbar.remote add command \
2750 -label [mc "Delete Branch..."] \
2751 -command remote_branch_delete::dialog
2754 if {[is_MacOSX]} {
2755 proc ::tk::mac::ShowPreferences {} {do_options}
2756 } else {
2757 # -- Edit Menu
2759 .mbar.edit add separator
2760 .mbar.edit add command -label [mc "Options..."] \
2761 -command do_options
2764 # -- Tools Menu
2766 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2767 set tools_menubar .mbar.tools
2768 menu $tools_menubar
2769 $tools_menubar add separator
2770 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2771 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2772 set tools_tailcnt 3
2773 if {[array names repo_config guitool.*.cmd] ne {}} {
2774 tools_populate_all
2778 # -- Help Menu
2780 .mbar add cascade -label [mc Help] -menu .mbar.help
2781 menu .mbar.help
2783 if {[is_MacOSX]} {
2784 .mbar.apple add command -label [mc "About %s" [appname]] \
2785 -command do_about
2786 .mbar.apple add separator
2787 } else {
2788 .mbar.help add command -label [mc "About %s" [appname]] \
2789 -command do_about
2791 . configure -menu .mbar
2793 set doc_path [githtmldir]
2794 if {$doc_path ne {}} {
2795 set doc_path [file join $doc_path index.html]
2797 if {[is_Cygwin]} {
2798 set doc_path [exec cygpath --mixed $doc_path]
2802 if {[file isfile $doc_path]} {
2803 set doc_url "file:$doc_path"
2804 } else {
2805 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2808 proc start_browser {url} {
2809 git "web--browse" $url
2812 .mbar.help add command -label [mc "Online Documentation"] \
2813 -command [list start_browser $doc_url]
2815 .mbar.help add command -label [mc "Show SSH Key"] \
2816 -command do_ssh_key
2818 unset doc_path doc_url
2820 # -- Standard bindings
2822 wm protocol . WM_DELETE_WINDOW do_quit
2823 bind all <$M1B-Key-q> do_quit
2824 bind all <$M1B-Key-Q> do_quit
2825 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2826 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2828 set subcommand_args {}
2829 proc usage {} {
2830 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2831 exit 1
2834 proc normalize_relpath {path} {
2835 set elements {}
2836 foreach item [file split $path] {
2837 if {$item eq {.}} continue
2838 if {$item eq {..} && [llength $elements] > 0
2839 && [lindex $elements end] ne {..}} {
2840 set elements [lrange $elements 0 end-1]
2841 continue
2843 lappend elements $item
2845 return [eval file join $elements]
2848 # -- Not a normal commit type invocation? Do that instead!
2850 switch -- $subcommand {
2851 browser -
2852 blame {
2853 if {$subcommand eq "blame"} {
2854 set subcommand_args {[--line=<num>] rev? path}
2855 } else {
2856 set subcommand_args {rev? path}
2858 if {$argv eq {}} usage
2859 set head {}
2860 set path {}
2861 set jump_spec {}
2862 set is_path 0
2863 foreach a $argv {
2864 if {$is_path || [file exists $_prefix$a]} {
2865 if {$path ne {}} usage
2866 set path [normalize_relpath $_prefix$a]
2867 break
2868 } elseif {$a eq {--}} {
2869 if {$path ne {}} {
2870 if {$head ne {}} usage
2871 set head $path
2872 set path {}
2874 set is_path 1
2875 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2876 if {$jump_spec ne {} || $head ne {}} usage
2877 set jump_spec [list $lnum]
2878 } elseif {$head eq {}} {
2879 if {$head ne {}} usage
2880 set head $a
2881 set is_path 1
2882 } else {
2883 usage
2886 unset is_path
2888 if {$head ne {} && $path eq {}} {
2889 set path [normalize_relpath $_prefix$head]
2890 set head {}
2893 if {$head eq {}} {
2894 load_current_branch
2895 } else {
2896 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2897 if {[catch {
2898 set head [git rev-parse --verify $head]
2899 } err]} {
2900 puts stderr $err
2901 exit 1
2904 set current_branch $head
2907 switch -- $subcommand {
2908 browser {
2909 if {$jump_spec ne {}} usage
2910 if {$head eq {}} {
2911 if {$path ne {} && [file isdirectory $path]} {
2912 set head $current_branch
2913 } else {
2914 set head $path
2915 set path {}
2918 browser::new $head $path
2920 blame {
2921 if {$head eq {} && ![file exists $path]} {
2922 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2923 exit 1
2925 blame::new $head $path $jump_spec
2928 return
2930 citool -
2931 gui {
2932 if {[llength $argv] != 0} {
2933 puts -nonewline stderr "usage: $argv0"
2934 if {$subcommand ne {gui}
2935 && [file tail $argv0] ne "git-$subcommand"} {
2936 puts -nonewline stderr " $subcommand"
2938 puts stderr {}
2939 exit 1
2941 # fall through to setup UI for commits
2943 default {
2944 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2945 exit 1
2949 # -- Branch Control
2951 ${NS}::frame .branch
2952 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
2953 ${NS}::label .branch.l1 \
2954 -text [mc "Current Branch:"] \
2955 -anchor w \
2956 -justify left
2957 ${NS}::label .branch.cb \
2958 -textvariable current_branch \
2959 -anchor w \
2960 -justify left
2961 pack .branch.l1 -side left
2962 pack .branch.cb -side left -fill x
2963 pack .branch -side top -fill x
2965 # -- Main Window Layout
2967 ${NS}::panedwindow .vpane -orient horizontal
2968 ${NS}::panedwindow .vpane.files -orient vertical
2969 if {$use_ttk} {
2970 .vpane add .vpane.files
2971 } else {
2972 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2974 pack .vpane -anchor n -side top -fill both -expand 1
2976 # -- Index File List
2978 ${NS}::frame .vpane.files.index -height 100 -width 200
2979 tlabel .vpane.files.index.title \
2980 -text [mc "Staged Changes (Will Commit)"] \
2981 -background lightgreen -foreground black
2982 text $ui_index -background white -foreground black \
2983 -borderwidth 0 \
2984 -width 20 -height 10 \
2985 -wrap none \
2986 -cursor $cursor_ptr \
2987 -xscrollcommand {.vpane.files.index.sx set} \
2988 -yscrollcommand {.vpane.files.index.sy set} \
2989 -state disabled
2990 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2991 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2992 pack .vpane.files.index.title -side top -fill x
2993 pack .vpane.files.index.sx -side bottom -fill x
2994 pack .vpane.files.index.sy -side right -fill y
2995 pack $ui_index -side left -fill both -expand 1
2997 # -- Working Directory File List
2999 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3000 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3001 -background lightsalmon -foreground black
3002 text $ui_workdir -background white -foreground black \
3003 -borderwidth 0 \
3004 -width 20 -height 10 \
3005 -wrap none \
3006 -cursor $cursor_ptr \
3007 -xscrollcommand {.vpane.files.workdir.sx set} \
3008 -yscrollcommand {.vpane.files.workdir.sy set} \
3009 -state disabled
3010 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3011 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3012 pack .vpane.files.workdir.title -side top -fill x
3013 pack .vpane.files.workdir.sx -side bottom -fill x
3014 pack .vpane.files.workdir.sy -side right -fill y
3015 pack $ui_workdir -side left -fill both -expand 1
3017 .vpane.files add .vpane.files.workdir
3018 .vpane.files add .vpane.files.index
3019 if {!$use_ttk} {
3020 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3021 .vpane.files paneconfigure .vpane.files.index -sticky news
3024 foreach i [list $ui_index $ui_workdir] {
3025 rmsel_tag $i
3026 $i tag conf in_diff -background [$i tag cget in_sel -background]
3028 unset i
3030 # -- Diff and Commit Area
3032 ${NS}::frame .vpane.lower -height 300 -width 400
3033 ${NS}::frame .vpane.lower.commarea
3034 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3035 pack .vpane.lower.diff -fill both -expand 1
3036 pack .vpane.lower.commarea -side bottom -fill x
3037 .vpane add .vpane.lower
3038 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3040 # -- Commit Area Buttons
3042 ${NS}::frame .vpane.lower.commarea.buttons
3043 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3044 -anchor w \
3045 -justify left
3046 pack .vpane.lower.commarea.buttons.l -side top -fill x
3047 pack .vpane.lower.commarea.buttons -side left -fill y
3049 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3050 -command ui_do_rescan
3051 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3052 lappend disable_on_lock \
3053 {.vpane.lower.commarea.buttons.rescan conf -state}
3055 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3056 -command do_add_all
3057 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3058 lappend disable_on_lock \
3059 {.vpane.lower.commarea.buttons.incall conf -state}
3061 if {![is_enabled nocommitmsg]} {
3062 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3063 -command do_signoff
3064 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3067 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3068 -command do_commit
3069 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3070 lappend disable_on_lock \
3071 {.vpane.lower.commarea.buttons.commit conf -state}
3073 if {![is_enabled nocommit]} {
3074 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3075 -command do_push_anywhere
3076 pack .vpane.lower.commarea.buttons.push -side top -fill x
3079 # -- Commit Message Buffer
3081 ${NS}::frame .vpane.lower.commarea.buffer
3082 ${NS}::frame .vpane.lower.commarea.buffer.header
3083 set ui_comm .vpane.lower.commarea.buffer.t
3084 set ui_coml .vpane.lower.commarea.buffer.header.l
3086 if {![is_enabled nocommit]} {
3087 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3088 -text [mc "New Commit"] \
3089 -command do_select_commit_type \
3090 -variable selected_commit_type \
3091 -value new
3092 lappend disable_on_lock \
3093 [list .vpane.lower.commarea.buffer.header.new conf -state]
3094 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3095 -text [mc "Amend Last Commit"] \
3096 -command do_select_commit_type \
3097 -variable selected_commit_type \
3098 -value amend
3099 lappend disable_on_lock \
3100 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3103 ${NS}::label $ui_coml \
3104 -anchor w \
3105 -justify left
3106 proc trace_commit_type {varname args} {
3107 global ui_coml commit_type
3108 switch -glob -- $commit_type {
3109 initial {set txt [mc "Initial Commit Message:"]}
3110 amend {set txt [mc "Amended Commit Message:"]}
3111 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3112 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3113 merge {set txt [mc "Merge Commit Message:"]}
3114 * {set txt [mc "Commit Message:"]}
3116 $ui_coml conf -text $txt
3118 trace add variable commit_type write trace_commit_type
3119 pack $ui_coml -side left -fill x
3121 if {![is_enabled nocommit]} {
3122 pack .vpane.lower.commarea.buffer.header.amend -side right
3123 pack .vpane.lower.commarea.buffer.header.new -side right
3126 text $ui_comm -background white -foreground black \
3127 -borderwidth 1 \
3128 -undo true \
3129 -maxundo 20 \
3130 -autoseparators true \
3131 -relief sunken \
3132 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3133 -font font_diff \
3134 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3135 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3136 -command [list $ui_comm yview]
3137 pack .vpane.lower.commarea.buffer.header -side top -fill x
3138 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3139 pack $ui_comm -side left -fill y
3140 pack .vpane.lower.commarea.buffer -side left -fill y
3142 # -- Commit Message Buffer Context Menu
3144 set ctxm .vpane.lower.commarea.buffer.ctxm
3145 menu $ctxm -tearoff 0
3146 $ctxm add command \
3147 -label [mc Cut] \
3148 -command {tk_textCut $ui_comm}
3149 $ctxm add command \
3150 -label [mc Copy] \
3151 -command {tk_textCopy $ui_comm}
3152 $ctxm add command \
3153 -label [mc Paste] \
3154 -command {tk_textPaste $ui_comm}
3155 $ctxm add command \
3156 -label [mc Delete] \
3157 -command {catch {$ui_comm delete sel.first sel.last}}
3158 $ctxm add separator
3159 $ctxm add command \
3160 -label [mc "Select All"] \
3161 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3162 $ctxm add command \
3163 -label [mc "Copy All"] \
3164 -command {
3165 $ui_comm tag add sel 0.0 end
3166 tk_textCopy $ui_comm
3167 $ui_comm tag remove sel 0.0 end
3169 $ctxm add separator
3170 $ctxm add command \
3171 -label [mc "Sign Off"] \
3172 -command do_signoff
3173 set ui_comm_ctxm $ctxm
3175 # -- Diff Header
3177 proc trace_current_diff_path {varname args} {
3178 global current_diff_path diff_actions file_states
3179 if {$current_diff_path eq {}} {
3180 set s {}
3181 set f {}
3182 set p {}
3183 set o disabled
3184 } else {
3185 set p $current_diff_path
3186 set s [mapdesc [lindex $file_states($p) 0] $p]
3187 set f [mc "File:"]
3188 set p [escape_path $p]
3189 set o normal
3192 .vpane.lower.diff.header.status configure -text $s
3193 .vpane.lower.diff.header.file configure -text $f
3194 .vpane.lower.diff.header.path configure -text $p
3195 foreach w $diff_actions {
3196 uplevel #0 $w $o
3199 trace add variable current_diff_path write trace_current_diff_path
3201 gold_frame .vpane.lower.diff.header
3202 tlabel .vpane.lower.diff.header.status \
3203 -background gold \
3204 -foreground black \
3205 -width $max_status_desc \
3206 -anchor w \
3207 -justify left
3208 tlabel .vpane.lower.diff.header.file \
3209 -background gold \
3210 -foreground black \
3211 -anchor w \
3212 -justify left
3213 tlabel .vpane.lower.diff.header.path \
3214 -background gold \
3215 -foreground black \
3216 -anchor w \
3217 -justify left
3218 pack .vpane.lower.diff.header.status -side left
3219 pack .vpane.lower.diff.header.file -side left
3220 pack .vpane.lower.diff.header.path -fill x
3221 set ctxm .vpane.lower.diff.header.ctxm
3222 menu $ctxm -tearoff 0
3223 $ctxm add command \
3224 -label [mc Copy] \
3225 -command {
3226 clipboard clear
3227 clipboard append \
3228 -format STRING \
3229 -type STRING \
3230 -- $current_diff_path
3232 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3233 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3235 # -- Diff Body
3237 ${NS}::frame .vpane.lower.diff.body
3238 set ui_diff .vpane.lower.diff.body.t
3239 text $ui_diff -background white -foreground black \
3240 -borderwidth 0 \
3241 -width 80 -height 5 -wrap none \
3242 -font font_diff \
3243 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3244 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3245 -state disabled
3246 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3247 -command [list $ui_diff xview]
3248 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3249 -command [list $ui_diff yview]
3250 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3251 pack .vpane.lower.diff.body.sby -side right -fill y
3252 pack $ui_diff -side left -fill both -expand 1
3253 pack .vpane.lower.diff.header -side top -fill x
3254 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3256 $ui_diff tag conf d_cr -elide true
3257 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
3258 $ui_diff tag conf d_+ -foreground {#00a000}
3259 $ui_diff tag conf d_- -foreground red
3261 $ui_diff tag conf d_++ -foreground {#00a000}
3262 $ui_diff tag conf d_-- -foreground red
3263 $ui_diff tag conf d_+s \
3264 -foreground {#00a000} \
3265 -background {#e2effa}
3266 $ui_diff tag conf d_-s \
3267 -foreground red \
3268 -background {#e2effa}
3269 $ui_diff tag conf d_s+ \
3270 -foreground {#00a000} \
3271 -background ivory1
3272 $ui_diff tag conf d_s- \
3273 -foreground red \
3274 -background ivory1
3276 $ui_diff tag conf d<<<<<<< \
3277 -foreground orange \
3278 -font font_diffbold
3279 $ui_diff tag conf d======= \
3280 -foreground orange \
3281 -font font_diffbold
3282 $ui_diff tag conf d>>>>>>> \
3283 -foreground orange \
3284 -font font_diffbold
3286 $ui_diff tag raise sel
3288 # -- Diff Body Context Menu
3291 proc create_common_diff_popup {ctxm} {
3292 $ctxm add command \
3293 -label [mc Refresh] \
3294 -command reshow_diff
3295 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3296 $ctxm add command \
3297 -label [mc Copy] \
3298 -command {tk_textCopy $ui_diff}
3299 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3300 $ctxm add command \
3301 -label [mc "Select All"] \
3302 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3303 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3304 $ctxm add command \
3305 -label [mc "Copy All"] \
3306 -command {
3307 $ui_diff tag add sel 0.0 end
3308 tk_textCopy $ui_diff
3309 $ui_diff tag remove sel 0.0 end
3311 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3312 $ctxm add separator
3313 $ctxm add command \
3314 -label [mc "Decrease Font Size"] \
3315 -command {incr_font_size font_diff -1}
3316 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3317 $ctxm add command \
3318 -label [mc "Increase Font Size"] \
3319 -command {incr_font_size font_diff 1}
3320 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3321 $ctxm add separator
3322 set emenu $ctxm.enc
3323 menu $emenu
3324 build_encoding_menu $emenu [list force_diff_encoding]
3325 $ctxm add cascade \
3326 -label [mc "Encoding"] \
3327 -menu $emenu
3328 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3329 $ctxm add separator
3330 $ctxm add command -label [mc "Options..."] \
3331 -command do_options
3334 set ctxm .vpane.lower.diff.body.ctxm
3335 menu $ctxm -tearoff 0
3336 $ctxm add command \
3337 -label [mc "Apply/Reverse Hunk"] \
3338 -command {apply_hunk $cursorX $cursorY}
3339 set ui_diff_applyhunk [$ctxm index last]
3340 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3341 $ctxm add command \
3342 -label [mc "Apply/Reverse Line"] \
3343 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3344 set ui_diff_applyline [$ctxm index last]
3345 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3346 $ctxm add separator
3347 $ctxm add command \
3348 -label [mc "Show Less Context"] \
3349 -command show_less_context
3350 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3351 $ctxm add command \
3352 -label [mc "Show More Context"] \
3353 -command show_more_context
3354 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3355 $ctxm add separator
3356 create_common_diff_popup $ctxm
3358 set ctxmmg .vpane.lower.diff.body.ctxmmg
3359 menu $ctxmmg -tearoff 0
3360 $ctxmmg add command \
3361 -label [mc "Run Merge Tool"] \
3362 -command {merge_resolve_tool}
3363 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3364 $ctxmmg add separator
3365 $ctxmmg add command \
3366 -label [mc "Use Remote Version"] \
3367 -command {merge_resolve_one 3}
3368 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3369 $ctxmmg add command \
3370 -label [mc "Use Local Version"] \
3371 -command {merge_resolve_one 2}
3372 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3373 $ctxmmg add command \
3374 -label [mc "Revert To Base"] \
3375 -command {merge_resolve_one 1}
3376 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3377 $ctxmmg add separator
3378 $ctxmmg add command \
3379 -label [mc "Show Less Context"] \
3380 -command show_less_context
3381 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3382 $ctxmmg add command \
3383 -label [mc "Show More Context"] \
3384 -command show_more_context
3385 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3386 $ctxmmg add separator
3387 create_common_diff_popup $ctxmmg
3389 set ctxmsm .vpane.lower.diff.body.ctxmsm
3390 menu $ctxmsm -tearoff 0
3391 $ctxmsm add command \
3392 -label [mc "Visualize These Changes In The Submodule"] \
3393 -command {do_gitk -- true}
3394 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3395 $ctxmsm add command \
3396 -label [mc "Visualize Current Branch History In The Submodule"] \
3397 -command {do_gitk {} true}
3398 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3399 $ctxmsm add command \
3400 -label [mc "Visualize All Branch History In The Submodule"] \
3401 -command {do_gitk --all true}
3402 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3403 $ctxmsm add separator
3404 $ctxmsm add command \
3405 -label [mc "Start git gui In The Submodule"] \
3406 -command {do_git_gui}
3407 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3408 $ctxmsm add separator
3409 create_common_diff_popup $ctxmsm
3411 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3412 global current_diff_path file_states
3413 set ::cursorX $x
3414 set ::cursorY $y
3415 if {[info exists file_states($current_diff_path)]} {
3416 set state [lindex $file_states($current_diff_path) 0]
3417 } else {
3418 set state {__}
3420 if {[string first {U} $state] >= 0} {
3421 tk_popup $ctxmmg $X $Y
3422 } elseif {$::is_submodule_diff} {
3423 tk_popup $ctxmsm $X $Y
3424 } else {
3425 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3426 if {$::ui_index eq $::current_diff_side} {
3427 set l [mc "Unstage Hunk From Commit"]
3428 if {$has_range} {
3429 set t [mc "Unstage Lines From Commit"]
3430 } else {
3431 set t [mc "Unstage Line From Commit"]
3433 } else {
3434 set l [mc "Stage Hunk For Commit"]
3435 if {$has_range} {
3436 set t [mc "Stage Lines For Commit"]
3437 } else {
3438 set t [mc "Stage Line For Commit"]
3441 if {$::is_3way_diff
3442 || $current_diff_path eq {}
3443 || {__} eq $state
3444 || {_O} eq $state
3445 || {_T} eq $state
3446 || {T_} eq $state} {
3447 set s disabled
3448 } else {
3449 set s normal
3451 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3452 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3453 tk_popup $ctxm $X $Y
3456 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3458 # -- Status Bar
3460 set main_status [::status_bar::new .status]
3461 pack .status -anchor w -side bottom -fill x
3462 $main_status show [mc "Initializing..."]
3464 # -- Load geometry
3466 catch {
3467 set gm $repo_config(gui.geometry)
3468 wm geometry . [lindex $gm 0]
3469 if {$use_ttk} {
3470 .vpane sashpos 0 [lindex $gm 1]
3471 .vpane.files sashpos 0 [lindex $gm 2]
3472 } else {
3473 .vpane sash place 0 \
3474 [lindex $gm 1] \
3475 [lindex [.vpane sash coord 0] 1]
3476 .vpane.files sash place 0 \
3477 [lindex [.vpane.files sash coord 0] 0] \
3478 [lindex $gm 2]
3480 unset gm
3483 # -- Load window state
3485 catch {
3486 set gws $repo_config(gui.wmstate)
3487 wm state . $gws
3488 unset gws
3491 # -- Key Bindings
3493 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3494 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3495 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3496 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3497 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3498 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3499 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3500 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3501 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3502 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3503 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3504 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3505 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3506 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3507 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3508 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3509 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3510 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3511 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3512 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3513 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3514 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3516 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3517 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3518 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3519 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3520 bind $ui_diff <$M1B-Key-v> {break}
3521 bind $ui_diff <$M1B-Key-V> {break}
3522 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3523 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3524 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3525 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3526 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3527 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3528 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3529 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3530 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3531 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3532 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3533 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3534 bind $ui_diff <Button-1> {focus %W}
3536 if {[is_enabled branch]} {
3537 bind . <$M1B-Key-n> branch_create::dialog
3538 bind . <$M1B-Key-N> branch_create::dialog
3539 bind . <$M1B-Key-o> branch_checkout::dialog
3540 bind . <$M1B-Key-O> branch_checkout::dialog
3541 bind . <$M1B-Key-m> merge::dialog
3542 bind . <$M1B-Key-M> merge::dialog
3544 if {[is_enabled transport]} {
3545 bind . <$M1B-Key-p> do_push_anywhere
3546 bind . <$M1B-Key-P> do_push_anywhere
3549 bind . <Key-F5> ui_do_rescan
3550 bind . <$M1B-Key-r> ui_do_rescan
3551 bind . <$M1B-Key-R> ui_do_rescan
3552 bind . <$M1B-Key-s> do_signoff
3553 bind . <$M1B-Key-S> do_signoff
3554 bind . <$M1B-Key-t> do_add_selection
3555 bind . <$M1B-Key-T> do_add_selection
3556 bind . <$M1B-Key-j> do_revert_selection
3557 bind . <$M1B-Key-J> do_revert_selection
3558 bind . <$M1B-Key-i> do_add_all
3559 bind . <$M1B-Key-I> do_add_all
3560 bind . <$M1B-Key-minus> {show_less_context;break}
3561 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3562 bind . <$M1B-Key-equal> {show_more_context;break}
3563 bind . <$M1B-Key-plus> {show_more_context;break}
3564 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3565 bind . <$M1B-Key-Return> do_commit
3566 foreach i [list $ui_index $ui_workdir] {
3567 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3568 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3569 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3571 unset i
3573 set file_lists($ui_index) [list]
3574 set file_lists($ui_workdir) [list]
3576 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3577 focus -force $ui_comm
3579 # -- Warn the user about environmental problems. Cygwin's Tcl
3580 # does *not* pass its env array onto any processes it spawns.
3581 # This means that git processes get none of our environment.
3583 if {[is_Cygwin]} {
3584 set ignored_env 0
3585 set suggest_user {}
3586 set msg [mc "Possible environment issues exist.
3588 The following environment variables are probably
3589 going to be ignored by any Git subprocess run
3590 by %s:
3592 " [appname]]
3593 foreach name [array names env] {
3594 switch -regexp -- $name {
3595 {^GIT_INDEX_FILE$} -
3596 {^GIT_OBJECT_DIRECTORY$} -
3597 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3598 {^GIT_DIFF_OPTS$} -
3599 {^GIT_EXTERNAL_DIFF$} -
3600 {^GIT_PAGER$} -
3601 {^GIT_TRACE$} -
3602 {^GIT_CONFIG$} -
3603 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3604 append msg " - $name\n"
3605 incr ignored_env
3607 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3608 append msg " - $name\n"
3609 incr ignored_env
3610 set suggest_user $name
3614 if {$ignored_env > 0} {
3615 append msg [mc "
3616 This is due to a known issue with the
3617 Tcl binary distributed by Cygwin."]
3619 if {$suggest_user ne {}} {
3620 append msg [mc "
3622 A good replacement for %s
3623 is placing values for the user.name and
3624 user.email settings into your personal
3625 ~/.gitconfig file.
3626 " $suggest_user]
3628 warn_popup $msg
3630 unset ignored_env msg suggest_user name
3633 # -- Only initialize complex UI if we are going to stay running.
3635 if {[is_enabled transport]} {
3636 load_all_remotes
3638 set n [.mbar.remote index end]
3639 populate_remotes_menu
3640 set n [expr {[.mbar.remote index end] - $n}]
3641 if {$n > 0} {
3642 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3643 .mbar.remote insert $n separator
3645 unset n
3648 if {[winfo exists $ui_comm]} {
3649 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3651 # -- If both our backup and message files exist use the
3652 # newer of the two files to initialize the buffer.
3654 if {$GITGUI_BCK_exists} {
3655 set m [gitdir GITGUI_MSG]
3656 if {[file isfile $m]} {
3657 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3658 catch {file delete [gitdir GITGUI_MSG]}
3659 } else {
3660 $ui_comm delete 0.0 end
3661 $ui_comm edit reset
3662 $ui_comm edit modified false
3663 catch {file delete [gitdir GITGUI_BCK]}
3664 set GITGUI_BCK_exists 0
3667 unset m
3670 proc backup_commit_buffer {} {
3671 global ui_comm GITGUI_BCK_exists
3673 set m [$ui_comm edit modified]
3674 if {$m || $GITGUI_BCK_exists} {
3675 set msg [string trim [$ui_comm get 0.0 end]]
3676 regsub -all -line {[ \r\t]+$} $msg {} msg
3678 if {$msg eq {}} {
3679 if {$GITGUI_BCK_exists} {
3680 catch {file delete [gitdir GITGUI_BCK]}
3681 set GITGUI_BCK_exists 0
3683 } elseif {$m} {
3684 catch {
3685 set fd [open [gitdir GITGUI_BCK] w]
3686 puts -nonewline $fd $msg
3687 close $fd
3688 set GITGUI_BCK_exists 1
3692 $ui_comm edit modified false
3695 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3698 backup_commit_buffer
3700 # -- If the user has aspell available we can drive it
3701 # in pipe mode to spellcheck the commit message.
3703 set spell_cmd [list |]
3704 set spell_dict [get_config gui.spellingdictionary]
3705 lappend spell_cmd aspell
3706 if {$spell_dict ne {}} {
3707 lappend spell_cmd --master=$spell_dict
3709 lappend spell_cmd --mode=none
3710 lappend spell_cmd --encoding=utf-8
3711 lappend spell_cmd pipe
3712 if {$spell_dict eq {none}
3713 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3714 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3715 } else {
3716 set ui_comm_spell [spellcheck::init \
3717 $spell_fd \
3718 $ui_comm \
3719 $ui_comm_ctxm \
3722 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3725 lock_index begin-read
3726 if {![winfo ismapped .]} {
3727 wm deiconify .
3729 after 1 {
3730 if {[is_enabled initialamend]} {
3731 force_amend
3732 } else {
3733 do_rescan
3736 if {[is_enabled nocommitmsg]} {
3737 $ui_comm configure -state disabled -background gray
3740 if {[is_enabled multicommit]} {
3741 after 1000 hint_gc
3743 if {[is_enabled retcode]} {
3744 bind . <Destroy> {+terminate_me %W}
3746 if {$picked && [is_config_true gui.autoexplore]} {
3747 do_explore
3750 # Local variables:
3751 # mode: tcl
3752 # indent-tabs-mode: t
3753 # tab-width: 4
3754 # End: