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" -- "$@"
11set appvers {@@GITGUI_VERSION@@}
13set copyright [string map [list (c) \u00a9] {
14Copyright (c) 2006-2010 Shawn Pearce, et. al.
15This program is free software; you can redistribute it and/or modify
17it under the terms of the GNU General Public License as published by
18the Free Software Foundation; either version 2 of the License, or
19(at your option) any later version.
20This program is distributed in the hope that it will be useful,
22but WITHOUT ANY WARRANTY; without even the implied warranty of
23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24GNU General Public License for more details.
25You should have received a copy of the GNU General Public License
27along with this program; if not, write to the Free Software
28Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}]
29######################################################################
31##
32## Tcl/Tk sanity check
33if {[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
44}
45catch {rename send {}} ; # What an evil concept...
47######################################################################
49##
50## locate our library
51set oguilib {@@GITGUI_LIBDIR@@}
53set oguirel {@@GITGUI_RELATIVE@@}
54if {$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]
58 }
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]
67}
68unset oguirel
69######################################################################
71##
72## enable verbose loading?
73if {![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]
80 }
81 rename source real__source
82 proc source {name} {
83 puts stderr "source $name"
84 uplevel 1 real__source $name
85 }
86}
87######################################################################
89##
90## Internationalization (i18n) through msgcat and gettext. See
91## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
92package require msgcat
94proc _mc_trim {fmt} {
96 set cmk [string first @@ $fmt]
97 if {$cmk > 0} {
98 return [string range $fmt 0 [expr {$cmk - 1}]]
99 }
100 return $fmt
101}
102proc mc {en_fmt args} {
104 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
105 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
106 set msg [eval [list format [_mc_trim $en_fmt]] $args]
107 }
108 return $msg
109}
110proc strcat {args} {
112 return [join $args {}]
113}
114::msgcat::mcload $oguimsg
116unset oguimsg
117######################################################################
119##
120## read only globals
121set _appname {Git Gui}
123set _gitdir {}
124set _gitworktree {}
125set _isbare {}
126set _gitexec {}
127set _githtmldir {}
128set _reponame {}
129set _iscygwin {}
130set _search_path {}
131set _shellpath {@@SHELL_PATH@@}
132set _trace [lsearch -exact $argv --trace]
134if {$_trace >= 0} {
135 set argv [lreplace $argv $_trace $_trace]
136 set _trace 1
137} else {
138 set _trace 0
139}
140proc shellpath {} {
142 global _shellpath env
143 if {[string match @@* $_shellpath]} {
144 if {[info exists env(SHELL)]} {
145 return $env(SHELL)
146 } else {
147 return /bin/sh
148 }
149 }
150 return $_shellpath
151}
152proc appname {} {
154 global _appname
155 return $_appname
156}
157proc gitdir {args} {
159 global _gitdir
160 if {$args eq {}} {
161 return $_gitdir
162 }
163 return [eval [list file join $_gitdir] $args]
164}
165proc gitexec {args} {
167 global _gitexec
168 if {$_gitexec eq {}} {
169 if {[catch {set _gitexec [git --exec-path]} err]} {
170 error "Git not installed?\n\n$err"
171 }
172 if {[is_Cygwin]} {
173 set _gitexec [exec cygpath \
174 --windows \
175 --absolute \
176 $_gitexec]
177 } else {
178 set _gitexec [file normalize $_gitexec]
179 }
180 }
181 if {$args eq {}} {
182 return $_gitexec
183 }
184 return [eval [list file join $_gitexec] $args]
185}
186proc githtmldir {args} {
188 global _githtmldir
189 if {$_githtmldir eq {}} {
190 if {[catch {set _githtmldir [git --html-path]}]} {
191 # Git not installed or option not yet supported
192 return {}
193 }
194 if {[is_Cygwin]} {
195 set _githtmldir [exec cygpath \
196 --windows \
197 --absolute \
198 $_githtmldir]
199 } else {
200 set _githtmldir [file normalize $_githtmldir]
201 }
202 }
203 if {$args eq {}} {
204 return $_githtmldir
205 }
206 return [eval [list file join $_githtmldir] $args]
207}
208proc reponame {} {
210 return $::_reponame
211}
212proc is_MacOSX {} {
214 if {[tk windowingsystem] eq {aqua}} {
215 return 1
216 }
217 return 0
218}
219proc is_Windows {} {
221 if {$::tcl_platform(platform) eq {windows}} {
222 return 1
223 }
224 return 0
225}
226proc is_Cygwin {} {
228 global _iscygwin
229 if {$_iscygwin eq {}} {
230 if {$::tcl_platform(platform) eq {windows}} {
231 if {[catch {set p [exec cygpath --windir]} err]} {
232 set _iscygwin 0
233 } else {
234 set _iscygwin 1
235 }
236 } else {
237 set _iscygwin 0
238 }
239 }
240 return $_iscygwin
241}
242proc is_enabled {option} {
244 global enabled_options
245 if {[catch {set on $enabled_options($option)}]} {return 0}
246 return $on
247}
248proc enable_option {option} {
250 global enabled_options
251 set enabled_options($option) 1
252}
253proc disable_option {option} {
255 global enabled_options
256 set enabled_options($option) 0
257}
258######################################################################
260##
261## config
262proc is_many_config {name} {
264 switch -glob -- $name {
265 gui.recentrepo -
266 remote.*.fetch -
267 remote.*.push
268 {return 1}
269 *
270 {return 0}
271 }
272}
273proc is_config_true {name} {
275 global repo_config
276 if {[catch {set v $repo_config($name)}]} {
277 return 0
278 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
279 return 1
280 } else {
281 return 0
282 }
283}
284proc is_config_false {name} {
286 global repo_config
287 if {[catch {set v $repo_config($name)}]} {
288 return 0
289 } elseif {$v eq {false} || $v eq {0} || $v eq {no}} {
290 return 1
291 } else {
292 return 0
293 }
294}
295proc get_config {name} {
297 global repo_config
298 if {[catch {set v $repo_config($name)}]} {
299 return {}
300 } else {
301 return $v
302 }
303}
304proc is_bare {} {
306 global _isbare
307 global _gitdir
308 global _gitworktree
309 if {$_isbare eq {}} {
311 if {[catch {
312 set _bare [git rev-parse --is-bare-repository]
313 switch -- $_bare {
314 true { set _isbare 1 }
315 false { set _isbare 0}
316 default { throw }
317 }
318 }]} {
319 if {[is_config_true core.bare]
320 || ($_gitworktree eq {}
321 && [lindex [file split $_gitdir] end] ne {.git})} {
322 set _isbare 1
323 } else {
324 set _isbare 0
325 }
326 }
327 }
328 return $_isbare
329}
330######################################################################
332##
333## handy utils
334proc _trace_exec {cmd} {
336 if {!$::_trace} return
337 set d {}
338 foreach v $cmd {
339 if {$d ne {}} {
340 append d { }
341 }
342 if {[regexp {[ \t\r\n'"$?*]} $v]} {
343 set v [sq $v]
344 }
345 append d $v
346 }
347 puts stderr $d
348}
349#'" fix poor old emacs font-lock mode
351proc _git_cmd {name} {
353 global _git_cmd_path
354 if {[catch {set v $_git_cmd_path($name)}]} {
356 switch -- $name {
357 version -
358 --version -
359 --exec-path { return [list $::_git $name] }
360 }
361 set p [gitexec git-$name$::_search_exe]
363 if {[file exists $p]} {
364 set v [list $p]
365 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
366 # Try to determine what sort of magic will make
367 # git-$name go and do its thing, because native
368 # Tcl on Windows doesn't know it.
369 #
370 set p [gitexec git-$name]
371 set f [open $p r]
372 set s [gets $f]
373 close $f
374 switch -glob -- [lindex $s 0] {
376 #!*sh { set i sh }
377 #!*perl { set i perl }
378 #!*python { set i python }
379 default { error "git-$name is not supported: $s" }
380 }
381 upvar #0 _$i interp
383 if {![info exists interp]} {
384 set interp [_which $i]
385 }
386 if {$interp eq {}} {
387 error "git-$name requires $i (not in PATH)"
388 }
389 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
390 } else {
391 # Assume it is builtin to git somehow and we
392 # aren't actually able to see a file for it.
393 #
394 set v [list $::_git $name]
395 }
396 set _git_cmd_path($name) $v
397 }
398 return $v
399}
400proc _which {what args} {
402 global env _search_exe _search_path
403 if {$_search_path eq {}} {
405 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
406 set _search_path [split [exec cygpath \
407 --windows \
408 --path \
409 --absolute \
410 $env(PATH)] {;}]
411 set _search_exe .exe
412 } elseif {[is_Windows]} {
413 set gitguidir [file dirname [info script]]
414 regsub -all ";" $gitguidir "\\;" gitguidir
415 set env(PATH) "$gitguidir;$env(PATH)"
416 set _search_path [split $env(PATH) {;}]
417 set _search_exe .exe
418 } else {
419 set _search_path [split $env(PATH) :]
420 set _search_exe {}
421 }
422 }
423 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
425 set suffix {}
426 } else {
427 set suffix $_search_exe
428 }
429 foreach p $_search_path {
431 set p [file join $p $what$suffix]
432 if {[file exists $p]} {
433 return [file normalize $p]
434 }
435 }
436 return {}
437}
438proc _lappend_nice {cmd_var} {
440 global _nice
441 upvar $cmd_var cmd
442 if {![info exists _nice]} {
444 set _nice [_which nice]
445 if {[catch {exec $_nice git version}]} {
446 set _nice {}
447 }
448 }
449 if {$_nice ne {}} {
450 lappend cmd $_nice
451 }
452}
453proc git {args} {
455 set opt [list]
456 while {1} {
458 switch -- [lindex $args 0] {
459 --nice {
460 _lappend_nice opt
461 }
462 default {
464 break
465 }
466 }
468 set args [lrange $args 1 end]
470 }
471 set cmdp [_git_cmd [lindex $args 0]]
473 set args [lrange $args 1 end]
474 _trace_exec [concat $opt $cmdp $args]
476 set result [eval exec $opt $cmdp $args]
477 if {$::_trace} {
478 puts stderr "< $result"
479 }
480 return $result
481}
482proc _open_stdout_stderr {cmd} {
484 _trace_exec $cmd
485 if {[catch {
486 set fd [open [concat [list | ] $cmd] r]
487 } err]} {
488 if { [lindex $cmd end] eq {2>@1}
489 && $err eq {can not find channel named "1"}
490 } {
491 # Older versions of Tcl 8.4 don't have this 2>@1 IO
492 # redirect operator. Fallback to |& cat for those.
493 # The command was not actually started, so its safe
494 # to try to start it a second time.
495 #
496 set fd [open [concat \
497 [list | ] \
498 [lrange $cmd 0 end-1] \
499 [list |& cat] \
500 ] r]
501 } else {
502 error $err
503 }
504 }
505 fconfigure $fd -eofchar {}
506 return $fd
507}
508proc git_read {args} {
510 set opt [list]
511 while {1} {
513 switch -- [lindex $args 0] {
514 --nice {
515 _lappend_nice opt
516 }
517 --stderr {
519 lappend args 2>@1
520 }
521 default {
523 break
524 }
525 }
527 set args [lrange $args 1 end]
529 }
530 set cmdp [_git_cmd [lindex $args 0]]
532 set args [lrange $args 1 end]
533 return [_open_stdout_stderr [concat $opt $cmdp $args]]
535}
536proc git_write {args} {
538 set opt [list]
539 while {1} {
541 switch -- [lindex $args 0] {
542 --nice {
543 _lappend_nice opt
544 }
545 default {
547 break
548 }
549 }
551 set args [lrange $args 1 end]
553 }
554 set cmdp [_git_cmd [lindex $args 0]]
556 set args [lrange $args 1 end]
557 _trace_exec [concat $opt $cmdp $args]
559 return [open [concat [list | ] $opt $cmdp $args] w]
560}
561proc githook_read {hook_name args} {
563 set pchook [gitdir hooks $hook_name]
564 lappend args 2>@1
565 # On Windows [file executable] might lie so we need to ask
567 # the shell if the hook is executable. Yes that's annoying.
568 #
569 if {[is_Windows]} {
570 upvar #0 _sh interp
571 if {![info exists interp]} {
572 set interp [_which sh]
573 }
574 if {$interp eq {}} {
575 error "hook execution requires sh (not in PATH)"
576 }
577 set scr {if test -x "$1";then exec "$@";fi}
579 set sh_c [list $interp -c $scr $interp $pchook]
580 return [_open_stdout_stderr [concat $sh_c $args]]
581 }
582 if {[file executable $pchook]} {
584 return [_open_stdout_stderr [concat [list $pchook] $args]]
585 }
586 return {}
588}
589proc kill_file_process {fd} {
591 set process [pid $fd]
592 catch {
594 if {[is_Windows]} {
595 # Use a Cygwin-specific flag to allow killing
596 # native Windows processes
597 exec kill -f $process
598 } else {
599 exec kill $process
600 }
601 }
602}
603proc gitattr {path attr default} {
605 if {[catch {set r [git check-attr $attr -- $path]}]} {
606 set r unspecified
607 } else {
608 set r [join [lrange [split $r :] 2 end] :]
609 regsub {^ } $r {} r
610 }
611 if {$r eq {unspecified}} {
612 return $default
613 }
614 return $r
615}
616proc sq {value} {
618 regsub -all ' $value "'\\''" value
619 return "'$value'"
620}
621proc load_current_branch {} {
623 global current_branch is_detached
624 set fd [open [gitdir HEAD] r]
626 if {[gets $fd ref] < 1} {
627 set ref {}
628 }
629 close $fd
630 set pfx {ref: refs/heads/}
632 set len [string length $pfx]
633 if {[string equal -length $len $pfx $ref]} {
634 # We're on a branch. It might not exist. But
635 # HEAD looks good enough to be a branch.
636 #
637 set current_branch [string range $ref $len end]
638 set is_detached 0
639 } else {
640 # Assume this is a detached head.
641 #
642 set current_branch HEAD
643 set is_detached 1
644 }
645}
646auto_load tk_optionMenu
648rename tk_optionMenu real__tkOptionMenu
649proc tk_optionMenu {w varName args} {
650 set m [eval real__tkOptionMenu $w $varName $args]
651 $m configure -font font_ui
652 $w configure -font font_ui
653 return $m
654}
655proc rmsel_tag {text} {
657 $text tag conf sel \
658 -background [$text cget -background] \
659 -foreground [$text cget -foreground] \
660 -borderwidth 0
661 $text tag conf in_sel -background lightgray
662 bind $text <Motion> break
663 return $text
664}
665wm withdraw .
667set root_exists 0
668bind . <Visibility> {
669 bind . <Visibility> {}
670 set root_exists 1
671}
672if {[is_Windows]} {
674 wm iconbitmap . -default $oguilib/git-gui.ico
675 set ::tk::AlwaysShowSelection 1
676 # Spoof an X11 display for SSH
678 if {![info exists env(DISPLAY)]} {
679 set env(DISPLAY) :9999
680 }
681} else {
682 catch {
683 image create photo gitlogo -width 16 -height 16
684 gitlogo put #33CC33 -to 7 0 9 2
686 gitlogo put #33CC33 -to 4 2 12 4
687 gitlogo put #33CC33 -to 7 4 9 6
688 gitlogo put #CC3333 -to 4 6 12 8
689 gitlogo put gray26 -to 4 9 6 10
690 gitlogo put gray26 -to 3 10 6 12
691 gitlogo put gray26 -to 8 9 13 11
692 gitlogo put gray26 -to 8 11 10 12
693 gitlogo put gray26 -to 11 11 13 14
694 gitlogo put gray26 -to 3 12 5 14
695 gitlogo put gray26 -to 5 13
696 gitlogo put gray26 -to 10 13
697 gitlogo put gray26 -to 4 14 12 15
698 gitlogo put gray26 -to 5 15 11 16
699 gitlogo redither
700 wm iconphoto . -default gitlogo
702 }
703}
704######################################################################
706##
707## config defaults
708set cursor_ptr arrow
710font create font_ui
711if {[lsearch -exact [font names] TkDefaultFont] != -1} {
712 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
713 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
714} else {
715 font create font_diff -family Courier -size 10
716 catch {
717 label .dummy
718 eval font configure font_ui [font actual [.dummy cget -font]]
719 destroy .dummy
720 }
721}
722font create font_uiitalic
724font create font_uibold
725font create font_diffbold
726font create font_diffitalic
727foreach class {Button Checkbutton Entry Label
729 Labelframe Listbox Message
730 Radiobutton Spinbox Text} {
731 option add *$class.font font_ui
732}
733if {![is_MacOSX]} {
734 option add *Menu.font font_ui
735 option add *Entry.borderWidth 1 startupFile
736 option add *Entry.relief sunken startupFile
737 option add *RadioButton.anchor w startupFile
738}
739unset class
740if {[is_Windows] || [is_MacOSX]} {
742 option add *Menu.tearOff 0
743}
744if {[is_MacOSX]} {
746 set M1B M1
747 set M1T Cmd
748} else {
749 set M1B Control
750 set M1T Ctrl
751}
752proc bind_button3 {w cmd} {
754 bind $w <Any-Button-3> $cmd
755 if {[is_MacOSX]} {
756 # Mac OS X sends Button-2 on right click through three-button mouse,
757 # or through trackpad right-clicking (two-finger touch + click).
758 bind $w <Any-Button-2> $cmd
759 bind $w <Control-Button-1> $cmd
760 }
761}
762proc apply_config {} {
764 global repo_config font_descs
765 foreach option $font_descs {
767 set name [lindex $option 0]
768 set font [lindex $option 1]
769 if {[catch {
770 set need_weight 1
771 foreach {cn cv} $repo_config(gui.$name) {
772 if {$cn eq {-weight}} {
773 set need_weight 0
774 }
775 font configure $font $cn $cv
776 }
777 if {$need_weight} {
778 font configure $font -weight normal
779 }
780 } err]} {
781 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
782 }
783 foreach {cn cv} [font configure $font] {
784 font configure ${font}bold $cn $cv
785 font configure ${font}italic $cn $cv
786 }
787 font configure ${font}bold -weight bold
788 font configure ${font}italic -slant italic
789 }
790 global use_ttk NS
792 set use_ttk 0
793 set NS {}
794 if {$repo_config(gui.usettk)} {
795 set use_ttk [package vsatisfies [package provide Tk] 8.5]
796 if {$use_ttk} {
797 set NS ttk
798 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
799 pave_toplevel .
800 }
801 }
802}
803set default_config(branch.autosetupmerge) true
805set default_config(merge.tool) {}
806set default_config(mergetool.keepbackup) true
807set default_config(merge.diffstat) true
808set default_config(merge.summary) false
809set default_config(merge.verbosity) 2
810set default_config(user.name) {}
811set default_config(user.email) {}
812set default_config(gui.encoding) [encoding system]
814set default_config(gui.matchtrackingbranch) false
815set default_config(gui.textconv) true
816set default_config(gui.pruneduringfetch) false
817set default_config(gui.trustmtime) false
818set default_config(gui.fastcopyblame) false
819set default_config(gui.copyblamethreshold) 40
820set default_config(gui.blamehistoryctx) 7
821set default_config(gui.diffcontext) 5
822set default_config(gui.commitmsgwidth) 75
823set default_config(gui.newbranchtemplate) {}
824set default_config(gui.spellingdictionary) {}
825set default_config(gui.fontui) [font configure font_ui]
826set default_config(gui.fontdiff) [font configure font_diff]
827# TODO: this option should be added to the git-config documentation
828set default_config(gui.maxfilesdisplayed) 5000
829set default_config(gui.usettk) 1
830set font_descs {
831 {fontui font_ui {mc "Main Font"}}
832 {fontdiff font_diff {mc "Diff/Console Font"}}
833}
834######################################################################
836##
837## find git
838set _git [_which git]
840if {$_git eq {}} {
841 catch {wm withdraw .}
842 tk_messageBox \
843 -icon error \
844 -type ok \
845 -title [mc "git-gui: fatal error"] \
846 -message [mc "Cannot find git in PATH."]
847 exit 1
848}
849######################################################################
851##
852## version check
853if {[catch {set _git_version [git --version]} err]} {
855 catch {wm withdraw .}
856 tk_messageBox \
857 -icon error \
858 -type ok \
859 -title [mc "git-gui: fatal error"] \
860 -message "Cannot determine Git version:
861$err
863[appname] requires Git 1.5.0 or later."
865 exit 1
866}
867if {![regsub {^git version } $_git_version {} _git_version]} {
868 catch {wm withdraw .}
869 tk_messageBox \
870 -icon error \
871 -type ok \
872 -title [mc "git-gui: fatal error"] \
873 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
874 exit 1
875}
876set _real_git_version $_git_version
878regsub -- {[\-\.]dirty$} $_git_version {} _git_version
879regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
880regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
881regsub {\.GIT$} $_git_version {} _git_version
882regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
883if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
885 catch {wm withdraw .}
886 if {[tk_messageBox \
887 -icon warning \
888 -type yesno \
889 -default no \
890 -title "[appname]: warning" \
891 -message [mc "Git version cannot be determined.
892%s claims it is version '%s'.
894%s requires at least Git 1.5.0 or later.
896Assume '%s' is version 1.5.0?
898" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
899 set _git_version 1.5.0
900 } else {
901 exit 1
902 }
903}
904unset _real_git_version
905proc git-version {args} {
907 global _git_version
908 switch [llength $args] {
910 0 {
911 return $_git_version
912 }
913 2 {
915 set op [lindex $args 0]
916 set vr [lindex $args 1]
917 set cm [package vcompare $_git_version $vr]
918 return [expr $cm $op 0]
919 }
920 4 {
922 set type [lindex $args 0]
923 set name [lindex $args 1]
924 set parm [lindex $args 2]
925 set body [lindex $args 3]
926 if {($type ne {proc} && $type ne {method})} {
928 error "Invalid arguments to git-version"
929 }
930 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
931 error "Last arm of $type $name must be default"
932 }
933 foreach {op vr cb} [lrange $body 0 end-2] {
935 if {[git-version $op $vr]} {
936 return [uplevel [list $type $name $parm $cb]]
937 }
938 }
939 return [uplevel [list $type $name $parm [lindex $body end]]]
941 }
942 default {
944 error "git-version >= x"
945 }
946 }
948}
949if {[git-version < 1.5]} {
951 catch {wm withdraw .}
952 tk_messageBox \
953 -icon error \
954 -type ok \
955 -title [mc "git-gui: fatal error"] \
956 -message "[appname] requires Git 1.5.0 or later.
957You are using [git-version]:
959[git --version]"
961 exit 1
962}
963######################################################################
965##
966## configure our library
967set idx [file join $oguilib tclIndex]
969if {[catch {set fd [open $idx r]} err]} {
970 catch {wm withdraw .}
971 tk_messageBox \
972 -icon error \
973 -type ok \
974 -title [mc "git-gui: fatal error"] \
975 -message $err
976 exit 1
977}
978if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
979 set idx [list]
980 while {[gets $fd n] >= 0} {
981 if {$n ne {} && ![string match #* $n]} {
982 lappend idx $n
983 }
984 }
985} else {
986 set idx {}
987}
988close $fd
989if {$idx ne {}} {
991 set loaded [list]
992 foreach p $idx {
993 if {[lsearch -exact $loaded $p] >= 0} continue
994 source [file join $oguilib $p]
995 lappend loaded $p
996 }
997 unset loaded p
998} else {
999 set auto_path [concat [list $oguilib] $auto_path]
1000}
1001unset -nocomplain idx fd
1002######################################################################
1004##
1005## config file parsing
1006git-version proc _parse_config {arr_name args} {
1008 >= 1.5.3 {
1009 upvar $arr_name arr
1010 array unset arr
1011 set buf {}
1012 catch {
1013 set fd_rc [eval \
1014 [list git_read config] \
1015 $args \
1016 [list --null --list]]
1017 fconfigure $fd_rc -translation binary
1018 set buf [read $fd_rc]
1019 close $fd_rc
1020 }
1021 foreach line [split $buf "\0"] {
1022 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1023 if {[is_many_config $name]} {
1024 lappend arr($name) $value
1025 } else {
1026 set arr($name) $value
1027 }
1028 }
1029 }
1030 }
1031 default {
1032 upvar $arr_name arr
1033 array unset arr
1034 catch {
1035 set fd_rc [eval [list git_read config --list] $args]
1036 while {[gets $fd_rc line] >= 0} {
1037 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1038 if {[is_many_config $name]} {
1039 lappend arr($name) $value
1040 } else {
1041 set arr($name) $value
1042 }
1043 }
1044 }
1045 close $fd_rc
1046 }
1047 }
1048}
1049proc load_config {include_global} {
1051 global repo_config global_config system_config default_config
1052 if {$include_global} {
1054 _parse_config system_config --system
1055 _parse_config global_config --global
1056 }
1057 _parse_config repo_config
1058 foreach name [array names default_config] {
1060 if {[catch {set v $system_config($name)}]} {
1061 set system_config($name) $default_config($name)
1062 }
1063 }
1064 foreach name [array names system_config] {
1065 if {[catch {set v $global_config($name)}]} {
1066 set global_config($name) $system_config($name)
1067 }
1068 if {[catch {set v $repo_config($name)}]} {
1069 set repo_config($name) $system_config($name)
1070 }
1071 }
1072}
1073######################################################################
1075##
1076## feature option selection
1077if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1079 unset _junk
1080} else {
1081 set subcommand gui
1082}
1083if {$subcommand eq {gui.sh}} {
1084 set subcommand gui
1085}
1086if {$subcommand eq {gui} && [llength $argv] > 0} {
1087 set subcommand [lindex $argv 0]
1088 set argv [lrange $argv 1 end]
1089}
1090enable_option multicommit
1092enable_option branch
1093enable_option transport
1094disable_option bare
1095switch -- $subcommand {
1097browser -
1098blame {
1099 enable_option bare
1100 disable_option multicommit
1102 disable_option branch
1103 disable_option transport
1104}
1105citool {
1106 enable_option singlecommit
1107 enable_option retcode
1108 disable_option multicommit
1110 disable_option branch
1111 disable_option transport
1112 while {[llength $argv] > 0} {
1114 set a [lindex $argv 0]
1115 switch -- $a {
1116 --amend {
1117 enable_option initialamend
1118 }
1119 --nocommit {
1120 enable_option nocommit
1121 enable_option nocommitmsg
1122 }
1123 --commitmsg {
1124 disable_option nocommitmsg
1125 }
1126 default {
1127 break
1128 }
1129 }
1130 set argv [lrange $argv 1 end]
1132 }
1133}
1134}
1135######################################################################
1137##
1138## execution environment
1139set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1141# Suggest our implementation of askpass, if none is set
1143if {![info exists env(SSH_ASKPASS)]} {
1144 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1145}
1146######################################################################
1148##
1149## repository setup
1150set picked 0
1152if {[catch {
1153 set _gitdir $env(GIT_DIR)
1154 set _prefix {}
1155 }]
1156 && [catch {
1157 # beware that from the .git dir this sets _gitdir to .
1158 # and _prefix to the empty string
1159 set _gitdir [git rev-parse --git-dir]
1160 set _prefix [git rev-parse --show-prefix]
1161 } err]} {
1162 load_config 1
1163 apply_config
1164 choose_repository::pick
1165 set picked 1
1166}
1167# we expand the _gitdir when it's just a single dot (i.e. when we're being
1169# run from the .git dir itself) lest the routines to find the worktree
1170# get confused
1171if {$_gitdir eq "."} {
1172 set _gitdir [pwd]
1173}
1174if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1176 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1177}
1178if {![file isdirectory $_gitdir]} {
1179 catch {wm withdraw .}
1180 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1181 exit 1
1182}
1183# _gitdir exists, so try loading the config
1184load_config 0
1185apply_config
1186# try to set work tree from environment, falling back to core.worktree
1187if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1188 set _gitworktree [get_config core.worktree]
1189 if {$_gitworktree eq ""} {
1190 set _gitworktree [file dirname [file normalize $_gitdir]]
1191 }
1192}
1193if {$_prefix ne {}} {
1194 if {$_gitworktree eq {}} {
1195 regsub -all {[^/]+/} $_prefix ../ cdup
1196 } else {
1197 set cdup $_gitworktree
1198 }
1199 if {[catch {cd $cdup} err]} {
1200 catch {wm withdraw .}
1201 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1202 exit 1
1203 }
1204 set _gitworktree [pwd]
1205 unset cdup
1206} elseif {![is_enabled bare]} {
1207 if {[is_bare]} {
1208 catch {wm withdraw .}
1209 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1210 exit 1
1211 }
1212 if {$_gitworktree eq {}} {
1213 set _gitworktree [file dirname $_gitdir]
1214 }
1215 if {[catch {cd $_gitworktree} err]} {
1216 catch {wm withdraw .}
1217 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1218 exit 1
1219 }
1220 set _gitworktree [pwd]
1221}
1222set _reponame [file split [file normalize $_gitdir]]
1223if {[lindex $_reponame end] eq {.git}} {
1224 set _reponame [lindex $_reponame end-1]
1225} else {
1226 set _reponame [lindex $_reponame end]
1227}
1228set env(GIT_DIR) $_gitdir
1230set env(GIT_WORK_TREE) $_gitworktree
1231######################################################################
1233##
1234## global init
1235set current_diff_path {}
1237set current_diff_side {}
1238set diff_actions [list]
1239set HEAD {}
1241set PARENT {}
1242set MERGE_HEAD [list]
1243set commit_type {}
1244set empty_tree {}
1245set current_branch {}
1246set is_detached 0
1247set current_diff_path {}
1248set is_3way_diff 0
1249set is_submodule_diff 0
1250set is_conflict_diff 0
1251set selected_commit_type new
1252set diff_empty_count 0
1253set nullid "0000000000000000000000000000000000000000"
1255set nullid2 "0000000000000000000000000000000000000001"
1256######################################################################
1258##
1259## task management
1260set rescan_active 0
1262set diff_active 0
1263set last_clicked {}
1264set disable_on_lock [list]
1266set index_lock_type none
1267proc lock_index {type} {
1269 global index_lock_type disable_on_lock
1270 if {$index_lock_type eq {none}} {
1272 set index_lock_type $type
1273 foreach w $disable_on_lock {
1274 uplevel #0 $w disabled
1275 }
1276 return 1
1277 } elseif {$index_lock_type eq "begin-$type"} {
1278 set index_lock_type $type
1279 return 1
1280 }
1281 return 0
1282}
1283proc unlock_index {} {
1285 global index_lock_type disable_on_lock
1286 set index_lock_type none
1288 foreach w $disable_on_lock {
1289 uplevel #0 $w normal
1290 }
1291}
1292######################################################################
1294##
1295## status
1296proc repository_state {ctvar hdvar mhvar} {
1298 global current_branch
1299 upvar $ctvar ct $hdvar hd $mhvar mh
1300 set mh [list]
1302 load_current_branch
1304 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1305 set hd {}
1306 set ct initial
1307 return
1308 }
1309 set merge_head [gitdir MERGE_HEAD]
1311 if {[file exists $merge_head]} {
1312 set ct merge
1313 set fd_mh [open $merge_head r]
1314 while {[gets $fd_mh line] >= 0} {
1315 lappend mh $line
1316 }
1317 close $fd_mh
1318 return
1319 }
1320 set ct normal
1322}
1323proc PARENT {} {
1325 global PARENT empty_tree
1326 set p [lindex $PARENT 0]
1328 if {$p ne {}} {
1329 return $p
1330 }
1331 if {$empty_tree eq {}} {
1332 set empty_tree [git mktree << {}]
1333 }
1334 return $empty_tree
1335}
1336proc force_amend {} {
1338 global selected_commit_type
1339 global HEAD PARENT MERGE_HEAD commit_type
1340 repository_state newType newHEAD newMERGE_HEAD
1342 set HEAD $newHEAD
1343 set PARENT $newHEAD
1344 set MERGE_HEAD $newMERGE_HEAD
1345 set commit_type $newType
1346 set selected_commit_type amend
1348 do_select_commit_type
1349}
1350proc rescan {after {honor_trustmtime 1}} {
1352 global HEAD PARENT MERGE_HEAD commit_type
1353 global ui_index ui_workdir ui_comm
1354 global rescan_active file_states
1355 global repo_config
1356 if {$rescan_active > 0 || ![lock_index read]} return
1358 repository_state newType newHEAD newMERGE_HEAD
1360 if {[string match amend* $commit_type]
1361 && $newType eq {normal}
1362 && $newHEAD eq $HEAD} {
1363 } else {
1364 set HEAD $newHEAD
1365 set PARENT $newHEAD
1366 set MERGE_HEAD $newMERGE_HEAD
1367 set commit_type $newType
1368 }
1369 array unset file_states
1371 if {!$::GITGUI_BCK_exists &&
1373 (![$ui_comm edit modified]
1374 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1375 if {[string match amend* $commit_type]} {
1376 } elseif {[load_message GITGUI_MSG]} {
1377 } elseif {[run_prepare_commit_msg_hook]} {
1378 } elseif {[load_message MERGE_MSG]} {
1379 } elseif {[load_message SQUASH_MSG]} {
1380 }
1381 $ui_comm edit reset
1382 $ui_comm edit modified false
1383 }
1384 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1386 rescan_stage2 {} $after
1387 } else {
1388 set rescan_active 1
1389 ui_status [mc "Refreshing file status..."]
1390 set fd_rf [git_read update-index \
1391 -q \
1392 --unmerged \
1393 --ignore-missing \
1394 --refresh \
1395 ]
1396 fconfigure $fd_rf -blocking 0 -translation binary
1397 fileevent $fd_rf readable \
1398 [list rescan_stage2 $fd_rf $after]
1399 }
1400}
1401if {[is_Cygwin]} {
1403 set is_git_info_exclude {}
1404 proc have_info_exclude {} {
1405 global is_git_info_exclude
1406 if {$is_git_info_exclude eq {}} {
1408 if {[catch {exec test -f [gitdir info exclude]}]} {
1409 set is_git_info_exclude 0
1410 } else {
1411 set is_git_info_exclude 1
1412 }
1413 }
1414 return $is_git_info_exclude
1415 }
1416} else {
1417 proc have_info_exclude {} {
1418 return [file readable [gitdir info exclude]]
1419 }
1420}
1421proc rescan_stage2 {fd after} {
1423 global rescan_active buf_rdi buf_rdf buf_rlo
1424 if {$fd ne {}} {
1426 read $fd
1427 if {![eof $fd]} return
1428 close $fd
1429 }
1430 set ls_others [list --exclude-per-directory=.gitignore]
1432 if {[have_info_exclude]} {
1433 lappend ls_others "--exclude-from=[gitdir info exclude]"
1434 }
1435 set user_exclude [get_config core.excludesfile]
1436 if {$user_exclude ne {} && [file readable $user_exclude]} {
1437 lappend ls_others "--exclude-from=$user_exclude"
1438 }
1439 set buf_rdi {}
1441 set buf_rdf {}
1442 set buf_rlo {}
1443 set rescan_active 3
1445 ui_status [mc "Scanning for modified files ..."]
1446 set fd_di [git_read diff-index --cached -z [PARENT]]
1447 set fd_df [git_read diff-files -z]
1448 set fd_lo [eval git_read ls-files --others -z $ls_others]
1449 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1451 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1452 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1453 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1454 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1455 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1456}
1457proc load_message {file} {
1459 global ui_comm
1460 set f [gitdir $file]
1462 if {[file isfile $f]} {
1463 if {[catch {set fd [open $f r]}]} {
1464 return 0
1465 }
1466 fconfigure $fd -eofchar {}
1467 set content [string trim [read $fd]]
1468 close $fd
1469 regsub -all -line {[ \r\t]+$} $content {} content
1470 $ui_comm delete 0.0 end
1471 $ui_comm insert end $content
1472 return 1
1473 }
1474 return 0
1475}
1476proc run_prepare_commit_msg_hook {} {
1478 global pch_error
1479 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1481 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1482 # empty file but existant file.
1483 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1485 if {[file isfile [gitdir MERGE_MSG]]} {
1487 set pcm_source "merge"
1488 set fd_mm [open [gitdir MERGE_MSG] r]
1489 puts -nonewline $fd_pcm [read $fd_mm]
1490 close $fd_mm
1491 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1492 set pcm_source "squash"
1493 set fd_sm [open [gitdir SQUASH_MSG] r]
1494 puts -nonewline $fd_pcm [read $fd_sm]
1495 close $fd_sm
1496 } else {
1497 set pcm_source ""
1498 }
1499 close $fd_pcm
1501 set fd_ph [githook_read prepare-commit-msg \
1503 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1504 if {$fd_ph eq {}} {
1505 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1506 return 0;
1507 }
1508 ui_status [mc "Calling prepare-commit-msg hook..."]
1510 set pch_error {}
1511 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1513 fileevent $fd_ph readable \
1514 [list prepare_commit_msg_hook_wait $fd_ph]
1515 return 1;
1517}
1518proc prepare_commit_msg_hook_wait {fd_ph} {
1520 global pch_error
1521 append pch_error [read $fd_ph]
1523 fconfigure $fd_ph -blocking 1
1524 if {[eof $fd_ph]} {
1525 if {[catch {close $fd_ph}]} {
1526 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1527 hook_failed_popup prepare-commit-msg $pch_error
1528 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1529 exit 1
1530 } else {
1531 load_message PREPARE_COMMIT_MSG
1532 }
1533 set pch_error {}
1534 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1535 return
1536 }
1537 fconfigure $fd_ph -blocking 0
1538 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1539}
1540proc read_diff_index {fd after} {
1542 global buf_rdi
1543 append buf_rdi [read $fd]
1545 set c 0
1546 set n [string length $buf_rdi]
1547 while {$c < $n} {
1548 set z1 [string first "\0" $buf_rdi $c]
1549 if {$z1 == -1} break
1550 incr z1
1551 set z2 [string first "\0" $buf_rdi $z1]
1552 if {$z2 == -1} break
1553 incr c
1555 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1556 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1557 merge_state \
1558 [encoding convertfrom $p] \
1559 [lindex $i 4]? \
1560 [list [lindex $i 0] [lindex $i 2]] \
1561 [list]
1562 set c $z2
1563 incr c
1564 }
1565 if {$c < $n} {
1566 set buf_rdi [string range $buf_rdi $c end]
1567 } else {
1568 set buf_rdi {}
1569 }
1570 rescan_done $fd buf_rdi $after
1572}
1573proc read_diff_files {fd after} {
1575 global buf_rdf
1576 append buf_rdf [read $fd]
1578 set c 0
1579 set n [string length $buf_rdf]
1580 while {$c < $n} {
1581 set z1 [string first "\0" $buf_rdf $c]
1582 if {$z1 == -1} break
1583 incr z1
1584 set z2 [string first "\0" $buf_rdf $z1]
1585 if {$z2 == -1} break
1586 incr c
1588 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1589 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1590 merge_state \
1591 [encoding convertfrom $p] \
1592 ?[lindex $i 4] \
1593 [list] \
1594 [list [lindex $i 0] [lindex $i 2]]
1595 set c $z2
1596 incr c
1597 }
1598 if {$c < $n} {
1599 set buf_rdf [string range $buf_rdf $c end]
1600 } else {
1601 set buf_rdf {}
1602 }
1603 rescan_done $fd buf_rdf $after
1605}
1606proc read_ls_others {fd after} {
1608 global buf_rlo
1609 append buf_rlo [read $fd]
1611 set pck [split $buf_rlo "\0"]
1612 set buf_rlo [lindex $pck end]
1613 foreach p [lrange $pck 0 end-1] {
1614 set p [encoding convertfrom $p]
1615 if {[string index $p end] eq {/}} {
1616 set p [string range $p 0 end-1]
1617 }
1618 merge_state $p ?O
1619 }
1620 rescan_done $fd buf_rlo $after
1621}
1622proc rescan_done {fd buf after} {
1624 global rescan_active current_diff_path
1625 global file_states repo_config
1626 upvar $buf to_clear
1627 if {![eof $fd]} return
1629 set to_clear {}
1630 close $fd
1631 if {[incr rescan_active -1] > 0} return
1632 prune_selection
1634 unlock_index
1635 display_all_files
1636 if {$current_diff_path ne {}} { reshow_diff $after }
1637 if {$current_diff_path eq {}} { select_first_diff $after }
1638}
1639proc prune_selection {} {
1641 global file_states selected_paths
1642 foreach path [array names selected_paths] {
1644 if {[catch {set still_here $file_states($path)}]} {
1645 unset selected_paths($path)
1646 }
1647 }
1648}
1649######################################################################
1651##
1652## ui helpers
1653proc mapicon {w state path} {
1655 global all_icons
1656 if {[catch {set r $all_icons($state$w)}]} {
1658 puts "error: no icon for $w state={$state} $path"
1659 return file_plain
1660 }
1661 return $r
1662}
1663proc mapdesc {state path} {
1665 global all_descs
1666 if {[catch {set r $all_descs($state)}]} {
1668 puts "error: no desc for state={$state} $path"
1669 return $state
1670 }
1671 return $r
1672}
1673proc ui_status {msg} {
1675 global main_status
1676 if {[info exists main_status]} {
1677 $main_status show $msg
1678 }
1679}
1680proc ui_ready {{test {}}} {
1682 global main_status
1683 if {[info exists main_status]} {
1684 $main_status show [mc "Ready."] $test
1685 }
1686}
1687proc escape_path {path} {
1689 regsub -all {\\} $path "\\\\" path
1690 regsub -all "\n" $path "\\n" path
1691 return $path
1692}
1693proc short_path {path} {
1695 return [escape_path [lindex [file split $path] end]]
1696}
1697set next_icon_id 0
1699set null_sha1 [string repeat 0 40]
1700proc merge_state {path new_state {head_info {}} {index_info {}}} {
1702 global file_states next_icon_id null_sha1
1703 set s0 [string index $new_state 0]
1705 set s1 [string index $new_state 1]
1706 if {[catch {set info $file_states($path)}]} {
1708 set state __
1709 set icon n[incr next_icon_id]
1710 } else {
1711 set state [lindex $info 0]
1712 set icon [lindex $info 1]
1713 if {$head_info eq {}} {set head_info [lindex $info 2]}
1714 if {$index_info eq {}} {set index_info [lindex $info 3]}
1715 }
1716 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1718 elseif {$s0 eq {_}} {set s0 _}
1719 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1721 elseif {$s1 eq {_}} {set s1 _}
1722 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1724 set head_info [list 0 $null_sha1]
1725 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1726 && $head_info eq {}} {
1727 set head_info $index_info
1728 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1729 set index_info $head_info
1730 set head_info {}
1731 }
1732 set file_states($path) [list $s0$s1 $icon \
1734 $head_info $index_info \
1735 ]
1736 return $state
1737}
1738proc display_file_helper {w path icon_name old_m new_m} {
1740 global file_lists
1741 if {$new_m eq {_}} {
1743 set lno [lsearch -sorted -exact $file_lists($w) $path]
1744 if {$lno >= 0} {
1745 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1746 incr lno
1747 $w conf -state normal
1748 $w delete $lno.0 [expr {$lno + 1}].0
1749 $w conf -state disabled
1750 }
1751 } elseif {$old_m eq {_} && $new_m ne {_}} {
1752 lappend file_lists($w) $path
1753 set file_lists($w) [lsort -unique $file_lists($w)]
1754 set lno [lsearch -sorted -exact $file_lists($w) $path]
1755 incr lno
1756 $w conf -state normal
1757 $w image create $lno.0 \
1758 -align center -padx 5 -pady 1 \
1759 -name $icon_name \
1760 -image [mapicon $w $new_m $path]
1761 $w insert $lno.1 "[escape_path $path]\n"
1762 $w conf -state disabled
1763 } elseif {$old_m ne $new_m} {
1764 $w conf -state normal
1765 $w image conf $icon_name -image [mapicon $w $new_m $path]
1766 $w conf -state disabled
1767 }
1768}
1769proc display_file {path state} {
1771 global file_states selected_paths
1772 global ui_index ui_workdir
1773 set old_m [merge_state $path $state]
1775 set s $file_states($path)
1776 set new_m [lindex $s 0]
1777 set icon_name [lindex $s 1]
1778 set o [string index $old_m 0]
1780 set n [string index $new_m 0]
1781 if {$o eq {U}} {
1782 set o _
1783 }
1784 if {$n eq {U}} {
1785 set n _
1786 }
1787 display_file_helper $ui_index $path $icon_name $o $n
1788 if {[string index $old_m 0] eq {U}} {
1790 set o U
1791 } else {
1792 set o [string index $old_m 1]
1793 }
1794 if {[string index $new_m 0] eq {U}} {
1795 set n U
1796 } else {
1797 set n [string index $new_m 1]
1798 }
1799 display_file_helper $ui_workdir $path $icon_name $o $n
1800 if {$new_m eq {__}} {
1802 unset file_states($path)
1803 catch {unset selected_paths($path)}
1804 }
1805}
1806proc display_all_files_helper {w path icon_name m} {
1808 global file_lists
1809 lappend file_lists($w) $path
1811 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1812 $w image create end \
1813 -align center -padx 5 -pady 1 \
1814 -name $icon_name \
1815 -image [mapicon $w $m $path]
1816 $w insert end "[escape_path $path]\n"
1817}
1818set files_warning 0
1820proc display_all_files {} {
1821 global ui_index ui_workdir
1822 global file_states file_lists
1823 global last_clicked
1824 global files_warning
1825 $ui_index conf -state normal
1827 $ui_workdir conf -state normal
1828 $ui_index delete 0.0 end
1830 $ui_workdir delete 0.0 end
1831 set last_clicked {}
1832 set file_lists($ui_index) [list]
1834 set file_lists($ui_workdir) [list]
1835 set to_display [lsort [array names file_states]]
1837 set display_limit [get_config gui.maxfilesdisplayed]
1838 if {[llength $to_display] > $display_limit} {
1839 if {!$files_warning} {
1840 # do not repeatedly warn:
1841 set files_warning 1
1842 info_popup [mc "Displaying only %s of %s files." \
1843 $display_limit [llength $to_display]]
1844 }
1845 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1846 }
1847 foreach path $to_display {
1848 set s $file_states($path)
1849 set m [lindex $s 0]
1850 set icon_name [lindex $s 1]
1851 set s [string index $m 0]
1853 if {$s ne {U} && $s ne {_}} {
1854 display_all_files_helper $ui_index $path \
1855 $icon_name $s
1856 }
1857 if {[string index $m 0] eq {U}} {
1859 set s U
1860 } else {
1861 set s [string index $m 1]
1862 }
1863 if {$s ne {_}} {
1864 display_all_files_helper $ui_workdir $path \
1865 $icon_name $s
1866 }
1867 }
1868 $ui_index conf -state disabled
1870 $ui_workdir conf -state disabled
1871}
1872######################################################################
1874##
1875## icons
1876set filemask {
1878#define mask_width 14
1879#define mask_height 15
1880static unsigned char mask_bits[] = {
1881 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1882 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1883 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1884}
1885image create bitmap file_plain -background white -foreground black -data {
1887#define plain_width 14
1888#define plain_height 15
1889static unsigned char plain_bits[] = {
1890 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1891 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1892 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1893} -maskdata $filemask
1894image create bitmap file_mod -background white -foreground blue -data {
1896#define mod_width 14
1897#define mod_height 15
1898static unsigned char mod_bits[] = {
1899 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1900 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1901 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1902} -maskdata $filemask
1903image create bitmap file_fulltick -background white -foreground "#007000" -data {
1905#define file_fulltick_width 14
1906#define file_fulltick_height 15
1907static unsigned char file_fulltick_bits[] = {
1908 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1909 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1910 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1911} -maskdata $filemask
1912image create bitmap file_question -background white -foreground black -data {
1914#define file_question_width 14
1915#define file_question_height 15
1916static unsigned char file_question_bits[] = {
1917 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1918 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1919 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1920} -maskdata $filemask
1921image create bitmap file_removed -background white -foreground red -data {
1923#define file_removed_width 14
1924#define file_removed_height 15
1925static unsigned char file_removed_bits[] = {
1926 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1927 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1928 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1929} -maskdata $filemask
1930image create bitmap file_merge -background white -foreground blue -data {
1932#define file_merge_width 14
1933#define file_merge_height 15
1934static unsigned char file_merge_bits[] = {
1935 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1936 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1937 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1938} -maskdata $filemask
1939image create bitmap file_statechange -background white -foreground green -data {
1941#define file_merge_width 14
1942#define file_merge_height 15
1943static unsigned char file_statechange_bits[] = {
1944 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1945 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1946 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1947} -maskdata $filemask
1948set ui_index .vpane.files.index.list
1950set ui_workdir .vpane.files.workdir.list
1951set all_icons(_$ui_index) file_plain
1953set all_icons(A$ui_index) file_plain
1954set all_icons(M$ui_index) file_fulltick
1955set all_icons(D$ui_index) file_removed
1956set all_icons(U$ui_index) file_merge
1957set all_icons(T$ui_index) file_statechange
1958set all_icons(_$ui_workdir) file_plain
1960set all_icons(M$ui_workdir) file_mod
1961set all_icons(D$ui_workdir) file_question
1962set all_icons(U$ui_workdir) file_merge
1963set all_icons(O$ui_workdir) file_plain
1964set all_icons(T$ui_workdir) file_statechange
1965set max_status_desc 0
1967foreach i {
1968 {__ {mc "Unmodified"}}
1969 {_M {mc "Modified, not staged"}}
1971 {M_ {mc "Staged for commit"}}
1972 {MM {mc "Portions staged for commit"}}
1973 {MD {mc "Staged for commit, missing"}}
1974 {_T {mc "File type changed, not staged"}}
1976 {T_ {mc "File type changed, staged"}}
1977 {_O {mc "Untracked, not staged"}}
1979 {A_ {mc "Staged for commit"}}
1980 {AM {mc "Portions staged for commit"}}
1981 {AD {mc "Staged for commit, missing"}}
1982 {_D {mc "Missing"}}
1984 {D_ {mc "Staged for removal"}}
1985 {DO {mc "Staged for removal, still present"}}
1986 {_U {mc "Requires merge resolution"}}
1988 {U_ {mc "Requires merge resolution"}}
1989 {UU {mc "Requires merge resolution"}}
1990 {UM {mc "Requires merge resolution"}}
1991 {UD {mc "Requires merge resolution"}}
1992 {UT {mc "Requires merge resolution"}}
1993 } {
1994 set text [eval [lindex $i 1]]
1995 if {$max_status_desc < [string length $text]} {
1996 set max_status_desc [string length $text]
1997 }
1998 set all_descs([lindex $i 0]) $text
1999}
2000unset i
2001######################################################################
2003##
2004## util
2005proc scrollbar2many {list mode args} {
2007 foreach w $list {eval $w $mode $args}
2008}
2009proc many2scrollbar {list mode sb top bottom} {
2011 $sb set $top $bottom
2012 foreach w $list {$w $mode moveto $top}
2013}
2014proc incr_font_size {font {amt 1}} {
2016 set sz [font configure $font -size]
2017 incr sz $amt
2018 font configure $font -size $sz
2019 font configure ${font}bold -size $sz
2020 font configure ${font}italic -size $sz
2021}
2022######################################################################
2024##
2025## ui commands
2026set starting_gitk_msg [mc "Starting gitk... please wait..."]
2028proc do_gitk {revs {is_submodule false}} {
2030 global current_diff_path file_states current_diff_side ui_index
2031 global _gitdir _gitworktree
2032 # -- Always start gitk through whatever we were loaded with. This
2034 # lets us bypass using shell process on Windows systems.
2035 #
2036 set exe [_which gitk -script]
2037 set cmd [list [info nameofexecutable] $exe]
2038 if {$exe eq {}} {
2039 error_popup [mc "Couldn't find gitk in PATH"]
2040 } else {
2041 global env
2042 set pwd [pwd]
2044 if {!$is_submodule} {
2046 if {![is_bare]} {
2047 cd $_gitworktree
2048 }
2049 } else {
2050 cd $current_diff_path
2051 if {$revs eq {--}} {
2052 set s $file_states($current_diff_path)
2053 set old_sha1 {}
2054 set new_sha1 {}
2055 switch -glob -- [lindex $s 0] {
2056 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2057 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2058 MM {
2059 if {$current_diff_side eq $ui_index} {
2060 set old_sha1 [lindex [lindex $s 2] 1]
2061 set new_sha1 [lindex [lindex $s 3] 1]
2062 } else {
2063 set old_sha1 [lindex [lindex $s 3] 1]
2064 }
2065 }
2066 }
2067 set revs $old_sha1...$new_sha1
2068 }
2069 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2070 # we've been using for the main repository, so unset them.
2071 # TODO we could make life easier (start up faster?) for gitk
2072 # by setting these to the appropriate values to allow gitk
2073 # to skip the heuristics to find their proper value
2074 unset env(GIT_DIR)
2075 unset env(GIT_WORK_TREE)
2076 }
2077 eval exec $cmd $revs "--" "--" &
2078 set env(GIT_DIR) $_gitdir
2080 set env(GIT_WORK_TREE) $_gitworktree
2081 cd $pwd
2082 ui_status $::starting_gitk_msg
2084 after 10000 {
2085 ui_ready $starting_gitk_msg
2086 }
2087 }
2088}
2089proc do_git_gui {} {
2091 global current_diff_path
2092 # -- Always start git gui through whatever we were loaded with. This
2094 # lets us bypass using shell process on Windows systems.
2095 #
2096 set exe [list [_which git]]
2097 if {$exe eq {}} {
2098 error_popup [mc "Couldn't find git gui in PATH"]
2099 } else {
2100 global env
2101 global _gitdir _gitworktree
2102 # see note in do_gitk about unsetting these vars when
2104 # running tools in a submodule
2105 unset env(GIT_DIR)
2106 unset env(GIT_WORK_TREE)
2107 set pwd [pwd]
2109 cd $current_diff_path
2110 eval exec $exe gui &
2112 set env(GIT_DIR) $_gitdir
2114 set env(GIT_WORK_TREE) $_gitworktree
2115 cd $pwd
2116 ui_status $::starting_gitk_msg
2118 after 10000 {
2119 ui_ready $starting_gitk_msg
2120 }
2121 }
2122}
2123proc do_explore {} {
2125 global _gitworktree
2126 set explorer {}
2127 if {[is_Cygwin] || [is_Windows]} {
2128 set explorer "explorer.exe"
2129 } elseif {[is_MacOSX]} {
2130 set explorer "open"
2131 } else {
2132 # freedesktop.org-conforming system is our best shot
2133 set explorer "xdg-open"
2134 }
2135 eval exec $explorer [list [file nativename $_gitworktree]] &
2136}
2137set is_quitting 0
2139set ret_code 1
2140proc terminate_me {win} {
2142 global ret_code
2143 if {$win ne {.}} return
2144 exit $ret_code
2145}
2146proc do_quit {{rc {1}}} {
2148 global ui_comm is_quitting repo_config commit_type
2149 global GITGUI_BCK_exists GITGUI_BCK_i
2150 global ui_comm_spell
2151 global ret_code use_ttk
2152 if {$is_quitting} return
2154 set is_quitting 1
2155 if {[winfo exists $ui_comm]} {
2157 # -- Stash our current commit buffer.
2158 #
2159 set save [gitdir GITGUI_MSG]
2160 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2161 file rename -force [gitdir GITGUI_BCK] $save
2162 set GITGUI_BCK_exists 0
2163 } else {
2164 set msg [string trim [$ui_comm get 0.0 end]]
2165 regsub -all -line {[ \r\t]+$} $msg {} msg
2166 if {(![string match amend* $commit_type]
2167 || [$ui_comm edit modified])
2168 && $msg ne {}} {
2169 catch {
2170 set fd [open $save w]
2171 puts -nonewline $fd $msg
2172 close $fd
2173 }
2174 } else {
2175 catch {file delete $save}
2176 }
2177 }
2178 # -- Cancel our spellchecker if its running.
2180 #
2181 if {[info exists ui_comm_spell]} {
2182 $ui_comm_spell stop
2183 }
2184 # -- Remove our editor backup, its not needed.
2186 #
2187 after cancel $GITGUI_BCK_i
2188 if {$GITGUI_BCK_exists} {
2189 catch {file delete [gitdir GITGUI_BCK]}
2190 }
2191 # -- Stash our current window geometry into this repository.
2193 #
2194 set cfg_wmstate [wm state .]
2195 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2196 set rc_wmstate {}
2197 }
2198 if {$cfg_wmstate ne $rc_wmstate} {
2199 catch {git config gui.wmstate $cfg_wmstate}
2200 }
2201 if {$cfg_wmstate eq {zoomed}} {
2202 # on Windows wm geometry will lie about window
2203 # position (but not size) when window is zoomed
2204 # restore the window before querying wm geometry
2205 wm state . normal
2206 }
2207 set cfg_geometry [list]
2208 lappend cfg_geometry [wm geometry .]
2209 if {$use_ttk} {
2210 lappend cfg_geometry [.vpane sashpos 0]
2211 lappend cfg_geometry [.vpane.files sashpos 0]
2212 } else {
2213 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2214 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2215 }
2216 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2217 set rc_geometry {}
2218 }
2219 if {$cfg_geometry ne $rc_geometry} {
2220 catch {git config gui.geometry $cfg_geometry}
2221 }
2222 }
2223 set ret_code $rc
2225 # Briefly enable send again, working around Tk bug
2227 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2228 tk appname [appname]
2229 destroy .
2231}
2232proc do_rescan {} {
2234 rescan ui_ready
2235}
2236proc ui_do_rescan {} {
2238 rescan {force_first_diff ui_ready}
2239}
2240proc do_commit {} {
2242 commit_tree
2243}
2244proc next_diff {{after {}}} {
2246 global next_diff_p next_diff_w next_diff_i
2247 show_diff $next_diff_p $next_diff_w {} {} $after
2248}
2249proc find_anchor_pos {lst name} {
2251 set lid [lsearch -sorted -exact $lst $name]
2252 if {$lid == -1} {
2254 set lid 0
2255 foreach lname $lst {
2256 if {$lname >= $name} break
2257 incr lid
2258 }
2259 }
2260 return $lid
2262}
2263proc find_file_from {flist idx delta path mmask} {
2265 global file_states
2266 set len [llength $flist]
2268 while {$idx >= 0 && $idx < $len} {
2269 set name [lindex $flist $idx]
2270 if {$name ne $path && [info exists file_states($name)]} {
2272 set state [lindex $file_states($name) 0]
2273 if {$mmask eq {} || [regexp $mmask $state]} {
2275 return $idx
2276 }
2277 }
2278 incr idx $delta
2280 }
2281 return {}
2283}
2284proc find_next_diff {w path {lno {}} {mmask {}}} {
2286 global next_diff_p next_diff_w next_diff_i
2287 global file_lists ui_index ui_workdir
2288 set flist $file_lists($w)
2290 if {$lno eq {}} {
2291 set lno [find_anchor_pos $flist $path]
2292 } else {
2293 incr lno -1
2294 }
2295 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2297 if {$w eq $ui_index} {
2298 set mmask "^$mmask"
2299 } else {
2300 set mmask "$mmask\$"
2301 }
2302 }
2303 set idx [find_file_from $flist $lno 1 $path $mmask]
2305 if {$idx eq {}} {
2306 incr lno -1
2307 set idx [find_file_from $flist $lno -1 $path $mmask]
2308 }
2309 if {$idx ne {}} {
2311 set next_diff_w $w
2312 set next_diff_p [lindex $flist $idx]
2313 set next_diff_i [expr {$idx+1}]
2314 return 1
2315 } else {
2316 return 0
2317 }
2318}
2319proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2321 global current_diff_path
2322 if {$path ne $current_diff_path} {
2324 return {}
2325 } elseif {[find_next_diff $w $path $lno $mmask]} {
2326 return {next_diff;}
2327 } else {
2328 return {reshow_diff;}
2329 }
2330}
2331proc select_first_diff {after} {
2333 global ui_workdir
2334 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2336 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2337 next_diff $after
2338 } else {
2339 uplevel #0 $after
2340 }
2341}
2342proc force_first_diff {after} {
2344 global ui_workdir current_diff_path file_states
2345 if {[info exists file_states($current_diff_path)]} {
2347 set state [lindex $file_states($current_diff_path) 0]
2348 } else {
2349 set state {OO}
2350 }
2351 set reselect 0
2353 if {[string first {U} $state] >= 0} {
2354 # Already a conflict, do nothing
2355 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2356 set reselect 1
2357 } elseif {[string index $state 1] ne {O}} {
2358 # Already a diff & no conflicts, do nothing
2359 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2360 set reselect 1
2361 }
2362 if {$reselect} {
2364 next_diff $after
2365 } else {
2366 uplevel #0 $after
2367 }
2368}
2369proc toggle_or_diff {w x y} {
2371 global file_states file_lists current_diff_path ui_index ui_workdir
2372 global last_clicked selected_paths
2373 set pos [split [$w index @$x,$y] .]
2375 set lno [lindex $pos 0]
2376 set col [lindex $pos 1]
2377 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2378 if {$path eq {}} {
2379 set last_clicked {}
2380 return
2381 }
2382 set last_clicked [list $w $lno]
2384 array unset selected_paths
2385 $ui_index tag remove in_sel 0.0 end
2386 $ui_workdir tag remove in_sel 0.0 end
2387 # Determine the state of the file
2389 if {[info exists file_states($path)]} {
2390 set state [lindex $file_states($path) 0]
2391 } else {
2392 set state {__}
2393 }
2394 # Restage the file, or simply show the diff
2396 if {$col == 0 && $y > 1} {
2397 # Conflicts need special handling
2398 if {[string first {U} $state] >= 0} {
2399 # $w must always be $ui_workdir, but...
2400 if {$w ne $ui_workdir} { set lno {} }
2401 merge_stage_workdir $path $lno
2402 return
2403 }
2404 if {[string index $state 1] eq {O}} {
2406 set mmask {}
2407 } else {
2408 set mmask {[^O]}
2409 }
2410 set after [next_diff_after_action $w $path $lno $mmask]
2412 if {$w eq $ui_index} {
2414 update_indexinfo \
2415 "Unstaging [short_path $path] from commit" \
2416 [list $path] \
2417 [concat $after [list ui_ready]]
2418 } elseif {$w eq $ui_workdir} {
2419 update_index \
2420 "Adding [short_path $path]" \
2421 [list $path] \
2422 [concat $after [list ui_ready]]
2423 }
2424 } else {
2425 show_diff $path $w $lno
2426 }
2427}
2428proc add_one_to_selection {w x y} {
2430 global file_lists last_clicked selected_paths
2431 set lno [lindex [split [$w index @$x,$y] .] 0]
2433 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2434 if {$path eq {}} {
2435 set last_clicked {}
2436 return
2437 }
2438 if {$last_clicked ne {}
2440 && [lindex $last_clicked 0] ne $w} {
2441 array unset selected_paths
2442 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2443 }
2444 set last_clicked [list $w $lno]
2446 if {[catch {set in_sel $selected_paths($path)}]} {
2447 set in_sel 0
2448 }
2449 if {$in_sel} {
2450 unset selected_paths($path)
2451 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2452 } else {
2453 set selected_paths($path) 1
2454 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2455 }
2456}
2457proc add_range_to_selection {w x y} {
2459 global file_lists last_clicked selected_paths
2460 if {[lindex $last_clicked 0] ne $w} {
2462 toggle_or_diff $w $x $y
2463 return
2464 }
2465 set lno [lindex [split [$w index @$x,$y] .] 0]
2467 set lc [lindex $last_clicked 1]
2468 if {$lc < $lno} {
2469 set begin $lc
2470 set end $lno
2471 } else {
2472 set begin $lno
2473 set end $lc
2474 }
2475 foreach path [lrange $file_lists($w) \
2477 [expr {$begin - 1}] \
2478 [expr {$end - 1}]] {
2479 set selected_paths($path) 1
2480 }
2481 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2482}
2483proc show_more_context {} {
2485 global repo_config
2486 if {$repo_config(gui.diffcontext) < 99} {
2487 incr repo_config(gui.diffcontext)
2488 reshow_diff
2489 }
2490}
2491proc show_less_context {} {
2493 global repo_config
2494 if {$repo_config(gui.diffcontext) > 1} {
2495 incr repo_config(gui.diffcontext) -1
2496 reshow_diff
2497 }
2498}
2499######################################################################
2501##
2502## ui construction
2503set ui_comm {}
2505# -- Menu Bar
2507#
2508menu .mbar -tearoff 0
2509if {[is_MacOSX]} {
2510 # -- Apple Menu (Mac OS X only)
2511 #
2512 .mbar add cascade -label Apple -menu .mbar.apple
2513 menu .mbar.apple
2514}
2515.mbar add cascade -label [mc Repository] -menu .mbar.repository
2516.mbar add cascade -label [mc Edit] -menu .mbar.edit
2517if {[is_enabled branch]} {
2518 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2519}
2520if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2521 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2522}
2523if {[is_enabled transport]} {
2524 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2525 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2526}
2527if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2528 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2529}
2530# -- Repository Menu
2532#
2533menu .mbar.repository
2534if {![is_bare]} {
2536 .mbar.repository add command \
2537 -label [mc "Explore Working Copy"] \
2538 -command {do_explore}
2539 .mbar.repository add separator
2540}
2541.mbar.repository add command \
2543 -label [mc "Browse Current Branch's Files"] \
2544 -command {browser::new $current_branch}
2545set ui_browse_current [.mbar.repository index last]
2546.mbar.repository add command \
2547 -label [mc "Browse Branch Files..."] \
2548 -command browser_open::dialog
2549.mbar.repository add separator
2550.mbar.repository add command \
2552 -label [mc "Visualize Current Branch's History"] \
2553 -command {do_gitk $current_branch}
2554set ui_visualize_current [.mbar.repository index last]
2555.mbar.repository add command \
2556 -label [mc "Visualize All Branch History"] \
2557 -command {do_gitk --all}
2558.mbar.repository add separator
2559proc current_branch_write {args} {
2561 global current_branch
2562 .mbar.repository entryconf $::ui_browse_current \
2563 -label [mc "Browse %s's Files" $current_branch]
2564 .mbar.repository entryconf $::ui_visualize_current \
2565 -label [mc "Visualize %s's History" $current_branch]
2566}
2567trace add variable current_branch write current_branch_write
2568if {[is_enabled multicommit]} {
2570 .mbar.repository add command -label [mc "Database Statistics"] \
2571 -command do_stats
2572 .mbar.repository add command -label [mc "Compress Database"] \
2574 -command do_gc
2575 .mbar.repository add command -label [mc "Verify Database"] \
2577 -command do_fsck_objects
2578 .mbar.repository add separator
2580 if {[is_Cygwin]} {
2582 .mbar.repository add command \
2583 -label [mc "Create Desktop Icon"] \
2584 -command do_cygwin_shortcut
2585 } elseif {[is_Windows]} {
2586 .mbar.repository add command \
2587 -label [mc "Create Desktop Icon"] \
2588 -command do_windows_shortcut
2589 } elseif {[is_MacOSX]} {
2590 .mbar.repository add command \
2591 -label [mc "Create Desktop Icon"] \
2592 -command do_macosx_app
2593 }
2594}
2595if {[is_MacOSX]} {
2597 proc ::tk::mac::Quit {args} { do_quit }
2598} else {
2599 .mbar.repository add command -label [mc Quit] \
2600 -command do_quit \
2601 -accelerator $M1T-Q
2602}
2603# -- Edit Menu
2605#
2606menu .mbar.edit
2607.mbar.edit add command -label [mc Undo] \
2608 -command {catch {[focus] edit undo}} \
2609 -accelerator $M1T-Z
2610.mbar.edit add command -label [mc Redo] \
2611 -command {catch {[focus] edit redo}} \
2612 -accelerator $M1T-Y
2613.mbar.edit add separator
2614.mbar.edit add command -label [mc Cut] \
2615 -command {catch {tk_textCut [focus]}} \
2616 -accelerator $M1T-X
2617.mbar.edit add command -label [mc Copy] \
2618 -command {catch {tk_textCopy [focus]}} \
2619 -accelerator $M1T-C
2620.mbar.edit add command -label [mc Paste] \
2621 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2622 -accelerator $M1T-V
2623.mbar.edit add command -label [mc Delete] \
2624 -command {catch {[focus] delete sel.first sel.last}} \
2625 -accelerator Del
2626.mbar.edit add separator
2627.mbar.edit add command -label [mc "Select All"] \
2628 -command {catch {[focus] tag add sel 0.0 end}} \
2629 -accelerator $M1T-A
2630# -- Branch Menu
2632#
2633if {[is_enabled branch]} {
2634 menu .mbar.branch
2635 .mbar.branch add command -label [mc "Create..."] \
2637 -command branch_create::dialog \
2638 -accelerator $M1T-N
2639 lappend disable_on_lock [list .mbar.branch entryconf \
2640 [.mbar.branch index last] -state]
2641 .mbar.branch add command -label [mc "Checkout..."] \
2643 -command branch_checkout::dialog \
2644 -accelerator $M1T-O
2645 lappend disable_on_lock [list .mbar.branch entryconf \
2646 [.mbar.branch index last] -state]
2647 .mbar.branch add command -label [mc "Rename..."] \
2649 -command branch_rename::dialog
2650 lappend disable_on_lock [list .mbar.branch entryconf \
2651 [.mbar.branch index last] -state]
2652 .mbar.branch add command -label [mc "Delete..."] \
2654 -command branch_delete::dialog
2655 lappend disable_on_lock [list .mbar.branch entryconf \
2656 [.mbar.branch index last] -state]
2657 .mbar.branch add command -label [mc "Reset..."] \
2659 -command merge::reset_hard
2660 lappend disable_on_lock [list .mbar.branch entryconf \
2661 [.mbar.branch index last] -state]
2662}
2663# -- Commit Menu
2665#
2666proc commit_btn_caption {} {
2667 if {[is_enabled nocommit]} {
2668 return [mc "Done"]
2669 } else {
2670 return [mc Commit@@verb]
2671 }
2672}
2673if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2675 menu .mbar.commit
2676 if {![is_enabled nocommit]} {
2678 .mbar.commit add radiobutton \
2679 -label [mc "New Commit"] \
2680 -command do_select_commit_type \
2681 -variable selected_commit_type \
2682 -value new
2683 lappend disable_on_lock \
2684 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2685 .mbar.commit add radiobutton \
2687 -label [mc "Amend Last Commit"] \
2688 -command do_select_commit_type \
2689 -variable selected_commit_type \
2690 -value amend
2691 lappend disable_on_lock \
2692 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2693 .mbar.commit add separator
2695 }
2696 .mbar.commit add command -label [mc Rescan] \
2698 -command ui_do_rescan \
2699 -accelerator F5
2700 lappend disable_on_lock \
2701 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2702 .mbar.commit add command -label [mc "Stage To Commit"] \
2704 -command do_add_selection \
2705 -accelerator $M1T-T
2706 lappend disable_on_lock \
2707 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2708 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2710 -command do_add_all \
2711 -accelerator $M1T-I
2712 lappend disable_on_lock \
2713 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2714 .mbar.commit add command -label [mc "Unstage From Commit"] \
2716 -command do_unstage_selection \
2717 -accelerator $M1T-U
2718 lappend disable_on_lock \
2719 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2720 .mbar.commit add command -label [mc "Revert Changes"] \
2722 -command do_revert_selection \
2723 -accelerator $M1T-J
2724 lappend disable_on_lock \
2725 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2726 .mbar.commit add separator
2728 .mbar.commit add command -label [mc "Show Less Context"] \
2730 -command show_less_context \
2731 -accelerator $M1T-\-
2732 .mbar.commit add command -label [mc "Show More Context"] \
2734 -command show_more_context \
2735 -accelerator $M1T-=
2736 .mbar.commit add separator
2738 if {![is_enabled nocommitmsg]} {
2740 .mbar.commit add command -label [mc "Sign Off"] \
2741 -command do_signoff \
2742 -accelerator $M1T-S
2743 }
2744 .mbar.commit add command -label [commit_btn_caption] \
2746 -command do_commit \
2747 -accelerator $M1T-Return
2748 lappend disable_on_lock \
2749 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2750}
2751# -- Merge Menu
2753#
2754if {[is_enabled branch]} {
2755 menu .mbar.merge
2756 .mbar.merge add command -label [mc "Local Merge..."] \
2757 -command merge::dialog \
2758 -accelerator $M1T-M
2759 lappend disable_on_lock \
2760 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2761 .mbar.merge add command -label [mc "Abort Merge..."] \
2762 -command merge::reset_hard
2763 lappend disable_on_lock \
2764 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2765}
2766# -- Transport Menu
2768#
2769if {[is_enabled transport]} {
2770 menu .mbar.remote
2771 .mbar.remote add command \
2773 -label [mc "Add..."] \
2774 -command remote_add::dialog \
2775 -accelerator $M1T-A
2776 .mbar.remote add command \
2777 -label [mc "Push..."] \
2778 -command do_push_anywhere \
2779 -accelerator $M1T-P
2780 .mbar.remote add command \
2781 -label [mc "Delete Branch..."] \
2782 -command remote_branch_delete::dialog
2783}
2784if {[is_MacOSX]} {
2786 proc ::tk::mac::ShowPreferences {} {do_options}
2787} else {
2788 # -- Edit Menu
2789 #
2790 .mbar.edit add separator
2791 .mbar.edit add command -label [mc "Options..."] \
2792 -command do_options
2793}
2794# -- Tools Menu
2796#
2797if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2798 set tools_menubar .mbar.tools
2799 menu $tools_menubar
2800 $tools_menubar add separator
2801 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2802 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2803 set tools_tailcnt 3
2804 if {[array names repo_config guitool.*.cmd] ne {}} {
2805 tools_populate_all
2806 }
2807}
2808# -- Help Menu
2810#
2811.mbar add cascade -label [mc Help] -menu .mbar.help
2812menu .mbar.help
2813if {[is_MacOSX]} {
2815 .mbar.apple add command -label [mc "About %s" [appname]] \
2816 -command do_about
2817 .mbar.apple add separator
2818} else {
2819 .mbar.help add command -label [mc "About %s" [appname]] \
2820 -command do_about
2821}
2822. configure -menu .mbar
2823set doc_path [githtmldir]
2825if {$doc_path ne {}} {
2826 set doc_path [file join $doc_path index.html]
2827 if {[is_Cygwin]} {
2829 set doc_path [exec cygpath --mixed $doc_path]
2830 }
2831}
2832if {[file isfile $doc_path]} {
2834 set doc_url "file:$doc_path"
2835} else {
2836 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2837}
2838proc start_browser {url} {
2840 git "web--browse" $url
2841}
2842.mbar.help add command -label [mc "Online Documentation"] \
2844 -command [list start_browser $doc_url]
2845.mbar.help add command -label [mc "Show SSH Key"] \
2847 -command do_ssh_key
2848unset doc_path doc_url
2850# -- Standard bindings
2852#
2853wm protocol . WM_DELETE_WINDOW do_quit
2854bind all <$M1B-Key-q> do_quit
2855bind all <$M1B-Key-Q> do_quit
2856bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2857bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2858set subcommand_args {}
2860proc usage {} {
2861 set s "usage: $::argv0 $::subcommand $::subcommand_args"
2862 if {[tk windowingsystem] eq "win32"} {
2863 wm withdraw .
2864 tk_messageBox -icon info -title "Usage" -message $s
2865 } else {
2866 puts stderr $s
2867 }
2868 exit 1
2869}
2870proc normalize_relpath {path} {
2872 set elements {}
2873 foreach item [file split $path] {
2874 if {$item eq {.}} continue
2875 if {$item eq {..} && [llength $elements] > 0
2876 && [lindex $elements end] ne {..}} {
2877 set elements [lrange $elements 0 end-1]
2878 continue
2879 }
2880 lappend elements $item
2881 }
2882 return [eval file join $elements]
2883}
2884# -- Not a normal commit type invocation? Do that instead!
2886#
2887switch -- $subcommand {
2888browser -
2889blame {
2890 if {$subcommand eq "blame"} {
2891 set subcommand_args {[--line=<num>] rev? path}
2892 } else {
2893 set subcommand_args {rev? path}
2894 }
2895 if {$argv eq {}} usage
2896 set head {}
2897 set path {}
2898 set jump_spec {}
2899 set is_path 0
2900 foreach a $argv {
2901 if {$is_path || [file exists $_prefix$a]} {
2902 if {$path ne {}} usage
2903 set path [normalize_relpath $_prefix$a]
2904 break
2905 } elseif {$a eq {--}} {
2906 if {$path ne {}} {
2907 if {$head ne {}} usage
2908 set head $path
2909 set path {}
2910 }
2911 set is_path 1
2912 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2913 if {$jump_spec ne {} || $head ne {}} usage
2914 set jump_spec [list $lnum]
2915 } elseif {$head eq {}} {
2916 if {$head ne {}} usage
2917 set head $a
2918 set is_path 1
2919 } else {
2920 usage
2921 }
2922 }
2923 unset is_path
2924 if {$head ne {} && $path eq {}} {
2926 set path [normalize_relpath $_prefix$head]
2927 set head {}
2928 }
2929 if {$head eq {}} {
2931 load_current_branch
2932 } else {
2933 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2934 if {[catch {
2935 set head [git rev-parse --verify $head]
2936 } err]} {
2937 puts stderr $err
2938 exit 1
2939 }
2940 }
2941 set current_branch $head
2942 }
2943 wm deiconify .
2945 switch -- $subcommand {
2946 browser {
2947 if {$jump_spec ne {}} usage
2948 if {$head eq {}} {
2949 if {$path ne {} && [file isdirectory $path]} {
2950 set head $current_branch
2951 } else {
2952 set head $path
2953 set path {}
2954 }
2955 }
2956 browser::new $head $path
2957 }
2958 blame {
2959 if {$head eq {} && ![file exists $path]} {
2960 catch {wm withdraw .}
2961 tk_messageBox \
2962 -icon error \
2963 -type ok \
2964 -title [mc "git-gui: fatal error"] \
2965 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
2966 exit 1
2967 }
2968 blame::new $head $path $jump_spec
2969 }
2970 }
2971 return
2972}
2973citool -
2974gui {
2975 if {[llength $argv] != 0} {
2976 puts -nonewline stderr "usage: $argv0"
2977 if {$subcommand ne {gui}
2978 && [file tail $argv0] ne "git-$subcommand"} {
2979 puts -nonewline stderr " $subcommand"
2980 }
2981 puts stderr {}
2982 exit 1
2983 }
2984 # fall through to setup UI for commits
2985}
2986default {
2987 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2988 exit 1
2989}
2990}
2991# -- Branch Control
2993#
2994${NS}::frame .branch
2995if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
2996${NS}::label .branch.l1 \
2997 -text [mc "Current Branch:"] \
2998 -anchor w \
2999 -justify left
3000${NS}::label .branch.cb \
3001 -textvariable current_branch \
3002 -anchor w \
3003 -justify left
3004pack .branch.l1 -side left
3005pack .branch.cb -side left -fill x
3006pack .branch -side top -fill x
3007# -- Main Window Layout
3009#
3010${NS}::panedwindow .vpane -orient horizontal
3011${NS}::panedwindow .vpane.files -orient vertical
3012if {$use_ttk} {
3013 .vpane add .vpane.files
3014} else {
3015 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3016}
3017pack .vpane -anchor n -side top -fill both -expand 1
3018# -- Index File List
3020#
3021${NS}::frame .vpane.files.index -height 100 -width 200
3022tlabel .vpane.files.index.title \
3023 -text [mc "Staged Changes (Will Commit)"] \
3024 -background lightgreen -foreground black
3025text $ui_index -background white -foreground black \
3026 -borderwidth 0 \
3027 -width 20 -height 10 \
3028 -wrap none \
3029 -cursor $cursor_ptr \
3030 -xscrollcommand {.vpane.files.index.sx set} \
3031 -yscrollcommand {.vpane.files.index.sy set} \
3032 -state disabled
3033${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3034${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3035pack .vpane.files.index.title -side top -fill x
3036pack .vpane.files.index.sx -side bottom -fill x
3037pack .vpane.files.index.sy -side right -fill y
3038pack $ui_index -side left -fill both -expand 1
3039# -- Working Directory File List
3041#
3042${NS}::frame .vpane.files.workdir -height 100 -width 200
3043tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3044 -background lightsalmon -foreground black
3045text $ui_workdir -background white -foreground black \
3046 -borderwidth 0 \
3047 -width 20 -height 10 \
3048 -wrap none \
3049 -cursor $cursor_ptr \
3050 -xscrollcommand {.vpane.files.workdir.sx set} \
3051 -yscrollcommand {.vpane.files.workdir.sy set} \
3052 -state disabled
3053${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3054${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3055pack .vpane.files.workdir.title -side top -fill x
3056pack .vpane.files.workdir.sx -side bottom -fill x
3057pack .vpane.files.workdir.sy -side right -fill y
3058pack $ui_workdir -side left -fill both -expand 1
3059.vpane.files add .vpane.files.workdir
3061.vpane.files add .vpane.files.index
3062if {!$use_ttk} {
3063 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3064 .vpane.files paneconfigure .vpane.files.index -sticky news
3065}
3066foreach i [list $ui_index $ui_workdir] {
3068 rmsel_tag $i
3069 $i tag conf in_diff -background [$i tag cget in_sel -background]
3070}
3071unset i
3072# -- Diff and Commit Area
3074#
3075${NS}::frame .vpane.lower -height 300 -width 400
3076${NS}::frame .vpane.lower.commarea
3077${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3078pack .vpane.lower.diff -fill both -expand 1
3079pack .vpane.lower.commarea -side bottom -fill x
3080.vpane add .vpane.lower
3081if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3082# -- Commit Area Buttons
3084#
3085${NS}::frame .vpane.lower.commarea.buttons
3086${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3087 -anchor w \
3088 -justify left
3089pack .vpane.lower.commarea.buttons.l -side top -fill x
3090pack .vpane.lower.commarea.buttons -side left -fill y
3091${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3093 -command ui_do_rescan
3094pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3095lappend disable_on_lock \
3096 {.vpane.lower.commarea.buttons.rescan conf -state}
3097${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3099 -command do_add_all
3100pack .vpane.lower.commarea.buttons.incall -side top -fill x
3101lappend disable_on_lock \
3102 {.vpane.lower.commarea.buttons.incall conf -state}
3103if {![is_enabled nocommitmsg]} {
3105 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3106 -command do_signoff
3107 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3108}
3109${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3111 -command do_commit
3112pack .vpane.lower.commarea.buttons.commit -side top -fill x
3113lappend disable_on_lock \
3114 {.vpane.lower.commarea.buttons.commit conf -state}
3115if {![is_enabled nocommit]} {
3117 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3118 -command do_push_anywhere
3119 pack .vpane.lower.commarea.buttons.push -side top -fill x
3120}
3121# -- Commit Message Buffer
3123#
3124${NS}::frame .vpane.lower.commarea.buffer
3125${NS}::frame .vpane.lower.commarea.buffer.header
3126set ui_comm .vpane.lower.commarea.buffer.t
3127set ui_coml .vpane.lower.commarea.buffer.header.l
3128if {![is_enabled nocommit]} {
3130 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3131 -text [mc "New Commit"] \
3132 -command do_select_commit_type \
3133 -variable selected_commit_type \
3134 -value new
3135 lappend disable_on_lock \
3136 [list .vpane.lower.commarea.buffer.header.new conf -state]
3137 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3138 -text [mc "Amend Last Commit"] \
3139 -command do_select_commit_type \
3140 -variable selected_commit_type \
3141 -value amend
3142 lappend disable_on_lock \
3143 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3144}
3145${NS}::label $ui_coml \
3147 -anchor w \
3148 -justify left
3149proc trace_commit_type {varname args} {
3150 global ui_coml commit_type
3151 switch -glob -- $commit_type {
3152 initial {set txt [mc "Initial Commit Message:"]}
3153 amend {set txt [mc "Amended Commit Message:"]}
3154 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3155 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3156 merge {set txt [mc "Merge Commit Message:"]}
3157 * {set txt [mc "Commit Message:"]}
3158 }
3159 $ui_coml conf -text $txt
3160}
3161trace add variable commit_type write trace_commit_type
3162pack $ui_coml -side left -fill x
3163if {![is_enabled nocommit]} {
3165 pack .vpane.lower.commarea.buffer.header.amend -side right
3166 pack .vpane.lower.commarea.buffer.header.new -side right
3167}
3168text $ui_comm -background white -foreground black \
3170 -borderwidth 1 \
3171 -undo true \
3172 -maxundo 20 \
3173 -autoseparators true \
3174 -relief sunken \
3175 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3176 -font font_diff \
3177 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3178${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3179 -command [list $ui_comm yview]
3180pack .vpane.lower.commarea.buffer.header -side top -fill x
3181pack .vpane.lower.commarea.buffer.sby -side right -fill y
3182pack $ui_comm -side left -fill y
3183pack .vpane.lower.commarea.buffer -side left -fill y
3184# -- Commit Message Buffer Context Menu
3186#
3187set ctxm .vpane.lower.commarea.buffer.ctxm
3188menu $ctxm -tearoff 0
3189$ctxm add command \
3190 -label [mc Cut] \
3191 -command {tk_textCut $ui_comm}
3192$ctxm add command \
3193 -label [mc Copy] \
3194 -command {tk_textCopy $ui_comm}
3195$ctxm add command \
3196 -label [mc Paste] \
3197 -command {tk_textPaste $ui_comm}
3198$ctxm add command \
3199 -label [mc Delete] \
3200 -command {catch {$ui_comm delete sel.first sel.last}}
3201$ctxm add separator
3202$ctxm add command \
3203 -label [mc "Select All"] \
3204 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3205$ctxm add command \
3206 -label [mc "Copy All"] \
3207 -command {
3208 $ui_comm tag add sel 0.0 end
3209 tk_textCopy $ui_comm
3210 $ui_comm tag remove sel 0.0 end
3211 }
3212$ctxm add separator
3213$ctxm add command \
3214 -label [mc "Sign Off"] \
3215 -command do_signoff
3216set ui_comm_ctxm $ctxm
3217# -- Diff Header
3219#
3220proc trace_current_diff_path {varname args} {
3221 global current_diff_path diff_actions file_states
3222 if {$current_diff_path eq {}} {
3223 set s {}
3224 set f {}
3225 set p {}
3226 set o disabled
3227 } else {
3228 set p $current_diff_path
3229 set s [mapdesc [lindex $file_states($p) 0] $p]
3230 set f [mc "File:"]
3231 set p [escape_path $p]
3232 set o normal
3233 }
3234 .vpane.lower.diff.header.status configure -text $s
3236 .vpane.lower.diff.header.file configure -text $f
3237 .vpane.lower.diff.header.path configure -text $p
3238 foreach w $diff_actions {
3239 uplevel #0 $w $o
3240 }
3241}
3242trace add variable current_diff_path write trace_current_diff_path
3243gold_frame .vpane.lower.diff.header
3245tlabel .vpane.lower.diff.header.status \
3246 -background gold \
3247 -foreground black \
3248 -width $max_status_desc \
3249 -anchor w \
3250 -justify left
3251tlabel .vpane.lower.diff.header.file \
3252 -background gold \
3253 -foreground black \
3254 -anchor w \
3255 -justify left
3256tlabel .vpane.lower.diff.header.path \
3257 -background gold \
3258 -foreground black \
3259 -anchor w \
3260 -justify left
3261pack .vpane.lower.diff.header.status -side left
3262pack .vpane.lower.diff.header.file -side left
3263pack .vpane.lower.diff.header.path -fill x
3264set ctxm .vpane.lower.diff.header.ctxm
3265menu $ctxm -tearoff 0
3266$ctxm add command \
3267 -label [mc Copy] \
3268 -command {
3269 clipboard clear
3270 clipboard append \
3271 -format STRING \
3272 -type STRING \
3273 -- $current_diff_path
3274 }
3275lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3276bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3277# -- Diff Body
3279#
3280${NS}::frame .vpane.lower.diff.body
3281set ui_diff .vpane.lower.diff.body.t
3282text $ui_diff -background white -foreground black \
3283 -borderwidth 0 \
3284 -width 80 -height 5 -wrap none \
3285 -font font_diff \
3286 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3287 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3288 -state disabled
3289${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3290 -command [list $ui_diff xview]
3291${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3292 -command [list $ui_diff yview]
3293pack .vpane.lower.diff.body.sbx -side bottom -fill x
3294pack .vpane.lower.diff.body.sby -side right -fill y
3295pack $ui_diff -side left -fill both -expand 1
3296pack .vpane.lower.diff.header -side top -fill x
3297pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3298$ui_diff tag conf d_cr -elide true
3300$ui_diff tag conf d_@ -foreground blue -font font_diffbold
3301$ui_diff tag conf d_+ -foreground {#00a000}
3302$ui_diff tag conf d_- -foreground red
3303$ui_diff tag conf d_++ -foreground {#00a000}
3305$ui_diff tag conf d_-- -foreground red
3306$ui_diff tag conf d_+s \
3307 -foreground {#00a000} \
3308 -background {#e2effa}
3309$ui_diff tag conf d_-s \
3310 -foreground red \
3311 -background {#e2effa}
3312$ui_diff tag conf d_s+ \
3313 -foreground {#00a000} \
3314 -background ivory1
3315$ui_diff tag conf d_s- \
3316 -foreground red \
3317 -background ivory1
3318$ui_diff tag conf d<<<<<<< \
3320 -foreground orange \
3321 -font font_diffbold
3322$ui_diff tag conf d======= \
3323 -foreground orange \
3324 -font font_diffbold
3325$ui_diff tag conf d>>>>>>> \
3326 -foreground orange \
3327 -font font_diffbold
3328$ui_diff tag raise sel
3330# -- Diff Body Context Menu
3332#
3333proc create_common_diff_popup {ctxm} {
3335 $ctxm add command \
3336 -label [mc Refresh] \
3337 -command reshow_diff
3338 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3339 $ctxm add command \
3340 -label [mc Copy] \
3341 -command {tk_textCopy $ui_diff}
3342 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3343 $ctxm add command \
3344 -label [mc "Select All"] \
3345 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3346 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3347 $ctxm add command \
3348 -label [mc "Copy All"] \
3349 -command {
3350 $ui_diff tag add sel 0.0 end
3351 tk_textCopy $ui_diff
3352 $ui_diff tag remove sel 0.0 end
3353 }
3354 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3355 $ctxm add separator
3356 $ctxm add command \
3357 -label [mc "Decrease Font Size"] \
3358 -command {incr_font_size font_diff -1}
3359 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3360 $ctxm add command \
3361 -label [mc "Increase Font Size"] \
3362 -command {incr_font_size font_diff 1}
3363 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3364 $ctxm add separator
3365 set emenu $ctxm.enc
3366 menu $emenu
3367 build_encoding_menu $emenu [list force_diff_encoding]
3368 $ctxm add cascade \
3369 -label [mc "Encoding"] \
3370 -menu $emenu
3371 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3372 $ctxm add separator
3373 $ctxm add command -label [mc "Options..."] \
3374 -command do_options
3375}
3376set ctxm .vpane.lower.diff.body.ctxm
3378menu $ctxm -tearoff 0
3379$ctxm add command \
3380 -label [mc "Apply/Reverse Hunk"] \
3381 -command {apply_hunk $cursorX $cursorY}
3382set ui_diff_applyhunk [$ctxm index last]
3383lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3384$ctxm add command \
3385 -label [mc "Apply/Reverse Line"] \
3386 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3387set ui_diff_applyline [$ctxm index last]
3388lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3389$ctxm add separator
3390$ctxm add command \
3391 -label [mc "Show Less Context"] \
3392 -command show_less_context
3393lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3394$ctxm add command \
3395 -label [mc "Show More Context"] \
3396 -command show_more_context
3397lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3398$ctxm add separator
3399create_common_diff_popup $ctxm
3400set ctxmmg .vpane.lower.diff.body.ctxmmg
3402menu $ctxmmg -tearoff 0
3403$ctxmmg add command \
3404 -label [mc "Run Merge Tool"] \
3405 -command {merge_resolve_tool}
3406lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3407$ctxmmg add separator
3408$ctxmmg add command \
3409 -label [mc "Use Remote Version"] \
3410 -command {merge_resolve_one 3}
3411lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3412$ctxmmg add command \
3413 -label [mc "Use Local Version"] \
3414 -command {merge_resolve_one 2}
3415lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3416$ctxmmg add command \
3417 -label [mc "Revert To Base"] \
3418 -command {merge_resolve_one 1}
3419lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3420$ctxmmg add separator
3421$ctxmmg add command \
3422 -label [mc "Show Less Context"] \
3423 -command show_less_context
3424lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3425$ctxmmg add command \
3426 -label [mc "Show More Context"] \
3427 -command show_more_context
3428lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3429$ctxmmg add separator
3430create_common_diff_popup $ctxmmg
3431set ctxmsm .vpane.lower.diff.body.ctxmsm
3433menu $ctxmsm -tearoff 0
3434$ctxmsm add command \
3435 -label [mc "Visualize These Changes In The Submodule"] \
3436 -command {do_gitk -- true}
3437lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3438$ctxmsm add command \
3439 -label [mc "Visualize Current Branch History In The Submodule"] \
3440 -command {do_gitk {} true}
3441lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3442$ctxmsm add command \
3443 -label [mc "Visualize All Branch History In The Submodule"] \
3444 -command {do_gitk --all true}
3445lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3446$ctxmsm add separator
3447$ctxmsm add command \
3448 -label [mc "Start git gui In The Submodule"] \
3449 -command {do_git_gui}
3450lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3451$ctxmsm add separator
3452create_common_diff_popup $ctxmsm
3453proc has_textconv {path} {
3455 if {[is_config_false gui.textconv]} {
3456 return 0
3457 }
3458 set filter [gitattr $path diff set]
3459 set textconv [get_config [join [list diff $filter textconv] .]]
3460 if {$filter ne {set} && $textconv ne {}} {
3461 return 1
3462 } else {
3463 return 0
3464 }
3465}
3466proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3468 global current_diff_path file_states
3469 set ::cursorX $x
3470 set ::cursorY $y
3471 if {[info exists file_states($current_diff_path)]} {
3472 set state [lindex $file_states($current_diff_path) 0]
3473 } else {
3474 set state {__}
3475 }
3476 if {[string first {U} $state] >= 0} {
3477 tk_popup $ctxmmg $X $Y
3478 } elseif {$::is_submodule_diff} {
3479 tk_popup $ctxmsm $X $Y
3480 } else {
3481 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3482 if {$::ui_index eq $::current_diff_side} {
3483 set l [mc "Unstage Hunk From Commit"]
3484 if {$has_range} {
3485 set t [mc "Unstage Lines From Commit"]
3486 } else {
3487 set t [mc "Unstage Line From Commit"]
3488 }
3489 } else {
3490 set l [mc "Stage Hunk For Commit"]
3491 if {$has_range} {
3492 set t [mc "Stage Lines For Commit"]
3493 } else {
3494 set t [mc "Stage Line For Commit"]
3495 }
3496 }
3497 if {$::is_3way_diff
3498 || $current_diff_path eq {}
3499 || {__} eq $state
3500 || {_O} eq $state
3501 || {_T} eq $state
3502 || {T_} eq $state
3503 || [has_textconv $current_diff_path]} {
3504 set s disabled
3505 } else {
3506 set s normal
3507 }
3508 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3509 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3510 tk_popup $ctxm $X $Y
3511 }
3512}
3513bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3514# -- Status Bar
3516#
3517set main_status [::status_bar::new .status]
3518pack .status -anchor w -side bottom -fill x
3519$main_status show [mc "Initializing..."]
3520# -- Load geometry
3522#
3523proc on_ttk_pane_mapped {w pane pos} {
3524 bind $w <Map> {}
3525 after 0 [list after idle [list $w sashpos $pane $pos]]
3526}
3527proc on_tk_pane_mapped {w pane x y} {
3528 bind $w <Map> {}
3529 after 0 [list after idle [list $w sash place $pane $x $y]]
3530}
3531proc on_application_mapped {} {
3532 global repo_config use_ttk
3533 bind . <Map> {}
3534 set gm $repo_config(gui.geometry)
3535 if {$use_ttk} {
3536 bind .vpane <Map> \
3537 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3538 bind .vpane.files <Map> \
3539 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3540 } else {
3541 bind .vpane <Map> \
3542 [list on_tk_pane_mapped %W 0 \
3543 [lindex $gm 1] \
3544 [lindex [.vpane sash coord 0] 1]]
3545 bind .vpane.files <Map> \
3546 [list on_tk_pane_mapped %W 0 \
3547 [lindex [.vpane.files sash coord 0] 0] \
3548 [lindex $gm 2]]
3549 }
3550 wm geometry . [lindex $gm 0]
3551}
3552if {[info exists repo_config(gui.geometry)]} {
3553 bind . <Map> [list on_application_mapped]
3554 wm geometry . [lindex $repo_config(gui.geometry) 0]
3555}
3556# -- Load window state
3558#
3559if {[info exists repo_config(gui.wmstate)]} {
3560 catch {wm state . $repo_config(gui.wmstate)}
3561}
3562# -- Key Bindings
3564#
3565bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3566bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3567bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3568bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3569bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3570bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3571bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3572bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3573bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3574bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3575bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3576bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3577bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3578bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3579bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3580bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3581bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3582bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3583bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3584bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3585bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3586bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3587bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3589bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3590bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3591bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3592bind $ui_diff <$M1B-Key-v> {break}
3593bind $ui_diff <$M1B-Key-V> {break}
3594bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3595bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3596bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3597bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3598bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3599bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3600bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3601bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3602bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3603bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3604bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3605bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3606bind $ui_diff <Button-1> {focus %W}
3607if {[is_enabled branch]} {
3609 bind . <$M1B-Key-n> branch_create::dialog
3610 bind . <$M1B-Key-N> branch_create::dialog
3611 bind . <$M1B-Key-o> branch_checkout::dialog
3612 bind . <$M1B-Key-O> branch_checkout::dialog
3613 bind . <$M1B-Key-m> merge::dialog
3614 bind . <$M1B-Key-M> merge::dialog
3615}
3616if {[is_enabled transport]} {
3617 bind . <$M1B-Key-p> do_push_anywhere
3618 bind . <$M1B-Key-P> do_push_anywhere
3619}
3620bind . <Key-F5> ui_do_rescan
3622bind . <$M1B-Key-r> ui_do_rescan
3623bind . <$M1B-Key-R> ui_do_rescan
3624bind . <$M1B-Key-s> do_signoff
3625bind . <$M1B-Key-S> do_signoff
3626bind . <$M1B-Key-t> do_add_selection
3627bind . <$M1B-Key-T> do_add_selection
3628bind . <$M1B-Key-j> do_revert_selection
3629bind . <$M1B-Key-J> do_revert_selection
3630bind . <$M1B-Key-i> do_add_all
3631bind . <$M1B-Key-I> do_add_all
3632bind . <$M1B-Key-minus> {show_less_context;break}
3633bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3634bind . <$M1B-Key-equal> {show_more_context;break}
3635bind . <$M1B-Key-plus> {show_more_context;break}
3636bind . <$M1B-Key-KP_Add> {show_more_context;break}
3637bind . <$M1B-Key-Return> do_commit
3638foreach i [list $ui_index $ui_workdir] {
3639 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3640 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3641 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3642}
3643unset i
3644set file_lists($ui_index) [list]
3646set file_lists($ui_workdir) [list]
3647wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3649focus -force $ui_comm
3650# -- Warn the user about environmental problems. Cygwin's Tcl
3652# does *not* pass its env array onto any processes it spawns.
3653# This means that git processes get none of our environment.
3654#
3655if {[is_Cygwin]} {
3656 set ignored_env 0
3657 set suggest_user {}
3658 set msg [mc "Possible environment issues exist.
3659The following environment variables are probably
3661going to be ignored by any Git subprocess run
3662by %s:
3663" [appname]]
3665 foreach name [array names env] {
3666 switch -regexp -- $name {
3667 {^GIT_INDEX_FILE$} -
3668 {^GIT_OBJECT_DIRECTORY$} -
3669 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3670 {^GIT_DIFF_OPTS$} -
3671 {^GIT_EXTERNAL_DIFF$} -
3672 {^GIT_PAGER$} -
3673 {^GIT_TRACE$} -
3674 {^GIT_CONFIG$} -
3675 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3676 append msg " - $name\n"
3677 incr ignored_env
3678 }
3679 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3680 append msg " - $name\n"
3681 incr ignored_env
3682 set suggest_user $name
3683 }
3684 }
3685 }
3686 if {$ignored_env > 0} {
3687 append msg [mc "
3688This is due to a known issue with the
3689Tcl binary distributed by Cygwin."]
3690 if {$suggest_user ne {}} {
3692 append msg [mc "
3693A good replacement for %s
3695is placing values for the user.name and
3696user.email settings into your personal
3697~/.gitconfig file.
3698" $suggest_user]
3699 }
3700 warn_popup $msg
3701 }
3702 unset ignored_env msg suggest_user name
3703}
3704# -- Only initialize complex UI if we are going to stay running.
3706#
3707if {[is_enabled transport]} {
3708 load_all_remotes
3709 set n [.mbar.remote index end]
3711 populate_remotes_menu
3712 set n [expr {[.mbar.remote index end] - $n}]
3713 if {$n > 0} {
3714 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3715 .mbar.remote insert $n separator
3716 }
3717 unset n
3718}
3719if {[winfo exists $ui_comm]} {
3721 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3722 # -- If both our backup and message files exist use the
3724 # newer of the two files to initialize the buffer.
3725 #
3726 if {$GITGUI_BCK_exists} {
3727 set m [gitdir GITGUI_MSG]
3728 if {[file isfile $m]} {
3729 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3730 catch {file delete [gitdir GITGUI_MSG]}
3731 } else {
3732 $ui_comm delete 0.0 end
3733 $ui_comm edit reset
3734 $ui_comm edit modified false
3735 catch {file delete [gitdir GITGUI_BCK]}
3736 set GITGUI_BCK_exists 0
3737 }
3738 }
3739 unset m
3740 }
3741 proc backup_commit_buffer {} {
3743 global ui_comm GITGUI_BCK_exists
3744 set m [$ui_comm edit modified]
3746 if {$m || $GITGUI_BCK_exists} {
3747 set msg [string trim [$ui_comm get 0.0 end]]
3748 regsub -all -line {[ \r\t]+$} $msg {} msg
3749 if {$msg eq {}} {
3751 if {$GITGUI_BCK_exists} {
3752 catch {file delete [gitdir GITGUI_BCK]}
3753 set GITGUI_BCK_exists 0
3754 }
3755 } elseif {$m} {
3756 catch {
3757 set fd [open [gitdir GITGUI_BCK] w]
3758 puts -nonewline $fd $msg
3759 close $fd
3760 set GITGUI_BCK_exists 1
3761 }
3762 }
3763 $ui_comm edit modified false
3765 }
3766 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3768 }
3769 backup_commit_buffer
3771 # -- If the user has aspell available we can drive it
3773 # in pipe mode to spellcheck the commit message.
3774 #
3775 set spell_cmd [list |]
3776 set spell_dict [get_config gui.spellingdictionary]
3777 lappend spell_cmd aspell
3778 if {$spell_dict ne {}} {
3779 lappend spell_cmd --master=$spell_dict
3780 }
3781 lappend spell_cmd --mode=none
3782 lappend spell_cmd --encoding=utf-8
3783 lappend spell_cmd pipe
3784 if {$spell_dict eq {none}
3785 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3786 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3787 } else {
3788 set ui_comm_spell [spellcheck::init \
3789 $spell_fd \
3790 $ui_comm \
3791 $ui_comm_ctxm \
3792 ]
3793 }
3794 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3795}
3796lock_index begin-read
3798if {![winfo ismapped .]} {
3799 wm deiconify .
3800}
3801after 1 {
3802 if {[is_enabled initialamend]} {
3803 force_amend
3804 } else {
3805 do_rescan
3806 }
3807 if {[is_enabled nocommitmsg]} {
3809 $ui_comm configure -state disabled -background gray
3810 }
3811}
3812if {[is_enabled multicommit]} {
3813 after 1000 hint_gc
3814}
3815if {[is_enabled retcode]} {
3816 bind . <Destroy> {+terminate_me %W}
3817}
3818if {$picked && [is_config_true gui.autoexplore]} {
3819 do_explore
3820}
3821# Local variables:
3823# mode: tcl
3824# indent-tabs-mode: t
3825# tab-width: 4
3826# End: