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