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