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