Sync with 1.8.1.5
[git/jnareb-git.git] / git-gui / git-gui.sh
blob89f636f4963cf7933639f6a23b3be2e8fd4c0964
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
86 if {[tk windowingsystem] eq "win32"} { console show }
89 ######################################################################
91 ## Internationalization (i18n) through msgcat and gettext. See
92 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
94 package require msgcat
96 # Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
97 if {[tk windowingsystem] eq "win32"
98 && [package vcompare [package provide msgcat] 1.4.4] < 0
99 } then {
100 proc _mc_update_locale {} {
101 set key {HKEY_CURRENT_USER\Control Panel\Desktop}
102 if {![catch {
103 package require registry
104 set uilocale [registry get $key "PreferredUILanguages"]
105 msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]
106 } uilocale]} {
107 if {[string length $uilocale] > 0} {
108 msgcat::mclocale $uilocale
112 _mc_update_locale
115 proc _mc_trim {fmt} {
116 set cmk [string first @@ $fmt]
117 if {$cmk > 0} {
118 return [string range $fmt 0 [expr {$cmk - 1}]]
120 return $fmt
123 proc mc {en_fmt args} {
124 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
125 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
126 set msg [eval [list format [_mc_trim $en_fmt]] $args]
128 return $msg
131 proc strcat {args} {
132 return [join $args {}]
135 ::msgcat::mcload $oguimsg
136 unset oguimsg
138 ######################################################################
140 ## read only globals
142 set _appname {Git Gui}
143 set _gitdir {}
144 set _gitworktree {}
145 set _isbare {}
146 set _gitexec {}
147 set _githtmldir {}
148 set _reponame {}
149 set _iscygwin {}
150 set _search_path {}
151 set _shellpath {@@SHELL_PATH@@}
153 set _trace [lsearch -exact $argv --trace]
154 if {$_trace >= 0} {
155 set argv [lreplace $argv $_trace $_trace]
156 set _trace 1
157 if {[tk windowingsystem] eq "win32"} { console show }
158 } else {
159 set _trace 0
162 # variable for the last merged branch (useful for a default when deleting
163 # branches).
164 set _last_merged_branch {}
166 proc shellpath {} {
167 global _shellpath env
168 if {[string match @@* $_shellpath]} {
169 if {[info exists env(SHELL)]} {
170 return $env(SHELL)
171 } else {
172 return /bin/sh
175 return $_shellpath
178 proc appname {} {
179 global _appname
180 return $_appname
183 proc gitdir {args} {
184 global _gitdir
185 if {$args eq {}} {
186 return $_gitdir
188 return [eval [list file join $_gitdir] $args]
191 proc gitexec {args} {
192 global _gitexec
193 if {$_gitexec eq {}} {
194 if {[catch {set _gitexec [git --exec-path]} err]} {
195 error "Git not installed?\n\n$err"
197 if {[is_Cygwin]} {
198 set _gitexec [exec cygpath \
199 --windows \
200 --absolute \
201 $_gitexec]
202 } else {
203 set _gitexec [file normalize $_gitexec]
206 if {$args eq {}} {
207 return $_gitexec
209 return [eval [list file join $_gitexec] $args]
212 proc githtmldir {args} {
213 global _githtmldir
214 if {$_githtmldir eq {}} {
215 if {[catch {set _githtmldir [git --html-path]}]} {
216 # Git not installed or option not yet supported
217 return {}
219 if {[is_Cygwin]} {
220 set _githtmldir [exec cygpath \
221 --windows \
222 --absolute \
223 $_githtmldir]
224 } else {
225 set _githtmldir [file normalize $_githtmldir]
228 if {$args eq {}} {
229 return $_githtmldir
231 return [eval [list file join $_githtmldir] $args]
234 proc reponame {} {
235 return $::_reponame
238 proc is_MacOSX {} {
239 if {[tk windowingsystem] eq {aqua}} {
240 return 1
242 return 0
245 proc is_Windows {} {
246 if {$::tcl_platform(platform) eq {windows}} {
247 return 1
249 return 0
252 proc is_Cygwin {} {
253 global _iscygwin
254 if {$_iscygwin eq {}} {
255 if {$::tcl_platform(platform) eq {windows}} {
256 if {[catch {set p [exec cygpath --windir]} err]} {
257 set _iscygwin 0
258 } else {
259 set _iscygwin 1
261 } else {
262 set _iscygwin 0
265 return $_iscygwin
268 proc is_enabled {option} {
269 global enabled_options
270 if {[catch {set on $enabled_options($option)}]} {return 0}
271 return $on
274 proc enable_option {option} {
275 global enabled_options
276 set enabled_options($option) 1
279 proc disable_option {option} {
280 global enabled_options
281 set enabled_options($option) 0
284 ######################################################################
286 ## config
288 proc is_many_config {name} {
289 switch -glob -- $name {
290 gui.recentrepo -
291 remote.*.fetch -
292 remote.*.push
293 {return 1}
295 {return 0}
299 proc is_config_true {name} {
300 global repo_config
301 if {[catch {set v $repo_config($name)}]} {
302 return 0
304 set v [string tolower $v]
305 if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
306 return 1
307 } else {
308 return 0
312 proc is_config_false {name} {
313 global repo_config
314 if {[catch {set v $repo_config($name)}]} {
315 return 0
317 set v [string tolower $v]
318 if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
319 return 1
320 } else {
321 return 0
325 proc get_config {name} {
326 global repo_config
327 if {[catch {set v $repo_config($name)}]} {
328 return {}
329 } else {
330 return $v
334 proc is_bare {} {
335 global _isbare
336 global _gitdir
337 global _gitworktree
339 if {$_isbare eq {}} {
340 if {[catch {
341 set _bare [git rev-parse --is-bare-repository]
342 switch -- $_bare {
343 true { set _isbare 1 }
344 false { set _isbare 0}
345 default { throw }
347 }]} {
348 if {[is_config_true core.bare]
349 || ($_gitworktree eq {}
350 && [lindex [file split $_gitdir] end] ne {.git})} {
351 set _isbare 1
352 } else {
353 set _isbare 0
357 return $_isbare
360 ######################################################################
362 ## handy utils
364 proc _trace_exec {cmd} {
365 if {!$::_trace} return
366 set d {}
367 foreach v $cmd {
368 if {$d ne {}} {
369 append d { }
371 if {[regexp {[ \t\r\n'"$?*]} $v]} {
372 set v [sq $v]
374 append d $v
376 puts stderr $d
379 #'" fix poor old emacs font-lock mode
381 proc _git_cmd {name} {
382 global _git_cmd_path
384 if {[catch {set v $_git_cmd_path($name)}]} {
385 switch -- $name {
386 version -
387 --version -
388 --exec-path { return [list $::_git $name] }
391 set p [gitexec git-$name$::_search_exe]
392 if {[file exists $p]} {
393 set v [list $p]
394 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
395 # Try to determine what sort of magic will make
396 # git-$name go and do its thing, because native
397 # Tcl on Windows doesn't know it.
399 set p [gitexec git-$name]
400 set f [open $p r]
401 set s [gets $f]
402 close $f
404 switch -glob -- [lindex $s 0] {
405 #!*sh { set i sh }
406 #!*perl { set i perl }
407 #!*python { set i python }
408 default { error "git-$name is not supported: $s" }
411 upvar #0 _$i interp
412 if {![info exists interp]} {
413 set interp [_which $i]
415 if {$interp eq {}} {
416 error "git-$name requires $i (not in PATH)"
418 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
419 } else {
420 # Assume it is builtin to git somehow and we
421 # aren't actually able to see a file for it.
423 set v [list $::_git $name]
425 set _git_cmd_path($name) $v
427 return $v
430 proc _which {what args} {
431 global env _search_exe _search_path
433 if {$_search_path eq {}} {
434 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
435 set _search_path [split [exec cygpath \
436 --windows \
437 --path \
438 --absolute \
439 $env(PATH)] {;}]
440 set _search_exe .exe
441 } elseif {[is_Windows]} {
442 set gitguidir [file dirname [info script]]
443 regsub -all ";" $gitguidir "\\;" gitguidir
444 set env(PATH) "$gitguidir;$env(PATH)"
445 set _search_path [split $env(PATH) {;}]
446 set _search_exe .exe
447 } else {
448 set _search_path [split $env(PATH) :]
449 set _search_exe {}
453 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
454 set suffix {}
455 } else {
456 set suffix $_search_exe
459 foreach p $_search_path {
460 set p [file join $p $what$suffix]
461 if {[file exists $p]} {
462 return [file normalize $p]
465 return {}
468 # Test a file for a hashbang to identify executable scripts on Windows.
469 proc is_shellscript {filename} {
470 if {![file exists $filename]} {return 0}
471 set f [open $filename r]
472 fconfigure $f -encoding binary
473 set magic [read $f 2]
474 close $f
475 return [expr {$magic eq "#!"}]
478 # Run a command connected via pipes on stdout.
479 # This is for use with textconv filters and uses sh -c "..." to allow it to
480 # contain a command with arguments. On windows we must check for shell
481 # scripts specifically otherwise just call the filter command.
482 proc open_cmd_pipe {cmd path} {
483 global env
484 if {![file executable [shellpath]]} {
485 set exe [auto_execok [lindex $cmd 0]]
486 if {[is_shellscript [lindex $exe 0]]} {
487 set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
488 } else {
489 set run [concat $exe [lrange $cmd 1 end] $path]
491 } else {
492 set run [list [shellpath] -c "$cmd \"\$0\"" $path]
494 return [open |$run r]
497 proc _lappend_nice {cmd_var} {
498 global _nice
499 upvar $cmd_var cmd
501 if {![info exists _nice]} {
502 set _nice [_which nice]
503 if {[catch {exec $_nice git version}]} {
504 set _nice {}
505 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
506 set _nice {}
509 if {$_nice ne {}} {
510 lappend cmd $_nice
514 proc git {args} {
515 set opt [list]
517 while {1} {
518 switch -- [lindex $args 0] {
519 --nice {
520 _lappend_nice opt
523 default {
524 break
529 set args [lrange $args 1 end]
532 set cmdp [_git_cmd [lindex $args 0]]
533 set args [lrange $args 1 end]
535 _trace_exec [concat $opt $cmdp $args]
536 set result [eval exec $opt $cmdp $args]
537 if {$::_trace} {
538 puts stderr "< $result"
540 return $result
543 proc _open_stdout_stderr {cmd} {
544 _trace_exec $cmd
545 if {[catch {
546 set fd [open [concat [list | ] $cmd] r]
547 } err]} {
548 if { [lindex $cmd end] eq {2>@1}
549 && $err eq {can not find channel named "1"}
551 # Older versions of Tcl 8.4 don't have this 2>@1 IO
552 # redirect operator. Fallback to |& cat for those.
553 # The command was not actually started, so its safe
554 # to try to start it a second time.
556 set fd [open [concat \
557 [list | ] \
558 [lrange $cmd 0 end-1] \
559 [list |& cat] \
560 ] r]
561 } else {
562 error $err
565 fconfigure $fd -eofchar {}
566 return $fd
569 proc git_read {args} {
570 set opt [list]
572 while {1} {
573 switch -- [lindex $args 0] {
574 --nice {
575 _lappend_nice opt
578 --stderr {
579 lappend args 2>@1
582 default {
583 break
588 set args [lrange $args 1 end]
591 set cmdp [_git_cmd [lindex $args 0]]
592 set args [lrange $args 1 end]
594 return [_open_stdout_stderr [concat $opt $cmdp $args]]
597 proc git_write {args} {
598 set opt [list]
600 while {1} {
601 switch -- [lindex $args 0] {
602 --nice {
603 _lappend_nice opt
606 default {
607 break
612 set args [lrange $args 1 end]
615 set cmdp [_git_cmd [lindex $args 0]]
616 set args [lrange $args 1 end]
618 _trace_exec [concat $opt $cmdp $args]
619 return [open [concat [list | ] $opt $cmdp $args] w]
622 proc githook_read {hook_name args} {
623 set pchook [gitdir hooks $hook_name]
624 lappend args 2>@1
626 # On Windows [file executable] might lie so we need to ask
627 # the shell if the hook is executable. Yes that's annoying.
629 if {[is_Windows]} {
630 upvar #0 _sh interp
631 if {![info exists interp]} {
632 set interp [_which sh]
634 if {$interp eq {}} {
635 error "hook execution requires sh (not in PATH)"
638 set scr {if test -x "$1";then exec "$@";fi}
639 set sh_c [list $interp -c $scr $interp $pchook]
640 return [_open_stdout_stderr [concat $sh_c $args]]
643 if {[file executable $pchook]} {
644 return [_open_stdout_stderr [concat [list $pchook] $args]]
647 return {}
650 proc kill_file_process {fd} {
651 set process [pid $fd]
653 catch {
654 if {[is_Windows]} {
655 # Use a Cygwin-specific flag to allow killing
656 # native Windows processes
657 exec kill -f $process
658 } else {
659 exec kill $process
664 proc gitattr {path attr default} {
665 if {[catch {set r [git check-attr $attr -- $path]}]} {
666 set r unspecified
667 } else {
668 set r [join [lrange [split $r :] 2 end] :]
669 regsub {^ } $r {} r
671 if {$r eq {unspecified}} {
672 return $default
674 return $r
677 proc sq {value} {
678 regsub -all ' $value "'\\''" value
679 return "'$value'"
682 proc load_current_branch {} {
683 global current_branch is_detached
685 set fd [open [gitdir HEAD] r]
686 if {[gets $fd ref] < 1} {
687 set ref {}
689 close $fd
691 set pfx {ref: refs/heads/}
692 set len [string length $pfx]
693 if {[string equal -length $len $pfx $ref]} {
694 # We're on a branch. It might not exist. But
695 # HEAD looks good enough to be a branch.
697 set current_branch [string range $ref $len end]
698 set is_detached 0
699 } else {
700 # Assume this is a detached head.
702 set current_branch HEAD
703 set is_detached 1
707 auto_load tk_optionMenu
708 rename tk_optionMenu real__tkOptionMenu
709 proc tk_optionMenu {w varName args} {
710 set m [eval real__tkOptionMenu $w $varName $args]
711 $m configure -font font_ui
712 $w configure -font font_ui
713 return $m
716 proc rmsel_tag {text} {
717 $text tag conf sel \
718 -background [$text cget -background] \
719 -foreground [$text cget -foreground] \
720 -borderwidth 0
721 $text tag conf in_sel -background lightgray
722 bind $text <Motion> break
723 return $text
726 wm withdraw .
727 set root_exists 0
728 bind . <Visibility> {
729 bind . <Visibility> {}
730 set root_exists 1
733 if {[is_Windows]} {
734 wm iconbitmap . -default $oguilib/git-gui.ico
735 set ::tk::AlwaysShowSelection 1
736 bind . <Control-F2> {console show}
738 # Spoof an X11 display for SSH
739 if {![info exists env(DISPLAY)]} {
740 set env(DISPLAY) :9999
742 } else {
743 catch {
744 image create photo gitlogo -width 16 -height 16
746 gitlogo put #33CC33 -to 7 0 9 2
747 gitlogo put #33CC33 -to 4 2 12 4
748 gitlogo put #33CC33 -to 7 4 9 6
749 gitlogo put #CC3333 -to 4 6 12 8
750 gitlogo put gray26 -to 4 9 6 10
751 gitlogo put gray26 -to 3 10 6 12
752 gitlogo put gray26 -to 8 9 13 11
753 gitlogo put gray26 -to 8 11 10 12
754 gitlogo put gray26 -to 11 11 13 14
755 gitlogo put gray26 -to 3 12 5 14
756 gitlogo put gray26 -to 5 13
757 gitlogo put gray26 -to 10 13
758 gitlogo put gray26 -to 4 14 12 15
759 gitlogo put gray26 -to 5 15 11 16
760 gitlogo redither
762 image create photo gitlogo32 -width 32 -height 32
763 gitlogo32 copy gitlogo -zoom 2 2
765 wm iconphoto . -default gitlogo gitlogo32
769 ######################################################################
771 ## config defaults
773 set cursor_ptr arrow
774 font create font_ui
775 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
776 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
777 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
778 } else {
779 font create font_diff -family Courier -size 10
780 catch {
781 label .dummy
782 eval font configure font_ui [font actual [.dummy cget -font]]
783 destroy .dummy
787 font create font_uiitalic
788 font create font_uibold
789 font create font_diffbold
790 font create font_diffitalic
792 foreach class {Button Checkbutton Entry Label
793 Labelframe Listbox Message
794 Radiobutton Spinbox Text} {
795 option add *$class.font font_ui
797 if {![is_MacOSX]} {
798 option add *Menu.font font_ui
799 option add *Entry.borderWidth 1 startupFile
800 option add *Entry.relief sunken startupFile
801 option add *RadioButton.anchor w startupFile
803 unset class
805 if {[is_Windows] || [is_MacOSX]} {
806 option add *Menu.tearOff 0
809 if {[is_MacOSX]} {
810 set M1B M1
811 set M1T Cmd
812 } else {
813 set M1B Control
814 set M1T Ctrl
817 proc bind_button3 {w cmd} {
818 bind $w <Any-Button-3> $cmd
819 if {[is_MacOSX]} {
820 # Mac OS X sends Button-2 on right click through three-button mouse,
821 # or through trackpad right-clicking (two-finger touch + click).
822 bind $w <Any-Button-2> $cmd
823 bind $w <Control-Button-1> $cmd
827 proc apply_config {} {
828 global repo_config font_descs
830 foreach option $font_descs {
831 set name [lindex $option 0]
832 set font [lindex $option 1]
833 if {[catch {
834 set need_weight 1
835 foreach {cn cv} $repo_config(gui.$name) {
836 if {$cn eq {-weight}} {
837 set need_weight 0
839 font configure $font $cn $cv
841 if {$need_weight} {
842 font configure $font -weight normal
844 } err]} {
845 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
847 foreach {cn cv} [font configure $font] {
848 font configure ${font}bold $cn $cv
849 font configure ${font}italic $cn $cv
851 font configure ${font}bold -weight bold
852 font configure ${font}italic -slant italic
855 global use_ttk NS
856 set use_ttk 0
857 set NS {}
858 if {$repo_config(gui.usettk)} {
859 set use_ttk [package vsatisfies [package provide Tk] 8.5]
860 if {$use_ttk} {
861 set NS ttk
862 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
863 pave_toplevel .
868 set default_config(branch.autosetupmerge) true
869 set default_config(merge.tool) {}
870 set default_config(mergetool.keepbackup) true
871 set default_config(merge.diffstat) true
872 set default_config(merge.summary) false
873 set default_config(merge.verbosity) 2
874 set default_config(user.name) {}
875 set default_config(user.email) {}
877 set default_config(gui.encoding) [encoding system]
878 set default_config(gui.matchtrackingbranch) false
879 set default_config(gui.textconv) true
880 set default_config(gui.pruneduringfetch) false
881 set default_config(gui.trustmtime) false
882 set default_config(gui.fastcopyblame) false
883 set default_config(gui.copyblamethreshold) 40
884 set default_config(gui.blamehistoryctx) 7
885 set default_config(gui.diffcontext) 5
886 set default_config(gui.diffopts) {}
887 set default_config(gui.commitmsgwidth) 75
888 set default_config(gui.newbranchtemplate) {}
889 set default_config(gui.spellingdictionary) {}
890 set default_config(gui.fontui) [font configure font_ui]
891 set default_config(gui.fontdiff) [font configure font_diff]
892 # TODO: this option should be added to the git-config documentation
893 set default_config(gui.maxfilesdisplayed) 5000
894 set default_config(gui.usettk) 1
895 set default_config(gui.warndetachedcommit) 1
896 set font_descs {
897 {fontui font_ui {mc "Main Font"}}
898 {fontdiff font_diff {mc "Diff/Console Font"}}
900 set default_config(gui.stageuntracked) ask
902 ######################################################################
904 ## find git
906 set _git [_which git]
907 if {$_git eq {}} {
908 catch {wm withdraw .}
909 tk_messageBox \
910 -icon error \
911 -type ok \
912 -title [mc "git-gui: fatal error"] \
913 -message [mc "Cannot find git in PATH."]
914 exit 1
917 ######################################################################
919 ## version check
921 if {[catch {set _git_version [git --version]} err]} {
922 catch {wm withdraw .}
923 tk_messageBox \
924 -icon error \
925 -type ok \
926 -title [mc "git-gui: fatal error"] \
927 -message "Cannot determine Git version:
929 $err
931 [appname] requires Git 1.5.0 or later."
932 exit 1
934 if {![regsub {^git version } $_git_version {} _git_version]} {
935 catch {wm withdraw .}
936 tk_messageBox \
937 -icon error \
938 -type ok \
939 -title [mc "git-gui: fatal error"] \
940 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
941 exit 1
944 proc get_trimmed_version {s} {
945 set r {}
946 foreach x [split $s -._] {
947 if {[string is integer -strict $x]} {
948 lappend r $x
949 } else {
950 break
953 return [join $r .]
955 set _real_git_version $_git_version
956 set _git_version [get_trimmed_version $_git_version]
958 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
959 catch {wm withdraw .}
960 if {[tk_messageBox \
961 -icon warning \
962 -type yesno \
963 -default no \
964 -title "[appname]: warning" \
965 -message [mc "Git version cannot be determined.
967 %s claims it is version '%s'.
969 %s requires at least Git 1.5.0 or later.
971 Assume '%s' is version 1.5.0?
972 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
973 set _git_version 1.5.0
974 } else {
975 exit 1
978 unset _real_git_version
980 proc git-version {args} {
981 global _git_version
983 switch [llength $args] {
985 return $_git_version
989 set op [lindex $args 0]
990 set vr [lindex $args 1]
991 set cm [package vcompare $_git_version $vr]
992 return [expr $cm $op 0]
996 set type [lindex $args 0]
997 set name [lindex $args 1]
998 set parm [lindex $args 2]
999 set body [lindex $args 3]
1001 if {($type ne {proc} && $type ne {method})} {
1002 error "Invalid arguments to git-version"
1004 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
1005 error "Last arm of $type $name must be default"
1008 foreach {op vr cb} [lrange $body 0 end-2] {
1009 if {[git-version $op $vr]} {
1010 return [uplevel [list $type $name $parm $cb]]
1014 return [uplevel [list $type $name $parm [lindex $body end]]]
1017 default {
1018 error "git-version >= x"
1024 if {[git-version < 1.5]} {
1025 catch {wm withdraw .}
1026 tk_messageBox \
1027 -icon error \
1028 -type ok \
1029 -title [mc "git-gui: fatal error"] \
1030 -message "[appname] requires Git 1.5.0 or later.
1032 You are using [git-version]:
1034 [git --version]"
1035 exit 1
1038 ######################################################################
1040 ## configure our library
1042 set idx [file join $oguilib tclIndex]
1043 if {[catch {set fd [open $idx r]} err]} {
1044 catch {wm withdraw .}
1045 tk_messageBox \
1046 -icon error \
1047 -type ok \
1048 -title [mc "git-gui: fatal error"] \
1049 -message $err
1050 exit 1
1052 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1053 set idx [list]
1054 while {[gets $fd n] >= 0} {
1055 if {$n ne {} && ![string match #* $n]} {
1056 lappend idx $n
1059 } else {
1060 set idx {}
1062 close $fd
1064 if {$idx ne {}} {
1065 set loaded [list]
1066 foreach p $idx {
1067 if {[lsearch -exact $loaded $p] >= 0} continue
1068 source [file join $oguilib $p]
1069 lappend loaded $p
1071 unset loaded p
1072 } else {
1073 set auto_path [concat [list $oguilib] $auto_path]
1075 unset -nocomplain idx fd
1077 ######################################################################
1079 ## config file parsing
1081 git-version proc _parse_config {arr_name args} {
1082 >= 1.5.3 {
1083 upvar $arr_name arr
1084 array unset arr
1085 set buf {}
1086 catch {
1087 set fd_rc [eval \
1088 [list git_read config] \
1089 $args \
1090 [list --null --list]]
1091 fconfigure $fd_rc -translation binary
1092 set buf [read $fd_rc]
1093 close $fd_rc
1095 foreach line [split $buf "\0"] {
1096 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1097 if {[is_many_config $name]} {
1098 lappend arr($name) $value
1099 } else {
1100 set arr($name) $value
1102 } elseif {[regexp {^([^\n]+)$} $line line name]} {
1103 # no value given, but interpreting them as
1104 # boolean will be handled as true
1105 set arr($name) {}
1109 default {
1110 upvar $arr_name arr
1111 array unset arr
1112 catch {
1113 set fd_rc [eval [list git_read config --list] $args]
1114 while {[gets $fd_rc line] >= 0} {
1115 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1116 if {[is_many_config $name]} {
1117 lappend arr($name) $value
1118 } else {
1119 set arr($name) $value
1121 } elseif {[regexp {^([^=]+)$} $line line name]} {
1122 # no value given, but interpreting them as
1123 # boolean will be handled as true
1124 set arr($name) {}
1127 close $fd_rc
1132 proc load_config {include_global} {
1133 global repo_config global_config system_config default_config
1135 if {$include_global} {
1136 _parse_config system_config --system
1137 _parse_config global_config --global
1139 _parse_config repo_config
1141 foreach name [array names default_config] {
1142 if {[catch {set v $system_config($name)}]} {
1143 set system_config($name) $default_config($name)
1146 foreach name [array names system_config] {
1147 if {[catch {set v $global_config($name)}]} {
1148 set global_config($name) $system_config($name)
1150 if {[catch {set v $repo_config($name)}]} {
1151 set repo_config($name) $system_config($name)
1156 ######################################################################
1158 ## feature option selection
1160 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1161 unset _junk
1162 } else {
1163 set subcommand gui
1165 if {$subcommand eq {gui.sh}} {
1166 set subcommand gui
1168 if {$subcommand eq {gui} && [llength $argv] > 0} {
1169 set subcommand [lindex $argv 0]
1170 set argv [lrange $argv 1 end]
1173 enable_option multicommit
1174 enable_option branch
1175 enable_option transport
1176 disable_option bare
1178 switch -- $subcommand {
1179 browser -
1180 blame {
1181 enable_option bare
1183 disable_option multicommit
1184 disable_option branch
1185 disable_option transport
1187 citool {
1188 enable_option singlecommit
1189 enable_option retcode
1191 disable_option multicommit
1192 disable_option branch
1193 disable_option transport
1195 while {[llength $argv] > 0} {
1196 set a [lindex $argv 0]
1197 switch -- $a {
1198 --amend {
1199 enable_option initialamend
1201 --nocommit {
1202 enable_option nocommit
1203 enable_option nocommitmsg
1205 --commitmsg {
1206 disable_option nocommitmsg
1208 default {
1209 break
1213 set argv [lrange $argv 1 end]
1218 ######################################################################
1220 ## execution environment
1222 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1224 # Suggest our implementation of askpass, if none is set
1225 if {![info exists env(SSH_ASKPASS)]} {
1226 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1229 ######################################################################
1231 ## repository setup
1233 set picked 0
1234 if {[catch {
1235 set _gitdir $env(GIT_DIR)
1236 set _prefix {}
1238 && [catch {
1239 # beware that from the .git dir this sets _gitdir to .
1240 # and _prefix to the empty string
1241 set _gitdir [git rev-parse --git-dir]
1242 set _prefix [git rev-parse --show-prefix]
1243 } err]} {
1244 load_config 1
1245 apply_config
1246 choose_repository::pick
1247 set picked 1
1250 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1251 # run from the .git dir itself) lest the routines to find the worktree
1252 # get confused
1253 if {$_gitdir eq "."} {
1254 set _gitdir [pwd]
1257 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1258 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1260 if {![file isdirectory $_gitdir]} {
1261 catch {wm withdraw .}
1262 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1263 exit 1
1265 # _gitdir exists, so try loading the config
1266 load_config 0
1267 apply_config
1269 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1270 if {[package vsatisfies $_git_version 1.7.0]} {
1271 set _gitworktree [git rev-parse --show-toplevel]
1272 } else {
1273 # try to set work tree from environment, core.worktree or use
1274 # cdup to obtain a relative path to the top of the worktree. If
1275 # run from the top, the ./ prefix ensures normalize expands pwd.
1276 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1277 set _gitworktree [get_config core.worktree]
1278 if {$_gitworktree eq ""} {
1279 set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1284 if {$_prefix ne {}} {
1285 if {$_gitworktree eq {}} {
1286 regsub -all {[^/]+/} $_prefix ../ cdup
1287 } else {
1288 set cdup $_gitworktree
1290 if {[catch {cd $cdup} err]} {
1291 catch {wm withdraw .}
1292 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1293 exit 1
1295 set _gitworktree [pwd]
1296 unset cdup
1297 } elseif {![is_enabled bare]} {
1298 if {[is_bare]} {
1299 catch {wm withdraw .}
1300 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1301 exit 1
1303 if {$_gitworktree eq {}} {
1304 set _gitworktree [file dirname $_gitdir]
1306 if {[catch {cd $_gitworktree} err]} {
1307 catch {wm withdraw .}
1308 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1309 exit 1
1311 set _gitworktree [pwd]
1313 set _reponame [file split [file normalize $_gitdir]]
1314 if {[lindex $_reponame end] eq {.git}} {
1315 set _reponame [lindex $_reponame end-1]
1316 } else {
1317 set _reponame [lindex $_reponame end]
1320 set env(GIT_DIR) $_gitdir
1321 set env(GIT_WORK_TREE) $_gitworktree
1323 ######################################################################
1325 ## global init
1327 set current_diff_path {}
1328 set current_diff_side {}
1329 set diff_actions [list]
1331 set HEAD {}
1332 set PARENT {}
1333 set MERGE_HEAD [list]
1334 set commit_type {}
1335 set empty_tree {}
1336 set current_branch {}
1337 set is_detached 0
1338 set current_diff_path {}
1339 set is_3way_diff 0
1340 set is_submodule_diff 0
1341 set is_conflict_diff 0
1342 set selected_commit_type new
1343 set diff_empty_count 0
1345 set nullid "0000000000000000000000000000000000000000"
1346 set nullid2 "0000000000000000000000000000000000000001"
1348 ######################################################################
1350 ## task management
1352 set rescan_active 0
1353 set diff_active 0
1354 set last_clicked {}
1356 set disable_on_lock [list]
1357 set index_lock_type none
1359 proc lock_index {type} {
1360 global index_lock_type disable_on_lock
1362 if {$index_lock_type eq {none}} {
1363 set index_lock_type $type
1364 foreach w $disable_on_lock {
1365 uplevel #0 $w disabled
1367 return 1
1368 } elseif {$index_lock_type eq "begin-$type"} {
1369 set index_lock_type $type
1370 return 1
1372 return 0
1375 proc unlock_index {} {
1376 global index_lock_type disable_on_lock
1378 set index_lock_type none
1379 foreach w $disable_on_lock {
1380 uplevel #0 $w normal
1384 ######################################################################
1386 ## status
1388 proc repository_state {ctvar hdvar mhvar} {
1389 global current_branch
1390 upvar $ctvar ct $hdvar hd $mhvar mh
1392 set mh [list]
1394 load_current_branch
1395 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1396 set hd {}
1397 set ct initial
1398 return
1401 set merge_head [gitdir MERGE_HEAD]
1402 if {[file exists $merge_head]} {
1403 set ct merge
1404 set fd_mh [open $merge_head r]
1405 while {[gets $fd_mh line] >= 0} {
1406 lappend mh $line
1408 close $fd_mh
1409 return
1412 set ct normal
1415 proc PARENT {} {
1416 global PARENT empty_tree
1418 set p [lindex $PARENT 0]
1419 if {$p ne {}} {
1420 return $p
1422 if {$empty_tree eq {}} {
1423 set empty_tree [git mktree << {}]
1425 return $empty_tree
1428 proc force_amend {} {
1429 global selected_commit_type
1430 global HEAD PARENT MERGE_HEAD commit_type
1432 repository_state newType newHEAD newMERGE_HEAD
1433 set HEAD $newHEAD
1434 set PARENT $newHEAD
1435 set MERGE_HEAD $newMERGE_HEAD
1436 set commit_type $newType
1438 set selected_commit_type amend
1439 do_select_commit_type
1442 proc rescan {after {honor_trustmtime 1}} {
1443 global HEAD PARENT MERGE_HEAD commit_type
1444 global ui_index ui_workdir ui_comm
1445 global rescan_active file_states
1446 global repo_config
1448 if {$rescan_active > 0 || ![lock_index read]} return
1450 repository_state newType newHEAD newMERGE_HEAD
1451 if {[string match amend* $commit_type]
1452 && $newType eq {normal}
1453 && $newHEAD eq $HEAD} {
1454 } else {
1455 set HEAD $newHEAD
1456 set PARENT $newHEAD
1457 set MERGE_HEAD $newMERGE_HEAD
1458 set commit_type $newType
1461 array unset file_states
1463 if {!$::GITGUI_BCK_exists &&
1464 (![$ui_comm edit modified]
1465 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1466 if {[string match amend* $commit_type]} {
1467 } elseif {[load_message GITGUI_MSG utf-8]} {
1468 } elseif {[run_prepare_commit_msg_hook]} {
1469 } elseif {[load_message MERGE_MSG]} {
1470 } elseif {[load_message SQUASH_MSG]} {
1472 $ui_comm edit reset
1473 $ui_comm edit modified false
1476 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1477 rescan_stage2 {} $after
1478 } else {
1479 set rescan_active 1
1480 ui_status [mc "Refreshing file status..."]
1481 set fd_rf [git_read update-index \
1482 -q \
1483 --unmerged \
1484 --ignore-missing \
1485 --refresh \
1487 fconfigure $fd_rf -blocking 0 -translation binary
1488 fileevent $fd_rf readable \
1489 [list rescan_stage2 $fd_rf $after]
1493 if {[is_Cygwin]} {
1494 set is_git_info_exclude {}
1495 proc have_info_exclude {} {
1496 global is_git_info_exclude
1498 if {$is_git_info_exclude eq {}} {
1499 if {[catch {exec test -f [gitdir info exclude]}]} {
1500 set is_git_info_exclude 0
1501 } else {
1502 set is_git_info_exclude 1
1505 return $is_git_info_exclude
1507 } else {
1508 proc have_info_exclude {} {
1509 return [file readable [gitdir info exclude]]
1513 proc rescan_stage2 {fd after} {
1514 global rescan_active buf_rdi buf_rdf buf_rlo
1516 if {$fd ne {}} {
1517 read $fd
1518 if {![eof $fd]} return
1519 close $fd
1522 if {[package vsatisfies $::_git_version 1.6.3]} {
1523 set ls_others [list --exclude-standard]
1524 } else {
1525 set ls_others [list --exclude-per-directory=.gitignore]
1526 if {[have_info_exclude]} {
1527 lappend ls_others "--exclude-from=[gitdir info exclude]"
1529 set user_exclude [get_config core.excludesfile]
1530 if {$user_exclude ne {} && [file readable $user_exclude]} {
1531 lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1535 set buf_rdi {}
1536 set buf_rdf {}
1537 set buf_rlo {}
1539 set rescan_active 3
1540 ui_status [mc "Scanning for modified files ..."]
1541 set fd_di [git_read diff-index --cached -z [PARENT]]
1542 set fd_df [git_read diff-files -z]
1543 set fd_lo [eval git_read ls-files --others -z $ls_others]
1545 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1546 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1547 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1548 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1549 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1550 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1553 proc load_message {file {encoding {}}} {
1554 global ui_comm
1556 set f [gitdir $file]
1557 if {[file isfile $f]} {
1558 if {[catch {set fd [open $f r]}]} {
1559 return 0
1561 fconfigure $fd -eofchar {}
1562 if {$encoding ne {}} {
1563 fconfigure $fd -encoding $encoding
1565 set content [string trim [read $fd]]
1566 close $fd
1567 regsub -all -line {[ \r\t]+$} $content {} content
1568 $ui_comm delete 0.0 end
1569 $ui_comm insert end $content
1570 return 1
1572 return 0
1575 proc run_prepare_commit_msg_hook {} {
1576 global pch_error
1578 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1579 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1580 # empty file but existent file.
1582 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1584 if {[file isfile [gitdir MERGE_MSG]]} {
1585 set pcm_source "merge"
1586 set fd_mm [open [gitdir MERGE_MSG] r]
1587 puts -nonewline $fd_pcm [read $fd_mm]
1588 close $fd_mm
1589 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1590 set pcm_source "squash"
1591 set fd_sm [open [gitdir SQUASH_MSG] r]
1592 puts -nonewline $fd_pcm [read $fd_sm]
1593 close $fd_sm
1594 } else {
1595 set pcm_source ""
1598 close $fd_pcm
1600 set fd_ph [githook_read prepare-commit-msg \
1601 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1602 if {$fd_ph eq {}} {
1603 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1604 return 0;
1607 ui_status [mc "Calling prepare-commit-msg hook..."]
1608 set pch_error {}
1610 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1611 fileevent $fd_ph readable \
1612 [list prepare_commit_msg_hook_wait $fd_ph]
1614 return 1;
1617 proc prepare_commit_msg_hook_wait {fd_ph} {
1618 global pch_error
1620 append pch_error [read $fd_ph]
1621 fconfigure $fd_ph -blocking 1
1622 if {[eof $fd_ph]} {
1623 if {[catch {close $fd_ph}]} {
1624 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1625 hook_failed_popup prepare-commit-msg $pch_error
1626 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1627 exit 1
1628 } else {
1629 load_message PREPARE_COMMIT_MSG
1631 set pch_error {}
1632 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1633 return
1635 fconfigure $fd_ph -blocking 0
1636 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1639 proc read_diff_index {fd after} {
1640 global buf_rdi
1642 append buf_rdi [read $fd]
1643 set c 0
1644 set n [string length $buf_rdi]
1645 while {$c < $n} {
1646 set z1 [string first "\0" $buf_rdi $c]
1647 if {$z1 == -1} break
1648 incr z1
1649 set z2 [string first "\0" $buf_rdi $z1]
1650 if {$z2 == -1} break
1652 incr c
1653 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1654 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1655 merge_state \
1656 [encoding convertfrom $p] \
1657 [lindex $i 4]? \
1658 [list [lindex $i 0] [lindex $i 2]] \
1659 [list]
1660 set c $z2
1661 incr c
1663 if {$c < $n} {
1664 set buf_rdi [string range $buf_rdi $c end]
1665 } else {
1666 set buf_rdi {}
1669 rescan_done $fd buf_rdi $after
1672 proc read_diff_files {fd after} {
1673 global buf_rdf
1675 append buf_rdf [read $fd]
1676 set c 0
1677 set n [string length $buf_rdf]
1678 while {$c < $n} {
1679 set z1 [string first "\0" $buf_rdf $c]
1680 if {$z1 == -1} break
1681 incr z1
1682 set z2 [string first "\0" $buf_rdf $z1]
1683 if {$z2 == -1} break
1685 incr c
1686 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1687 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1688 merge_state \
1689 [encoding convertfrom $p] \
1690 ?[lindex $i 4] \
1691 [list] \
1692 [list [lindex $i 0] [lindex $i 2]]
1693 set c $z2
1694 incr c
1696 if {$c < $n} {
1697 set buf_rdf [string range $buf_rdf $c end]
1698 } else {
1699 set buf_rdf {}
1702 rescan_done $fd buf_rdf $after
1705 proc read_ls_others {fd after} {
1706 global buf_rlo
1708 append buf_rlo [read $fd]
1709 set pck [split $buf_rlo "\0"]
1710 set buf_rlo [lindex $pck end]
1711 foreach p [lrange $pck 0 end-1] {
1712 set p [encoding convertfrom $p]
1713 if {[string index $p end] eq {/}} {
1714 set p [string range $p 0 end-1]
1716 merge_state $p ?O
1718 rescan_done $fd buf_rlo $after
1721 proc rescan_done {fd buf after} {
1722 global rescan_active current_diff_path
1723 global file_states repo_config
1724 upvar $buf to_clear
1726 if {![eof $fd]} return
1727 set to_clear {}
1728 close $fd
1729 if {[incr rescan_active -1] > 0} return
1731 prune_selection
1732 unlock_index
1733 display_all_files
1734 if {$current_diff_path ne {}} { reshow_diff $after }
1735 if {$current_diff_path eq {}} { select_first_diff $after }
1738 proc prune_selection {} {
1739 global file_states selected_paths
1741 foreach path [array names selected_paths] {
1742 if {[catch {set still_here $file_states($path)}]} {
1743 unset selected_paths($path)
1748 ######################################################################
1750 ## ui helpers
1752 proc mapicon {w state path} {
1753 global all_icons
1755 if {[catch {set r $all_icons($state$w)}]} {
1756 puts "error: no icon for $w state={$state} $path"
1757 return file_plain
1759 return $r
1762 proc mapdesc {state path} {
1763 global all_descs
1765 if {[catch {set r $all_descs($state)}]} {
1766 puts "error: no desc for state={$state} $path"
1767 return $state
1769 return $r
1772 proc ui_status {msg} {
1773 global main_status
1774 if {[info exists main_status]} {
1775 $main_status show $msg
1779 proc ui_ready {{test {}}} {
1780 global main_status
1781 if {[info exists main_status]} {
1782 $main_status show [mc "Ready."] $test
1786 proc escape_path {path} {
1787 regsub -all {\\} $path "\\\\" path
1788 regsub -all "\n" $path "\\n" path
1789 return $path
1792 proc short_path {path} {
1793 return [escape_path [lindex [file split $path] end]]
1796 set next_icon_id 0
1797 set null_sha1 [string repeat 0 40]
1799 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1800 global file_states next_icon_id null_sha1
1802 set s0 [string index $new_state 0]
1803 set s1 [string index $new_state 1]
1805 if {[catch {set info $file_states($path)}]} {
1806 set state __
1807 set icon n[incr next_icon_id]
1808 } else {
1809 set state [lindex $info 0]
1810 set icon [lindex $info 1]
1811 if {$head_info eq {}} {set head_info [lindex $info 2]}
1812 if {$index_info eq {}} {set index_info [lindex $info 3]}
1815 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1816 elseif {$s0 eq {_}} {set s0 _}
1818 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1819 elseif {$s1 eq {_}} {set s1 _}
1821 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1822 set head_info [list 0 $null_sha1]
1823 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1824 && $head_info eq {}} {
1825 set head_info $index_info
1826 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1827 set index_info $head_info
1828 set head_info {}
1831 set file_states($path) [list $s0$s1 $icon \
1832 $head_info $index_info \
1834 return $state
1837 proc display_file_helper {w path icon_name old_m new_m} {
1838 global file_lists
1840 if {$new_m eq {_}} {
1841 set lno [lsearch -sorted -exact $file_lists($w) $path]
1842 if {$lno >= 0} {
1843 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1844 incr lno
1845 $w conf -state normal
1846 $w delete $lno.0 [expr {$lno + 1}].0
1847 $w conf -state disabled
1849 } elseif {$old_m eq {_} && $new_m ne {_}} {
1850 lappend file_lists($w) $path
1851 set file_lists($w) [lsort -unique $file_lists($w)]
1852 set lno [lsearch -sorted -exact $file_lists($w) $path]
1853 incr lno
1854 $w conf -state normal
1855 $w image create $lno.0 \
1856 -align center -padx 5 -pady 1 \
1857 -name $icon_name \
1858 -image [mapicon $w $new_m $path]
1859 $w insert $lno.1 "[escape_path $path]\n"
1860 $w conf -state disabled
1861 } elseif {$old_m ne $new_m} {
1862 $w conf -state normal
1863 $w image conf $icon_name -image [mapicon $w $new_m $path]
1864 $w conf -state disabled
1868 proc display_file {path state} {
1869 global file_states selected_paths
1870 global ui_index ui_workdir
1872 set old_m [merge_state $path $state]
1873 set s $file_states($path)
1874 set new_m [lindex $s 0]
1875 set icon_name [lindex $s 1]
1877 set o [string index $old_m 0]
1878 set n [string index $new_m 0]
1879 if {$o eq {U}} {
1880 set o _
1882 if {$n eq {U}} {
1883 set n _
1885 display_file_helper $ui_index $path $icon_name $o $n
1887 if {[string index $old_m 0] eq {U}} {
1888 set o U
1889 } else {
1890 set o [string index $old_m 1]
1892 if {[string index $new_m 0] eq {U}} {
1893 set n U
1894 } else {
1895 set n [string index $new_m 1]
1897 display_file_helper $ui_workdir $path $icon_name $o $n
1899 if {$new_m eq {__}} {
1900 unset file_states($path)
1901 catch {unset selected_paths($path)}
1905 proc display_all_files_helper {w path icon_name m} {
1906 global file_lists
1908 lappend file_lists($w) $path
1909 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1910 $w image create end \
1911 -align center -padx 5 -pady 1 \
1912 -name $icon_name \
1913 -image [mapicon $w $m $path]
1914 $w insert end "[escape_path $path]\n"
1917 set files_warning 0
1918 proc display_all_files {} {
1919 global ui_index ui_workdir
1920 global file_states file_lists
1921 global last_clicked
1922 global files_warning
1924 $ui_index conf -state normal
1925 $ui_workdir conf -state normal
1927 $ui_index delete 0.0 end
1928 $ui_workdir delete 0.0 end
1929 set last_clicked {}
1931 set file_lists($ui_index) [list]
1932 set file_lists($ui_workdir) [list]
1934 set to_display [lsort [array names file_states]]
1935 set display_limit [get_config gui.maxfilesdisplayed]
1936 if {[llength $to_display] > $display_limit} {
1937 if {!$files_warning} {
1938 # do not repeatedly warn:
1939 set files_warning 1
1940 info_popup [mc "Displaying only %s of %s files." \
1941 $display_limit [llength $to_display]]
1943 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1945 foreach path $to_display {
1946 set s $file_states($path)
1947 set m [lindex $s 0]
1948 set icon_name [lindex $s 1]
1950 set s [string index $m 0]
1951 if {$s ne {U} && $s ne {_}} {
1952 display_all_files_helper $ui_index $path \
1953 $icon_name $s
1956 if {[string index $m 0] eq {U}} {
1957 set s U
1958 } else {
1959 set s [string index $m 1]
1961 if {$s ne {_}} {
1962 display_all_files_helper $ui_workdir $path \
1963 $icon_name $s
1967 $ui_index conf -state disabled
1968 $ui_workdir conf -state disabled
1971 ######################################################################
1973 ## icons
1975 set filemask {
1976 #define mask_width 14
1977 #define mask_height 15
1978 static unsigned char mask_bits[] = {
1979 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1980 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1981 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1984 image create bitmap file_plain -background white -foreground black -data {
1985 #define plain_width 14
1986 #define plain_height 15
1987 static unsigned char plain_bits[] = {
1988 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1989 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1990 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1991 } -maskdata $filemask
1993 image create bitmap file_mod -background white -foreground blue -data {
1994 #define mod_width 14
1995 #define mod_height 15
1996 static unsigned char mod_bits[] = {
1997 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1998 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1999 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2000 } -maskdata $filemask
2002 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2003 #define file_fulltick_width 14
2004 #define file_fulltick_height 15
2005 static unsigned char file_fulltick_bits[] = {
2006 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2007 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2008 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2009 } -maskdata $filemask
2011 image create bitmap file_question -background white -foreground black -data {
2012 #define file_question_width 14
2013 #define file_question_height 15
2014 static unsigned char file_question_bits[] = {
2015 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2016 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2017 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2018 } -maskdata $filemask
2020 image create bitmap file_removed -background white -foreground red -data {
2021 #define file_removed_width 14
2022 #define file_removed_height 15
2023 static unsigned char file_removed_bits[] = {
2024 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2025 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2026 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2027 } -maskdata $filemask
2029 image create bitmap file_merge -background white -foreground blue -data {
2030 #define file_merge_width 14
2031 #define file_merge_height 15
2032 static unsigned char file_merge_bits[] = {
2033 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2034 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2035 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2036 } -maskdata $filemask
2038 image create bitmap file_statechange -background white -foreground green -data {
2039 #define file_statechange_width 14
2040 #define file_statechange_height 15
2041 static unsigned char file_statechange_bits[] = {
2042 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2043 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2044 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2045 } -maskdata $filemask
2047 set ui_index .vpane.files.index.list
2048 set ui_workdir .vpane.files.workdir.list
2050 set all_icons(_$ui_index) file_plain
2051 set all_icons(A$ui_index) file_plain
2052 set all_icons(M$ui_index) file_fulltick
2053 set all_icons(D$ui_index) file_removed
2054 set all_icons(U$ui_index) file_merge
2055 set all_icons(T$ui_index) file_statechange
2057 set all_icons(_$ui_workdir) file_plain
2058 set all_icons(M$ui_workdir) file_mod
2059 set all_icons(D$ui_workdir) file_question
2060 set all_icons(U$ui_workdir) file_merge
2061 set all_icons(O$ui_workdir) file_plain
2062 set all_icons(T$ui_workdir) file_statechange
2064 set max_status_desc 0
2065 foreach i {
2066 {__ {mc "Unmodified"}}
2068 {_M {mc "Modified, not staged"}}
2069 {M_ {mc "Staged for commit"}}
2070 {MM {mc "Portions staged for commit"}}
2071 {MD {mc "Staged for commit, missing"}}
2073 {_T {mc "File type changed, not staged"}}
2074 {MT {mc "File type changed, old type staged for commit"}}
2075 {AT {mc "File type changed, old type staged for commit"}}
2076 {T_ {mc "File type changed, staged"}}
2077 {TM {mc "File type change staged, modification not staged"}}
2078 {TD {mc "File type change staged, file missing"}}
2080 {_O {mc "Untracked, not staged"}}
2081 {A_ {mc "Staged for commit"}}
2082 {AM {mc "Portions staged for commit"}}
2083 {AD {mc "Staged for commit, missing"}}
2085 {_D {mc "Missing"}}
2086 {D_ {mc "Staged for removal"}}
2087 {DO {mc "Staged for removal, still present"}}
2089 {_U {mc "Requires merge resolution"}}
2090 {U_ {mc "Requires merge resolution"}}
2091 {UU {mc "Requires merge resolution"}}
2092 {UM {mc "Requires merge resolution"}}
2093 {UD {mc "Requires merge resolution"}}
2094 {UT {mc "Requires merge resolution"}}
2096 set text [eval [lindex $i 1]]
2097 if {$max_status_desc < [string length $text]} {
2098 set max_status_desc [string length $text]
2100 set all_descs([lindex $i 0]) $text
2102 unset i
2104 ######################################################################
2106 ## util
2108 proc scrollbar2many {list mode args} {
2109 foreach w $list {eval $w $mode $args}
2112 proc many2scrollbar {list mode sb top bottom} {
2113 $sb set $top $bottom
2114 foreach w $list {$w $mode moveto $top}
2117 proc incr_font_size {font {amt 1}} {
2118 set sz [font configure $font -size]
2119 incr sz $amt
2120 font configure $font -size $sz
2121 font configure ${font}bold -size $sz
2122 font configure ${font}italic -size $sz
2125 ######################################################################
2127 ## ui commands
2129 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2131 proc do_gitk {revs {is_submodule false}} {
2132 global current_diff_path file_states current_diff_side ui_index
2133 global _gitdir _gitworktree
2135 # -- Always start gitk through whatever we were loaded with. This
2136 # lets us bypass using shell process on Windows systems.
2138 set exe [_which gitk -script]
2139 set cmd [list [info nameofexecutable] $exe]
2140 if {$exe eq {}} {
2141 error_popup [mc "Couldn't find gitk in PATH"]
2142 } else {
2143 global env
2145 set pwd [pwd]
2147 if {!$is_submodule} {
2148 if {![is_bare]} {
2149 cd $_gitworktree
2151 } else {
2152 cd $current_diff_path
2153 if {$revs eq {--}} {
2154 set s $file_states($current_diff_path)
2155 set old_sha1 {}
2156 set new_sha1 {}
2157 switch -glob -- [lindex $s 0] {
2158 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2159 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2160 MM {
2161 if {$current_diff_side eq $ui_index} {
2162 set old_sha1 [lindex [lindex $s 2] 1]
2163 set new_sha1 [lindex [lindex $s 3] 1]
2164 } else {
2165 set old_sha1 [lindex [lindex $s 3] 1]
2169 set revs $old_sha1...$new_sha1
2171 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2172 # we've been using for the main repository, so unset them.
2173 # TODO we could make life easier (start up faster?) for gitk
2174 # by setting these to the appropriate values to allow gitk
2175 # to skip the heuristics to find their proper value
2176 unset env(GIT_DIR)
2177 unset env(GIT_WORK_TREE)
2179 eval exec $cmd $revs "--" "--" &
2181 set env(GIT_DIR) $_gitdir
2182 set env(GIT_WORK_TREE) $_gitworktree
2183 cd $pwd
2185 ui_status $::starting_gitk_msg
2186 after 10000 {
2187 ui_ready $starting_gitk_msg
2192 proc do_git_gui {} {
2193 global current_diff_path
2195 # -- Always start git gui through whatever we were loaded with. This
2196 # lets us bypass using shell process on Windows systems.
2198 set exe [list [_which git]]
2199 if {$exe eq {}} {
2200 error_popup [mc "Couldn't find git gui in PATH"]
2201 } else {
2202 global env
2203 global _gitdir _gitworktree
2205 # see note in do_gitk about unsetting these vars when
2206 # running tools in a submodule
2207 unset env(GIT_DIR)
2208 unset env(GIT_WORK_TREE)
2210 set pwd [pwd]
2211 cd $current_diff_path
2213 eval exec $exe gui &
2215 set env(GIT_DIR) $_gitdir
2216 set env(GIT_WORK_TREE) $_gitworktree
2217 cd $pwd
2219 ui_status $::starting_gitk_msg
2220 after 10000 {
2221 ui_ready $starting_gitk_msg
2226 proc do_explore {} {
2227 global _gitworktree
2228 set explorer {}
2229 if {[is_Cygwin] || [is_Windows]} {
2230 set explorer "explorer.exe"
2231 } elseif {[is_MacOSX]} {
2232 set explorer "open"
2233 } else {
2234 # freedesktop.org-conforming system is our best shot
2235 set explorer "xdg-open"
2237 eval exec $explorer [list [file nativename $_gitworktree]] &
2240 set is_quitting 0
2241 set ret_code 1
2243 proc terminate_me {win} {
2244 global ret_code
2245 if {$win ne {.}} return
2246 exit $ret_code
2249 proc do_quit {{rc {1}}} {
2250 global ui_comm is_quitting repo_config commit_type
2251 global GITGUI_BCK_exists GITGUI_BCK_i
2252 global ui_comm_spell
2253 global ret_code use_ttk
2255 if {$is_quitting} return
2256 set is_quitting 1
2258 if {[winfo exists $ui_comm]} {
2259 # -- Stash our current commit buffer.
2261 set save [gitdir GITGUI_MSG]
2262 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2263 file rename -force [gitdir GITGUI_BCK] $save
2264 set GITGUI_BCK_exists 0
2265 } else {
2266 set msg [string trim [$ui_comm get 0.0 end]]
2267 regsub -all -line {[ \r\t]+$} $msg {} msg
2268 if {(![string match amend* $commit_type]
2269 || [$ui_comm edit modified])
2270 && $msg ne {}} {
2271 catch {
2272 set fd [open $save w]
2273 fconfigure $fd -encoding utf-8
2274 puts -nonewline $fd $msg
2275 close $fd
2277 } else {
2278 catch {file delete $save}
2282 # -- Cancel our spellchecker if its running.
2284 if {[info exists ui_comm_spell]} {
2285 $ui_comm_spell stop
2288 # -- Remove our editor backup, its not needed.
2290 after cancel $GITGUI_BCK_i
2291 if {$GITGUI_BCK_exists} {
2292 catch {file delete [gitdir GITGUI_BCK]}
2295 # -- Stash our current window geometry into this repository.
2297 set cfg_wmstate [wm state .]
2298 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2299 set rc_wmstate {}
2301 if {$cfg_wmstate ne $rc_wmstate} {
2302 catch {git config gui.wmstate $cfg_wmstate}
2304 if {$cfg_wmstate eq {zoomed}} {
2305 # on Windows wm geometry will lie about window
2306 # position (but not size) when window is zoomed
2307 # restore the window before querying wm geometry
2308 wm state . normal
2310 set cfg_geometry [list]
2311 lappend cfg_geometry [wm geometry .]
2312 if {$use_ttk} {
2313 lappend cfg_geometry [.vpane sashpos 0]
2314 lappend cfg_geometry [.vpane.files sashpos 0]
2315 } else {
2316 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2317 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2319 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2320 set rc_geometry {}
2322 if {$cfg_geometry ne $rc_geometry} {
2323 catch {git config gui.geometry $cfg_geometry}
2327 set ret_code $rc
2329 # Briefly enable send again, working around Tk bug
2330 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2331 tk appname [appname]
2333 destroy .
2336 proc do_rescan {} {
2337 rescan ui_ready
2340 proc ui_do_rescan {} {
2341 rescan {force_first_diff ui_ready}
2344 proc do_commit {} {
2345 commit_tree
2348 proc next_diff {{after {}}} {
2349 global next_diff_p next_diff_w next_diff_i
2350 show_diff $next_diff_p $next_diff_w {} {} $after
2353 proc find_anchor_pos {lst name} {
2354 set lid [lsearch -sorted -exact $lst $name]
2356 if {$lid == -1} {
2357 set lid 0
2358 foreach lname $lst {
2359 if {$lname >= $name} break
2360 incr lid
2364 return $lid
2367 proc find_file_from {flist idx delta path mmask} {
2368 global file_states
2370 set len [llength $flist]
2371 while {$idx >= 0 && $idx < $len} {
2372 set name [lindex $flist $idx]
2374 if {$name ne $path && [info exists file_states($name)]} {
2375 set state [lindex $file_states($name) 0]
2377 if {$mmask eq {} || [regexp $mmask $state]} {
2378 return $idx
2382 incr idx $delta
2385 return {}
2388 proc find_next_diff {w path {lno {}} {mmask {}}} {
2389 global next_diff_p next_diff_w next_diff_i
2390 global file_lists ui_index ui_workdir
2392 set flist $file_lists($w)
2393 if {$lno eq {}} {
2394 set lno [find_anchor_pos $flist $path]
2395 } else {
2396 incr lno -1
2399 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2400 if {$w eq $ui_index} {
2401 set mmask "^$mmask"
2402 } else {
2403 set mmask "$mmask\$"
2407 set idx [find_file_from $flist $lno 1 $path $mmask]
2408 if {$idx eq {}} {
2409 incr lno -1
2410 set idx [find_file_from $flist $lno -1 $path $mmask]
2413 if {$idx ne {}} {
2414 set next_diff_w $w
2415 set next_diff_p [lindex $flist $idx]
2416 set next_diff_i [expr {$idx+1}]
2417 return 1
2418 } else {
2419 return 0
2423 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2424 global current_diff_path
2426 if {$path ne $current_diff_path} {
2427 return {}
2428 } elseif {[find_next_diff $w $path $lno $mmask]} {
2429 return {next_diff;}
2430 } else {
2431 return {reshow_diff;}
2435 proc select_first_diff {after} {
2436 global ui_workdir
2438 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2439 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2440 next_diff $after
2441 } else {
2442 uplevel #0 $after
2446 proc force_first_diff {after} {
2447 global ui_workdir current_diff_path file_states
2449 if {[info exists file_states($current_diff_path)]} {
2450 set state [lindex $file_states($current_diff_path) 0]
2451 } else {
2452 set state {OO}
2455 set reselect 0
2456 if {[string first {U} $state] >= 0} {
2457 # Already a conflict, do nothing
2458 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2459 set reselect 1
2460 } elseif {[string index $state 1] ne {O}} {
2461 # Already a diff & no conflicts, do nothing
2462 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2463 set reselect 1
2466 if {$reselect} {
2467 next_diff $after
2468 } else {
2469 uplevel #0 $after
2473 proc toggle_or_diff {w x y} {
2474 global file_states file_lists current_diff_path ui_index ui_workdir
2475 global last_clicked selected_paths
2477 set pos [split [$w index @$x,$y] .]
2478 set lno [lindex $pos 0]
2479 set col [lindex $pos 1]
2480 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2481 if {$path eq {}} {
2482 set last_clicked {}
2483 return
2486 set last_clicked [list $w $lno]
2487 array unset selected_paths
2488 $ui_index tag remove in_sel 0.0 end
2489 $ui_workdir tag remove in_sel 0.0 end
2491 # Determine the state of the file
2492 if {[info exists file_states($path)]} {
2493 set state [lindex $file_states($path) 0]
2494 } else {
2495 set state {__}
2498 # Restage the file, or simply show the diff
2499 if {$col == 0 && $y > 1} {
2500 # Conflicts need special handling
2501 if {[string first {U} $state] >= 0} {
2502 # $w must always be $ui_workdir, but...
2503 if {$w ne $ui_workdir} { set lno {} }
2504 merge_stage_workdir $path $lno
2505 return
2508 if {[string index $state 1] eq {O}} {
2509 set mmask {}
2510 } else {
2511 set mmask {[^O]}
2514 set after [next_diff_after_action $w $path $lno $mmask]
2516 if {$w eq $ui_index} {
2517 update_indexinfo \
2518 "Unstaging [short_path $path] from commit" \
2519 [list $path] \
2520 [concat $after [list ui_ready]]
2521 } elseif {$w eq $ui_workdir} {
2522 update_index \
2523 "Adding [short_path $path]" \
2524 [list $path] \
2525 [concat $after [list ui_ready]]
2527 } else {
2528 set selected_paths($path) 1
2529 show_diff $path $w $lno
2533 proc add_one_to_selection {w x y} {
2534 global file_lists last_clicked selected_paths
2536 set lno [lindex [split [$w index @$x,$y] .] 0]
2537 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2538 if {$path eq {}} {
2539 set last_clicked {}
2540 return
2543 if {$last_clicked ne {}
2544 && [lindex $last_clicked 0] ne $w} {
2545 array unset selected_paths
2546 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2549 set last_clicked [list $w $lno]
2550 if {[catch {set in_sel $selected_paths($path)}]} {
2551 set in_sel 0
2553 if {$in_sel} {
2554 unset selected_paths($path)
2555 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2556 } else {
2557 set selected_paths($path) 1
2558 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2562 proc add_range_to_selection {w x y} {
2563 global file_lists last_clicked selected_paths
2565 if {[lindex $last_clicked 0] ne $w} {
2566 toggle_or_diff $w $x $y
2567 return
2570 set lno [lindex [split [$w index @$x,$y] .] 0]
2571 set lc [lindex $last_clicked 1]
2572 if {$lc < $lno} {
2573 set begin $lc
2574 set end $lno
2575 } else {
2576 set begin $lno
2577 set end $lc
2580 foreach path [lrange $file_lists($w) \
2581 [expr {$begin - 1}] \
2582 [expr {$end - 1}]] {
2583 set selected_paths($path) 1
2585 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2588 proc show_more_context {} {
2589 global repo_config
2590 if {$repo_config(gui.diffcontext) < 99} {
2591 incr repo_config(gui.diffcontext)
2592 reshow_diff
2596 proc show_less_context {} {
2597 global repo_config
2598 if {$repo_config(gui.diffcontext) > 1} {
2599 incr repo_config(gui.diffcontext) -1
2600 reshow_diff
2604 ######################################################################
2606 ## ui construction
2608 set ui_comm {}
2610 # -- Menu Bar
2612 menu .mbar -tearoff 0
2613 if {[is_MacOSX]} {
2614 # -- Apple Menu (Mac OS X only)
2616 .mbar add cascade -label Apple -menu .mbar.apple
2617 menu .mbar.apple
2619 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2620 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2621 if {[is_enabled branch]} {
2622 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2624 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2625 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2627 if {[is_enabled transport]} {
2628 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2629 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2631 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2632 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2635 # -- Repository Menu
2637 menu .mbar.repository
2639 if {![is_bare]} {
2640 .mbar.repository add command \
2641 -label [mc "Explore Working Copy"] \
2642 -command {do_explore}
2643 .mbar.repository add separator
2646 .mbar.repository add command \
2647 -label [mc "Browse Current Branch's Files"] \
2648 -command {browser::new $current_branch}
2649 set ui_browse_current [.mbar.repository index last]
2650 .mbar.repository add command \
2651 -label [mc "Browse Branch Files..."] \
2652 -command browser_open::dialog
2653 .mbar.repository add separator
2655 .mbar.repository add command \
2656 -label [mc "Visualize Current Branch's History"] \
2657 -command {do_gitk $current_branch}
2658 set ui_visualize_current [.mbar.repository index last]
2659 .mbar.repository add command \
2660 -label [mc "Visualize All Branch History"] \
2661 -command {do_gitk --all}
2662 .mbar.repository add separator
2664 proc current_branch_write {args} {
2665 global current_branch
2666 .mbar.repository entryconf $::ui_browse_current \
2667 -label [mc "Browse %s's Files" $current_branch]
2668 .mbar.repository entryconf $::ui_visualize_current \
2669 -label [mc "Visualize %s's History" $current_branch]
2671 trace add variable current_branch write current_branch_write
2673 if {[is_enabled multicommit]} {
2674 .mbar.repository add command -label [mc "Database Statistics"] \
2675 -command do_stats
2677 .mbar.repository add command -label [mc "Compress Database"] \
2678 -command do_gc
2680 .mbar.repository add command -label [mc "Verify Database"] \
2681 -command do_fsck_objects
2683 .mbar.repository add separator
2685 if {[is_Cygwin]} {
2686 .mbar.repository add command \
2687 -label [mc "Create Desktop Icon"] \
2688 -command do_cygwin_shortcut
2689 } elseif {[is_Windows]} {
2690 .mbar.repository add command \
2691 -label [mc "Create Desktop Icon"] \
2692 -command do_windows_shortcut
2693 } elseif {[is_MacOSX]} {
2694 .mbar.repository add command \
2695 -label [mc "Create Desktop Icon"] \
2696 -command do_macosx_app
2700 if {[is_MacOSX]} {
2701 proc ::tk::mac::Quit {args} { do_quit }
2702 } else {
2703 .mbar.repository add command -label [mc Quit] \
2704 -command do_quit \
2705 -accelerator $M1T-Q
2708 # -- Edit Menu
2710 menu .mbar.edit
2711 .mbar.edit add command -label [mc Undo] \
2712 -command {catch {[focus] edit undo}} \
2713 -accelerator $M1T-Z
2714 .mbar.edit add command -label [mc Redo] \
2715 -command {catch {[focus] edit redo}} \
2716 -accelerator $M1T-Y
2717 .mbar.edit add separator
2718 .mbar.edit add command -label [mc Cut] \
2719 -command {catch {tk_textCut [focus]}} \
2720 -accelerator $M1T-X
2721 .mbar.edit add command -label [mc Copy] \
2722 -command {catch {tk_textCopy [focus]}} \
2723 -accelerator $M1T-C
2724 .mbar.edit add command -label [mc Paste] \
2725 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2726 -accelerator $M1T-V
2727 .mbar.edit add command -label [mc Delete] \
2728 -command {catch {[focus] delete sel.first sel.last}} \
2729 -accelerator Del
2730 .mbar.edit add separator
2731 .mbar.edit add command -label [mc "Select All"] \
2732 -command {catch {[focus] tag add sel 0.0 end}} \
2733 -accelerator $M1T-A
2735 # -- Branch Menu
2737 if {[is_enabled branch]} {
2738 menu .mbar.branch
2740 .mbar.branch add command -label [mc "Create..."] \
2741 -command branch_create::dialog \
2742 -accelerator $M1T-N
2743 lappend disable_on_lock [list .mbar.branch entryconf \
2744 [.mbar.branch index last] -state]
2746 .mbar.branch add command -label [mc "Checkout..."] \
2747 -command branch_checkout::dialog \
2748 -accelerator $M1T-O
2749 lappend disable_on_lock [list .mbar.branch entryconf \
2750 [.mbar.branch index last] -state]
2752 .mbar.branch add command -label [mc "Rename..."] \
2753 -command branch_rename::dialog
2754 lappend disable_on_lock [list .mbar.branch entryconf \
2755 [.mbar.branch index last] -state]
2757 .mbar.branch add command -label [mc "Delete..."] \
2758 -command branch_delete::dialog
2759 lappend disable_on_lock [list .mbar.branch entryconf \
2760 [.mbar.branch index last] -state]
2762 .mbar.branch add command -label [mc "Reset..."] \
2763 -command merge::reset_hard
2764 lappend disable_on_lock [list .mbar.branch entryconf \
2765 [.mbar.branch index last] -state]
2768 # -- Commit Menu
2770 proc commit_btn_caption {} {
2771 if {[is_enabled nocommit]} {
2772 return [mc "Done"]
2773 } else {
2774 return [mc Commit@@verb]
2778 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2779 menu .mbar.commit
2781 if {![is_enabled nocommit]} {
2782 .mbar.commit add radiobutton \
2783 -label [mc "New Commit"] \
2784 -command do_select_commit_type \
2785 -variable selected_commit_type \
2786 -value new
2787 lappend disable_on_lock \
2788 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2790 .mbar.commit add radiobutton \
2791 -label [mc "Amend Last Commit"] \
2792 -command do_select_commit_type \
2793 -variable selected_commit_type \
2794 -value amend
2795 lappend disable_on_lock \
2796 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2798 .mbar.commit add separator
2801 .mbar.commit add command -label [mc Rescan] \
2802 -command ui_do_rescan \
2803 -accelerator F5
2804 lappend disable_on_lock \
2805 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2807 .mbar.commit add command -label [mc "Stage To Commit"] \
2808 -command do_add_selection \
2809 -accelerator $M1T-T
2810 lappend disable_on_lock \
2811 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2813 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2814 -command do_add_all \
2815 -accelerator $M1T-I
2816 lappend disable_on_lock \
2817 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2819 .mbar.commit add command -label [mc "Unstage From Commit"] \
2820 -command do_unstage_selection \
2821 -accelerator $M1T-U
2822 lappend disable_on_lock \
2823 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2825 .mbar.commit add command -label [mc "Revert Changes"] \
2826 -command do_revert_selection \
2827 -accelerator $M1T-J
2828 lappend disable_on_lock \
2829 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2831 .mbar.commit add separator
2833 .mbar.commit add command -label [mc "Show Less Context"] \
2834 -command show_less_context \
2835 -accelerator $M1T-\-
2837 .mbar.commit add command -label [mc "Show More Context"] \
2838 -command show_more_context \
2839 -accelerator $M1T-=
2841 .mbar.commit add separator
2843 if {![is_enabled nocommitmsg]} {
2844 .mbar.commit add command -label [mc "Sign Off"] \
2845 -command do_signoff \
2846 -accelerator $M1T-S
2849 .mbar.commit add command -label [commit_btn_caption] \
2850 -command do_commit \
2851 -accelerator $M1T-Return
2852 lappend disable_on_lock \
2853 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2856 # -- Merge Menu
2858 if {[is_enabled branch]} {
2859 menu .mbar.merge
2860 .mbar.merge add command -label [mc "Local Merge..."] \
2861 -command merge::dialog \
2862 -accelerator $M1T-M
2863 lappend disable_on_lock \
2864 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2865 .mbar.merge add command -label [mc "Abort Merge..."] \
2866 -command merge::reset_hard
2867 lappend disable_on_lock \
2868 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2871 # -- Transport Menu
2873 if {[is_enabled transport]} {
2874 menu .mbar.remote
2876 .mbar.remote add command \
2877 -label [mc "Add..."] \
2878 -command remote_add::dialog \
2879 -accelerator $M1T-A
2880 .mbar.remote add command \
2881 -label [mc "Push..."] \
2882 -command do_push_anywhere \
2883 -accelerator $M1T-P
2884 .mbar.remote add command \
2885 -label [mc "Delete Branch..."] \
2886 -command remote_branch_delete::dialog
2889 if {[is_MacOSX]} {
2890 proc ::tk::mac::ShowPreferences {} {do_options}
2891 } else {
2892 # -- Edit Menu
2894 .mbar.edit add separator
2895 .mbar.edit add command -label [mc "Options..."] \
2896 -command do_options
2899 # -- Tools Menu
2901 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2902 set tools_menubar .mbar.tools
2903 menu $tools_menubar
2904 $tools_menubar add separator
2905 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2906 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2907 set tools_tailcnt 3
2908 if {[array names repo_config guitool.*.cmd] ne {}} {
2909 tools_populate_all
2913 # -- Help Menu
2915 .mbar add cascade -label [mc Help] -menu .mbar.help
2916 menu .mbar.help
2918 if {[is_MacOSX]} {
2919 .mbar.apple add command -label [mc "About %s" [appname]] \
2920 -command do_about
2921 .mbar.apple add separator
2922 } else {
2923 .mbar.help add command -label [mc "About %s" [appname]] \
2924 -command do_about
2926 . configure -menu .mbar
2928 set doc_path [githtmldir]
2929 if {$doc_path ne {}} {
2930 set doc_path [file join $doc_path index.html]
2932 if {[is_Cygwin]} {
2933 set doc_path [exec cygpath --mixed $doc_path]
2937 if {[file isfile $doc_path]} {
2938 set doc_url "file:$doc_path"
2939 } else {
2940 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2943 proc start_browser {url} {
2944 git "web--browse" $url
2947 .mbar.help add command -label [mc "Online Documentation"] \
2948 -command [list start_browser $doc_url]
2950 .mbar.help add command -label [mc "Show SSH Key"] \
2951 -command do_ssh_key
2953 unset doc_path doc_url
2955 # -- Standard bindings
2957 wm protocol . WM_DELETE_WINDOW do_quit
2958 bind all <$M1B-Key-q> do_quit
2959 bind all <$M1B-Key-Q> do_quit
2960 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2961 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2963 set subcommand_args {}
2964 proc usage {} {
2965 set s "usage: $::argv0 $::subcommand $::subcommand_args"
2966 if {[tk windowingsystem] eq "win32"} {
2967 wm withdraw .
2968 tk_messageBox -icon info -message $s \
2969 -title [mc "Usage"]
2970 } else {
2971 puts stderr $s
2973 exit 1
2976 proc normalize_relpath {path} {
2977 set elements {}
2978 foreach item [file split $path] {
2979 if {$item eq {.}} continue
2980 if {$item eq {..} && [llength $elements] > 0
2981 && [lindex $elements end] ne {..}} {
2982 set elements [lrange $elements 0 end-1]
2983 continue
2985 lappend elements $item
2987 return [eval file join $elements]
2990 # -- Not a normal commit type invocation? Do that instead!
2992 switch -- $subcommand {
2993 browser -
2994 blame {
2995 if {$subcommand eq "blame"} {
2996 set subcommand_args {[--line=<num>] rev? path}
2997 } else {
2998 set subcommand_args {rev? path}
3000 if {$argv eq {}} usage
3001 set head {}
3002 set path {}
3003 set jump_spec {}
3004 set is_path 0
3005 foreach a $argv {
3006 if {[file exists $a]} {
3007 if {$path ne {}} usage
3008 set path [normalize_relpath $a]
3009 break
3010 } elseif {[file exists $_prefix$a]} {
3011 if {$path ne {}} usage
3012 set path [normalize_relpath $_prefix$a]
3013 break
3016 if {$is_path} {
3017 if {$path ne {}} usage
3018 break
3019 } elseif {$a eq {--}} {
3020 if {$path ne {}} {
3021 if {$head ne {}} usage
3022 set head $path
3023 set path {}
3025 set is_path 1
3026 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3027 if {$jump_spec ne {} || $head ne {}} usage
3028 set jump_spec [list $lnum]
3029 } elseif {$head eq {}} {
3030 if {$head ne {}} usage
3031 set head $a
3032 set is_path 1
3033 } else {
3034 usage
3037 unset is_path
3039 if {$head ne {} && $path eq {}} {
3040 if {[string index $head 0] eq {/}} {
3041 set path [normalize_relpath $head]
3042 set head {}
3043 } else {
3044 set path [normalize_relpath $_prefix$head]
3045 set head {}
3049 if {$head eq {}} {
3050 load_current_branch
3051 } else {
3052 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3053 if {[catch {
3054 set head [git rev-parse --verify $head]
3055 } err]} {
3056 if {[tk windowingsystem] eq "win32"} {
3057 tk_messageBox -icon error -title [mc Error] -message $err
3058 } else {
3059 puts stderr $err
3061 exit 1
3064 set current_branch $head
3067 wm deiconify .
3068 switch -- $subcommand {
3069 browser {
3070 if {$jump_spec ne {}} usage
3071 if {$head eq {}} {
3072 if {$path ne {} && [file isdirectory $path]} {
3073 set head $current_branch
3074 } else {
3075 set head $path
3076 set path {}
3079 browser::new $head $path
3081 blame {
3082 if {$head eq {} && ![file exists $path]} {
3083 catch {wm withdraw .}
3084 tk_messageBox \
3085 -icon error \
3086 -type ok \
3087 -title [mc "git-gui: fatal error"] \
3088 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3089 exit 1
3091 blame::new $head $path $jump_spec
3094 return
3096 citool -
3097 gui {
3098 if {[llength $argv] != 0} {
3099 usage
3101 # fall through to setup UI for commits
3103 default {
3104 set err "usage: $argv0 \[{blame|browser|citool}\]"
3105 if {[tk windowingsystem] eq "win32"} {
3106 wm withdraw .
3107 tk_messageBox -icon error -message $err \
3108 -title [mc "Usage"]
3109 } else {
3110 puts stderr $err
3112 exit 1
3116 # -- Branch Control
3118 ${NS}::frame .branch
3119 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3120 ${NS}::label .branch.l1 \
3121 -text [mc "Current Branch:"] \
3122 -anchor w \
3123 -justify left
3124 ${NS}::label .branch.cb \
3125 -textvariable current_branch \
3126 -anchor w \
3127 -justify left
3128 pack .branch.l1 -side left
3129 pack .branch.cb -side left -fill x
3130 pack .branch -side top -fill x
3132 # -- Main Window Layout
3134 ${NS}::panedwindow .vpane -orient horizontal
3135 ${NS}::panedwindow .vpane.files -orient vertical
3136 if {$use_ttk} {
3137 .vpane add .vpane.files
3138 } else {
3139 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3141 pack .vpane -anchor n -side top -fill both -expand 1
3143 # -- Index File List
3145 ${NS}::frame .vpane.files.index -height 100 -width 200
3146 tlabel .vpane.files.index.title \
3147 -text [mc "Staged Changes (Will Commit)"] \
3148 -background lightgreen -foreground black
3149 text $ui_index -background white -foreground black \
3150 -borderwidth 0 \
3151 -width 20 -height 10 \
3152 -wrap none \
3153 -cursor $cursor_ptr \
3154 -xscrollcommand {.vpane.files.index.sx set} \
3155 -yscrollcommand {.vpane.files.index.sy set} \
3156 -state disabled
3157 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3158 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3159 pack .vpane.files.index.title -side top -fill x
3160 pack .vpane.files.index.sx -side bottom -fill x
3161 pack .vpane.files.index.sy -side right -fill y
3162 pack $ui_index -side left -fill both -expand 1
3164 # -- Working Directory File List
3166 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3167 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3168 -background lightsalmon -foreground black
3169 text $ui_workdir -background white -foreground black \
3170 -borderwidth 0 \
3171 -width 20 -height 10 \
3172 -wrap none \
3173 -cursor $cursor_ptr \
3174 -xscrollcommand {.vpane.files.workdir.sx set} \
3175 -yscrollcommand {.vpane.files.workdir.sy set} \
3176 -state disabled
3177 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3178 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3179 pack .vpane.files.workdir.title -side top -fill x
3180 pack .vpane.files.workdir.sx -side bottom -fill x
3181 pack .vpane.files.workdir.sy -side right -fill y
3182 pack $ui_workdir -side left -fill both -expand 1
3184 .vpane.files add .vpane.files.workdir
3185 .vpane.files add .vpane.files.index
3186 if {!$use_ttk} {
3187 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3188 .vpane.files paneconfigure .vpane.files.index -sticky news
3191 foreach i [list $ui_index $ui_workdir] {
3192 rmsel_tag $i
3193 $i tag conf in_diff -background [$i tag cget in_sel -background]
3195 unset i
3197 # -- Diff and Commit Area
3199 ${NS}::frame .vpane.lower -height 300 -width 400
3200 ${NS}::frame .vpane.lower.commarea
3201 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3202 pack .vpane.lower.diff -fill both -expand 1
3203 pack .vpane.lower.commarea -side bottom -fill x
3204 .vpane add .vpane.lower
3205 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3207 # -- Commit Area Buttons
3209 ${NS}::frame .vpane.lower.commarea.buttons
3210 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3211 -anchor w \
3212 -justify left
3213 pack .vpane.lower.commarea.buttons.l -side top -fill x
3214 pack .vpane.lower.commarea.buttons -side left -fill y
3216 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3217 -command ui_do_rescan
3218 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3219 lappend disable_on_lock \
3220 {.vpane.lower.commarea.buttons.rescan conf -state}
3222 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3223 -command do_add_all
3224 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3225 lappend disable_on_lock \
3226 {.vpane.lower.commarea.buttons.incall conf -state}
3228 if {![is_enabled nocommitmsg]} {
3229 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3230 -command do_signoff
3231 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3234 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3235 -command do_commit
3236 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3237 lappend disable_on_lock \
3238 {.vpane.lower.commarea.buttons.commit conf -state}
3240 if {![is_enabled nocommit]} {
3241 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3242 -command do_push_anywhere
3243 pack .vpane.lower.commarea.buttons.push -side top -fill x
3246 # -- Commit Message Buffer
3248 ${NS}::frame .vpane.lower.commarea.buffer
3249 ${NS}::frame .vpane.lower.commarea.buffer.header
3250 set ui_comm .vpane.lower.commarea.buffer.t
3251 set ui_coml .vpane.lower.commarea.buffer.header.l
3253 if {![is_enabled nocommit]} {
3254 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3255 -text [mc "New Commit"] \
3256 -command do_select_commit_type \
3257 -variable selected_commit_type \
3258 -value new
3259 lappend disable_on_lock \
3260 [list .vpane.lower.commarea.buffer.header.new conf -state]
3261 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3262 -text [mc "Amend Last Commit"] \
3263 -command do_select_commit_type \
3264 -variable selected_commit_type \
3265 -value amend
3266 lappend disable_on_lock \
3267 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3270 ${NS}::label $ui_coml \
3271 -anchor w \
3272 -justify left
3273 proc trace_commit_type {varname args} {
3274 global ui_coml commit_type
3275 switch -glob -- $commit_type {
3276 initial {set txt [mc "Initial Commit Message:"]}
3277 amend {set txt [mc "Amended Commit Message:"]}
3278 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3279 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3280 merge {set txt [mc "Merge Commit Message:"]}
3281 * {set txt [mc "Commit Message:"]}
3283 $ui_coml conf -text $txt
3285 trace add variable commit_type write trace_commit_type
3286 pack $ui_coml -side left -fill x
3288 if {![is_enabled nocommit]} {
3289 pack .vpane.lower.commarea.buffer.header.amend -side right
3290 pack .vpane.lower.commarea.buffer.header.new -side right
3293 text $ui_comm -background white -foreground black \
3294 -borderwidth 1 \
3295 -undo true \
3296 -maxundo 20 \
3297 -autoseparators true \
3298 -relief sunken \
3299 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3300 -font font_diff \
3301 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3302 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3303 -command [list $ui_comm yview]
3304 pack .vpane.lower.commarea.buffer.header -side top -fill x
3305 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3306 pack $ui_comm -side left -fill y
3307 pack .vpane.lower.commarea.buffer -side left -fill y
3309 # -- Commit Message Buffer Context Menu
3311 set ctxm .vpane.lower.commarea.buffer.ctxm
3312 menu $ctxm -tearoff 0
3313 $ctxm add command \
3314 -label [mc Cut] \
3315 -command {tk_textCut $ui_comm}
3316 $ctxm add command \
3317 -label [mc Copy] \
3318 -command {tk_textCopy $ui_comm}
3319 $ctxm add command \
3320 -label [mc Paste] \
3321 -command {tk_textPaste $ui_comm}
3322 $ctxm add command \
3323 -label [mc Delete] \
3324 -command {catch {$ui_comm delete sel.first sel.last}}
3325 $ctxm add separator
3326 $ctxm add command \
3327 -label [mc "Select All"] \
3328 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3329 $ctxm add command \
3330 -label [mc "Copy All"] \
3331 -command {
3332 $ui_comm tag add sel 0.0 end
3333 tk_textCopy $ui_comm
3334 $ui_comm tag remove sel 0.0 end
3336 $ctxm add separator
3337 $ctxm add command \
3338 -label [mc "Sign Off"] \
3339 -command do_signoff
3340 set ui_comm_ctxm $ctxm
3342 # -- Diff Header
3344 proc trace_current_diff_path {varname args} {
3345 global current_diff_path diff_actions file_states
3346 if {$current_diff_path eq {}} {
3347 set s {}
3348 set f {}
3349 set p {}
3350 set o disabled
3351 } else {
3352 set p $current_diff_path
3353 set s [mapdesc [lindex $file_states($p) 0] $p]
3354 set f [mc "File:"]
3355 set p [escape_path $p]
3356 set o normal
3359 .vpane.lower.diff.header.status configure -text $s
3360 .vpane.lower.diff.header.file configure -text $f
3361 .vpane.lower.diff.header.path configure -text $p
3362 foreach w $diff_actions {
3363 uplevel #0 $w $o
3366 trace add variable current_diff_path write trace_current_diff_path
3368 gold_frame .vpane.lower.diff.header
3369 tlabel .vpane.lower.diff.header.status \
3370 -background gold \
3371 -foreground black \
3372 -width $max_status_desc \
3373 -anchor w \
3374 -justify left
3375 tlabel .vpane.lower.diff.header.file \
3376 -background gold \
3377 -foreground black \
3378 -anchor w \
3379 -justify left
3380 tlabel .vpane.lower.diff.header.path \
3381 -background gold \
3382 -foreground black \
3383 -anchor w \
3384 -justify left
3385 pack .vpane.lower.diff.header.status -side left
3386 pack .vpane.lower.diff.header.file -side left
3387 pack .vpane.lower.diff.header.path -fill x
3388 set ctxm .vpane.lower.diff.header.ctxm
3389 menu $ctxm -tearoff 0
3390 $ctxm add command \
3391 -label [mc Copy] \
3392 -command {
3393 clipboard clear
3394 clipboard append \
3395 -format STRING \
3396 -type STRING \
3397 -- $current_diff_path
3399 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3400 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3402 # -- Diff Body
3404 ${NS}::frame .vpane.lower.diff.body
3405 set ui_diff .vpane.lower.diff.body.t
3406 text $ui_diff -background white -foreground black \
3407 -borderwidth 0 \
3408 -width 80 -height 5 -wrap none \
3409 -font font_diff \
3410 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3411 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3412 -state disabled
3413 catch {$ui_diff configure -tabstyle wordprocessor}
3414 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3415 -command [list $ui_diff xview]
3416 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3417 -command [list $ui_diff yview]
3418 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3419 pack .vpane.lower.diff.body.sby -side right -fill y
3420 pack $ui_diff -side left -fill both -expand 1
3421 pack .vpane.lower.diff.header -side top -fill x
3422 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3424 foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3425 $ui_diff tag configure clr4$n -background $c
3426 $ui_diff tag configure clri4$n -foreground $c
3427 $ui_diff tag configure clr3$n -foreground $c
3428 $ui_diff tag configure clri3$n -background $c
3430 $ui_diff tag configure clr1 -font font_diffbold
3431 $ui_diff tag configure clr4 -underline 1
3433 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3435 $ui_diff tag conf d_cr -elide true
3436 $ui_diff tag conf d_@ -font font_diffbold
3437 $ui_diff tag conf d_+ -foreground {#00a000}
3438 $ui_diff tag conf d_- -foreground red
3440 $ui_diff tag conf d_++ -foreground {#00a000}
3441 $ui_diff tag conf d_-- -foreground red
3442 $ui_diff tag conf d_+s \
3443 -foreground {#00a000} \
3444 -background {#e2effa}
3445 $ui_diff tag conf d_-s \
3446 -foreground red \
3447 -background {#e2effa}
3448 $ui_diff tag conf d_s+ \
3449 -foreground {#00a000} \
3450 -background ivory1
3451 $ui_diff tag conf d_s- \
3452 -foreground red \
3453 -background ivory1
3455 $ui_diff tag conf d< \
3456 -foreground orange \
3457 -font font_diffbold
3458 $ui_diff tag conf d= \
3459 -foreground orange \
3460 -font font_diffbold
3461 $ui_diff tag conf d> \
3462 -foreground orange \
3463 -font font_diffbold
3465 $ui_diff tag raise sel
3467 # -- Diff Body Context Menu
3470 proc create_common_diff_popup {ctxm} {
3471 $ctxm add command \
3472 -label [mc Refresh] \
3473 -command reshow_diff
3474 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3475 $ctxm add command \
3476 -label [mc Copy] \
3477 -command {tk_textCopy $ui_diff}
3478 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3479 $ctxm add command \
3480 -label [mc "Select All"] \
3481 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3482 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3483 $ctxm add command \
3484 -label [mc "Copy All"] \
3485 -command {
3486 $ui_diff tag add sel 0.0 end
3487 tk_textCopy $ui_diff
3488 $ui_diff tag remove sel 0.0 end
3490 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3491 $ctxm add separator
3492 $ctxm add command \
3493 -label [mc "Decrease Font Size"] \
3494 -command {incr_font_size font_diff -1}
3495 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3496 $ctxm add command \
3497 -label [mc "Increase Font Size"] \
3498 -command {incr_font_size font_diff 1}
3499 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3500 $ctxm add separator
3501 set emenu $ctxm.enc
3502 menu $emenu
3503 build_encoding_menu $emenu [list force_diff_encoding]
3504 $ctxm add cascade \
3505 -label [mc "Encoding"] \
3506 -menu $emenu
3507 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3508 $ctxm add separator
3509 $ctxm add command -label [mc "Options..."] \
3510 -command do_options
3513 set ctxm .vpane.lower.diff.body.ctxm
3514 menu $ctxm -tearoff 0
3515 $ctxm add command \
3516 -label [mc "Apply/Reverse Hunk"] \
3517 -command {apply_hunk $cursorX $cursorY}
3518 set ui_diff_applyhunk [$ctxm index last]
3519 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3520 $ctxm add command \
3521 -label [mc "Apply/Reverse Line"] \
3522 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3523 set ui_diff_applyline [$ctxm index last]
3524 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3525 $ctxm add separator
3526 $ctxm add command \
3527 -label [mc "Show Less Context"] \
3528 -command show_less_context
3529 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3530 $ctxm add command \
3531 -label [mc "Show More Context"] \
3532 -command show_more_context
3533 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3534 $ctxm add separator
3535 create_common_diff_popup $ctxm
3537 set ctxmmg .vpane.lower.diff.body.ctxmmg
3538 menu $ctxmmg -tearoff 0
3539 $ctxmmg add command \
3540 -label [mc "Run Merge Tool"] \
3541 -command {merge_resolve_tool}
3542 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3543 $ctxmmg add separator
3544 $ctxmmg add command \
3545 -label [mc "Use Remote Version"] \
3546 -command {merge_resolve_one 3}
3547 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3548 $ctxmmg add command \
3549 -label [mc "Use Local Version"] \
3550 -command {merge_resolve_one 2}
3551 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3552 $ctxmmg add command \
3553 -label [mc "Revert To Base"] \
3554 -command {merge_resolve_one 1}
3555 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3556 $ctxmmg add separator
3557 $ctxmmg add command \
3558 -label [mc "Show Less Context"] \
3559 -command show_less_context
3560 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3561 $ctxmmg add command \
3562 -label [mc "Show More Context"] \
3563 -command show_more_context
3564 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3565 $ctxmmg add separator
3566 create_common_diff_popup $ctxmmg
3568 set ctxmsm .vpane.lower.diff.body.ctxmsm
3569 menu $ctxmsm -tearoff 0
3570 $ctxmsm add command \
3571 -label [mc "Visualize These Changes In The Submodule"] \
3572 -command {do_gitk -- true}
3573 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3574 $ctxmsm add command \
3575 -label [mc "Visualize Current Branch History In The Submodule"] \
3576 -command {do_gitk {} true}
3577 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3578 $ctxmsm add command \
3579 -label [mc "Visualize All Branch History In The Submodule"] \
3580 -command {do_gitk --all true}
3581 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3582 $ctxmsm add separator
3583 $ctxmsm add command \
3584 -label [mc "Start git gui In The Submodule"] \
3585 -command {do_git_gui}
3586 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3587 $ctxmsm add separator
3588 create_common_diff_popup $ctxmsm
3590 proc has_textconv {path} {
3591 if {[is_config_false gui.textconv]} {
3592 return 0
3594 set filter [gitattr $path diff set]
3595 set textconv [get_config [join [list diff $filter textconv] .]]
3596 if {$filter ne {set} && $textconv ne {}} {
3597 return 1
3598 } else {
3599 return 0
3603 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3604 global current_diff_path file_states
3605 set ::cursorX $x
3606 set ::cursorY $y
3607 if {[info exists file_states($current_diff_path)]} {
3608 set state [lindex $file_states($current_diff_path) 0]
3609 } else {
3610 set state {__}
3612 if {[string first {U} $state] >= 0} {
3613 tk_popup $ctxmmg $X $Y
3614 } elseif {$::is_submodule_diff} {
3615 tk_popup $ctxmsm $X $Y
3616 } else {
3617 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3618 if {$::ui_index eq $::current_diff_side} {
3619 set l [mc "Unstage Hunk From Commit"]
3620 if {$has_range} {
3621 set t [mc "Unstage Lines From Commit"]
3622 } else {
3623 set t [mc "Unstage Line From Commit"]
3625 } else {
3626 set l [mc "Stage Hunk For Commit"]
3627 if {$has_range} {
3628 set t [mc "Stage Lines For Commit"]
3629 } else {
3630 set t [mc "Stage Line For Commit"]
3633 if {$::is_3way_diff
3634 || $current_diff_path eq {}
3635 || {__} eq $state
3636 || {_O} eq $state
3637 || [string match {?T} $state]
3638 || [string match {T?} $state]
3639 || [has_textconv $current_diff_path]} {
3640 set s disabled
3641 } else {
3642 set s normal
3644 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3645 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3646 tk_popup $ctxm $X $Y
3649 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3651 # -- Status Bar
3653 set main_status [::status_bar::new .status]
3654 pack .status -anchor w -side bottom -fill x
3655 $main_status show [mc "Initializing..."]
3657 # -- Load geometry
3659 proc on_ttk_pane_mapped {w pane pos} {
3660 bind $w <Map> {}
3661 after 0 [list after idle [list $w sashpos $pane $pos]]
3663 proc on_tk_pane_mapped {w pane x y} {
3664 bind $w <Map> {}
3665 after 0 [list after idle [list $w sash place $pane $x $y]]
3667 proc on_application_mapped {} {
3668 global repo_config use_ttk
3669 bind . <Map> {}
3670 set gm $repo_config(gui.geometry)
3671 if {$use_ttk} {
3672 bind .vpane <Map> \
3673 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3674 bind .vpane.files <Map> \
3675 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3676 } else {
3677 bind .vpane <Map> \
3678 [list on_tk_pane_mapped %W 0 \
3679 [lindex $gm 1] \
3680 [lindex [.vpane sash coord 0] 1]]
3681 bind .vpane.files <Map> \
3682 [list on_tk_pane_mapped %W 0 \
3683 [lindex [.vpane.files sash coord 0] 0] \
3684 [lindex $gm 2]]
3686 wm geometry . [lindex $gm 0]
3688 if {[info exists repo_config(gui.geometry)]} {
3689 bind . <Map> [list on_application_mapped]
3690 wm geometry . [lindex $repo_config(gui.geometry) 0]
3693 # -- Load window state
3695 if {[info exists repo_config(gui.wmstate)]} {
3696 catch {wm state . $repo_config(gui.wmstate)}
3699 # -- Key Bindings
3701 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3702 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3703 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3704 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3705 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3706 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3707 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3708 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3709 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3710 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3711 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3712 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3713 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3714 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3715 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3716 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3717 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3718 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3719 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3720 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3721 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3722 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3724 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3725 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3726 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3727 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3728 bind $ui_diff <$M1B-Key-v> {break}
3729 bind $ui_diff <$M1B-Key-V> {break}
3730 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3731 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3732 bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
3733 bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
3734 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3735 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3736 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3737 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3738 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3739 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3740 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3741 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3742 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3743 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3744 bind $ui_diff <Button-1> {focus %W}
3746 if {[is_enabled branch]} {
3747 bind . <$M1B-Key-n> branch_create::dialog
3748 bind . <$M1B-Key-N> branch_create::dialog
3749 bind . <$M1B-Key-o> branch_checkout::dialog
3750 bind . <$M1B-Key-O> branch_checkout::dialog
3751 bind . <$M1B-Key-m> merge::dialog
3752 bind . <$M1B-Key-M> merge::dialog
3754 if {[is_enabled transport]} {
3755 bind . <$M1B-Key-p> do_push_anywhere
3756 bind . <$M1B-Key-P> do_push_anywhere
3759 bind . <Key-F5> ui_do_rescan
3760 bind . <$M1B-Key-r> ui_do_rescan
3761 bind . <$M1B-Key-R> ui_do_rescan
3762 bind . <$M1B-Key-s> do_signoff
3763 bind . <$M1B-Key-S> do_signoff
3764 bind . <$M1B-Key-t> do_add_selection
3765 bind . <$M1B-Key-T> do_add_selection
3766 bind . <$M1B-Key-u> do_unstage_selection
3767 bind . <$M1B-Key-U> do_unstage_selection
3768 bind . <$M1B-Key-j> do_revert_selection
3769 bind . <$M1B-Key-J> do_revert_selection
3770 bind . <$M1B-Key-i> do_add_all
3771 bind . <$M1B-Key-I> do_add_all
3772 bind . <$M1B-Key-minus> {show_less_context;break}
3773 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3774 bind . <$M1B-Key-equal> {show_more_context;break}
3775 bind . <$M1B-Key-plus> {show_more_context;break}
3776 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3777 bind . <$M1B-Key-Return> do_commit
3778 foreach i [list $ui_index $ui_workdir] {
3779 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3780 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3781 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3783 unset i
3785 set file_lists($ui_index) [list]
3786 set file_lists($ui_workdir) [list]
3788 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3789 focus -force $ui_comm
3791 # -- Warn the user about environmental problems. Cygwin's Tcl
3792 # does *not* pass its env array onto any processes it spawns.
3793 # This means that git processes get none of our environment.
3795 if {[is_Cygwin]} {
3796 set ignored_env 0
3797 set suggest_user {}
3798 set msg [mc "Possible environment issues exist.
3800 The following environment variables are probably
3801 going to be ignored by any Git subprocess run
3802 by %s:
3804 " [appname]]
3805 foreach name [array names env] {
3806 switch -regexp -- $name {
3807 {^GIT_INDEX_FILE$} -
3808 {^GIT_OBJECT_DIRECTORY$} -
3809 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3810 {^GIT_DIFF_OPTS$} -
3811 {^GIT_EXTERNAL_DIFF$} -
3812 {^GIT_PAGER$} -
3813 {^GIT_TRACE$} -
3814 {^GIT_CONFIG$} -
3815 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3816 append msg " - $name\n"
3817 incr ignored_env
3819 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3820 append msg " - $name\n"
3821 incr ignored_env
3822 set suggest_user $name
3826 if {$ignored_env > 0} {
3827 append msg [mc "
3828 This is due to a known issue with the
3829 Tcl binary distributed by Cygwin."]
3831 if {$suggest_user ne {}} {
3832 append msg [mc "
3834 A good replacement for %s
3835 is placing values for the user.name and
3836 user.email settings into your personal
3837 ~/.gitconfig file.
3838 " $suggest_user]
3840 warn_popup $msg
3842 unset ignored_env msg suggest_user name
3845 # -- Only initialize complex UI if we are going to stay running.
3847 if {[is_enabled transport]} {
3848 load_all_remotes
3850 set n [.mbar.remote index end]
3851 populate_remotes_menu
3852 set n [expr {[.mbar.remote index end] - $n}]
3853 if {$n > 0} {
3854 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3855 .mbar.remote insert $n separator
3857 unset n
3860 if {[winfo exists $ui_comm]} {
3861 set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
3863 # -- If both our backup and message files exist use the
3864 # newer of the two files to initialize the buffer.
3866 if {$GITGUI_BCK_exists} {
3867 set m [gitdir GITGUI_MSG]
3868 if {[file isfile $m]} {
3869 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3870 catch {file delete [gitdir GITGUI_MSG]}
3871 } else {
3872 $ui_comm delete 0.0 end
3873 $ui_comm edit reset
3874 $ui_comm edit modified false
3875 catch {file delete [gitdir GITGUI_BCK]}
3876 set GITGUI_BCK_exists 0
3879 unset m
3882 proc backup_commit_buffer {} {
3883 global ui_comm GITGUI_BCK_exists
3885 set m [$ui_comm edit modified]
3886 if {$m || $GITGUI_BCK_exists} {
3887 set msg [string trim [$ui_comm get 0.0 end]]
3888 regsub -all -line {[ \r\t]+$} $msg {} msg
3890 if {$msg eq {}} {
3891 if {$GITGUI_BCK_exists} {
3892 catch {file delete [gitdir GITGUI_BCK]}
3893 set GITGUI_BCK_exists 0
3895 } elseif {$m} {
3896 catch {
3897 set fd [open [gitdir GITGUI_BCK] w]
3898 fconfigure $fd -encoding utf-8
3899 puts -nonewline $fd $msg
3900 close $fd
3901 set GITGUI_BCK_exists 1
3905 $ui_comm edit modified false
3908 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3911 backup_commit_buffer
3913 # -- If the user has aspell available we can drive it
3914 # in pipe mode to spellcheck the commit message.
3916 set spell_cmd [list |]
3917 set spell_dict [get_config gui.spellingdictionary]
3918 lappend spell_cmd aspell
3919 if {$spell_dict ne {}} {
3920 lappend spell_cmd --master=$spell_dict
3922 lappend spell_cmd --mode=none
3923 lappend spell_cmd --encoding=utf-8
3924 lappend spell_cmd pipe
3925 if {$spell_dict eq {none}
3926 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3927 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3928 } else {
3929 set ui_comm_spell [spellcheck::init \
3930 $spell_fd \
3931 $ui_comm \
3932 $ui_comm_ctxm \
3935 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3938 lock_index begin-read
3939 if {![winfo ismapped .]} {
3940 wm deiconify .
3942 after 1 {
3943 if {[is_enabled initialamend]} {
3944 force_amend
3945 } else {
3946 do_rescan
3949 if {[is_enabled nocommitmsg]} {
3950 $ui_comm configure -state disabled -background gray
3953 if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
3954 after 1000 hint_gc
3956 if {[is_enabled retcode]} {
3957 bind . <Destroy> {+terminate_me %W}
3959 if {$picked && [is_config_true gui.autoexplore]} {
3960 do_explore
3963 # Local variables:
3964 # mode: tcl
3965 # indent-tabs-mode: t
3966 # tab-width: 4
3967 # End: