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