Browse Source
Two G-candidate prototypes under src/scriptapps/tools/ for punk::args as the documentation source of truth (run against bootsupport modules with a plain tclsh, e.g: tclsh punkargs_to_doctools.tcl punk::path out.man): - punkargs_to_doctools.tcl: package's punk::args definitions -> doctools .man (Tcl-standard [arg]/[opt] synopsis conventions by design - punk s-style is out of scope for the doctools target). Covers @cmd summary/help, per-form [call] synopses, argument detail lists in argspace order (leaders/options/ trailing values), constraint sentences (defaults/choices/ranges), id aliases as cross-references. Validated via 'dtplite validate' (bin/dtplite.cmd); punk::path trial output renders clean through the html/text/nroff engines. - punkargs_punknative.tcl: doctools-free pipeline faithful to punk s-style. html = punk::args::usage ANSI output converted via a minimal SGR->CSS ansi2html (16/256/truecolour, bold/dim/italic/underline/strike/reverse) on punk::ansi::ta::split_codes - candidate for a punk::ansi public api (also the docs-screenshot enabler for ansicat/textblock output). markdown = GFM with verbatim s-style synopsis fences + per-form argument tables. -boxmap none (default) keeps faithful heavy box glyphs; -boxmap light maps to the light set as a portability fallback. Key findings baked into the code comments: - css font stacks must be set on the pre element itself - the UA stylesheet's 'pre {font-family:monospace}' overrides body inheritance (cause of an initially-misdiagnosed overlong-border rendering bug) - glyph coverage probe over src/testansi + textblock::periodic/frames + punk::args::usage (160 codepoints incl. unicode 16 octants and legacy computing blocks): Cascadia Mono >=2404.23 covers 157/160; embedding or referencing a pinned punkdoc-mono font remains the plan for doc-set output since octant/legacy glyphs are absent from commonly installed fonts. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
2 changed files with 734 additions and 0 deletions
@ -0,0 +1,416 @@
|
||||
# punkargs_punknative.tcl - PROTOTYPE (companion to punkargs_to_doctools.tcl) |
||||
# Punk-native documentation pipeline: generate html + markdown for one package |
||||
# directly from its punk::args definitions, faithful to the punk s-style |
||||
# synopsis conventions ([...] optionals, <type> placeholders) - bypassing |
||||
# doctools entirely (doctools stays Tcl-standard; no man-page output here). |
||||
# |
||||
# usage: tclsh punkargs_punknative.tcl <package> <outdir> ?-boxmap none|light? |
||||
# -boxmap none (default): faithful heavy box-drawing glyphs |
||||
# -boxmap light: map heavy/mixed box chars to the light set (portability |
||||
# fallback for viewers with only minimal mono fonts; _lightbox suffix) |
||||
# writes: <outdir>/<pkg>_punknative.html terminal-faithful rendering: |
||||
# punk::args::usage ANSI output converted to styled HTML spans |
||||
# (dark terminal theme, box-drawing tables, colours, italics) |
||||
# <outdir>/<pkg>_punknative.md GitHub-flavoured markdown: |
||||
# punk-style synopsis in code fences (ansistripped - exact |
||||
# s-style text), summary/help prose, argument tables in |
||||
# argspace order (GFM tables; no colour - github sanitizes |
||||
# inline styles, so md is the plain-but-faithful skeleton) |
||||
# |
||||
# The ansi2html converter here is deliberately minimal (SGR subset punk::args |
||||
# output uses: reset/bold/dim/italic/underline/strike/reverse, 16-colour, |
||||
# 256-colour, truecolour). If adopted, it belongs in punk::ansi as a proper |
||||
# public api (would also enable 'screenshots' of arbitrary repl output in docs). |
||||
|
||||
lassign [split [info tclversion] .] tcl_major tcl_minor |
||||
#script lives at <projectroot>/src/scriptapps/tools/punkargs_punknative.tcl |
||||
set project_root [file dirname [file dirname [file dirname [file dirname [file dirname [file normalize [info script]/__]]]]]] |
||||
if {![file isdirectory $project_root/src/bootsupport/modules]} { |
||||
puts stderr "cannot locate <projectroot>/src/bootsupport/modules from script location (derived project_root: $project_root)" |
||||
exit 2 |
||||
} |
||||
set original_tmlist [tcl::tm::list] |
||||
tcl::tm::remove {*}$original_tmlist |
||||
tcl::tm::add [file normalize $project_root/src/bootsupport/modules] |
||||
tcl::tm::add [file normalize $project_root/src/bootsupport/modules_tcl$tcl_major] |
||||
tcl::tm::add {*}[lreverse $original_tmlist] |
||||
package require platform |
||||
set arch [platform::generic] |
||||
foreach libdir [list [file normalize $project_root/src/bootsupport/lib] [file normalize $project_root/src/bootsupport/lib/tcl$tcl_major/$arch]] { |
||||
if {$libdir ni $::auto_path} {lappend ::auto_path $libdir} |
||||
} |
||||
package require punk::args |
||||
package require punk::ansi |
||||
|
||||
lassign $argv pkgname outdir |
||||
#-boxmap: heavy box-drawing glyphs (U+2501 etc.) are the punk default and |
||||
#render correctly PROVIDED the css font stack is applied to the pre element |
||||
#itself (the UA stylesheet's 'pre {font-family:monospace}' overrides body |
||||
#inheritance - the original overlong-border bug). The stack includes a |
||||
#heavy-box-capable font on every mainstream platform (Consolas on windows, |
||||
#DejaVu on linux, Menlo on macos), so faithful heavy output is the default. |
||||
#-boxmap light maps heavy/mixed glyphs to the light set (universal coverage |
||||
#in even minimal mono fonts like Courier New) as a portability fallback. |
||||
#Verified 2026-07-13: heavy renders aligned in chrome + firefox with the |
||||
#pre-level font stack. |
||||
set boxmap none |
||||
foreach {k v} [lrange $argv 2 end] { |
||||
switch -- $k { |
||||
-boxmap { |
||||
if {$v ni {light none}} { |
||||
puts stderr "-boxmap must be light or none (got '$v')" |
||||
exit 2 |
||||
} |
||||
set boxmap $v |
||||
} |
||||
default { |
||||
puts stderr "unknown option '$k' (known: -boxmap)" |
||||
exit 2 |
||||
} |
||||
} |
||||
} |
||||
if {$pkgname eq "" || $outdir eq ""} { |
||||
puts stderr "usage: punkargs_punknative.tcl <package> <outdir> ?-boxmap light|none?" |
||||
exit 2 |
||||
} |
||||
set pkgversion [package require $pkgname] |
||||
file mkdir $outdir |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# minimal ansi (SGR) -> html converter |
||||
# --------------------------------------------------------------------------- |
||||
namespace eval ansi2html { |
||||
#16-colour palette (vscode-ish terminal defaults) |
||||
variable pal16 { |
||||
#000000 #cd3131 #0dbc79 #e5e510 #2472c8 #bc3fbc #11a8cd #e5e5e5 |
||||
#666666 #f14c4c #23d18b #f5f543 #3b8eea #d670d6 #29b8db #ffffff |
||||
} |
||||
variable default_fg "#d4d4d4" |
||||
variable default_bg "#1e1e1e" |
||||
|
||||
proc color256 {n} { |
||||
variable pal16 |
||||
if {$n < 16} {return [lindex $pal16 $n]} |
||||
if {$n <= 231} { |
||||
set n [expr {$n - 16}] |
||||
set levels {0 95 135 175 215 255} |
||||
set r [lindex $levels [expr {$n / 36}]] |
||||
set g [lindex $levels [expr {($n % 36) / 6}]] |
||||
set b [lindex $levels [expr {$n % 6}]] |
||||
return [format "#%02x%02x%02x" $r $g $b] |
||||
} |
||||
set v [expr {8 + 10 * ($n - 232)}] |
||||
return [format "#%02x%02x%02x" $v $v $v] |
||||
} |
||||
proc fresh_state {} { |
||||
return [dict create bold 0 dim 0 italic 0 underline 0 strike 0 reverse 0 fg "" bg ""] |
||||
} |
||||
#apply one SGR sequence's parameter list to a state dict |
||||
proc apply_params {state params} { |
||||
variable pal16 |
||||
if {![llength $params]} {set params 0} |
||||
for {set i 0} {$i < [llength $params]} {incr i} { |
||||
set p [lindex $params $i] |
||||
#tolerate leading zeros / empty params |
||||
if {$p eq ""} {set p 0} |
||||
set p [scan $p %d] |
||||
switch -- $p { |
||||
0 {set state [fresh_state]} |
||||
1 {dict set state bold 1} |
||||
2 {dict set state dim 1} |
||||
3 {dict set state italic 1} |
||||
4 {dict set state underline 1} |
||||
7 {dict set state reverse 1} |
||||
9 {dict set state strike 1} |
||||
22 {dict set state bold 0; dict set state dim 0} |
||||
23 {dict set state italic 0} |
||||
24 {dict set state underline 0} |
||||
27 {dict set state reverse 0} |
||||
29 {dict set state strike 0} |
||||
39 {dict set state fg ""} |
||||
49 {dict set state bg ""} |
||||
38 - 48 { |
||||
set target [expr {$p == 38 ? "fg" : "bg"}] |
||||
set mode [lindex $params [incr i]] |
||||
if {$mode == 5} { |
||||
dict set state $target [color256 [lindex $params [incr i]]] |
||||
} elseif {$mode == 2} { |
||||
set r [lindex $params [incr i]] |
||||
set g [lindex $params [incr i]] |
||||
set b [lindex $params [incr i]] |
||||
dict set state $target [format "#%02x%02x%02x" $r $g $b] |
||||
} |
||||
} |
||||
default { |
||||
if {$p >= 30 && $p <= 37} { |
||||
dict set state fg [lindex $pal16 [expr {$p - 30}]] |
||||
} elseif {$p >= 90 && $p <= 97} { |
||||
dict set state fg [lindex $pal16 [expr {$p - 90 + 8}]] |
||||
} elseif {$p >= 40 && $p <= 47} { |
||||
dict set state bg [lindex $pal16 [expr {$p - 40}]] |
||||
} elseif {$p >= 100 && $p <= 107} { |
||||
dict set state bg [lindex $pal16 [expr {$p - 100 + 8}]] |
||||
} |
||||
#other params ignored |
||||
} |
||||
} |
||||
} |
||||
return $state |
||||
} |
||||
proc state_css {state} { |
||||
variable default_fg |
||||
variable default_bg |
||||
set fg [dict get $state fg] |
||||
set bg [dict get $state bg] |
||||
if {[dict get $state reverse]} { |
||||
lassign [list [expr {$bg eq "" ? $default_bg : $bg}] [expr {$fg eq "" ? $default_fg : $fg}]] fg bg |
||||
} |
||||
set css [list] |
||||
if {$fg ne ""} {lappend css "color:$fg"} |
||||
if {$bg ne ""} {lappend css "background-color:$bg"} |
||||
if {[dict get $state bold]} {lappend css "font-weight:bold"} |
||||
if {[dict get $state dim]} {lappend css "opacity:.62"} |
||||
if {[dict get $state italic]} {lappend css "font-style:italic"} |
||||
set deco [list] |
||||
if {[dict get $state underline]} {lappend deco underline} |
||||
if {[dict get $state strike]} {lappend deco line-through} |
||||
if {[llength $deco]} {lappend css "text-decoration:[join $deco { }]"} |
||||
return [join $css ";"] |
||||
} |
||||
proc html_escape {text} { |
||||
return [string map {& & < < > >} $text] |
||||
} |
||||
#map heavy and mixed-weight box-drawing chars to the light set (universal |
||||
#monospace font coverage - avoids browser glyph-fallback width blowout) |
||||
variable lightboxmap { |
||||
━ ─ ┃ │ ┏ ┌ ┓ ┐ ┗ └ ┛ ┘ |
||||
┣ ├ ┫ ┤ ┳ ┬ ┻ ┴ ╋ ┼ |
||||
┡ ├ ┩ ┤ ╇ ┼ ┢ ├ ┪ ┤ ╈ ┼ |
||||
┠ ├ ┨ ┤ ┯ ┬ ┷ ┴ ┿ ┼ ╂ ┼ |
||||
} |
||||
proc to_lightbox {text} { |
||||
variable lightboxmap |
||||
return [string map $lightboxmap $text] |
||||
} |
||||
#convert ANSI text to html (span-styled, for use inside <pre>) |
||||
proc convert {text} { |
||||
set out "" |
||||
set state [fresh_state] |
||||
#split_codes returns alternating plaintext,codes,plaintext,... (codes |
||||
#element may contain several adjacent escape sequences) |
||||
set parts [punk::ansi::ta::split_codes $text] |
||||
set is_pt 1 |
||||
foreach part $parts { |
||||
if {$is_pt} { |
||||
if {$part ne ""} { |
||||
set css [state_css $state] |
||||
if {$css ne ""} { |
||||
append out "<span style=\"$css\">[html_escape $part]</span>" |
||||
} else { |
||||
append out [html_escape $part] |
||||
} |
||||
} |
||||
} else { |
||||
#apply each SGR sequence in the code chunk; ignore non-SGR codes |
||||
foreach {m body} [regexp -all -inline {\x1b\[([0-9;:]*)m} $part] { |
||||
set state [apply_params $state [split [string map {: ;} $body] \;]] |
||||
} |
||||
} |
||||
set is_pt [expr {!$is_pt}] |
||||
} |
||||
return $out |
||||
} |
||||
} |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# shared spec helpers (subset of the doctools converter's) |
||||
# --------------------------------------------------------------------------- |
||||
proc optvalname {optname} {return [string trimleft $optname -]} |
||||
proc is_solo {arginfo} { |
||||
return [expr {"none" in [split [lindex [dict get $arginfo -type] 0] |]}] |
||||
} |
||||
proc typedisplay {arginfo} { |
||||
set t [dict get $arginfo -type] |
||||
return [lindex [split [lindex $t 0] |] 0] |
||||
} |
||||
proc md_escape {text} { |
||||
#escape for GFM table cells: pipes and newlines |
||||
set text [punk::ansi::ansistrip $text] |
||||
set text [string map {| \\| \r\n " " \n " " \r " "} $text] |
||||
return $text |
||||
} |
||||
proc md_prose {text} { |
||||
#reflow to paragraphs: source indentation must not survive - 4-space |
||||
#indented lines are code blocks in markdown (accidental <pre> rendering) |
||||
set text [punk::ansi::ansistrip $text] |
||||
set paras [list] |
||||
set current "" |
||||
foreach ln [split $text \n] { |
||||
if {[string trim $ln] eq ""} { |
||||
if {$current ne ""} {lappend paras $current; set current ""} |
||||
} else { |
||||
append current [string trim $ln] " " |
||||
} |
||||
} |
||||
if {$current ne ""} {lappend paras $current} |
||||
return [join $paras "\n\n"] |
||||
} |
||||
#punk s-style synopsis text (ansistripped), minus the '# summary' preamble line; |
||||
#'## FORM n' headers kept only for multi-form commands |
||||
proc punk_synopsis_text {id nforms} { |
||||
set s [punk::ansi::ansistrip [punk::args::synopsis $id]] |
||||
set keep [list] |
||||
foreach ln [split $s \n] { |
||||
if {[string match "# *" $ln]} {continue} |
||||
if {[string match "## FORM*" $ln] && $nforms < 2} {continue} |
||||
lappend keep $ln |
||||
} |
||||
return [join $keep \n] |
||||
} |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# gather |
||||
# --------------------------------------------------------------------------- |
||||
punk::args::update_definitions [list ::$pkgname] |
||||
set ids [lsort [punk::args::get_ids ::${pkgname}::*]] |
||||
set cmd_ids [list] |
||||
foreach id $ids { |
||||
set tail [string range $id [string length ::${pkgname}::] end] |
||||
if {[string first :: $tail] < 0} {lappend cmd_ids $id} |
||||
} |
||||
if {![llength $cmd_ids]} { |
||||
puts stderr "no punk::args ids found for ::${pkgname}::*" |
||||
exit 1 |
||||
} |
||||
#suffix distinguishes these from doctools-engine renderings of the same package |
||||
set pkgfile "[string map {:: _} $pkgname]_punknative" |
||||
if {$boxmap eq "light"} { |
||||
append pkgfile "_lightbox" |
||||
} |
||||
puts "punk-native docgen: [llength $cmd_ids] command definitions for $pkgname $pkgversion" |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# html: terminal-faithful - ansi2html of punk::args::usage per command |
||||
# --------------------------------------------------------------------------- |
||||
set html "" |
||||
append html "<!DOCTYPE html>\n<html lang=\"en\"><head><meta charset=\"utf-8\">\n" |
||||
append html "<title>$pkgname $pkgversion - punk::args reference</title>\n" |
||||
append html "<style>\n" |
||||
#font stack: fonts with FULL box-drawing coverage (incl. heavy + mixed-weight |
||||
#chars) first - Consolas lacks the heavy set, causing per-glyph fallback at |
||||
#wrong widths (overlong border lines, esp. in chrome). lang=en above also |
||||
#steers chrome away from CJK ambiguous-width (double-width) fallback. |
||||
set fontstack "'Cascadia Mono','Cascadia Code','DejaVu Sans Mono','Noto Sans Mono','JetBrains Mono','Liberation Mono',Consolas,Menlo,monospace" |
||||
append html "body {background:$ansi2html::default_bg; color:$ansi2html::default_fg; font-family:$fontstack;}\n" |
||||
append html "h1,h2 {font-family:inherit; color:#e5e510;}\n" |
||||
#IMPORTANT: pre needs its own font-family - the UA stylesheet's |
||||
#'pre {font-family:monospace}' overrides inheritance from body, so without |
||||
#this the pre renders in the browser's default mono font regardless of the |
||||
#body stack (the original cause of overlong heavy-box border lines) |
||||
append html "pre.punkterm {font-family:$fontstack; line-height:1.15; font-size:13px; overflow-x:auto; padding:8px; background:$ansi2html::default_bg; font-variant-ligatures:none;}\n" |
||||
append html "hr {border:0; border-top:1px solid #444;}\n" |
||||
append html "</style></head><body>\n" |
||||
append html "<h1>$pkgname $pkgversion</h1>\n" |
||||
append html "<p>Command reference generated from punk::args definitions (terminal-faithful rendering).</p>\n" |
||||
foreach id $cmd_ids { |
||||
set cmdname [string trimleft $id :] |
||||
append html "<hr><h2 id=\"[ansi2html::html_escape $cmdname]\">$cmdname</h2>\n" |
||||
set aliastarget [punk::args::get_idalias $id] |
||||
if {$aliastarget ne ""} { |
||||
append html "<p>Takes the same arguments as <b>[ansi2html::html_escape [string trimleft $aliastarget :]]</b> (shared argument definition).</p>\n" |
||||
} |
||||
if {[catch {punk::args::usage $id} u]} { |
||||
append html "<p>(no usage rendering: [ansi2html::html_escape $u])</p>\n" |
||||
continue |
||||
} |
||||
if {$boxmap eq "light"} { |
||||
set u [ansi2html::to_lightbox $u] |
||||
} |
||||
append html "<pre class=\"punkterm\">[ansi2html::convert $u]</pre>\n" |
||||
} |
||||
append html "</body></html>\n" |
||||
set fd [open [file join $outdir $pkgfile.html] w] |
||||
fconfigure $fd -translation lf -encoding utf-8 |
||||
puts -nonewline $fd $html |
||||
close $fd |
||||
puts "wrote [file join $outdir $pkgfile.html] ([string length $html] bytes)" |
||||
|
||||
# --------------------------------------------------------------------------- |
||||
# markdown: GFM - punk-style synopsis fences + argument tables (argspace order) |
||||
# (-boxmap only affects the html rendering - only the default run writes md, |
||||
# so an opt-in heavybox run doesn't duplicate an identical file) |
||||
# --------------------------------------------------------------------------- |
||||
if {$boxmap ne "none"} { |
||||
exit 0 |
||||
} |
||||
proc md_argrow {argname arginfo} { |
||||
set type [md_escape [typedisplay $arginfo]] |
||||
if {[is_solo $arginfo]} {set type "(solo flag)"} |
||||
set default "" |
||||
if {[dict exists $arginfo -default]} {set default [md_escape [dict get $arginfo -default]]} |
||||
if {$default eq ""} {set default " "} |
||||
set multi " " |
||||
if {[dict exists $arginfo -multiple] && [dict get $arginfo -multiple]} {set multi "yes"} |
||||
set help "" |
||||
if {[dict exists $arginfo -help]} {set help [md_escape [dict get $arginfo -help]]} |
||||
set choices [list] |
||||
if {[dict exists $arginfo -choices]} {lappend choices {*}[dict get $arginfo -choices]} |
||||
if {[dict exists $arginfo -choicegroups]} { |
||||
dict for {grp members} [dict get $arginfo -choicegroups] {lappend choices {*}$members} |
||||
} |
||||
if {[llength $choices]} { |
||||
append help " Choices: [md_escape [join $choices {, }]]." |
||||
} |
||||
return "| `[md_escape $argname]` | $type | `$default` | $multi | $help |" |
||||
} |
||||
set md "" |
||||
append md "# $pkgname $pkgversion\n\n" |
||||
append md "Command reference generated from punk::args definitions (punk s-style synopses).\n" |
||||
foreach id $cmd_ids { |
||||
set spec [punk::args::get_spec $id] |
||||
set cmd_info [dict get $spec cmd_info] |
||||
set cmdname [string trimleft $id :] |
||||
append md "\n---\n\n## $cmdname\n\n" |
||||
set aliastarget [punk::args::get_idalias $id] |
||||
if {[dict exists $cmd_info -summary] && [dict get $cmd_info -summary] ne ""} { |
||||
append md "*[md_escape [dict get $cmd_info -summary]]*\n\n" |
||||
} |
||||
set nforms [llength [dict get $spec form_names]] |
||||
append md "```\n[punk_synopsis_text $id $nforms]\n```\n" |
||||
if {$aliastarget ne ""} { |
||||
set atail [string trimleft $aliastarget :] |
||||
set aanchor [string map {:: -} [string tolower $atail]] |
||||
append md "\nTakes the same arguments as \[`$atail`\](#$aanchor) (shared argument definition).\n" |
||||
continue |
||||
} |
||||
if {[dict exists $cmd_info -help] && [dict get $cmd_info -help] ne ""} { |
||||
append md "\n[md_prose [dict get $cmd_info -help]]\n" |
||||
} |
||||
foreach formname [dict get $spec form_names] { |
||||
set form [dict get $spec FORMS $formname] |
||||
if {$nforms > 1} { |
||||
append md "\n**form: $formname**\n" |
||||
} |
||||
set leaders [dict get $form LEADER_NAMES] |
||||
set opts [dict get $form OPT_NAMES] |
||||
set vals [dict get $form VAL_NAMES] |
||||
if {[llength $leaders] + [llength $opts] + [llength $vals] == 0} {continue} |
||||
append md "\n| Arg | Type | Default | Multi | Help |\n" |
||||
append md "| --- | --- | --- | --- | --- |\n" |
||||
#argspace order: leaders, options, trailing values |
||||
foreach argname $leaders { |
||||
append md [md_argrow $argname [dict get $form ARG_INFO $argname]] \n |
||||
} |
||||
foreach optname $opts { |
||||
append md [md_argrow $optname [dict get $form ARG_INFO $optname]] \n |
||||
} |
||||
foreach argname $vals { |
||||
append md [md_argrow $argname [dict get $form ARG_INFO $argname]] \n |
||||
} |
||||
} |
||||
} |
||||
set fd [open [file join $outdir $pkgfile.md] w] |
||||
fconfigure $fd -translation lf -encoding utf-8 |
||||
puts -nonewline $fd $md |
||||
close $fd |
||||
puts "wrote [file join $outdir $pkgfile.md] ([string length $md] bytes)" |
||||
@ -0,0 +1,318 @@
|
||||
# punkargs_to_doctools.tcl - PROTOTYPE (G-? candidate: punk::args as doc source of truth) |
||||
# Generate a doctools .man page for one package from its punk::args definitions. |
||||
# |
||||
# usage: tclsh punkargs_to_doctools.tcl <package> <outfile.man> |
||||
# e.g: tclsh punkargs_to_doctools.tcl punk::path punk_path.man |
||||
# |
||||
# Output is deliberately Tcl-standard doctools style ([arg]/[opt] markup; engines |
||||
# render optionals as ?...? and placeholders italic). Rendering the punk::args |
||||
# s-style synopsis conventions ([...] optionals, <type> placeholders, ANSI |
||||
# styling) is out of scope for the doctools target - doctools engines hardcode |
||||
# the Tcl conventions and cannot carry ANSI. Punk-style output belongs to a |
||||
# separate direct html/markdown pipeline (see punkargs_to_html/markdown |
||||
# prototypes and the assessment discussion 2026-07-13). |
||||
# |
||||
# Trial-quality notes (2026-07-13): |
||||
# - runs against the bootsupport modules (like src/tests/runtests.tcl toplevel) |
||||
# - covers: @cmd summary/help, per-form [call] synopses (leaders/opts/values, |
||||
# solo flags, -multiple, -optional), argument detail lists in argspace order |
||||
# (leaders, then options, then trailing values - matching the synopsis and the |
||||
# punk::args usage table) with -default/-choices/-choicegroups/ |
||||
# -choicerestricted/-choiceprefix/-minsize/-maxsize/-range constraint |
||||
# sentences, id aliases (cross-reference entry), @cmd keywords accumulation |
||||
# - prose is ansistripped (punk::args -help fields can contain literal ESC from |
||||
# %B%/%I% define-time maps) and [ ]-escaped to [lb]/[rb] |
||||
# - NOT yet covered: @examples -> [example], @seealso/@doc -> [see_also]/[uri], |
||||
# choicelabels as sub-lists, grouped choice display, tables (doctools has |
||||
# none), colour (doctools has none) |
||||
|
||||
lassign [split [info tclversion] .] tcl_major tcl_minor |
||||
#script lives at <projectroot>/src/scriptapps/tools/punkargs_to_doctools.tcl |
||||
set project_root [file dirname [file dirname [file dirname [file dirname [file dirname [file normalize [info script]/__]]]]]] |
||||
if {![file isdirectory $project_root/src/bootsupport/modules]} { |
||||
puts stderr "cannot locate <projectroot>/src/bootsupport/modules from script location (derived project_root: $project_root)" |
||||
exit 2 |
||||
} |
||||
set original_tmlist [tcl::tm::list] |
||||
tcl::tm::remove {*}$original_tmlist |
||||
tcl::tm::add [file normalize $project_root/src/bootsupport/modules] |
||||
tcl::tm::add [file normalize $project_root/src/bootsupport/modules_tcl$tcl_major] |
||||
tcl::tm::add {*}[lreverse $original_tmlist] |
||||
package require platform |
||||
set arch [platform::generic] |
||||
foreach libdir [list [file normalize $project_root/src/bootsupport/lib] [file normalize $project_root/src/bootsupport/lib/tcl$tcl_major/$arch]] { |
||||
if {$libdir ni $::auto_path} {lappend ::auto_path $libdir} |
||||
} |
||||
package require punk::args |
||||
package require punk::ansi |
||||
|
||||
lassign $argv pkgname outfile |
||||
if {$pkgname eq "" || $outfile eq ""} { |
||||
puts stderr "usage: punkargs_to_doctools.tcl <package> <outfile.man>" |
||||
exit 2 |
||||
} |
||||
set pkgversion [package require $pkgname] |
||||
|
||||
namespace eval argdoc2man { |
||||
#escape doctools-special brackets in prose; strip ANSI (punk::args -help fields |
||||
#may contain literal ESC sequences from %B%/%I% define-time maps) |
||||
proc prose {text} { |
||||
set text [punk::ansi::ansistrip $text] |
||||
return [string map {[ [lb] ] [rb]} $text] |
||||
} |
||||
#multi-line help -> doctools flowed text with [para] breaks on blank lines |
||||
proc prose_paras {text} { |
||||
set text [prose $text] |
||||
set paras [list] |
||||
set current "" |
||||
foreach ln [split $text \n] { |
||||
if {[string trim $ln] eq ""} { |
||||
if {$current ne ""} {lappend paras $current; set current ""} |
||||
} else { |
||||
append current [string trim $ln] " " |
||||
} |
||||
} |
||||
if {$current ne ""} {lappend paras $current} |
||||
return [join $paras "\n\[para\]\n"] |
||||
} |
||||
#display name for the value an option takes, from its argname |
||||
proc optvalname {optname} { |
||||
return [string trimleft $optname -] |
||||
} |
||||
#primary type word for display (first alternative, first clause member) |
||||
proc typedisplay {arginfo} { |
||||
set t [dict get $arginfo -type] |
||||
set t0 [lindex $t 0] |
||||
set t0 [lindex [split $t0 |] 0] |
||||
return $t0 |
||||
} |
||||
proc is_solo {arginfo} { |
||||
return [expr {"none" in [split [lindex [dict get $arginfo -type] 0] |]}] |
||||
} |
||||
#synopsis markup for one positional (leader or value) argument |
||||
proc positional_markup {form argname} { |
||||
set ainfo [dict get $form ARG_INFO $argname] |
||||
set a "\[arg [list $argname]\]" |
||||
if {[dict exists $ainfo -multiple] && [dict get $ainfo -multiple]} { |
||||
append a " \[opt \[arg [list $argname...]\]\]" |
||||
} |
||||
if {[dict exists $ainfo -optional] && [dict get $ainfo -optional]} { |
||||
set a "\[opt \"$a\"\]" |
||||
} |
||||
return $a |
||||
} |
||||
#build the [call ...] synopsis markup for one form |
||||
proc call_markup {cmdname form} { |
||||
set bits [list] |
||||
foreach argname [dict get $form LEADER_NAMES] { |
||||
lappend bits [positional_markup $form $argname] |
||||
} |
||||
foreach optname [dict get $form OPT_NAMES] { |
||||
set ainfo [dict get $form ARG_INFO $optname] |
||||
if {[is_solo $ainfo]} { |
||||
set a "\[opt \[option [list $optname]\]\]" |
||||
} else { |
||||
set a "\[opt \"\[option [list $optname]\] \[arg [list [optvalname $optname]]\]\"\]" |
||||
} |
||||
lappend bits $a |
||||
} |
||||
foreach argname [dict get $form VAL_NAMES] { |
||||
lappend bits [positional_markup $form $argname] |
||||
} |
||||
return "\[call \[cmd [list $cmdname]\] [join $bits { }]\]" |
||||
} |
||||
#constraint sentences for one argument from its resolved ARG_INFO entry |
||||
proc constraint_sentences {arginfo isopt} { |
||||
set out [list] |
||||
if {[dict exists $arginfo -default]} { |
||||
set def [dict get $arginfo -default] |
||||
if {$def eq ""} {set def "(empty)"} |
||||
lappend out "Defaults to '[prose $def]'." |
||||
} |
||||
set choices [list] |
||||
if {[dict exists $arginfo -choices]} {lappend choices {*}[dict get $arginfo -choices]} |
||||
if {[dict exists $arginfo -choicegroups]} { |
||||
dict for {grp members} [dict get $arginfo -choicegroups] {lappend choices {*}$members} |
||||
} |
||||
if {[llength $choices]} { |
||||
set restricted 1 |
||||
if {[dict exists $arginfo -choicerestricted]} {set restricted [dict get $arginfo -choicerestricted]} |
||||
set s "Choices: [prose [join $choices {, }]]" |
||||
if {!$restricted} {append s " (other values accepted)"} |
||||
if {[dict exists $arginfo -choiceprefix] && [dict get $arginfo -choiceprefix]} { |
||||
append s " (unique prefixes accepted)" |
||||
} |
||||
lappend out "$s." |
||||
} |
||||
if {[dict exists $arginfo -multiple] && [dict get $arginfo -multiple]} { |
||||
if {$isopt} { |
||||
lappend out "May be given multiple times." |
||||
} else { |
||||
lappend out "Accepts multiple values." |
||||
} |
||||
} |
||||
foreach {k label} {-minsize "Minimum size" -maxsize "Maximum size" -range "Range"} { |
||||
if {[dict exists $arginfo $k]} { |
||||
lappend out "$label: [prose [dict get $arginfo $k]]." |
||||
} |
||||
} |
||||
return [join $out " "] |
||||
} |
||||
#help + constraint body for one argument's detail entry |
||||
proc argitem_body {arginfo isopt} { |
||||
set body "" |
||||
if {[dict exists $arginfo -help]} { |
||||
set body [prose_paras [dict get $arginfo -help]] |
||||
} |
||||
set extra [constraint_sentences $arginfo $isopt] |
||||
if {$extra ne ""} { |
||||
if {$body ne ""} {append body "\n\[para\]\n"} |
||||
append body $extra |
||||
} |
||||
if {$body eq ""} {set body "No description."} |
||||
return $body |
||||
} |
||||
#argument detail lists for one form, in argspace order: leaders, options, |
||||
#trailing values (matching the synopsis and the punk::args usage table). |
||||
#Group headings are emitted only when more than one group is present. |
||||
proc arg_details {form} { |
||||
set out "" |
||||
set leaders [dict get $form LEADER_NAMES] |
||||
set opts [dict get $form OPT_NAMES] |
||||
set vals [dict get $form VAL_NAMES] |
||||
set ngroups [expr {([llength $leaders]>0) + ([llength $opts]>0) + ([llength $vals]>0)}] |
||||
if {[llength $leaders]} { |
||||
if {$ngroups > 1} { |
||||
append out "\[para\]\[emph {Leading arguments:}\]\n" |
||||
} |
||||
append out "\[list_begin arguments\]\n" |
||||
foreach argname $leaders { |
||||
set ainfo [dict get $form ARG_INFO $argname] |
||||
append out "\[arg_def [list [typedisplay $ainfo]] [list $argname]\]\n" |
||||
append out [argitem_body $ainfo 0] \n |
||||
} |
||||
append out "\[list_end\]\n" |
||||
} |
||||
if {[llength $opts]} { |
||||
if {$ngroups > 1} { |
||||
append out "\[para\]\[emph {Options:}\]\n" |
||||
} |
||||
append out "\[list_begin options\]\n" |
||||
foreach optname $opts { |
||||
set ainfo [dict get $form ARG_INFO $optname] |
||||
if {[is_solo $ainfo]} { |
||||
append out "\[opt_def [list $optname]\]\n" |
||||
} else { |
||||
append out "\[opt_def [list $optname] \[arg [list [optvalname $optname]]\]\]\n" |
||||
} |
||||
append out [argitem_body $ainfo 1] \n |
||||
} |
||||
append out "\[list_end\]\n" |
||||
} |
||||
if {[llength $vals]} { |
||||
if {$ngroups > 1} { |
||||
append out "\[para\]\[emph {Trailing values:}\]\n" |
||||
} |
||||
append out "\[list_begin arguments\]\n" |
||||
foreach argname $vals { |
||||
set ainfo [dict get $form ARG_INFO $argname] |
||||
append out "\[arg_def [list [typedisplay $ainfo]] [list $argname]\]\n" |
||||
append out [argitem_body $ainfo 0] \n |
||||
} |
||||
append out "\[list_end\]\n" |
||||
} |
||||
return $out |
||||
} |
||||
} |
||||
|
||||
#---- gather definitions for the package ------------------------------------ |
||||
punk::args::update_definitions [list ::$pkgname] |
||||
set ids [lsort [punk::args::get_ids ::${pkgname}::*]] |
||||
#keep the page focused on the package's direct commands: skip ids with further |
||||
#:: segments below the package namespace (sub-ensembles could get their own pages) |
||||
set cmd_ids [list] |
||||
foreach id $ids { |
||||
set tail [string range $id [string length ::${pkgname}::] end] |
||||
if {[string first :: $tail] < 0} { |
||||
lappend cmd_ids $id |
||||
} |
||||
} |
||||
if {![llength $cmd_ids]} { |
||||
puts stderr "no punk::args ids found for ::${pkgname}::*" |
||||
exit 1 |
||||
} |
||||
puts "converting [llength $cmd_ids] command definitions for package $pkgname $pkgversion" |
||||
|
||||
#---- emit doctools ---------------------------------------------------------- |
||||
set man "" |
||||
append man "\[comment {--- generated from punk::args definitions by punkargs_to_doctools.tcl (prototype) - do not edit ---}\]\n" |
||||
append man "\[manpage_begin [list $pkgname] n [list $pkgversion]\]\n" |
||||
append man "\[moddesc {punkshell - generated argdoc}\]\n" |
||||
append man "\[titledesc {Command reference for [list $pkgname] (generated from punk::args definitions)}\]\n" |
||||
append man "\[require [list $pkgname] \[opt [list $pkgversion]\]\]\n" |
||||
append man "\[description\]\n" |
||||
append man "\[para\] Command reference for package [list $pkgname], generated from its punk::args runtime argument definitions.\n" |
||||
append man "\[section Commands\]\n" |
||||
append man "\[list_begin definitions\]\n" |
||||
|
||||
set all_keywords [list] |
||||
foreach id $cmd_ids { |
||||
set spec [punk::args::get_spec $id] |
||||
set cmd_info [dict get $spec cmd_info] |
||||
set cmdname [string trimleft $id :] |
||||
#an id alias is a distinct command sharing another command's definition |
||||
#(e.g punk::path::treefilenames_zipfs -> punk::path::treefilenames): |
||||
#emit its own synopsis under its own name with a cross-reference body, |
||||
#not a full duplicate of the target's documentation |
||||
set aliastarget [punk::args::get_idalias $id] |
||||
if {$aliastarget ne ""} { |
||||
foreach formname [dict get $spec form_names] { |
||||
set form [dict get $spec FORMS $formname] |
||||
append man [argdoc2man::call_markup $cmdname $form] \n |
||||
} |
||||
if {[dict exists $cmd_info -summary] && [dict get $cmd_info -summary] ne ""} { |
||||
append man "\[emph {[argdoc2man::prose [dict get $cmd_info -summary]]}\]\n\[para\]\n" |
||||
} |
||||
append man "Takes the same arguments as \[cmd [list [string trimleft $aliastarget :]]\] (shared argument definition) - see above/below for details.\n" |
||||
continue |
||||
} |
||||
if {[dict exists $cmd_info -name]} { |
||||
set cmdname [dict get $cmd_info -name] |
||||
} |
||||
#one [call] per form |
||||
foreach formname [dict get $spec form_names] { |
||||
set form [dict get $spec FORMS $formname] |
||||
append man [argdoc2man::call_markup $cmdname $form] \n |
||||
} |
||||
#summary + main help |
||||
if {[dict exists $cmd_info -summary] && [dict get $cmd_info -summary] ne ""} { |
||||
append man "\[emph {[argdoc2man::prose [dict get $cmd_info -summary]]}\]\n\[para\]\n" |
||||
} |
||||
if {[dict exists $cmd_info -help] && [dict get $cmd_info -help] ne ""} { |
||||
append man [argdoc2man::prose_paras [dict get $cmd_info -help]] \n "\[para\]\n" |
||||
} |
||||
#argument details per form |
||||
set formnames [dict get $spec form_names] |
||||
foreach formname $formnames { |
||||
set form [dict get $spec FORMS $formname] |
||||
if {[llength $formnames] > 1} { |
||||
append man "\[para\]\[emph \"form: [argdoc2man::prose $formname]\"\]\n" |
||||
} |
||||
append man [argdoc2man::arg_details $form] |
||||
} |
||||
#seealso/keywords accumulate to page level |
||||
foreach kw [dict get $spec keywords_info] { |
||||
if {[dict exists $kw -name]} {lappend all_keywords [dict get $kw -name]} |
||||
} |
||||
} |
||||
append man "\[list_end\]\n" |
||||
if {[llength $all_keywords]} { |
||||
append man "\[keywords [join [lsort -unique $all_keywords] { }]\]\n" |
||||
} |
||||
append man "\[manpage_end\]\n" |
||||
|
||||
set fd [open $outfile w] |
||||
fconfigure $fd -translation lf |
||||
puts -nonewline $fd $man |
||||
close $fd |
||||
puts "wrote $outfile ([string length $man] bytes)" |
||||
Loading…
Reference in new issue