git-gui: show command-line errors in a messagebox on Windows
[git/jrn.git] / git-gui.sh
blobed0904d9935c0d143cb624a651e24667fffd457b
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 [string map [list (c) \u00a9] {
14 Copyright (c) 2006-2010 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 "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 {}
131 set _shellpath {@@SHELL_PATH@@}
133 set _trace [lsearch -exact $argv --trace]
134 if {$_trace >= 0} {
135 set argv [lreplace $argv $_trace $_trace]
136 set _trace 1
137 } else {
138 set _trace 0
141 proc shellpath {} {
142 global _shellpath env
143 if {[string match @@* $_shellpath]} {
144 if {[info exists env(SHELL)]} {
145 return $env(SHELL)
146 } else {
147 return /bin/sh
150 return $_shellpath
153 proc appname {} {
154 global _appname
155 return $_appname
158 proc gitdir {args} {
159 global _gitdir
160 if {$args eq {}} {
161 return $_gitdir
163 return [eval [list file join $_gitdir] $args]
166 proc gitexec {args} {
167 global _gitexec
168 if {$_gitexec eq {}} {
169 if {[catch {set _gitexec [git --exec-path]} err]} {
170 error "Git not installed?\n\n$err"
172 if {[is_Cygwin]} {
173 set _gitexec [exec cygpath \
174 --windows \
175 --absolute \
176 $_gitexec]
177 } else {
178 set _gitexec [file normalize $_gitexec]
181 if {$args eq {}} {
182 return $_gitexec
184 return [eval [list file join $_gitexec] $args]
187 proc githtmldir {args} {
188 global _githtmldir
189 if {$_githtmldir eq {}} {
190 if {[catch {set _githtmldir [git --html-path]}]} {
191 # Git not installed or option not yet supported
192 return {}
194 if {[is_Cygwin]} {
195 set _githtmldir [exec cygpath \
196 --windows \
197 --absolute \
198 $_githtmldir]
199 } else {
200 set _githtmldir [file normalize $_githtmldir]
203 if {$args eq {}} {
204 return $_githtmldir
206 return [eval [list file join $_githtmldir] $args]
209 proc reponame {} {
210 return $::_reponame
213 proc is_MacOSX {} {
214 if {[tk windowingsystem] eq {aqua}} {
215 return 1
217 return 0
220 proc is_Windows {} {
221 if {$::tcl_platform(platform) eq {windows}} {
222 return 1
224 return 0
227 proc is_Cygwin {} {
228 global _iscygwin
229 if {$_iscygwin eq {}} {
230 if {$::tcl_platform(platform) eq {windows}} {
231 if {[catch {set p [exec cygpath --windir]} err]} {
232 set _iscygwin 0
233 } else {
234 set _iscygwin 1
236 } else {
237 set _iscygwin 0
240 return $_iscygwin
243 proc is_enabled {option} {
244 global enabled_options
245 if {[catch {set on $enabled_options($option)}]} {return 0}
246 return $on
249 proc enable_option {option} {
250 global enabled_options
251 set enabled_options($option) 1
254 proc disable_option {option} {
255 global enabled_options
256 set enabled_options($option) 0
259 ######################################################################
261 ## config
263 proc is_many_config {name} {
264 switch -glob -- $name {
265 gui.recentrepo -
266 remote.*.fetch -
267 remote.*.push
268 {return 1}
270 {return 0}
274 proc is_config_true {name} {
275 global repo_config
276 if {[catch {set v $repo_config($name)}]} {
277 return 0
278 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
279 return 1
280 } else {
281 return 0
285 proc is_config_false {name} {
286 global repo_config
287 if {[catch {set v $repo_config($name)}]} {
288 return 0
289 } elseif {$v eq {false} || $v eq {0} || $v eq {no}} {
290 return 1
291 } else {
292 return 0
296 proc get_config {name} {
297 global repo_config
298 if {[catch {set v $repo_config($name)}]} {
299 return {}
300 } else {
301 return $v
305 proc is_bare {} {
306 global _isbare
307 global _gitdir
308 global _gitworktree
310 if {$_isbare eq {}} {
311 if {[catch {
312 set _bare [git rev-parse --is-bare-repository]
313 switch -- $_bare {
314 true { set _isbare 1 }
315 false { set _isbare 0}
316 default { throw }
318 }]} {
319 if {[is_config_true core.bare]
320 || ($_gitworktree eq {}
321 && [lindex [file split $_gitdir] end] ne {.git})} {
322 set _isbare 1
323 } else {
324 set _isbare 0
328 return $_isbare
331 ######################################################################
333 ## handy utils
335 proc _trace_exec {cmd} {
336 if {!$::_trace} return
337 set d {}
338 foreach v $cmd {
339 if {$d ne {}} {
340 append d { }
342 if {[regexp {[ \t\r\n'"$?*]} $v]} {
343 set v [sq $v]
345 append d $v
347 puts stderr $d
350 #'" fix poor old emacs font-lock mode
352 proc _git_cmd {name} {
353 global _git_cmd_path
355 if {[catch {set v $_git_cmd_path($name)}]} {
356 switch -- $name {
357 version -
358 --version -
359 --exec-path { return [list $::_git $name] }
362 set p [gitexec git-$name$::_search_exe]
363 if {[file exists $p]} {
364 set v [list $p]
365 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
366 # Try to determine what sort of magic will make
367 # git-$name go and do its thing, because native
368 # Tcl on Windows doesn't know it.
370 set p [gitexec git-$name]
371 set f [open $p r]
372 set s [gets $f]
373 close $f
375 switch -glob -- [lindex $s 0] {
376 #!*sh { set i sh }
377 #!*perl { set i perl }
378 #!*python { set i python }
379 default { error "git-$name is not supported: $s" }
382 upvar #0 _$i interp
383 if {![info exists interp]} {
384 set interp [_which $i]
386 if {$interp eq {}} {
387 error "git-$name requires $i (not in PATH)"
389 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
390 } else {
391 # Assume it is builtin to git somehow and we
392 # aren't actually able to see a file for it.
394 set v [list $::_git $name]
396 set _git_cmd_path($name) $v
398 return $v
401 proc _which {what args} {
402 global env _search_exe _search_path
404 if {$_search_path eq {}} {
405 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
406 set _search_path [split [exec cygpath \
407 --windows \
408 --path \
409 --absolute \
410 $env(PATH)] {;}]
411 set _search_exe .exe
412 } elseif {[is_Windows]} {
413 set gitguidir [file dirname [info script]]
414 regsub -all ";" $gitguidir "\\;" gitguidir
415 set env(PATH) "$gitguidir;$env(PATH)"
416 set _search_path [split $env(PATH) {;}]
417 set _search_exe .exe
418 } else {
419 set _search_path [split $env(PATH) :]
420 set _search_exe {}
424 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
425 set suffix {}
426 } else {
427 set suffix $_search_exe
430 foreach p $_search_path {
431 set p [file join $p $what$suffix]
432 if {[file exists $p]} {
433 return [file normalize $p]
436 return {}
439 proc _lappend_nice {cmd_var} {
440 global _nice
441 upvar $cmd_var cmd
443 if {![info exists _nice]} {
444 set _nice [_which nice]
445 if {[catch {exec $_nice git version}]} {
446 set _nice {}
447 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
448 set _nice {}
451 if {$_nice ne {}} {
452 lappend cmd $_nice
456 proc git {args} {
457 set opt [list]
459 while {1} {
460 switch -- [lindex $args 0] {
461 --nice {
462 _lappend_nice opt
465 default {
466 break
471 set args [lrange $args 1 end]
474 set cmdp [_git_cmd [lindex $args 0]]
475 set args [lrange $args 1 end]
477 _trace_exec [concat $opt $cmdp $args]
478 set result [eval exec $opt $cmdp $args]
479 if {$::_trace} {
480 puts stderr "< $result"
482 return $result
485 proc _open_stdout_stderr {cmd} {
486 _trace_exec $cmd
487 if {[catch {
488 set fd [open [concat [list | ] $cmd] r]
489 } err]} {
490 if { [lindex $cmd end] eq {2>@1}
491 && $err eq {can not find channel named "1"}
493 # Older versions of Tcl 8.4 don't have this 2>@1 IO
494 # redirect operator. Fallback to |& cat for those.
495 # The command was not actually started, so its safe
496 # to try to start it a second time.
498 set fd [open [concat \
499 [list | ] \
500 [lrange $cmd 0 end-1] \
501 [list |& cat] \
502 ] r]
503 } else {
504 error $err
507 fconfigure $fd -eofchar {}
508 return $fd
511 proc git_read {args} {
512 set opt [list]
514 while {1} {
515 switch -- [lindex $args 0] {
516 --nice {
517 _lappend_nice opt
520 --stderr {
521 lappend args 2>@1
524 default {
525 break
530 set args [lrange $args 1 end]
533 set cmdp [_git_cmd [lindex $args 0]]
534 set args [lrange $args 1 end]
536 return [_open_stdout_stderr [concat $opt $cmdp $args]]
539 proc git_write {args} {
540 set opt [list]
542 while {1} {
543 switch -- [lindex $args 0] {
544 --nice {
545 _lappend_nice opt
548 default {
549 break
554 set args [lrange $args 1 end]
557 set cmdp [_git_cmd [lindex $args 0]]
558 set args [lrange $args 1 end]
560 _trace_exec [concat $opt $cmdp $args]
561 return [open [concat [list | ] $opt $cmdp $args] w]
564 proc githook_read {hook_name args} {
565 set pchook [gitdir hooks $hook_name]
566 lappend args 2>@1
568 # On Windows [file executable] might lie so we need to ask
569 # the shell if the hook is executable. Yes that's annoying.
571 if {[is_Windows]} {
572 upvar #0 _sh interp
573 if {![info exists interp]} {
574 set interp [_which sh]
576 if {$interp eq {}} {
577 error "hook execution requires sh (not in PATH)"
580 set scr {if test -x "$1";then exec "$@";fi}
581 set sh_c [list $interp -c $scr $interp $pchook]
582 return [_open_stdout_stderr [concat $sh_c $args]]
585 if {[file executable $pchook]} {
586 return [_open_stdout_stderr [concat [list $pchook] $args]]
589 return {}
592 proc kill_file_process {fd} {
593 set process [pid $fd]
595 catch {
596 if {[is_Windows]} {
597 # Use a Cygwin-specific flag to allow killing
598 # native Windows processes
599 exec kill -f $process
600 } else {
601 exec kill $process
606 proc gitattr {path attr default} {
607 if {[catch {set r [git check-attr $attr -- $path]}]} {
608 set r unspecified
609 } else {
610 set r [join [lrange [split $r :] 2 end] :]
611 regsub {^ } $r {} r
613 if {$r eq {unspecified}} {
614 return $default
616 return $r
619 proc sq {value} {
620 regsub -all ' $value "'\\''" value
621 return "'$value'"
624 proc load_current_branch {} {
625 global current_branch is_detached
627 set fd [open [gitdir HEAD] r]
628 if {[gets $fd ref] < 1} {
629 set ref {}
631 close $fd
633 set pfx {ref: refs/heads/}
634 set len [string length $pfx]
635 if {[string equal -length $len $pfx $ref]} {
636 # We're on a branch. It might not exist. But
637 # HEAD looks good enough to be a branch.
639 set current_branch [string range $ref $len end]
640 set is_detached 0
641 } else {
642 # Assume this is a detached head.
644 set current_branch HEAD
645 set is_detached 1
649 auto_load tk_optionMenu
650 rename tk_optionMenu real__tkOptionMenu
651 proc tk_optionMenu {w varName args} {
652 set m [eval real__tkOptionMenu $w $varName $args]
653 $m configure -font font_ui
654 $w configure -font font_ui
655 return $m
658 proc rmsel_tag {text} {
659 $text tag conf sel \
660 -background [$text cget -background] \
661 -foreground [$text cget -foreground] \
662 -borderwidth 0
663 $text tag conf in_sel -background lightgray
664 bind $text <Motion> break
665 return $text
668 wm withdraw .
669 set root_exists 0
670 bind . <Visibility> {
671 bind . <Visibility> {}
672 set root_exists 1
675 if {[is_Windows]} {
676 wm iconbitmap . -default $oguilib/git-gui.ico
677 set ::tk::AlwaysShowSelection 1
679 # Spoof an X11 display for SSH
680 if {![info exists env(DISPLAY)]} {
681 set env(DISPLAY) :9999
683 } else {
684 catch {
685 image create photo gitlogo -width 16 -height 16
687 gitlogo put #33CC33 -to 7 0 9 2
688 gitlogo put #33CC33 -to 4 2 12 4
689 gitlogo put #33CC33 -to 7 4 9 6
690 gitlogo put #CC3333 -to 4 6 12 8
691 gitlogo put gray26 -to 4 9 6 10
692 gitlogo put gray26 -to 3 10 6 12
693 gitlogo put gray26 -to 8 9 13 11
694 gitlogo put gray26 -to 8 11 10 12
695 gitlogo put gray26 -to 11 11 13 14
696 gitlogo put gray26 -to 3 12 5 14
697 gitlogo put gray26 -to 5 13
698 gitlogo put gray26 -to 10 13
699 gitlogo put gray26 -to 4 14 12 15
700 gitlogo put gray26 -to 5 15 11 16
701 gitlogo redither
703 wm iconphoto . -default gitlogo
707 ######################################################################
709 ## config defaults
711 set cursor_ptr arrow
712 font create font_ui
713 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
714 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
715 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
716 } else {
717 font create font_diff -family Courier -size 10
718 catch {
719 label .dummy
720 eval font configure font_ui [font actual [.dummy cget -font]]
721 destroy .dummy
725 font create font_uiitalic
726 font create font_uibold
727 font create font_diffbold
728 font create font_diffitalic
730 foreach class {Button Checkbutton Entry Label
731 Labelframe Listbox Message
732 Radiobutton Spinbox Text} {
733 option add *$class.font font_ui
735 if {![is_MacOSX]} {
736 option add *Menu.font font_ui
737 option add *Entry.borderWidth 1 startupFile
738 option add *Entry.relief sunken startupFile
739 option add *RadioButton.anchor w startupFile
741 unset class
743 if {[is_Windows] || [is_MacOSX]} {
744 option add *Menu.tearOff 0
747 if {[is_MacOSX]} {
748 set M1B M1
749 set M1T Cmd
750 } else {
751 set M1B Control
752 set M1T Ctrl
755 proc bind_button3 {w cmd} {
756 bind $w <Any-Button-3> $cmd
757 if {[is_MacOSX]} {
758 # Mac OS X sends Button-2 on right click through three-button mouse,
759 # or through trackpad right-clicking (two-finger touch + click).
760 bind $w <Any-Button-2> $cmd
761 bind $w <Control-Button-1> $cmd
765 proc apply_config {} {
766 global repo_config font_descs
768 foreach option $font_descs {
769 set name [lindex $option 0]
770 set font [lindex $option 1]
771 if {[catch {
772 set need_weight 1
773 foreach {cn cv} $repo_config(gui.$name) {
774 if {$cn eq {-weight}} {
775 set need_weight 0
777 font configure $font $cn $cv
779 if {$need_weight} {
780 font configure $font -weight normal
782 } err]} {
783 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
785 foreach {cn cv} [font configure $font] {
786 font configure ${font}bold $cn $cv
787 font configure ${font}italic $cn $cv
789 font configure ${font}bold -weight bold
790 font configure ${font}italic -slant italic
793 global use_ttk NS
794 set use_ttk 0
795 set NS {}
796 if {$repo_config(gui.usettk)} {
797 set use_ttk [package vsatisfies [package provide Tk] 8.5]
798 if {$use_ttk} {
799 set NS ttk
800 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
801 pave_toplevel .
806 set default_config(branch.autosetupmerge) true
807 set default_config(merge.tool) {}
808 set default_config(mergetool.keepbackup) true
809 set default_config(merge.diffstat) true
810 set default_config(merge.summary) false
811 set default_config(merge.verbosity) 2
812 set default_config(user.name) {}
813 set default_config(user.email) {}
815 set default_config(gui.encoding) [encoding system]
816 set default_config(gui.matchtrackingbranch) false
817 set default_config(gui.textconv) true
818 set default_config(gui.pruneduringfetch) false
819 set default_config(gui.trustmtime) false
820 set default_config(gui.fastcopyblame) false
821 set default_config(gui.copyblamethreshold) 40
822 set default_config(gui.blamehistoryctx) 7
823 set default_config(gui.diffcontext) 5
824 set default_config(gui.commitmsgwidth) 75
825 set default_config(gui.newbranchtemplate) {}
826 set default_config(gui.spellingdictionary) {}
827 set default_config(gui.fontui) [font configure font_ui]
828 set default_config(gui.fontdiff) [font configure font_diff]
829 # TODO: this option should be added to the git-config documentation
830 set default_config(gui.maxfilesdisplayed) 5000
831 set default_config(gui.usettk) 1
832 set font_descs {
833 {fontui font_ui {mc "Main Font"}}
834 {fontdiff font_diff {mc "Diff/Console Font"}}
837 ######################################################################
839 ## find git
841 set _git [_which git]
842 if {$_git eq {}} {
843 catch {wm withdraw .}
844 tk_messageBox \
845 -icon error \
846 -type ok \
847 -title [mc "git-gui: fatal error"] \
848 -message [mc "Cannot find git in PATH."]
849 exit 1
852 ######################################################################
854 ## version check
856 if {[catch {set _git_version [git --version]} err]} {
857 catch {wm withdraw .}
858 tk_messageBox \
859 -icon error \
860 -type ok \
861 -title [mc "git-gui: fatal error"] \
862 -message "Cannot determine Git version:
864 $err
866 [appname] requires Git 1.5.0 or later."
867 exit 1
869 if {![regsub {^git version } $_git_version {} _git_version]} {
870 catch {wm withdraw .}
871 tk_messageBox \
872 -icon error \
873 -type ok \
874 -title [mc "git-gui: fatal error"] \
875 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
876 exit 1
879 set _real_git_version $_git_version
880 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
881 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
882 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
883 regsub {\.GIT$} $_git_version {} _git_version
884 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
886 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
887 catch {wm withdraw .}
888 if {[tk_messageBox \
889 -icon warning \
890 -type yesno \
891 -default no \
892 -title "[appname]: warning" \
893 -message [mc "Git version cannot be determined.
895 %s claims it is version '%s'.
897 %s requires at least Git 1.5.0 or later.
899 Assume '%s' is version 1.5.0?
900 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
901 set _git_version 1.5.0
902 } else {
903 exit 1
906 unset _real_git_version
908 proc git-version {args} {
909 global _git_version
911 switch [llength $args] {
913 return $_git_version
917 set op [lindex $args 0]
918 set vr [lindex $args 1]
919 set cm [package vcompare $_git_version $vr]
920 return [expr $cm $op 0]
924 set type [lindex $args 0]
925 set name [lindex $args 1]
926 set parm [lindex $args 2]
927 set body [lindex $args 3]
929 if {($type ne {proc} && $type ne {method})} {
930 error "Invalid arguments to git-version"
932 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
933 error "Last arm of $type $name must be default"
936 foreach {op vr cb} [lrange $body 0 end-2] {
937 if {[git-version $op $vr]} {
938 return [uplevel [list $type $name $parm $cb]]
942 return [uplevel [list $type $name $parm [lindex $body end]]]
945 default {
946 error "git-version >= x"
952 if {[git-version < 1.5]} {
953 catch {wm withdraw .}
954 tk_messageBox \
955 -icon error \
956 -type ok \
957 -title [mc "git-gui: fatal error"] \
958 -message "[appname] requires Git 1.5.0 or later.
960 You are using [git-version]:
962 [git --version]"
963 exit 1
966 ######################################################################
968 ## configure our library
970 set idx [file join $oguilib tclIndex]
971 if {[catch {set fd [open $idx r]} err]} {
972 catch {wm withdraw .}
973 tk_messageBox \
974 -icon error \
975 -type ok \
976 -title [mc "git-gui: fatal error"] \
977 -message $err
978 exit 1
980 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
981 set idx [list]
982 while {[gets $fd n] >= 0} {
983 if {$n ne {} && ![string match #* $n]} {
984 lappend idx $n
987 } else {
988 set idx {}
990 close $fd
992 if {$idx ne {}} {
993 set loaded [list]
994 foreach p $idx {
995 if {[lsearch -exact $loaded $p] >= 0} continue
996 source [file join $oguilib $p]
997 lappend loaded $p
999 unset loaded p
1000 } else {
1001 set auto_path [concat [list $oguilib] $auto_path]
1003 unset -nocomplain idx fd
1005 ######################################################################
1007 ## config file parsing
1009 git-version proc _parse_config {arr_name args} {
1010 >= 1.5.3 {
1011 upvar $arr_name arr
1012 array unset arr
1013 set buf {}
1014 catch {
1015 set fd_rc [eval \
1016 [list git_read config] \
1017 $args \
1018 [list --null --list]]
1019 fconfigure $fd_rc -translation binary
1020 set buf [read $fd_rc]
1021 close $fd_rc
1023 foreach line [split $buf "\0"] {
1024 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1025 if {[is_many_config $name]} {
1026 lappend arr($name) $value
1027 } else {
1028 set arr($name) $value
1033 default {
1034 upvar $arr_name arr
1035 array unset arr
1036 catch {
1037 set fd_rc [eval [list git_read config --list] $args]
1038 while {[gets $fd_rc line] >= 0} {
1039 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1040 if {[is_many_config $name]} {
1041 lappend arr($name) $value
1042 } else {
1043 set arr($name) $value
1047 close $fd_rc
1052 proc load_config {include_global} {
1053 global repo_config global_config system_config default_config
1055 if {$include_global} {
1056 _parse_config system_config --system
1057 _parse_config global_config --global
1059 _parse_config repo_config
1061 foreach name [array names default_config] {
1062 if {[catch {set v $system_config($name)}]} {
1063 set system_config($name) $default_config($name)
1066 foreach name [array names system_config] {
1067 if {[catch {set v $global_config($name)}]} {
1068 set global_config($name) $system_config($name)
1070 if {[catch {set v $repo_config($name)}]} {
1071 set repo_config($name) $system_config($name)
1076 ######################################################################
1078 ## feature option selection
1080 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1081 unset _junk
1082 } else {
1083 set subcommand gui
1085 if {$subcommand eq {gui.sh}} {
1086 set subcommand gui
1088 if {$subcommand eq {gui} && [llength $argv] > 0} {
1089 set subcommand [lindex $argv 0]
1090 set argv [lrange $argv 1 end]
1093 enable_option multicommit
1094 enable_option branch
1095 enable_option transport
1096 disable_option bare
1098 switch -- $subcommand {
1099 browser -
1100 blame {
1101 enable_option bare
1103 disable_option multicommit
1104 disable_option branch
1105 disable_option transport
1107 citool {
1108 enable_option singlecommit
1109 enable_option retcode
1111 disable_option multicommit
1112 disable_option branch
1113 disable_option transport
1115 while {[llength $argv] > 0} {
1116 set a [lindex $argv 0]
1117 switch -- $a {
1118 --amend {
1119 enable_option initialamend
1121 --nocommit {
1122 enable_option nocommit
1123 enable_option nocommitmsg
1125 --commitmsg {
1126 disable_option nocommitmsg
1128 default {
1129 break
1133 set argv [lrange $argv 1 end]
1138 ######################################################################
1140 ## execution environment
1142 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1144 # Suggest our implementation of askpass, if none is set
1145 if {![info exists env(SSH_ASKPASS)]} {
1146 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1149 ######################################################################
1151 ## repository setup
1153 set picked 0
1154 if {[catch {
1155 set _gitdir $env(GIT_DIR)
1156 set _prefix {}
1158 && [catch {
1159 # beware that from the .git dir this sets _gitdir to .
1160 # and _prefix to the empty string
1161 set _gitdir [git rev-parse --git-dir]
1162 set _prefix [git rev-parse --show-prefix]
1163 } err]} {
1164 load_config 1
1165 apply_config
1166 choose_repository::pick
1167 set picked 1
1170 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1171 # run from the .git dir itself) lest the routines to find the worktree
1172 # get confused
1173 if {$_gitdir eq "."} {
1174 set _gitdir [pwd]
1177 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1178 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1180 if {![file isdirectory $_gitdir]} {
1181 catch {wm withdraw .}
1182 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1183 exit 1
1185 # _gitdir exists, so try loading the config
1186 load_config 0
1187 apply_config
1188 # try to set work tree from environment, falling back to core.worktree
1189 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1190 set _gitworktree [get_config core.worktree]
1191 if {$_gitworktree eq ""} {
1192 set _gitworktree [file dirname [file normalize $_gitdir]]
1195 if {$_prefix ne {}} {
1196 if {$_gitworktree eq {}} {
1197 regsub -all {[^/]+/} $_prefix ../ cdup
1198 } else {
1199 set cdup $_gitworktree
1201 if {[catch {cd $cdup} err]} {
1202 catch {wm withdraw .}
1203 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1204 exit 1
1206 set _gitworktree [pwd]
1207 unset cdup
1208 } elseif {![is_enabled bare]} {
1209 if {[is_bare]} {
1210 catch {wm withdraw .}
1211 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1212 exit 1
1214 if {$_gitworktree eq {}} {
1215 set _gitworktree [file dirname $_gitdir]
1217 if {[catch {cd $_gitworktree} err]} {
1218 catch {wm withdraw .}
1219 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1220 exit 1
1222 set _gitworktree [pwd]
1224 set _reponame [file split [file normalize $_gitdir]]
1225 if {[lindex $_reponame end] eq {.git}} {
1226 set _reponame [lindex $_reponame end-1]
1227 } else {
1228 set _reponame [lindex $_reponame end]
1231 set env(GIT_DIR) $_gitdir
1232 set env(GIT_WORK_TREE) $_gitworktree
1234 ######################################################################
1236 ## global init
1238 set current_diff_path {}
1239 set current_diff_side {}
1240 set diff_actions [list]
1242 set HEAD {}
1243 set PARENT {}
1244 set MERGE_HEAD [list]
1245 set commit_type {}
1246 set empty_tree {}
1247 set current_branch {}
1248 set is_detached 0
1249 set current_diff_path {}
1250 set is_3way_diff 0
1251 set is_submodule_diff 0
1252 set is_conflict_diff 0
1253 set selected_commit_type new
1254 set diff_empty_count 0
1256 set nullid "0000000000000000000000000000000000000000"
1257 set nullid2 "0000000000000000000000000000000000000001"
1259 ######################################################################
1261 ## task management
1263 set rescan_active 0
1264 set diff_active 0
1265 set last_clicked {}
1267 set disable_on_lock [list]
1268 set index_lock_type none
1270 proc lock_index {type} {
1271 global index_lock_type disable_on_lock
1273 if {$index_lock_type eq {none}} {
1274 set index_lock_type $type
1275 foreach w $disable_on_lock {
1276 uplevel #0 $w disabled
1278 return 1
1279 } elseif {$index_lock_type eq "begin-$type"} {
1280 set index_lock_type $type
1281 return 1
1283 return 0
1286 proc unlock_index {} {
1287 global index_lock_type disable_on_lock
1289 set index_lock_type none
1290 foreach w $disable_on_lock {
1291 uplevel #0 $w normal
1295 ######################################################################
1297 ## status
1299 proc repository_state {ctvar hdvar mhvar} {
1300 global current_branch
1301 upvar $ctvar ct $hdvar hd $mhvar mh
1303 set mh [list]
1305 load_current_branch
1306 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1307 set hd {}
1308 set ct initial
1309 return
1312 set merge_head [gitdir MERGE_HEAD]
1313 if {[file exists $merge_head]} {
1314 set ct merge
1315 set fd_mh [open $merge_head r]
1316 while {[gets $fd_mh line] >= 0} {
1317 lappend mh $line
1319 close $fd_mh
1320 return
1323 set ct normal
1326 proc PARENT {} {
1327 global PARENT empty_tree
1329 set p [lindex $PARENT 0]
1330 if {$p ne {}} {
1331 return $p
1333 if {$empty_tree eq {}} {
1334 set empty_tree [git mktree << {}]
1336 return $empty_tree
1339 proc force_amend {} {
1340 global selected_commit_type
1341 global HEAD PARENT MERGE_HEAD commit_type
1343 repository_state newType newHEAD newMERGE_HEAD
1344 set HEAD $newHEAD
1345 set PARENT $newHEAD
1346 set MERGE_HEAD $newMERGE_HEAD
1347 set commit_type $newType
1349 set selected_commit_type amend
1350 do_select_commit_type
1353 proc rescan {after {honor_trustmtime 1}} {
1354 global HEAD PARENT MERGE_HEAD commit_type
1355 global ui_index ui_workdir ui_comm
1356 global rescan_active file_states
1357 global repo_config
1359 if {$rescan_active > 0 || ![lock_index read]} return
1361 repository_state newType newHEAD newMERGE_HEAD
1362 if {[string match amend* $commit_type]
1363 && $newType eq {normal}
1364 && $newHEAD eq $HEAD} {
1365 } else {
1366 set HEAD $newHEAD
1367 set PARENT $newHEAD
1368 set MERGE_HEAD $newMERGE_HEAD
1369 set commit_type $newType
1372 array unset file_states
1374 if {!$::GITGUI_BCK_exists &&
1375 (![$ui_comm edit modified]
1376 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1377 if {[string match amend* $commit_type]} {
1378 } elseif {[load_message GITGUI_MSG]} {
1379 } elseif {[run_prepare_commit_msg_hook]} {
1380 } elseif {[load_message MERGE_MSG]} {
1381 } elseif {[load_message SQUASH_MSG]} {
1383 $ui_comm edit reset
1384 $ui_comm edit modified false
1387 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1388 rescan_stage2 {} $after
1389 } else {
1390 set rescan_active 1
1391 ui_status [mc "Refreshing file status..."]
1392 set fd_rf [git_read update-index \
1393 -q \
1394 --unmerged \
1395 --ignore-missing \
1396 --refresh \
1398 fconfigure $fd_rf -blocking 0 -translation binary
1399 fileevent $fd_rf readable \
1400 [list rescan_stage2 $fd_rf $after]
1404 if {[is_Cygwin]} {
1405 set is_git_info_exclude {}
1406 proc have_info_exclude {} {
1407 global is_git_info_exclude
1409 if {$is_git_info_exclude eq {}} {
1410 if {[catch {exec test -f [gitdir info exclude]}]} {
1411 set is_git_info_exclude 0
1412 } else {
1413 set is_git_info_exclude 1
1416 return $is_git_info_exclude
1418 } else {
1419 proc have_info_exclude {} {
1420 return [file readable [gitdir info exclude]]
1424 proc rescan_stage2 {fd after} {
1425 global rescan_active buf_rdi buf_rdf buf_rlo
1427 if {$fd ne {}} {
1428 read $fd
1429 if {![eof $fd]} return
1430 close $fd
1433 set ls_others [list --exclude-per-directory=.gitignore]
1434 if {[have_info_exclude]} {
1435 lappend ls_others "--exclude-from=[gitdir info exclude]"
1437 set user_exclude [get_config core.excludesfile]
1438 if {$user_exclude ne {} && [file readable $user_exclude]} {
1439 lappend ls_others "--exclude-from=$user_exclude"
1442 set buf_rdi {}
1443 set buf_rdf {}
1444 set buf_rlo {}
1446 set rescan_active 3
1447 ui_status [mc "Scanning for modified files ..."]
1448 set fd_di [git_read diff-index --cached -z [PARENT]]
1449 set fd_df [git_read diff-files -z]
1450 set fd_lo [eval git_read ls-files --others -z $ls_others]
1452 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1453 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1454 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1455 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1456 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1457 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1460 proc load_message {file} {
1461 global ui_comm
1463 set f [gitdir $file]
1464 if {[file isfile $f]} {
1465 if {[catch {set fd [open $f r]}]} {
1466 return 0
1468 fconfigure $fd -eofchar {}
1469 set content [string trim [read $fd]]
1470 close $fd
1471 regsub -all -line {[ \r\t]+$} $content {} content
1472 $ui_comm delete 0.0 end
1473 $ui_comm insert end $content
1474 return 1
1476 return 0
1479 proc run_prepare_commit_msg_hook {} {
1480 global pch_error
1482 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1483 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1484 # empty file but existant file.
1486 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1488 if {[file isfile [gitdir MERGE_MSG]]} {
1489 set pcm_source "merge"
1490 set fd_mm [open [gitdir MERGE_MSG] r]
1491 puts -nonewline $fd_pcm [read $fd_mm]
1492 close $fd_mm
1493 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1494 set pcm_source "squash"
1495 set fd_sm [open [gitdir SQUASH_MSG] r]
1496 puts -nonewline $fd_pcm [read $fd_sm]
1497 close $fd_sm
1498 } else {
1499 set pcm_source ""
1502 close $fd_pcm
1504 set fd_ph [githook_read prepare-commit-msg \
1505 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1506 if {$fd_ph eq {}} {
1507 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1508 return 0;
1511 ui_status [mc "Calling prepare-commit-msg hook..."]
1512 set pch_error {}
1514 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1515 fileevent $fd_ph readable \
1516 [list prepare_commit_msg_hook_wait $fd_ph]
1518 return 1;
1521 proc prepare_commit_msg_hook_wait {fd_ph} {
1522 global pch_error
1524 append pch_error [read $fd_ph]
1525 fconfigure $fd_ph -blocking 1
1526 if {[eof $fd_ph]} {
1527 if {[catch {close $fd_ph}]} {
1528 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1529 hook_failed_popup prepare-commit-msg $pch_error
1530 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1531 exit 1
1532 } else {
1533 load_message PREPARE_COMMIT_MSG
1535 set pch_error {}
1536 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1537 return
1539 fconfigure $fd_ph -blocking 0
1540 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1543 proc read_diff_index {fd after} {
1544 global buf_rdi
1546 append buf_rdi [read $fd]
1547 set c 0
1548 set n [string length $buf_rdi]
1549 while {$c < $n} {
1550 set z1 [string first "\0" $buf_rdi $c]
1551 if {$z1 == -1} break
1552 incr z1
1553 set z2 [string first "\0" $buf_rdi $z1]
1554 if {$z2 == -1} break
1556 incr c
1557 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1558 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1559 merge_state \
1560 [encoding convertfrom $p] \
1561 [lindex $i 4]? \
1562 [list [lindex $i 0] [lindex $i 2]] \
1563 [list]
1564 set c $z2
1565 incr c
1567 if {$c < $n} {
1568 set buf_rdi [string range $buf_rdi $c end]
1569 } else {
1570 set buf_rdi {}
1573 rescan_done $fd buf_rdi $after
1576 proc read_diff_files {fd after} {
1577 global buf_rdf
1579 append buf_rdf [read $fd]
1580 set c 0
1581 set n [string length $buf_rdf]
1582 while {$c < $n} {
1583 set z1 [string first "\0" $buf_rdf $c]
1584 if {$z1 == -1} break
1585 incr z1
1586 set z2 [string first "\0" $buf_rdf $z1]
1587 if {$z2 == -1} break
1589 incr c
1590 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1591 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1592 merge_state \
1593 [encoding convertfrom $p] \
1594 ?[lindex $i 4] \
1595 [list] \
1596 [list [lindex $i 0] [lindex $i 2]]
1597 set c $z2
1598 incr c
1600 if {$c < $n} {
1601 set buf_rdf [string range $buf_rdf $c end]
1602 } else {
1603 set buf_rdf {}
1606 rescan_done $fd buf_rdf $after
1609 proc read_ls_others {fd after} {
1610 global buf_rlo
1612 append buf_rlo [read $fd]
1613 set pck [split $buf_rlo "\0"]
1614 set buf_rlo [lindex $pck end]
1615 foreach p [lrange $pck 0 end-1] {
1616 set p [encoding convertfrom $p]
1617 if {[string index $p end] eq {/}} {
1618 set p [string range $p 0 end-1]
1620 merge_state $p ?O
1622 rescan_done $fd buf_rlo $after
1625 proc rescan_done {fd buf after} {
1626 global rescan_active current_diff_path
1627 global file_states repo_config
1628 upvar $buf to_clear
1630 if {![eof $fd]} return
1631 set to_clear {}
1632 close $fd
1633 if {[incr rescan_active -1] > 0} return
1635 prune_selection
1636 unlock_index
1637 display_all_files
1638 if {$current_diff_path ne {}} { reshow_diff $after }
1639 if {$current_diff_path eq {}} { select_first_diff $after }
1642 proc prune_selection {} {
1643 global file_states selected_paths
1645 foreach path [array names selected_paths] {
1646 if {[catch {set still_here $file_states($path)}]} {
1647 unset selected_paths($path)
1652 ######################################################################
1654 ## ui helpers
1656 proc mapicon {w state path} {
1657 global all_icons
1659 if {[catch {set r $all_icons($state$w)}]} {
1660 puts "error: no icon for $w state={$state} $path"
1661 return file_plain
1663 return $r
1666 proc mapdesc {state path} {
1667 global all_descs
1669 if {[catch {set r $all_descs($state)}]} {
1670 puts "error: no desc for state={$state} $path"
1671 return $state
1673 return $r
1676 proc ui_status {msg} {
1677 global main_status
1678 if {[info exists main_status]} {
1679 $main_status show $msg
1683 proc ui_ready {{test {}}} {
1684 global main_status
1685 if {[info exists main_status]} {
1686 $main_status show [mc "Ready."] $test
1690 proc escape_path {path} {
1691 regsub -all {\\} $path "\\\\" path
1692 regsub -all "\n" $path "\\n" path
1693 return $path
1696 proc short_path {path} {
1697 return [escape_path [lindex [file split $path] end]]
1700 set next_icon_id 0
1701 set null_sha1 [string repeat 0 40]
1703 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1704 global file_states next_icon_id null_sha1
1706 set s0 [string index $new_state 0]
1707 set s1 [string index $new_state 1]
1709 if {[catch {set info $file_states($path)}]} {
1710 set state __
1711 set icon n[incr next_icon_id]
1712 } else {
1713 set state [lindex $info 0]
1714 set icon [lindex $info 1]
1715 if {$head_info eq {}} {set head_info [lindex $info 2]}
1716 if {$index_info eq {}} {set index_info [lindex $info 3]}
1719 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1720 elseif {$s0 eq {_}} {set s0 _}
1722 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1723 elseif {$s1 eq {_}} {set s1 _}
1725 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1726 set head_info [list 0 $null_sha1]
1727 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1728 && $head_info eq {}} {
1729 set head_info $index_info
1730 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1731 set index_info $head_info
1732 set head_info {}
1735 set file_states($path) [list $s0$s1 $icon \
1736 $head_info $index_info \
1738 return $state
1741 proc display_file_helper {w path icon_name old_m new_m} {
1742 global file_lists
1744 if {$new_m eq {_}} {
1745 set lno [lsearch -sorted -exact $file_lists($w) $path]
1746 if {$lno >= 0} {
1747 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1748 incr lno
1749 $w conf -state normal
1750 $w delete $lno.0 [expr {$lno + 1}].0
1751 $w conf -state disabled
1753 } elseif {$old_m eq {_} && $new_m ne {_}} {
1754 lappend file_lists($w) $path
1755 set file_lists($w) [lsort -unique $file_lists($w)]
1756 set lno [lsearch -sorted -exact $file_lists($w) $path]
1757 incr lno
1758 $w conf -state normal
1759 $w image create $lno.0 \
1760 -align center -padx 5 -pady 1 \
1761 -name $icon_name \
1762 -image [mapicon $w $new_m $path]
1763 $w insert $lno.1 "[escape_path $path]\n"
1764 $w conf -state disabled
1765 } elseif {$old_m ne $new_m} {
1766 $w conf -state normal
1767 $w image conf $icon_name -image [mapicon $w $new_m $path]
1768 $w conf -state disabled
1772 proc display_file {path state} {
1773 global file_states selected_paths
1774 global ui_index ui_workdir
1776 set old_m [merge_state $path $state]
1777 set s $file_states($path)
1778 set new_m [lindex $s 0]
1779 set icon_name [lindex $s 1]
1781 set o [string index $old_m 0]
1782 set n [string index $new_m 0]
1783 if {$o eq {U}} {
1784 set o _
1786 if {$n eq {U}} {
1787 set n _
1789 display_file_helper $ui_index $path $icon_name $o $n
1791 if {[string index $old_m 0] eq {U}} {
1792 set o U
1793 } else {
1794 set o [string index $old_m 1]
1796 if {[string index $new_m 0] eq {U}} {
1797 set n U
1798 } else {
1799 set n [string index $new_m 1]
1801 display_file_helper $ui_workdir $path $icon_name $o $n
1803 if {$new_m eq {__}} {
1804 unset file_states($path)
1805 catch {unset selected_paths($path)}
1809 proc display_all_files_helper {w path icon_name m} {
1810 global file_lists
1812 lappend file_lists($w) $path
1813 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1814 $w image create end \
1815 -align center -padx 5 -pady 1 \
1816 -name $icon_name \
1817 -image [mapicon $w $m $path]
1818 $w insert end "[escape_path $path]\n"
1821 set files_warning 0
1822 proc display_all_files {} {
1823 global ui_index ui_workdir
1824 global file_states file_lists
1825 global last_clicked
1826 global files_warning
1828 $ui_index conf -state normal
1829 $ui_workdir conf -state normal
1831 $ui_index delete 0.0 end
1832 $ui_workdir delete 0.0 end
1833 set last_clicked {}
1835 set file_lists($ui_index) [list]
1836 set file_lists($ui_workdir) [list]
1838 set to_display [lsort [array names file_states]]
1839 set display_limit [get_config gui.maxfilesdisplayed]
1840 if {[llength $to_display] > $display_limit} {
1841 if {!$files_warning} {
1842 # do not repeatedly warn:
1843 set files_warning 1
1844 info_popup [mc "Displaying only %s of %s files." \
1845 $display_limit [llength $to_display]]
1847 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1849 foreach path $to_display {
1850 set s $file_states($path)
1851 set m [lindex $s 0]
1852 set icon_name [lindex $s 1]
1854 set s [string index $m 0]
1855 if {$s ne {U} && $s ne {_}} {
1856 display_all_files_helper $ui_index $path \
1857 $icon_name $s
1860 if {[string index $m 0] eq {U}} {
1861 set s U
1862 } else {
1863 set s [string index $m 1]
1865 if {$s ne {_}} {
1866 display_all_files_helper $ui_workdir $path \
1867 $icon_name $s
1871 $ui_index conf -state disabled
1872 $ui_workdir conf -state disabled
1875 ######################################################################
1877 ## icons
1879 set filemask {
1880 #define mask_width 14
1881 #define mask_height 15
1882 static unsigned char mask_bits[] = {
1883 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1884 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1885 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1888 image create bitmap file_plain -background white -foreground black -data {
1889 #define plain_width 14
1890 #define plain_height 15
1891 static unsigned char plain_bits[] = {
1892 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1893 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1894 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1895 } -maskdata $filemask
1897 image create bitmap file_mod -background white -foreground blue -data {
1898 #define mod_width 14
1899 #define mod_height 15
1900 static unsigned char mod_bits[] = {
1901 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1902 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1903 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1904 } -maskdata $filemask
1906 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1907 #define file_fulltick_width 14
1908 #define file_fulltick_height 15
1909 static unsigned char file_fulltick_bits[] = {
1910 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1911 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1912 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1913 } -maskdata $filemask
1915 image create bitmap file_question -background white -foreground black -data {
1916 #define file_question_width 14
1917 #define file_question_height 15
1918 static unsigned char file_question_bits[] = {
1919 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1920 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1921 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1922 } -maskdata $filemask
1924 image create bitmap file_removed -background white -foreground red -data {
1925 #define file_removed_width 14
1926 #define file_removed_height 15
1927 static unsigned char file_removed_bits[] = {
1928 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1929 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1930 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1931 } -maskdata $filemask
1933 image create bitmap file_merge -background white -foreground blue -data {
1934 #define file_merge_width 14
1935 #define file_merge_height 15
1936 static unsigned char file_merge_bits[] = {
1937 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1938 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1939 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1940 } -maskdata $filemask
1942 image create bitmap file_statechange -background white -foreground green -data {
1943 #define file_merge_width 14
1944 #define file_merge_height 15
1945 static unsigned char file_statechange_bits[] = {
1946 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1947 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1948 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1949 } -maskdata $filemask
1951 set ui_index .vpane.files.index.list
1952 set ui_workdir .vpane.files.workdir.list
1954 set all_icons(_$ui_index) file_plain
1955 set all_icons(A$ui_index) file_plain
1956 set all_icons(M$ui_index) file_fulltick
1957 set all_icons(D$ui_index) file_removed
1958 set all_icons(U$ui_index) file_merge
1959 set all_icons(T$ui_index) file_statechange
1961 set all_icons(_$ui_workdir) file_plain
1962 set all_icons(M$ui_workdir) file_mod
1963 set all_icons(D$ui_workdir) file_question
1964 set all_icons(U$ui_workdir) file_merge
1965 set all_icons(O$ui_workdir) file_plain
1966 set all_icons(T$ui_workdir) file_statechange
1968 set max_status_desc 0
1969 foreach i {
1970 {__ {mc "Unmodified"}}
1972 {_M {mc "Modified, not staged"}}
1973 {M_ {mc "Staged for commit"}}
1974 {MM {mc "Portions staged for commit"}}
1975 {MD {mc "Staged for commit, missing"}}
1977 {_T {mc "File type changed, not staged"}}
1978 {T_ {mc "File type changed, staged"}}
1980 {_O {mc "Untracked, not staged"}}
1981 {A_ {mc "Staged for commit"}}
1982 {AM {mc "Portions staged for commit"}}
1983 {AD {mc "Staged for commit, missing"}}
1985 {_D {mc "Missing"}}
1986 {D_ {mc "Staged for removal"}}
1987 {DO {mc "Staged for removal, still present"}}
1989 {_U {mc "Requires merge resolution"}}
1990 {U_ {mc "Requires merge resolution"}}
1991 {UU {mc "Requires merge resolution"}}
1992 {UM {mc "Requires merge resolution"}}
1993 {UD {mc "Requires merge resolution"}}
1994 {UT {mc "Requires merge resolution"}}
1996 set text [eval [lindex $i 1]]
1997 if {$max_status_desc < [string length $text]} {
1998 set max_status_desc [string length $text]
2000 set all_descs([lindex $i 0]) $text
2002 unset i
2004 ######################################################################
2006 ## util
2008 proc scrollbar2many {list mode args} {
2009 foreach w $list {eval $w $mode $args}
2012 proc many2scrollbar {list mode sb top bottom} {
2013 $sb set $top $bottom
2014 foreach w $list {$w $mode moveto $top}
2017 proc incr_font_size {font {amt 1}} {
2018 set sz [font configure $font -size]
2019 incr sz $amt
2020 font configure $font -size $sz
2021 font configure ${font}bold -size $sz
2022 font configure ${font}italic -size $sz
2025 ######################################################################
2027 ## ui commands
2029 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2031 proc do_gitk {revs {is_submodule false}} {
2032 global current_diff_path file_states current_diff_side ui_index
2033 global _gitdir _gitworktree
2035 # -- Always start gitk through whatever we were loaded with. This
2036 # lets us bypass using shell process on Windows systems.
2038 set exe [_which gitk -script]
2039 set cmd [list [info nameofexecutable] $exe]
2040 if {$exe eq {}} {
2041 error_popup [mc "Couldn't find gitk in PATH"]
2042 } else {
2043 global env
2045 set pwd [pwd]
2047 if {!$is_submodule} {
2048 if {![is_bare]} {
2049 cd $_gitworktree
2051 } else {
2052 cd $current_diff_path
2053 if {$revs eq {--}} {
2054 set s $file_states($current_diff_path)
2055 set old_sha1 {}
2056 set new_sha1 {}
2057 switch -glob -- [lindex $s 0] {
2058 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2059 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2060 MM {
2061 if {$current_diff_side eq $ui_index} {
2062 set old_sha1 [lindex [lindex $s 2] 1]
2063 set new_sha1 [lindex [lindex $s 3] 1]
2064 } else {
2065 set old_sha1 [lindex [lindex $s 3] 1]
2069 set revs $old_sha1...$new_sha1
2071 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2072 # we've been using for the main repository, so unset them.
2073 # TODO we could make life easier (start up faster?) for gitk
2074 # by setting these to the appropriate values to allow gitk
2075 # to skip the heuristics to find their proper value
2076 unset env(GIT_DIR)
2077 unset env(GIT_WORK_TREE)
2079 eval exec $cmd $revs "--" "--" &
2081 set env(GIT_DIR) $_gitdir
2082 set env(GIT_WORK_TREE) $_gitworktree
2083 cd $pwd
2085 ui_status $::starting_gitk_msg
2086 after 10000 {
2087 ui_ready $starting_gitk_msg
2092 proc do_git_gui {} {
2093 global current_diff_path
2095 # -- Always start git gui through whatever we were loaded with. This
2096 # lets us bypass using shell process on Windows systems.
2098 set exe [list [_which git]]
2099 if {$exe eq {}} {
2100 error_popup [mc "Couldn't find git gui in PATH"]
2101 } else {
2102 global env
2103 global _gitdir _gitworktree
2105 # see note in do_gitk about unsetting these vars when
2106 # running tools in a submodule
2107 unset env(GIT_DIR)
2108 unset env(GIT_WORK_TREE)
2110 set pwd [pwd]
2111 cd $current_diff_path
2113 eval exec $exe gui &
2115 set env(GIT_DIR) $_gitdir
2116 set env(GIT_WORK_TREE) $_gitworktree
2117 cd $pwd
2119 ui_status $::starting_gitk_msg
2120 after 10000 {
2121 ui_ready $starting_gitk_msg
2126 proc do_explore {} {
2127 global _gitworktree
2128 set explorer {}
2129 if {[is_Cygwin] || [is_Windows]} {
2130 set explorer "explorer.exe"
2131 } elseif {[is_MacOSX]} {
2132 set explorer "open"
2133 } else {
2134 # freedesktop.org-conforming system is our best shot
2135 set explorer "xdg-open"
2137 eval exec $explorer [list [file nativename $_gitworktree]] &
2140 set is_quitting 0
2141 set ret_code 1
2143 proc terminate_me {win} {
2144 global ret_code
2145 if {$win ne {.}} return
2146 exit $ret_code
2149 proc do_quit {{rc {1}}} {
2150 global ui_comm is_quitting repo_config commit_type
2151 global GITGUI_BCK_exists GITGUI_BCK_i
2152 global ui_comm_spell
2153 global ret_code use_ttk
2155 if {$is_quitting} return
2156 set is_quitting 1
2158 if {[winfo exists $ui_comm]} {
2159 # -- Stash our current commit buffer.
2161 set save [gitdir GITGUI_MSG]
2162 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2163 file rename -force [gitdir GITGUI_BCK] $save
2164 set GITGUI_BCK_exists 0
2165 } else {
2166 set msg [string trim [$ui_comm get 0.0 end]]
2167 regsub -all -line {[ \r\t]+$} $msg {} msg
2168 if {(![string match amend* $commit_type]
2169 || [$ui_comm edit modified])
2170 && $msg ne {}} {
2171 catch {
2172 set fd [open $save w]
2173 puts -nonewline $fd $msg
2174 close $fd
2176 } else {
2177 catch {file delete $save}
2181 # -- Cancel our spellchecker if its running.
2183 if {[info exists ui_comm_spell]} {
2184 $ui_comm_spell stop
2187 # -- Remove our editor backup, its not needed.
2189 after cancel $GITGUI_BCK_i
2190 if {$GITGUI_BCK_exists} {
2191 catch {file delete [gitdir GITGUI_BCK]}
2194 # -- Stash our current window geometry into this repository.
2196 set cfg_wmstate [wm state .]
2197 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2198 set rc_wmstate {}
2200 if {$cfg_wmstate ne $rc_wmstate} {
2201 catch {git config gui.wmstate $cfg_wmstate}
2203 if {$cfg_wmstate eq {zoomed}} {
2204 # on Windows wm geometry will lie about window
2205 # position (but not size) when window is zoomed
2206 # restore the window before querying wm geometry
2207 wm state . normal
2209 set cfg_geometry [list]
2210 lappend cfg_geometry [wm geometry .]
2211 if {$use_ttk} {
2212 lappend cfg_geometry [.vpane sashpos 0]
2213 lappend cfg_geometry [.vpane.files sashpos 0]
2214 } else {
2215 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2216 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2218 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2219 set rc_geometry {}
2221 if {$cfg_geometry ne $rc_geometry} {
2222 catch {git config gui.geometry $cfg_geometry}
2226 set ret_code $rc
2228 # Briefly enable send again, working around Tk bug
2229 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2230 tk appname [appname]
2232 destroy .
2235 proc do_rescan {} {
2236 rescan ui_ready
2239 proc ui_do_rescan {} {
2240 rescan {force_first_diff ui_ready}
2243 proc do_commit {} {
2244 commit_tree
2247 proc next_diff {{after {}}} {
2248 global next_diff_p next_diff_w next_diff_i
2249 show_diff $next_diff_p $next_diff_w {} {} $after
2252 proc find_anchor_pos {lst name} {
2253 set lid [lsearch -sorted -exact $lst $name]
2255 if {$lid == -1} {
2256 set lid 0
2257 foreach lname $lst {
2258 if {$lname >= $name} break
2259 incr lid
2263 return $lid
2266 proc find_file_from {flist idx delta path mmask} {
2267 global file_states
2269 set len [llength $flist]
2270 while {$idx >= 0 && $idx < $len} {
2271 set name [lindex $flist $idx]
2273 if {$name ne $path && [info exists file_states($name)]} {
2274 set state [lindex $file_states($name) 0]
2276 if {$mmask eq {} || [regexp $mmask $state]} {
2277 return $idx
2281 incr idx $delta
2284 return {}
2287 proc find_next_diff {w path {lno {}} {mmask {}}} {
2288 global next_diff_p next_diff_w next_diff_i
2289 global file_lists ui_index ui_workdir
2291 set flist $file_lists($w)
2292 if {$lno eq {}} {
2293 set lno [find_anchor_pos $flist $path]
2294 } else {
2295 incr lno -1
2298 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2299 if {$w eq $ui_index} {
2300 set mmask "^$mmask"
2301 } else {
2302 set mmask "$mmask\$"
2306 set idx [find_file_from $flist $lno 1 $path $mmask]
2307 if {$idx eq {}} {
2308 incr lno -1
2309 set idx [find_file_from $flist $lno -1 $path $mmask]
2312 if {$idx ne {}} {
2313 set next_diff_w $w
2314 set next_diff_p [lindex $flist $idx]
2315 set next_diff_i [expr {$idx+1}]
2316 return 1
2317 } else {
2318 return 0
2322 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2323 global current_diff_path
2325 if {$path ne $current_diff_path} {
2326 return {}
2327 } elseif {[find_next_diff $w $path $lno $mmask]} {
2328 return {next_diff;}
2329 } else {
2330 return {reshow_diff;}
2334 proc select_first_diff {after} {
2335 global ui_workdir
2337 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2338 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2339 next_diff $after
2340 } else {
2341 uplevel #0 $after
2345 proc force_first_diff {after} {
2346 global ui_workdir current_diff_path file_states
2348 if {[info exists file_states($current_diff_path)]} {
2349 set state [lindex $file_states($current_diff_path) 0]
2350 } else {
2351 set state {OO}
2354 set reselect 0
2355 if {[string first {U} $state] >= 0} {
2356 # Already a conflict, do nothing
2357 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2358 set reselect 1
2359 } elseif {[string index $state 1] ne {O}} {
2360 # Already a diff & no conflicts, do nothing
2361 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2362 set reselect 1
2365 if {$reselect} {
2366 next_diff $after
2367 } else {
2368 uplevel #0 $after
2372 proc toggle_or_diff {w x y} {
2373 global file_states file_lists current_diff_path ui_index ui_workdir
2374 global last_clicked selected_paths
2376 set pos [split [$w index @$x,$y] .]
2377 set lno [lindex $pos 0]
2378 set col [lindex $pos 1]
2379 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2380 if {$path eq {}} {
2381 set last_clicked {}
2382 return
2385 set last_clicked [list $w $lno]
2386 array unset selected_paths
2387 $ui_index tag remove in_sel 0.0 end
2388 $ui_workdir tag remove in_sel 0.0 end
2390 # Determine the state of the file
2391 if {[info exists file_states($path)]} {
2392 set state [lindex $file_states($path) 0]
2393 } else {
2394 set state {__}
2397 # Restage the file, or simply show the diff
2398 if {$col == 0 && $y > 1} {
2399 # Conflicts need special handling
2400 if {[string first {U} $state] >= 0} {
2401 # $w must always be $ui_workdir, but...
2402 if {$w ne $ui_workdir} { set lno {} }
2403 merge_stage_workdir $path $lno
2404 return
2407 if {[string index $state 1] eq {O}} {
2408 set mmask {}
2409 } else {
2410 set mmask {[^O]}
2413 set after [next_diff_after_action $w $path $lno $mmask]
2415 if {$w eq $ui_index} {
2416 update_indexinfo \
2417 "Unstaging [short_path $path] from commit" \
2418 [list $path] \
2419 [concat $after [list ui_ready]]
2420 } elseif {$w eq $ui_workdir} {
2421 update_index \
2422 "Adding [short_path $path]" \
2423 [list $path] \
2424 [concat $after [list ui_ready]]
2426 } else {
2427 show_diff $path $w $lno
2431 proc add_one_to_selection {w x y} {
2432 global file_lists last_clicked selected_paths
2434 set lno [lindex [split [$w index @$x,$y] .] 0]
2435 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2436 if {$path eq {}} {
2437 set last_clicked {}
2438 return
2441 if {$last_clicked ne {}
2442 && [lindex $last_clicked 0] ne $w} {
2443 array unset selected_paths
2444 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2447 set last_clicked [list $w $lno]
2448 if {[catch {set in_sel $selected_paths($path)}]} {
2449 set in_sel 0
2451 if {$in_sel} {
2452 unset selected_paths($path)
2453 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2454 } else {
2455 set selected_paths($path) 1
2456 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2460 proc add_range_to_selection {w x y} {
2461 global file_lists last_clicked selected_paths
2463 if {[lindex $last_clicked 0] ne $w} {
2464 toggle_or_diff $w $x $y
2465 return
2468 set lno [lindex [split [$w index @$x,$y] .] 0]
2469 set lc [lindex $last_clicked 1]
2470 if {$lc < $lno} {
2471 set begin $lc
2472 set end $lno
2473 } else {
2474 set begin $lno
2475 set end $lc
2478 foreach path [lrange $file_lists($w) \
2479 [expr {$begin - 1}] \
2480 [expr {$end - 1}]] {
2481 set selected_paths($path) 1
2483 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2486 proc show_more_context {} {
2487 global repo_config
2488 if {$repo_config(gui.diffcontext) < 99} {
2489 incr repo_config(gui.diffcontext)
2490 reshow_diff
2494 proc show_less_context {} {
2495 global repo_config
2496 if {$repo_config(gui.diffcontext) > 1} {
2497 incr repo_config(gui.diffcontext) -1
2498 reshow_diff
2502 ######################################################################
2504 ## ui construction
2506 set ui_comm {}
2508 # -- Menu Bar
2510 menu .mbar -tearoff 0
2511 if {[is_MacOSX]} {
2512 # -- Apple Menu (Mac OS X only)
2514 .mbar add cascade -label Apple -menu .mbar.apple
2515 menu .mbar.apple
2517 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2518 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2519 if {[is_enabled branch]} {
2520 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2522 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2523 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2525 if {[is_enabled transport]} {
2526 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2527 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2529 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2530 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2533 # -- Repository Menu
2535 menu .mbar.repository
2537 if {![is_bare]} {
2538 .mbar.repository add command \
2539 -label [mc "Explore Working Copy"] \
2540 -command {do_explore}
2541 .mbar.repository add separator
2544 .mbar.repository add command \
2545 -label [mc "Browse Current Branch's Files"] \
2546 -command {browser::new $current_branch}
2547 set ui_browse_current [.mbar.repository index last]
2548 .mbar.repository add command \
2549 -label [mc "Browse Branch Files..."] \
2550 -command browser_open::dialog
2551 .mbar.repository add separator
2553 .mbar.repository add command \
2554 -label [mc "Visualize Current Branch's History"] \
2555 -command {do_gitk $current_branch}
2556 set ui_visualize_current [.mbar.repository index last]
2557 .mbar.repository add command \
2558 -label [mc "Visualize All Branch History"] \
2559 -command {do_gitk --all}
2560 .mbar.repository add separator
2562 proc current_branch_write {args} {
2563 global current_branch
2564 .mbar.repository entryconf $::ui_browse_current \
2565 -label [mc "Browse %s's Files" $current_branch]
2566 .mbar.repository entryconf $::ui_visualize_current \
2567 -label [mc "Visualize %s's History" $current_branch]
2569 trace add variable current_branch write current_branch_write
2571 if {[is_enabled multicommit]} {
2572 .mbar.repository add command -label [mc "Database Statistics"] \
2573 -command do_stats
2575 .mbar.repository add command -label [mc "Compress Database"] \
2576 -command do_gc
2578 .mbar.repository add command -label [mc "Verify Database"] \
2579 -command do_fsck_objects
2581 .mbar.repository add separator
2583 if {[is_Cygwin]} {
2584 .mbar.repository add command \
2585 -label [mc "Create Desktop Icon"] \
2586 -command do_cygwin_shortcut
2587 } elseif {[is_Windows]} {
2588 .mbar.repository add command \
2589 -label [mc "Create Desktop Icon"] \
2590 -command do_windows_shortcut
2591 } elseif {[is_MacOSX]} {
2592 .mbar.repository add command \
2593 -label [mc "Create Desktop Icon"] \
2594 -command do_macosx_app
2598 if {[is_MacOSX]} {
2599 proc ::tk::mac::Quit {args} { do_quit }
2600 } else {
2601 .mbar.repository add command -label [mc Quit] \
2602 -command do_quit \
2603 -accelerator $M1T-Q
2606 # -- Edit Menu
2608 menu .mbar.edit
2609 .mbar.edit add command -label [mc Undo] \
2610 -command {catch {[focus] edit undo}} \
2611 -accelerator $M1T-Z
2612 .mbar.edit add command -label [mc Redo] \
2613 -command {catch {[focus] edit redo}} \
2614 -accelerator $M1T-Y
2615 .mbar.edit add separator
2616 .mbar.edit add command -label [mc Cut] \
2617 -command {catch {tk_textCut [focus]}} \
2618 -accelerator $M1T-X
2619 .mbar.edit add command -label [mc Copy] \
2620 -command {catch {tk_textCopy [focus]}} \
2621 -accelerator $M1T-C
2622 .mbar.edit add command -label [mc Paste] \
2623 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2624 -accelerator $M1T-V
2625 .mbar.edit add command -label [mc Delete] \
2626 -command {catch {[focus] delete sel.first sel.last}} \
2627 -accelerator Del
2628 .mbar.edit add separator
2629 .mbar.edit add command -label [mc "Select All"] \
2630 -command {catch {[focus] tag add sel 0.0 end}} \
2631 -accelerator $M1T-A
2633 # -- Branch Menu
2635 if {[is_enabled branch]} {
2636 menu .mbar.branch
2638 .mbar.branch add command -label [mc "Create..."] \
2639 -command branch_create::dialog \
2640 -accelerator $M1T-N
2641 lappend disable_on_lock [list .mbar.branch entryconf \
2642 [.mbar.branch index last] -state]
2644 .mbar.branch add command -label [mc "Checkout..."] \
2645 -command branch_checkout::dialog \
2646 -accelerator $M1T-O
2647 lappend disable_on_lock [list .mbar.branch entryconf \
2648 [.mbar.branch index last] -state]
2650 .mbar.branch add command -label [mc "Rename..."] \
2651 -command branch_rename::dialog
2652 lappend disable_on_lock [list .mbar.branch entryconf \
2653 [.mbar.branch index last] -state]
2655 .mbar.branch add command -label [mc "Delete..."] \
2656 -command branch_delete::dialog
2657 lappend disable_on_lock [list .mbar.branch entryconf \
2658 [.mbar.branch index last] -state]
2660 .mbar.branch add command -label [mc "Reset..."] \
2661 -command merge::reset_hard
2662 lappend disable_on_lock [list .mbar.branch entryconf \
2663 [.mbar.branch index last] -state]
2666 # -- Commit Menu
2668 proc commit_btn_caption {} {
2669 if {[is_enabled nocommit]} {
2670 return [mc "Done"]
2671 } else {
2672 return [mc Commit@@verb]
2676 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2677 menu .mbar.commit
2679 if {![is_enabled nocommit]} {
2680 .mbar.commit add radiobutton \
2681 -label [mc "New Commit"] \
2682 -command do_select_commit_type \
2683 -variable selected_commit_type \
2684 -value new
2685 lappend disable_on_lock \
2686 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2688 .mbar.commit add radiobutton \
2689 -label [mc "Amend Last Commit"] \
2690 -command do_select_commit_type \
2691 -variable selected_commit_type \
2692 -value amend
2693 lappend disable_on_lock \
2694 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2696 .mbar.commit add separator
2699 .mbar.commit add command -label [mc Rescan] \
2700 -command ui_do_rescan \
2701 -accelerator F5
2702 lappend disable_on_lock \
2703 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2705 .mbar.commit add command -label [mc "Stage To Commit"] \
2706 -command do_add_selection \
2707 -accelerator $M1T-T
2708 lappend disable_on_lock \
2709 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2711 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2712 -command do_add_all \
2713 -accelerator $M1T-I
2714 lappend disable_on_lock \
2715 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2717 .mbar.commit add command -label [mc "Unstage From Commit"] \
2718 -command do_unstage_selection \
2719 -accelerator $M1T-U
2720 lappend disable_on_lock \
2721 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2723 .mbar.commit add command -label [mc "Revert Changes"] \
2724 -command do_revert_selection \
2725 -accelerator $M1T-J
2726 lappend disable_on_lock \
2727 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2729 .mbar.commit add separator
2731 .mbar.commit add command -label [mc "Show Less Context"] \
2732 -command show_less_context \
2733 -accelerator $M1T-\-
2735 .mbar.commit add command -label [mc "Show More Context"] \
2736 -command show_more_context \
2737 -accelerator $M1T-=
2739 .mbar.commit add separator
2741 if {![is_enabled nocommitmsg]} {
2742 .mbar.commit add command -label [mc "Sign Off"] \
2743 -command do_signoff \
2744 -accelerator $M1T-S
2747 .mbar.commit add command -label [commit_btn_caption] \
2748 -command do_commit \
2749 -accelerator $M1T-Return
2750 lappend disable_on_lock \
2751 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2754 # -- Merge Menu
2756 if {[is_enabled branch]} {
2757 menu .mbar.merge
2758 .mbar.merge add command -label [mc "Local Merge..."] \
2759 -command merge::dialog \
2760 -accelerator $M1T-M
2761 lappend disable_on_lock \
2762 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2763 .mbar.merge add command -label [mc "Abort Merge..."] \
2764 -command merge::reset_hard
2765 lappend disable_on_lock \
2766 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2769 # -- Transport Menu
2771 if {[is_enabled transport]} {
2772 menu .mbar.remote
2774 .mbar.remote add command \
2775 -label [mc "Add..."] \
2776 -command remote_add::dialog \
2777 -accelerator $M1T-A
2778 .mbar.remote add command \
2779 -label [mc "Push..."] \
2780 -command do_push_anywhere \
2781 -accelerator $M1T-P
2782 .mbar.remote add command \
2783 -label [mc "Delete Branch..."] \
2784 -command remote_branch_delete::dialog
2787 if {[is_MacOSX]} {
2788 proc ::tk::mac::ShowPreferences {} {do_options}
2789 } else {
2790 # -- Edit Menu
2792 .mbar.edit add separator
2793 .mbar.edit add command -label [mc "Options..."] \
2794 -command do_options
2797 # -- Tools Menu
2799 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2800 set tools_menubar .mbar.tools
2801 menu $tools_menubar
2802 $tools_menubar add separator
2803 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2804 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2805 set tools_tailcnt 3
2806 if {[array names repo_config guitool.*.cmd] ne {}} {
2807 tools_populate_all
2811 # -- Help Menu
2813 .mbar add cascade -label [mc Help] -menu .mbar.help
2814 menu .mbar.help
2816 if {[is_MacOSX]} {
2817 .mbar.apple add command -label [mc "About %s" [appname]] \
2818 -command do_about
2819 .mbar.apple add separator
2820 } else {
2821 .mbar.help add command -label [mc "About %s" [appname]] \
2822 -command do_about
2824 . configure -menu .mbar
2826 set doc_path [githtmldir]
2827 if {$doc_path ne {}} {
2828 set doc_path [file join $doc_path index.html]
2830 if {[is_Cygwin]} {
2831 set doc_path [exec cygpath --mixed $doc_path]
2835 if {[file isfile $doc_path]} {
2836 set doc_url "file:$doc_path"
2837 } else {
2838 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2841 proc start_browser {url} {
2842 git "web--browse" $url
2845 .mbar.help add command -label [mc "Online Documentation"] \
2846 -command [list start_browser $doc_url]
2848 .mbar.help add command -label [mc "Show SSH Key"] \
2849 -command do_ssh_key
2851 unset doc_path doc_url
2853 # -- Standard bindings
2855 wm protocol . WM_DELETE_WINDOW do_quit
2856 bind all <$M1B-Key-q> do_quit
2857 bind all <$M1B-Key-Q> do_quit
2858 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2859 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2861 set subcommand_args {}
2862 proc usage {} {
2863 set s "usage: $::argv0 $::subcommand $::subcommand_args"
2864 if {[tk windowingsystem] eq "win32"} {
2865 wm withdraw .
2866 tk_messageBox -icon info -message $s \
2867 -title [mc "Usage"]
2868 } else {
2869 puts stderr $s
2871 exit 1
2874 proc normalize_relpath {path} {
2875 set elements {}
2876 foreach item [file split $path] {
2877 if {$item eq {.}} continue
2878 if {$item eq {..} && [llength $elements] > 0
2879 && [lindex $elements end] ne {..}} {
2880 set elements [lrange $elements 0 end-1]
2881 continue
2883 lappend elements $item
2885 return [eval file join $elements]
2888 # -- Not a normal commit type invocation? Do that instead!
2890 switch -- $subcommand {
2891 browser -
2892 blame {
2893 if {$subcommand eq "blame"} {
2894 set subcommand_args {[--line=<num>] rev? path}
2895 } else {
2896 set subcommand_args {rev? path}
2898 if {$argv eq {}} usage
2899 set head {}
2900 set path {}
2901 set jump_spec {}
2902 set is_path 0
2903 foreach a $argv {
2904 if {$is_path || [file exists $_prefix$a]} {
2905 if {$path ne {}} usage
2906 set path [normalize_relpath $_prefix$a]
2907 break
2908 } elseif {$a eq {--}} {
2909 if {$path ne {}} {
2910 if {$head ne {}} usage
2911 set head $path
2912 set path {}
2914 set is_path 1
2915 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2916 if {$jump_spec ne {} || $head ne {}} usage
2917 set jump_spec [list $lnum]
2918 } elseif {$head eq {}} {
2919 if {$head ne {}} usage
2920 set head $a
2921 set is_path 1
2922 } else {
2923 usage
2926 unset is_path
2928 if {$head ne {} && $path eq {}} {
2929 set path [normalize_relpath $_prefix$head]
2930 set head {}
2933 if {$head eq {}} {
2934 load_current_branch
2935 } else {
2936 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2937 if {[catch {
2938 set head [git rev-parse --verify $head]
2939 } err]} {
2940 if {[tk windowingsystem] eq "win32"} {
2941 tk_messageBox -icon error -title [mc Error] -message $err
2942 } else {
2943 puts stderr $err
2945 exit 1
2948 set current_branch $head
2951 wm deiconify .
2952 switch -- $subcommand {
2953 browser {
2954 if {$jump_spec ne {}} usage
2955 if {$head eq {}} {
2956 if {$path ne {} && [file isdirectory $path]} {
2957 set head $current_branch
2958 } else {
2959 set head $path
2960 set path {}
2963 browser::new $head $path
2965 blame {
2966 if {$head eq {} && ![file exists $path]} {
2967 catch {wm withdraw .}
2968 tk_messageBox \
2969 -icon error \
2970 -type ok \
2971 -title [mc "git-gui: fatal error"] \
2972 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
2973 exit 1
2975 blame::new $head $path $jump_spec
2978 return
2980 citool -
2981 gui {
2982 if {[llength $argv] != 0} {
2983 usage
2985 # fall through to setup UI for commits
2987 default {
2988 set err "usage: $argv0 \[{blame|browser|citool}\]"
2989 if {[tk windowingsystem] eq "win32"} {
2990 wm withdraw .
2991 tk_messageBox -icon error -message $err \
2992 -title [mc "Usage"]
2993 } else {
2994 puts stderr $err
2996 exit 1
3000 # -- Branch Control
3002 ${NS}::frame .branch
3003 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3004 ${NS}::label .branch.l1 \
3005 -text [mc "Current Branch:"] \
3006 -anchor w \
3007 -justify left
3008 ${NS}::label .branch.cb \
3009 -textvariable current_branch \
3010 -anchor w \
3011 -justify left
3012 pack .branch.l1 -side left
3013 pack .branch.cb -side left -fill x
3014 pack .branch -side top -fill x
3016 # -- Main Window Layout
3018 ${NS}::panedwindow .vpane -orient horizontal
3019 ${NS}::panedwindow .vpane.files -orient vertical
3020 if {$use_ttk} {
3021 .vpane add .vpane.files
3022 } else {
3023 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3025 pack .vpane -anchor n -side top -fill both -expand 1
3027 # -- Index File List
3029 ${NS}::frame .vpane.files.index -height 100 -width 200
3030 tlabel .vpane.files.index.title \
3031 -text [mc "Staged Changes (Will Commit)"] \
3032 -background lightgreen -foreground black
3033 text $ui_index -background white -foreground black \
3034 -borderwidth 0 \
3035 -width 20 -height 10 \
3036 -wrap none \
3037 -cursor $cursor_ptr \
3038 -xscrollcommand {.vpane.files.index.sx set} \
3039 -yscrollcommand {.vpane.files.index.sy set} \
3040 -state disabled
3041 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3042 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3043 pack .vpane.files.index.title -side top -fill x
3044 pack .vpane.files.index.sx -side bottom -fill x
3045 pack .vpane.files.index.sy -side right -fill y
3046 pack $ui_index -side left -fill both -expand 1
3048 # -- Working Directory File List
3050 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3051 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3052 -background lightsalmon -foreground black
3053 text $ui_workdir -background white -foreground black \
3054 -borderwidth 0 \
3055 -width 20 -height 10 \
3056 -wrap none \
3057 -cursor $cursor_ptr \
3058 -xscrollcommand {.vpane.files.workdir.sx set} \
3059 -yscrollcommand {.vpane.files.workdir.sy set} \
3060 -state disabled
3061 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3062 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3063 pack .vpane.files.workdir.title -side top -fill x
3064 pack .vpane.files.workdir.sx -side bottom -fill x
3065 pack .vpane.files.workdir.sy -side right -fill y
3066 pack $ui_workdir -side left -fill both -expand 1
3068 .vpane.files add .vpane.files.workdir
3069 .vpane.files add .vpane.files.index
3070 if {!$use_ttk} {
3071 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3072 .vpane.files paneconfigure .vpane.files.index -sticky news
3075 foreach i [list $ui_index $ui_workdir] {
3076 rmsel_tag $i
3077 $i tag conf in_diff -background [$i tag cget in_sel -background]
3079 unset i
3081 # -- Diff and Commit Area
3083 ${NS}::frame .vpane.lower -height 300 -width 400
3084 ${NS}::frame .vpane.lower.commarea
3085 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3086 pack .vpane.lower.diff -fill both -expand 1
3087 pack .vpane.lower.commarea -side bottom -fill x
3088 .vpane add .vpane.lower
3089 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3091 # -- Commit Area Buttons
3093 ${NS}::frame .vpane.lower.commarea.buttons
3094 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3095 -anchor w \
3096 -justify left
3097 pack .vpane.lower.commarea.buttons.l -side top -fill x
3098 pack .vpane.lower.commarea.buttons -side left -fill y
3100 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3101 -command ui_do_rescan
3102 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3103 lappend disable_on_lock \
3104 {.vpane.lower.commarea.buttons.rescan conf -state}
3106 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3107 -command do_add_all
3108 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3109 lappend disable_on_lock \
3110 {.vpane.lower.commarea.buttons.incall conf -state}
3112 if {![is_enabled nocommitmsg]} {
3113 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3114 -command do_signoff
3115 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3118 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3119 -command do_commit
3120 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3121 lappend disable_on_lock \
3122 {.vpane.lower.commarea.buttons.commit conf -state}
3124 if {![is_enabled nocommit]} {
3125 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3126 -command do_push_anywhere
3127 pack .vpane.lower.commarea.buttons.push -side top -fill x
3130 # -- Commit Message Buffer
3132 ${NS}::frame .vpane.lower.commarea.buffer
3133 ${NS}::frame .vpane.lower.commarea.buffer.header
3134 set ui_comm .vpane.lower.commarea.buffer.t
3135 set ui_coml .vpane.lower.commarea.buffer.header.l
3137 if {![is_enabled nocommit]} {
3138 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3139 -text [mc "New Commit"] \
3140 -command do_select_commit_type \
3141 -variable selected_commit_type \
3142 -value new
3143 lappend disable_on_lock \
3144 [list .vpane.lower.commarea.buffer.header.new conf -state]
3145 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3146 -text [mc "Amend Last Commit"] \
3147 -command do_select_commit_type \
3148 -variable selected_commit_type \
3149 -value amend
3150 lappend disable_on_lock \
3151 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3154 ${NS}::label $ui_coml \
3155 -anchor w \
3156 -justify left
3157 proc trace_commit_type {varname args} {
3158 global ui_coml commit_type
3159 switch -glob -- $commit_type {
3160 initial {set txt [mc "Initial Commit Message:"]}
3161 amend {set txt [mc "Amended Commit Message:"]}
3162 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3163 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3164 merge {set txt [mc "Merge Commit Message:"]}
3165 * {set txt [mc "Commit Message:"]}
3167 $ui_coml conf -text $txt
3169 trace add variable commit_type write trace_commit_type
3170 pack $ui_coml -side left -fill x
3172 if {![is_enabled nocommit]} {
3173 pack .vpane.lower.commarea.buffer.header.amend -side right
3174 pack .vpane.lower.commarea.buffer.header.new -side right
3177 text $ui_comm -background white -foreground black \
3178 -borderwidth 1 \
3179 -undo true \
3180 -maxundo 20 \
3181 -autoseparators true \
3182 -relief sunken \
3183 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3184 -font font_diff \
3185 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3186 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3187 -command [list $ui_comm yview]
3188 pack .vpane.lower.commarea.buffer.header -side top -fill x
3189 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3190 pack $ui_comm -side left -fill y
3191 pack .vpane.lower.commarea.buffer -side left -fill y
3193 # -- Commit Message Buffer Context Menu
3195 set ctxm .vpane.lower.commarea.buffer.ctxm
3196 menu $ctxm -tearoff 0
3197 $ctxm add command \
3198 -label [mc Cut] \
3199 -command {tk_textCut $ui_comm}
3200 $ctxm add command \
3201 -label [mc Copy] \
3202 -command {tk_textCopy $ui_comm}
3203 $ctxm add command \
3204 -label [mc Paste] \
3205 -command {tk_textPaste $ui_comm}
3206 $ctxm add command \
3207 -label [mc Delete] \
3208 -command {catch {$ui_comm delete sel.first sel.last}}
3209 $ctxm add separator
3210 $ctxm add command \
3211 -label [mc "Select All"] \
3212 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3213 $ctxm add command \
3214 -label [mc "Copy All"] \
3215 -command {
3216 $ui_comm tag add sel 0.0 end
3217 tk_textCopy $ui_comm
3218 $ui_comm tag remove sel 0.0 end
3220 $ctxm add separator
3221 $ctxm add command \
3222 -label [mc "Sign Off"] \
3223 -command do_signoff
3224 set ui_comm_ctxm $ctxm
3226 # -- Diff Header
3228 proc trace_current_diff_path {varname args} {
3229 global current_diff_path diff_actions file_states
3230 if {$current_diff_path eq {}} {
3231 set s {}
3232 set f {}
3233 set p {}
3234 set o disabled
3235 } else {
3236 set p $current_diff_path
3237 set s [mapdesc [lindex $file_states($p) 0] $p]
3238 set f [mc "File:"]
3239 set p [escape_path $p]
3240 set o normal
3243 .vpane.lower.diff.header.status configure -text $s
3244 .vpane.lower.diff.header.file configure -text $f
3245 .vpane.lower.diff.header.path configure -text $p
3246 foreach w $diff_actions {
3247 uplevel #0 $w $o
3250 trace add variable current_diff_path write trace_current_diff_path
3252 gold_frame .vpane.lower.diff.header
3253 tlabel .vpane.lower.diff.header.status \
3254 -background gold \
3255 -foreground black \
3256 -width $max_status_desc \
3257 -anchor w \
3258 -justify left
3259 tlabel .vpane.lower.diff.header.file \
3260 -background gold \
3261 -foreground black \
3262 -anchor w \
3263 -justify left
3264 tlabel .vpane.lower.diff.header.path \
3265 -background gold \
3266 -foreground black \
3267 -anchor w \
3268 -justify left
3269 pack .vpane.lower.diff.header.status -side left
3270 pack .vpane.lower.diff.header.file -side left
3271 pack .vpane.lower.diff.header.path -fill x
3272 set ctxm .vpane.lower.diff.header.ctxm
3273 menu $ctxm -tearoff 0
3274 $ctxm add command \
3275 -label [mc Copy] \
3276 -command {
3277 clipboard clear
3278 clipboard append \
3279 -format STRING \
3280 -type STRING \
3281 -- $current_diff_path
3283 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3284 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3286 # -- Diff Body
3288 ${NS}::frame .vpane.lower.diff.body
3289 set ui_diff .vpane.lower.diff.body.t
3290 text $ui_diff -background white -foreground black \
3291 -borderwidth 0 \
3292 -width 80 -height 5 -wrap none \
3293 -font font_diff \
3294 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3295 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3296 -state disabled
3297 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3298 -command [list $ui_diff xview]
3299 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3300 -command [list $ui_diff yview]
3301 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3302 pack .vpane.lower.diff.body.sby -side right -fill y
3303 pack $ui_diff -side left -fill both -expand 1
3304 pack .vpane.lower.diff.header -side top -fill x
3305 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3307 $ui_diff tag conf d_cr -elide true
3308 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
3309 $ui_diff tag conf d_+ -foreground {#00a000}
3310 $ui_diff tag conf d_- -foreground red
3312 $ui_diff tag conf d_++ -foreground {#00a000}
3313 $ui_diff tag conf d_-- -foreground red
3314 $ui_diff tag conf d_+s \
3315 -foreground {#00a000} \
3316 -background {#e2effa}
3317 $ui_diff tag conf d_-s \
3318 -foreground red \
3319 -background {#e2effa}
3320 $ui_diff tag conf d_s+ \
3321 -foreground {#00a000} \
3322 -background ivory1
3323 $ui_diff tag conf d_s- \
3324 -foreground red \
3325 -background ivory1
3327 $ui_diff tag conf d<<<<<<< \
3328 -foreground orange \
3329 -font font_diffbold
3330 $ui_diff tag conf d======= \
3331 -foreground orange \
3332 -font font_diffbold
3333 $ui_diff tag conf d>>>>>>> \
3334 -foreground orange \
3335 -font font_diffbold
3337 $ui_diff tag raise sel
3339 # -- Diff Body Context Menu
3342 proc create_common_diff_popup {ctxm} {
3343 $ctxm add command \
3344 -label [mc Refresh] \
3345 -command reshow_diff
3346 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3347 $ctxm add command \
3348 -label [mc Copy] \
3349 -command {tk_textCopy $ui_diff}
3350 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3351 $ctxm add command \
3352 -label [mc "Select All"] \
3353 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3354 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3355 $ctxm add command \
3356 -label [mc "Copy All"] \
3357 -command {
3358 $ui_diff tag add sel 0.0 end
3359 tk_textCopy $ui_diff
3360 $ui_diff tag remove sel 0.0 end
3362 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3363 $ctxm add separator
3364 $ctxm add command \
3365 -label [mc "Decrease Font Size"] \
3366 -command {incr_font_size font_diff -1}
3367 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3368 $ctxm add command \
3369 -label [mc "Increase Font Size"] \
3370 -command {incr_font_size font_diff 1}
3371 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3372 $ctxm add separator
3373 set emenu $ctxm.enc
3374 menu $emenu
3375 build_encoding_menu $emenu [list force_diff_encoding]
3376 $ctxm add cascade \
3377 -label [mc "Encoding"] \
3378 -menu $emenu
3379 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3380 $ctxm add separator
3381 $ctxm add command -label [mc "Options..."] \
3382 -command do_options
3385 set ctxm .vpane.lower.diff.body.ctxm
3386 menu $ctxm -tearoff 0
3387 $ctxm add command \
3388 -label [mc "Apply/Reverse Hunk"] \
3389 -command {apply_hunk $cursorX $cursorY}
3390 set ui_diff_applyhunk [$ctxm index last]
3391 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3392 $ctxm add command \
3393 -label [mc "Apply/Reverse Line"] \
3394 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3395 set ui_diff_applyline [$ctxm index last]
3396 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3397 $ctxm add separator
3398 $ctxm add command \
3399 -label [mc "Show Less Context"] \
3400 -command show_less_context
3401 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3402 $ctxm add command \
3403 -label [mc "Show More Context"] \
3404 -command show_more_context
3405 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3406 $ctxm add separator
3407 create_common_diff_popup $ctxm
3409 set ctxmmg .vpane.lower.diff.body.ctxmmg
3410 menu $ctxmmg -tearoff 0
3411 $ctxmmg add command \
3412 -label [mc "Run Merge Tool"] \
3413 -command {merge_resolve_tool}
3414 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3415 $ctxmmg add separator
3416 $ctxmmg add command \
3417 -label [mc "Use Remote Version"] \
3418 -command {merge_resolve_one 3}
3419 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3420 $ctxmmg add command \
3421 -label [mc "Use Local Version"] \
3422 -command {merge_resolve_one 2}
3423 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3424 $ctxmmg add command \
3425 -label [mc "Revert To Base"] \
3426 -command {merge_resolve_one 1}
3427 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3428 $ctxmmg add separator
3429 $ctxmmg add command \
3430 -label [mc "Show Less Context"] \
3431 -command show_less_context
3432 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3433 $ctxmmg add command \
3434 -label [mc "Show More Context"] \
3435 -command show_more_context
3436 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3437 $ctxmmg add separator
3438 create_common_diff_popup $ctxmmg
3440 set ctxmsm .vpane.lower.diff.body.ctxmsm
3441 menu $ctxmsm -tearoff 0
3442 $ctxmsm add command \
3443 -label [mc "Visualize These Changes In The Submodule"] \
3444 -command {do_gitk -- true}
3445 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3446 $ctxmsm add command \
3447 -label [mc "Visualize Current Branch History In The Submodule"] \
3448 -command {do_gitk {} true}
3449 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3450 $ctxmsm add command \
3451 -label [mc "Visualize All Branch History In The Submodule"] \
3452 -command {do_gitk --all true}
3453 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3454 $ctxmsm add separator
3455 $ctxmsm add command \
3456 -label [mc "Start git gui In The Submodule"] \
3457 -command {do_git_gui}
3458 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3459 $ctxmsm add separator
3460 create_common_diff_popup $ctxmsm
3462 proc has_textconv {path} {
3463 if {[is_config_false gui.textconv]} {
3464 return 0
3466 set filter [gitattr $path diff set]
3467 set textconv [get_config [join [list diff $filter textconv] .]]
3468 if {$filter ne {set} && $textconv ne {}} {
3469 return 1
3470 } else {
3471 return 0
3475 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3476 global current_diff_path file_states
3477 set ::cursorX $x
3478 set ::cursorY $y
3479 if {[info exists file_states($current_diff_path)]} {
3480 set state [lindex $file_states($current_diff_path) 0]
3481 } else {
3482 set state {__}
3484 if {[string first {U} $state] >= 0} {
3485 tk_popup $ctxmmg $X $Y
3486 } elseif {$::is_submodule_diff} {
3487 tk_popup $ctxmsm $X $Y
3488 } else {
3489 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3490 if {$::ui_index eq $::current_diff_side} {
3491 set l [mc "Unstage Hunk From Commit"]
3492 if {$has_range} {
3493 set t [mc "Unstage Lines From Commit"]
3494 } else {
3495 set t [mc "Unstage Line From Commit"]
3497 } else {
3498 set l [mc "Stage Hunk For Commit"]
3499 if {$has_range} {
3500 set t [mc "Stage Lines For Commit"]
3501 } else {
3502 set t [mc "Stage Line For Commit"]
3505 if {$::is_3way_diff
3506 || $current_diff_path eq {}
3507 || {__} eq $state
3508 || {_O} eq $state
3509 || {_T} eq $state
3510 || {T_} eq $state
3511 || [has_textconv $current_diff_path]} {
3512 set s disabled
3513 } else {
3514 set s normal
3516 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3517 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3518 tk_popup $ctxm $X $Y
3521 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3523 # -- Status Bar
3525 set main_status [::status_bar::new .status]
3526 pack .status -anchor w -side bottom -fill x
3527 $main_status show [mc "Initializing..."]
3529 # -- Load geometry
3531 proc on_ttk_pane_mapped {w pane pos} {
3532 bind $w <Map> {}
3533 after 0 [list after idle [list $w sashpos $pane $pos]]
3535 proc on_tk_pane_mapped {w pane x y} {
3536 bind $w <Map> {}
3537 after 0 [list after idle [list $w sash place $pane $x $y]]
3539 proc on_application_mapped {} {
3540 global repo_config use_ttk
3541 bind . <Map> {}
3542 set gm $repo_config(gui.geometry)
3543 if {$use_ttk} {
3544 bind .vpane <Map> \
3545 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3546 bind .vpane.files <Map> \
3547 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3548 } else {
3549 bind .vpane <Map> \
3550 [list on_tk_pane_mapped %W 0 \
3551 [lindex $gm 1] \
3552 [lindex [.vpane sash coord 0] 1]]
3553 bind .vpane.files <Map> \
3554 [list on_tk_pane_mapped %W 0 \
3555 [lindex [.vpane.files sash coord 0] 0] \
3556 [lindex $gm 2]]
3558 wm geometry . [lindex $gm 0]
3560 if {[info exists repo_config(gui.geometry)]} {
3561 bind . <Map> [list on_application_mapped]
3562 wm geometry . [lindex $repo_config(gui.geometry) 0]
3565 # -- Load window state
3567 if {[info exists repo_config(gui.wmstate)]} {
3568 catch {wm state . $repo_config(gui.wmstate)}
3571 # -- Key Bindings
3573 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3574 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3575 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3576 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3577 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3578 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3579 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3580 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3581 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3582 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3583 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3584 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3585 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3586 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3587 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3588 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3589 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3590 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3591 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3592 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3593 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3594 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3596 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3597 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3598 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3599 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3600 bind $ui_diff <$M1B-Key-v> {break}
3601 bind $ui_diff <$M1B-Key-V> {break}
3602 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3603 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3604 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3605 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3606 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3607 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3608 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3609 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3610 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3611 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3612 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3613 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3614 bind $ui_diff <Button-1> {focus %W}
3616 if {[is_enabled branch]} {
3617 bind . <$M1B-Key-n> branch_create::dialog
3618 bind . <$M1B-Key-N> branch_create::dialog
3619 bind . <$M1B-Key-o> branch_checkout::dialog
3620 bind . <$M1B-Key-O> branch_checkout::dialog
3621 bind . <$M1B-Key-m> merge::dialog
3622 bind . <$M1B-Key-M> merge::dialog
3624 if {[is_enabled transport]} {
3625 bind . <$M1B-Key-p> do_push_anywhere
3626 bind . <$M1B-Key-P> do_push_anywhere
3629 bind . <Key-F5> ui_do_rescan
3630 bind . <$M1B-Key-r> ui_do_rescan
3631 bind . <$M1B-Key-R> ui_do_rescan
3632 bind . <$M1B-Key-s> do_signoff
3633 bind . <$M1B-Key-S> do_signoff
3634 bind . <$M1B-Key-t> do_add_selection
3635 bind . <$M1B-Key-T> do_add_selection
3636 bind . <$M1B-Key-j> do_revert_selection
3637 bind . <$M1B-Key-J> do_revert_selection
3638 bind . <$M1B-Key-i> do_add_all
3639 bind . <$M1B-Key-I> do_add_all
3640 bind . <$M1B-Key-minus> {show_less_context;break}
3641 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3642 bind . <$M1B-Key-equal> {show_more_context;break}
3643 bind . <$M1B-Key-plus> {show_more_context;break}
3644 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3645 bind . <$M1B-Key-Return> do_commit
3646 foreach i [list $ui_index $ui_workdir] {
3647 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3648 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3649 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3651 unset i
3653 set file_lists($ui_index) [list]
3654 set file_lists($ui_workdir) [list]
3656 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3657 focus -force $ui_comm
3659 # -- Warn the user about environmental problems. Cygwin's Tcl
3660 # does *not* pass its env array onto any processes it spawns.
3661 # This means that git processes get none of our environment.
3663 if {[is_Cygwin]} {
3664 set ignored_env 0
3665 set suggest_user {}
3666 set msg [mc "Possible environment issues exist.
3668 The following environment variables are probably
3669 going to be ignored by any Git subprocess run
3670 by %s:
3672 " [appname]]
3673 foreach name [array names env] {
3674 switch -regexp -- $name {
3675 {^GIT_INDEX_FILE$} -
3676 {^GIT_OBJECT_DIRECTORY$} -
3677 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3678 {^GIT_DIFF_OPTS$} -
3679 {^GIT_EXTERNAL_DIFF$} -
3680 {^GIT_PAGER$} -
3681 {^GIT_TRACE$} -
3682 {^GIT_CONFIG$} -
3683 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3684 append msg " - $name\n"
3685 incr ignored_env
3687 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3688 append msg " - $name\n"
3689 incr ignored_env
3690 set suggest_user $name
3694 if {$ignored_env > 0} {
3695 append msg [mc "
3696 This is due to a known issue with the
3697 Tcl binary distributed by Cygwin."]
3699 if {$suggest_user ne {}} {
3700 append msg [mc "
3702 A good replacement for %s
3703 is placing values for the user.name and
3704 user.email settings into your personal
3705 ~/.gitconfig file.
3706 " $suggest_user]
3708 warn_popup $msg
3710 unset ignored_env msg suggest_user name
3713 # -- Only initialize complex UI if we are going to stay running.
3715 if {[is_enabled transport]} {
3716 load_all_remotes
3718 set n [.mbar.remote index end]
3719 populate_remotes_menu
3720 set n [expr {[.mbar.remote index end] - $n}]
3721 if {$n > 0} {
3722 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3723 .mbar.remote insert $n separator
3725 unset n
3728 if {[winfo exists $ui_comm]} {
3729 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3731 # -- If both our backup and message files exist use the
3732 # newer of the two files to initialize the buffer.
3734 if {$GITGUI_BCK_exists} {
3735 set m [gitdir GITGUI_MSG]
3736 if {[file isfile $m]} {
3737 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3738 catch {file delete [gitdir GITGUI_MSG]}
3739 } else {
3740 $ui_comm delete 0.0 end
3741 $ui_comm edit reset
3742 $ui_comm edit modified false
3743 catch {file delete [gitdir GITGUI_BCK]}
3744 set GITGUI_BCK_exists 0
3747 unset m
3750 proc backup_commit_buffer {} {
3751 global ui_comm GITGUI_BCK_exists
3753 set m [$ui_comm edit modified]
3754 if {$m || $GITGUI_BCK_exists} {
3755 set msg [string trim [$ui_comm get 0.0 end]]
3756 regsub -all -line {[ \r\t]+$} $msg {} msg
3758 if {$msg eq {}} {
3759 if {$GITGUI_BCK_exists} {
3760 catch {file delete [gitdir GITGUI_BCK]}
3761 set GITGUI_BCK_exists 0
3763 } elseif {$m} {
3764 catch {
3765 set fd [open [gitdir GITGUI_BCK] w]
3766 puts -nonewline $fd $msg
3767 close $fd
3768 set GITGUI_BCK_exists 1
3772 $ui_comm edit modified false
3775 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3778 backup_commit_buffer
3780 # -- If the user has aspell available we can drive it
3781 # in pipe mode to spellcheck the commit message.
3783 set spell_cmd [list |]
3784 set spell_dict [get_config gui.spellingdictionary]
3785 lappend spell_cmd aspell
3786 if {$spell_dict ne {}} {
3787 lappend spell_cmd --master=$spell_dict
3789 lappend spell_cmd --mode=none
3790 lappend spell_cmd --encoding=utf-8
3791 lappend spell_cmd pipe
3792 if {$spell_dict eq {none}
3793 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3794 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3795 } else {
3796 set ui_comm_spell [spellcheck::init \
3797 $spell_fd \
3798 $ui_comm \
3799 $ui_comm_ctxm \
3802 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3805 lock_index begin-read
3806 if {![winfo ismapped .]} {
3807 wm deiconify .
3809 after 1 {
3810 if {[is_enabled initialamend]} {
3811 force_amend
3812 } else {
3813 do_rescan
3816 if {[is_enabled nocommitmsg]} {
3817 $ui_comm configure -state disabled -background gray
3820 if {[is_enabled multicommit]} {
3821 after 1000 hint_gc
3823 if {[is_enabled retcode]} {
3824 bind . <Destroy> {+terminate_me %W}
3826 if {$picked && [is_config_true gui.autoexplore]} {
3827 do_explore
3830 # Local variables:
3831 # mode: tcl
3832 # indent-tabs-mode: t
3833 # tab-width: 4
3834 # End: