summaryrefslogtreecommitdiffstats
path: root/tcllib/support/devel/sak/review/review.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tcllib/support/devel/sak/review/review.tcl')
-rw-r--r--tcllib/support/devel/sak/review/review.tcl985
1 files changed, 985 insertions, 0 deletions
diff --git a/tcllib/support/devel/sak/review/review.tcl b/tcllib/support/devel/sak/review/review.tcl
new file mode 100644
index 0000000..93bb59e
--- /dev/null
+++ b/tcllib/support/devel/sak/review/review.tcl
@@ -0,0 +1,985 @@
+# -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+# (C) 2013 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+##
+# ###
+
+package require linenoise
+package require sak::color
+
+getpackage fileutil fileutil/fileutil.tcl
+getpackage doctools::changelog doctools/changelog.tcl
+getpackage struct::set struct/sets.tcl
+getpackage term::ansi::send term/ansi/send.tcl
+
+namespace eval ::sak::review {
+ namespace import ::sak::color::*
+}
+
+# ###
+
+proc ::sak::review::usage {} {
+ package require sak::help
+ puts stdout \n[sak::help::on review]
+ exit 1
+}
+
+proc ::sak::review::run {} {
+ Scan ; Review
+ return
+}
+
+# # ## ### ##### ######## ############# #####################
+## Phase I. Determine which modules require a review.
+## A derivative of the code in ::sak::readme.
+
+proc ::sak::review::Scan {} {
+ global distribution
+ variable review
+ variable rm
+
+ Banner "Scan for modules and packages to review..."
+
+ # Future: Consolidate with ... readme ...
+ # Determine which packages are potentially changed and therefore
+ # in need of review, from the set of modules touched since the
+ # last release, as per the fossil repository's commit log.
+
+ # list of modified modules.
+ set modifiedm {}
+
+ # database of commit messages per changed module.
+ # cm: module -> list(string)
+ array set cm {}
+
+ # pt: database of files per changed module.
+ # module -> list(path)
+
+ # rm: module -> list (revs); rev = uuid+desc+files (string)
+ array set rm {}
+
+ foreach {trunk tuid} [Leaf trunk] break ;# rid + uuid
+ foreach {release ruid} [YoungestOfTag release] break ;# datetime + uuid
+ AllParentsAfter $trunk $tuid $release $ruid -> rid uuid numparents {
+ Next ; Progress " $rid"
+
+ if {$numparents > 1} {
+ Progress " SKIP"
+ } else {
+ # Consider only commits with one parent, i.e. non-merges,
+ # as possible contributors to modules and packages.
+
+ set d [Description $rid]
+ Progress " D"
+
+ # Determine file set, split by modules, then generate a package of
+ # uuid, description and filtered files per modules touched.
+
+ array set fs {}
+
+ FileSet $rid -> path action {
+ Progress .
+
+ set px [file split $path]
+ set themodule [lindex $px 1]
+ lappend modifiedm $themodule
+ lappend cm($themodule) $d
+
+ # ignore files in modules/
+ if {[llength $px] < 3} continue
+
+ #puts $themodule||$rid||$action|$px|
+
+ lappend fs($themodule) [file join {*}[lrange $px 2 end]]
+ lappend pt($themodule) [file join {*}[lrange $px 2 end]]
+ }
+
+ foreach {m files} [array get fs] {
+ set str \[htts://core.tcl.tk/tcllib/info/$uuid\]\n$d\n\n[join [lsort -dict $files] \n]
+ lappend rm($m) $str
+ }
+ unset fs
+ }
+ }
+
+ Next
+
+ # cleanup module list, may have duplicates
+ set modifiedm [lsort -unique $modifiedm]
+
+ array set review {}
+
+ # package -> list(version)
+ set old_version [loadoldv [location_PACKAGES]]
+ array set releasep [loadpkglist [location_PACKAGES]]
+ array set currentp [ipackages]
+
+ array set changed {}
+ foreach p [array names currentp] {
+ foreach {vlist module} $currentp($p) break
+ set currentp($p) $vlist
+ set changed($p) [struct::set contains $modifiedm $module]
+ }
+
+ LoadNotes
+
+ set np 0
+ # Process all packages in all modules ...
+ foreach m [lsort -dict [modules]] {
+ Next ; Progress " $m"
+ foreach name [lsort -dict [Provided $m]] {
+ #Next ; Progress "... $m/$name"
+ # Define list of versions, if undefined so far.
+ if {![info exists currentp($name)]} {
+ set currentp($name) {}
+ }
+
+ # Detect new packages. Ignore them.
+
+ if {![info exists releasep($name)]} {
+ #Progress " /new"
+ continue
+ }
+
+ # The package is not new, but possibly changed. And even
+ # if the version has not changed it may have been, this is
+ # indicated by changed(), which is based on the ChangeLog.
+
+ set vequal [struct::set equal $releasep($name) $currentp($name)]
+ set note [Note $m $name]
+
+ # Detect packages whose versions are unchanged, and whose
+ # changelog also indicates no change. Ignore these too.
+
+ if {!$changed($name) && $vequal} {
+ #Progress " /not changed"
+ continue
+ }
+
+ # Now look for packages where both changelog and version
+ # number indicate a change. These we have to review.
+
+ if {$changed($name) && !$vequal} {
+ lappend review($m) [list $name classify $note]
+ #Progress " [=cya classify]"
+ incr np
+ continue
+ }
+
+ # What remains are packages which are changed according to
+ # their changelog, but their version disagrees. Or the
+ # reverse. These need a big review to see who is right.
+ # We may have to bump their version information, not just
+ # classify changes. Of course, in modules with multiple
+ # packages it is quite possible to be unchanged and the
+ # changelog refers to the siblings.
+
+ lappend review($m) [list $name mismatch $note]
+ #Progress " [=cya mismatch]"
+ incr np
+ }
+ }
+
+ Close
+
+ # Postprocessing phase, pull in all relevant commit messages of the module.
+
+ foreach m [array names review] {
+ # commit messages
+ if {[info exists cm($m)]} {
+ set entries [lsort -unique $cm($m)]
+ } else {
+ set entries {}
+ }
+ # and affected files
+ if {[info exists pt($m)]} {
+ lappend entries [join [lsort -dict [lsort -unique $pt($m)]] \n]
+ }
+
+ set review($m) [list $review($m) [join $entries \n\n]]
+ }
+
+ # review: module -> list (notes, desc+files)
+ set review() $np
+ return
+}
+
+# see also readme
+proc ::sak::review::Provided {m} {
+ set result {}
+ foreach {p ___} [ppackages $m] {
+ lappend result $p
+ }
+ return $result
+}
+
+# see also readme
+proc ::sak::review::loadoldv {fname} {
+ set f [open $fname r]
+ foreach line [split [read $f] \n] {
+ set line [string trim $line]
+ if {[string match @* $line]} {
+ foreach {__ __ v} $line break
+ close $f
+ return $v
+ }
+ }
+ close $f
+ return -code error {Version not found}
+}
+
+proc ::sak::review::Progress {text} {
+ puts -nonewline stdout $text
+ flush stdout
+ return
+}
+
+proc ::sak::review::Next {} {
+ # erase to end of line, then move back to start of line.
+ term::ansi::send::eeol
+ puts -nonewline stdout \r
+ flush stdout
+ return
+}
+
+proc ::sak::review::Close {} {
+ puts stdout ""
+ return
+}
+
+proc ::sak::review::Clear {} {
+ term::ansi::send::clear
+ return
+}
+
+proc ::sak::review::Banner {text} {
+ Clear
+ puts stdout "\n <<SAK Tcllib: $text>>\n"
+ return
+}
+
+proc ::sak::review::Note {m p} {
+ # Look for a note, and present to caller, if any.
+ variable notes
+ #parray notes
+ set k [list $m $p]
+ #puts <$k>
+ if {[info exists notes($k)]} {
+ return $notes($k)
+ }
+ return ""
+}
+
+proc ::sak::review::SaveNote {at t} {
+ global distribution
+ set f [open [file join $distribution .NOTE] a]
+ puts $f [list $at $t]
+ close $f
+ return
+}
+
+proc ::sak::review::LoadNotes {} {
+ global distribution
+ variable notes
+ array set notes {}
+
+ catch {
+ set f [file join $distribution .NOTE]
+ set f [open $f r]
+ while {![eof $f]} {
+ if {[gets $f line] < 0} continue
+ set line [string trim $line]
+ if {$line == {}} continue
+ foreach {k t} $line break
+ set notes($k) $t
+ }
+ close $f
+ }
+
+ return
+}
+
+proc ::sak::review::FileSet {rid _ pv av script} {
+ upvar 1 $pv thepath $av theaction
+
+ lappend map @rid@ $rid
+ foreach line [split [string trim [F [string map $map {
+ SELECT filename.name,
+ CASE WHEN nullif(mlink.pid,0) is null THEN 'added'
+ WHEN nullif(mlink.fid,0) is null THEN 'deleted'
+ ELSE 'edited'
+ END
+ FROM mlink, filename
+ WHERE mlink.mid = @rid@
+ AND mlink.fnid = filename.fnid
+ ORDER BY filename.name;
+ }]]] \n] {
+ foreach {thepath theaction} [split $line |] break
+ # ignore all changes not in modules
+ if {![string match modules* $thepath]} continue
+ uplevel 1 $script
+ }
+ return
+}
+
+proc ::sak::review::Description {rid} {
+ lappend map @rid@ $rid
+ string trim [F [string map $map {
+ SELECT coalesce(event.ecomment,event.comment)
+ FROM event
+ WHERE event.objid = @rid@
+ ;
+ }]]
+}
+
+proc ::sak::review::AllParentsAfter {rid ruid cut cutuid _ rv uv nv script} {
+ upvar 1 $rv therev $uv theuid $nv thenump
+
+ array set rev {}
+ set rev($rid) .
+ lappend front $rid
+
+ # Initial run, for the starting revision.
+ set thenump [llength [AllParents $rid]]
+ set therev $rid
+ set theuid $ruid
+ uplevel 1 $script
+
+ # Standard iterative incremental transitive-closure. We have a
+ # front of revisions whose parents we take, which become the new
+ # front to follow, until no parents are delivered anymore due to
+ # the cutoff condition (timestamp, only the revisions coming after
+ # are accepted).
+
+ while {1} {
+ set new {}
+ foreach cid $front {
+ foreach pid [Parents $cid $cut] {
+ foreach {pid uuid mtraw mtime} [split [string trim $pid |] |] break
+ if {$uuid eq $cutuid} continue
+
+ lappend new $pid $mtime $uuid
+ if {$mtraw <= $cut} {
+ puts "Overshot: $rid $mtime $uuid"
+ }
+ }
+ }
+ if {![llength $new]} break
+
+ # record new parents, and make them the new starting points
+ set front {}
+ foreach {pid mtime uuid} $new {
+ if {[info exists rev($pid)]} continue
+ set rev($pid) .
+ lappend front $pid
+
+ set thenump [llength [AllParents $pid]]
+ set therev $pid
+ set theuid $uuid
+ uplevel 1 $script
+ }
+ }
+}
+
+proc ::sak::review::Parents {rid cut} {
+ lappend map @rid@ $rid
+ lappend map @cutoff@ $cut
+ split [F [string map $map {
+ SELECT pid, blob.uuid, event.mtime, datetime(event.mtime)
+ FROM plink, blob, event
+ WHERE plink.cid = @rid@
+ AND plink.pid = blob.rid
+ AND plink.pid = event.objid
+ AND event.mtime > @cutoff@
+ ;
+ }]] \n
+}
+
+proc ::sak::review::AllParents {rid} {
+ lappend map @rid@ $rid
+ split [F [string map $map {
+ SELECT pid, blob.uuid, event.mtime, datetime(event.mtime)
+ FROM plink, blob, event
+ WHERE plink.cid = @rid@
+ AND plink.pid = blob.rid
+ AND plink.pid = event.objid
+ ;
+ }]] \n
+}
+
+proc ::sak::review::YoungestOfTag {tag} {
+ lappend map @tag@ $tag
+ puts stderr "last $tag = [F [string map $map {
+ SELECT datetime (event.mtime)
+ FROM tag, tagxref, event
+ WHERE tag.tagname = 'sym-' || '@tag@'
+ AND tagxref.tagid = tag.tagid
+ AND tagxref.tagtype > 0
+ AND tagxref.rid = event.objid
+ AND event.type = 'ci'
+ ORDER BY event.mtime DESC
+ LIMIT 1
+ ;
+ }]]"
+ split [F [string map $map {
+ SELECT event.mtime, blob.uuid
+ FROM tag, tagxref, event, blob
+ WHERE tag.tagname = 'sym-' || '@tag@'
+ AND tagxref.tagid = tag.tagid
+ AND tagxref.tagtype > 0
+ AND tagxref.rid = event.objid
+ AND event.type = 'ci'
+ AND blob.rid = event.objid
+ ORDER BY event.mtime DESC
+ LIMIT 1
+ ;
+ }]] |
+}
+
+proc ::sak::review::Leaf {branch} {
+ lappend map @branch@ $branch
+ split [F [string map $map {
+ SELECT blob.rid, blob.uuid
+ FROM leaf, blob, tag, tagxref
+ WHERE blob.rid = leaf.rid
+ AND tag.tagname = 'sym-' || '@branch@'
+ AND tagxref.tagid = tag.tagid
+ AND tagxref.tagtype > 0
+ AND tagxref.rid = leaf.rid
+ ;
+ }]] |
+}
+
+proc ::sak::review::F {script} {
+ #puts |$script|
+ set r [exec fossil sqlite3 << $script]
+ #puts ($r)
+ return $r
+}
+
+
+
+# # ## ### ##### ######## ############# #####################
+## Phase II. Interactively review the changes packages.
+
+# Namespace variables
+#
+# review : array, database of all modules, keyed by name
+# nm : number of modules
+# modules : list of module names, keys to --> review
+# current : index in -> modules, current module
+# np : number of packages in current module
+# packages : list of packages in current module
+# currentp : index in --> packages
+# im : 1+current | indices for display
+# ip : 1+currentp |
+# ir : 1+currentr |
+# end : array : module (name) --> index of last package
+# stop : repl exit flag
+# map : array : text -> module/package index
+# commands : proper commands
+# allcommands : commands + namesof(map)
+#
+
+proc ::sak::review::Review {} {
+ variable review ;# table of everything to review
+ variable rm ;# Alt structure, rev (desc, files) by module.
+ variable nm ;# number of modules
+ variable modules ;# list of module names, sorted
+ variable stop 0 ;# repl exit flag
+ variable end ;# last module/package index.
+ variable smode rev ;# standard display per revision.
+
+ variable navcommands
+ variable allcommands ;# list of all commands, sorted
+ variable commands ;# list of proper commands, sorted
+ variable map ;# map from package names to module/package indices.
+ variable prefix
+
+ Banner "Packages to review: $review()"
+ unset review()
+
+ set nm [array size review]
+ if {!$nm} return
+
+ set modules [lsort -dict [array names review]]
+
+ # Map package name --> module/package index.
+ set im 0
+ foreach m $modules {
+ foreach {packages clog} $review($m) break
+ set ip 0
+ foreach p $packages {
+ set end($im) $ip
+ set end($m) $ip
+ set end() [list $im $ip]
+ foreach {name what tags} $p break
+ lappend map(@$name) [list $im $ip]
+ lappend map(@$name/$m) [list $im $ip]
+ incr ip
+ }
+ incr im
+ }
+
+ # Drop amibigous mappings, and fill the list of commands.
+ foreach k [array names map] {
+ # Skip already dropped keys (extended forms).
+ if {![info exists map($k)]} continue
+ if {[llength $map($k)] < 2} {
+ set map($k) [lindex $map($k) 0]
+ # Drop extended form, not needed.
+ array unset map $k/*
+ } else {
+ unset map($k)
+ }
+ }
+
+ # Map module name --> module/package index
+ # If not preempted by package mapping.
+ set im -1
+ foreach m $modules {
+ incr im
+ if {[info exists map(@$m)]} continue
+ set map(@$m) [list $im 0]
+ }
+
+ # Map command prefix -> full command.
+
+ array set prefix {}
+ foreach c [info commands ::sak::review::C_*] {
+ set c [string range [namespace tail $c] 2 end]
+ lappend commands $c
+ lappend allcommands $c
+ set buf {}
+ foreach ch [split $c {}] {
+ append buf $ch
+ lappend prefix($buf) $c
+ }
+ }
+
+ foreach c [array names map] {
+ lappend allcommands $c
+ set buf {}
+ foreach ch [split $c {}] {
+ append buf $ch
+ lappend prefix($buf) $c
+ }
+ }
+
+ set commands [lsort -dict $commands]
+ set allcommands [lsort -dict $allcommands]
+ set navcommands [lsort -dict [array names map]]
+
+ # Enter the REPL
+ Goto {0 0} 1
+ linenoise::cmdloop \
+ -history 1 \
+ -exit ::sak::review::Exit \
+ -continued ::sak::review::Continued \
+ -prompt1 ::sak::review::Prompt \
+ -complete ::sak::review::Complete \
+ -dispatch ::sak::review::Dispatch
+ return
+}
+
+# # ## ### ##### ######## ############# #####################
+
+proc ::sak::review::RefreshDisplay {} {
+ variable m
+ variable im
+ variable ir
+ variable nm
+ variable nr
+ variable clog
+ variable rlog
+ variable what
+ variable smode
+
+ if {$smode eq "rev"} {
+ set text $rlog
+ } else {
+ set text $clog
+ }
+
+ if {$smode eq "rev"} {
+ Banner "($ir/$nr) \[$im/$nm\] [=cya [string totitle $what]] [=green $m]"
+ } else {
+ Banner "\[$im/$nm\] [=cya [string totitle $what]] [=green $m]"
+ }
+ puts "| [join [split $text \n] "\n| "]\n"
+ return
+}
+
+proc ::sak::review::Exit {} {
+ variable stop
+ return $stop
+}
+
+proc ::sak::review::Continued {buffer} {
+ return 0
+}
+
+proc ::sak::review::Prompt {} {
+ variable ip
+ variable np
+ variable name
+ variable tags
+ variable smode
+ variable im
+ variable ir
+ variable nm
+ variable nr
+ variable what
+ variable m
+
+ if {$smode eq "rev"} {
+ append p "($ir/$nr) "
+ }
+
+ append p "\[$im/$nm\] [=green $m] [=cya [string totitle $what]] "
+ append p "\[$ip/$np\] [=whi $name] ($tags): "
+ return $p
+}
+
+proc ::sak::review::Complete {line} {
+ variable allcommands
+ if {$line eq {}} {
+ return $allcommands
+ } elseif {[llength $line] == 1} {
+ set r {}
+ foreach c $allcommands {
+ if {![string match ${line}* $c]} continue
+ lappend r $c
+ }
+ return $r
+ } else {
+ return {}
+ }
+}
+
+proc ::sak::review::Dispatch {line} {
+ variable prefix
+ variable map
+
+ if {$line == ""} { set line next }
+
+ set cmd [lindex $line 0]
+
+ if {![info exists prefix($cmd)]} {
+ return -code error "Unknown command $cmd, use help or ? to list them"
+ } elseif {[llength $prefix($cmd)] > 1} {
+ return -code error "Ambigous prefix \"$cmd\", expected [join $prefix($cmd) {, }]"
+ }
+
+ # Map prefix to actual command
+ set line [lreplace $line 0 0 $prefix($cmd)]
+
+ # Run command.
+ if {[info exists map($cmd)]} {
+ Goto $map($cmd)
+ return
+ }
+ eval C_$line
+}
+
+proc ::sak::review::Goto {loc {skip 0}} {
+ variable review
+ variable rm
+ variable modules
+ variable packages
+ variable clog
+ variable rlog
+ variable rloga
+ variable current
+ variable currentp
+ variable currentr
+ variable nm
+ variable np
+ variable nr
+ variable at
+ variable tags
+ variable what
+ variable name
+
+ variable m
+ variable p
+ variable ip
+ variable im
+ variable ir
+
+ foreach {current currentp} $loc break
+ set currentr 0
+
+ puts "Goto ($current/$currentp)"
+
+ set m [lindex $modules $current]
+ foreach {packages clog} $review($m) break
+ if {[catch {
+ set nr [llength $rm($m)]
+ set rloga $rm($m)
+ set rlog [lindex $rloga $currentr]
+ }]} {
+ set nr 0
+ set currentr 0
+ set rloga {}
+ set rlog {}
+ }
+
+ set np [llength $packages]
+ set p [lindex $packages $currentp]
+
+ foreach {name what tags} $p break
+ set at [list $m $name]
+
+ set im [expr {1+$current}]
+ set ip [expr {1+$currentp}]
+ set ir [expr {1+$currentr}]
+
+ if {$skip && ([llength $tags] ||
+ ($tags == "---"))} {
+ C_next
+ } else {
+ RefreshDisplay
+ }
+ return
+}
+
+proc ::sak::review::C_* {} {
+ variable smode
+ variable currentr
+ if {$smode eq "all"} {
+ set smode rev
+ set currentr 0
+ } else {
+ set smode all
+ }
+ RefreshDisplay
+ return
+}
+proc ::sak::review::C_, {} {
+ # next revision
+ variable smode
+ variable rlog
+ variable rloga
+ variable currentr
+ if {$smode eq "all"} {
+ set smode rev
+ set currentr 0
+ } else {
+ variable nr
+ incr currentr
+ if {$currentr >= $nr} { set currentr 0 }
+ }
+ variable ir [expr {1+$currentr}]
+ set rlog [lindex $rloga $currentr]
+ RefreshDisplay
+ return
+}
+proc ::sak::review::C_' {} {
+ # previous revision
+ variable smode
+ variable rlog
+ variable rloga
+ variable nr
+ variable currentr
+ if {$smode eq "all"} {
+ set smode rev
+ set currentr $nr
+ }
+ incr currentr -1
+ if {$currentr <= 0} {
+ set currentr $nr
+ incr currentr -1
+ }
+ variable ir [expr {1+$currentr}]
+ set rlog [lindex $rloga $currentr]
+ RefreshDisplay
+ return
+}
+
+proc ::sak::review::C_exit {} { variable stop 1 }
+proc ::sak::review::C_quit {} { variable stop 1 }
+
+proc ::sak::review::C_? {} { C_help }
+proc ::sak::review::C_help {} {
+ variable commands
+ return [join $commands {, }]
+}
+
+proc ::sak::review::C_@? {} { C_@help }
+proc ::sak::review::C_@help {} {
+ variable navcommands
+ return [join $navcommands {, }]
+}
+
+proc ::sak::review::C_@start {} { Goto {0 0} }
+proc ::sak::review::C_@0 {} { Goto {0 0} }
+proc ::sak::review::C_@end {} { variable end ; Goto $end() }
+
+proc ::sak::review::C_>> {} { C_next 1 }
+proc ::sak::review::C_next {{skiprev 0}} {
+ variable tags
+ variable current
+ variable currentp
+ variable smode
+
+ if {!($skiprev) && ($smode eq "rev")} {
+ variable ir
+ variable nr
+ if {$ir < $nr} {
+ C_,
+ return
+ }
+ }
+
+ C_step 0
+
+ set stop @$current/$currentp
+ while {[llength $tags] ||
+ ($tags == "---")} {
+ C_step 0
+ if {"@$current/$currentp" == "$stop"} break
+ }
+
+ RefreshDisplay
+ return
+}
+
+proc ::sak::review::C_step {{refresh 1}} {
+ variable nm
+ variable np
+ variable current
+ variable currentp
+ variable packages
+
+ incr currentp
+ if {$currentp >= $np} {
+ # skip to next module, first package
+ incr current
+ if {$current >= $nm} {
+ # skip to first module
+ set current 0
+ }
+ set currentp 0
+
+ }
+ Goto [list $current $currentp]
+ return
+}
+
+proc ::sak::review::C_<< {} { C_prev 1 }
+proc ::sak::review::C_prev {{skiprev 0}} {
+ variable end
+ variable nm
+ variable np
+ variable current
+ variable currentp
+ variable packages
+ variable smode
+
+ if {!$skiprev && ($smode eq "rev")} {
+ variable ir
+ if {$ir > 1} {
+ C_'
+ return
+ }
+ }
+
+ incr currentp -1
+ if {$currentp < 0} {
+ # skip to previous module, last package
+ incr current -1
+ if {$current < 0} {
+ # skip to back to last module
+ set current [expr {$nm - 1}]
+ }
+ set currentp $end($current)
+ }
+ Goto [list $current $currentp]
+ return
+}
+
+# Commands to add/remove tags, clear set, replace set
+
+proc ::sak::review::C_feature {} { +T EF }
+proc ::sak::review::C_test {} { +T T }
+proc ::sak::review::C_doc {} { +T D }
+proc ::sak::review::C_bug {} { +T B }
+proc ::sak::review::C_perf {} { +T P }
+proc ::sak::review::C_example {} { +T EX }
+proc ::sak::review::C_api {} { +T API }
+proc ::sak::review::C_impl {} { +T I }
+
+proc ::sak::review::C_-feature {} { -T EF }
+proc ::sak::review::C_-test {} { -T T }
+proc ::sak::review::C_-doc {} { -T D }
+proc ::sak::review::C_-bug {} { -T B }
+proc ::sak::review::C_-perf {} { -T P }
+proc ::sak::review::C_-example {} { -T EX }
+proc ::sak::review::C_-api {} { -T API }
+proc ::sak::review::C_-impl {} { -T I }
+
+proc ::sak::review::C_--- {} { =T --- }
+proc ::sak::review::C_clear {} { =T --- }
+#proc ::sak::review::C_cn {} { C_clear ; C_next }
+
+proc ::sak::review::+T {tag} {
+ variable tags
+ if {[lsearch -exact $tags $tag] >= 0} {
+ RefreshDisplay
+ return
+ }
+ =T [linsert $tags end $tag]
+ return
+}
+
+proc ::sak::review::-T {tag} {
+ variable tags
+ set pos [lsearch -exact $tags $tag]
+ if {$pos < 0} {
+ RefreshDisplay
+ return
+ }
+ =T [lreplace $tags $pos $pos]
+ return
+}
+
+proc ::sak::review::=T {newtags} {
+ variable review
+ variable clog
+ variable packages
+ variable currentp
+ variable p
+ variable m
+ variable at
+ variable name
+ variable what
+ variable tags
+
+ if {([llength $newtags] > 1) &&
+ ([set pos [lsearch -exact $newtags ---]] >= 0)} {
+ # Drop --- if there are other tags.
+ set newtags [lreplace $newtags $pos $pos]
+ }
+
+ set tags [lsort -dict $newtags]
+ set p [list $name $what $newtags]
+ set packages [lreplace $packages $currentp $currentp $p]
+ set review($m) [list $packages $clog]
+
+ SaveNote $at $tags
+ RefreshDisplay
+ return
+}
+
+proc ::sak::review::?T {} {
+ variable tags
+ return $tags
+}
+
+##
+# ###
+
+namespace eval ::sak::review {}
+
+package provide sak::review 1.0
generated by cgit v0.12 at 2024-07-18 09:21:43 (GMT)