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