git gui 0.7.0

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

@@ -64,7 +64,10 @@ $(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)echo \
+	  source lib/class.tcl \; \
+	  auto_mkindex lib '*.tcl' \
+	| $(TCL_PATH)
 
 # These can record GITGUI_VERSION
 $(patsubst %.sh,%,$(SCRIPT_SH)): GIT-VERSION-FILE GIT-GUI-VARS

git-gui.sh

@@ -261,8 +261,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
@@ -1288,7 +1294,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
 
@@ -1572,25 +1578,67 @@ 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
 	}
+	1 {
 		set current_branch [lindex $argv 0]
-	new_browser $current_branch
+	}
+	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 current_branch [lindex $argv 0]
+			set is_path 1
-	show_blame $current_branch [lindex $argv 1]
+		} elseif {$head eq {}} {
+			if {$head ne {}} usage
+			set head $a
+		} else {
+			usage
+		}
+	}
+	unset is_path
+
+	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,7 +1686,7 @@ 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
 text $ui_index -background white -borderwidth 0 \
 	-width 20 -height 10 \
@@ -1658,7 +1706,7 @@ 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
 text $ui_workdir -background white -borderwidth 0 \
 	-width 20 -height 10 \

lib/blame.tcl

@@ -1,18 +1,42 @@
 # git-gui blame viewer
 # Copyright (C) 2006, 2007 Shawn Pearce
 
-proc show_blame {commit path} {
+class blame {
-	global next_browser_id blame_status blame_data
 
-	if {[winfo ismapped .]} {
+field commit  ; # input commit to blame
-		set w .browser[incr next_browser_id]
+field path    ; # input filename to view in $commit
-		set tl $w
+
-		toplevel $w
+field w
-	} else {
+field w_line
-		set w {}
+field w_load
-		set tl .
+field w_file
-	}
+field w_cmit
-	set blame_status($w) {Loading current file content...}
+field status
+
+field highlight_line   -1 ; # current line selected
+field highlight_commit {} ; # sha1 of commit selected
+
+field total_lines       0  ; # total length of file
+field blame_lines       0  ; # number of lines computed
+field commit_count      0  ; # number of commits in $commit_list
+field commit_list      {}  ; # list of commit sha1 in receipt order
+field order                ; # array commit -> receipt order
+field header               ; # array commit,key -> header field
+field line_commit          ; # array line -> sha1 commit
+field line_file            ; # array line -> file name
+
+field r_commit      ; # commit currently being parsed
+field r_orig_line   ; # original line number
+field r_final_line  ; # final line number
+field r_line_count  ; # lines in this region
+
+constructor new {i_commit i_path} {
+	set commit $i_commit
+	set path   $i_path
+
+	make_toplevel top w
+	wm title $top "[appname] ([reponame]): File Viewer"
+	set status "Loading $commit:$path..."
 
 	label $w.path -text "$commit:$path" \
 		-anchor w \
@@ -68,7 +92,8 @@ proc show_blame {commit path} {
 	grid rowconfigure $w.out 0 -weight 1
 	pack $w.out -fill both -expand 1
 
-	label $w.status -textvariable blame_status($w) \
+	label $w.status \
+		-textvariable @status \
 		-anchor w \
 		-justify left \
 		-borderwidth 1 \
@@ -93,8 +118,14 @@ proc show_blame {commit path} {
 	pack $w.cm -side bottom -fill x
 
 	menu $w.ctxm -tearoff 0
-	$w.ctxm add command -label "Copy Commit" \
+	$w.ctxm add command \
-		-command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
+		-label "Copy Commit" \
+		-command [cb _copycommit]
+
+	set w_line $w.out.linenumber_t
+	set w_load $w.out.loaded_t
+	set w_file $w.out.file_t
+	set w_cmit $w.cm.t
 
 	foreach i [list \
 		$w.out.loaded_t \
@@ -109,14 +140,7 @@ proc show_blame {commit path} {
 			$w.out.linenumber_t \
 			$w.out.file_t \
 			] yview $w.out.sby]
-		bind $i <Button-1> "
+		bind $i <Button-1> "[cb _click $i @%x,%y]; focus $i"
-			blame_click {$w} \\
-				$w.cm.t \\
-				$w.out.linenumber_t \\
-				$w.out.file_t \\
-				$i @%x,%y
-			focus $i
-		"
 		bind_button3 $i "
 			set cursorX %x
 			set cursorY %y
@@ -142,184 +166,161 @@ proc show_blame {commit path} {
 		bind $i <Control-Key-f> {catch {%W yview scroll  1 pages};break}
 	}
 
-	bind $w.cm.t <Button-1> "focus $w.cm.t"
+	bind $w.cm.t <Button-1> [list focus $w.cm.t]
-	bind $tl <Visibility> "focus $tl"
+	bind $top <Visibility> [list focus $top]
-	bind $tl <Destroy> "
+	bind $top <Destroy> [list delete_this $this]
-		array unset blame_status {$w}
-		array unset blame_data $w,*
-	"
-	wm title $tl "[appname] ([reponame]): File Viewer"
-
-	set blame_data($w,commit_count) 0
-	set blame_data($w,commit_list) {}
-	set blame_data($w,total_lines) 0
-	set blame_data($w,blame_lines) 0
-	set blame_data($w,highlight_commit) {}
-	set blame_data($w,highlight_line) -1
 
+	if {$commit eq {}} {
+		set fd [open $path r]
+	} else {
 		set cmd [list git cat-file blob "$commit:$path"]
 		set fd [open "| $cmd" r]
+	}
 	fconfigure $fd -blocking 0 -translation lf -encoding binary
-	fileevent $fd readable [list read_blame_catfile \
+	fileevent $fd readable [cb _read_file $fd]
-		$fd $w $commit $path \
-		$w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
 }
 
-proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
+method _read_file {fd} {
-	global blame_status blame_data
-
-	if {![winfo exists $w_file]} {
-		catch {close $fd}
-		return
-	}
-
-	set n $blame_data($w,total_lines)
 	$w_load conf -state normal
 	$w_line conf -state normal
 	$w_file conf -state normal
 	while {[gets $fd line] >= 0} {
 		regsub "\r\$" $line {} line
-		incr n
+		incr total_lines
 		$w_load insert end "\n"
-		$w_line insert end "$n\n" linenumber
+		$w_line insert end "$total_lines\n" linenumber
 		$w_file insert end "$line\n"
 	}
 	$w_load conf -state disabled
 	$w_line conf -state disabled
 	$w_file conf -state disabled
-	set blame_data($w,total_lines) $n
 
 	if {[eof $fd]} {
 		close $fd
-		blame_incremental_status $w
+		_status $this
 		set cmd [list git blame -M -C --incremental]
-		lappend cmd $commit -- $path
+		if {$commit eq {}} {
+			lappend cmd --contents $path
+		} else {
+			lappend cmd $commit
+		}
+		lappend cmd -- $path
 		set fd [open "| $cmd" r]
 		fconfigure $fd -blocking 0 -translation lf -encoding binary
-		fileevent $fd readable [list read_blame_incremental $fd $w \
+		fileevent $fd readable [cb _read_blame $fd]
-			$w_load $w_cmit $w_line $w_file]
-	}
-}
-
-proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
-	global blame_status blame_data
-
-	if {![winfo exists $w_file]} {
-		catch {close $fd}
-		return
 	}
+} ifdeleted { catch {close $fd} }
 
+method _read_blame {fd} {
 	while {[gets $fd line] >= 0} {
 		if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
 			cmit original_line final_line line_count]} {
-			set blame_data($w,commit) $cmit
+			set r_commit     $cmit
-			set blame_data($w,original_line) $original_line
+			set r_orig_line  $original_line
-			set blame_data($w,final_line) $final_line
+			set r_final_line $final_line
-			set blame_data($w,line_count) $line_count
+			set r_line_count $line_count
 
-			if {[catch {set g $blame_data($w,$cmit,order)}]} {
+			if {[catch {set g $order($cmit)}]} {
 				$w_line tag conf g$cmit
 				$w_file tag conf g$cmit
 				$w_line tag raise in_sel
 				$w_file tag raise in_sel
 				$w_file tag raise sel
-				set blame_data($w,$cmit,order) $blame_data($w,commit_count)
+				set order($cmit) $commit_count
-				incr blame_data($w,commit_count)
+				incr commit_count
-				lappend blame_data($w,commit_list) $cmit
+				lappend commit_list $cmit
 			}
 		} elseif {[string match {filename *} $line]} {
 			set file [string range $line 9 end]
-			set n $blame_data($w,line_count)
+			set n    $r_line_count
-			set lno $blame_data($w,final_line)
+			set lno  $r_final_line
-			set cmit $blame_data($w,commit)
+			set cmit $r_commit
 
 			while {$n > 0} {
-				if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
+				set lno_e "$lno.0 lineend + 1c"
-					$w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
+				if {[catch {set g g$line_commit($lno)}]} {
+					$w_load tag add annotated $lno.0 $lno_e
 				} else {
-					$w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
+					$w_line tag remove g$g $lno.0 $lno_e
-					$w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
+					$w_file tag remove g$g $lno.0 $lno_e
 				}
 
-				set blame_data($w,line$lno,commit) $cmit
+				set line_commit($lno) $cmit
-				set blame_data($w,line$lno,file) $file
+				set line_file($lno)   $file
-				$w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
+				$w_line tag add g$cmit $lno.0 $lno_e
-				$w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
+				$w_file tag add g$cmit $lno.0 $lno_e
 
-				if {$blame_data($w,highlight_line) == -1} {
+				if {$highlight_line == -1} {
 					if {[lindex [$w_file yview] 0] == 0} {
 						$w_file see $lno.0
-						blame_showcommit $w $w_cmit $w_line $w_file $lno
+						_showcommit $this $lno
 					}
-				} elseif {$blame_data($w,highlight_line) == $lno} {
+				} elseif {$highlight_line == $lno} {
-					blame_showcommit $w $w_cmit $w_line $w_file $lno
+					_showcommit $this $lno
 				}
 
 				incr n -1
 				incr lno
-				incr blame_data($w,blame_lines)
+				incr blame_lines
 			}
 
-			set hc $blame_data($w,highlight_commit)
+			set hc $highlight_commit
 			if {$hc ne {}
-				&& [expr {$blame_data($w,$hc,order) + 1}]
+				&& [expr {$order($hc) + 1}] == $order($cmit)} {
-					== $blame_data($w,$cmit,order)} {
+				_showcommit $this $highlight_line
-				blame_showcommit $w $w_cmit $w_line $w_file \
-					$blame_data($w,highlight_line)
 			}
-		} elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
+		} elseif {[regexp {^([a-z-]+) (.*)$} $line line key data]} {
-			set blame_data($w,$blame_data($w,commit),$header) $data
+			set header($r_commit,$key) $data
 		}
 	}
 
 	if {[eof $fd]} {
 		close $fd
-		set blame_status($w) {Annotation complete.}
+		set status {Annotation complete.}
 	} else {
-		blame_incremental_status $w
+		_status $this
-	}
 	}
+} ifdeleted { catch {close $fd} }
 
-proc blame_incremental_status {w} {
+method _status {} {
-	global blame_status blame_data
+	set have  $blame_lines
-
+	set total $total_lines
-	set have  $blame_data($w,blame_lines)
-	set total $blame_data($w,total_lines)
 	set pdone 0
 	if {$total} {set pdone [expr {100 * $have / $total}]}
 
-	set blame_status($w) [format \
+	set status [format \
 		"Loading annotations... %i of %i lines annotated (%2i%%)" \
 		$have $total $pdone]
 }
 
-proc blame_click {w w_cmit w_line w_file cur_w pos} {
+method _click {cur_w pos} {
 	set lno [lindex [split [$cur_w index $pos] .] 0]
 	if {$lno eq {}} return
 
+	set lno_e "$lno.0 + 1 line"
 	$w_line tag remove in_sel 0.0 end
 	$w_file tag remove in_sel 0.0 end
-	$w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
+	$w_line tag add in_sel $lno.0 $lno_e
-	$w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
+	$w_file tag add in_sel $lno.0 $lno_e
 
-	blame_showcommit $w $w_cmit $w_line $w_file $lno
+	_showcommit $this $lno
 }
 
-set blame_colors {
+variable blame_colors {
 	#ff4040
 	#ff40ff
 	#4040ff
 }
 
-proc blame_showcommit {w w_cmit w_line w_file lno} {
+method _showcommit {lno} {
-	global blame_colors blame_data repo_config
+	global repo_config
+	variable blame_colors
 
-	set cmit $blame_data($w,highlight_commit)
+	if {$highlight_commit ne {}} {
-	if {$cmit ne {}} {
+		set idx $order($highlight_commit)
-		set idx $blame_data($w,$cmit,order)
 		set i 0
 		foreach c $blame_colors {
-			set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
+			set h [lindex $commit_list [expr {$idx - 1 + $i}]]
 			$w_line tag conf g$h -background white
 			$w_file tag conf g$h -background white
 			incr i
@@ -328,14 +329,14 @@ proc blame_showcommit {w w_cmit w_line w_file lno} {
 
 	$w_cmit conf -state normal
 	$w_cmit delete 0.0 end
-	if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
+	if {[catch {set cmit $line_commit($lno)}]} {
 		set cmit {}
 		$w_cmit insert end "Loading annotation..."
 	} else {
-		set idx $blame_data($w,$cmit,order)
+		set idx $order($cmit)
 		set i 0
 		foreach c $blame_colors {
-			set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
+			set h [lindex $commit_list [expr {$idx - 1 + $i}]]
 			$w_line tag conf g$h -background $c
 			$w_file tag conf g$h -background $c
 			incr i
@@ -344,18 +345,24 @@ proc blame_showcommit {w w_cmit w_line w_file lno} {
 		set author_name {}
 		set author_email {}
 		set author_time {}
-		catch {set author_name $blame_data($w,$cmit,author)}
+		catch {set author_name $header($cmit,author)}
-		catch {set author_email $blame_data($w,$cmit,author-mail)}
+		catch {set author_email $header($cmit,author-mail)}
-		catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
+		catch {set author_time [clock format \
+			$header($cmit,author-time) \
+			-format {%Y-%m-%d %H:%M:%S}
+		]}
 
 		set committer_name {}
 		set committer_email {}
 		set committer_time {}
-		catch {set committer_name $blame_data($w,$cmit,committer)}
+		catch {set committer_name $header($cmit,committer)}
-		catch {set committer_email $blame_data($w,$cmit,committer-mail)}
+		catch {set committer_email $header($cmit,committer-mail)}
-		catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
+		catch {set committer_time [clock format \
+			$header($cmit,committer-time) \
+			-format {%Y-%m-%d %H:%M:%S}
+		]}
 
-		if {[catch {set msg $blame_data($w,$cmit,message)}]} {
+		if {[catch {set msg $header($cmit,message)}]} {
 			set msg {}
 			catch {
 				set fd [open "| git cat-file commit $cmit" r]
@@ -375,29 +382,29 @@ proc blame_showcommit {w w_cmit w_line w_file lno} {
 				set author_name [encoding convertfrom $enc $author_name]
 				set committer_name [encoding convertfrom $enc $committer_name]
 
-				set blame_data($w,$cmit,author) $author_name
+				set header($cmit,author) $author_name
-				set blame_data($w,$cmit,committer) $committer_name
+				set header($cmit,committer) $committer_name
 			}
-			set blame_data($w,$cmit,message) $msg
+			set header($cmit,message) $msg
 		}
 
-		$w_cmit insert end "commit $cmit\n"
+		$w_cmit insert end "commit $cmit
-		$w_cmit insert end "Author: $author_name $author_email $author_time\n"
+Author: $author_name $author_email  $author_time
-		$w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
+Committer: $committer_name $committer_email  $committer_time
-		$w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
+Original File: [escape_path $line_file($lno)]
-		$w_cmit insert end "\n"
+
-		$w_cmit insert end $msg
+$msg"
 	}
 	$w_cmit conf -state disabled
 
-	set blame_data($w,highlight_line) $lno
+	set highlight_line $lno
-	set blame_data($w,highlight_commit) $cmit
+	set highlight_commit $cmit
 }
 
-proc blame_copycommit {w i pos} {
+method _copycommit {} {
-	global blame_data
+	set pos @$::cursorX,$::cursorY
-	set lno [lindex [split [$i index $pos] .] 0]
+	set lno [lindex [split [$::cursorW index $pos] .] 0]
-	if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
+	if {![catch {set commit $line_commit($lno)}]} {
 		clipboard clear
 		clipboard append \
 			-format STRING \
@@ -405,3 +412,5 @@ proc blame_copycommit {w i pos} {
 			-- $commit
 	}
 }
+
+}

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} {
-	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"
 	}
 }
 
+method done {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/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>]