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