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