hgk: colorize commits by authors

Color commits by author. Colors will be assigned to authors by using a configurable list of colors. The line corresponding to current id (the version currently in the working tree) is highlighted in a special font which is also configurable. There is provision to assign fixed colors to authors. See .gitk comment for details.

contrib/hgk

@@ -338,7 +338,10 b' proc parsecommit {id contents listed old'
 }
 
 proc readrefs {} {
-    global tagids idtags headids idheads tagcontents env
+    global tagids idtags headids idheads tagcontents env curid
+    
+    set curid [exec $env(HG) --config ui.report_untrusted=false id]
+    regexp -- {[[:xdigit:]]+} $curid curid
 
     set tags [exec $env(HG) --config ui.report_untrusted=false tags]
     regsub -all "\r\n" $tags "\n" tags
@@ -641,13 +644,14 b' proc click {w} {'
 proc savestuff {w} {
     global canv canv2 canv3 ctext cflist mainfont textfont
     global stuffsaved findmergefiles gaudydiff maxgraphpct
-    global maxwidth
+    global maxwidth authorcolors curidfont
 
     if {$stuffsaved} return
     if {![winfo viewable .]} return
     catch {
 	set f [open "~/.gitk-new" w]
 	puts $f [list set mainfont $mainfont]
+	puts $f [list set curidfont $curidfont]
 	puts $f [list set textfont $textfont]
 	puts $f [list set findmergefiles $findmergefiles]
 	puts $f [list set gaudydiff $gaudydiff]
@@ -665,6 +669,23 b' proc savestuff {w} {'
 	set wid [expr {([winfo width $cflist] - 11) \
 			   / [font measure [$cflist cget -font] "0"]}]
 	puts $f "set geometry(cflistw) $wid"
+	puts $f "#"
+	puts $f "# authorcolors format:"
+	puts $f "#"
+	puts $f "# zero or more sublists of"
+	puts $f "#"
+	puts $f "#    { regex color }"
+	puts $f "#"
+	puts $f "# followed by a list of colors"
+	puts $f "#"
+	puts $f "# If the commit author matches a regex in a sublist,"
+	puts $f "# the commit will be colored by that color"
+	puts $f "# otherwise the next unused entry from the list of colors"
+	puts $f "# will be assigned to this commit and also all other commits"
+	puts $f "# of the same author.  When the list of colors is exhausted,"
+	puts $f "# the last entry will be reused."
+	puts $f "#"
+	puts $f "set authorcolors {$authorcolors}"
 	close $f
 	file rename -force "~/.gitk-new" "~/.gitk"
     }
@@ -757,6 +778,35 b' Use and redistribute under the terms of '
     pack $w.ok -side bottom
 }
 
+set aunextcolor 0
+proc assignauthorcolor {name} {
+    global authorcolors aucolormap aunextcolor
+    if [info exists aucolormap($name)] return
+
+    set randomcolors {black}
+    for {set i 0} {$i < [llength $authorcolors]} {incr i} {
+	set col [lindex $authorcolors $i]
+	if {[llength $col] > 1} {
+	    set re [lindex $col 0]
+	    set c [lindex $col 1]
+	    if {[regexp -- $re $name]} {
+		set aucolormap($name) $c
+		return
+	    }
+	} else {
+	    set randomcolors [lrange $authorcolors $i end]
+	    break
+	}
+    }
+
+    set ncolors [llength $randomcolors]
+    set c [lindex $randomcolors $aunextcolor]
+    if {[incr aunextcolor] >= $ncolors} {
+	incr aunextcolor -1
+    }
+    set aucolormap($name) $c
+}
+
 proc assigncolor {id} {
     global commitinfo colormap commcolors colors nextcolor
     global parents nparents children nchildren
@@ -894,6 +944,7 b' proc drawcommitline {level} {'
     global lineno lthickness mainline mainlinearrow sidelines
     global commitlisted rowtextx idpos lastuse displist
     global oldnlines olddlevel olddisplist
+    global aucolormap curid curidfont
 
     incr numcommits
     incr lineno
@@ -952,14 +1003,25 b' proc drawcommitline {level} {'
     }
     set headline [lindex $commitinfo($id) 0]
     set name [lindex $commitinfo($id) 1]
+    assignauthorcolor $name
+    set fg $aucolormap($name)
+    if {$id == $curid} {
+	set fn $curidfont
+    } else {
+	set fn $mainfont
+    }
+
     set date [lindex $commitinfo($id) 2]
     set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
-			       -text $headline -font $mainfont ]
+			       -text $headline -font $fn \
+			       -fill $fg]
     $canv bind $linehtag($lineno) <<B3>> "rowmenu %X %Y $id"
     set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
-			       -text $name -font $namefont]
+			       -text $name -font $namefont \
+			       -fill $fg]
     set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
-			       -text $date -font $mainfont]
+			       -text $date -font $mainfont \
+			       -fill $fg]
 
     set olddlevel $level
     set olddisplist $displist
@@ -3089,9 +3151,10 b' proc redisplay {} {'
 
 proc incrfont {inc} {
     global mainfont namefont textfont ctext canv phase
-    global stopped entries
+    global stopped entries curidfont
     unmarkmatches
     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
+    set curidfont [lreplace $curidfont 1 1 [expr {[lindex $curidfont 1] + $inc}]]
     set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
     setcoords
@@ -3772,6 +3835,7 b' set diffopts "-U 5 -p"'
 set wrcomcmd "\"\$HG\" --config ui.report_untrusted=false debug-diff-tree --stdin -p --pretty"
 
 set mainfont {Helvetica 9}
+set curidfont {}
 set textfont {Courier 9}
 set findmergefiles 0
 set gaudydiff 0
@@ -3779,9 +3843,16 b' set maxgraphpct 50'
 set maxwidth 16
 
 set colors {green red blue magenta darkgrey brown orange}
+set authorcolors {
+    deeppink mediumorchid blue burlywood4 goldenrod slateblue red2 navy dimgrey
+}
 
 catch {source ~/.gitk}
 
+if {$curidfont == ""} {  # initialize late based on current mainfont
+    set curidfont "$mainfont bold italic underline"
+}
+
 set namefont $mainfont
 if {$boldnames} {
     lappend namefont bold