Compare commits
14 Commits
2157c01f6c
...
22ff5cf802
| Author | SHA1 | Date |
|---|---|---|
 Julian Noble
|
22ff5cf802 | 2 weeks ago |
|
Julian Noble
|
5df5f65b4f | 2 weeks ago |
|
Julian Noble
|
60dd6094c7 | 2 weeks ago |
|
Julian Noble
|
c457d4222a | 2 weeks ago |
|
Julian Noble
|
c18ca90a70 | 2 weeks ago |
|
Julian Noble
|
c668cb85c1 | 2 weeks ago |
|
Julian Noble
|
49ec22a928 | 2 weeks ago |
|
Julian Noble
|
4e23a2c373 | 2 weeks ago |
|
Julian Noble
|
6af0fd541e | 2 weeks ago |
|
Julian Noble
|
ce5108cb09 | 2 weeks ago |
|
Julian Noble
|
5da307ebe2 | 2 weeks ago |
|
Julian Noble
|
06db38be46 | 2 weeks ago |
|
Julian Noble
|
7c49fc844e | 2 weeks ago |
|
Julian Noble
|
97ca1ceb1e | 2 weeks ago |
49 changed files with 5944 additions and 230 deletions
@ -0,0 +1,50 @@
|
||||
{ |
||||
"permissions": { |
||||
"allow": [ |
||||
"Bash(tclsh90 src/tests/runtests.tcl *)", |
||||
"Bash(tclsh src/tests/runtests.tcl *)", |
||||
"Bash(/c/Users/sleek/AppData/Local/Apps/Tcl903/bin/tclsh90 src/tests/runtests.tcl *)", |
||||
"Bash(\"C:/Users/sleek/AppData/Local/Apps/Tcl903/bin/tclsh.exe\" src/tests/runtests.tcl *)", |
||||
"Bash(./bin/punk91.exe src/tests/runtests.tcl *)", |
||||
"Bash(tclsh src/make.tcl *)", |
||||
"Bash(tclsh90 src/make.tcl *)", |
||||
"Bash(tclsh87 src/make.tcl *)", |
||||
"Bash(/c/Users/sleek/AppData/Local/Apps/Tcl903/bin/tclsh90 src/make.tcl *)", |
||||
"Bash(\"C:/Users/sleek/AppData/Local/Apps/Tcl903/bin/tclsh.exe\" src/make.tcl *)", |
||||
"Bash(./bin/punk91.exe src/make.tcl *)", |
||||
"Bash(./bin/punk902z.exe src/make.tcl *)", |
||||
"Bash(./bin/punksys.exe src/make.tcl *)", |
||||
"Bash(tclsh scriptlib/developer/goals_lint.tcl *)", |
||||
"Bash(tclsh90 scriptlib/developer/goals_lint.tcl *)", |
||||
"Bash(/c/Users/sleek/AppData/Local/Apps/Tcl903/bin/tclsh90 scriptlib/developer/goals_lint.tcl *)", |
||||
"Bash(\"C:/Users/sleek/AppData/Local/Apps/Tcl903/bin/tclsh.exe\" scriptlib/developer/goals_lint.tcl *)", |
||||
"PowerShell(tclsh scriptlib/developer/goals_lint.tcl *)", |
||||
"PowerShell(tclsh90 scriptlib/developer/goals_lint.tcl *)", |
||||
"PowerShell(& \"C:\\Users\\sleek\\AppData\\Local\\Apps\\Tcl903\\bin\\tclsh90.exe\" scriptlib/developer/goals_lint.tcl *)", |
||||
"PowerShell(tclsh src/make.tcl *)", |
||||
"PowerShell(tclsh90 src/make.tcl *)", |
||||
"PowerShell(& \"C:\\Users\\sleek\\AppData\\Local\\Apps\\Tcl903\\bin\\tclsh90.exe\" src/make.tcl *)", |
||||
"PowerShell(& c:\\repo\\jn\\shellspy\\bin\\punk902z.exe src/make.tcl *)", |
||||
"PowerShell(Get-Process *)", |
||||
"PowerShell(git status *)", |
||||
"PowerShell(git log *)", |
||||
"PowerShell(git diff *)" |
||||
] |
||||
}, |
||||
"hooks": { |
||||
"PreToolUse": [ |
||||
{ |
||||
"matcher": "Bash|PowerShell", |
||||
"hooks": [ |
||||
{ |
||||
"type": "command", |
||||
"command": "cmd=$(jq -r '.tool_input.command // empty'); if printf '%s' \"$cmd\" | grep -qiE '(^|[|;&(]|\\$\\()[[:space:]]*[^|;&[:space:]]*tclsh[0-9.]*(\\.exe)?\"?[[:space:]]+(-encoding[[:space:]]+[^[:space:]]+[[:space:]]+)?-e([[:space:]]|$)'; then printf '%s' '{\"hookSpecificOutput\":{\"hookEventName\":\"PreToolUse\",\"permissionDecision\":\"deny\",\"permissionDecisionReason\":\"tclsh has no -e one-liner flag. An argument starting with - is not treated as a script file: all args land in $argv and tclsh reads commands from stdin instead (hangs forever at an interactive prompt on a console; silently ignores the -e script when stdin is piped). Write the code to a temp .tcl file and run: tclsh path/to/file.tcl - or pipe the script via stdin. See AGENTS.md User Preferences.\"}}'; fi", |
||||
"shell": "bash", |
||||
"timeout": 15, |
||||
"statusMessage": "Checking for tclsh -e misuse" |
||||
} |
||||
] |
||||
} |
||||
] |
||||
} |
||||
} |
||||
@ -0,0 +1,89 @@
|
||||
# G-076 Adopt upstream tcl9 dead-console fix: shared version gate for watchdog and help tcl warning |
||||
|
||||
Status: active |
||||
Scope: src/modules/punk/lib-999999.0a1.0.tm (punk::lib::check), src/modules/punk/repl-999999.0a1.0.tm (repl::start watchdog arming), src/modules/punk/AGENTS.md, src/tests/modules/punk/lib/testsuites/lib/checkbugs.test |
||||
Goal: the tcl9 dead-console defect (upstream ticket f10d91c2d3, root-caused in G-039) is surfaced by 'help tcl' via a has_tclbug_* check, and that check and the repl dead-console watchdog arming share a single version gate, so that runtimes at or past the first released Tcl containing the verified upstream fix neither warn nor arm the watchdog, while all earlier Tcl 9 windows runtimes keep both. |
||||
Acceptance: 'help tcl' on an affected runtime shows the warning with the f10d91c2d3 link and mitigation note; the applicability decision is a pure facts-in/verdict-out classifier proc with tests (libbug_udp_threadexit_applies precedent); repl::start arms the watchdog only when the same classifier reports the runtime affected, with live-console/piped/8.6 behaviour unchanged; the fixed-in constant is set only after the G-039 kill procedure, re-run on a released runtime containing the fix with the watchdog disabled, shows the repl exiting cleanly via the script-visible eof path - until then every Tcl 9 windows runtime is treated as affected. |
||||
|
||||
## Context |
||||
|
||||
G-039 (achieved 2026-07-12, goals/archive/G-039-orphan-console-spin.md) root-caused an orphaned-shell |
||||
CPU spin to a Tcl 9 core defect pair in win/tclWinConsole.c: (a) ConsoleEventProc drops the error/EOF |
||||
notification for a dead console so the script-level fileevent never fires; (b) ConsoleReaderThread |
||||
busy-loops on the persistent error. The script-level mitigation is repl::console_watchdog (punk::repl |
||||
0.5.0). The upstream ticket https://core.tcl-lang.org/tcl/tktview/f10d91c2d3 was filed 2026-07-12 and |
||||
has since been updated upstream with a fix branch in the Tcl repository (observed 2026-07-13). |
||||
|
||||
This goal tracks adoption of the eventual released fix: surfacing the defect through the existing |
||||
'help tcl' has_tclbug_* auto-discovery, and making the watchdog version-conditional so runtimes |
||||
carrying the released fix don't warn and don't arm the probe. |
||||
|
||||
## Approach |
||||
|
||||
- punk::lib::check gains a pure classifier `tclbug_console_deadspin_applies {platform tclversion}` |
||||
(facts in, verdict out, testable - same pattern as libbug_udp_threadexit_applies from G-036, achieved - |
||||
see goals/archive/G-036-tcl9-udp-console-worker-wedge.md) and a |
||||
`has_tclbug_console_deadspin` wrapper returning the standard buginfo dict (bugref f10d91c2d3, |
||||
level major, description noting punkshell's watchdog mitigation). |
||||
- Detection is version-based only: a behavioural probe is impossible (it would require killing a |
||||
console). The classifier compares against a `tclbug_console_deadspin_fixed_in` namespace variable; |
||||
empty means "no fixed release known" and every Tcl 9 windows runtime classifies as affected. |
||||
- repl::start's watchdog arming consults the same classifier as an additional AND-term, so setting |
||||
the fixed-in constant once flips both the 'help tcl' warning and the watchdog together. |
||||
- Error direction is safe: a trunk/dev build carrying the fix under an old-looking patchlevel merely |
||||
arms a harmless 5s read-only probe. |
||||
- The fixed-in flip is deliberately gated on verification, not on the upstream branch: G-039 found |
||||
TWO defects, and the watchdog is only redundant if the notification defect (a) is fixed - i.e. the |
||||
script actually sees EOF on console death. Before setting fixed_in, re-run the G-039 kill |
||||
procedure (documented in the archived detail file) on the fixed released runtime with the watchdog |
||||
disabled and confirm the repl exits via the normal fileevent/eof path. If upstream fixes only the |
||||
spin, the watchdog stays necessary and the check's description changes instead. |
||||
|
||||
## Notes |
||||
|
||||
- G-039 (archived) recorded the reproduction/kill procedure and the two-defect mechanism - see |
||||
goals/archive/G-039-orphan-console-spin.md. Full ticket text with repro scripts: |
||||
TEMP_REFERENCE/tcl9-dead-console-spin-TICKET-DRAFT.md. |
||||
- 8.6 remains out of scope (different console driver; per G-039 user decision 2026-07-12). |
||||
|
||||
## Progress |
||||
|
||||
### 2026-07-13 classifier + help tcl surfacing + watchdog gating (initial increment) |
||||
|
||||
Landed (punk::lib 0.4.2, punk::repl 0.5.1): |
||||
|
||||
- punk::lib::check: `tclbug_console_deadspin_applies {platform tclversion fixed_in}` pure |
||||
classifier + `has_tclbug_console_deadspin` wrapper (bugref f10d91c2d3, level major, description |
||||
notes the punk::repl watchdog mitigation) + gate variable `tclbug_console_deadspin_fixed_in` |
||||
(empty = all Tcl 9 windows affected). |
||||
- repl::start watchdog arming gained the `[dict get [punk::lib::check::has_tclbug_console_deadspin] bug]` |
||||
AND-term; console_watchdog argdoc and src/modules/punk/AGENTS.md note updated. |
||||
- Tests: checkbugs.test +2 (classifier truth table incl. fixed_in comparisons; live-check/classifier |
||||
consistency + bugref). |
||||
|
||||
Verification (2026-07-13, native tclsh 9.0.3 runtests + punk902z kit 9.0.2 in src mode): |
||||
|
||||
- lib checkbugs.test 5/5 pass; repl consolebackends.test 3/3 pass; `make.tcl modules` builds clean. |
||||
- Live check on tclsh 9.0.3: bug=1; setting fixed_in to the running version flips bug=0. |
||||
- `'help tcl' | punk902z src` (piped, PUNK_PIPE_EOF=exit): major warning displayed with |
||||
description, mitigation note and f10d91c2d3 hyperlink. |
||||
|
||||
### 2026-07-13 mitigated/mitigation buginfo axis (punk::lib 0.4.3, punk 0.2.6) |
||||
|
||||
- buginfo dicts gain an optional axis orthogonal to level: `mitigated` boolean + `mitigation` |
||||
text. 'help tcl' renders a triggered mitigated check as "warning level: <level> (mitigated)" |
||||
in subdued grey (term-grey foreground) instead of the level colour, with an indented |
||||
"mitigated: <text>" block; unmitigated warnings render unchanged. |
||||
- has_tclbug_console_deadspin populates it: mitigated when punk::repl >= 0.5.0 is available to |
||||
the runtime (version discovery without loading, udp-check precedent), mitigation text noting |
||||
the watchdog scope (non-repl console reads remain exposed). Severity stays major. |
||||
- checkbugs.test extended (axis key presence/boolean/consistency rules incl. the generic |
||||
every-check sweep); 5/5 pass under native tclsh 9.0.3. Piped `'help tcl' | punk902z src` |
||||
verified: grey (38;5;8 fg) mitigated rendering with mitigation block and ticket hyperlink. |
||||
|
||||
Remaining for acceptance: |
||||
|
||||
- When a released Tcl contains the merged upstream fix: re-run the G-039 kill procedure on that |
||||
runtime with the watchdog disabled, confirm clean script-visible eof exit, then set |
||||
`punk::lib::check::tclbug_console_deadspin_fixed_in` to that version (one edit flips both |
||||
consumers) and update the AGENTS.md note. |
||||
@ -0,0 +1,21 @@
|
||||
# G-077 punk executable -e one-liner support: make the tclsh-agent instinct work |
||||
|
||||
Status: proposed |
||||
Scope: src/vfs/_config/punk_main.tcl (top-level arg dispatch), src/lib/app-punkscript/punkscript.tcl (script subcommand arg forms), src/tests/shell/testsuites/punkexe/scriptexec.test |
||||
Goal: `<punkexe> -e <script> ?args...?` and `<punkexe> script -e <script> ?args...?` execute the given Tcl code as a one-liner (args after the script land in `::argv`, `::argv0` = `-e`, non-interactive), so the -e reflex agents carry over from perl/python/node works on punk kits instead of erroring - while stock-tclsh misparse behaviour (argv-swallow + stdin read) is never reproduced. |
||||
Acceptance: `punksys -e {puts hi}` and `punk902z script -e {puts hi}` print hi and exit 0 with and without piped stdin present (the one-liner may itself read stdin); a -e with no following script argument is a usage error, never an interactive fall-through; error in the one-liner prints errorInfo to stderr and exits 1 (matching the script subcommand's file form); scriptexec.test covers the above against the built executable. |
||||
|
||||
## Context |
||||
|
||||
Agents and harnesses habitually try `tclsh -e "script"` (the one-liner reflex from perl/python/node). |
||||
Stock tclsh has no such flag: only `-encoding name` is recognised, and any other leading-dash |
||||
argument is not treated as a script file - all arguments land in `$argv` and tclsh reads commands |
||||
from stdin instead (hangs at an interactive prompt on a console; silently ignores the supposed |
||||
one-liner when stdin is piped). Root `AGENTS.md` User Preferences documents the pitfall and a |
||||
claude-harness PreToolUse hook (`.claude/settings.json`) denies such invocations with corrective |
||||
guidance. |
||||
|
||||
The punk kits currently fail fast instead (`punk script: script file not found: '-e'`) but offer |
||||
no one-liner form. This goal makes the instinct work on punk executables, removing the failure |
||||
class for the kits entirely. app-punkscript's existing stdin form already provides the execution |
||||
scaffolding (argv0/argv setup, errorInfo-to-stderr, exit-code discipline). |
||||
@ -0,0 +1,20 @@
|
||||
# G-078 punk::ansi ANSI->HTML rendering api (developer-surfaced, documented) |
||||
|
||||
Status: proposed |
||||
Scope: src/modules/punk/ansi-999999.0a1.0.tm (or a new punk::ansi::html module), src/scriptapps/tools/punkargs_punknative.tcl + scratch prototypes (ansi2html_core.tcl, ansicat_gallery.tcl) as reference implementations to be retired into consumers, src/scriptapps/tools/fontprep/ (asset + geometry contract), new testsuite under src/tests/modules/punk/ansi/ |
||||
Goal: a documented public api converting ANSI/SGR text to html: a fragment converter (spans for a `<pre>`) plus a page assembler with `-assets embed|link|none` (punkdoc-mono data-uri / relative file / stack-only), `-palette vga|campbell|vscode|<list>` (16-colour table - classic art needs VGA where SGR 33 is brown), art mode (bold-as-bright for basic colours, no font-weight, solid-block background sealing, tight pitch + scaleY aspect correction per the settled recipe) and doc mode (text-oriented pitch), and a headless flatten entry for files/captures (ansicat semantics - cursor movement/wrap/SAUCE/cp437 - without repl/console dependencies). |
||||
Acceptance: renders the prototype corpus (src/testansi gallery samples incl. octants, textblock::periodic, punk::args::usage tables) with parity to the settled recipe; runs headless in a plain tclsh with declared package deps only (no punk::console load, no fcat/global-alias assumptions); covered by tests incl. SGR state-machine cases (reset/bold/dim/italic/underline/reverse, 16/256/truecolour, bold-as-bright) and an artifact pin of a small converted sample; the scriptapps prototypes become thin consumers of the api. |
||||
|
||||
## Context |
||||
|
||||
Prototyped 2026-07-13/14 (scratch/argdoc2man-trial-2026-07-13). The settled empirical |
||||
recipe and its rejected alternatives (larger row pitches, font line-metric |
||||
normalization - wrong-coloured bleed bars) are recorded in |
||||
src/scriptapps/tools/fontprep/README.md and the prototype comments; cell geometry |
||||
contract: punkdoc-mono advance exactly 0.5859375em (integer 9px cells at |
||||
font-size 15.36px), blocks paint the 1.3213em win cell, art aspect restored via |
||||
transform:scaleY(1.3212890625) over a line-height:1.0 layout. |
||||
This api is also the docs-screenshot enabler (ansicat/textblock output embedded in |
||||
generated documentation) identified in the punk::args-as-doc-source-of-truth |
||||
assessment. Related: G-079 (default-colour semantics), G-080 (deterministic |
||||
cell-grid mode), G-081 (docs build pipeline consumer). |
||||
@ -0,0 +1,17 @@
|
||||
# G-079 default-colour semantics through renderspace/flattened output |
||||
|
||||
Status: proposed |
||||
Scope: src/modules/overtype-999999.0a1.0.tm (renderspace/renderline replay-code emission), punk::ansi flatten consumers (ansicat), ansi2html consumer mapping (G-078) |
||||
Goal: flattened/rendered ANSI output preserves "default foreground/background" as a semantic value (SGR 39/49 or absence) instead of baking in explicit colours (replay/overlay output currently emits literal `0;40` - black background - for cells whose background was never set). Consumers can then map defaults to their own backdrop: html pages theme-match any page background, terminal replays keep the user's colour scheme. |
||||
Acceptance: ansicat/usage flattened output for content that never sets a background contains no explicit SGR 40/black-bg codes for those cells; the punk-native html pages render example-helper top/bottom bars (e.g. grepstr @cmd -help examples) blending with a NON-black page background with no contrasting bars; existing terminal display output is visually unchanged (regression-checked against current renderings). |
||||
|
||||
## Context |
||||
|
||||
Found 2026-07-14 while reviewing the punk::ansi punknative doc page: example blocks |
||||
produced by the punk::ansi example helper show bars whose "background half" rendered |
||||
as black boxes contrasting with a grey page. Probe evidence: renderspace overlay |
||||
replay emits `replay_codes_overlay: ESC[0;40m`. Interim workaround (shipped in the |
||||
punknative generator): the `<pre>` backdrop is hard black so baked-black blends - |
||||
this constrains doc page theming and leaves lighter antialiasing seams at half-block |
||||
edges against non-matching content. Proper fix is upstream in the renderer's |
||||
replay-code model, then a `-defaultbg`/`-defaultfg` mapping option in the G-078 api. |
||||
@ -0,0 +1,18 @@
|
||||
# G-080 deterministic cell-grid html rendering mode (seamless block art) |
||||
|
||||
Status: proposed |
||||
Scope: the G-078 punk::ansi html api (additional rendering mode); scratch prototypes as baseline |
||||
Goal: an optional rendering mode that emulates the terminal cell grid explicitly - each styled run emitted as inline-block with exact integer-px cell width/height, inner line-height equal to the cell, overflow hidden, vertical-align top (newlines outside spans) - making row/column geometry fully deterministic instead of dependent on font metrics, inline-background box heights and sub-pixel glyph rasterization. Optionally decompose half-block cells (U+2580/2584/258C/2590 and quadrants) into sized background rectangles for complete seam-proofing. |
||||
Acceptance: the testansi gallery samples show no vertical or horizontal seams in chrome and firefox at 100%/125%/150% zoom (the residual shade/half-block seams accepted in the span-mode recipe are eliminated); cost (page size, loss of text selectability granularity if any) measured and documented; span mode remains the default with cell-grid selectable per block. |
||||
|
||||
## Context |
||||
|
||||
The 2026-07-14 seam investigation (scratch/argdoc2man-trial-2026-07-13/seam_compare.tcl) |
||||
settled a span-mode recipe (integer 9px advance, tight pitch + scaleY aspect, solid-block |
||||
background sealing, integer 17px doc pitch) that reduces but cannot eliminate seams: |
||||
shade (U+2591-2593) and half-block glyph edges still antialias against differing |
||||
neighbours at fractional device-pixel positions (display scaling), and inline background |
||||
box height is a font-metric browsers don't agree on (metric normalization was tried and |
||||
rejected - see fontprep/README.md). Cell-grid emulation removes every one of those |
||||
degrees of freedom at the cost of heavier markup. Only worth building if/when the |
||||
accepted residual seams stop passing review - the glance test passes today. |
||||
@ -0,0 +1,18 @@
|
||||
# G-081 punk::args documentation build pipeline (dev doc.* integration) |
||||
|
||||
Status: proposed |
||||
Scope: src/modules/punk/mix/commandset/doc-999999.0a1.0.tm (doc.* commandset - new generation subcommands), src/scriptapps/tools/punkargs_to_doctools.tcl + punkargs_punknative.tcl (prototypes to productize), src/scriptapps/tools/fontprep/ (shared doc-set asset in link mode), src/doc tree conventions, src/tests coverage |
||||
Goal: 'dev doc.*' generates the external documentation set from punk::args definitions as the source of truth, per package, against the DEV modules (src/modules 999999 versions - not bootsupport snapshots): (a) doctools .man output (Tcl-standard synopsis conventions) validated via dev doc.validate/dtplite and feeding the existing kettle machinery; (b) punk-native html via the G-078 api with a shared punkdoc-mono.woff2 + css (assets link mode, one cached font per doc set) and (c) GFM markdown. Includes the productization items the prototypes deferred: per-form arg tables without repeated panels (prototype has a trim heuristic - production should render per-form tables directly from the spec), deeper-namespace/ensemble command pages (e.g. punk::ansi::ansistring - the prototypes' one-level namespace filter skips them), module/package-level info at page top once G-075 surfaces @package ids, large choice sets as structured lists in markdown, and doctools emitter gaps (@examples -> [example], @seealso/@doc -> [see_also]/[uri], choicelabels). |
||||
Acceptance: a doc.* subcommand generates all three formats for a nominated package list from dev modules in one run; doctools output validates clean (dtplite) and html pages carry the shared font/css by reference; deeper-namespace registered ids appear on the owning package's page (or their own); output tree location and vcs policy decided and documented (generated-vs-committed); at least punk::path + punk::ansi + one ensemble-rich package covered by a regression pin. |
||||
|
||||
## Context |
||||
|
||||
Follows the 2026-07-13 assessment (punk::args -> doctools expressibility) and trials: |
||||
punkargs_to_doctools.tcl (doctools, Tcl-standard by decision - punk s-style is out of |
||||
scope for that target) and punkargs_punknative.tcl (terminal-faithful html + markdown) |
||||
both work per-package against bootsupport modules, invoked manually. The doctools |
||||
comment blocks in source remain interim until this pipeline is validated, after which |
||||
worthwhile prose migrates into punk::args blocks (original long-term plan). dtplite |
||||
validation infrastructure (bin/dtplite.cmd + dev doc.validate) is in place. |
||||
Related: G-075 (@package ids), G-078 (html api), G-079 (default colours), G-014/G-068 |
||||
(argdoc/moduledoc workflows). |
||||
@ -1,4 +1,4 @@
|
||||
[project] |
||||
name = "punkshell" |
||||
version = "0.12.20" |
||||
version = "0.12.23" |
||||
license = "BSD-2-Clause" |
||||
|
||||
@ -1,27 +1,42 @@
|
||||
# -*- tcl -*- |
||||
|
||||
# @@ Meta Begin |
||||
# Application dtplite 1.0.5 |
||||
# Meta platform tcl |
||||
# Meta summary Lightweight DocTools Processor |
||||
# Meta description This application is a simple processor |
||||
# Meta description for documents written in the doctools |
||||
# Meta description markup language. It covers the most |
||||
# Meta description common use cases, but is not as |
||||
# Meta description configurable as its big brother dtp. |
||||
# Meta category Processing doctools documents |
||||
# Meta subject doctools doctoc docidx |
||||
# Meta require {dtplite 1.0.5} |
||||
# Meta author Andreas Kupries |
||||
# Meta license BSD |
||||
# @@ Meta End |
||||
|
||||
package require dtplite 1.0.5 |
||||
|
||||
# dtp lite - Lightweight DocTools Processor |
||||
# ======== = ============================== |
||||
|
||||
exit [dtplite::do $argv] |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
exit |
||||
# -*- tcl -*- |
||||
|
||||
# @@ Meta Begin |
||||
# Application dtplite 1.0.5 |
||||
# Meta platform tcl |
||||
# Meta summary Lightweight DocTools Processor |
||||
# Meta description This application is a simple processor |
||||
# Meta description for documents written in the doctools |
||||
# Meta description markup language. It covers the most |
||||
# Meta description common use cases, but is not as |
||||
# Meta description configurable as its big brother dtp. |
||||
# Meta category Processing doctools documents |
||||
# Meta subject doctools doctoc docidx |
||||
# Meta require {dtplite 1.0.5} |
||||
# Meta author Andreas Kupries |
||||
# Meta license BSD |
||||
# @@ Meta End |
||||
|
||||
if {[catch {package require dtplite 1.0.5}]} { |
||||
# Fall back to the project-vendored tcllib (pure Tcl) when the invoking |
||||
# tclsh has no tcllib installed. Works both unwrapped (src/scriptapps/dtplite.tcl) |
||||
# and wrapped (<projectroot>/bin/dtplite.cmd) - each is one level below a folder |
||||
# containing (or sibling to) src/vendorlib_tcl9/<arch>/tcllib<ver> |
||||
set selfdir [file dirname [file dirname [file normalize [info script]/__]]] |
||||
foreach libdir [glob -nocomplain -types d -directory $selfdir\ |
||||
../vendorlib_tcl9/*/tcllib*\ |
||||
../src/vendorlib_tcl9/*/tcllib*] { |
||||
set libdir [file normalize $libdir] |
||||
if {$libdir ni $::auto_path} { |
||||
lappend ::auto_path $libdir |
||||
} |
||||
} |
||||
package require dtplite 1.0.5 |
||||
} |
||||
|
||||
# dtp lite - Lightweight DocTools Processor |
||||
# ======== = ============================== |
||||
|
||||
exit [dtplite::do $argv] |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
exit |
||||
|
||||
@ -0,0 +1,15 @@
|
||||
[application] |
||||
template="punk.multishell.cmd" |
||||
as_admin=false |
||||
|
||||
scripts=[ |
||||
"dtplite.tcl", |
||||
] |
||||
|
||||
default_outputfile="dtplite.cmd" |
||||
default_nextshellpath="/usr/bin/env tclsh" |
||||
default_nextshelltype="tcl" |
||||
|
||||
win32.nextshellpath="tclsh" |
||||
win32.nextshelltype="tcl" |
||||
win32.outputfile="dtplite.cmd" |
||||
@ -0,0 +1,94 @@
|
||||
Copyright (c) 2019 - Present, Microsoft Corporation, |
||||
with Reserved Font Name Cascadia Code. |
||||
|
||||
This Font Software is licensed under the SIL Open Font License, Version 1.1. |
||||
This license is copied below, and is also available with a FAQ at: |
||||
http://scripts.sil.org/OFL |
||||
|
||||
|
||||
----------------------------------------------------------- |
||||
SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 |
||||
----------------------------------------------------------- |
||||
|
||||
PREAMBLE |
||||
The goals of the Open Font License (OFL) are to stimulate worldwide |
||||
development of collaborative font projects, to support the font creation |
||||
efforts of academic and linguistic communities, and to provide a free and |
||||
open framework in which fonts may be shared and improved in partnership |
||||
with others. |
||||
|
||||
The OFL allows the licensed fonts to be used, studied, modified and |
||||
redistributed freely as long as they are not sold by themselves. The |
||||
fonts, including any derivative works, can be bundled, embedded, |
||||
redistributed and/or sold with any software provided that any reserved |
||||
names are not used by derivative works. The fonts and derivatives, |
||||
however, cannot be released under any other type of license. The |
||||
requirement for fonts to remain under this license does not apply |
||||
to any document created using the fonts or their derivatives. |
||||
|
||||
DEFINITIONS |
||||
"Font Software" refers to the set of files released by the Copyright |
||||
Holder(s) under this license and clearly marked as such. This may |
||||
include source files, build scripts and documentation. |
||||
|
||||
"Reserved Font Name" refers to any names specified as such after the |
||||
copyright statement(s). |
||||
|
||||
"Original Version" refers to the collection of Font Software components as |
||||
distributed by the Copyright Holder(s). |
||||
|
||||
"Modified Version" refers to any derivative made by adding to, deleting, |
||||
or substituting -- in part or in whole -- any of the components of the |
||||
Original Version, by changing formats or by porting the Font Software to a |
||||
new environment. |
||||
|
||||
"Author" refers to any designer, engineer, programmer, technical |
||||
writer or other person who contributed to the Font Software. |
||||
|
||||
PERMISSION & CONDITIONS |
||||
Permission is hereby granted, free of charge, to any person obtaining |
||||
a copy of the Font Software, to use, study, copy, merge, embed, modify, |
||||
redistribute, and sell modified and unmodified copies of the Font |
||||
Software, subject to the following conditions: |
||||
|
||||
1) Neither the Font Software nor any of its individual components, |
||||
in Original or Modified Versions, may be sold by itself. |
||||
|
||||
2) Original or Modified Versions of the Font Software may be bundled, |
||||
redistributed and/or sold with any software, provided that each copy |
||||
contains the above copyright notice and this license. These can be |
||||
included either as stand-alone text files, human-readable headers or |
||||
in the appropriate machine-readable metadata fields within text or |
||||
binary files as long as those fields can be easily viewed by the user. |
||||
|
||||
3) No Modified Version of the Font Software may use the Reserved Font |
||||
Name(s) unless explicit written permission is granted by the corresponding |
||||
Copyright Holder. This restriction only applies to the primary font name as |
||||
presented to the users. |
||||
|
||||
4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font |
||||
Software shall not be used to promote, endorse or advertise any |
||||
Modified Version, except to acknowledge the contribution(s) of the |
||||
Copyright Holder(s) and the Author(s) or with their explicit written |
||||
permission. |
||||
|
||||
5) The Font Software, modified or unmodified, in part or in whole, |
||||
must be distributed entirely under this license, and must not be |
||||
distributed under any other license. The requirement for fonts to |
||||
remain under this license does not apply to any document created |
||||
using the Font Software. |
||||
|
||||
TERMINATION |
||||
This license becomes null and void if any of the above conditions are |
||||
not met. |
||||
|
||||
DISCLAIMER |
||||
THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, |
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF |
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT |
||||
OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE |
||||
COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, |
||||
INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL |
||||
DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING |
||||
FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM |
||||
OTHER DEALINGS IN THE FONT SOFTWARE. |
||||
@ -0,0 +1,87 @@
|
||||
# fontprep - punkdoc-mono web font for the punk-native documentation pipeline |
||||
|
||||
`punkdoc-mono.woff2` is the pinned monospace web font consumed by the |
||||
punk-native html doc generation (`../punkargs_punknative.tcl` and its |
||||
successors). It exists because the ansi->html rendering of punk::args usage |
||||
tables, textblock output and cp437/ansi art (src/testansi) needs glyphs - |
||||
Unicode 16 octants (U+1CC00-1CEBF) and Symbols for Legacy Computing |
||||
(U+1FB00-1FBFF) in particular - that are absent from the monospace fonts |
||||
commonly installed on reader machines. Coverage was measured empirically: |
||||
see the glyph inventory probe notes below. |
||||
|
||||
## What it is |
||||
|
||||
A glyph subset of **Cascadia Mono v2404.23** (variable font, `wght` axis |
||||
200-700 retained so browsers render true bold from this single file), |
||||
renamed to **punkdoc-mono**. Line metrics are STOCK (hhea/typo ascent 1900 / |
||||
descent 480; win ascent 2226 / descent 480). |
||||
|
||||
Cell geometry for css authors: advance = 0.5859375 em exactly (font-size |
||||
15.36px -> integer 9px cell width - integer cell widths avoid vertical seams |
||||
at styled-span boundaries). Block-element glyphs paint -480..2226 units = |
||||
1.3212890625 em (they fill the WINDOWS cell, which is the conhost/windows |
||||
terminal cell height). NOTE - rejected experiment (2026-07-14, see the |
||||
commented-out normalize_line_metrics in make_punkdoc_mono.py): setting |
||||
hhea/typo equal to the win metrics makes browsers' inline content area |
||||
1.3213em, and at row pitches below that every span's BACKGROUND bleeds ~2.5px |
||||
into neighbouring rows (wrong-coloured bars under solid blocks). Empirically |
||||
the best block-art rendering is stock metrics with a tight row pitch |
||||
(line-height:1.0) - optionally aspect-corrected with a transform:scaleY of |
||||
1.3212890625 applied to the whole rendering. |
||||
|
||||
- Renaming is REQUIRED, not cosmetic: Cascadia's SIL OFL 1.1 licence declares |
||||
the Reserved Font Name "Cascadia Code", and a modified version (subsetting |
||||
is modification) must not use it. `punkdoc-mono` avoids the Cascadia name |
||||
entirely. The font's embedded name table carries the original Microsoft |
||||
copyright (nameID 0, preserved verbatim as the OFL requires), the OFL |
||||
licence statement/url (nameID 13/14), and a provenance description |
||||
(nameID 10). The original trademark record was removed (a renamed copy must |
||||
not assert Microsoft's trademark). |
||||
- Licence: SIL OFL 1.1 - full text in `LICENSE-cascadia-OFL.txt` (fetched from |
||||
the v2404.23 source tag). The OFL applies to the font only; it places no |
||||
conditions on punkshell (BSD) or on documents rendered with the font. |
||||
Track in the project licence inventory (G-063). |
||||
- No italic face is included: browsers synthesize oblique for italic spans |
||||
(advance widths are preserved, so terminal-grid alignment holds). |
||||
|
||||
## Provenance (reproducibility) |
||||
|
||||
- Source: https://github.com/microsoft/cascadia-code/releases/download/v2404.23/CascadiaCode-2404.23.zip |
||||
- release zip sha256: A911410626C0E09D03FA3FDDA827188FDA96607DF50FECC3C5FEE5906E33251B |
||||
- input file within zip: ttf/CascadiaMono.ttf (variable) |
||||
- input ttf sha256: 056F33BA2D9DA954750320EC6ECFB7D83CFB5F93AD593722170CD4498F5D4E95 |
||||
- Tooling: python fonttools 4.63.0 + brotli (one-time prep only - the doc |
||||
BUILD never invokes python; it just reads/copies/base64s the .woff2) |
||||
- Command: |
||||
`python make_punkdoc_mono.py CascadiaMono.ttf punkdoc-unicodes.txt <outdir>` |
||||
- Output punkdoc-mono.woff2 sha256: EE068E60E0BE6D96FC97D79123DE3B1A9A35205136A4A5C97648BCA2D9A24DB6 |
||||
(1561 cmap codepoints, 4319 glyphs, 79744 bytes) |
||||
Builds are byte-reproducible: the prep script loads with |
||||
recalcTimestamp=False so head.modified stays that of the source font |
||||
(verified: two consecutive builds hash identically). |
||||
|
||||
## Subset ranges |
||||
|
||||
`punkdoc-unicodes.txt` - whole blocks (with headroom) covering the demand |
||||
measured 2026-07-13 by the glyph inventory probe (scratch trial folder |
||||
argdoc2man-trial-2026-07-13: glyph_inventory.tcl over src/testansi decoded as |
||||
ansicat does + textblock::periodic + all textblock frametypes + |
||||
punk::args::usage = 160 unique non-ascii codepoints), plus the full CP437 |
||||
repertoire and braille (U+2800-28FF) for future plot rendering. |
||||
Verified: the subset covers 157/160 of the measured inventory - identical to |
||||
the full source font. The 3 misses are deliberate non-goals: em-space U+2003 |
||||
(converters should normalize exotic spaces to plain spaces - terminals treat |
||||
them as one cell) and fullwidth forms U+FF30/FF31 (inherently double-width; |
||||
CJK-font fallback territory). |
||||
|
||||
## Regenerating (when the glyph domain grows) |
||||
|
||||
1. Re-run the glyph inventory probe over the current content; if new |
||||
codepoints fall outside `punkdoc-unicodes.txt`, widen the ranges. |
||||
2. `pip install fonttools brotli` (any machine; a venv is fine) |
||||
3. Fetch the pinned Cascadia release (or a newer one - update shas here) |
||||
4. Run the command above; verify coverage (e.g. via |
||||
Windows.Media.GlyphTypeface against the inventory - see font_coverage.ps1 |
||||
in the trial scratch folder) and that name records contain no "Cascadia" |
||||
outside the nameID 10 provenance credit. |
||||
5. Commit the new .woff2 together with updated shas in this README. |
||||
@ -0,0 +1,145 @@
|
||||
#!/usr/bin/env python3 |
||||
"""make_punkdoc_mono.py - one-time font-prep for the punkshell doc pipeline. |
||||
|
||||
Subsets the Cascadia Mono VARIABLE font (weight axis kept, so browsers get |
||||
true bold from one file) to the punkdoc unicode ranges, renames the family to |
||||
'punkdoc-mono' (REQUIRED: Cascadia's OFL declares Reserved Font Name |
||||
'Cascadia Code' - a modified version must not use the reserved name), and |
||||
writes woff2 (for the web) + ttf (for cmap verification tooling). |
||||
|
||||
usage: python make_punkdoc_mono.py <CascadiaMono.ttf> <unicodes.txt> <outdir> |
||||
""" |
||||
import sys |
||||
import os |
||||
from fontTools import version as fonttools_version |
||||
from fontTools.ttLib import TTFont |
||||
from fontTools.subset import Subsetter, Options |
||||
|
||||
SRC_FAMILY_NAMES = ["Cascadia Mono", "CascadiaMono", "Cascadia Code", "CascadiaCode"] |
||||
NEW_FAMILY = "punkdoc-mono" |
||||
|
||||
def parse_unicodes(path): |
||||
cps = set() |
||||
with open(path, encoding="utf-8") as f: |
||||
for line in f: |
||||
line = line.strip() |
||||
if not line or line.startswith("#"): |
||||
continue |
||||
if "-" in line: |
||||
lo, hi = line.split("-") |
||||
cps.update(range(int(lo, 16), int(hi, 16) + 1)) |
||||
else: |
||||
cps.add(int(line, 16)) |
||||
return cps |
||||
|
||||
# name records that carry the FAMILY NAME and must be renamed (OFL Reserved |
||||
# Font Name requirement). Copyright (0), designer/vendor credits (8,9,11,12) |
||||
# are preserved untouched - the OFL requires the copyright notice be retained. |
||||
FAMILY_NAME_IDS = (1, 3, 4, 6, 16, 17, 21, 22, 25) |
||||
OFL_ID13 = ("This Font Software is licensed under the SIL Open Font License, " |
||||
"Version 1.1.") |
||||
PROVENANCE_ID10 = ("punkdoc-mono is a glyph subset of Cascadia Mono v2404.23 " |
||||
"(c) Microsoft Corporation, renamed as required by the SIL " |
||||
"OFL 1.1 Reserved Font Name condition. Prepared for the " |
||||
"punkshell documentation pipeline.") |
||||
|
||||
def rename(font): |
||||
name = font["name"] |
||||
keep = [] |
||||
for rec in name.names: |
||||
# drop the trademark record entirely: the original text is about the |
||||
# Cascadia name (which this font no longer uses) and a renamed copy |
||||
# must not assert Microsoft's trademark over the new name |
||||
if rec.nameID == 7: |
||||
continue |
||||
if rec.nameID in FAMILY_NAME_IDS: |
||||
s = rec.toUnicode() |
||||
for old in SRC_FAMILY_NAMES: |
||||
s = s.replace(old, NEW_FAMILY) |
||||
s = s.replace(old.replace(" ", ""), NEW_FAMILY) |
||||
if rec.nameID == 6: |
||||
s = s.replace(" ", "") |
||||
rec.string = s |
||||
elif rec.nameID == 13: |
||||
rec.string = OFL_ID13 |
||||
keep.append(rec) |
||||
name.names = keep |
||||
# embedded provenance/description (mentioning the source font as credit is |
||||
# permitted - the RFN restriction is on naming the font, not attribution) |
||||
for platformID, platEncID, langID in ((3, 1, 0x409), (1, 0, 0)): |
||||
name.setName(PROVENANCE_ID10, 10, platformID, platEncID, langID) |
||||
|
||||
def normalize_line_metrics(font): |
||||
"""Make every line-metric set equal the WINDOWS metrics. |
||||
|
||||
Cascadia draws its block-element glyphs to fill the windows cell |
||||
(usWinAscent + usWinDescent = 2706/2048 = 1.3213em) - that box IS the |
||||
terminal cell. But hhea/typo metrics are smaller (2380 units), and |
||||
browsers differ in which set they use for the inline content area, so |
||||
inline backgrounds and 'line-height: normal' vary per browser and can |
||||
leave uncovered bands between rows of block art. |
||||
Setting hhea == typo == win (and the USE_TYPO_METRICS flag) makes the |
||||
content area equal the block paint extent everywhere: with css |
||||
line-height <= 1.3213em, adjacent rows' inline backgrounds and block |
||||
glyphs overlap slightly and horizontal seams become impossible. |
||||
""" |
||||
hhea = font["hhea"] |
||||
os2 = font["OS/2"] |
||||
win_asc = os2.usWinAscent |
||||
win_desc = os2.usWinDescent |
||||
hhea.ascent = win_asc |
||||
hhea.descent = -win_desc |
||||
hhea.lineGap = 0 |
||||
os2.sTypoAscender = win_asc |
||||
os2.sTypoDescender = -win_desc |
||||
os2.sTypoLineGap = 0 |
||||
os2.fsSelection |= 0x80 # USE_TYPO_METRICS |
||||
print(f"line metrics normalized to win: ascent {win_asc} descent {win_desc} " |
||||
f"(cell {(win_asc+win_desc)/font['head'].unitsPerEm:.6f} em)") |
||||
|
||||
def main(): |
||||
src, unifile, outdir = sys.argv[1], sys.argv[2], sys.argv[3] |
||||
os.makedirs(outdir, exist_ok=True) |
||||
cps = parse_unicodes(unifile) |
||||
print(f"fonttools {fonttools_version}; requested codepoints: {len(cps)}") |
||||
|
||||
#recalcTimestamp=False keeps the source font's head.modified so rebuilds |
||||
#from the same input are byte-reproducible |
||||
font = TTFont(src, recalcTimestamp=False) |
||||
opts = Options() |
||||
opts.layout_features = ["*"] # keep default layout behaviour |
||||
opts.name_IDs = ["*"] # keep all name records (license notice ids too) |
||||
opts.name_legacy = True |
||||
opts.name_languages = ["*"] |
||||
opts.notdef_outline = True |
||||
opts.recalc_bounds = True |
||||
opts.recalc_average_width = True |
||||
opts.prune_unicode_ranges = True |
||||
subsetter = Subsetter(options=opts) |
||||
subsetter.populate(unicodes=cps) |
||||
subsetter.subset(font) |
||||
|
||||
covered = set() |
||||
for table in font["cmap"].tables: |
||||
covered.update(table.cmap.keys()) |
||||
print(f"glyphs in subset: {font['maxp'].numGlyphs}; cmap codepoints: {len(covered)}") |
||||
|
||||
rename(font) |
||||
# normalize_line_metrics(font) # REJECTED EXPERIMENT (2026-07-14): making |
||||
# hhea/typo equal the win metrics grows the browsers' inline content area |
||||
# to 1.3213em, so at row pitches below that every span's background bleeds |
||||
# ~2.5px into the neighbouring rows - visible as wrong-coloured bars at |
||||
# the bottom of solid blocks. Stock metrics + squashed pitch (+ optional |
||||
# scaleY for aspect) rendered best in practice. Kept for reference. |
||||
|
||||
ttf_path = os.path.join(outdir, "punkdoc-mono.ttf") |
||||
font.save(ttf_path) |
||||
print(f"wrote {ttf_path} ({os.path.getsize(ttf_path)} bytes)") |
||||
|
||||
font.flavor = "woff2" |
||||
woff2_path = os.path.join(outdir, "punkdoc-mono.woff2") |
||||
font.save(woff2_path) |
||||
print(f"wrote {woff2_path} ({os.path.getsize(woff2_path)} bytes)") |
||||
|
||||
if __name__ == "__main__": |
||||
main() |
||||
Binary file not shown.
@ -0,0 +1,21 @@
|
||||
# punkdoc-mono subset ranges - whole blocks covering (with headroom) the |
||||
# glyph demand measured by glyph_inventory.tcl over src/testansi + |
||||
# textblock::periodic/frames + punk::args::usage (2026-07-13, 160 codepoints) |
||||
# plus the full CP437 repertoire and braille for future plot rendering. |
||||
0020-007E |
||||
00A0-00FF |
||||
0180-024F |
||||
0370-03FF |
||||
2000-206F |
||||
2070-209F |
||||
20A0-20CF |
||||
2190-21FF |
||||
2200-22FF |
||||
2300-23FF |
||||
2400-243F |
||||
2500-25FF |
||||
2600-26FF |
||||
2700-27BF |
||||
2800-28FF |
||||
1CC00-1CEBF |
||||
1FB00-1FBFF |
||||
@ -0,0 +1,556 @@
|
||||
# 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? ?-assets embed|link|none? |
||||
# -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) |
||||
# -assets embed (default): data-uri the pinned punkdoc-mono web font |
||||
# (fontprep/punkdoc-mono.woff2) into the page - fully self-contained |
||||
# single file; every glyph (incl. octants/legacy computing) renders |
||||
# identically on any machine (~106KB page overhead) |
||||
# -assets link: reference punkdoc-mono.woff2 relatively and copy it to |
||||
# <outdir> - one cached font shared by a whole generated doc set |
||||
# -assets none: no font shipped; rely on the viewer's installed fonts |
||||
# via the css stack (octants/legacy-computing glyphs may be missing) |
||||
# 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::lib ;#punk::args::lib::tstr placeholder resolution uses punk::lib::undent |
||||
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 |
||||
set assets embed |
||||
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 |
||||
} |
||||
-assets { |
||||
if {$v ni {embed link none}} { |
||||
puts stderr "-assets must be embed, link or none (got '$v')" |
||||
exit 2 |
||||
} |
||||
set assets $v |
||||
} |
||||
default { |
||||
puts stderr "unknown option '$k' (known: -boxmap -assets)" |
||||
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" |
||||
#terminal backdrop for rendered blocks: BLACK. overtype::renderspace |
||||
#overlay output uses explicit SGR 40 (black bg) and art/example helpers |
||||
#treat 'default background' as the terminal's - on a black pre they blend |
||||
#exactly as in a black terminal (a grey pre showed contrasting black bars |
||||
#inside example blocks). The page body stays lighter for contrast. |
||||
variable default_bg "#000000" |
||||
|
||||
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 |
||||
# --------------------------------------------------------------------------- |
||||
#pinned web font (see fontprep/README.md): guarantees every glyph in the punk |
||||
#domain - incl. unicode 16 octants and legacy computing blocks that no |
||||
#commonly-installed font provides. Variable (wght 200-700) so bold spans use |
||||
#real bold. OFL-subset of Cascadia Mono renamed punkdoc-mono (RFN condition). |
||||
set fontfile [file join [file dirname [file dirname [file normalize [info script]/__]]] fontprep punkdoc-mono.woff2] |
||||
set fontface "" |
||||
if {$assets ne "none"} { |
||||
if {![file exists $fontfile]} { |
||||
puts stderr "WARNING: -assets $assets requested but $fontfile not found - falling back to -assets none" |
||||
set assets none |
||||
} else { |
||||
if {$assets eq "embed"} { |
||||
set fd [open $fontfile rb] |
||||
set fontb64 [binary encode base64 [read $fd]] |
||||
close $fd |
||||
set fontsrc "data:font/woff2;base64,$fontb64" |
||||
} else { |
||||
#link mode: ship the font next to the page(s) - shared+cached |
||||
file copy -force $fontfile [file join $outdir punkdoc-mono.woff2] |
||||
set fontsrc "punkdoc-mono.woff2" |
||||
} |
||||
set fontface "@font-face {font-family:\"punkdoc-mono\"; src:url($fontsrc) format(\"woff2\"); font-weight:200 700; font-display:block;}\n" |
||||
} |
||||
} |
||||
|
||||
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" |
||||
append html $fontface |
||||
#fallback stack: fonts with FULL box-drawing coverage (incl. heavy + |
||||
#mixed-weight chars) first - Courier New (firefox's default mono) lacks the |
||||
#heavy set. lang=en above steers chrome away from CJK ambiguous-width |
||||
#(double-width) fallback for box chars when no stack font matches. |
||||
set fontstack "'Cascadia Mono','Cascadia Code','DejaVu Sans Mono','Noto Sans Mono','JetBrains Mono','Liberation Mono',Consolas,Menlo,monospace" |
||||
if {$fontface ne ""} { |
||||
set fontstack "'punkdoc-mono',$fontstack" |
||||
} |
||||
append html "body {background:#1e1e1e; color:$ansi2html::default_fg; font-family:$fontstack;}\n" |
||||
append html "h1,h2,h3 {font-family:inherit; color:#e5e510;}\n" |
||||
append html "nav.cmdindex {background:#000; padding:8px 12px; display:inline-block;}\n" |
||||
append html "nav.cmdindex a {color:#29b8db; text-decoration:none; display:inline-block; margin-right:1.5em;}\n" |
||||
append html "nav.cmdindex a:hover {text-decoration:underline;}\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) |
||||
#punkdoc-mono cell geometry (see fontprep/README.md): advance is exactly |
||||
#0.5859375em - font-size 15.36px gives an integer 9px cell width (fractional |
||||
#advances round differently at styled-span boundaries -> vertical seams |
||||
#through block/border glyphs). Row pitch: browsers size inline BACKGROUNDS |
||||
#to the font's hhea content area = 1.1621em = 17.85px here; a fractional |
||||
#pitch (1.15em = 17.664px) put row boundaries at fractional positions and |
||||
#showed periodic hairline gaps through solid-bg runs (~every 2 lines). |
||||
#line-height:17px = integer pitch just under the bg height, so adjacent |
||||
#rows' backgrounds overlap ~0.85px - sealed at any zoom/dpi (cost: bg rows |
||||
#overpaint <1px of the row above's descenders - imperceptible in tables). |
||||
#If the font stack falls back past punkdoc-mono this exactness is lost but |
||||
#text-only content tolerates it. |
||||
append html "pre.punkterm {font-family:$fontstack; line-height:17px; font-size:15.36px; 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" |
||||
|
||||
#module/package-level info when @package directives are registered (none in |
||||
#older module versions - the hook is here for when dev modules surface them) |
||||
set package_notes [list] |
||||
foreach id $cmd_ids { |
||||
set spec [punk::args::get_spec $id] |
||||
#package_info key absent in older punk::args spec dicts (pre-@package) |
||||
if {![dict exists $spec package_info]} {break} |
||||
set pinfo [dict get $spec package_info] |
||||
if {[llength $pinfo] && $pinfo ni $package_notes} { |
||||
lappend package_notes $pinfo |
||||
} |
||||
} |
||||
foreach pinfo $package_notes { |
||||
append html "<p>package: [ansi2html::html_escape [punk::ansi::ansistrip $pinfo]]</p>\n" |
||||
} |
||||
|
||||
#command index navigation (doctools-style jump list) |
||||
append html "<nav class=\"cmdindex\">\n" |
||||
foreach id $cmd_ids { |
||||
set cmdname [string trimleft $id :] |
||||
set esc [ansi2html::html_escape $cmdname] |
||||
append html "<a href=\"#$esc\">$esc</a>\n" |
||||
} |
||||
append html "</nav>\n" |
||||
|
||||
#helper: one converted usage block. |
||||
#-trim 1: keep only the Arg table (from its header separator down) - used for |
||||
#per-form blocks so they don't repeat the whole command/description/synopsis |
||||
#panel and drown the per-form differences (renderspace output lines are |
||||
#colour-self-contained, so slicing at a line boundary is safe) |
||||
proc usage_block {id args} { |
||||
global boxmap |
||||
set trim 0 |
||||
set idx [lsearch -exact $args -trim] |
||||
if {$idx >= 0} { |
||||
set trim [lindex $args $idx+1] |
||||
set args [lreplace $args $idx $idx+1] |
||||
} |
||||
if {[catch {punk::args::usage {*}$args $id} u]} { |
||||
return "<p>(no usage rendering: [ansi2html::html_escape $u])</p>\n" |
||||
} |
||||
if {$trim} { |
||||
set lines [split $u \n] |
||||
set argidx -1 |
||||
set i 0 |
||||
foreach ln $lines { |
||||
if {[string match "┃Arg *" [punk::ansi::ansistrip $ln]]} { |
||||
set argidx $i |
||||
break |
||||
} |
||||
incr i |
||||
} |
||||
if {$argidx > 0} { |
||||
#include the separator line above the Arg header as the top border |
||||
set u [join [lrange $lines $argidx-1 end] \n] |
||||
} |
||||
} |
||||
if {$boxmap eq "light"} { |
||||
set u [ansi2html::to_lightbox $u] |
||||
} |
||||
return "<pre class=\"punkterm\">[ansi2html::convert $u]</pre>\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" |
||||
} |
||||
#the default usage table shows description + all form synopses, but for |
||||
#multiform commands its Arg table covers only the default form - render |
||||
#an additional per-form ARG TABLE (trimmed - no repeated header panel) |
||||
#for each form that has arguments (mirrors 'i -form N <cmd>'). |
||||
append html [usage_block $id] |
||||
set spec [punk::args::get_spec $id] |
||||
set formnames [dict get $spec form_names] |
||||
if {[llength $formnames] > 1} { |
||||
foreach formname $formnames { |
||||
set form [dict get $spec FORMS $formname] |
||||
if {![dict size [dict get $form ARG_INFO]]} { |
||||
#form takes no arguments - the synopsis line says it all |
||||
continue |
||||
} |
||||
append html "<h3>form: [ansi2html::html_escape $formname]</h3>\n" |
||||
append html [usage_block $id -form $formname -trim 1] |
||||
} |
||||
} |
||||
} |
||||
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)" |
||||
@ -0,0 +1,195 @@
|
||||
package require tcltest |
||||
|
||||
package require punk::args |
||||
|
||||
#G-074: punk::args::formcheck - on-demand multiform ambiguity analysis with |
||||
#sanctioned-overlap annotation (@form -overlapallowed). |
||||
#A finding is only reported after a synthetic witness arglist is CONFIRMED by a real |
||||
#single-form parse against both forms, so fully discriminated form pairs cannot |
||||
#false-alarm; witness derivation is the documented miss direction (exotic types, |
||||
#forms requiring options, capped -multiple repetition). The sanction is |
||||
#formcheck-reporting metadata only - parse behaviour (multipleformmatches) is |
||||
#unaffected. The tclcore ::lseq and ::after models are the motivating real cases |
||||
#from the G-041 closeout (goals/archive/G-041-punkargs-form-matching.md). |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
variable common { |
||||
set result "" |
||||
} |
||||
|
||||
testConstraint have_tclcoredocs [expr {![catch {package require punk::args::moduledoc::tclcore}]}] |
||||
|
||||
#discriminated multiform fixtures - literal/choice/int leading slots (no permissive |
||||
#alignment) and arity-window separation. formcheck must report NOTHING for these. |
||||
punk::args::define { |
||||
@id -id ::testspace::fc_afterish |
||||
@cmd -name testspace::fc_afterish -summary "after-like multiform" -help "discriminated multiform fixture" |
||||
@form -form ms |
||||
@values -min 1 -max -1 |
||||
ms -type int |
||||
script -type string -optional 1 -multiple 1 |
||||
@form -form cancel |
||||
@values -min 2 -max -1 |
||||
cancel -type literal(cancel) |
||||
ids -type string -multiple 1 |
||||
@form -form idle |
||||
@values -min 2 -max -1 |
||||
idle -type literal(idle) |
||||
scripts -type string -multiple 1 |
||||
} |
||||
punk::args::define { |
||||
@id -id ::testspace::fc_sharedform |
||||
@cmd -name testspace::fc_sharedform -summary "shared-prologue multiform" -help "arity-discriminated multiform fixture" |
||||
@form -form {get set} |
||||
@leaders -min 1 -max 1 |
||||
key -type string |
||||
@form -form get |
||||
@values -min 0 -max 0 |
||||
@form -form set |
||||
@values -min 1 -max 1 |
||||
newvalue -type string |
||||
} |
||||
|
||||
#overlapping fixture: aa's typed slot faces bb's permissive slot (type-weakness), |
||||
#with the pair sanctioned on ONE member via @form -overlapallowed |
||||
punk::args::define { |
||||
@id -id ::testspace::fc_sanctioned |
||||
@cmd -name testspace::fc_sanctioned -summary "sanctioned overlap" -help "sanctioned overlapping multiform fixture" |
||||
@form -form go -overlapallowed {run} |
||||
@values -min 2 -max 2 |
||||
go -type literal(go) |
||||
target -type string |
||||
@form -form run |
||||
@values -min 2 -max 2 |
||||
mode -type any |
||||
target -type string |
||||
} |
||||
|
||||
test formcheck_discriminated_no_findings {formcheck reports nothing for fully discriminated multiform definitions (fixtures + the parse withid/withdef pair)}\ |
||||
-setup $common -body { |
||||
foreach id {::testspace::fc_afterish ::testspace::fc_sharedform ::punk::args::parse} { |
||||
set r [punk::args::formcheck $id] |
||||
lappend result [list [dict size [dict get $r findings]] [dict get $r unsanctioned]] |
||||
} |
||||
set result |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list {0 {}} {0 {}} {0 {}}] |
||||
|
||||
test formcheck_finding_classes_and_sanction {an overlap is classified (type-weakness = discriminator vs permissive) and -overlapallowed on one member downgrades the pair to sanctioned}\ |
||||
-setup $common -body { |
||||
set r [punk::args::formcheck ::testspace::fc_sanctioned] |
||||
set finding [dict get $r findings {go run}] |
||||
lappend result [dict get $finding class] |
||||
lappend result [dict get $finding sanctioned] |
||||
lappend result [dict get $r unsanctioned] |
||||
#the reported witness genuinely parses against both forms |
||||
lappend result [dict get [punk::args::parse_status [dict get $finding witness] -form go withid ::testspace::fc_sanctioned] ok] |
||||
lappend result [dict get [punk::args::parse_status [dict get $finding witness] -form run withid ::testspace::fc_sanctioned] ok] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list type_weakness 1 {} 1 1] |
||||
|
||||
test formcheck_overlapallowed_unknown_form_rejected {@form -overlapallowed naming an unknown form is rejected when the definition resolves}\ |
||||
-setup $common -body { |
||||
punk::args::define { |
||||
@id -id ::testspace::fc_badsanction |
||||
@form -form aa -overlapallowed {nosuchform} |
||||
@values -min 1 -max 1 |
||||
x -type string |
||||
@form -form bb |
||||
@values -min 1 -max 1 |
||||
y -type any |
||||
} |
||||
if {[catch {punk::args::get_spec ::testspace::fc_badsanction} errmsg]} { |
||||
lappend result [string match "*-overlapallowed*unknown form 'nosuchform'*" $errmsg] |
||||
} else { |
||||
lappend result UNEXPECTED-resolved |
||||
} |
||||
set result |
||||
}\ |
||||
-cleanup { |
||||
catch {punk::args::undefine ::testspace::fc_badsanction 1} |
||||
}\ |
||||
-result [list 1] |
||||
|
||||
test formcheck_return_summary {-return summary returns the human report text only}\ |
||||
-setup $common -body { |
||||
set s [punk::args::formcheck -return summary ::testspace::fc_sanctioned] |
||||
lappend result [string match "punk::args::formcheck ::testspace::fc_sanctioned:*" $s] |
||||
lappend result [string match "*sanctioned type_weakness overlap: go vs run*" $s] |
||||
#dict return carries the same text under the summary key |
||||
lappend result [expr {$s eq [dict get [punk::args::formcheck ::testspace::fc_sanctioned] summary]}] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 1 1 1] |
||||
|
||||
test formcheck_lseq_typeweakness {tclcore ::lseq reports the range/start_count expr-typed-end overlap as an unsanctioned type-weakness finding ('lseq 1 count 5' class)}\ |
||||
-constraints have_tclcoredocs\ |
||||
-setup $common -body { |
||||
set r [punk::args::formcheck ::lseq] |
||||
set finding [dict get $r findings {range start_count}] |
||||
lappend result [dict get $finding class] |
||||
lappend result [dict get $finding sanctioned] |
||||
lappend result [expr {{range start_count} in [dict get $r unsanctioned]}] |
||||
#the witness word for the aligned discriminator slot is start_count's |
||||
#literalprefix(count) word, swallowed by range's number|expr end slot |
||||
set discword "" |
||||
foreach slot [dict get $finding slots] { |
||||
if {[dict get $slot relation] eq "discriminator_vs_permissive"} { |
||||
set discword [dict get $slot word] |
||||
} |
||||
} |
||||
lappend result $discword |
||||
#every reported ::lseq witness genuinely parses against both its forms |
||||
dict for {pairkey pf} [dict get $r findings] { |
||||
lassign $pairkey fa fb |
||||
if {![dict get [punk::args::parse_status [dict get $pf witness] -form $fa withid ::lseq] ok] |
||||
|| ![dict get [punk::args::parse_status [dict get $pf witness] -form $fb withid ::lseq] ok]} { |
||||
lappend result [list unconfirmed-witness $pairkey] |
||||
} |
||||
} |
||||
set result |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list type_weakness 0 1 count] |
||||
|
||||
test formcheck_after_cancel_sanctioned {tclcore ::after reports exactly the documented cancelid/cancelscript overlap - structural class, sanctioned via -overlapallowed, leaving no unsanctioned findings}\ |
||||
-constraints have_tclcoredocs\ |
||||
-setup $common -body { |
||||
set r [punk::args::formcheck ::after] |
||||
lappend result [dict keys [dict get $r findings]] |
||||
lappend result [dict get $r findings {cancelid cancelscript} class] |
||||
lappend result [dict get $r findings {cancelid cancelscript} sanctioned] |
||||
lappend result [dict get $r unsanctioned] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list {{cancelid cancelscript}} structural 1 {}] |
||||
|
||||
test formcheck_sanction_does_not_affect_parse {the -overlapallowed sanction never changes parse behaviour - an ambiguous 'after cancel <id-shaped>' still raises multipleformmatches}\ |
||||
-constraints have_tclcoredocs\ |
||||
-setup $common -body { |
||||
if {[catch {punk::args::parse {cancel after#1} withid ::after} errmsg erroropts]} { |
||||
set classinfo [lindex [dict get $erroropts -errorcode] 2] |
||||
lappend result [lindex $classinfo 0] |
||||
} else { |
||||
lappend result UNEXPECTED-parsed |
||||
} |
||||
set result |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list multipleformmatches] |
||||
|
||||
#fixture cleanup |
||||
catch {punk::args::undefine ::testspace::fc_afterish 1} |
||||
catch {punk::args::undefine ::testspace::fc_sharedform 1} |
||||
catch {punk::args::undefine ::testspace::fc_sanctioned 1} |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary line. |
||||
@ -0,0 +1,231 @@
|
||||
package require tcltest |
||||
|
||||
#Behaviour + artifact tests for bin/dtplite.cmd - the scriptwrap-multishell wrapped |
||||
#tcllib dtplite application (payload: src/scriptapps/dtplite.tcl + dtplite_wrap.toml). |
||||
# |
||||
#Context: 'dev doc.validate' (punk::mix::commandset::doc::validate) invokes a bare |
||||
#`dtplite validate <path>` which the punk repl unknown-handler resolves via auto_execok, |
||||
#so a dtplite executable must be findable on PATH. bin/dtplite.cmd provides that |
||||
#cross-platform (cmd.exe on windows dispatching to tclsh; sh/tclsh on unix). |
||||
# |
||||
#Covered: |
||||
# - artifact contract: bin/dtplite.cmd is LF-only and passes scriptwrap checkfile |
||||
# (no 512-byte label location errors) |
||||
# - source sync: re-wrapping the dtplite scriptset from src/scriptapps reproduces the |
||||
# committed bin/dtplite.cmd byte for byte (fix payloads and re-wrap - never the output) |
||||
# - execution usecases (windows via cmd.exe; unix via sh - both need a tclsh with the |
||||
# dtplite package or the project-vendored tcllib fallback): |
||||
# * no args -> usage error, nonzero exit |
||||
# * validate <good .man file> -> exit 0 |
||||
# * validate <bad .man file> -> nonzero exit + doctools error on stderr |
||||
# * validate <directory tree> -> exit 0 (the 'dev doc.validate' usecase) |
||||
# * html generation to an output file |
||||
# |
||||
#NOTE for agents: bin/dtplite.cmd is GENERATED - edit src/scriptapps/dtplite.tcl / |
||||
#dtplite_wrap.toml and re-wrap with punk::mix::commandset::scriptwrap::multishell |
||||
#(see src/scriptapps/AGENTS.md). |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
variable common { |
||||
set result "" |
||||
} |
||||
|
||||
variable testdir [file dirname [file normalize [info script]]] |
||||
#<projectroot>/src/tests/shell/testsuites/binscripts -> src/tests is 3 levels up |
||||
variable testsroot [file normalize [file join $testdir .. .. ..]] |
||||
variable projectroot [file normalize [file join $testsroot .. ..]] |
||||
|
||||
variable target [file join $projectroot bin dtplite.cmd] |
||||
testConstraint havedtplitecmd [file exists $target] |
||||
testConstraint iswindows [expr {$::tcl_platform(platform) eq "windows"}] |
||||
testConstraint isunix [expr {$::tcl_platform(platform) eq "unix"}] |
||||
testConstraint havescriptwrap [expr {![catch { |
||||
package require Thread ;#punk::fileline textinfo (used by checkfile) calls thread::id |
||||
package require punk::mix::commandset::scriptwrap |
||||
}]}] |
||||
|
||||
proc readbytes {path} { |
||||
set fd [open $path r] |
||||
fconfigure $fd -translation binary |
||||
set data [read $fd] |
||||
close $fd |
||||
return $data |
||||
} |
||||
|
||||
#write with explicit lf translation |
||||
proc writefile_lf {path content} { |
||||
set fd [open $path w] |
||||
fconfigure $fd -translation lf |
||||
puts $fd $content |
||||
close $fd |
||||
} |
||||
|
||||
#run bin/dtplite.cmd with args; returns dict {exit <code> output <stdout+stderr>} |
||||
#on windows via cmd.exe (the way the repl unknown-handler launches it), on unix via sh |
||||
proc run_dtplite {args} { |
||||
variable target |
||||
set output "" |
||||
set code 0 |
||||
if {$::tcl_platform(platform) eq "windows"} { |
||||
set comspec [expr {[info exists ::env(ComSpec)] ? $::env(ComSpec) : "cmd.exe"}] |
||||
set cmdline [list $comspec /c [file nativename $target] {*}$args] |
||||
} else { |
||||
set cmdline [list sh $target {*}$args] |
||||
} |
||||
if {[catch {exec -- {*}$cmdline << "" 2>@1} output opts]} { |
||||
set ec [dict get $opts -errorcode] |
||||
if {[lindex $ec 0] eq "CHILDSTATUS"} { |
||||
set code [lindex $ec 2] |
||||
} else { |
||||
set code -1 |
||||
} |
||||
} |
||||
return [dict create exit $code output $output] |
||||
} |
||||
|
||||
#--- fixtures: minimal good/bad doctools manpages + a small doc tree ------------- |
||||
variable good_man {[manpage_begin sample_good n 1.0] |
||||
[copyright {2026}] |
||||
[moddesc {Sample}] |
||||
[titledesc {A minimal valid doctools manpage}] |
||||
[description] |
||||
[para] This is a minimal valid doctools document used for smoke testing dtplite. |
||||
[section Usage] |
||||
[para] Nothing to see here. |
||||
[manpage_end]} |
||||
variable bad_man {[manpage_begin sample_bad n 1.0] |
||||
[copyright {2026}] |
||||
[moddesc {Sample}] |
||||
[titledesc {An invalid doctools manpage - manpage_end missing}] |
||||
[description] |
||||
[list_begin itemized] |
||||
[item] an item, but the list is never closed and manpage_end is missing} |
||||
|
||||
variable fixdir [makeDirectory dtplite_fixture] |
||||
writefile_lf $fixdir/sample_good.man $good_man |
||||
writefile_lf $fixdir/sample_bad.man $bad_man |
||||
variable treedir [makeDirectory dtplite_fixture_tree] |
||||
file mkdir $treedir/sub |
||||
writefile_lf $treedir/one.man [string map {sample_good tree_one} $good_man] |
||||
writefile_lf $treedir/sub/two.man [string map {sample_good tree_two} $good_man] |
||||
|
||||
#--- artifact contract ------------------------------------------------------------ |
||||
|
||||
test dtplite_cmd_lf_only {the committed bin/dtplite.cmd uses LF line endings exclusively (cmd label scanning depends on it)}\ |
||||
-constraints havedtplitecmd\ |
||||
-setup $common -body { |
||||
variable target |
||||
set data [readbytes $target] |
||||
lappend result [expr {[string first \r $data] == -1}] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 1] |
||||
|
||||
test dtplite_cmd_checkfile_no_label_errors {the committed bin/dtplite.cmd passes scriptwrap checkfile - no 512-byte label location errors}\ |
||||
-constraints {havedtplitecmd havescriptwrap}\ |
||||
-setup $common -body { |
||||
variable target |
||||
set summary [punk::mix::commandset::scriptwrap::checkfile $target] |
||||
lappend result [string match "*ERROR: label location errors*" $summary] |
||||
#sanity: the analysis actually ran (labels enumerated) |
||||
lappend result [string match "*call-labels-found:*" $summary] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 0 1] |
||||
|
||||
test dtplite_cmd_roundtrip_no_drift {re-wrapping the dtplite scriptset from src/scriptapps reproduces the committed bin/dtplite.cmd byte for byte}\ |
||||
-constraints {havedtplitecmd havescriptwrap}\ |
||||
-setup $common -body { |
||||
variable projectroot |
||||
variable target |
||||
set scriptapps [file join $projectroot src scriptapps] |
||||
if {![file exists $scriptapps/dtplite_wrap.toml]} { |
||||
lappend result no_dtplite_sources |
||||
} else { |
||||
set outdir [makeDirectory dtplite_roundtrip] |
||||
set startdir [pwd] |
||||
cd $scriptapps |
||||
set res [punk::mix::commandset::scriptwrap::multishell dtplite -outputfolder $outdir -askme 0 -force 1] |
||||
cd $startdir |
||||
set fresh [dict get $res filename] |
||||
lappend result [expr {[readbytes $fresh] eq [readbytes $target]}] |
||||
#a failure here means either bin/dtplite.cmd was edited directly (fix |
||||
#src/scriptapps/dtplite.tcl or dtplite_wrap.toml instead and re-wrap), |
||||
#or the payload/template changed without regenerating bin/dtplite.cmd |
||||
} |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 1] |
||||
|
||||
#--- execution usecases ----------------------------------------------------------- |
||||
|
||||
test dtplite_exec_no_args_usage_error {running dtplite.cmd without arguments exits nonzero with the dtplite usage message}\ |
||||
-constraints havedtplitecmd\ |
||||
-setup $common -body { |
||||
set r [run_dtplite] |
||||
lappend result [expr {[dict get $r exit] != 0}] |
||||
lappend result [string match "*wrong#args*" [dict get $r output]] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 1 1] |
||||
|
||||
test dtplite_exec_validate_good {validate of a well-formed .man file exits 0}\ |
||||
-constraints havedtplitecmd\ |
||||
-setup $common -body { |
||||
variable fixdir |
||||
set r [run_dtplite validate [file nativename $fixdir/sample_good.man]] |
||||
lappend result [dict get $r exit] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 0] |
||||
|
||||
test dtplite_exec_validate_bad {validate of a malformed .man file exits nonzero and reports a doctools format error}\ |
||||
-constraints havedtplitecmd\ |
||||
-setup $common -body { |
||||
variable fixdir |
||||
set r [run_dtplite validate [file nativename $fixdir/sample_bad.man]] |
||||
lappend result [expr {[dict get $r exit] != 0}] |
||||
lappend result [string match "*FmtError*" [dict get $r output]] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 1 1] |
||||
|
||||
test dtplite_exec_validate_tree {validate of a directory tree of .man files exits 0 - the 'dev doc.validate' usecase}\ |
||||
-constraints havedtplitecmd\ |
||||
-setup $common -body { |
||||
variable treedir |
||||
set r [run_dtplite validate [file nativename $treedir]] |
||||
lappend result [dict get $r exit] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list 0] |
||||
|
||||
test dtplite_exec_html_generation {html generation from a .man file produces an html output file mentioning the manpage name}\ |
||||
-constraints havedtplitecmd\ |
||||
-setup $common -body { |
||||
variable fixdir |
||||
set outfile $fixdir/sample_good.html |
||||
set r [run_dtplite -o [file nativename $outfile] html [file nativename $fixdir/sample_good.man]] |
||||
lappend result [dict get $r exit] |
||||
lappend result [file exists $outfile] |
||||
if {[file exists $outfile]} { |
||||
set html [readbytes $outfile] |
||||
lappend result [string match "*sample_good*" $html] |
||||
} else { |
||||
lappend result no_output_file |
||||
} |
||||
}\ |
||||
-cleanup { |
||||
file delete -force $fixdir/sample_good.html |
||||
}\ |
||||
-result [list 0 1 1] |
||||
} |
||||
tcltest::cleanupTests ;#needed to produce test summary line. |
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in new issue