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.5} err]
34 || [catch {package require Tk  8.5} 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	bind $text <Motion> break
724	return $text
725}
726
727wm withdraw .
728set root_exists 0
729bind . <Visibility> {
730	bind . <Visibility> {}
731	set root_exists 1
732}
733
734if {[is_Windows]} {
735	wm iconbitmap . -default $oguilib/git-gui.ico
736	set ::tk::AlwaysShowSelection 1
737	bind . <Control-F2> {console show}
738
739	# Spoof an X11 display for SSH
740	if {![info exists env(DISPLAY)]} {
741		set env(DISPLAY) :9999
742	}
743} else {
744	catch {
745		image create photo gitlogo -width 16 -height 16
746
747		gitlogo put #33CC33 -to  7  0  9  2
748		gitlogo put #33CC33 -to  4  2 12  4
749		gitlogo put #33CC33 -to  7  4  9  6
750		gitlogo put #CC3333 -to  4  6 12  8
751		gitlogo put gray26  -to  4  9  6 10
752		gitlogo put gray26  -to  3 10  6 12
753		gitlogo put gray26  -to  8  9 13 11
754		gitlogo put gray26  -to  8 11 10 12
755		gitlogo put gray26  -to 11 11 13 14
756		gitlogo put gray26  -to  3 12  5 14
757		gitlogo put gray26  -to  5 13
758		gitlogo put gray26  -to 10 13
759		gitlogo put gray26  -to  4 14 12 15
760		gitlogo put gray26  -to  5 15 11 16
761		gitlogo redither
762
763		image create photo gitlogo32 -width 32 -height 32
764		gitlogo32 copy gitlogo -zoom 2 2
765
766		wm iconphoto . -default gitlogo gitlogo32
767	}
768}
769
770######################################################################
771##
772## config defaults
773
774set cursor_ptr arrow
775font create font_ui
776if {[lsearch -exact [font names] TkDefaultFont] != -1} {
777	eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
778	eval [linsert [font actual TkFixedFont] 0 font create font_diff]
779} else {
780	font create font_diff -family Courier -size 10
781	catch {
782		label .dummy
783		eval font configure font_ui [font actual [.dummy cget -font]]
784		destroy .dummy
785	}
786}
787
788font create font_uiitalic
789font create font_uibold
790font create font_diffbold
791font create font_diffitalic
792
793foreach class {Button Checkbutton Entry Label
794		Labelframe Listbox Message
795		Radiobutton Spinbox Text} {
796	option add *$class.font font_ui
797}
798if {![is_MacOSX]} {
799	option add *Menu.font font_ui
800	option add *Entry.borderWidth 1 startupFile
801	option add *Entry.relief sunken startupFile
802	option add *RadioButton.anchor w startupFile
803}
804unset class
805
806if {[is_Windows] || [is_MacOSX]} {
807	option add *Menu.tearOff 0
808}
809
810if {[is_MacOSX]} {
811	set M1B M1
812	set M1T Cmd
813} else {
814	set M1B Control
815	set M1T Ctrl
816}
817
818proc bind_button3 {w cmd} {
819	bind $w <Any-Button-3> $cmd
820	if {[is_MacOSX]} {
821		# Mac OS X sends Button-2 on right click through three-button mouse,
822		# or through trackpad right-clicking (two-finger touch + click).
823		bind $w <Any-Button-2> $cmd
824		bind $w <Control-Button-1> $cmd
825	}
826}
827
828proc apply_config {} {
829	global repo_config font_descs
830
831	foreach option $font_descs {
832		set name [lindex $option 0]
833		set font [lindex $option 1]
834		if {[catch {
835			set need_weight 1
836			foreach {cn cv} $repo_config(gui.$name) {
837				if {$cn eq {-weight}} {
838					set need_weight 0
839				}
840				font configure $font $cn $cv
841			}
842			if {$need_weight} {
843				font configure $font -weight normal
844			}
845			} err]} {
846			error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
847		}
848		foreach {cn cv} [font configure $font] {
849			font configure ${font}bold $cn $cv
850			font configure ${font}italic $cn $cv
851		}
852		font configure ${font}bold -weight bold
853		font configure ${font}italic -slant italic
854	}
855
856	global use_ttk NS
857	set use_ttk 0
858	set NS {}
859	if {$repo_config(gui.usettk)} {
860		set use_ttk [package vsatisfies [package provide Tk] 8.5]
861		if {$use_ttk} {
862			set NS ttk
863			bind [winfo class .] <<ThemeChanged>> [list InitTheme]
864			pave_toplevel .
865			color::sync_with_theme
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		} elseif {[load_message [get_config commit.template]]} {
1483		}
1484		$ui_comm edit reset
1485		$ui_comm edit modified false
1486	}
1487
1488	if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1489		rescan_stage2 {} $after
1490	} else {
1491		set rescan_active 1
1492		ui_status [mc "Refreshing file status..."]
1493		set fd_rf [git_read update-index \
1494			-q \
1495			--unmerged \
1496			--ignore-missing \
1497			--refresh \
1498			]
1499		fconfigure $fd_rf -blocking 0 -translation binary
1500		fileevent $fd_rf readable \
1501			[list rescan_stage2 $fd_rf $after]
1502	}
1503}
1504
1505if {[is_Cygwin]} {
1506	set is_git_info_exclude {}
1507	proc have_info_exclude {} {
1508		global is_git_info_exclude
1509
1510		if {$is_git_info_exclude eq {}} {
1511			if {[catch {exec test -f [gitdir info exclude]}]} {
1512				set is_git_info_exclude 0
1513			} else {
1514				set is_git_info_exclude 1
1515			}
1516		}
1517		return $is_git_info_exclude
1518	}
1519} else {
1520	proc have_info_exclude {} {
1521		return [file readable [gitdir info exclude]]
1522	}
1523}
1524
1525proc rescan_stage2 {fd after} {
1526	global rescan_active buf_rdi buf_rdf buf_rlo
1527
1528	if {$fd ne {}} {
1529		read $fd
1530		if {![eof $fd]} return
1531		close $fd
1532	}
1533
1534	if {[package vcompare $::_git_version 1.6.3] >= 0} {
1535		set ls_others [list --exclude-standard]
1536	} else {
1537		set ls_others [list --exclude-per-directory=.gitignore]
1538		if {[have_info_exclude]} {
1539			lappend ls_others "--exclude-from=[gitdir info exclude]"
1540		}
1541		set user_exclude [get_config core.excludesfile]
1542		if {$user_exclude ne {} && [file readable $user_exclude]} {
1543			lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1544		}
1545	}
1546
1547	set buf_rdi {}
1548	set buf_rdf {}
1549	set buf_rlo {}
1550
1551	set rescan_active 2
1552	ui_status [mc "Scanning for modified files ..."]
1553	if {[git-version >= "1.7.2"]} {
1554		set fd_di [git_read diff-index --cached --ignore-submodules=dirty -z [PARENT]]
1555	} else {
1556		set fd_di [git_read diff-index --cached -z [PARENT]]
1557	}
1558	set fd_df [git_read diff-files -z]
1559
1560	fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1561	fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1562
1563	fileevent $fd_di readable [list read_diff_index $fd_di $after]
1564	fileevent $fd_df readable [list read_diff_files $fd_df $after]
1565
1566	if {[is_config_true gui.displayuntracked]} {
1567		set fd_lo [eval git_read ls-files --others -z $ls_others]
1568		fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1569		fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1570		incr rescan_active
1571	}
1572}
1573
1574proc load_message {file {encoding {}}} {
1575	global ui_comm
1576
1577	set f [gitdir $file]
1578	if {[file isfile $f]} {
1579		if {[catch {set fd [open $f r]}]} {
1580			return 0
1581		}
1582		fconfigure $fd -eofchar {}
1583		if {$encoding ne {}} {
1584			fconfigure $fd -encoding $encoding
1585		}
1586		set content [string trim [read $fd]]
1587		close $fd
1588		regsub -all -line {[ \r\t]+$} $content {} content
1589		$ui_comm delete 0.0 end
1590		$ui_comm insert end $content
1591		return 1
1592	}
1593	return 0
1594}
1595
1596proc run_prepare_commit_msg_hook {} {
1597	global pch_error
1598
1599	# prepare-commit-msg requires PREPARE_COMMIT_MSG exist.  From git-gui
1600	# it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1601	# empty file but existent file.
1602
1603	set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1604
1605	if {[file isfile [gitdir MERGE_MSG]]} {
1606		set pcm_source "merge"
1607		set fd_mm [open [gitdir MERGE_MSG] r]
1608		fconfigure $fd_mm -encoding utf-8
1609		puts -nonewline $fd_pcm [read $fd_mm]
1610		close $fd_mm
1611	} elseif {[file isfile [gitdir SQUASH_MSG]]} {
1612		set pcm_source "squash"
1613		set fd_sm [open [gitdir SQUASH_MSG] r]
1614		fconfigure $fd_sm -encoding utf-8
1615		puts -nonewline $fd_pcm [read $fd_sm]
1616		close $fd_sm
1617	} elseif {[file isfile [get_config commit.template]]} {
1618		set pcm_source "template"
1619		set fd_sm [open [get_config commit.template] r]
1620		fconfigure $fd_sm -encoding utf-8
1621		puts -nonewline $fd_pcm [read $fd_sm]
1622		close $fd_sm
1623	} else {
1624		set pcm_source ""
1625	}
1626
1627	close $fd_pcm
1628
1629	set fd_ph [githook_read prepare-commit-msg \
1630			[gitdir PREPARE_COMMIT_MSG] $pcm_source]
1631	if {$fd_ph eq {}} {
1632		catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1633		return 0;
1634	}
1635
1636	ui_status [mc "Calling prepare-commit-msg hook..."]
1637	set pch_error {}
1638
1639	fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1640	fileevent $fd_ph readable \
1641		[list prepare_commit_msg_hook_wait $fd_ph]
1642
1643	return 1;
1644}
1645
1646proc prepare_commit_msg_hook_wait {fd_ph} {
1647	global pch_error
1648
1649	append pch_error [read $fd_ph]
1650	fconfigure $fd_ph -blocking 1
1651	if {[eof $fd_ph]} {
1652		if {[catch {close $fd_ph}]} {
1653			ui_status [mc "Commit declined by prepare-commit-msg hook."]
1654			hook_failed_popup prepare-commit-msg $pch_error
1655			catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1656			exit 1
1657		} else {
1658			load_message PREPARE_COMMIT_MSG
1659		}
1660		set pch_error {}
1661		catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1662		return
1663	}
1664	fconfigure $fd_ph -blocking 0
1665	catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1666}
1667
1668proc read_diff_index {fd after} {
1669	global buf_rdi
1670
1671	append buf_rdi [read $fd]
1672	set c 0
1673	set n [string length $buf_rdi]
1674	while {$c < $n} {
1675		set z1 [string first "\0" $buf_rdi $c]
1676		if {$z1 == -1} break
1677		incr z1
1678		set z2 [string first "\0" $buf_rdi $z1]
1679		if {$z2 == -1} break
1680
1681		incr c
1682		set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1683		set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1684		merge_state \
1685			[encoding convertfrom utf-8 $p] \
1686			[lindex $i 4]? \
1687			[list [lindex $i 0] [lindex $i 2]] \
1688			[list]
1689		set c $z2
1690		incr c
1691	}
1692	if {$c < $n} {
1693		set buf_rdi [string range $buf_rdi $c end]
1694	} else {
1695		set buf_rdi {}
1696	}
1697
1698	rescan_done $fd buf_rdi $after
1699}
1700
1701proc read_diff_files {fd after} {
1702	global buf_rdf
1703
1704	append buf_rdf [read $fd]
1705	set c 0
1706	set n [string length $buf_rdf]
1707	while {$c < $n} {
1708		set z1 [string first "\0" $buf_rdf $c]
1709		if {$z1 == -1} break
1710		incr z1
1711		set z2 [string first "\0" $buf_rdf $z1]
1712		if {$z2 == -1} break
1713
1714		incr c
1715		set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1716		set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1717		merge_state \
1718			[encoding convertfrom utf-8 $p] \
1719			?[lindex $i 4] \
1720			[list] \
1721			[list [lindex $i 0] [lindex $i 2]]
1722		set c $z2
1723		incr c
1724	}
1725	if {$c < $n} {
1726		set buf_rdf [string range $buf_rdf $c end]
1727	} else {
1728		set buf_rdf {}
1729	}
1730
1731	rescan_done $fd buf_rdf $after
1732}
1733
1734proc read_ls_others {fd after} {
1735	global buf_rlo
1736
1737	append buf_rlo [read $fd]
1738	set pck [split $buf_rlo "\0"]
1739	set buf_rlo [lindex $pck end]
1740	foreach p [lrange $pck 0 end-1] {
1741		set p [encoding convertfrom utf-8 $p]
1742		if {[string index $p end] eq {/}} {
1743			set p [string range $p 0 end-1]
1744		}
1745		merge_state $p ?O
1746	}
1747	rescan_done $fd buf_rlo $after
1748}
1749
1750proc rescan_done {fd buf after} {
1751	global rescan_active current_diff_path
1752	global file_states repo_config
1753	upvar $buf to_clear
1754
1755	if {![eof $fd]} return
1756	set to_clear {}
1757	close $fd
1758	if {[incr rescan_active -1] > 0} return
1759
1760	prune_selection
1761	unlock_index
1762	display_all_files
1763	if {$current_diff_path ne {}} { reshow_diff $after }
1764	if {$current_diff_path eq {}} { select_first_diff $after }
1765}
1766
1767proc prune_selection {} {
1768	global file_states selected_paths
1769
1770	foreach path [array names selected_paths] {
1771		if {[catch {set still_here $file_states($path)}]} {
1772			unset selected_paths($path)
1773		}
1774	}
1775}
1776
1777######################################################################
1778##
1779## ui helpers
1780
1781proc mapicon {w state path} {
1782	global all_icons
1783
1784	if {[catch {set r $all_icons($state$w)}]} {
1785		puts "error: no icon for $w state={$state} $path"
1786		return file_plain
1787	}
1788	return $r
1789}
1790
1791proc mapdesc {state path} {
1792	global all_descs
1793
1794	if {[catch {set r $all_descs($state)}]} {
1795		puts "error: no desc for state={$state} $path"
1796		return $state
1797	}
1798	return $r
1799}
1800
1801proc ui_status {msg} {
1802	global main_status
1803	if {[info exists main_status]} {
1804		$main_status show $msg
1805	}
1806}
1807
1808proc ui_ready {} {
1809	global main_status
1810	if {[info exists main_status]} {
1811		$main_status show [mc "Ready."]
1812	}
1813}
1814
1815proc escape_path {path} {
1816	regsub -all {\\} $path "\\\\" path
1817	regsub -all "\n" $path "\\n" path
1818	return $path
1819}
1820
1821proc short_path {path} {
1822	return [escape_path [lindex [file split $path] end]]
1823}
1824
1825set next_icon_id 0
1826set null_sha1 [string repeat 0 40]
1827
1828proc merge_state {path new_state {head_info {}} {index_info {}}} {
1829	global file_states next_icon_id null_sha1
1830
1831	set s0 [string index $new_state 0]
1832	set s1 [string index $new_state 1]
1833
1834	if {[catch {set info $file_states($path)}]} {
1835		set state __
1836		set icon n[incr next_icon_id]
1837	} else {
1838		set state [lindex $info 0]
1839		set icon [lindex $info 1]
1840		if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1841		if {$index_info eq {}} {set index_info [lindex $info 3]}
1842	}
1843
1844	if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1845	elseif {$s0 eq {_}} {set s0 _}
1846
1847	if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1848	elseif {$s1 eq {_}} {set s1 _}
1849
1850	if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1851		set head_info [list 0 $null_sha1]
1852	} elseif {$s0 ne {_} && [string index $state 0] eq {_}
1853		&& $head_info eq {}} {
1854		set head_info $index_info
1855	} elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1856		set index_info $head_info
1857		set head_info {}
1858	}
1859
1860	set file_states($path) [list $s0$s1 $icon \
1861		$head_info $index_info \
1862		]
1863	return $state
1864}
1865
1866proc display_file_helper {w path icon_name old_m new_m} {
1867	global file_lists
1868
1869	if {$new_m eq {_}} {
1870		set lno [lsearch -sorted -exact $file_lists($w) $path]
1871		if {$lno >= 0} {
1872			set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1873			incr lno
1874			$w conf -state normal
1875			$w delete $lno.0 [expr {$lno + 1}].0
1876			$w conf -state disabled
1877		}
1878	} elseif {$old_m eq {_} && $new_m ne {_}} {
1879		lappend file_lists($w) $path
1880		set file_lists($w) [lsort -unique $file_lists($w)]
1881		set lno [lsearch -sorted -exact $file_lists($w) $path]
1882		incr lno
1883		$w conf -state normal
1884		$w image create $lno.0 \
1885			-align center -padx 5 -pady 1 \
1886			-name $icon_name \
1887			-image [mapicon $w $new_m $path]
1888		$w insert $lno.1 "[escape_path $path]\n"
1889		$w conf -state disabled
1890	} elseif {$old_m ne $new_m} {
1891		$w conf -state normal
1892		$w image conf $icon_name -image [mapicon $w $new_m $path]
1893		$w conf -state disabled
1894	}
1895}
1896
1897proc display_file {path state} {
1898	global file_states selected_paths
1899	global ui_index ui_workdir
1900
1901	set old_m [merge_state $path $state]
1902	set s $file_states($path)
1903	set new_m [lindex $s 0]
1904	set icon_name [lindex $s 1]
1905
1906	set o [string index $old_m 0]
1907	set n [string index $new_m 0]
1908	if {$o eq {U}} {
1909		set o _
1910	}
1911	if {$n eq {U}} {
1912		set n _
1913	}
1914	display_file_helper	$ui_index $path $icon_name $o $n
1915
1916	if {[string index $old_m 0] eq {U}} {
1917		set o U
1918	} else {
1919		set o [string index $old_m 1]
1920	}
1921	if {[string index $new_m 0] eq {U}} {
1922		set n U
1923	} else {
1924		set n [string index $new_m 1]
1925	}
1926	display_file_helper	$ui_workdir $path $icon_name $o $n
1927
1928	if {$new_m eq {__}} {
1929		unset file_states($path)
1930		catch {unset selected_paths($path)}
1931	}
1932}
1933
1934proc display_all_files_helper {w path icon_name m} {
1935	global file_lists
1936
1937	lappend file_lists($w) $path
1938	set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1939	$w image create end \
1940		-align center -padx 5 -pady 1 \
1941		-name $icon_name \
1942		-image [mapicon $w $m $path]
1943	$w insert end "[escape_path $path]\n"
1944}
1945
1946set files_warning 0
1947proc display_all_files {} {
1948	global ui_index ui_workdir
1949	global file_states file_lists
1950	global last_clicked
1951	global files_warning
1952
1953	$ui_index conf -state normal
1954	$ui_workdir conf -state normal
1955
1956	$ui_index delete 0.0 end
1957	$ui_workdir delete 0.0 end
1958	set last_clicked {}
1959
1960	set file_lists($ui_index) [list]
1961	set file_lists($ui_workdir) [list]
1962
1963	set to_display [lsort [array names file_states]]
1964	set display_limit [get_config gui.maxfilesdisplayed]
1965	set displayed 0
1966	foreach path $to_display {
1967		set s $file_states($path)
1968		set m [lindex $s 0]
1969		set icon_name [lindex $s 1]
1970
1971		if {$displayed > $display_limit && [string index $m 1] eq {O} } {
1972			if {!$files_warning} {
1973				# do not repeatedly warn:
1974				set files_warning 1
1975				info_popup [mc "Display limit (gui.maxfilesdisplayed = %s) reached, not showing all %s files." \
1976					$display_limit [llength $to_display]]
1977			}
1978			continue
1979		}
1980
1981		set s [string index $m 0]
1982		if {$s ne {U} && $s ne {_}} {
1983			display_all_files_helper $ui_index $path \
1984				$icon_name $s
1985		}
1986
1987		if {[string index $m 0] eq {U}} {
1988			set s U
1989		} else {
1990			set s [string index $m 1]
1991		}
1992		if {$s ne {_}} {
1993			display_all_files_helper $ui_workdir $path \
1994				$icon_name $s
1995			incr displayed
1996		}
1997	}
1998
1999	$ui_index conf -state disabled
2000	$ui_workdir conf -state disabled
2001}
2002
2003######################################################################
2004##
2005## icons
2006
2007set filemask {
2008#define mask_width 14
2009#define mask_height 15
2010static unsigned char mask_bits[] = {
2011	0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2012	0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2013	0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2014}
2015
2016image create bitmap file_plain -background white -foreground black -data {
2017#define plain_width 14
2018#define plain_height 15
2019static unsigned char plain_bits[] = {
2020	0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2021	0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2022	0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2023} -maskdata $filemask
2024
2025image create bitmap file_mod -background white -foreground blue -data {
2026#define mod_width 14
2027#define mod_height 15
2028static unsigned char mod_bits[] = {
2029	0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2030	0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2031	0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2032} -maskdata $filemask
2033
2034image create bitmap file_fulltick -background white -foreground "#007000" -data {
2035#define file_fulltick_width 14
2036#define file_fulltick_height 15
2037static unsigned char file_fulltick_bits[] = {
2038	0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2039	0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2040	0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2041} -maskdata $filemask
2042
2043image create bitmap file_question -background white -foreground black -data {
2044#define file_question_width 14
2045#define file_question_height 15
2046static unsigned char file_question_bits[] = {
2047	0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2048	0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2049	0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2050} -maskdata $filemask
2051
2052image create bitmap file_removed -background white -foreground red -data {
2053#define file_removed_width 14
2054#define file_removed_height 15
2055static unsigned char file_removed_bits[] = {
2056	0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2057	0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2058	0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2059} -maskdata $filemask
2060
2061image create bitmap file_merge -background white -foreground blue -data {
2062#define file_merge_width 14
2063#define file_merge_height 15
2064static unsigned char file_merge_bits[] = {
2065	0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2066	0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2067	0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2068} -maskdata $filemask
2069
2070image create bitmap file_statechange -background white -foreground green -data {
2071#define file_statechange_width 14
2072#define file_statechange_height 15
2073static unsigned char file_statechange_bits[] = {
2074	0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2075	0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2076	0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2077} -maskdata $filemask
2078
2079set ui_index .vpane.files.index.list
2080set ui_workdir .vpane.files.workdir.list
2081
2082set all_icons(_$ui_index)   file_plain
2083set all_icons(A$ui_index)   file_plain
2084set all_icons(M$ui_index)   file_fulltick
2085set all_icons(D$ui_index)   file_removed
2086set all_icons(U$ui_index)   file_merge
2087set all_icons(T$ui_index)   file_statechange
2088
2089set all_icons(_$ui_workdir) file_plain
2090set all_icons(M$ui_workdir) file_mod
2091set all_icons(D$ui_workdir) file_question
2092set all_icons(U$ui_workdir) file_merge
2093set all_icons(O$ui_workdir) file_plain
2094set all_icons(T$ui_workdir) file_statechange
2095
2096set max_status_desc 0
2097foreach i {
2098		{__ {mc "Unmodified"}}
2099
2100		{_M {mc "Modified, not staged"}}
2101		{M_ {mc "Staged for commit"}}
2102		{MM {mc "Portions staged for commit"}}
2103		{MD {mc "Staged for commit, missing"}}
2104
2105		{_T {mc "File type changed, not staged"}}
2106		{MT {mc "File type changed, old type staged for commit"}}
2107		{AT {mc "File type changed, old type staged for commit"}}
2108		{T_ {mc "File type changed, staged"}}
2109		{TM {mc "File type change staged, modification not staged"}}
2110		{TD {mc "File type change staged, file missing"}}
2111
2112		{_O {mc "Untracked, not staged"}}
2113		{A_ {mc "Staged for commit"}}
2114		{AM {mc "Portions staged for commit"}}
2115		{AD {mc "Staged for commit, missing"}}
2116
2117		{_D {mc "Missing"}}
2118		{D_ {mc "Staged for removal"}}
2119		{DO {mc "Staged for removal, still present"}}
2120
2121		{_U {mc "Requires merge resolution"}}
2122		{U_ {mc "Requires merge resolution"}}
2123		{UU {mc "Requires merge resolution"}}
2124		{UM {mc "Requires merge resolution"}}
2125		{UD {mc "Requires merge resolution"}}
2126		{UT {mc "Requires merge resolution"}}
2127	} {
2128	set text [eval [lindex $i 1]]
2129	if {$max_status_desc < [string length $text]} {
2130		set max_status_desc [string length $text]
2131	}
2132	set all_descs([lindex $i 0]) $text
2133}
2134unset i
2135
2136######################################################################
2137##
2138## util
2139
2140proc scrollbar2many {list mode args} {
2141	foreach w $list {eval $w $mode $args}
2142}
2143
2144proc many2scrollbar {list mode sb top bottom} {
2145	$sb set $top $bottom
2146	foreach w $list {$w $mode moveto $top}
2147}
2148
2149proc incr_font_size {font {amt 1}} {
2150	set sz [font configure $font -size]
2151	incr sz $amt
2152	font configure $font -size $sz
2153	font configure ${font}bold -size $sz
2154	font configure ${font}italic -size $sz
2155}
2156
2157######################################################################
2158##
2159## ui commands
2160
2161proc do_gitk {revs {is_submodule false}} {
2162	global current_diff_path file_states current_diff_side ui_index
2163	global _gitdir _gitworktree
2164
2165	# -- Always start gitk through whatever we were loaded with.  This
2166	#    lets us bypass using shell process on Windows systems.
2167	#
2168	set exe [_which gitk -script]
2169	set cmd [list [info nameofexecutable] $exe]
2170	if {$exe eq {}} {
2171		error_popup [mc "Couldn't find gitk in PATH"]
2172	} else {
2173		global env
2174
2175		set pwd [pwd]
2176
2177		if {!$is_submodule} {
2178			if {![is_bare]} {
2179				cd $_gitworktree
2180			}
2181		} else {
2182			cd $current_diff_path
2183			if {$revs eq {--}} {
2184				set s $file_states($current_diff_path)
2185				set old_sha1 {}
2186				set new_sha1 {}
2187				switch -glob -- [lindex $s 0] {
2188				M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2189				_M { set old_sha1 [lindex [lindex $s 3] 1] }
2190				MM {
2191					if {$current_diff_side eq $ui_index} {
2192						set old_sha1 [lindex [lindex $s 2] 1]
2193						set new_sha1 [lindex [lindex $s 3] 1]
2194					} else {
2195						set old_sha1 [lindex [lindex $s 3] 1]
2196					}
2197				}
2198				}
2199				set revs $old_sha1...$new_sha1
2200			}
2201			# GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2202			# we've been using for the main repository, so unset them.
2203			# TODO we could make life easier (start up faster?) for gitk
2204			# by setting these to the appropriate values to allow gitk
2205			# to skip the heuristics to find their proper value
2206			unset env(GIT_DIR)
2207			unset env(GIT_WORK_TREE)
2208		}
2209		eval exec $cmd $revs "--" "--" &
2210
2211		set env(GIT_DIR) $_gitdir
2212		set env(GIT_WORK_TREE) $_gitworktree
2213		cd $pwd
2214
2215		if {[info exists main_status]} {
2216			set status_operation [$::main_status \
2217				start \
2218				[mc "Starting %s... please wait..." "gitk"]]
2219
2220			after 3500 [list $status_operation stop]
2221		}
2222	}
2223}
2224
2225proc do_git_gui {} {
2226	global current_diff_path
2227
2228	# -- Always start git gui through whatever we were loaded with.  This
2229	#    lets us bypass using shell process on Windows systems.
2230	#
2231	set exe [list [_which git]]
2232	if {$exe eq {}} {
2233		error_popup [mc "Couldn't find git gui in PATH"]
2234	} else {
2235		global env
2236		global _gitdir _gitworktree
2237
2238		# see note in do_gitk about unsetting these vars when
2239		# running tools in a submodule
2240		unset env(GIT_DIR)
2241		unset env(GIT_WORK_TREE)
2242
2243		set pwd [pwd]
2244		cd $current_diff_path
2245
2246		eval exec $exe gui &
2247
2248		set env(GIT_DIR) $_gitdir
2249		set env(GIT_WORK_TREE) $_gitworktree
2250		cd $pwd
2251
2252		set status_operation [$::main_status \
2253			start \
2254			[mc "Starting %s... please wait..." "git-gui"]]
2255
2256		after 3500 [list $status_operation stop]
2257	}
2258}
2259
2260# Get the system-specific explorer app/command.
2261proc get_explorer {} {
2262	if {[is_Cygwin] || [is_Windows]} {
2263		set explorer "explorer.exe"
2264	} elseif {[is_MacOSX]} {
2265		set explorer "open"
2266	} else {
2267		# freedesktop.org-conforming system is our best shot
2268		set explorer "xdg-open"
2269	}
2270	return $explorer
2271}
2272
2273proc do_explore {} {
2274	global _gitworktree
2275	set explorer [get_explorer]
2276	eval exec $explorer [list [file nativename $_gitworktree]] &
2277}
2278
2279# Open file relative to the working tree by the default associated app.
2280proc do_file_open {file} {
2281	global _gitworktree
2282	set explorer [get_explorer]
2283	set full_file_path [file join $_gitworktree $file]
2284	exec $explorer [file nativename $full_file_path] &
2285}
2286
2287set is_quitting 0
2288set ret_code    1
2289
2290proc terminate_me {win} {
2291	global ret_code
2292	if {$win ne {.}} return
2293	exit $ret_code
2294}
2295
2296proc do_quit {{rc {1}}} {
2297	global ui_comm is_quitting repo_config commit_type
2298	global GITGUI_BCK_exists GITGUI_BCK_i
2299	global ui_comm_spell
2300	global ret_code use_ttk
2301
2302	if {$is_quitting} return
2303	set is_quitting 1
2304
2305	if {[winfo exists $ui_comm]} {
2306		# -- Stash our current commit buffer.
2307		#
2308		set save [gitdir GITGUI_MSG]
2309		if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2310			file rename -force [gitdir GITGUI_BCK] $save
2311			set GITGUI_BCK_exists 0
2312		} elseif {[$ui_comm edit modified]} {
2313			set msg [string trim [$ui_comm get 0.0 end]]
2314			regsub -all -line {[ \r\t]+$} $msg {} msg
2315			if {![string match amend* $commit_type]
2316				&& $msg ne {}} {
2317				catch {
2318					set fd [open $save w]
2319					fconfigure $fd -encoding utf-8
2320					puts -nonewline $fd $msg
2321					close $fd
2322				}
2323			} else {
2324				catch {file delete $save}
2325			}
2326		}
2327
2328		# -- Cancel our spellchecker if its running.
2329		#
2330		if {[info exists ui_comm_spell]} {
2331			$ui_comm_spell stop
2332		}
2333
2334		# -- Remove our editor backup, its not needed.
2335		#
2336		after cancel $GITGUI_BCK_i
2337		if {$GITGUI_BCK_exists} {
2338			catch {file delete [gitdir GITGUI_BCK]}
2339		}
2340
2341		# -- Stash our current window geometry into this repository.
2342		#
2343		set cfg_wmstate [wm state .]
2344		if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2345			set rc_wmstate {}
2346		}
2347		if {$cfg_wmstate ne $rc_wmstate} {
2348			catch {git config gui.wmstate $cfg_wmstate}
2349		}
2350		if {$cfg_wmstate eq {zoomed}} {
2351			# on Windows wm geometry will lie about window
2352			# position (but not size) when window is zoomed
2353			# restore the window before querying wm geometry
2354			wm state . normal
2355		}
2356		set cfg_geometry [list]
2357		lappend cfg_geometry [wm geometry .]
2358		if {$use_ttk} {
2359			lappend cfg_geometry [.vpane sashpos 0]
2360			lappend cfg_geometry [.vpane.files sashpos 0]
2361		} else {
2362			lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2363			lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2364		}
2365		if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2366			set rc_geometry {}
2367		}
2368		if {$cfg_geometry ne $rc_geometry} {
2369			catch {git config gui.geometry $cfg_geometry}
2370		}
2371	}
2372
2373	set ret_code $rc
2374
2375	# Briefly enable send again, working around Tk bug
2376	# http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2377	tk appname [appname]
2378
2379	destroy .
2380}
2381
2382proc do_rescan {} {
2383	rescan ui_ready
2384}
2385
2386proc ui_do_rescan {} {
2387	rescan {force_first_diff ui_ready}
2388}
2389
2390proc do_commit {} {
2391	commit_tree
2392}
2393
2394proc next_diff {{after {}}} {
2395	global next_diff_p next_diff_w next_diff_i
2396	show_diff $next_diff_p $next_diff_w {} {} $after
2397}
2398
2399proc find_anchor_pos {lst name} {
2400	set lid [lsearch -sorted -exact $lst $name]
2401
2402	if {$lid == -1} {
2403		set lid 0
2404		foreach lname $lst {
2405			if {$lname >= $name} break
2406			incr lid
2407		}
2408	}
2409
2410	return $lid
2411}
2412
2413proc find_file_from {flist idx delta path mmask} {
2414	global file_states
2415
2416	set len [llength $flist]
2417	while {$idx >= 0 && $idx < $len} {
2418		set name [lindex $flist $idx]
2419
2420		if {$name ne $path && [info exists file_states($name)]} {
2421			set state [lindex $file_states($name) 0]
2422
2423			if {$mmask eq {} || [regexp $mmask $state]} {
2424				return $idx
2425			}
2426		}
2427
2428		incr idx $delta
2429	}
2430
2431	return {}
2432}
2433
2434proc find_next_diff {w path {lno {}} {mmask {}}} {
2435	global next_diff_p next_diff_w next_diff_i
2436	global file_lists ui_index ui_workdir
2437
2438	set flist $file_lists($w)
2439	if {$lno eq {}} {
2440		set lno [find_anchor_pos $flist $path]
2441	} else {
2442		incr lno -1
2443	}
2444
2445	if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2446		if {$w eq $ui_index} {
2447			set mmask "^$mmask"
2448		} else {
2449			set mmask "$mmask\$"
2450		}
2451	}
2452
2453	set idx [find_file_from $flist $lno 1 $path $mmask]
2454	if {$idx eq {}} {
2455		incr lno -1
2456		set idx [find_file_from $flist $lno -1 $path $mmask]
2457	}
2458
2459	if {$idx ne {}} {
2460		set next_diff_w $w
2461		set next_diff_p [lindex $flist $idx]
2462		set next_diff_i [expr {$idx+1}]
2463		return 1
2464	} else {
2465		return 0
2466	}
2467}
2468
2469proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2470	global current_diff_path
2471
2472	if {$path ne $current_diff_path} {
2473		return {}
2474	} elseif {[find_next_diff $w $path $lno $mmask]} {
2475		return {next_diff;}
2476	} else {
2477		return {reshow_diff;}
2478	}
2479}
2480
2481proc select_first_diff {after} {
2482	global ui_workdir
2483
2484	if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2485	    [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2486		next_diff $after
2487	} else {
2488		uplevel #0 $after
2489	}
2490}
2491
2492proc force_first_diff {after} {
2493	global ui_workdir current_diff_path file_states
2494
2495	if {[info exists file_states($current_diff_path)]} {
2496		set state [lindex $file_states($current_diff_path) 0]
2497	} else {
2498		set state {OO}
2499	}
2500
2501	set reselect 0
2502	if {[string first {U} $state] >= 0} {
2503		# Already a conflict, do nothing
2504	} elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2505		set reselect 1
2506	} elseif {[string index $state 1] ne {O}} {
2507		# Already a diff & no conflicts, do nothing
2508	} elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2509		set reselect 1
2510	}
2511
2512	if {$reselect} {
2513		next_diff $after
2514	} else {
2515		uplevel #0 $after
2516	}
2517}
2518
2519proc toggle_or_diff {mode w args} {
2520	global file_states file_lists current_diff_path ui_index ui_workdir
2521	global last_clicked selected_paths file_lists_last_clicked
2522
2523	if {$mode eq "click"} {
2524		foreach {x y} $args break
2525		set pos [split [$w index @$x,$y] .]
2526		foreach {lno col} $pos break
2527	} else {
2528		if {$mode eq "toggle"} {
2529			if {$w eq $ui_workdir} {
2530				do_add_selection
2531				set last_clicked {}
2532				return
2533			}
2534			if {$w eq $ui_index} {
2535				do_unstage_selection
2536				set last_clicked {}
2537				return
2538			}
2539		}
2540
2541		if {$last_clicked ne {}} {
2542			set lno [lindex $last_clicked 1]
2543		} else {
2544			if {![info exists file_lists]
2545				|| ![info exists file_lists($w)]
2546				|| [llength $file_lists($w)] == 0} {
2547				set last_clicked {}
2548				return
2549			}
2550			set lno [expr {int([lindex [$w tag ranges in_diff] 0])}]
2551		}
2552		if {$mode eq "toggle"} {
2553			set col 0; set y 2
2554		} else {
2555			incr lno [expr {$mode eq "up" ? -1 : 1}]
2556			set col 1
2557		}
2558	}
2559
2560	if {![info exists file_lists]
2561		|| ![info exists file_lists($w)]
2562		|| [llength $file_lists($w)] < $lno - 1} {
2563		set path {}
2564	} else {
2565		set path [lindex $file_lists($w) [expr {$lno - 1}]]
2566	}
2567	if {$path eq {}} {
2568		set last_clicked {}
2569		return
2570	}
2571
2572	set last_clicked [list $w $lno]
2573	focus $w
2574	array unset selected_paths
2575	$ui_index tag remove in_sel 0.0 end
2576	$ui_workdir tag remove in_sel 0.0 end
2577
2578	set file_lists_last_clicked($w) $path
2579
2580	# Determine the state of the file
2581	if {[info exists file_states($path)]} {
2582		set state [lindex $file_states($path) 0]
2583	} else {
2584		set state {__}
2585	}
2586
2587	# Restage the file, or simply show the diff
2588	if {$col == 0 && $y > 1} {
2589		# Conflicts need special handling
2590		if {[string first {U} $state] >= 0} {
2591			# $w must always be $ui_workdir, but...
2592			if {$w ne $ui_workdir} { set lno {} }
2593			merge_stage_workdir $path $lno
2594			return
2595		}
2596
2597		if {[string index $state 1] eq {O}} {
2598			set mmask {}
2599		} else {
2600			set mmask {[^O]}
2601		}
2602
2603		set after [next_diff_after_action $w $path $lno $mmask]
2604
2605		if {$w eq $ui_index} {
2606			update_indexinfo \
2607				"Unstaging [short_path $path] from commit" \
2608				[list $path] \
2609				[concat $after {ui_ready;}]
2610		} elseif {$w eq $ui_workdir} {
2611			update_index \
2612				"Adding [short_path $path]" \
2613				[list $path] \
2614				[concat $after {ui_ready;}]
2615		}
2616	} else {
2617		set selected_paths($path) 1
2618		show_diff $path $w $lno
2619	}
2620}
2621
2622proc add_one_to_selection {w x y} {
2623	global file_lists last_clicked selected_paths
2624
2625	set lno [lindex [split [$w index @$x,$y] .] 0]
2626	set path [lindex $file_lists($w) [expr {$lno - 1}]]
2627	if {$path eq {}} {
2628		set last_clicked {}
2629		return
2630	}
2631
2632	if {$last_clicked ne {}
2633		&& [lindex $last_clicked 0] ne $w} {
2634		array unset selected_paths
2635		[lindex $last_clicked 0] tag remove in_sel 0.0 end
2636	}
2637
2638	set last_clicked [list $w $lno]
2639	if {[catch {set in_sel $selected_paths($path)}]} {
2640		set in_sel 0
2641	}
2642	if {$in_sel} {
2643		unset selected_paths($path)
2644		$w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2645	} else {
2646		set selected_paths($path) 1
2647		$w tag add in_sel $lno.0 [expr {$lno + 1}].0
2648	}
2649}
2650
2651proc add_range_to_selection {w x y} {
2652	global file_lists last_clicked selected_paths
2653
2654	if {[lindex $last_clicked 0] ne $w} {
2655		toggle_or_diff click $w $x $y
2656		return
2657	}
2658
2659	set lno [lindex [split [$w index @$x,$y] .] 0]
2660	set lc [lindex $last_clicked 1]
2661	if {$lc < $lno} {
2662		set begin $lc
2663		set end $lno
2664	} else {
2665		set begin $lno
2666		set end $lc
2667	}
2668
2669	foreach path [lrange $file_lists($w) \
2670		[expr {$begin - 1}] \
2671		[expr {$end - 1}]] {
2672		set selected_paths($path) 1
2673	}
2674	$w tag add in_sel $begin.0 [expr {$end + 1}].0
2675}
2676
2677proc show_more_context {} {
2678	global repo_config
2679	if {$repo_config(gui.diffcontext) < 99} {
2680		incr repo_config(gui.diffcontext)
2681		reshow_diff
2682	}
2683}
2684
2685proc show_less_context {} {
2686	global repo_config
2687	if {$repo_config(gui.diffcontext) > 1} {
2688		incr repo_config(gui.diffcontext) -1
2689		reshow_diff
2690	}
2691}
2692
2693proc focus_widget {widget} {
2694	global file_lists last_clicked selected_paths
2695	global file_lists_last_clicked
2696
2697	if {[llength $file_lists($widget)] > 0} {
2698		set path $file_lists_last_clicked($widget)
2699		set index [lsearch -sorted -exact $file_lists($widget) $path]
2700		if {$index < 0} {
2701			set index 0
2702			set path [lindex $file_lists($widget) $index]
2703		}
2704
2705		focus $widget
2706		set last_clicked [list $widget [expr $index + 1]]
2707		array unset selected_paths
2708		set selected_paths($path) 1
2709		show_diff $path $widget
2710	}
2711}
2712
2713proc toggle_commit_type {} {
2714	global commit_type_is_amend
2715	set commit_type_is_amend [expr !$commit_type_is_amend]
2716	do_select_commit_type
2717}
2718
2719######################################################################
2720##
2721## ui construction
2722
2723set ui_comm {}
2724
2725# -- Menu Bar
2726#
2727menu .mbar -tearoff 0
2728if {[is_MacOSX]} {
2729	# -- Apple Menu (Mac OS X only)
2730	#
2731	.mbar add cascade -label Apple -menu .mbar.apple
2732	menu .mbar.apple
2733}
2734.mbar add cascade -label [mc Repository] -menu .mbar.repository
2735.mbar add cascade -label [mc Edit] -menu .mbar.edit
2736if {[is_enabled branch]} {
2737	.mbar add cascade -label [mc Branch] -menu .mbar.branch
2738}
2739if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2740	.mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2741}
2742if {[is_enabled transport]} {
2743	.mbar add cascade -label [mc Merge] -menu .mbar.merge
2744	.mbar add cascade -label [mc Remote] -menu .mbar.remote
2745}
2746if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2747	.mbar add cascade -label [mc Tools] -menu .mbar.tools
2748}
2749
2750# -- Repository Menu
2751#
2752menu .mbar.repository
2753
2754if {![is_bare]} {
2755	.mbar.repository add command \
2756		-label [mc "Explore Working Copy"] \
2757		-command {do_explore}
2758}
2759
2760if {[is_Windows]} {
2761	# Use /git-bash.exe if available
2762	set normalized [file normalize $::argv0]
2763	regsub "/mingw../libexec/git-core/git-gui$" \
2764		$normalized "/git-bash.exe" cmdLine
2765	if {$cmdLine != $normalized && [file exists $cmdLine]} {
2766		set cmdLine [list "Git Bash" $cmdLine &]
2767	} else {
2768		set cmdLine [list "Git Bash" bash --login -l &]
2769	}
2770	.mbar.repository add command \
2771		-label [mc "Git Bash"] \
2772		-command {eval exec [auto_execok start] $cmdLine}
2773}
2774
2775if {[is_Windows] || ![is_bare]} {
2776	.mbar.repository add separator
2777}
2778
2779.mbar.repository add command \
2780	-label [mc "Browse Current Branch's Files"] \
2781	-command {browser::new $current_branch}
2782set ui_browse_current [.mbar.repository index last]
2783.mbar.repository add command \
2784	-label [mc "Browse Branch Files..."] \
2785	-command browser_open::dialog
2786.mbar.repository add separator
2787
2788.mbar.repository add command \
2789	-label [mc "Visualize Current Branch's History"] \
2790	-command {do_gitk $current_branch}
2791set ui_visualize_current [.mbar.repository index last]
2792.mbar.repository add command \
2793	-label [mc "Visualize All Branch History"] \
2794	-command {do_gitk --all}
2795.mbar.repository add separator
2796
2797proc current_branch_write {args} {
2798	global current_branch
2799	.mbar.repository entryconf $::ui_browse_current \
2800		-label [mc "Browse %s's Files" $current_branch]
2801	.mbar.repository entryconf $::ui_visualize_current \
2802		-label [mc "Visualize %s's History" $current_branch]
2803}
2804trace add variable current_branch write current_branch_write
2805
2806if {[is_enabled multicommit]} {
2807	.mbar.repository add command -label [mc "Database Statistics"] \
2808		-command do_stats
2809
2810	.mbar.repository add command -label [mc "Compress Database"] \
2811		-command do_gc
2812
2813	.mbar.repository add command -label [mc "Verify Database"] \
2814		-command do_fsck_objects
2815
2816	.mbar.repository add separator
2817
2818	if {[is_Cygwin]} {
2819		.mbar.repository add command \
2820			-label [mc "Create Desktop Icon"] \
2821			-command do_cygwin_shortcut
2822	} elseif {[is_Windows]} {
2823		.mbar.repository add command \
2824			-label [mc "Create Desktop Icon"] \
2825			-command do_windows_shortcut
2826	} elseif {[is_MacOSX]} {
2827		.mbar.repository add command \
2828			-label [mc "Create Desktop Icon"] \
2829			-command do_macosx_app
2830	}
2831}
2832
2833if {[is_MacOSX]} {
2834	proc ::tk::mac::Quit {args} { do_quit }
2835} else {
2836	.mbar.repository add command -label [mc Quit] \
2837		-command do_quit \
2838		-accelerator $M1T-Q
2839}
2840
2841# -- Edit Menu
2842#
2843menu .mbar.edit
2844.mbar.edit add command -label [mc Undo] \
2845	-command {catch {[focus] edit undo}} \
2846	-accelerator $M1T-Z
2847.mbar.edit add command -label [mc Redo] \
2848	-command {catch {[focus] edit redo}} \
2849	-accelerator $M1T-Y
2850.mbar.edit add separator
2851.mbar.edit add command -label [mc Cut] \
2852	-command {catch {tk_textCut [focus]}} \
2853	-accelerator $M1T-X
2854.mbar.edit add command -label [mc Copy] \
2855	-command {catch {tk_textCopy [focus]}} \
2856	-accelerator $M1T-C
2857.mbar.edit add command -label [mc Paste] \
2858	-command {catch {tk_textPaste [focus]; [focus] see insert}} \
2859	-accelerator $M1T-V
2860.mbar.edit add command -label [mc Delete] \
2861	-command {catch {[focus] delete sel.first sel.last}} \
2862	-accelerator Del
2863.mbar.edit add separator
2864.mbar.edit add command -label [mc "Select All"] \
2865	-command {catch {[focus] tag add sel 0.0 end}} \
2866	-accelerator $M1T-A
2867
2868# -- Branch Menu
2869#
2870if {[is_enabled branch]} {
2871	menu .mbar.branch
2872
2873	.mbar.branch add command -label [mc "Create..."] \
2874		-command branch_create::dialog \
2875		-accelerator $M1T-N
2876	lappend disable_on_lock [list .mbar.branch entryconf \
2877		[.mbar.branch index last] -state]
2878
2879	.mbar.branch add command -label [mc "Checkout..."] \
2880		-command branch_checkout::dialog \
2881		-accelerator $M1T-O
2882	lappend disable_on_lock [list .mbar.branch entryconf \
2883		[.mbar.branch index last] -state]
2884
2885	.mbar.branch add command -label [mc "Rename..."] \
2886		-command branch_rename::dialog
2887	lappend disable_on_lock [list .mbar.branch entryconf \
2888		[.mbar.branch index last] -state]
2889
2890	.mbar.branch add command -label [mc "Delete..."] \
2891		-command branch_delete::dialog
2892	lappend disable_on_lock [list .mbar.branch entryconf \
2893		[.mbar.branch index last] -state]
2894
2895	.mbar.branch add command -label [mc "Reset..."] \
2896		-command merge::reset_hard
2897	lappend disable_on_lock [list .mbar.branch entryconf \
2898		[.mbar.branch index last] -state]
2899}
2900
2901# -- Commit Menu
2902#
2903proc commit_btn_caption {} {
2904	if {[is_enabled nocommit]} {
2905		return [mc "Done"]
2906	} else {
2907		return [mc Commit@@verb]
2908	}
2909}
2910
2911if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2912	menu .mbar.commit
2913
2914	if {![is_enabled nocommit]} {
2915		.mbar.commit add checkbutton \
2916			-label [mc "Amend Last Commit"] \
2917			-accelerator $M1T-E \
2918			-variable commit_type_is_amend \
2919			-command do_select_commit_type
2920		lappend disable_on_lock \
2921			[list .mbar.commit entryconf [.mbar.commit index last] -state]
2922
2923		.mbar.commit add separator
2924	}
2925
2926	.mbar.commit add command -label [mc Rescan] \
2927		-command ui_do_rescan \
2928		-accelerator F5
2929	lappend disable_on_lock \
2930		[list .mbar.commit entryconf [.mbar.commit index last] -state]
2931
2932	.mbar.commit add command -label [mc "Stage To Commit"] \
2933		-command do_add_selection \
2934		-accelerator $M1T-T
2935	lappend disable_on_lock \
2936		[list .mbar.commit entryconf [.mbar.commit index last] -state]
2937
2938	.mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2939		-command do_add_all \
2940		-accelerator $M1T-I
2941	lappend disable_on_lock \
2942		[list .mbar.commit entryconf [.mbar.commit index last] -state]
2943
2944	.mbar.commit add command -label [mc "Unstage From Commit"] \
2945		-command do_unstage_selection \
2946		-accelerator $M1T-U
2947	lappend disable_on_lock \
2948		[list .mbar.commit entryconf [.mbar.commit index last] -state]
2949
2950	.mbar.commit add command -label [mc "Revert Changes"] \
2951		-command do_revert_selection \
2952		-accelerator $M1T-J
2953	lappend disable_on_lock \
2954		[list .mbar.commit entryconf [.mbar.commit index last] -state]
2955
2956	.mbar.commit add separator
2957
2958	.mbar.commit add command -label [mc "Show Less Context"] \
2959		-command show_less_context \
2960		-accelerator $M1T-\-
2961
2962	.mbar.commit add command -label [mc "Show More Context"] \
2963		-command show_more_context \
2964		-accelerator $M1T-=
2965
2966	.mbar.commit add separator
2967
2968	if {![is_enabled nocommitmsg]} {
2969		.mbar.commit add command -label [mc "Sign Off"] \
2970			-command do_signoff \
2971			-accelerator $M1T-S
2972	}
2973
2974	.mbar.commit add command -label [commit_btn_caption] \
2975		-command do_commit \
2976		-accelerator $M1T-Return
2977	lappend disable_on_lock \
2978		[list .mbar.commit entryconf [.mbar.commit index last] -state]
2979}
2980
2981# -- Merge Menu
2982#
2983if {[is_enabled branch]} {
2984	menu .mbar.merge
2985	.mbar.merge add command -label [mc "Local Merge..."] \
2986		-command merge::dialog \
2987		-accelerator $M1T-M
2988	lappend disable_on_lock \
2989		[list .mbar.merge entryconf [.mbar.merge index last] -state]
2990	.mbar.merge add command -label [mc "Abort Merge..."] \
2991		-command merge::reset_hard
2992	lappend disable_on_lock \
2993		[list .mbar.merge entryconf [.mbar.merge index last] -state]
2994}
2995
2996# -- Transport Menu
2997#
2998if {[is_enabled transport]} {
2999	menu .mbar.remote
3000
3001	.mbar.remote add command \
3002		-label [mc "Add..."] \
3003		-command remote_add::dialog \
3004		-accelerator $M1T-A
3005	.mbar.remote add command \
3006		-label [mc "Push..."] \
3007		-command do_push_anywhere \
3008		-accelerator $M1T-P
3009	.mbar.remote add command \
3010		-label [mc "Delete Branch..."] \
3011		-command remote_branch_delete::dialog
3012}
3013
3014if {[is_MacOSX]} {
3015	proc ::tk::mac::ShowPreferences {} {do_options}
3016} else {
3017	# -- Edit Menu
3018	#
3019	.mbar.edit add separator
3020	.mbar.edit add command -label [mc "Options..."] \
3021		-command do_options
3022}
3023
3024# -- Tools Menu
3025#
3026if {[is_enabled multicommit] || [is_enabled singlecommit]} {
3027	set tools_menubar .mbar.tools
3028	menu $tools_menubar
3029	$tools_menubar add separator
3030	$tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
3031	$tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
3032	set tools_tailcnt 3
3033	if {[array names repo_config guitool.*.cmd] ne {}} {
3034		tools_populate_all
3035	}
3036}
3037
3038# -- Help Menu
3039#
3040.mbar add cascade -label [mc Help] -menu .mbar.help
3041menu .mbar.help
3042
3043if {[is_MacOSX]} {
3044	.mbar.apple add command -label [mc "About %s" [appname]] \
3045		-command do_about
3046	.mbar.apple add separator
3047} else {
3048	.mbar.help add command -label [mc "About %s" [appname]] \
3049		-command do_about
3050}
3051. configure -menu .mbar
3052
3053set doc_path [githtmldir]
3054if {$doc_path ne {}} {
3055	set doc_path [file join $doc_path index.html]
3056
3057	if {[is_Cygwin]} {
3058		set doc_path [exec cygpath --mixed $doc_path]
3059	}
3060}
3061
3062if {[file isfile $doc_path]} {
3063	set doc_url "file:$doc_path"
3064} else {
3065	set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
3066}
3067
3068proc start_browser {url} {
3069	git "web--browse" $url
3070}
3071
3072.mbar.help add command -label [mc "Online Documentation"] \
3073	-command [list start_browser $doc_url]
3074
3075.mbar.help add command -label [mc "Show SSH Key"] \
3076	-command do_ssh_key
3077
3078unset doc_path doc_url
3079
3080# -- Standard bindings
3081#
3082wm protocol . WM_DELETE_WINDOW do_quit
3083bind all <$M1B-Key-q> do_quit
3084bind all <$M1B-Key-Q> do_quit
3085
3086set m1b_w_script {
3087	set toplvl_win [winfo toplevel %W]
3088
3089	# If we are destroying the main window, we should call do_quit to take
3090	# care of cleanup before exiting the program.
3091	if {$toplvl_win eq "."} {
3092		do_quit
3093	} else {
3094		destroy $toplvl_win
3095	}
3096}
3097
3098bind all <$M1B-Key-w> $m1b_w_script
3099bind all <$M1B-Key-W> $m1b_w_script
3100
3101unset m1b_w_script
3102
3103set subcommand_args {}
3104proc usage {} {
3105	set s "[mc usage:] $::argv0 $::subcommand $::subcommand_args"
3106	if {[tk windowingsystem] eq "win32"} {
3107		wm withdraw .
3108		tk_messageBox -icon info -message $s \
3109			-title [mc "Usage"]
3110	} else {
3111		puts stderr $s
3112	}
3113	exit 1
3114}
3115
3116proc normalize_relpath {path} {
3117	set elements {}
3118	foreach item [file split $path] {
3119		if {$item eq {.}} continue
3120		if {$item eq {..} && [llength $elements] > 0
3121		    && [lindex $elements end] ne {..}} {
3122			set elements [lrange $elements 0 end-1]
3123			continue
3124		}
3125		lappend elements $item
3126	}
3127	return [eval file join $elements]
3128}
3129
3130# -- Not a normal commit type invocation?  Do that instead!
3131#
3132switch -- $subcommand {
3133browser -
3134blame {
3135	if {$subcommand eq "blame"} {
3136		set subcommand_args {[--line=<num>] rev? path}
3137	} else {
3138		set subcommand_args {rev? path}
3139	}
3140	if {$argv eq {}} usage
3141	set head {}
3142	set path {}
3143	set jump_spec {}
3144	set is_path 0
3145	foreach a $argv {
3146		set p [file join $_prefix $a]
3147
3148		if {$is_path || [file exists $p]} {
3149			if {$path ne {}} usage
3150			set path [normalize_relpath $p]
3151			break
3152		} elseif {$a eq {--}} {
3153			if {$path ne {}} {
3154				if {$head ne {}} usage
3155				set head $path
3156				set path {}
3157			}
3158			set is_path 1
3159		} elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3160			if {$jump_spec ne {} || $head ne {}} usage
3161			set jump_spec [list $lnum]
3162		} elseif {$head eq {}} {
3163			if {$head ne {}} usage
3164			set head $a
3165			set is_path 1
3166		} else {
3167			usage
3168		}
3169	}
3170	unset is_path
3171
3172	if {$head ne {} && $path eq {}} {
3173		if {[string index $head 0] eq {/}} {
3174			set path [normalize_relpath $head]
3175			set head {}
3176		} else {
3177			set path [normalize_relpath $_prefix$head]
3178			set head {}
3179		}
3180	}
3181
3182	if {$head eq {}} {
3183		load_current_branch
3184	} else {
3185		if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3186			if {[catch {
3187					set head [git rev-parse --verify $head]
3188				} err]} {
3189				if {[tk windowingsystem] eq "win32"} {
3190					tk_messageBox -icon error -title [mc Error] -message $err
3191				} else {
3192					puts stderr $err
3193				}
3194				exit 1
3195			}
3196		}
3197		set current_branch $head
3198	}
3199
3200	wm deiconify .
3201	switch -- $subcommand {
3202	browser {
3203		if {$jump_spec ne {}} usage
3204		if {$head eq {}} {
3205			if {$path ne {} && [file isdirectory $path]} {
3206				set head $current_branch
3207			} else {
3208				set head $path
3209				set path {}
3210			}
3211		}
3212		browser::new $head $path
3213	}
3214	blame   {
3215		if {$head eq {} && ![file exists $path]} {
3216			catch {wm withdraw .}
3217			tk_messageBox \
3218				-icon error \
3219				-type ok \
3220				-title [mc "git-gui: fatal error"] \
3221				-message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3222			exit 1
3223		}
3224		blame::new $head $path $jump_spec
3225	}
3226	}
3227	return
3228}
3229citool -
3230gui {
3231	if {[llength $argv] != 0} {
3232		usage
3233	}
3234	# fall through to setup UI for commits
3235}
3236default {
3237	set err "[mc usage:] $argv0 \[{blame|browser|citool}\]"
3238	if {[tk windowingsystem] eq "win32"} {
3239		wm withdraw .
3240		tk_messageBox -icon error -message $err \
3241			-title [mc "Usage"]
3242	} else {
3243		puts stderr $err
3244	}
3245	exit 1
3246}
3247}
3248
3249# -- Branch Control
3250#
3251${NS}::frame .branch
3252if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3253${NS}::label .branch.l1 \
3254	-text [mc "Current Branch:"] \
3255	-anchor w \
3256	-justify left
3257${NS}::label .branch.cb \
3258	-textvariable current_branch \
3259	-anchor w \
3260	-justify left
3261pack .branch.l1 -side left
3262pack .branch.cb -side left -fill x
3263pack .branch -side top -fill x
3264
3265# -- Main Window Layout
3266#
3267${NS}::panedwindow .vpane -orient horizontal
3268${NS}::panedwindow .vpane.files -orient vertical
3269if {$use_ttk} {
3270	.vpane add .vpane.files
3271} else {
3272	.vpane add .vpane.files -sticky nsew -height 100 -width 200
3273}
3274pack .vpane -anchor n -side top -fill both -expand 1
3275
3276# -- Working Directory File List
3277
3278textframe .vpane.files.workdir -height 100 -width 200
3279tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3280	-background lightsalmon -foreground black
3281ttext $ui_workdir \
3282	-borderwidth 0 \
3283	-width 20 -height 10 \
3284	-wrap none \
3285	-takefocus 1 -highlightthickness 1\
3286	-cursor $cursor_ptr \
3287	-xscrollcommand {.vpane.files.workdir.sx set} \
3288	-yscrollcommand {.vpane.files.workdir.sy set} \
3289	-state disabled
3290${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3291${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3292pack .vpane.files.workdir.title -side top -fill x
3293pack .vpane.files.workdir.sx -side bottom -fill x
3294pack .vpane.files.workdir.sy -side right -fill y
3295pack $ui_workdir -side left -fill both -expand 1
3296
3297# -- Index File List
3298#
3299textframe .vpane.files.index -height 100 -width 200
3300tlabel .vpane.files.index.title \
3301	-text [mc "Staged Changes (Will Commit)"] \
3302	-background lightgreen -foreground black
3303ttext $ui_index \
3304	-borderwidth 0 \
3305	-width 20 -height 10 \
3306	-wrap none \
3307	-takefocus 1 -highlightthickness 1\
3308	-cursor $cursor_ptr \
3309	-xscrollcommand {.vpane.files.index.sx set} \
3310	-yscrollcommand {.vpane.files.index.sy set} \
3311	-state disabled
3312${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3313${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3314pack .vpane.files.index.title -side top -fill x
3315pack .vpane.files.index.sx -side bottom -fill x
3316pack .vpane.files.index.sy -side right -fill y
3317pack $ui_index -side left -fill both -expand 1
3318
3319# -- Insert the workdir and index into the panes
3320#
3321.vpane.files add .vpane.files.workdir
3322.vpane.files add .vpane.files.index
3323if {!$use_ttk} {
3324	.vpane.files paneconfigure .vpane.files.workdir -sticky news
3325	.vpane.files paneconfigure .vpane.files.index -sticky news
3326}
3327
3328proc set_selection_colors {w has_focus} {
3329	foreach tag [list in_diff in_sel] {
3330		$w tag conf $tag \
3331			-background [expr {$has_focus ? $color::select_bg : $color::inactive_select_bg}] \
3332			-foreground [expr {$has_focus ? $color::select_fg : $color::inactive_select_fg}]
3333	}
3334}
3335
3336foreach i [list $ui_index $ui_workdir] {
3337	rmsel_tag $i
3338
3339	set_selection_colors $i 0
3340	bind $i <FocusIn>	{ set_selection_colors %W 1 }
3341	bind $i <FocusOut>	{ set_selection_colors %W 0 }
3342}
3343unset i
3344
3345# -- Diff and Commit Area
3346#
3347if {$have_tk85} {
3348	${NS}::panedwindow .vpane.lower -orient vertical
3349	${NS}::frame .vpane.lower.commarea
3350	${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500
3351	.vpane.lower add .vpane.lower.diff
3352	.vpane.lower add .vpane.lower.commarea
3353	.vpane add .vpane.lower
3354	if {$use_ttk} {
3355		.vpane.lower pane .vpane.lower.diff -weight 1
3356		.vpane.lower pane .vpane.lower.commarea -weight 0
3357	} else {
3358		.vpane.lower paneconfigure .vpane.lower.diff -stretch always
3359		.vpane.lower paneconfigure .vpane.lower.commarea -stretch never
3360	}
3361} else {
3362	frame .vpane.lower -height 300 -width 400
3363	frame .vpane.lower.commarea
3364	frame .vpane.lower.diff -relief sunken -borderwidth 1
3365	pack .vpane.lower.diff -fill both -expand 1
3366	pack .vpane.lower.commarea -side bottom -fill x
3367	.vpane add .vpane.lower
3368	.vpane paneconfigure .vpane.lower -sticky nsew
3369}
3370
3371# -- Commit Area Buttons
3372#
3373${NS}::frame .vpane.lower.commarea.buttons
3374${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3375	-anchor w \
3376	-justify left
3377pack .vpane.lower.commarea.buttons.l -side top -fill x
3378pack .vpane.lower.commarea.buttons -side left -fill y
3379
3380${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3381	-command ui_do_rescan
3382pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3383lappend disable_on_lock \
3384	{.vpane.lower.commarea.buttons.rescan conf -state}
3385
3386${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3387	-command do_add_all
3388pack .vpane.lower.commarea.buttons.incall -side top -fill x
3389lappend disable_on_lock \
3390	{.vpane.lower.commarea.buttons.incall conf -state}
3391
3392if {![is_enabled nocommitmsg]} {
3393	${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3394		-command do_signoff
3395	pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3396}
3397
3398${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3399	-command do_commit
3400pack .vpane.lower.commarea.buttons.commit -side top -fill x
3401lappend disable_on_lock \
3402	{.vpane.lower.commarea.buttons.commit conf -state}
3403
3404if {![is_enabled nocommit]} {
3405	${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3406		-command do_push_anywhere
3407	pack .vpane.lower.commarea.buttons.push -side top -fill x
3408}
3409
3410# -- Commit Message Buffer
3411#
3412${NS}::frame .vpane.lower.commarea.buffer
3413${NS}::frame .vpane.lower.commarea.buffer.header
3414set ui_comm .vpane.lower.commarea.buffer.frame.t
3415set ui_coml .vpane.lower.commarea.buffer.header.l
3416
3417if {![is_enabled nocommit]} {
3418	${NS}::checkbutton .vpane.lower.commarea.buffer.header.amend \
3419		-text [mc "Amend Last Commit"] \
3420		-variable commit_type_is_amend \
3421		-command do_select_commit_type
3422	lappend disable_on_lock \
3423		[list .vpane.lower.commarea.buffer.header.amend conf -state]
3424}
3425
3426${NS}::label $ui_coml \
3427	-anchor w \
3428	-justify left
3429proc trace_commit_type {varname args} {
3430	global ui_coml commit_type
3431	switch -glob -- $commit_type {
3432	initial       {set txt [mc "Initial Commit Message:"]}
3433	amend         {set txt [mc "Amended Commit Message:"]}
3434	amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3435	amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
3436	merge         {set txt [mc "Merge Commit Message:"]}
3437	*             {set txt [mc "Commit Message:"]}
3438	}
3439	$ui_coml conf -text $txt
3440}
3441trace add variable commit_type write trace_commit_type
3442pack $ui_coml -side left -fill x
3443
3444if {![is_enabled nocommit]} {
3445	pack .vpane.lower.commarea.buffer.header.amend -side right
3446}
3447
3448textframe .vpane.lower.commarea.buffer.frame
3449ttext $ui_comm \
3450	-borderwidth 1 \
3451	-undo true \
3452	-maxundo 20 \
3453	-autoseparators true \
3454	-takefocus 1 \
3455	-highlightthickness 1 \
3456	-relief sunken \
3457	-width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3458	-font font_diff \
3459	-xscrollcommand {.vpane.lower.commarea.buffer.frame.sbx set} \
3460	-yscrollcommand {.vpane.lower.commarea.buffer.frame.sby set}
3461${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sbx \
3462	-orient horizontal \
3463	-command [list $ui_comm xview]
3464${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sby \
3465	-orient vertical \
3466	-command [list $ui_comm yview]
3467
3468pack .vpane.lower.commarea.buffer.frame.sbx -side bottom -fill x
3469pack .vpane.lower.commarea.buffer.frame.sby -side right -fill y
3470pack $ui_comm -side left -fill y
3471pack .vpane.lower.commarea.buffer.header -side top -fill x
3472pack .vpane.lower.commarea.buffer.frame -side left -fill y
3473pack .vpane.lower.commarea.buffer -side left -fill y
3474
3475# -- Commit Message Buffer Context Menu
3476#
3477set ctxm .vpane.lower.commarea.buffer.ctxm
3478menu $ctxm -tearoff 0
3479$ctxm add command \
3480	-label [mc Cut] \
3481	-command {tk_textCut $ui_comm}
3482$ctxm add command \
3483	-label [mc Copy] \
3484	-command {tk_textCopy $ui_comm}
3485$ctxm add command \
3486	-label [mc Paste] \
3487	-command {tk_textPaste $ui_comm}
3488$ctxm add command \
3489	-label [mc Delete] \
3490	-command {catch {$ui_comm delete sel.first sel.last}}
3491$ctxm add separator
3492$ctxm add command \
3493	-label [mc "Select All"] \
3494	-command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3495$ctxm add command \
3496	-label [mc "Copy All"] \
3497	-command {
3498		$ui_comm tag add sel 0.0 end
3499		tk_textCopy $ui_comm
3500		$ui_comm tag remove sel 0.0 end
3501	}
3502$ctxm add separator
3503$ctxm add command \
3504	-label [mc "Sign Off"] \
3505	-command do_signoff
3506set ui_comm_ctxm $ctxm
3507
3508# -- Diff Header
3509#
3510proc trace_current_diff_path {varname args} {
3511	global current_diff_path diff_actions file_states
3512	if {$current_diff_path eq {}} {
3513		set s {}
3514		set f {}
3515		set p {}
3516		set o disabled
3517	} else {
3518		set p $current_diff_path
3519		set s [mapdesc [lindex $file_states($p) 0] $p]
3520		set f [mc "File:"]
3521		set p [escape_path $p]
3522		set o normal
3523	}
3524
3525	.vpane.lower.diff.header.status configure -text $s
3526	.vpane.lower.diff.header.file configure -text $f
3527	.vpane.lower.diff.header.path configure -text $p
3528	foreach w $diff_actions {
3529		uplevel #0 $w $o
3530	}
3531}
3532trace add variable current_diff_path write trace_current_diff_path
3533
3534gold_frame .vpane.lower.diff.header
3535tlabel .vpane.lower.diff.header.status \
3536	-background gold \
3537	-foreground black \
3538	-width $max_status_desc \
3539	-anchor w \
3540	-justify left
3541tlabel .vpane.lower.diff.header.file \
3542	-background gold \
3543	-foreground black \
3544	-anchor w \
3545	-justify left
3546tlabel .vpane.lower.diff.header.path \
3547	-background gold \
3548	-foreground blue \
3549	-anchor w \
3550	-justify left \
3551	-font [eval font create [font configure font_ui] -underline 1] \
3552	-cursor hand2
3553pack .vpane.lower.diff.header.status -side left
3554pack .vpane.lower.diff.header.file -side left
3555pack .vpane.lower.diff.header.path -fill x
3556set ctxm .vpane.lower.diff.header.ctxm
3557menu $ctxm -tearoff 0
3558$ctxm add command \
3559	-label [mc Copy] \
3560	-command {
3561		clipboard clear
3562		clipboard append \
3563			-format STRING \
3564			-type STRING \
3565			-- $current_diff_path
3566	}
3567$ctxm add command \
3568	-label [mc Open] \
3569	-command {do_file_open $current_diff_path}
3570lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3571bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3572bind .vpane.lower.diff.header.path <Button-1> {do_file_open $current_diff_path}
3573
3574# -- Diff Body
3575#
3576textframe .vpane.lower.diff.body
3577set ui_diff .vpane.lower.diff.body.t
3578ttext $ui_diff \
3579	-borderwidth 0 \
3580	-width 80 -height 5 -wrap none \
3581	-font font_diff \
3582	-takefocus 1 -highlightthickness 1 \
3583	-xscrollcommand {.vpane.lower.diff.body.sbx set} \
3584	-yscrollcommand {.vpane.lower.diff.body.sby set} \
3585	-state disabled
3586catch {$ui_diff configure -tabstyle wordprocessor}
3587${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3588	-command [list $ui_diff xview]
3589${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3590	-command [list $ui_diff yview]
3591pack .vpane.lower.diff.body.sbx -side bottom -fill x
3592pack .vpane.lower.diff.body.sby -side right -fill y
3593pack $ui_diff -side left -fill both -expand 1
3594pack .vpane.lower.diff.header -side top -fill x
3595pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3596
3597foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3598	$ui_diff tag configure clr4$n -background $c
3599	$ui_diff tag configure clri4$n -foreground $c
3600	$ui_diff tag configure clr3$n -foreground $c
3601	$ui_diff tag configure clri3$n -background $c
3602}
3603$ui_diff tag configure clr1 -font font_diffbold
3604$ui_diff tag configure clr4 -underline 1
3605
3606$ui_diff tag conf d_info -foreground blue -font font_diffbold
3607
3608$ui_diff tag conf d_cr -elide true
3609$ui_diff tag conf d_@ -font font_diffbold
3610$ui_diff tag conf d_+ -foreground {#00a000}
3611$ui_diff tag conf d_- -foreground red
3612
3613$ui_diff tag conf d_++ -foreground {#00a000}
3614$ui_diff tag conf d_-- -foreground red
3615$ui_diff tag conf d_+s \
3616	-foreground {#00a000} \
3617	-background {#e2effa}
3618$ui_diff tag conf d_-s \
3619	-foreground red \
3620	-background {#e2effa}
3621$ui_diff tag conf d_s+ \
3622	-foreground {#00a000} \
3623	-background ivory1
3624$ui_diff tag conf d_s- \
3625	-foreground red \
3626	-background ivory1
3627
3628$ui_diff tag conf d< \
3629	-foreground orange \
3630	-font font_diffbold
3631$ui_diff tag conf d| \
3632	-foreground orange \
3633	-font font_diffbold
3634$ui_diff tag conf d= \
3635	-foreground orange \
3636	-font font_diffbold
3637$ui_diff tag conf d> \
3638	-foreground orange \
3639	-font font_diffbold
3640
3641$ui_diff tag raise sel
3642
3643# -- Diff Body Context Menu
3644#
3645
3646proc create_common_diff_popup {ctxm} {
3647	$ctxm add command \
3648		-label [mc Refresh] \
3649		-command reshow_diff
3650	lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3651	$ctxm add command \
3652		-label [mc Copy] \
3653		-command {tk_textCopy $ui_diff}
3654	lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3655	$ctxm add command \
3656		-label [mc "Select All"] \
3657		-command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3658	lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3659	$ctxm add command \
3660		-label [mc "Copy All"] \
3661		-command {
3662			$ui_diff tag add sel 0.0 end
3663			tk_textCopy $ui_diff
3664			$ui_diff tag remove sel 0.0 end
3665		}
3666	lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3667	$ctxm add separator
3668	$ctxm add command \
3669		-label [mc "Decrease Font Size"] \
3670		-command {incr_font_size font_diff -1}
3671	lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3672	$ctxm add command \
3673		-label [mc "Increase Font Size"] \
3674		-command {incr_font_size font_diff 1}
3675	lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3676	$ctxm add separator
3677	set emenu $ctxm.enc
3678	menu $emenu
3679	build_encoding_menu $emenu [list force_diff_encoding]
3680	$ctxm add cascade \
3681		-label [mc "Encoding"] \
3682		-menu $emenu
3683	lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3684	$ctxm add separator
3685	$ctxm add command -label [mc "Options..."] \
3686		-command do_options
3687}
3688
3689set ctxm .vpane.lower.diff.body.ctxm
3690menu $ctxm -tearoff 0
3691$ctxm add command \
3692	-label [mc "Apply/Reverse Hunk"] \
3693	-command {apply_or_revert_hunk $cursorX $cursorY 0}
3694set ui_diff_applyhunk [$ctxm index last]
3695lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3696$ctxm add command \
3697	-label [mc "Apply/Reverse Line"] \
3698	-command {apply_or_revert_range_or_line $cursorX $cursorY 0; do_rescan}
3699set ui_diff_applyline [$ctxm index last]
3700lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3701$ctxm add separator
3702$ctxm add command \
3703	-label [mc "Revert Hunk"] \
3704	-command {apply_or_revert_hunk $cursorX $cursorY 1}
3705set ui_diff_reverthunk [$ctxm index last]
3706lappend diff_actions [list $ctxm entryconf $ui_diff_reverthunk -state]
3707$ctxm add command \
3708	-label [mc "Revert Line"] \
3709	-command {apply_or_revert_range_or_line $cursorX $cursorY 1; do_rescan}
3710set ui_diff_revertline [$ctxm index last]
3711lappend diff_actions [list $ctxm entryconf $ui_diff_revertline -state]
3712$ctxm add command \
3713	-label [mc "Undo Last Revert"] \
3714	-command {undo_last_revert; do_rescan}
3715set ui_diff_undorevert [$ctxm index last]
3716lappend diff_actions [list $ctxm entryconf $ui_diff_undorevert -state]
3717$ctxm add separator
3718$ctxm add command \
3719	-label [mc "Show Less Context"] \
3720	-command show_less_context
3721lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3722$ctxm add command \
3723	-label [mc "Show More Context"] \
3724	-command show_more_context
3725lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3726$ctxm add separator
3727create_common_diff_popup $ctxm
3728
3729set ctxmmg .vpane.lower.diff.body.ctxmmg
3730menu $ctxmmg -tearoff 0
3731$ctxmmg add command \
3732	-label [mc "Run Merge Tool"] \
3733	-command {merge_resolve_tool}
3734lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3735$ctxmmg add separator
3736$ctxmmg add command \
3737	-label [mc "Use Remote Version"] \
3738	-command {merge_resolve_one 3}
3739lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3740$ctxmmg add command \
3741	-label [mc "Use Local Version"] \
3742	-command {merge_resolve_one 2}
3743lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3744$ctxmmg add command \
3745	-label [mc "Revert To Base"] \
3746	-command {merge_resolve_one 1}
3747lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3748$ctxmmg add separator
3749$ctxmmg add command \
3750	-label [mc "Show Less Context"] \
3751	-command show_less_context
3752lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3753$ctxmmg add command \
3754	-label [mc "Show More Context"] \
3755	-command show_more_context
3756lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3757$ctxmmg add separator
3758create_common_diff_popup $ctxmmg
3759
3760set ctxmsm .vpane.lower.diff.body.ctxmsm
3761menu $ctxmsm -tearoff 0
3762$ctxmsm add command \
3763	-label [mc "Visualize These Changes In The Submodule"] \
3764	-command {do_gitk -- true}
3765lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3766$ctxmsm add command \
3767	-label [mc "Visualize Current Branch History In The Submodule"] \
3768	-command {do_gitk {} true}
3769lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3770$ctxmsm add command \
3771	-label [mc "Visualize All Branch History In The Submodule"] \
3772	-command {do_gitk --all true}
3773lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3774$ctxmsm add separator
3775$ctxmsm add command \
3776	-label [mc "Start git gui In The Submodule"] \
3777	-command {do_git_gui}
3778lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3779$ctxmsm add separator
3780create_common_diff_popup $ctxmsm
3781
3782proc has_textconv {path} {
3783	if {[is_config_false gui.textconv]} {
3784		return 0
3785	}
3786	set filter [gitattr $path diff set]
3787	set textconv [get_config [join [list diff $filter textconv] .]]
3788	if {$filter ne {set} && $textconv ne {}} {
3789		return 1
3790	} else {
3791		return 0
3792	}
3793}
3794
3795proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3796	global current_diff_path file_states last_revert
3797	set ::cursorX $x
3798	set ::cursorY $y
3799	if {[info exists file_states($current_diff_path)]} {
3800		set state [lindex $file_states($current_diff_path) 0]
3801	} else {
3802		set state {__}
3803	}
3804	if {[string first {U} $state] >= 0} {
3805		tk_popup $ctxmmg $X $Y
3806	} elseif {$::is_submodule_diff} {
3807		tk_popup $ctxmsm $X $Y
3808	} else {
3809		set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3810		set u [mc "Undo Last Revert"]
3811		if {$::ui_index eq $::current_diff_side} {
3812			set l [mc "Unstage Hunk From Commit"]
3813			set h [mc "Revert Hunk"]
3814
3815			if {$has_range} {
3816				set t [mc "Unstage Lines From Commit"]
3817				set r [mc "Revert Lines"]
3818			} else {
3819				set t [mc "Unstage Line From Commit"]
3820				set r [mc "Revert Line"]
3821			}
3822		} else {
3823			set l [mc "Stage Hunk For Commit"]
3824			set h [mc "Revert Hunk"]
3825
3826			if {$has_range} {
3827				set t [mc "Stage Lines For Commit"]
3828				set r [mc "Revert Lines"]
3829			} else {
3830				set t [mc "Stage Line For Commit"]
3831				set r [mc "Revert Line"]
3832			}
3833		}
3834		if {$::is_3way_diff
3835			|| $current_diff_path eq {}
3836			|| {__} eq $state
3837			|| {_O} eq $state
3838			|| [string match {?T} $state]
3839			|| [string match {T?} $state]
3840			|| [has_textconv $current_diff_path]} {
3841			set s disabled
3842			set revert_state disabled
3843		} else {
3844			set s normal
3845
3846			# Only allow reverting changes in the working tree. If
3847			# the user wants to revert changes in the index, they
3848			# need to unstage those first.
3849			if {$::ui_workdir eq $::current_diff_side} {
3850				set revert_state normal
3851			} else {
3852				set revert_state disabled
3853			}
3854		}
3855
3856		if {$last_revert eq {}} {
3857			set undo_state disabled
3858		} else {
3859			set undo_state normal
3860		}
3861
3862		$ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3863		$ctxm entryconf $::ui_diff_applyline -state $s -label $t
3864		$ctxm entryconf $::ui_diff_revertline -state $revert_state \
3865			-label $r
3866		$ctxm entryconf $::ui_diff_reverthunk -state $revert_state \
3867			-label $h
3868		$ctxm entryconf $::ui_diff_undorevert -state $undo_state \
3869			-label $u
3870
3871		tk_popup $ctxm $X $Y
3872	}
3873}
3874bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3875
3876# -- Status Bar
3877#
3878set main_status [::status_bar::new .status]
3879pack .status -anchor w -side bottom -fill x
3880$main_status show [mc "Initializing..."]
3881
3882# -- Load geometry
3883#
3884proc on_ttk_pane_mapped {w pane pos} {
3885	bind $w <Map> {}
3886	after 0 [list after idle [list $w sashpos $pane $pos]]
3887}
3888proc on_tk_pane_mapped {w pane x y} {
3889	bind $w <Map> {}
3890	after 0 [list after idle [list $w sash place $pane $x $y]]
3891}
3892proc on_application_mapped {} {
3893	global repo_config use_ttk
3894	bind . <Map> {}
3895	set gm $repo_config(gui.geometry)
3896	if {$use_ttk} {
3897		bind .vpane <Map> \
3898			[list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3899		bind .vpane.files <Map> \
3900			[list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3901	} else {
3902		bind .vpane <Map> \
3903			[list on_tk_pane_mapped %W 0 \
3904			[lindex $gm 1] \
3905			[lindex [.vpane sash coord 0] 1]]
3906		bind .vpane.files <Map> \
3907			[list on_tk_pane_mapped %W 0 \
3908			[lindex [.vpane.files sash coord 0] 0] \
3909			[lindex $gm 2]]
3910	}
3911	wm geometry . [lindex $gm 0]
3912}
3913if {[info exists repo_config(gui.geometry)]} {
3914	bind . <Map> [list on_application_mapped]
3915	wm geometry . [lindex $repo_config(gui.geometry) 0]
3916}
3917
3918# -- Load window state
3919#
3920if {[info exists repo_config(gui.wmstate)]} {
3921	catch {wm state . $repo_config(gui.wmstate)}
3922}
3923
3924# -- Key Bindings
3925#
3926bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3927bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3928bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3929bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3930bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3931bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3932bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3933bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3934bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3935bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3936bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3937bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3938bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3939bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3940bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3941bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3942bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3943bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3944bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3945bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3946bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3947bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3948bind $ui_comm <$M1B-Key-BackSpace> {event generate %W <Meta-Delete>;break}
3949bind $ui_comm <$M1B-Key-Delete> {event generate %W <Meta-d>;break}
3950
3951bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3952bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3953bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3954bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3955bind $ui_diff <$M1B-Key-v> {break}
3956bind $ui_diff <$M1B-Key-V> {break}
3957bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3958bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3959bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
3960bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
3961bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3962bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3963bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3964bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3965bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
3966bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
3967bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
3968bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
3969bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3970bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
3971bind $ui_diff <Button-1>   {focus %W}
3972
3973if {[is_enabled branch]} {
3974	bind . <$M1B-Key-n> branch_create::dialog
3975	bind . <$M1B-Key-N> branch_create::dialog
3976	bind . <$M1B-Key-o> branch_checkout::dialog
3977	bind . <$M1B-Key-O> branch_checkout::dialog
3978	bind . <$M1B-Key-m> merge::dialog
3979	bind . <$M1B-Key-M> merge::dialog
3980}
3981if {[is_enabled transport]} {
3982	bind . <$M1B-Key-p> do_push_anywhere
3983	bind . <$M1B-Key-P> do_push_anywhere
3984}
3985
3986bind .   <Key-F5>     ui_do_rescan
3987bind .   <$M1B-Key-r> ui_do_rescan
3988bind .   <$M1B-Key-R> ui_do_rescan
3989bind .   <$M1B-Key-s> do_signoff
3990bind .   <$M1B-Key-S> do_signoff
3991bind .   <$M1B-Key-t> { toggle_or_diff toggle %W }
3992bind .   <$M1B-Key-T> { toggle_or_diff toggle %W }
3993bind .   <$M1B-Key-u> { toggle_or_diff toggle %W }
3994bind .   <$M1B-Key-U> { toggle_or_diff toggle %W }
3995bind .   <$M1B-Key-j> do_revert_selection
3996bind .   <$M1B-Key-J> do_revert_selection
3997bind .   <$M1B-Key-i> do_add_all
3998bind .   <$M1B-Key-I> do_add_all
3999bind .   <$M1B-Key-e> toggle_commit_type
4000bind .   <$M1B-Key-E> toggle_commit_type
4001bind .   <$M1B-Key-minus> {show_less_context;break}
4002bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
4003bind .   <$M1B-Key-equal> {show_more_context;break}
4004bind .   <$M1B-Key-plus> {show_more_context;break}
4005bind .   <$M1B-Key-KP_Add> {show_more_context;break}
4006bind .   <$M1B-Key-Return> do_commit
4007bind .   <$M1B-Key-KP_Enter> do_commit
4008foreach i [list $ui_index $ui_workdir] {
4009	bind $i <Button-1>       { toggle_or_diff click %W %x %y; break }
4010	bind $i <$M1B-Button-1>  { add_one_to_selection %W %x %y; break }
4011	bind $i <Shift-Button-1> { add_range_to_selection %W %x %y; break }
4012	bind $i <Key-Up>         { toggle_or_diff up %W; break }
4013	bind $i <Key-Down>       { toggle_or_diff down %W; break }
4014}
4015unset i
4016
4017bind .   <Alt-Key-1> {focus_widget $::ui_workdir}
4018bind .   <Alt-Key-2> {focus_widget $::ui_index}
4019bind .   <Alt-Key-3> {focus $::ui_diff}
4020bind .   <Alt-Key-4> {focus $::ui_comm}
4021
4022set file_lists_last_clicked($ui_index) {}
4023set file_lists_last_clicked($ui_workdir) {}
4024
4025set file_lists($ui_index) [list]
4026set file_lists($ui_workdir) [list]
4027
4028wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
4029focus -force $ui_comm
4030
4031# -- Warn the user about environmental problems.  Cygwin's Tcl
4032#    does *not* pass its env array onto any processes it spawns.
4033#    This means that git processes get none of our environment.
4034#
4035if {[is_Cygwin]} {
4036	set ignored_env 0
4037	set suggest_user {}
4038	set msg [mc "Possible environment issues exist.
4039
4040The following environment variables are probably
4041going to be ignored by any Git subprocess run
4042by %s:
4043
4044" [appname]]
4045	foreach name [array names env] {
4046		switch -regexp -- $name {
4047		{^GIT_INDEX_FILE$} -
4048		{^GIT_OBJECT_DIRECTORY$} -
4049		{^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4050		{^GIT_DIFF_OPTS$} -
4051		{^GIT_EXTERNAL_DIFF$} -
4052		{^GIT_PAGER$} -
4053		{^GIT_TRACE$} -
4054		{^GIT_CONFIG$} -
4055		{^GIT_(AUTHOR|COMMITTER)_DATE$} {
4056			append msg " - $name\n"
4057			incr ignored_env
4058		}
4059		{^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4060			append msg " - $name\n"
4061			incr ignored_env
4062			set suggest_user $name
4063		}
4064		}
4065	}
4066	if {$ignored_env > 0} {
4067		append msg [mc "
4068This is due to a known issue with the
4069Tcl binary distributed by Cygwin."]
4070
4071		if {$suggest_user ne {}} {
4072			append msg [mc "
4073
4074A good replacement for %s
4075is placing values for the user.name and
4076user.email settings into your personal
4077~/.gitconfig file.
4078" $suggest_user]
4079		}
4080		warn_popup $msg
4081	}
4082	unset ignored_env msg suggest_user name
4083}
4084
4085# -- Only initialize complex UI if we are going to stay running.
4086#
4087if {[is_enabled transport]} {
4088	load_all_remotes
4089
4090	set n [.mbar.remote index end]
4091	populate_remotes_menu
4092	set n [expr {[.mbar.remote index end] - $n}]
4093	if {$n > 0} {
4094		if {[.mbar.remote type 0] eq "tearoff"} { incr n }
4095		.mbar.remote insert $n separator
4096	}
4097	unset n
4098}
4099
4100if {[winfo exists $ui_comm]} {
4101	set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
4102
4103	# -- If both our backup and message files exist use the
4104	#    newer of the two files to initialize the buffer.
4105	#
4106	if {$GITGUI_BCK_exists} {
4107		set m [gitdir GITGUI_MSG]
4108		if {[file isfile $m]} {
4109			if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
4110				catch {file delete [gitdir GITGUI_MSG]}
4111			} else {
4112				$ui_comm delete 0.0 end
4113				$ui_comm edit reset
4114				$ui_comm edit modified false
4115				catch {file delete [gitdir GITGUI_BCK]}
4116				set GITGUI_BCK_exists 0
4117			}
4118		}
4119		unset m
4120	}
4121
4122	proc backup_commit_buffer {} {
4123		global ui_comm GITGUI_BCK_exists
4124
4125		set m [$ui_comm edit modified]
4126		if {$m || $GITGUI_BCK_exists} {
4127			set msg [string trim [$ui_comm get 0.0 end]]
4128			regsub -all -line {[ \r\t]+$} $msg {} msg
4129
4130			if {$msg eq {}} {
4131				if {$GITGUI_BCK_exists} {
4132					catch {file delete [gitdir GITGUI_BCK]}
4133					set GITGUI_BCK_exists 0
4134				}
4135			} elseif {$m} {
4136				catch {
4137					set fd [open [gitdir GITGUI_BCK] w]
4138					fconfigure $fd -encoding utf-8
4139					puts -nonewline $fd $msg
4140					close $fd
4141					set GITGUI_BCK_exists 1
4142				}
4143			}
4144
4145			$ui_comm edit modified false
4146		}
4147
4148		set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
4149	}
4150
4151	backup_commit_buffer
4152
4153	# -- If the user has aspell available we can drive it
4154	#    in pipe mode to spellcheck the commit message.
4155	#
4156	set spell_cmd [list |]
4157	set spell_dict [get_config gui.spellingdictionary]
4158	lappend spell_cmd aspell
4159	if {$spell_dict ne {}} {
4160		lappend spell_cmd --master=$spell_dict
4161	}
4162	lappend spell_cmd --mode=none
4163	lappend spell_cmd --encoding=utf-8
4164	lappend spell_cmd pipe
4165	if {$spell_dict eq {none}
4166	 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
4167		bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
4168	} else {
4169		set ui_comm_spell [spellcheck::init \
4170			$spell_fd \
4171			$ui_comm \
4172			$ui_comm_ctxm \
4173		]
4174	}
4175	unset -nocomplain spell_cmd spell_fd spell_err spell_dict
4176}
4177
4178lock_index begin-read
4179if {![winfo ismapped .]} {
4180	wm deiconify .
4181}
4182after 1 {
4183	if {[is_enabled initialamend]} {
4184		force_amend
4185	} else {
4186		do_rescan
4187	}
4188
4189	if {[is_enabled nocommitmsg]} {
4190		$ui_comm configure -state disabled -background gray
4191	}
4192}
4193if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
4194	after 1000 hint_gc
4195}
4196if {[is_enabled retcode]} {
4197	bind . <Destroy> {+terminate_me %W}
4198}
4199if {$picked && [is_config_true gui.autoexplore]} {
4200	do_explore
4201}
4202
4203# Clear "Initializing..." status
4204after 500 {$main_status show ""}
4205
4206# Local variables:
4207# mode: tcl
4208# indent-tabs-mode: t
4209# tab-width: 4
4210# End:
4211