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