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