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