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