git-gui: Changed blame header bar background to match main window

The main window's diff header bar background switched from orange
to gold recently, and I liked the effect it had on readability of
the text.  Since I wanted the blame viewer to match, here it is.

Though this probably should be a user defined color, or at least
a constant somewhere that everyone can reference.

Signed-off-by: Shawn O. Pearce <spearce@spearce.org>

GIT-VERSION-GEN

@@ -1,7 +1,7 @@
 #!/bin/sh
 
 GVF=GIT-VERSION-FILE
-DEF_VER=0.6.GITGUI
+DEF_VER=0.7.GITGUI
 
 LF='
 '

Makefile

@@ -11,6 +11,7 @@ SCRIPT_SH = git-gui.sh
 GITGUI_BUILT_INS = git-citool
 ALL_PROGRAMS = $(GITGUI_BUILT_INS) $(patsubst %.sh,%,$(SCRIPT_SH))
 ALL_LIBFILES = $(wildcard lib/*.tcl)
+PRELOAD_FILES = lib/class.tcl
 
 ifndef SHELL_PATH
 	SHELL_PATH = /bin/sh
@@ -21,7 +22,7 @@ ifndef gitexecdir
 endif
 
 ifndef sharedir
-	sharedir := $(dir $(gitexecdir))/share
+	sharedir := $(dir $(gitexecdir))share
 endif
 
 ifndef INSTALL
@@ -32,6 +33,7 @@ ifndef V
 	QUIET_GEN      = @echo '   ' GEN $@;
 	QUIET_BUILT_IN = @echo '   ' BUILTIN $@;
 	QUIET_INDEX    = @echo '   ' INDEX $(dir $@);
+	QUIET_2DEVNULL = 2>/dev/null
 endif
 
 TCL_PATH   ?= tclsh
@@ -45,17 +47,25 @@ endif
 DESTDIR_SQ = $(subst ','\'',$(DESTDIR))
 gitexecdir_SQ = $(subst ','\'',$(gitexecdir))
 SHELL_PATH_SQ = $(subst ','\'',$(SHELL_PATH))
+TCL_PATH_SQ = $(subst ','\'',$(TCL_PATH))
 TCLTK_PATH_SQ = $(subst ','\'',$(TCLTK_PATH))
 
 libdir   ?= $(sharedir)/git-gui/lib
 libdir_SQ = $(subst ','\'',$(libdir))
 
+exedir    = $(dir $(gitexecdir))share/git-gui/lib
+exedir_SQ = $(subst ','\'',$(exedir))
+
 $(patsubst %.sh,%,$(SCRIPT_SH)) : % : %.sh
 	$(QUIET_GEN)rm -f $@ $@+ && \
+	if test '$(exedir_SQ)' = '$(libdir_SQ)'; then \
+		GITGUI_RELATIVE=1; \
+	fi && \
 	sed -e '1s|#!.*/sh|#!$(SHELL_PATH_SQ)|' \
 		-e 's|^exec wish "$$0"|exec $(subst |,'\|',$(TCLTK_PATH_SQ)) "$$0"|' \
 		-e 's/@@GITGUI_VERSION@@/$(GITGUI_VERSION)/g' \
-		-e 's|@@GITGUI_LIBDIR@@|$(libdir_SQ)|' \
+		-e 's|@@GITGUI_RELATIVE@@|'$$GITGUI_RELATIVE'|' \
+		-e $$GITGUI_RELATIVE's|@@GITGUI_LIBDIR@@|$(libdir_SQ)|' \
 		$@.sh >$@+ && \
 	chmod +x $@+ && \
 	mv $@+ $@
@@ -64,14 +74,28 @@ $(GITGUI_BUILT_INS): git-gui
 	$(QUIET_BUILT_IN)rm -f $@ && ln git-gui $@
 
 lib/tclIndex: $(ALL_LIBFILES)
-	$(QUIET_INDEX)echo auto_mkindex lib '*.tcl' | $(TCL_PATH)
+	$(QUIET_INDEX)if echo \
+	  $(foreach p,$(PRELOAD_FILES),source $p\;) \
+	  auto_mkindex lib '*.tcl' \
+	| $(TCL_PATH) $(QUIET_2DEVNULL); then : ok; \
+	else \
+	 echo 1>&2 "    * $(TCL_PATH) failed; using unoptimized loading"; \
+	 rm -f $@ ; \
+	 echo '# Autogenerated by git-gui Makefile' >$@ && \
+	 echo >>$@ && \
+	 $(foreach p,$(PRELOAD_FILES) $(ALL_LIBFILES),echo '$(subst lib/,,$p)' >>$@ &&) \
+	 echo >>$@ ; \
+	fi
 
 # These can record GITGUI_VERSION
 $(patsubst %.sh,%,$(SCRIPT_SH)): GIT-VERSION-FILE GIT-GUI-VARS
+lib/tclIndex: GIT-GUI-VARS
 
 TRACK_VARS = \
 	$(subst ','\'',SHELL_PATH='$(SHELL_PATH_SQ)') \
+	$(subst ','\'',TCL_PATH='$(TCL_PATH_SQ)') \
 	$(subst ','\'',TCLTK_PATH='$(TCLTK_PATH_SQ)') \
+	$(subst ','\'',gitexecdir='$(gitexecdir_SQ)') \
 	$(subst ','\'',libdir='$(libdir_SQ)') \
 #end TRACK_VARS
 

git-gui.sh

@@ -20,15 +20,62 @@ You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
 
+######################################################################
+##
+## Tcl/Tk sanity check
+
+if {[catch {package require Tcl 8.4} err]
+ || [catch {package require Tk  8.4} err]
+} {
+	catch {wm withdraw .}
+	tk_messageBox \
+		-icon error \
+		-type ok \
+		-title "git-gui: fatal error" \
+		-message $err
+	exit 1
+}
+
 ######################################################################
 ##
 ## configure our library
 
 set oguilib {@@GITGUI_LIBDIR@@}
-if {[string match @@* $oguilib]} {
+set oguirel {@@GITGUI_RELATIVE@@}
+if {$oguirel eq {1}} {
+	set oguilib [file dirname [file dirname [file normalize $argv0]]]
+	set oguilib [file join $oguilib share git-gui lib]
+} elseif {[string match @@* $oguirel]} {
 	set oguilib [file join [file dirname [file normalize $argv0]] lib]
 }
-set auto_path [concat [list $oguilib] $auto_path]
+set idx [file join $oguilib tclIndex]
+catch {
+	set fd [open $idx r]
+	if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
+		set idx [list]
+		while {[gets $fd n] >= 0} {
+			if {$n ne {} && ![string match #* $n]} {
+				lappend idx $n
+			}
+		}
+	} else {
+		set idx {}
+	}
+	close $fd
+}
+if {$idx ne {}} {
+	set loaded [list]
+	foreach p $idx {
+		if {[lsearch -exact $loaded $p] >= 0} continue
+		puts $p
+		source [file join $oguilib $p]
+		lappend loaded $p
+	}
+	unset loaded p
+} else {
+	set auto_path [concat [list $oguilib] $auto_path]
+}
+unset -nocomplain oguilib oguirel idx fd
 
 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
 	unset _verbose
@@ -261,8 +308,14 @@ unset -nocomplain v _junk act_maj act_min req_maj req_min
 ##
 ## repository setup
 
-if {   [catch {set _gitdir $env(GIT_DIR)}]
+if {[catch {
-	&& [catch {set _gitdir [git rev-parse --git-dir]} err]} {
+		set _gitdir $env(GIT_DIR)
+		set _prefix {}
+		}]
+	&& [catch {
+		set _gitdir [git rev-parse --git-dir]
+		set _prefix [git rev-parse --show-prefix]
+	} err]} {
 	catch {wm withdraw .}
 	error_popup "Cannot find the git directory:\n\n$err"
 	exit 1
@@ -971,6 +1024,7 @@ proc incr_font_size {font {amt 1}} {
 	incr sz $amt
 	font configure $font -size $sz
 	font configure ${font}bold -size $sz
+	font configure ${font}italic -size $sz
 }
 
 ######################################################################
@@ -1163,25 +1217,24 @@ catch {
 	destroy .dummy
 }
 
+font create font_uiitalic
 font create font_uibold
 font create font_diffbold
+font create font_diffitalic
 
 foreach class {Button Checkbutton Entry Label
 		Labelframe Listbox Menu Message
-		Radiobutton Text} {
+		Radiobutton Spinbox Text} {
 	option add *$class.font font_ui
 }
 unset class
 
-if {[is_Windows]} {
+if {[is_MacOSX]} {
-	set M1B Control
-	set M1T Ctrl
-} elseif {[is_MacOSX]} {
 	set M1B M1
 	set M1T Cmd
 } else {
-	set M1B M1
+	set M1B Control
-	set M1T M1
+	set M1T Ctrl
 }
 
 proc apply_config {} {
@@ -1199,8 +1252,10 @@ proc apply_config {} {
 		}
 		foreach {cn cv} [font configure $font] {
 			font configure ${font}bold $cn $cv
+			font configure ${font}italic $cn $cv
 		}
 		font configure ${font}bold -weight bold
+		font configure ${font}italic -slant italic
 	}
 }
 
@@ -1288,7 +1343,7 @@ menu .mbar.repository
 
 .mbar.repository add command \
 	-label {Browse Current Branch} \
-	-command {new_browser $current_branch}
+	-command {browser::new $current_branch}
 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
 .mbar.repository add separator
 
@@ -1566,31 +1621,73 @@ unset browser doc_path doc_url
 
 # -- Standard bindings
 #
-bind .   <Destroy> do_quit
+bind .   <Destroy> {if {{%W} eq {.}} do_quit}
 bind all <$M1B-Key-q> do_quit
 bind all <$M1B-Key-Q> do_quit
 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
 
+set subcommand_args {}
+proc usage {} {
+	puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
+	exit 1
+}
+
 # -- Not a normal commit type invocation?  Do that instead!
 #
 switch -- $subcommand {
 browser {
-	if {[llength $argv] != 1} {
+	set subcommand_args {rev?}
-		puts stderr "usage: $argv0 browser commit"
+	switch [llength $argv] {
-		exit 1
+	0 {
+		set current_branch [git symbolic-ref HEAD]
+		regsub ^refs/((heads|tags|remotes)/)? \
+			$current_branch {} current_branch
 	}
-	set current_branch [lindex $argv 0]
+	1 {
-	new_browser $current_branch
+		set current_branch [lindex $argv 0]
+	}
+	default usage
+	}
+	browser::new $current_branch
 	return
 }
 blame {
-	if {[llength $argv] != 2} {
+	set subcommand_args {rev? path?}
-		puts stderr "usage: $argv0 blame commit path"
+	set head {}
-		exit 1
+	set path {}
+	set is_path 0
+	foreach a $argv {
+		if {$is_path || [file exists $_prefix$a]} {
+			if {$path ne {}} usage
+			set path $_prefix$a
+			break
+		} elseif {$a eq {--}} {
+			if {$path ne {}} {
+				if {$head ne {}} usage
+				set head $path
+				set path {}
+			}
+			set is_path 1
+		} elseif {$head eq {}} {
+			if {$head ne {}} usage
+			set head $a
+		} else {
+			usage
+		}
 	}
-	set current_branch [lindex $argv 0]
+	unset is_path
-	show_blame $current_branch [lindex $argv 1]
+
+	if {$head eq {}} {
+		set current_branch [git symbolic-ref HEAD]
+		regsub ^refs/((heads|tags|remotes)/)? \
+			$current_branch {} current_branch
+	} else {
+		set current_branch $head
+	}
+
+	if {$path eq {}} usage
+	blame::new $head $path
 	return
 }
 citool -
@@ -1638,8 +1735,8 @@ pack .vpane -anchor n -side top -fill both -expand 1
 # -- Index File List
 #
 frame .vpane.files.index -height 100 -width 200
-label .vpane.files.index.title -text {Changes To Be Committed} \
+label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
-	-background green
+	-background lightgreen
 text $ui_index -background white -borderwidth 0 \
 	-width 20 -height 10 \
 	-wrap none \
@@ -1658,8 +1755,8 @@ pack $ui_index -side left -fill both -expand 1
 # -- Working Directory File List
 #
 frame .vpane.files.workdir -height 100 -width 200
-label .vpane.files.workdir.title -text {Changed But Not Updated} \
+label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
-	-background red
+	-background lightsalmon
 text $ui_workdir -background white -borderwidth 0 \
 	-width 20 -height 10 \
 	-wrap none \
@@ -1676,10 +1773,8 @@ pack $ui_workdir -side left -fill both -expand 1
 .vpane.files add .vpane.files.workdir -sticky nsew
 
 foreach i [list $ui_index $ui_workdir] {
-	$i tag conf in_diff -font font_uibold
+	$i tag conf in_diff -background lightgray
-	$i tag conf in_sel \
+	$i tag conf in_sel  -background lightgray
-		-background [$i cget -foreground] \
-		-foreground [$i cget -background]
 }
 unset i
 
@@ -1837,18 +1932,18 @@ proc trace_current_diff_path {varname args} {
 }
 trace add variable current_diff_path write trace_current_diff_path
 
-frame .vpane.lower.diff.header -background orange
+frame .vpane.lower.diff.header -background gold
 label .vpane.lower.diff.header.status \
-	-background orange \
+	-background gold \
 	-width $max_status_desc \
 	-anchor w \
 	-justify left
 label .vpane.lower.diff.header.file \
-	-background orange \
+	-background gold \
 	-anchor w \
 	-justify left
 label .vpane.lower.diff.header.path \
-	-background orange \
+	-background gold \
 	-anchor w \
 	-justify left
 pack .vpane.lower.diff.header.status -side left
@@ -1962,17 +2057,17 @@ lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
 $ctxm add separator
 $ctxm add command \
 	-label {Show Less Context} \
-	-command {if {$repo_config(gui.diffcontext) >= 2} {
+	-command {if {$repo_config(gui.diffcontext) >= 1} {
 		incr repo_config(gui.diffcontext) -1
 		reshow_diff
 	}}
 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
 $ctxm add command \
 	-label {Show More Context} \
-	-command {
+	-command {if {$repo_config(gui.diffcontext) < 99} {
 		incr repo_config(gui.diffcontext)
 		reshow_diff
-	}
+	}}
 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
 $ctxm add separator
 $ctxm add command -label {Options...} \

lib/branch.tcl

@@ -201,12 +201,14 @@ proc do_create_branch {} {
 	pack $w.desc -anchor nw -fill x -pady 5 -padx 5
 
 	labelframe $w.from -text {Starting Revision}
-	radiobutton $w.from.head_r \
+	if {$all_heads ne {}} {
-		-text {Local Branch:} \
+		radiobutton $w.from.head_r \
-		-value head \
+			-text {Local Branch:} \
-		-variable create_branch_revtype
+			-value head \
-	eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
+			-variable create_branch_revtype
-	grid $w.from.head_r $w.from.head_m -sticky w
+		eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
+		grid $w.from.head_r $w.from.head_m -sticky w
+	}
 	set all_trackings [all_tracking_branches]
 	if {$all_trackings ne {}} {
 		set create_branch_trackinghead [lindex $all_trackings 0]

lib/browser.tcl

@@ -1,28 +1,26 @@
 # git-gui tree browser
 # Copyright (C) 2006, 2007 Shawn Pearce
 
-set next_browser_id 0
+class browser {
 
-proc new_browser {commit} {
+field w
-	global next_browser_id cursor_ptr M1B
+field browser_commit
-	global browser_commit browser_status browser_stack browser_path browser_busy
+field browser_path
+field browser_files  {}
+field browser_status {Starting...}
+field browser_stack  {}
+field browser_busy   1
 
-	if {[winfo ismapped .]} {
+constructor new {commit} {
-		set w .browser[incr next_browser_id]
+	global cursor_ptr M1B
-		set tl $w
+	make_toplevel top w
-		toplevel $w
+	wm title $top "[appname] ([reponame]): File Browser"
-	} else {
-		set w {}
-		set tl .
-	}
-	set w_list $w.list.l
-	set browser_commit($w_list) $commit
-	set browser_status($w_list) {Starting...}
-	set browser_stack($w_list) {}
-	set browser_path($w_list) $browser_commit($w_list):
-	set browser_busy($w_list) 1
 
-	label $w.path -textvariable browser_path($w_list) \
+	set browser_commit $commit
+	set browser_path $browser_commit:
+
+	label $w.path \
+		-textvariable @browser_path \
 		-anchor w \
 		-justify left \
 		-borderwidth 1 \
@@ -31,6 +29,7 @@ proc new_browser {commit} {
 	pack $w.path -anchor w -side top -fill x
 
 	frame $w.list
+	set w_list $w.list.l
 	text $w_list -background white -borderwidth 0 \
 		-cursor $cursor_ptr \
 		-state disabled \
@@ -49,176 +48,149 @@ proc new_browser {commit} {
 	pack $w_list -side left -fill both -expand 1
 	pack $w.list -side top -fill both -expand 1
 
-	label $w.status -textvariable browser_status($w_list) \
+	label $w.status \
+		-textvariable @browser_status \
 		-anchor w \
 		-justify left \
 		-borderwidth 1 \
 		-relief sunken
 	pack $w.status -anchor w -side bottom -fill x
 
-	bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
+	bind $w_list <Button-1>        "[cb _click 0 @%x,%y];break"
-	bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
+	bind $w_list <Double-Button-1> "[cb _click 1 @%x,%y];break"
-	bind $w_list <$M1B-Up>         "browser_parent $w_list;break"
+	bind $w_list <$M1B-Up>         "[cb _parent]        ;break"
-	bind $w_list <$M1B-Left>       "browser_parent $w_list;break"
+	bind $w_list <$M1B-Left>       "[cb _parent]        ;break"
-	bind $w_list <Up>              "browser_move -1 $w_list;break"
+	bind $w_list <Up>              "[cb _move -1]       ;break"
-	bind $w_list <Down>            "browser_move 1 $w_list;break"
+	bind $w_list <Down>            "[cb _move  1]       ;break"
-	bind $w_list <$M1B-Right>      "browser_enter $w_list;break"
+	bind $w_list <$M1B-Right>      "[cb _enter]         ;break"
-	bind $w_list <Return>          "browser_enter $w_list;break"
+	bind $w_list <Return>          "[cb _enter]         ;break"
-	bind $w_list <Prior>           "browser_page -1 $w_list;break"
+	bind $w_list <Prior>           "[cb _page -1]       ;break"
-	bind $w_list <Next>            "browser_page 1 $w_list;break"
+	bind $w_list <Next>            "[cb _page  1]       ;break"
 	bind $w_list <Left>            break
 	bind $w_list <Right>           break
 
-	bind $tl <Visibility> "focus $w"
+	bind $w_list <Visibility> [list focus $w_list]
-	bind $tl <Destroy> "
+	bind $w_list <Destroy> [list delete_this $this]
-		array unset browser_buffer $w_list
+	set w $w_list
-		array unset browser_files $w_list
+	_ls $this $browser_commit
-		array unset browser_status $w_list
+	return $this
-		array unset browser_stack $w_list
-		array unset browser_path $w_list
-		array unset browser_commit $w_list
-		array unset browser_busy $w_list
-	"
-	wm title $tl "[appname] ([reponame]): File Browser"
-	ls_tree $w_list $browser_commit($w_list) {}
 }
 
-proc browser_move {dir w} {
+method _move {dir} {
-	global browser_files browser_busy
+	if {$browser_busy} return
-
-	if {$browser_busy($w)} return
 	set lno [lindex [split [$w index in_sel.first] .] 0]
 	incr lno $dir
-	if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
+	if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 		$w tag remove in_sel 0.0 end
 		$w tag add in_sel $lno.0 [expr {$lno + 1}].0
 		$w see $lno.0
 	}
 }
 
-proc browser_page {dir w} {
+method _page {dir} {
-	global browser_files browser_busy
+	if {$browser_busy} return
-
-	if {$browser_busy($w)} return
 	$w yview scroll $dir pages
 	set lno [expr {int(
 		  [lindex [$w yview] 0]
-		* [llength $browser_files($w)]
+		* [llength $browser_files]
 		+ 1)}]
-	if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
+	if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 		$w tag remove in_sel 0.0 end
 		$w tag add in_sel $lno.0 [expr {$lno + 1}].0
 		$w see $lno.0
 	}
 }
 
-proc browser_parent {w} {
+method _parent {} {
-	global browser_files browser_status browser_path
+	if {$browser_busy} return
-	global browser_stack browser_busy
+	set info [lindex $browser_files 0]
-
-	if {$browser_busy($w)} return
-	set info [lindex $browser_files($w) 0]
 	if {[lindex $info 0] eq {parent}} {
-		set parent [lindex $browser_stack($w) end-1]
+		set parent [lindex $browser_stack end-1]
-		set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
+		set browser_stack [lrange $browser_stack 0 end-2]
-		if {$browser_stack($w) eq {}} {
+		if {$browser_stack eq {}} {
-			regsub {:.*$} $browser_path($w) {:} browser_path($w)
+			regsub {:.*$} $browser_path {:} browser_path
 		} else {
-			regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
+			regsub {/[^/]+$} $browser_path {} browser_path
 		}
-		set browser_status($w) "Loading $browser_path($w)..."
+		set browser_status "Loading $browser_path..."
-		ls_tree $w [lindex $parent 0] [lindex $parent 1]
+		_ls $this [lindex $parent 0] [lindex $parent 1]
 	}
 }
 
-proc browser_enter {w} {
+method _enter {} {
-	global browser_files browser_status browser_path
+	if {$browser_busy} return
-	global browser_commit browser_stack browser_busy
-
-	if {$browser_busy($w)} return
 	set lno [lindex [split [$w index in_sel.first] .] 0]
-	set info [lindex $browser_files($w) [expr {$lno - 1}]]
+	set info [lindex $browser_files [expr {$lno - 1}]]
 	if {$info ne {}} {
 		switch -- [lindex $info 0] {
 		parent {
-			browser_parent $w
+			_parent $this
 		}
 		tree {
 			set name [lindex $info 2]
 			set escn [escape_path $name]
-			set browser_status($w) "Loading $escn..."
+			set browser_status "Loading $escn..."
-			append browser_path($w) $escn
+			append browser_path $escn
-			ls_tree $w [lindex $info 1] $name
+			_ls $this [lindex $info 1] $name
 		}
 		blob {
 			set name [lindex $info 2]
 			set p {}
-			foreach n $browser_stack($w) {
+			foreach n $browser_stack {
 				append p [lindex $n 1]
 			}
 			append p $name
-			show_blame $browser_commit($w) $p
+			blame::new $browser_commit $p
 		}
 		}
 	}
 }
 
-proc browser_click {was_double_click w pos} {
+method _click {was_double_click pos} {
-	global browser_files browser_busy
+	if {$browser_busy} return
-
-	if {$browser_busy($w)} return
 	set lno [lindex [split [$w index $pos] .] 0]
 	focus $w
 
-	if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
+	if {[lindex $browser_files [expr {$lno - 1}]] ne {}} {
 		$w tag remove in_sel 0.0 end
 		$w tag add in_sel $lno.0 [expr {$lno + 1}].0
 		if {$was_double_click} {
-			browser_enter $w
+			_enter $this
 		}
 	}
 }
 
-proc ls_tree {w tree_id name} {
+method _ls {tree_id {name {}}} {
-	global browser_buffer browser_files browser_stack browser_busy
+	set browser_buffer {}
-
+	set browser_files {}
-	set browser_buffer($w) {}
+	set browser_busy 1
-	set browser_files($w) {}
-	set browser_busy($w) 1
 
 	$w conf -state normal
 	$w tag remove in_sel 0.0 end
 	$w delete 0.0 end
-	if {$browser_stack($w) ne {}} {
+	if {$browser_stack ne {}} {
 		$w image create end \
 			-align center -padx 5 -pady 1 \
 			-name icon0 \
 			-image file_uplevel
 		$w insert end {[Up To Parent]}
-		lappend browser_files($w) parent
+		lappend browser_files parent
 	}
-	lappend browser_stack($w) [list $tree_id $name]
+	lappend browser_stack [list $tree_id $name]
 	$w conf -state disabled
 
 	set cmd [list git ls-tree -z $tree_id]
 	set fd [open "| $cmd" r]
 	fconfigure $fd -blocking 0 -translation binary -encoding binary
-	fileevent $fd readable [list read_ls_tree $fd $w]
+	fileevent $fd readable [cb _read $fd]
 }
 
-proc read_ls_tree {fd w} {
+method _read {fd} {
-	global browser_buffer browser_files browser_status browser_busy
+	append browser_buffer [read $fd]
+	set pck [split $browser_buffer "\0"]
+	set browser_buffer [lindex $pck end]
 
-	if {![winfo exists $w]} {
+	set n [llength $browser_files]
-		catch {close $fd}
-		return
-	}
-
-	append browser_buffer($w) [read $fd]
-	set pck [split $browser_buffer($w) "\0"]
-	set browser_buffer($w) [lindex $pck end]
-
-	set n [llength $browser_files($w)]
 	$w conf -state normal
 	foreach p [lrange $pck 0 end-1] {
 		set info [split $p "\t"]
@@ -246,18 +218,22 @@ proc read_ls_tree {fd w} {
 			-name icon[incr n] \
 			-image $image
 		$w insert end [escape_path $path]
-		lappend browser_files($w) [list $type $object $path]
+		lappend browser_files [list $type $object $path]
 	}
 	$w conf -state disabled
 
 	if {[eof $fd]} {
 		close $fd
-		set browser_status($w) Ready.
+		set browser_status Ready.
-		set browser_busy($w) 0
+		set browser_busy 0
-		array unset browser_buffer $w
+		unset browser_buffer
 		if {$n > 0} {
 			$w tag add in_sel 1.0 2.0
 			focus -force $w
 		}
 	}
+} ifdeleted {
+	catch {close $fd}
+}
+
 }

lib/class.tcl

@@ -0,0 +1,154 @@
+# git-gui simple class/object fake-alike
+# Copyright (C) 2007 Shawn Pearce
+
+proc class {class body} {
+	if {[namespace exists $class]} {
+		error "class $class already declared"
+	}
+	namespace eval $class {
+		variable __nextid     0
+		variable __sealed     0
+		variable __field_list {}
+		variable __field_array
+
+		proc cb {name args} {
+			upvar this this
+			set args [linsert $args 0 $name $this]
+			return [uplevel [list namespace code $args]]
+		}
+	}
+	namespace eval $class $body
+}
+
+proc field {name args} {
+	set class [uplevel {namespace current}]
+	variable ${class}::__sealed
+	variable ${class}::__field_array
+
+	switch [llength $args] {
+	0 { set new [list $name] }
+	1 { set new [list $name [lindex $args 0]] }
+	default { error "wrong # args: field name value?" }
+	}
+
+	if {$__sealed} {
+		error "class $class is sealed (cannot add new fields)"
+	}
+
+	if {[catch {set old $__field_array($name)}]} {
+		variable ${class}::__field_list
+		lappend __field_list $new
+		set __field_array($name) 1
+	} else {
+		error "field $name already declared"
+	}
+}
+
+proc constructor {name params body} {
+	set class [uplevel {namespace current}]
+	set ${class}::__sealed 1
+	variable ${class}::__field_list
+	set mbodyc {}
+
+	append mbodyc {set this } $class
+	append mbodyc {::__o[incr } $class {::__nextid]} \;
+	append mbodyc {namespace eval $this {}} \;
+
+	if {$__field_list ne {}} {
+		append mbodyc {upvar #0}
+		foreach n $__field_list {
+			set n [lindex $n 0]
+			append mbodyc { ${this}::} $n { } $n
+			regsub -all @$n\\M $body "\${this}::$n" body
+		}
+		append mbodyc \;
+		foreach n $__field_list {
+			if {[llength $n] == 2} {
+				append mbodyc \
+				{set } [lindex $n 0] { } [list [lindex $n 1]] \;
+			}
+		}
+	}
+	append mbodyc $body
+	namespace eval $class [list proc $name $params $mbodyc]
+}
+
+proc method {name params body {deleted {}} {del_body {}}} {
+	set class [uplevel {namespace current}]
+	set ${class}::__sealed 1
+	variable ${class}::__field_list
+	set params [linsert $params 0 this]
+	set mbodyc {}
+
+	switch $deleted {
+	{} {}
+	ifdeleted {
+		append mbodyc {if {![namespace exists $this]} }
+		append mbodyc \{ $del_body \; return \} \;
+	}
+	default {
+		error "wrong # args: method name args body (ifdeleted body)?"
+	}
+	}
+
+	set decl {}
+	foreach n $__field_list {
+		set n [lindex $n 0]
+		if {[regexp -- $n\\M $body]} {
+			if {   [regexp -all -- $n\\M $body] == 1
+				&& [regexp -all -- \\\$$n\\M $body] == 1
+				&& [regexp -all -- \\\$$n\\( $body] == 0} {
+				regsub -all \\\$$n\\M $body "\[set \${this}::$n\]" body
+			} else {
+				append decl { ${this}::} $n { } $n
+				regsub -all @$n\\M $body "\${this}::$n" body
+			}
+		}
+	}
+	if {$decl ne {}} {
+		append mbodyc {upvar #0} $decl \;
+	}
+	append mbodyc $body
+	namespace eval $class [list proc $name $params $mbodyc]
+}
+
+proc delete_this {{t {}}} {
+	if {$t eq {}} {
+		upvar this this
+		set t $this
+	}
+	if {[namespace exists $t]} {namespace delete $t}
+}
+
+proc make_toplevel {t w} {
+	upvar $t top $w pfx
+	if {[winfo ismapped .]} {
+		upvar this this
+		regsub -all {::} $this {__} w
+		set top .$w
+		set pfx $top
+		toplevel $top
+	} else {
+		set top .
+		set pfx {}
+	}
+}
+
+
+## auto_mkindex support for class/constructor/method
+##
+auto_mkindex_parser::command class {name body} {
+	variable parser
+	variable contextStack
+	set contextStack [linsert $contextStack 0 $name]
+	$parser eval [list _%@namespace eval $name] $body
+	set contextStack [lrange $contextStack 1 end]
+}
+auto_mkindex_parser::command constructor {name args} {
+	variable index
+	variable scriptFile
+	append index [list set auto_index([fullname $name])] \
+		[format { [list source [file join $dir %s]]} \
+		[file split $scriptFile]] "\n"
+}
+

lib/console.tcl

@@ -1,30 +1,29 @@
 # git-gui console support
 # Copyright (C) 2006, 2007 Shawn Pearce
 
-namespace eval console {
+class console {
 
-variable next_console_id 0
+field t_short
-variable console_data
+field t_long
-variable console_cr
+field w
+field console_cr
 
-proc new {short_title long_title} {
+constructor new {short_title long_title} {
-	variable next_console_id
+	set t_short $short_title
-	variable console_data
+	set t_long $long_title
-
+	_init $this
-	set w .console[incr next_console_id]
+	return $this
-	set console_data($w) [list $short_title $long_title]
-	return [_init $w]
 }
 
-proc _init {w} {
+method _init {} {
 	global M1B
-	variable console_cr
+	make_toplevel top w
-	variable console_data
+	wm title $top "[appname] ([reponame]): $t_short"
+	set console_cr 1.0
 
-	set console_cr($w) 1.0
-	toplevel $w
 	frame $w.m
-	label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
+	label $w.m.l1 \
+		-textvariable @t_long  \
 		-anchor w \
 		-justify left \
 		-font font_uibold
@@ -67,11 +66,9 @@ proc _init {w} {
 	bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
 	bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
 	bind $w <Visibility> "focus $w"
-	wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
-	return $w
 }
 
-proc exec {w cmd {after {}}} {
+method exec {cmd {after {}}} {
 	# -- Cygwin's Tcl tosses the enviroment when we exec our child.
 	#    But most users need that so we have to relogin. :-(
 	#
@@ -86,16 +83,13 @@ proc exec {w cmd {after {}}} {
 
 	set fd_f [open $cmd r]
 	fconfigure $fd_f -blocking 0 -translation binary
-	fileevent $fd_f readable \
+	fileevent $fd_f readable [cb _read $fd_f $after]
-		[namespace code [list _read $w $fd_f $after]]
 }
 
-proc _read {w fd after} {
+method _read {fd after} {
-	variable console_cr
-
 	set buf [read $fd]
 	if {$buf ne {}} {
-		if {![winfo exists $w]} {_init $w}
+		if {![winfo exists $w.m.t]} {_init $this}
 		$w.m.t conf -state normal
 		set c 0
 		set n [string length $buf]
@@ -107,11 +101,11 @@ proc _read {w fd after} {
 
 			if {$lf < $cr} {
 				$w.m.t insert end [string range $buf $c $lf]
-				set console_cr($w) [$w.m.t index {end -1c}]
+				set console_cr [$w.m.t index {end -1c}]
 				set c $lf
 				incr c
 			} else {
-				$w.m.t delete $console_cr($w) end
+				$w.m.t delete $console_cr end
 				$w.m.t insert end "\n"
 				$w.m.t insert end [string range $buf $c $cr]
 				set c $cr
@@ -130,19 +124,19 @@ proc _read {w fd after} {
 			set ok 1
 		}
 		if {$after ne {}} {
-			uplevel #0 $after $w $ok
+			uplevel #0 $after $ok
 		} else {
-			done $w $ok
+			done $this $ok
 		}
 		return
 	}
 	fconfigure $fd -blocking 0
 }
 
-proc chain {cmdlist w {ok 1}} {
+method chain {cmdlist {ok 1}} {
 	if {$ok} {
 		if {[llength $cmdlist] == 0} {
-			done $w $ok
+			done $this $ok
 			return
 		}
 
@@ -150,52 +144,33 @@ proc chain {cmdlist w {ok 1}} {
 		set cmdlist [lrange $cmdlist 1 end]
 
 		if {[lindex $cmd 0] eq {exec}} {
-			exec $w \
+			exec $this \
-				[lindex $cmd 1] \
+				[lrange $cmd 1 end] \
-				[namespace code [list chain $cmdlist]]
+				[cb chain $cmdlist]
 		} else {
-			uplevel #0 $cmd $cmdlist $w $ok
+			uplevel #0 $cmd [cb chain $cmdlist]
 		}
 	} else {
-		done $w $ok
+		done $this $ok
 	}
 }
 
-proc done {args} {
+method done {ok} {
-	variable console_cr
-	variable console_data
-
-	switch -- [llength $args] {
-	2 {
-		set w [lindex $args 0]
-		set ok [lindex $args 1]
-	}
-	3 {
-		set w [lindex $args 1]
-		set ok [lindex $args 2]
-	}
-	default {
-		error "wrong number of args: done ?ignored? w ok"
-	}
-	}
-
 	if {$ok} {
-		if {[winfo exists $w]} {
+		if {[winfo exists $w.m.s]} {
 			$w.m.s conf -background green -text {Success}
 			$w.ok conf -state normal
 			focus $w.ok
 		}
 	} else {
-		if {![winfo exists $w]} {
+		if {![winfo exists $w.m.s]} {
-			_init $w
+			_init $this
 		}
 		$w.m.s conf -background red -text {Error: Command Failed}
 		$w.ok conf -state normal
 		focus $w.ok
 	}
-
+	delete_this
-	array unset console_cr $w
-	array unset console_data $w
 }
 
 }

lib/database.tcl

@@ -70,12 +70,12 @@ proc do_stats {} {
 
 proc do_gc {} {
 	set w [console::new {gc} {Compressing the object database}]
-	console::chain {
+	console::chain $w {
-		{exec {git pack-refs --prune}}
+		{exec git pack-refs --prune}
-		{exec {git reflog expire --all}}
+		{exec git reflog expire --all}
-		{exec {git repack -a -d -l}}
+		{exec git repack -a -d -l}
-		{exec {git rerere gc}}
+		{exec git rerere gc}
-	} $w
+	}
 }
 
 proc do_fsck_objects {} {

lib/diff.tcl

@@ -145,7 +145,7 @@ proc show_diff {path w {lno {}}} {
 
 	lappend cmd -p
 	lappend cmd --no-color
-	if {$repo_config(gui.diffcontext) > 0} {
+	if {$repo_config(gui.diffcontext) >= 0} {
 		lappend cmd "-U$repo_config(gui.diffcontext)"
 	}
 	if {$w eq $ui_index} {

lib/merge.tcl

@@ -123,7 +123,8 @@ Please select fewer branches.  To merge more than 15 branches, merge the branche
 	set msg "Merging $current_branch, [join $names {, }]"
 	set ui_status_value "$msg..."
 	set cons [console::new "Merge" $msg]
-	console::exec $cons $cmd [namespace code [list _finish $revcnt]]
+	console::exec $cons $cmd \
+		[namespace code [list _finish $revcnt $cons]]
 	bind $w <Destroy> {}
 	destroy $w
 }
@@ -238,6 +239,8 @@ proc dialog {} {
 			$subj([lindex $ref 0])]
 	}
 
+	bind $w.source.l <Key-K> [list event generate %W <Shift-Key-Up>]
+	bind $w.source.l <Key-J> [list event generate %W <Shift-Key-Down>]
 	bind $w.source.l <Key-k> [list event generate %W <Key-Up>]
 	bind $w.source.l <Key-j> [list event generate %W <Key-Down>]
 	bind $w.source.l <Key-h> [list event generate %W <Key-Left>]

lib/option.tcl

@@ -15,6 +15,9 @@ proc save_config {} {
 		font configure ${font}bold \
 			-family $global_config_new(gui.$font^^family) \
 			-size $global_config_new(gui.$font^^size)
+		font configure ${font}italic \
+			-family $global_config_new(gui.$font^^family) \
+			-size $global_config_new(gui.$font^^size)
 		set global_config_new(gui.$name) [font configure $font]
 		unset global_config_new(gui.$font^^family)
 		unset global_config_new(gui.$font^^size)
@@ -173,7 +176,7 @@ proc do_options {} {
 		{i-1..5 merge.verbosity {Merge Verbosity}}
 
 		{b gui.trustmtime  {Trust File Modification Timestamps}}
-		{i-1..99 gui.diffcontext {Number of Diff Context Lines}}
+		{i-0..99 gui.diffcontext {Number of Diff Context Lines}}
 		{t gui.newbranchtemplate {New Branch Name Template}}
 		} {
 		set type [lindex $option 0]