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