[PATCH] fast gitk.hg

[Chris Mason]

Hello again,

This turned out much easier than I expected, here's a diff on top of gitk1.1 
to make it support my hg rev-list -c extension.  You can find gitk1.1 here:

http://ozlabs.org/~paulus/gitk/gitk-1.1.tar.gz

After you unpack, cp gitk gitk.hg and apply this patch.  If people try 
this out and find that it generally works, I'll try to convince Paul to take 
patches for hg support.

--- a/gitk.hg	2005-06-03 15:17:33.993667784 -0400
+++ b/gitk.hg	2005-06-03 15:19:21.866268656 -0400
@@ -9,21 +9,23 @@
 
 # CVS $Revision: 1.20 $
 
-proc getcommits {rargs} {
-    global commits commfd phase canv mainfont
+proc readfullcommits {rargs} {
+    global commits commfd phase canv mainfont curcommit allcommitstate 
     if {$rargs == {}} {
 	set rargs HEAD
     }
     set commits {}
+    set curcommit {}
+    set allcommitstate none
     set phase getcommits
-    if [catch {set commfd [open "|git-rev-list $rargs" r]} err] {
-	puts stderr "Error executing git-rev-list: $err"
+    if [catch {set commfd [open "|hg rev-list -c $rargs" r]} err] {
+	puts stderr "Error executing hg rev-list: $err"
 	exit 1
     }
     fconfigure $commfd -blocking 0
-    fileevent $commfd readable "getcommitline $commfd"
+    fileevent $commfd readable "getallcommitline $commfd"
     $canv delete all
-    $canv create text 3 3 -anchor nw -text "Reading commits..." \
+    $canv create text 3 3 -anchor nw -text "Reading all commits..." \
 	-font $mainfont -tags textitems
 }
 
@@ -40,8 +42,8 @@
 	}
 	if {[string range $err 0 4] == "usage"} {
 	    set err "\
-Gitk: error reading commits: bad arguments to git-rev-list.\n\
-(Note: arguments to gitk are passed to git-rev-list\
+Gitk: error reading commits: bad arguments to hg rev-list.\n\
+(Note: arguments to gitk are passed to hg rev-list\
 to allow selection of commits to be displayed.)"
 	} else {
 	    set err "Error reading commits: $err"
@@ -50,7 +52,7 @@
 	exit 1
     }
     if {![regexp {^[0-9a-f]{40}$} $line]} {
-	error_popup "Can't parse git-rev-tree output: {$line}"
+	error_popup "Can't parse hg rev-tree output: {$line}"
 	exit 1
     }
     lappend commits $line
@@ -65,7 +67,7 @@
     drawgraph
 }
 
-proc readcommit {id} {
+proc readonecommit {id contents} {
     global commitinfo children nchildren parents nparents cdate
     set inhdr 1
     set comment {}
@@ -80,7 +82,6 @@
     }
     set parents($id) {}
     set nparents($id) 0
-    if [catch {set contents [exec git-cat-file commit $id]}] return
     foreach line [split $contents "\n"] {
 	if {$inhdr} {
 	    if {$line == {}} {
@@ -129,6 +130,85 @@
 			     $comname $comdate $comment]
 }
 
+proc getallcommitline {commfd}  {
+    global commits allcommitstate curcommit curcommitid
+    set n [gets $commfd line]
+    set s "\n"
+    if {$n < 0} {
+	if {![eof $commfd]} return
+	# this works around what is apparently a bug in Tcl...
+	fconfigure $commfd -blocking 1
+	if {![catch {close $commfd} err]} {
+	    after idle drawgraph
+	    return
+	}
+	if {[string range $err 0 4] == "usage"} {
+	    set err "\
+Gitk: error reading commits: bad arguments to hg rev-list.\n\
+(Note: arguments to gitk are passed to hg rev-list\
+to allow selection of commits to be displayed.)"
+	} else {
+	    set err "Error reading commits: $err"
+	}
+	error_popup $err
+	exit 1
+    }
+    if {[string range $line 0 1] != "  "} {
+	if {$allcommitstate == "indent"} {
+	    readonecommit $curcommitid $curcommit
+	}
+	if {$allcommitstate == "start"} {
+	    set curcommit $curcommit$line$s
+	    set allcommitstate "indent"
+        } else {
+	    set curcommitid $line
+	    set curcommit {}
+	    set allcommitstate "start"
+	    lappend commits $line
+	}
+    } else {
+	set d [string range $line 2 end] 
+        set curcommit $curcommit$d$s
+    }
+}
+
+proc getcommits {rargs} {
+    global commits commfd phase canv mainfont
+    if {$rargs == {}} {
+	set rargs HEAD
+    }
+    set commits {}
+    set phase getcommits
+    if [catch {set commfd [open "|hg rev-list $rargs" r]} err] {
+	puts stderr "Error executing hg rev-list: $err"
+	exit 1
+    }
+    fconfigure $commfd -blocking 0
+    fileevent $commfd readable "getcommitline $commfd"
+    $canv delete all
+    $canv create text 3 3 -anchor nw -text "Reading commits..." \
+	-font $mainfont -tags textitems
+}
+
+proc readcommit {id} {
+    global commitinfo children nchildren parents nparents cdate
+    set inhdr 1
+    set comment {}
+    set headline {}
+    set auname {}
+    set audate {}
+    set comname {}
+    set comdate {}
+    if {![info exists nchildren($id)]} {
+	set children($id) {}
+	set nchildren($id) 0
+    }
+    set parents($id) {}
+    set nparents($id) 0
+    if [catch {set contents [exec hg cat-file commit $id]}] return
+    readonecommit $id $contents
+}
+
 proc readrefs {} {
     global tagids idtags
     set tags [glob -nocomplain -types f .git/refs/tags/*]
@@ -137,7 +217,7 @@
 	    set fd [open $f r]
 	    set line [read $fd]
 	    if {[regexp {^[0-9a-f]{40}} $line id]} {
-		set contents [split [exec git-cat-file tag $id] "\n"]
+		set contents [split [exec hg cat-file tag $id] "\n"]
 		set obj {}
 		set type {}
 		set tag {}
@@ -1084,7 +1164,7 @@
     set treepending $id
     set treediffs($id) {}
     set p [lindex $parents($id) 0]
-    if [catch {set gdtf [open "|git-diff-tree -r $p $id" r]}] return
+    if [catch {set gdtf [open "|hg diff-tree -r $p $id" r]}] return
     fconfigure $gdtf -blocking 0
     fileevent $gdtf readable "gettreediffline $gdtf $id"
 }
@@ -1108,7 +1188,7 @@
     global diffindex difffilestart
     set p [lindex $parents($id) 0]
     set env(GIT_DIFF_OPTS) $diffopts
-    if [catch {set bdf [open "|git-diff-tree -r -p $p $id" r]} err] {
+    if [catch {set bdf [open "|hg diff-tree -r -p $p $id" r]} err] {
 	puts "error getting diffs: $err"
 	return
     }
@@ -1362,4 +1442,4 @@
 setcoords
 makewindow
 readrefs
-getcommits $revtreeargs
+readfullcommits $revtreeargs