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