8996d2d6bc9ec9d2fe0f105a18c288d87734f7d3
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}
1162if {$_prefix ne {}} {
1163 if {$_gitworktree eq {}} {
1164 regsub -all {[^/]+/} $_prefix ../ cdup
1165 } else {
1166 set cdup $_gitworktree
1167 }
1168 if {[catch {cd $cdup} err]} {
1169 catch {wm withdraw .}
1170 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1171 exit 1
1172 }
1173 set _gitworktree [pwd]
1174 unset cdup
1175} elseif {![is_enabled bare]} {
1176 if {[is_bare]} {
1177 catch {wm withdraw .}
1178 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1179 exit 1
1180 }
1181 if {$_gitworktree eq {}} {
1182 set _gitworktree [file dirname $_gitdir]
1183 }
1184 if {[catch {cd $_gitworktree} err]} {
1185 catch {wm withdraw .}
1186 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1187 exit 1
1188 }
1189 set _gitworktree [pwd]
1190}
1191set _reponame [file split [file normalize $_gitdir]]
1192if {[lindex $_reponame end] eq {.git}} {
1193 set _reponame [lindex $_reponame end-1]
1194} else {
1195 set _reponame [lindex $_reponame end]
1196}
1197
1198set env(GIT_DIR) $_gitdir
1199set env(GIT_WORK_TREE) $_gitworktree
1200
1201######################################################################
1202##
1203## global init
1204
1205set current_diff_path {}
1206set current_diff_side {}
1207set diff_actions [list]
1208
1209set HEAD {}
1210set PARENT {}
1211set MERGE_HEAD [list]
1212set commit_type {}
1213set empty_tree {}
1214set current_branch {}
1215set is_detached 0
1216set current_diff_path {}
1217set is_3way_diff 0
1218set is_submodule_diff 0
1219set is_conflict_diff 0
1220set selected_commit_type new
1221set diff_empty_count 0
1222
1223set nullid "0000000000000000000000000000000000000000"
1224set nullid2 "0000000000000000000000000000000000000001"
1225
1226######################################################################
1227##
1228## task management
1229
1230set rescan_active 0
1231set diff_active 0
1232set last_clicked {}
1233
1234set disable_on_lock [list]
1235set index_lock_type none
1236
1237proc lock_index {type} {
1238 global index_lock_type disable_on_lock
1239
1240 if {$index_lock_type eq {none}} {
1241 set index_lock_type $type
1242 foreach w $disable_on_lock {
1243 uplevel #0 $w disabled
1244 }
1245 return 1
1246 } elseif {$index_lock_type eq "begin-$type"} {
1247 set index_lock_type $type
1248 return 1
1249 }
1250 return 0
1251}
1252
1253proc unlock_index {} {
1254 global index_lock_type disable_on_lock
1255
1256 set index_lock_type none
1257 foreach w $disable_on_lock {
1258 uplevel #0 $w normal
1259 }
1260}
1261
1262######################################################################
1263##
1264## status
1265
1266proc repository_state {ctvar hdvar mhvar} {
1267 global current_branch
1268 upvar $ctvar ct $hdvar hd $mhvar mh
1269
1270 set mh [list]
1271
1272 load_current_branch
1273 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1274 set hd {}
1275 set ct initial
1276 return
1277 }
1278
1279 set merge_head [gitdir MERGE_HEAD]
1280 if {[file exists $merge_head]} {
1281 set ct merge
1282 set fd_mh [open $merge_head r]
1283 while {[gets $fd_mh line] >= 0} {
1284 lappend mh $line
1285 }
1286 close $fd_mh
1287 return
1288 }
1289
1290 set ct normal
1291}
1292
1293proc PARENT {} {
1294 global PARENT empty_tree
1295
1296 set p [lindex $PARENT 0]
1297 if {$p ne {}} {
1298 return $p
1299 }
1300 if {$empty_tree eq {}} {
1301 set empty_tree [git mktree << {}]
1302 }
1303 return $empty_tree
1304}
1305
1306proc force_amend {} {
1307 global selected_commit_type
1308 global HEAD PARENT MERGE_HEAD commit_type
1309
1310 repository_state newType newHEAD newMERGE_HEAD
1311 set HEAD $newHEAD
1312 set PARENT $newHEAD
1313 set MERGE_HEAD $newMERGE_HEAD
1314 set commit_type $newType
1315
1316 set selected_commit_type amend
1317 do_select_commit_type
1318}
1319
1320proc rescan {after {honor_trustmtime 1}} {
1321 global HEAD PARENT MERGE_HEAD commit_type
1322 global ui_index ui_workdir ui_comm
1323 global rescan_active file_states
1324 global repo_config
1325
1326 if {$rescan_active > 0 || ![lock_index read]} return
1327
1328 repository_state newType newHEAD newMERGE_HEAD
1329 if {[string match amend* $commit_type]
1330 && $newType eq {normal}
1331 && $newHEAD eq $HEAD} {
1332 } else {
1333 set HEAD $newHEAD
1334 set PARENT $newHEAD
1335 set MERGE_HEAD $newMERGE_HEAD
1336 set commit_type $newType
1337 }
1338
1339 array unset file_states
1340
1341 if {!$::GITGUI_BCK_exists &&
1342 (![$ui_comm edit modified]
1343 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1344 if {[string match amend* $commit_type]} {
1345 } elseif {[load_message GITGUI_MSG]} {
1346 } elseif {[run_prepare_commit_msg_hook]} {
1347 } elseif {[load_message MERGE_MSG]} {
1348 } elseif {[load_message SQUASH_MSG]} {
1349 }
1350 $ui_comm edit reset
1351 $ui_comm edit modified false
1352 }
1353
1354 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1355 rescan_stage2 {} $after
1356 } else {
1357 set rescan_active 1
1358 ui_status [mc "Refreshing file status..."]
1359 set fd_rf [git_read update-index \
1360 -q \
1361 --unmerged \
1362 --ignore-missing \
1363 --refresh \
1364 ]
1365 fconfigure $fd_rf -blocking 0 -translation binary
1366 fileevent $fd_rf readable \
1367 [list rescan_stage2 $fd_rf $after]
1368 }
1369}
1370
1371if {[is_Cygwin]} {
1372 set is_git_info_exclude {}
1373 proc have_info_exclude {} {
1374 global is_git_info_exclude
1375
1376 if {$is_git_info_exclude eq {}} {
1377 if {[catch {exec test -f [gitdir info exclude]}]} {
1378 set is_git_info_exclude 0
1379 } else {
1380 set is_git_info_exclude 1
1381 }
1382 }
1383 return $is_git_info_exclude
1384 }
1385} else {
1386 proc have_info_exclude {} {
1387 return [file readable [gitdir info exclude]]
1388 }
1389}
1390
1391proc rescan_stage2 {fd after} {
1392 global rescan_active buf_rdi buf_rdf buf_rlo
1393
1394 if {$fd ne {}} {
1395 read $fd
1396 if {![eof $fd]} return
1397 close $fd
1398 }
1399
1400 set ls_others [list --exclude-per-directory=.gitignore]
1401 if {[have_info_exclude]} {
1402 lappend ls_others "--exclude-from=[gitdir info exclude]"
1403 }
1404 set user_exclude [get_config core.excludesfile]
1405 if {$user_exclude ne {} && [file readable $user_exclude]} {
1406 lappend ls_others "--exclude-from=$user_exclude"
1407 }
1408
1409 set buf_rdi {}
1410 set buf_rdf {}
1411 set buf_rlo {}
1412
1413 set rescan_active 3
1414 ui_status [mc "Scanning for modified files ..."]
1415 set fd_di [git_read diff-index --cached -z [PARENT]]
1416 set fd_df [git_read diff-files -z]
1417 set fd_lo [eval git_read ls-files --others -z $ls_others]
1418
1419 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1420 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1421 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1422 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1423 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1424 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1425}
1426
1427proc load_message {file} {
1428 global ui_comm
1429
1430 set f [gitdir $file]
1431 if {[file isfile $f]} {
1432 if {[catch {set fd [open $f r]}]} {
1433 return 0
1434 }
1435 fconfigure $fd -eofchar {}
1436 set content [string trim [read $fd]]
1437 close $fd
1438 regsub -all -line {[ \r\t]+$} $content {} content
1439 $ui_comm delete 0.0 end
1440 $ui_comm insert end $content
1441 return 1
1442 }
1443 return 0
1444}
1445
1446proc run_prepare_commit_msg_hook {} {
1447 global pch_error
1448
1449 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1450 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1451 # empty file but existant file.
1452
1453 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1454
1455 if {[file isfile [gitdir MERGE_MSG]]} {
1456 set pcm_source "merge"
1457 set fd_mm [open [gitdir MERGE_MSG] r]
1458 puts -nonewline $fd_pcm [read $fd_mm]
1459 close $fd_mm
1460 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1461 set pcm_source "squash"
1462 set fd_sm [open [gitdir SQUASH_MSG] r]
1463 puts -nonewline $fd_pcm [read $fd_sm]
1464 close $fd_sm
1465 } else {
1466 set pcm_source ""
1467 }
1468
1469 close $fd_pcm
1470
1471 set fd_ph [githook_read prepare-commit-msg \
1472 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1473 if {$fd_ph eq {}} {
1474 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1475 return 0;
1476 }
1477
1478 ui_status [mc "Calling prepare-commit-msg hook..."]
1479 set pch_error {}
1480
1481 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1482 fileevent $fd_ph readable \
1483 [list prepare_commit_msg_hook_wait $fd_ph]
1484
1485 return 1;
1486}
1487
1488proc prepare_commit_msg_hook_wait {fd_ph} {
1489 global pch_error
1490
1491 append pch_error [read $fd_ph]
1492 fconfigure $fd_ph -blocking 1
1493 if {[eof $fd_ph]} {
1494 if {[catch {close $fd_ph}]} {
1495 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1496 hook_failed_popup prepare-commit-msg $pch_error
1497 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1498 exit 1
1499 } else {
1500 load_message PREPARE_COMMIT_MSG
1501 }
1502 set pch_error {}
1503 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1504 return
1505 }
1506 fconfigure $fd_ph -blocking 0
1507 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1508}
1509
1510proc read_diff_index {fd after} {
1511 global buf_rdi
1512
1513 append buf_rdi [read $fd]
1514 set c 0
1515 set n [string length $buf_rdi]
1516 while {$c < $n} {
1517 set z1 [string first "\0" $buf_rdi $c]
1518 if {$z1 == -1} break
1519 incr z1
1520 set z2 [string first "\0" $buf_rdi $z1]
1521 if {$z2 == -1} break
1522
1523 incr c
1524 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1525 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1526 merge_state \
1527 [encoding convertfrom $p] \
1528 [lindex $i 4]? \
1529 [list [lindex $i 0] [lindex $i 2]] \
1530 [list]
1531 set c $z2
1532 incr c
1533 }
1534 if {$c < $n} {
1535 set buf_rdi [string range $buf_rdi $c end]
1536 } else {
1537 set buf_rdi {}
1538 }
1539
1540 rescan_done $fd buf_rdi $after
1541}
1542
1543proc read_diff_files {fd after} {
1544 global buf_rdf
1545
1546 append buf_rdf [read $fd]
1547 set c 0
1548 set n [string length $buf_rdf]
1549 while {$c < $n} {
1550 set z1 [string first "\0" $buf_rdf $c]
1551 if {$z1 == -1} break
1552 incr z1
1553 set z2 [string first "\0" $buf_rdf $z1]
1554 if {$z2 == -1} break
1555
1556 incr c
1557 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1558 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1559 merge_state \
1560 [encoding convertfrom $p] \
1561 ?[lindex $i 4] \
1562 [list] \
1563 [list [lindex $i 0] [lindex $i 2]]
1564 set c $z2
1565 incr c
1566 }
1567 if {$c < $n} {
1568 set buf_rdf [string range $buf_rdf $c end]
1569 } else {
1570 set buf_rdf {}
1571 }
1572
1573 rescan_done $fd buf_rdf $after
1574}
1575
1576proc read_ls_others {fd after} {
1577 global buf_rlo
1578
1579 append buf_rlo [read $fd]
1580 set pck [split $buf_rlo "\0"]
1581 set buf_rlo [lindex $pck end]
1582 foreach p [lrange $pck 0 end-1] {
1583 set p [encoding convertfrom $p]
1584 if {[string index $p end] eq {/}} {
1585 set p [string range $p 0 end-1]
1586 }
1587 merge_state $p ?O
1588 }
1589 rescan_done $fd buf_rlo $after
1590}
1591
1592proc rescan_done {fd buf after} {
1593 global rescan_active current_diff_path
1594 global file_states repo_config
1595 upvar $buf to_clear
1596
1597 if {![eof $fd]} return
1598 set to_clear {}
1599 close $fd
1600 if {[incr rescan_active -1] > 0} return
1601
1602 prune_selection
1603 unlock_index
1604 display_all_files
1605 if {$current_diff_path ne {}} { reshow_diff $after }
1606 if {$current_diff_path eq {}} { select_first_diff $after }
1607}
1608
1609proc prune_selection {} {
1610 global file_states selected_paths
1611
1612 foreach path [array names selected_paths] {
1613 if {[catch {set still_here $file_states($path)}]} {
1614 unset selected_paths($path)
1615 }
1616 }
1617}
1618
1619######################################################################
1620##
1621## ui helpers
1622
1623proc mapicon {w state path} {
1624 global all_icons
1625
1626 if {[catch {set r $all_icons($state$w)}]} {
1627 puts "error: no icon for $w state={$state} $path"
1628 return file_plain
1629 }
1630 return $r
1631}
1632
1633proc mapdesc {state path} {
1634 global all_descs
1635
1636 if {[catch {set r $all_descs($state)}]} {
1637 puts "error: no desc for state={$state} $path"
1638 return $state
1639 }
1640 return $r
1641}
1642
1643proc ui_status {msg} {
1644 global main_status
1645 if {[info exists main_status]} {
1646 $main_status show $msg
1647 }
1648}
1649
1650proc ui_ready {{test {}}} {
1651 global main_status
1652 if {[info exists main_status]} {
1653 $main_status show [mc "Ready."] $test
1654 }
1655}
1656
1657proc escape_path {path} {
1658 regsub -all {\\} $path "\\\\" path
1659 regsub -all "\n" $path "\\n" path
1660 return $path
1661}
1662
1663proc short_path {path} {
1664 return [escape_path [lindex [file split $path] end]]
1665}
1666
1667set next_icon_id 0
1668set null_sha1 [string repeat 0 40]
1669
1670proc merge_state {path new_state {head_info {}} {index_info {}}} {
1671 global file_states next_icon_id null_sha1
1672
1673 set s0 [string index $new_state 0]
1674 set s1 [string index $new_state 1]
1675
1676 if {[catch {set info $file_states($path)}]} {
1677 set state __
1678 set icon n[incr next_icon_id]
1679 } else {
1680 set state [lindex $info 0]
1681 set icon [lindex $info 1]
1682 if {$head_info eq {}} {set head_info [lindex $info 2]}
1683 if {$index_info eq {}} {set index_info [lindex $info 3]}
1684 }
1685
1686 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1687 elseif {$s0 eq {_}} {set s0 _}
1688
1689 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1690 elseif {$s1 eq {_}} {set s1 _}
1691
1692 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1693 set head_info [list 0 $null_sha1]
1694 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1695 && $head_info eq {}} {
1696 set head_info $index_info
1697 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1698 set index_info $head_info
1699 set head_info {}
1700 }
1701
1702 set file_states($path) [list $s0$s1 $icon \
1703 $head_info $index_info \
1704 ]
1705 return $state
1706}
1707
1708proc display_file_helper {w path icon_name old_m new_m} {
1709 global file_lists
1710
1711 if {$new_m eq {_}} {
1712 set lno [lsearch -sorted -exact $file_lists($w) $path]
1713 if {$lno >= 0} {
1714 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1715 incr lno
1716 $w conf -state normal
1717 $w delete $lno.0 [expr {$lno + 1}].0
1718 $w conf -state disabled
1719 }
1720 } elseif {$old_m eq {_} && $new_m ne {_}} {
1721 lappend file_lists($w) $path
1722 set file_lists($w) [lsort -unique $file_lists($w)]
1723 set lno [lsearch -sorted -exact $file_lists($w) $path]
1724 incr lno
1725 $w conf -state normal
1726 $w image create $lno.0 \
1727 -align center -padx 5 -pady 1 \
1728 -name $icon_name \
1729 -image [mapicon $w $new_m $path]
1730 $w insert $lno.1 "[escape_path $path]\n"
1731 $w conf -state disabled
1732 } elseif {$old_m ne $new_m} {
1733 $w conf -state normal
1734 $w image conf $icon_name -image [mapicon $w $new_m $path]
1735 $w conf -state disabled
1736 }
1737}
1738
1739proc display_file {path state} {
1740 global file_states selected_paths
1741 global ui_index ui_workdir
1742
1743 set old_m [merge_state $path $state]
1744 set s $file_states($path)
1745 set new_m [lindex $s 0]
1746 set icon_name [lindex $s 1]
1747
1748 set o [string index $old_m 0]
1749 set n [string index $new_m 0]
1750 if {$o eq {U}} {
1751 set o _
1752 }
1753 if {$n eq {U}} {
1754 set n _
1755 }
1756 display_file_helper $ui_index $path $icon_name $o $n
1757
1758 if {[string index $old_m 0] eq {U}} {
1759 set o U
1760 } else {
1761 set o [string index $old_m 1]
1762 }
1763 if {[string index $new_m 0] eq {U}} {
1764 set n U
1765 } else {
1766 set n [string index $new_m 1]
1767 }
1768 display_file_helper $ui_workdir $path $icon_name $o $n
1769
1770 if {$new_m eq {__}} {
1771 unset file_states($path)
1772 catch {unset selected_paths($path)}
1773 }
1774}
1775
1776proc display_all_files_helper {w path icon_name m} {
1777 global file_lists
1778
1779 lappend file_lists($w) $path
1780 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1781 $w image create end \
1782 -align center -padx 5 -pady 1 \
1783 -name $icon_name \
1784 -image [mapicon $w $m $path]
1785 $w insert end "[escape_path $path]\n"
1786}
1787
1788set files_warning 0
1789proc display_all_files {} {
1790 global ui_index ui_workdir
1791 global file_states file_lists
1792 global last_clicked
1793 global files_warning
1794
1795 $ui_index conf -state normal
1796 $ui_workdir conf -state normal
1797
1798 $ui_index delete 0.0 end
1799 $ui_workdir delete 0.0 end
1800 set last_clicked {}
1801
1802 set file_lists($ui_index) [list]
1803 set file_lists($ui_workdir) [list]
1804
1805 set to_display [lsort [array names file_states]]
1806 set display_limit [get_config gui.maxfilesdisplayed]
1807 if {[llength $to_display] > $display_limit} {
1808 if {!$files_warning} {
1809 # do not repeatedly warn:
1810 set files_warning 1
1811 info_popup [mc "Displaying only %s of %s files." \
1812 $display_limit [llength $to_display]]
1813 }
1814 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1815 }
1816 foreach path $to_display {
1817 set s $file_states($path)
1818 set m [lindex $s 0]
1819 set icon_name [lindex $s 1]
1820
1821 set s [string index $m 0]
1822 if {$s ne {U} && $s ne {_}} {
1823 display_all_files_helper $ui_index $path \
1824 $icon_name $s
1825 }
1826
1827 if {[string index $m 0] eq {U}} {
1828 set s U
1829 } else {
1830 set s [string index $m 1]
1831 }
1832 if {$s ne {_}} {
1833 display_all_files_helper $ui_workdir $path \
1834 $icon_name $s
1835 }
1836 }
1837
1838 $ui_index conf -state disabled
1839 $ui_workdir conf -state disabled
1840}
1841
1842######################################################################
1843##
1844## icons
1845
1846set filemask {
1847#define mask_width 14
1848#define mask_height 15
1849static unsigned char mask_bits[] = {
1850 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1851 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1852 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1853}
1854
1855image create bitmap file_plain -background white -foreground black -data {
1856#define plain_width 14
1857#define plain_height 15
1858static unsigned char plain_bits[] = {
1859 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1860 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1861 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1862} -maskdata $filemask
1863
1864image create bitmap file_mod -background white -foreground blue -data {
1865#define mod_width 14
1866#define mod_height 15
1867static unsigned char mod_bits[] = {
1868 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1869 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1870 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1871} -maskdata $filemask
1872
1873image create bitmap file_fulltick -background white -foreground "#007000" -data {
1874#define file_fulltick_width 14
1875#define file_fulltick_height 15
1876static unsigned char file_fulltick_bits[] = {
1877 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1878 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1879 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1880} -maskdata $filemask
1881
1882image create bitmap file_question -background white -foreground black -data {
1883#define file_question_width 14
1884#define file_question_height 15
1885static unsigned char file_question_bits[] = {
1886 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1887 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1888 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1889} -maskdata $filemask
1890
1891image create bitmap file_removed -background white -foreground red -data {
1892#define file_removed_width 14
1893#define file_removed_height 15
1894static unsigned char file_removed_bits[] = {
1895 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1896 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1897 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1898} -maskdata $filemask
1899
1900image create bitmap file_merge -background white -foreground blue -data {
1901#define file_merge_width 14
1902#define file_merge_height 15
1903static unsigned char file_merge_bits[] = {
1904 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1905 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1906 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1907} -maskdata $filemask
1908
1909image create bitmap file_statechange -background white -foreground green -data {
1910#define file_merge_width 14
1911#define file_merge_height 15
1912static unsigned char file_statechange_bits[] = {
1913 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1914 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1915 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1916} -maskdata $filemask
1917
1918set ui_index .vpane.files.index.list
1919set ui_workdir .vpane.files.workdir.list
1920
1921set all_icons(_$ui_index) file_plain
1922set all_icons(A$ui_index) file_plain
1923set all_icons(M$ui_index) file_fulltick
1924set all_icons(D$ui_index) file_removed
1925set all_icons(U$ui_index) file_merge
1926set all_icons(T$ui_index) file_statechange
1927
1928set all_icons(_$ui_workdir) file_plain
1929set all_icons(M$ui_workdir) file_mod
1930set all_icons(D$ui_workdir) file_question
1931set all_icons(U$ui_workdir) file_merge
1932set all_icons(O$ui_workdir) file_plain
1933set all_icons(T$ui_workdir) file_statechange
1934
1935set max_status_desc 0
1936foreach i {
1937 {__ {mc "Unmodified"}}
1938
1939 {_M {mc "Modified, not staged"}}
1940 {M_ {mc "Staged for commit"}}
1941 {MM {mc "Portions staged for commit"}}
1942 {MD {mc "Staged for commit, missing"}}
1943
1944 {_T {mc "File type changed, not staged"}}
1945 {T_ {mc "File type changed, staged"}}
1946
1947 {_O {mc "Untracked, not staged"}}
1948 {A_ {mc "Staged for commit"}}
1949 {AM {mc "Portions staged for commit"}}
1950 {AD {mc "Staged for commit, missing"}}
1951
1952 {_D {mc "Missing"}}
1953 {D_ {mc "Staged for removal"}}
1954 {DO {mc "Staged for removal, still present"}}
1955
1956 {_U {mc "Requires merge resolution"}}
1957 {U_ {mc "Requires merge resolution"}}
1958 {UU {mc "Requires merge resolution"}}
1959 {UM {mc "Requires merge resolution"}}
1960 {UD {mc "Requires merge resolution"}}
1961 {UT {mc "Requires merge resolution"}}
1962 } {
1963 set text [eval [lindex $i 1]]
1964 if {$max_status_desc < [string length $text]} {
1965 set max_status_desc [string length $text]
1966 }
1967 set all_descs([lindex $i 0]) $text
1968}
1969unset i
1970
1971######################################################################
1972##
1973## util
1974
1975proc scrollbar2many {list mode args} {
1976 foreach w $list {eval $w $mode $args}
1977}
1978
1979proc many2scrollbar {list mode sb top bottom} {
1980 $sb set $top $bottom
1981 foreach w $list {$w $mode moveto $top}
1982}
1983
1984proc incr_font_size {font {amt 1}} {
1985 set sz [font configure $font -size]
1986 incr sz $amt
1987 font configure $font -size $sz
1988 font configure ${font}bold -size $sz
1989 font configure ${font}italic -size $sz
1990}
1991
1992######################################################################
1993##
1994## ui commands
1995
1996set starting_gitk_msg [mc "Starting gitk... please wait..."]
1997
1998proc do_gitk {revs {is_submodule false}} {
1999 global current_diff_path file_states current_diff_side ui_index
2000 global _gitdir _gitworktree
2001
2002 # -- Always start gitk through whatever we were loaded with. This
2003 # lets us bypass using shell process on Windows systems.
2004 #
2005 set exe [_which gitk -script]
2006 set cmd [list [info nameofexecutable] $exe]
2007 if {$exe eq {}} {
2008 error_popup [mc "Couldn't find gitk in PATH"]
2009 } else {
2010 global env
2011
2012 set pwd [pwd]
2013
2014 if {!$is_submodule} {
2015 if {![is_bare]} {
2016 cd $_gitworktree
2017 }
2018 } else {
2019 cd $current_diff_path
2020 if {$revs eq {--}} {
2021 set s $file_states($current_diff_path)
2022 set old_sha1 {}
2023 set new_sha1 {}
2024 switch -glob -- [lindex $s 0] {
2025 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2026 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2027 MM {
2028 if {$current_diff_side eq $ui_index} {
2029 set old_sha1 [lindex [lindex $s 2] 1]
2030 set new_sha1 [lindex [lindex $s 3] 1]
2031 } else {
2032 set old_sha1 [lindex [lindex $s 3] 1]
2033 }
2034 }
2035 }
2036 set revs $old_sha1...$new_sha1
2037 }
2038 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2039 # we've been using for the main repository, so unset them.
2040 # TODO we could make life easier (start up faster?) for gitk
2041 # by setting these to the appropriate values to allow gitk
2042 # to skip the heuristics to find their proper value
2043 unset env(GIT_DIR)
2044 unset env(GIT_WORK_TREE)
2045 }
2046 eval exec $cmd $revs "--" "--" &
2047
2048 set env(GIT_DIR) $_gitdir
2049 set env(GIT_WORK_TREE) $_gitworktree
2050 cd $pwd
2051
2052 ui_status $::starting_gitk_msg
2053 after 10000 {
2054 ui_ready $starting_gitk_msg
2055 }
2056 }
2057}
2058
2059proc do_git_gui {} {
2060 global current_diff_path
2061
2062 # -- Always start git gui through whatever we were loaded with. This
2063 # lets us bypass using shell process on Windows systems.
2064 #
2065 set exe [list [_which git]]
2066 if {$exe eq {}} {
2067 error_popup [mc "Couldn't find git gui in PATH"]
2068 } else {
2069 global env
2070 global _gitdir _gitworktree
2071
2072 # see note in do_gitk about unsetting these vars when
2073 # running tools in a submodule
2074 unset env(GIT_DIR)
2075 unset env(GIT_WORK_TREE)
2076
2077 set pwd [pwd]
2078 cd $current_diff_path
2079
2080 eval exec $exe gui &
2081
2082 set env(GIT_DIR) $_gitdir
2083 set env(GIT_WORK_TREE) $_gitworktree
2084 cd $pwd
2085
2086 ui_status $::starting_gitk_msg
2087 after 10000 {
2088 ui_ready $starting_gitk_msg
2089 }
2090 }
2091}
2092
2093proc do_explore {} {
2094 global _gitworktree
2095 set explorer {}
2096 if {[is_Cygwin] || [is_Windows]} {
2097 set explorer "explorer.exe"
2098 } elseif {[is_MacOSX]} {
2099 set explorer "open"
2100 } else {
2101 # freedesktop.org-conforming system is our best shot
2102 set explorer "xdg-open"
2103 }
2104 eval exec $explorer $_gitworktree &
2105}
2106
2107set is_quitting 0
2108set ret_code 1
2109
2110proc terminate_me {win} {
2111 global ret_code
2112 if {$win ne {.}} return
2113 exit $ret_code
2114}
2115
2116proc do_quit {{rc {1}}} {
2117 global ui_comm is_quitting repo_config commit_type
2118 global GITGUI_BCK_exists GITGUI_BCK_i
2119 global ui_comm_spell
2120 global ret_code use_ttk
2121
2122 if {$is_quitting} return
2123 set is_quitting 1
2124
2125 if {[winfo exists $ui_comm]} {
2126 # -- Stash our current commit buffer.
2127 #
2128 set save [gitdir GITGUI_MSG]
2129 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2130 file rename -force [gitdir GITGUI_BCK] $save
2131 set GITGUI_BCK_exists 0
2132 } else {
2133 set msg [string trim [$ui_comm get 0.0 end]]
2134 regsub -all -line {[ \r\t]+$} $msg {} msg
2135 if {(![string match amend* $commit_type]
2136 || [$ui_comm edit modified])
2137 && $msg ne {}} {
2138 catch {
2139 set fd [open $save w]
2140 puts -nonewline $fd $msg
2141 close $fd
2142 }
2143 } else {
2144 catch {file delete $save}
2145 }
2146 }
2147
2148 # -- Cancel our spellchecker if its running.
2149 #
2150 if {[info exists ui_comm_spell]} {
2151 $ui_comm_spell stop
2152 }
2153
2154 # -- Remove our editor backup, its not needed.
2155 #
2156 after cancel $GITGUI_BCK_i
2157 if {$GITGUI_BCK_exists} {
2158 catch {file delete [gitdir GITGUI_BCK]}
2159 }
2160
2161 # -- Stash our current window geometry into this repository.
2162 #
2163 set cfg_wmstate [wm state .]
2164 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2165 set rc_wmstate {}
2166 }
2167 if {$cfg_wmstate ne $rc_wmstate} {
2168 catch {git config gui.wmstate $cfg_wmstate}
2169 }
2170 if {$cfg_wmstate eq {zoomed}} {
2171 # on Windows wm geometry will lie about window
2172 # position (but not size) when window is zoomed
2173 # restore the window before querying wm geometry
2174 wm state . normal
2175 }
2176 set cfg_geometry [list]
2177 lappend cfg_geometry [wm geometry .]
2178 if {$use_ttk} {
2179 lappend cfg_geometry [.vpane sashpos 0]
2180 lappend cfg_geometry [.vpane.files sashpos 0]
2181 } else {
2182 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2183 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2184 }
2185 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2186 set rc_geometry {}
2187 }
2188 if {$cfg_geometry ne $rc_geometry} {
2189 catch {git config gui.geometry $cfg_geometry}
2190 }
2191 }
2192
2193 set ret_code $rc
2194
2195 # Briefly enable send again, working around Tk bug
2196 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2197 tk appname [appname]
2198
2199 destroy .
2200}
2201
2202proc do_rescan {} {
2203 rescan ui_ready
2204}
2205
2206proc ui_do_rescan {} {
2207 rescan {force_first_diff ui_ready}
2208}
2209
2210proc do_commit {} {
2211 commit_tree
2212}
2213
2214proc next_diff {{after {}}} {
2215 global next_diff_p next_diff_w next_diff_i
2216 show_diff $next_diff_p $next_diff_w {} {} $after
2217}
2218
2219proc find_anchor_pos {lst name} {
2220 set lid [lsearch -sorted -exact $lst $name]
2221
2222 if {$lid == -1} {
2223 set lid 0
2224 foreach lname $lst {
2225 if {$lname >= $name} break
2226 incr lid
2227 }
2228 }
2229
2230 return $lid
2231}
2232
2233proc find_file_from {flist idx delta path mmask} {
2234 global file_states
2235
2236 set len [llength $flist]
2237 while {$idx >= 0 && $idx < $len} {
2238 set name [lindex $flist $idx]
2239
2240 if {$name ne $path && [info exists file_states($name)]} {
2241 set state [lindex $file_states($name) 0]
2242
2243 if {$mmask eq {} || [regexp $mmask $state]} {
2244 return $idx
2245 }
2246 }
2247
2248 incr idx $delta
2249 }
2250
2251 return {}
2252}
2253
2254proc find_next_diff {w path {lno {}} {mmask {}}} {
2255 global next_diff_p next_diff_w next_diff_i
2256 global file_lists ui_index ui_workdir
2257
2258 set flist $file_lists($w)
2259 if {$lno eq {}} {
2260 set lno [find_anchor_pos $flist $path]
2261 } else {
2262 incr lno -1
2263 }
2264
2265 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2266 if {$w eq $ui_index} {
2267 set mmask "^$mmask"
2268 } else {
2269 set mmask "$mmask\$"
2270 }
2271 }
2272
2273 set idx [find_file_from $flist $lno 1 $path $mmask]
2274 if {$idx eq {}} {
2275 incr lno -1
2276 set idx [find_file_from $flist $lno -1 $path $mmask]
2277 }
2278
2279 if {$idx ne {}} {
2280 set next_diff_w $w
2281 set next_diff_p [lindex $flist $idx]
2282 set next_diff_i [expr {$idx+1}]
2283 return 1
2284 } else {
2285 return 0
2286 }
2287}
2288
2289proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2290 global current_diff_path
2291
2292 if {$path ne $current_diff_path} {
2293 return {}
2294 } elseif {[find_next_diff $w $path $lno $mmask]} {
2295 return {next_diff;}
2296 } else {
2297 return {reshow_diff;}
2298 }
2299}
2300
2301proc select_first_diff {after} {
2302 global ui_workdir
2303
2304 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2305 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2306 next_diff $after
2307 } else {
2308 uplevel #0 $after
2309 }
2310}
2311
2312proc force_first_diff {after} {
2313 global ui_workdir current_diff_path file_states
2314
2315 if {[info exists file_states($current_diff_path)]} {
2316 set state [lindex $file_states($current_diff_path) 0]
2317 } else {
2318 set state {OO}
2319 }
2320
2321 set reselect 0
2322 if {[string first {U} $state] >= 0} {
2323 # Already a conflict, do nothing
2324 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2325 set reselect 1
2326 } elseif {[string index $state 1] ne {O}} {
2327 # Already a diff & no conflicts, do nothing
2328 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2329 set reselect 1
2330 }
2331
2332 if {$reselect} {
2333 next_diff $after
2334 } else {
2335 uplevel #0 $after
2336 }
2337}
2338
2339proc toggle_or_diff {w x y} {
2340 global file_states file_lists current_diff_path ui_index ui_workdir
2341 global last_clicked selected_paths
2342
2343 set pos [split [$w index @$x,$y] .]
2344 set lno [lindex $pos 0]
2345 set col [lindex $pos 1]
2346 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2347 if {$path eq {}} {
2348 set last_clicked {}
2349 return
2350 }
2351
2352 set last_clicked [list $w $lno]
2353 array unset selected_paths
2354 $ui_index tag remove in_sel 0.0 end
2355 $ui_workdir tag remove in_sel 0.0 end
2356
2357 # Determine the state of the file
2358 if {[info exists file_states($path)]} {
2359 set state [lindex $file_states($path) 0]
2360 } else {
2361 set state {__}
2362 }
2363
2364 # Restage the file, or simply show the diff
2365 if {$col == 0 && $y > 1} {
2366 # Conflicts need special handling
2367 if {[string first {U} $state] >= 0} {
2368 # $w must always be $ui_workdir, but...
2369 if {$w ne $ui_workdir} { set lno {} }
2370 merge_stage_workdir $path $lno
2371 return
2372 }
2373
2374 if {[string index $state 1] eq {O}} {
2375 set mmask {}
2376 } else {
2377 set mmask {[^O]}
2378 }
2379
2380 set after [next_diff_after_action $w $path $lno $mmask]
2381
2382 if {$w eq $ui_index} {
2383 update_indexinfo \
2384 "Unstaging [short_path $path] from commit" \
2385 [list $path] \
2386 [concat $after [list ui_ready]]
2387 } elseif {$w eq $ui_workdir} {
2388 update_index \
2389 "Adding [short_path $path]" \
2390 [list $path] \
2391 [concat $after [list ui_ready]]
2392 }
2393 } else {
2394 show_diff $path $w $lno
2395 }
2396}
2397
2398proc add_one_to_selection {w x y} {
2399 global file_lists last_clicked selected_paths
2400
2401 set lno [lindex [split [$w index @$x,$y] .] 0]
2402 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2403 if {$path eq {}} {
2404 set last_clicked {}
2405 return
2406 }
2407
2408 if {$last_clicked ne {}
2409 && [lindex $last_clicked 0] ne $w} {
2410 array unset selected_paths
2411 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2412 }
2413
2414 set last_clicked [list $w $lno]
2415 if {[catch {set in_sel $selected_paths($path)}]} {
2416 set in_sel 0
2417 }
2418 if {$in_sel} {
2419 unset selected_paths($path)
2420 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2421 } else {
2422 set selected_paths($path) 1
2423 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2424 }
2425}
2426
2427proc add_range_to_selection {w x y} {
2428 global file_lists last_clicked selected_paths
2429
2430 if {[lindex $last_clicked 0] ne $w} {
2431 toggle_or_diff $w $x $y
2432 return
2433 }
2434
2435 set lno [lindex [split [$w index @$x,$y] .] 0]
2436 set lc [lindex $last_clicked 1]
2437 if {$lc < $lno} {
2438 set begin $lc
2439 set end $lno
2440 } else {
2441 set begin $lno
2442 set end $lc
2443 }
2444
2445 foreach path [lrange $file_lists($w) \
2446 [expr {$begin - 1}] \
2447 [expr {$end - 1}]] {
2448 set selected_paths($path) 1
2449 }
2450 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2451}
2452
2453proc show_more_context {} {
2454 global repo_config
2455 if {$repo_config(gui.diffcontext) < 99} {
2456 incr repo_config(gui.diffcontext)
2457 reshow_diff
2458 }
2459}
2460
2461proc show_less_context {} {
2462 global repo_config
2463 if {$repo_config(gui.diffcontext) > 1} {
2464 incr repo_config(gui.diffcontext) -1
2465 reshow_diff
2466 }
2467}
2468
2469######################################################################
2470##
2471## ui construction
2472
2473set ui_comm {}
2474
2475# -- Menu Bar
2476#
2477menu .mbar -tearoff 0
2478if {[is_MacOSX]} {
2479 # -- Apple Menu (Mac OS X only)
2480 #
2481 .mbar add cascade -label Apple -menu .mbar.apple
2482 menu .mbar.apple
2483}
2484.mbar add cascade -label [mc Repository] -menu .mbar.repository
2485.mbar add cascade -label [mc Edit] -menu .mbar.edit
2486if {[is_enabled branch]} {
2487 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2488}
2489if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2490 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2491}
2492if {[is_enabled transport]} {
2493 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2494 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2495}
2496if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2497 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2498}
2499
2500# -- Repository Menu
2501#
2502menu .mbar.repository
2503
2504if {![is_bare]} {
2505 .mbar.repository add command \
2506 -label [mc "Explore Working Copy"] \
2507 -command {do_explore}
2508 .mbar.repository add separator
2509}
2510
2511.mbar.repository add command \
2512 -label [mc "Browse Current Branch's Files"] \
2513 -command {browser::new $current_branch}
2514set ui_browse_current [.mbar.repository index last]
2515.mbar.repository add command \
2516 -label [mc "Browse Branch Files..."] \
2517 -command browser_open::dialog
2518.mbar.repository add separator
2519
2520.mbar.repository add command \
2521 -label [mc "Visualize Current Branch's History"] \
2522 -command {do_gitk $current_branch}
2523set ui_visualize_current [.mbar.repository index last]
2524.mbar.repository add command \
2525 -label [mc "Visualize All Branch History"] \
2526 -command {do_gitk --all}
2527.mbar.repository add separator
2528
2529proc current_branch_write {args} {
2530 global current_branch
2531 .mbar.repository entryconf $::ui_browse_current \
2532 -label [mc "Browse %s's Files" $current_branch]
2533 .mbar.repository entryconf $::ui_visualize_current \
2534 -label [mc "Visualize %s's History" $current_branch]
2535}
2536trace add variable current_branch write current_branch_write
2537
2538if {[is_enabled multicommit]} {
2539 .mbar.repository add command -label [mc "Database Statistics"] \
2540 -command do_stats
2541
2542 .mbar.repository add command -label [mc "Compress Database"] \
2543 -command do_gc
2544
2545 .mbar.repository add command -label [mc "Verify Database"] \
2546 -command do_fsck_objects
2547
2548 .mbar.repository add separator
2549
2550 if {[is_Cygwin]} {
2551 .mbar.repository add command \
2552 -label [mc "Create Desktop Icon"] \
2553 -command do_cygwin_shortcut
2554 } elseif {[is_Windows]} {
2555 .mbar.repository add command \
2556 -label [mc "Create Desktop Icon"] \
2557 -command do_windows_shortcut
2558 } elseif {[is_MacOSX]} {
2559 .mbar.repository add command \
2560 -label [mc "Create Desktop Icon"] \
2561 -command do_macosx_app
2562 }
2563}
2564
2565if {[is_MacOSX]} {
2566 proc ::tk::mac::Quit {args} { do_quit }
2567} else {
2568 .mbar.repository add command -label [mc Quit] \
2569 -command do_quit \
2570 -accelerator $M1T-Q
2571}
2572
2573# -- Edit Menu
2574#
2575menu .mbar.edit
2576.mbar.edit add command -label [mc Undo] \
2577 -command {catch {[focus] edit undo}} \
2578 -accelerator $M1T-Z
2579.mbar.edit add command -label [mc Redo] \
2580 -command {catch {[focus] edit redo}} \
2581 -accelerator $M1T-Y
2582.mbar.edit add separator
2583.mbar.edit add command -label [mc Cut] \
2584 -command {catch {tk_textCut [focus]}} \
2585 -accelerator $M1T-X
2586.mbar.edit add command -label [mc Copy] \
2587 -command {catch {tk_textCopy [focus]}} \
2588 -accelerator $M1T-C
2589.mbar.edit add command -label [mc Paste] \
2590 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2591 -accelerator $M1T-V
2592.mbar.edit add command -label [mc Delete] \
2593 -command {catch {[focus] delete sel.first sel.last}} \
2594 -accelerator Del
2595.mbar.edit add separator
2596.mbar.edit add command -label [mc "Select All"] \
2597 -command {catch {[focus] tag add sel 0.0 end}} \
2598 -accelerator $M1T-A
2599
2600# -- Branch Menu
2601#
2602if {[is_enabled branch]} {
2603 menu .mbar.branch
2604
2605 .mbar.branch add command -label [mc "Create..."] \
2606 -command branch_create::dialog \
2607 -accelerator $M1T-N
2608 lappend disable_on_lock [list .mbar.branch entryconf \
2609 [.mbar.branch index last] -state]
2610
2611 .mbar.branch add command -label [mc "Checkout..."] \
2612 -command branch_checkout::dialog \
2613 -accelerator $M1T-O
2614 lappend disable_on_lock [list .mbar.branch entryconf \
2615 [.mbar.branch index last] -state]
2616
2617 .mbar.branch add command -label [mc "Rename..."] \
2618 -command branch_rename::dialog
2619 lappend disable_on_lock [list .mbar.branch entryconf \
2620 [.mbar.branch index last] -state]
2621
2622 .mbar.branch add command -label [mc "Delete..."] \
2623 -command branch_delete::dialog
2624 lappend disable_on_lock [list .mbar.branch entryconf \
2625 [.mbar.branch index last] -state]
2626
2627 .mbar.branch add command -label [mc "Reset..."] \
2628 -command merge::reset_hard
2629 lappend disable_on_lock [list .mbar.branch entryconf \
2630 [.mbar.branch index last] -state]
2631}
2632
2633# -- Commit Menu
2634#
2635proc commit_btn_caption {} {
2636 if {[is_enabled nocommit]} {
2637 return [mc "Done"]
2638 } else {
2639 return [mc Commit@@verb]
2640 }
2641}
2642
2643if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2644 menu .mbar.commit
2645
2646 if {![is_enabled nocommit]} {
2647 .mbar.commit add radiobutton \
2648 -label [mc "New Commit"] \
2649 -command do_select_commit_type \
2650 -variable selected_commit_type \
2651 -value new
2652 lappend disable_on_lock \
2653 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2654
2655 .mbar.commit add radiobutton \
2656 -label [mc "Amend Last Commit"] \
2657 -command do_select_commit_type \
2658 -variable selected_commit_type \
2659 -value amend
2660 lappend disable_on_lock \
2661 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2662
2663 .mbar.commit add separator
2664 }
2665
2666 .mbar.commit add command -label [mc Rescan] \
2667 -command ui_do_rescan \
2668 -accelerator F5
2669 lappend disable_on_lock \
2670 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2671
2672 .mbar.commit add command -label [mc "Stage To Commit"] \
2673 -command do_add_selection \
2674 -accelerator $M1T-T
2675 lappend disable_on_lock \
2676 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2677
2678 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2679 -command do_add_all \
2680 -accelerator $M1T-I
2681 lappend disable_on_lock \
2682 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2683
2684 .mbar.commit add command -label [mc "Unstage From Commit"] \
2685 -command do_unstage_selection \
2686 -accelerator $M1T-U
2687 lappend disable_on_lock \
2688 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2689
2690 .mbar.commit add command -label [mc "Revert Changes"] \
2691 -command do_revert_selection \
2692 -accelerator $M1T-J
2693 lappend disable_on_lock \
2694 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2695
2696 .mbar.commit add separator
2697
2698 .mbar.commit add command -label [mc "Show Less Context"] \
2699 -command show_less_context \
2700 -accelerator $M1T-\-
2701
2702 .mbar.commit add command -label [mc "Show More Context"] \
2703 -command show_more_context \
2704 -accelerator $M1T-=
2705
2706 .mbar.commit add separator
2707
2708 if {![is_enabled nocommitmsg]} {
2709 .mbar.commit add command -label [mc "Sign Off"] \
2710 -command do_signoff \
2711 -accelerator $M1T-S
2712 }
2713
2714 .mbar.commit add command -label [commit_btn_caption] \
2715 -command do_commit \
2716 -accelerator $M1T-Return
2717 lappend disable_on_lock \
2718 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2719}
2720
2721# -- Merge Menu
2722#
2723if {[is_enabled branch]} {
2724 menu .mbar.merge
2725 .mbar.merge add command -label [mc "Local Merge..."] \
2726 -command merge::dialog \
2727 -accelerator $M1T-M
2728 lappend disable_on_lock \
2729 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2730 .mbar.merge add command -label [mc "Abort Merge..."] \
2731 -command merge::reset_hard
2732 lappend disable_on_lock \
2733 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2734}
2735
2736# -- Transport Menu
2737#
2738if {[is_enabled transport]} {
2739 menu .mbar.remote
2740
2741 .mbar.remote add command \
2742 -label [mc "Add..."] \
2743 -command remote_add::dialog \
2744 -accelerator $M1T-A
2745 .mbar.remote add command \
2746 -label [mc "Push..."] \
2747 -command do_push_anywhere \
2748 -accelerator $M1T-P
2749 .mbar.remote add command \
2750 -label [mc "Delete Branch..."] \
2751 -command remote_branch_delete::dialog
2752}
2753
2754if {[is_MacOSX]} {
2755 proc ::tk::mac::ShowPreferences {} {do_options}
2756} else {
2757 # -- Edit Menu
2758 #
2759 .mbar.edit add separator
2760 .mbar.edit add command -label [mc "Options..."] \
2761 -command do_options
2762}
2763
2764# -- Tools Menu
2765#
2766if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2767 set tools_menubar .mbar.tools
2768 menu $tools_menubar
2769 $tools_menubar add separator
2770 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2771 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2772 set tools_tailcnt 3
2773 if {[array names repo_config guitool.*.cmd] ne {}} {
2774 tools_populate_all
2775 }
2776}
2777
2778# -- Help Menu
2779#
2780.mbar add cascade -label [mc Help] -menu .mbar.help
2781menu .mbar.help
2782
2783if {[is_MacOSX]} {
2784 .mbar.apple add command -label [mc "About %s" [appname]] \
2785 -command do_about
2786 .mbar.apple add separator
2787} else {
2788 .mbar.help add command -label [mc "About %s" [appname]] \
2789 -command do_about
2790}
2791. configure -menu .mbar
2792
2793set doc_path [githtmldir]
2794if {$doc_path ne {}} {
2795 set doc_path [file join $doc_path index.html]
2796
2797 if {[is_Cygwin]} {
2798 set doc_path [exec cygpath --mixed $doc_path]
2799 }
2800}
2801
2802if {[file isfile $doc_path]} {
2803 set doc_url "file:$doc_path"
2804} else {
2805 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2806}
2807
2808proc start_browser {url} {
2809 git "web--browse" $url
2810}
2811
2812.mbar.help add command -label [mc "Online Documentation"] \
2813 -command [list start_browser $doc_url]
2814
2815.mbar.help add command -label [mc "Show SSH Key"] \
2816 -command do_ssh_key
2817
2818unset doc_path doc_url
2819
2820# -- Standard bindings
2821#
2822wm protocol . WM_DELETE_WINDOW do_quit
2823bind all <$M1B-Key-q> do_quit
2824bind all <$M1B-Key-Q> do_quit
2825bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2826bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2827
2828set subcommand_args {}
2829proc usage {} {
2830 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2831 exit 1
2832}
2833
2834proc normalize_relpath {path} {
2835 set elements {}
2836 foreach item [file split $path] {
2837 if {$item eq {.}} continue
2838 if {$item eq {..} && [llength $elements] > 0
2839 && [lindex $elements end] ne {..}} {
2840 set elements [lrange $elements 0 end-1]
2841 continue
2842 }
2843 lappend elements $item
2844 }
2845 return [eval file join $elements]
2846}
2847
2848# -- Not a normal commit type invocation? Do that instead!
2849#
2850switch -- $subcommand {
2851browser -
2852blame {
2853 if {$subcommand eq "blame"} {
2854 set subcommand_args {[--line=<num>] rev? path}
2855 } else {
2856 set subcommand_args {rev? path}
2857 }
2858 if {$argv eq {}} usage
2859 set head {}
2860 set path {}
2861 set jump_spec {}
2862 set is_path 0
2863 foreach a $argv {
2864 if {$is_path || [file exists $_prefix$a]} {
2865 if {$path ne {}} usage
2866 set path [normalize_relpath $_prefix$a]
2867 break
2868 } elseif {$a eq {--}} {
2869 if {$path ne {}} {
2870 if {$head ne {}} usage
2871 set head $path
2872 set path {}
2873 }
2874 set is_path 1
2875 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2876 if {$jump_spec ne {} || $head ne {}} usage
2877 set jump_spec [list $lnum]
2878 } elseif {$head eq {}} {
2879 if {$head ne {}} usage
2880 set head $a
2881 set is_path 1
2882 } else {
2883 usage
2884 }
2885 }
2886 unset is_path
2887
2888 if {$head ne {} && $path eq {}} {
2889 set path [normalize_relpath $_prefix$head]
2890 set head {}
2891 }
2892
2893 if {$head eq {}} {
2894 load_current_branch
2895 } else {
2896 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2897 if {[catch {
2898 set head [git rev-parse --verify $head]
2899 } err]} {
2900 puts stderr $err
2901 exit 1
2902 }
2903 }
2904 set current_branch $head
2905 }
2906
2907 switch -- $subcommand {
2908 browser {
2909 if {$jump_spec ne {}} usage
2910 if {$head eq {}} {
2911 if {$path ne {} && [file isdirectory $path]} {
2912 set head $current_branch
2913 } else {
2914 set head $path
2915 set path {}
2916 }
2917 }
2918 browser::new $head $path
2919 }
2920 blame {
2921 if {$head eq {} && ![file exists $path]} {
2922 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2923 exit 1
2924 }
2925 blame::new $head $path $jump_spec
2926 }
2927 }
2928 return
2929}
2930citool -
2931gui {
2932 if {[llength $argv] != 0} {
2933 puts -nonewline stderr "usage: $argv0"
2934 if {$subcommand ne {gui}
2935 && [file tail $argv0] ne "git-$subcommand"} {
2936 puts -nonewline stderr " $subcommand"
2937 }
2938 puts stderr {}
2939 exit 1
2940 }
2941 # fall through to setup UI for commits
2942}
2943default {
2944 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2945 exit 1
2946}
2947}
2948
2949# -- Branch Control
2950#
2951${NS}::frame .branch
2952if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
2953${NS}::label .branch.l1 \
2954 -text [mc "Current Branch:"] \
2955 -anchor w \
2956 -justify left
2957${NS}::label .branch.cb \
2958 -textvariable current_branch \
2959 -anchor w \
2960 -justify left
2961pack .branch.l1 -side left
2962pack .branch.cb -side left -fill x
2963pack .branch -side top -fill x
2964
2965# -- Main Window Layout
2966#
2967${NS}::panedwindow .vpane -orient horizontal
2968${NS}::panedwindow .vpane.files -orient vertical
2969if {$use_ttk} {
2970 .vpane add .vpane.files
2971} else {
2972 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2973}
2974pack .vpane -anchor n -side top -fill both -expand 1
2975
2976# -- Index File List
2977#
2978${NS}::frame .vpane.files.index -height 100 -width 200
2979tlabel .vpane.files.index.title \
2980 -text [mc "Staged Changes (Will Commit)"] \
2981 -background lightgreen -foreground black
2982text $ui_index -background white -foreground black \
2983 -borderwidth 0 \
2984 -width 20 -height 10 \
2985 -wrap none \
2986 -cursor $cursor_ptr \
2987 -xscrollcommand {.vpane.files.index.sx set} \
2988 -yscrollcommand {.vpane.files.index.sy set} \
2989 -state disabled
2990${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2991${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2992pack .vpane.files.index.title -side top -fill x
2993pack .vpane.files.index.sx -side bottom -fill x
2994pack .vpane.files.index.sy -side right -fill y
2995pack $ui_index -side left -fill both -expand 1
2996
2997# -- Working Directory File List
2998#
2999${NS}::frame .vpane.files.workdir -height 100 -width 200
3000tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3001 -background lightsalmon -foreground black
3002text $ui_workdir -background white -foreground black \
3003 -borderwidth 0 \
3004 -width 20 -height 10 \
3005 -wrap none \
3006 -cursor $cursor_ptr \
3007 -xscrollcommand {.vpane.files.workdir.sx set} \
3008 -yscrollcommand {.vpane.files.workdir.sy set} \
3009 -state disabled
3010${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3011${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3012pack .vpane.files.workdir.title -side top -fill x
3013pack .vpane.files.workdir.sx -side bottom -fill x
3014pack .vpane.files.workdir.sy -side right -fill y
3015pack $ui_workdir -side left -fill both -expand 1
3016
3017.vpane.files add .vpane.files.workdir
3018.vpane.files add .vpane.files.index
3019if {!$use_ttk} {
3020 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3021 .vpane.files paneconfigure .vpane.files.index -sticky news
3022}
3023
3024foreach i [list $ui_index $ui_workdir] {
3025 rmsel_tag $i
3026 $i tag conf in_diff -background [$i tag cget in_sel -background]
3027}
3028unset i
3029
3030# -- Diff and Commit Area
3031#
3032${NS}::frame .vpane.lower -height 300 -width 400
3033${NS}::frame .vpane.lower.commarea
3034${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3035pack .vpane.lower.diff -fill both -expand 1
3036pack .vpane.lower.commarea -side bottom -fill x
3037.vpane add .vpane.lower
3038if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3039
3040# -- Commit Area Buttons
3041#
3042${NS}::frame .vpane.lower.commarea.buttons
3043${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3044 -anchor w \
3045 -justify left
3046pack .vpane.lower.commarea.buttons.l -side top -fill x
3047pack .vpane.lower.commarea.buttons -side left -fill y
3048
3049${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3050 -command ui_do_rescan
3051pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3052lappend disable_on_lock \
3053 {.vpane.lower.commarea.buttons.rescan conf -state}
3054
3055${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3056 -command do_add_all
3057pack .vpane.lower.commarea.buttons.incall -side top -fill x
3058lappend disable_on_lock \
3059 {.vpane.lower.commarea.buttons.incall conf -state}
3060
3061if {![is_enabled nocommitmsg]} {
3062 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3063 -command do_signoff
3064 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3065}
3066
3067${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3068 -command do_commit
3069pack .vpane.lower.commarea.buttons.commit -side top -fill x
3070lappend disable_on_lock \
3071 {.vpane.lower.commarea.buttons.commit conf -state}
3072
3073if {![is_enabled nocommit]} {
3074 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3075 -command do_push_anywhere
3076 pack .vpane.lower.commarea.buttons.push -side top -fill x
3077}
3078
3079# -- Commit Message Buffer
3080#
3081${NS}::frame .vpane.lower.commarea.buffer
3082${NS}::frame .vpane.lower.commarea.buffer.header
3083set ui_comm .vpane.lower.commarea.buffer.t
3084set ui_coml .vpane.lower.commarea.buffer.header.l
3085
3086if {![is_enabled nocommit]} {
3087 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3088 -text [mc "New Commit"] \
3089 -command do_select_commit_type \
3090 -variable selected_commit_type \
3091 -value new
3092 lappend disable_on_lock \
3093 [list .vpane.lower.commarea.buffer.header.new conf -state]
3094 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3095 -text [mc "Amend Last Commit"] \
3096 -command do_select_commit_type \
3097 -variable selected_commit_type \
3098 -value amend
3099 lappend disable_on_lock \
3100 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3101}
3102
3103${NS}::label $ui_coml \
3104 -anchor w \
3105 -justify left
3106proc trace_commit_type {varname args} {
3107 global ui_coml commit_type
3108 switch -glob -- $commit_type {
3109 initial {set txt [mc "Initial Commit Message:"]}
3110 amend {set txt [mc "Amended Commit Message:"]}
3111 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3112 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3113 merge {set txt [mc "Merge Commit Message:"]}
3114 * {set txt [mc "Commit Message:"]}
3115 }
3116 $ui_coml conf -text $txt
3117}
3118trace add variable commit_type write trace_commit_type
3119pack $ui_coml -side left -fill x
3120
3121if {![is_enabled nocommit]} {
3122 pack .vpane.lower.commarea.buffer.header.amend -side right
3123 pack .vpane.lower.commarea.buffer.header.new -side right
3124}
3125
3126text $ui_comm -background white -foreground black \
3127 -borderwidth 1 \
3128 -undo true \
3129 -maxundo 20 \
3130 -autoseparators true \
3131 -relief sunken \
3132 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3133 -font font_diff \
3134 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3135${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3136 -command [list $ui_comm yview]
3137pack .vpane.lower.commarea.buffer.header -side top -fill x
3138pack .vpane.lower.commarea.buffer.sby -side right -fill y
3139pack $ui_comm -side left -fill y
3140pack .vpane.lower.commarea.buffer -side left -fill y
3141
3142# -- Commit Message Buffer Context Menu
3143#
3144set ctxm .vpane.lower.commarea.buffer.ctxm
3145menu $ctxm -tearoff 0
3146$ctxm add command \
3147 -label [mc Cut] \
3148 -command {tk_textCut $ui_comm}
3149$ctxm add command \
3150 -label [mc Copy] \
3151 -command {tk_textCopy $ui_comm}
3152$ctxm add command \
3153 -label [mc Paste] \
3154 -command {tk_textPaste $ui_comm}
3155$ctxm add command \
3156 -label [mc Delete] \
3157 -command {catch {$ui_comm delete sel.first sel.last}}
3158$ctxm add separator
3159$ctxm add command \
3160 -label [mc "Select All"] \
3161 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3162$ctxm add command \
3163 -label [mc "Copy All"] \
3164 -command {
3165 $ui_comm tag add sel 0.0 end
3166 tk_textCopy $ui_comm
3167 $ui_comm tag remove sel 0.0 end
3168 }
3169$ctxm add separator
3170$ctxm add command \
3171 -label [mc "Sign Off"] \
3172 -command do_signoff
3173set ui_comm_ctxm $ctxm
3174
3175# -- Diff Header
3176#
3177proc trace_current_diff_path {varname args} {
3178 global current_diff_path diff_actions file_states
3179 if {$current_diff_path eq {}} {
3180 set s {}
3181 set f {}
3182 set p {}
3183 set o disabled
3184 } else {
3185 set p $current_diff_path
3186 set s [mapdesc [lindex $file_states($p) 0] $p]
3187 set f [mc "File:"]
3188 set p [escape_path $p]
3189 set o normal
3190 }
3191
3192 .vpane.lower.diff.header.status configure -text $s
3193 .vpane.lower.diff.header.file configure -text $f
3194 .vpane.lower.diff.header.path configure -text $p
3195 foreach w $diff_actions {
3196 uplevel #0 $w $o
3197 }
3198}
3199trace add variable current_diff_path write trace_current_diff_path
3200
3201gold_frame .vpane.lower.diff.header
3202tlabel .vpane.lower.diff.header.status \
3203 -background gold \
3204 -foreground black \
3205 -width $max_status_desc \
3206 -anchor w \
3207 -justify left
3208tlabel .vpane.lower.diff.header.file \
3209 -background gold \
3210 -foreground black \
3211 -anchor w \
3212 -justify left
3213tlabel .vpane.lower.diff.header.path \
3214 -background gold \
3215 -foreground black \
3216 -anchor w \
3217 -justify left
3218pack .vpane.lower.diff.header.status -side left
3219pack .vpane.lower.diff.header.file -side left
3220pack .vpane.lower.diff.header.path -fill x
3221set ctxm .vpane.lower.diff.header.ctxm
3222menu $ctxm -tearoff 0
3223$ctxm add command \
3224 -label [mc Copy] \
3225 -command {
3226 clipboard clear
3227 clipboard append \
3228 -format STRING \
3229 -type STRING \
3230 -- $current_diff_path
3231 }
3232lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3233bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3234
3235# -- Diff Body
3236#
3237${NS}::frame .vpane.lower.diff.body
3238set ui_diff .vpane.lower.diff.body.t
3239text $ui_diff -background white -foreground black \
3240 -borderwidth 0 \
3241 -width 80 -height 5 -wrap none \
3242 -font font_diff \
3243 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3244 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3245 -state disabled
3246${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3247 -command [list $ui_diff xview]
3248${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3249 -command [list $ui_diff yview]
3250pack .vpane.lower.diff.body.sbx -side bottom -fill x
3251pack .vpane.lower.diff.body.sby -side right -fill y
3252pack $ui_diff -side left -fill both -expand 1
3253pack .vpane.lower.diff.header -side top -fill x
3254pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3255
3256$ui_diff tag conf d_cr -elide true
3257$ui_diff tag conf d_@ -foreground blue -font font_diffbold
3258$ui_diff tag conf d_+ -foreground {#00a000}
3259$ui_diff tag conf d_- -foreground red
3260
3261$ui_diff tag conf d_++ -foreground {#00a000}
3262$ui_diff tag conf d_-- -foreground red
3263$ui_diff tag conf d_+s \
3264 -foreground {#00a000} \
3265 -background {#e2effa}
3266$ui_diff tag conf d_-s \
3267 -foreground red \
3268 -background {#e2effa}
3269$ui_diff tag conf d_s+ \
3270 -foreground {#00a000} \
3271 -background ivory1
3272$ui_diff tag conf d_s- \
3273 -foreground red \
3274 -background ivory1
3275
3276$ui_diff tag conf d<<<<<<< \
3277 -foreground orange \
3278 -font font_diffbold
3279$ui_diff tag conf d======= \
3280 -foreground orange \
3281 -font font_diffbold
3282$ui_diff tag conf d>>>>>>> \
3283 -foreground orange \
3284 -font font_diffbold
3285
3286$ui_diff tag raise sel
3287
3288# -- Diff Body Context Menu
3289#
3290
3291proc create_common_diff_popup {ctxm} {
3292 $ctxm add command \
3293 -label [mc Refresh] \
3294 -command reshow_diff
3295 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3296 $ctxm add command \
3297 -label [mc Copy] \
3298 -command {tk_textCopy $ui_diff}
3299 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3300 $ctxm add command \
3301 -label [mc "Select All"] \
3302 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3303 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3304 $ctxm add command \
3305 -label [mc "Copy All"] \
3306 -command {
3307 $ui_diff tag add sel 0.0 end
3308 tk_textCopy $ui_diff
3309 $ui_diff tag remove sel 0.0 end
3310 }
3311 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3312 $ctxm add separator
3313 $ctxm add command \
3314 -label [mc "Decrease Font Size"] \
3315 -command {incr_font_size font_diff -1}
3316 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3317 $ctxm add command \
3318 -label [mc "Increase Font Size"] \
3319 -command {incr_font_size font_diff 1}
3320 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3321 $ctxm add separator
3322 set emenu $ctxm.enc
3323 menu $emenu
3324 build_encoding_menu $emenu [list force_diff_encoding]
3325 $ctxm add cascade \
3326 -label [mc "Encoding"] \
3327 -menu $emenu
3328 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3329 $ctxm add separator
3330 $ctxm add command -label [mc "Options..."] \
3331 -command do_options
3332}
3333
3334set ctxm .vpane.lower.diff.body.ctxm
3335menu $ctxm -tearoff 0
3336$ctxm add command \
3337 -label [mc "Apply/Reverse Hunk"] \
3338 -command {apply_hunk $cursorX $cursorY}
3339set ui_diff_applyhunk [$ctxm index last]
3340lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3341$ctxm add command \
3342 -label [mc "Apply/Reverse Line"] \
3343 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3344set ui_diff_applyline [$ctxm index last]
3345lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3346$ctxm add separator
3347$ctxm add command \
3348 -label [mc "Show Less Context"] \
3349 -command show_less_context
3350lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3351$ctxm add command \
3352 -label [mc "Show More Context"] \
3353 -command show_more_context
3354lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3355$ctxm add separator
3356create_common_diff_popup $ctxm
3357
3358set ctxmmg .vpane.lower.diff.body.ctxmmg
3359menu $ctxmmg -tearoff 0
3360$ctxmmg add command \
3361 -label [mc "Run Merge Tool"] \
3362 -command {merge_resolve_tool}
3363lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3364$ctxmmg add separator
3365$ctxmmg add command \
3366 -label [mc "Use Remote Version"] \
3367 -command {merge_resolve_one 3}
3368lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3369$ctxmmg add command \
3370 -label [mc "Use Local Version"] \
3371 -command {merge_resolve_one 2}
3372lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3373$ctxmmg add command \
3374 -label [mc "Revert To Base"] \
3375 -command {merge_resolve_one 1}
3376lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3377$ctxmmg add separator
3378$ctxmmg add command \
3379 -label [mc "Show Less Context"] \
3380 -command show_less_context
3381lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3382$ctxmmg add command \
3383 -label [mc "Show More Context"] \
3384 -command show_more_context
3385lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3386$ctxmmg add separator
3387create_common_diff_popup $ctxmmg
3388
3389set ctxmsm .vpane.lower.diff.body.ctxmsm
3390menu $ctxmsm -tearoff 0
3391$ctxmsm add command \
3392 -label [mc "Visualize These Changes In The Submodule"] \
3393 -command {do_gitk -- true}
3394lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3395$ctxmsm add command \
3396 -label [mc "Visualize Current Branch History In The Submodule"] \
3397 -command {do_gitk {} true}
3398lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3399$ctxmsm add command \
3400 -label [mc "Visualize All Branch History In The Submodule"] \
3401 -command {do_gitk --all true}
3402lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3403$ctxmsm add separator
3404$ctxmsm add command \
3405 -label [mc "Start git gui In The Submodule"] \
3406 -command {do_git_gui}
3407lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3408$ctxmsm add separator
3409create_common_diff_popup $ctxmsm
3410
3411proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3412 global current_diff_path file_states
3413 set ::cursorX $x
3414 set ::cursorY $y
3415 if {[info exists file_states($current_diff_path)]} {
3416 set state [lindex $file_states($current_diff_path) 0]
3417 } else {
3418 set state {__}
3419 }
3420 if {[string first {U} $state] >= 0} {
3421 tk_popup $ctxmmg $X $Y
3422 } elseif {$::is_submodule_diff} {
3423 tk_popup $ctxmsm $X $Y
3424 } else {
3425 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3426 if {$::ui_index eq $::current_diff_side} {
3427 set l [mc "Unstage Hunk From Commit"]
3428 if {$has_range} {
3429 set t [mc "Unstage Lines From Commit"]
3430 } else {
3431 set t [mc "Unstage Line From Commit"]
3432 }
3433 } else {
3434 set l [mc "Stage Hunk For Commit"]
3435 if {$has_range} {
3436 set t [mc "Stage Lines For Commit"]
3437 } else {
3438 set t [mc "Stage Line For Commit"]
3439 }
3440 }
3441 if {$::is_3way_diff
3442 || $current_diff_path eq {}
3443 || {__} eq $state
3444 || {_O} eq $state
3445 || {_T} eq $state
3446 || {T_} eq $state} {
3447 set s disabled
3448 } else {
3449 set s normal
3450 }
3451 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3452 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3453 tk_popup $ctxm $X $Y
3454 }
3455}
3456bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3457
3458# -- Status Bar
3459#
3460set main_status [::status_bar::new .status]
3461pack .status -anchor w -side bottom -fill x
3462$main_status show [mc "Initializing..."]
3463
3464# -- Load geometry
3465#
3466catch {
3467set gm $repo_config(gui.geometry)
3468wm geometry . [lindex $gm 0]
3469if {$use_ttk} {
3470 .vpane sashpos 0 [lindex $gm 1]
3471 .vpane.files sashpos 0 [lindex $gm 2]
3472} else {
3473 .vpane sash place 0 \
3474 [lindex $gm 1] \
3475 [lindex [.vpane sash coord 0] 1]
3476 .vpane.files sash place 0 \
3477 [lindex [.vpane.files sash coord 0] 0] \
3478 [lindex $gm 2]
3479}
3480unset gm
3481}
3482
3483# -- Load window state
3484#
3485catch {
3486set gws $repo_config(gui.wmstate)
3487wm state . $gws
3488unset gws
3489}
3490
3491# -- Key Bindings
3492#
3493bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3494bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3495bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3496bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3497bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3498bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3499bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3500bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3501bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3502bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3503bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3504bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3505bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3506bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3507bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3508bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3509bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3510bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3511bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3512bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3513bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3514bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3515
3516bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3517bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3518bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3519bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3520bind $ui_diff <$M1B-Key-v> {break}
3521bind $ui_diff <$M1B-Key-V> {break}
3522bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3523bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3524bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3525bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3526bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3527bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3528bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3529bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3530bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3531bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3532bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3533bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3534bind $ui_diff <Button-1> {focus %W}
3535
3536if {[is_enabled branch]} {
3537 bind . <$M1B-Key-n> branch_create::dialog
3538 bind . <$M1B-Key-N> branch_create::dialog
3539 bind . <$M1B-Key-o> branch_checkout::dialog
3540 bind . <$M1B-Key-O> branch_checkout::dialog
3541 bind . <$M1B-Key-m> merge::dialog
3542 bind . <$M1B-Key-M> merge::dialog
3543}
3544if {[is_enabled transport]} {
3545 bind . <$M1B-Key-p> do_push_anywhere
3546 bind . <$M1B-Key-P> do_push_anywhere
3547}
3548
3549bind . <Key-F5> ui_do_rescan
3550bind . <$M1B-Key-r> ui_do_rescan
3551bind . <$M1B-Key-R> ui_do_rescan
3552bind . <$M1B-Key-s> do_signoff
3553bind . <$M1B-Key-S> do_signoff
3554bind . <$M1B-Key-t> do_add_selection
3555bind . <$M1B-Key-T> do_add_selection
3556bind . <$M1B-Key-j> do_revert_selection
3557bind . <$M1B-Key-J> do_revert_selection
3558bind . <$M1B-Key-i> do_add_all
3559bind . <$M1B-Key-I> do_add_all
3560bind . <$M1B-Key-minus> {show_less_context;break}
3561bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3562bind . <$M1B-Key-equal> {show_more_context;break}
3563bind . <$M1B-Key-plus> {show_more_context;break}
3564bind . <$M1B-Key-KP_Add> {show_more_context;break}
3565bind . <$M1B-Key-Return> do_commit
3566foreach i [list $ui_index $ui_workdir] {
3567 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3568 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3569 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3570}
3571unset i
3572
3573set file_lists($ui_index) [list]
3574set file_lists($ui_workdir) [list]
3575
3576wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3577focus -force $ui_comm
3578
3579# -- Warn the user about environmental problems. Cygwin's Tcl
3580# does *not* pass its env array onto any processes it spawns.
3581# This means that git processes get none of our environment.
3582#
3583if {[is_Cygwin]} {
3584 set ignored_env 0
3585 set suggest_user {}
3586 set msg [mc "Possible environment issues exist.
3587
3588The following environment variables are probably
3589going to be ignored by any Git subprocess run
3590by %s:
3591
3592" [appname]]
3593 foreach name [array names env] {
3594 switch -regexp -- $name {
3595 {^GIT_INDEX_FILE$} -
3596 {^GIT_OBJECT_DIRECTORY$} -
3597 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3598 {^GIT_DIFF_OPTS$} -
3599 {^GIT_EXTERNAL_DIFF$} -
3600 {^GIT_PAGER$} -
3601 {^GIT_TRACE$} -
3602 {^GIT_CONFIG$} -
3603 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3604 append msg " - $name\n"
3605 incr ignored_env
3606 }
3607 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3608 append msg " - $name\n"
3609 incr ignored_env
3610 set suggest_user $name
3611 }
3612 }
3613 }
3614 if {$ignored_env > 0} {
3615 append msg [mc "
3616This is due to a known issue with the
3617Tcl binary distributed by Cygwin."]
3618
3619 if {$suggest_user ne {}} {
3620 append msg [mc "
3621
3622A good replacement for %s
3623is placing values for the user.name and
3624user.email settings into your personal
3625~/.gitconfig file.
3626" $suggest_user]
3627 }
3628 warn_popup $msg
3629 }
3630 unset ignored_env msg suggest_user name
3631}
3632
3633# -- Only initialize complex UI if we are going to stay running.
3634#
3635if {[is_enabled transport]} {
3636 load_all_remotes
3637
3638 set n [.mbar.remote index end]
3639 populate_remotes_menu
3640 set n [expr {[.mbar.remote index end] - $n}]
3641 if {$n > 0} {
3642 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3643 .mbar.remote insert $n separator
3644 }
3645 unset n
3646}
3647
3648if {[winfo exists $ui_comm]} {
3649 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3650
3651 # -- If both our backup and message files exist use the
3652 # newer of the two files to initialize the buffer.
3653 #
3654 if {$GITGUI_BCK_exists} {
3655 set m [gitdir GITGUI_MSG]
3656 if {[file isfile $m]} {
3657 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3658 catch {file delete [gitdir GITGUI_MSG]}
3659 } else {
3660 $ui_comm delete 0.0 end
3661 $ui_comm edit reset
3662 $ui_comm edit modified false
3663 catch {file delete [gitdir GITGUI_BCK]}
3664 set GITGUI_BCK_exists 0
3665 }
3666 }
3667 unset m
3668 }
3669
3670 proc backup_commit_buffer {} {
3671 global ui_comm GITGUI_BCK_exists
3672
3673 set m [$ui_comm edit modified]
3674 if {$m || $GITGUI_BCK_exists} {
3675 set msg [string trim [$ui_comm get 0.0 end]]
3676 regsub -all -line {[ \r\t]+$} $msg {} msg
3677
3678 if {$msg eq {}} {
3679 if {$GITGUI_BCK_exists} {
3680 catch {file delete [gitdir GITGUI_BCK]}
3681 set GITGUI_BCK_exists 0
3682 }
3683 } elseif {$m} {
3684 catch {
3685 set fd [open [gitdir GITGUI_BCK] w]
3686 puts -nonewline $fd $msg
3687 close $fd
3688 set GITGUI_BCK_exists 1
3689 }
3690 }
3691
3692 $ui_comm edit modified false
3693 }
3694
3695 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3696 }
3697
3698 backup_commit_buffer
3699
3700 # -- If the user has aspell available we can drive it
3701 # in pipe mode to spellcheck the commit message.
3702 #
3703 set spell_cmd [list |]
3704 set spell_dict [get_config gui.spellingdictionary]
3705 lappend spell_cmd aspell
3706 if {$spell_dict ne {}} {
3707 lappend spell_cmd --master=$spell_dict
3708 }
3709 lappend spell_cmd --mode=none
3710 lappend spell_cmd --encoding=utf-8
3711 lappend spell_cmd pipe
3712 if {$spell_dict eq {none}
3713 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3714 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3715 } else {
3716 set ui_comm_spell [spellcheck::init \
3717 $spell_fd \
3718 $ui_comm \
3719 $ui_comm_ctxm \
3720 ]
3721 }
3722 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3723}
3724
3725lock_index begin-read
3726if {![winfo ismapped .]} {
3727 wm deiconify .
3728}
3729after 1 {
3730 if {[is_enabled initialamend]} {
3731 force_amend
3732 } else {
3733 do_rescan
3734 }
3735
3736 if {[is_enabled nocommitmsg]} {
3737 $ui_comm configure -state disabled -background gray
3738 }
3739}
3740if {[is_enabled multicommit]} {
3741 after 1000 hint_gc
3742}
3743if {[is_enabled retcode]} {
3744 bind . <Destroy> {+terminate_me %W}
3745}
3746if {$picked && [is_config_true gui.autoexplore]} {
3747 do_explore
3748}
3749
3750# Local variables:
3751# mode: tcl
3752# indent-tabs-mode: t
3753# tab-width: 4
3754# End: