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