comparison contrib/hgk @ 5464:7dafd9ab3979

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.

5463:3b204881f959

    set commitinfo($id) [list $headline $auname $audate \
			     $comname $comdate $comment $rev]
}

proc readrefs {} {
    global tagids idtags headids idheads tagcontents env

    set tags [exec $env(HG) --config ui.report_untrusted=false tags]
    regsub -all "\r\n" $tags "\n" tags
    set lines [split $tags "\n"]
    foreach f $lines {

}

proc savestuff {w} {
    global canv canv2 canv3 ctext cflist mainfont textfont
    global stuffsaved findmergefiles gaudydiff maxgraphpct
    global maxwidth

    if {$stuffsaved} return
    if {![winfo viewable .]} return
    catch {
	set f [open "~/.gitk-new" w]
	puts $f [list set mainfont $mainfont]
	puts $f [list set textfont $textfont]
	puts $f [list set findmergefiles $findmergefiles]
	puts $f [list set gaudydiff $gaudydiff]
	puts $f [list set maxgraphpct $maxgraphpct]
	puts $f [list set maxwidth $maxwidth]

			   / [font measure $textfont "0"]}]
	puts $f "set geometry(ctextw) $wid"
	set wid [expr {([winfo width $cflist] - 11) \
			   / [font measure [$cflist cget -font] "0"]}]
	puts $f "set geometry(cflistw) $wid"
	close $f
	file rename -force "~/.gitk-new" "~/.gitk"
    }
    set stuffsaved 1
}

    pack $w.m -side top -fill x -padx 20 -pady 20
    button $w.ok -text Close -command "destroy $w"
    pack $w.ok -side bottom
}

proc assigncolor {id} {
    global commitinfo colormap commcolors colors nextcolor
    global parents nparents children nchildren
    global cornercrossings crossings

    global colormap numcommits currentparents dupparents
    global idtags idline idheads idotherrefs
    global lineno lthickness mainline mainlinearrow sidelines
    global commitlisted rowtextx idpos lastuse displist
    global oldnlines olddlevel olddisplist

    incr numcommits
    incr lineno
    set id [lindex $displist $level]
    set lastuse($id) $lineno

	|| [info exists idotherrefs($id)]} {
	set xt [drawtags $id $x $xt $y1]
    }
    set headline [lindex $commitinfo($id) 0]
    set name [lindex $commitinfo($id) 1]
    set date [lindex $commitinfo($id) 2]
    set linehtag($lineno) [$canv create text $xt $y1 -anchor w \
			       -text $headline -font $mainfont ]
    $canv bind $linehtag($lineno) <<B3>> "rowmenu %X %Y $id"
    set linentag($lineno) [$canv2 create text 3 $y1 -anchor w \
			       -text $name -font $namefont]
    set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
			       -text $date -font $mainfont]

    set olddlevel $level
    set olddisplist $displist
    set oldnlines [llength $displist]
}

    }
}

proc incrfont {inc} {
    global mainfont namefont textfont ctext canv phase
    global stopped entries
    unmarkmatches
    set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 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
    $ctext conf -font $textfont
    $ctext tag conf filesep -font [concat $textfont bold]

set boldnames 0
set diffopts "-U 5 -p"
set wrcomcmd "\"\$HG\" --config ui.report_untrusted=false debug-diff-tree --stdin -p --pretty"

set mainfont {Helvetica 9}
set textfont {Courier 9}
set findmergefiles 0
set gaudydiff 0
set maxgraphpct 50
set maxwidth 16

set colors {green red blue magenta darkgrey brown orange}

catch {source ~/.gitk}

set namefont $mainfont
if {$boldnames} {
    lappend namefont bold
}

5464:7dafd9ab3979

    set commitinfo($id) [list $headline $auname $audate \
			     $comname $comdate $comment $rev]
}

proc readrefs {} {
    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
    set lines [split $tags "\n"]
    foreach f $lines {

}

proc savestuff {w} {
    global canv canv2 canv3 ctext cflist mainfont textfont
    global stuffsaved findmergefiles gaudydiff maxgraphpct
    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]
	puts $f [list set maxgraphpct $maxgraphpct]
	puts $f [list set maxwidth $maxwidth]

			   / [font measure $textfont "0"]}]
	puts $f "set geometry(ctextw) $wid"
	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"
    }
    set stuffsaved 1
}

    pack $w.m -side top -fill x -padx 20 -pady 20
    button $w.ok -text Close -command "destroy $w"
    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
    global cornercrossings crossings

    global colormap numcommits currentparents dupparents
    global idtags idline idheads idotherrefs
    global lineno lthickness mainline mainlinearrow sidelines
    global commitlisted rowtextx idpos lastuse displist
    global oldnlines olddlevel olddisplist
    global aucolormap curid curidfont

    incr numcommits
    incr lineno
    set id [lindex $displist $level]
    set lastuse($id) $lineno

	|| [info exists idotherrefs($id)]} {
	set xt [drawtags $id $x $xt $y1]
    }
    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 $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 \
			       -fill $fg]
    set linedtag($lineno) [$canv3 create text 3 $y1 -anchor w \
			       -text $date -font $mainfont \
			       -fill $fg]

    set olddlevel $level
    set olddisplist $displist
    set oldnlines [llength $displist]
}

    }
}

proc incrfont {inc} {
    global mainfont namefont textfont ctext canv phase
    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
    $ctext conf -font $textfont
    $ctext tag conf filesep -font [concat $textfont bold]

set boldnames 0
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
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
}