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