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