From 68e45c513d69132288359dea12fbd2cf560473f9 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Wed, 8 Jul 2026 15:59:33 +1000 Subject: [PATCH] punk 0.2.0: help system restructured onto ::punk::helptopic topic registry - each topic (topics|help, tcl, env|environment, console|term|terminal) is a handler proc returning {channel text} chunks, with its own punk::args definition (id ::punk::helptopic::) so 'i help ' renders documented usage - registering a topic (re)generates the ::punk::help / ::punk::help_chunks definitions, so 'i help' shows a documented topic table that always matches the registry (previously an autogenerated stub); the registry is the seam for future subshell-declared topics - 'help topics' derived from the registry (all aliases listed, fits 80 cols) - no-arg overview and command-fallthrough output byte-identical to before; 80-column layout preserved; verified on tcl 9 and 8.6 kits via the script and shell subcommands - 'help env' degrades to a one-line notice when punk::config is not initialised (e.g. script contexts) instead of an error stack + exit 1 - shared table_block helper destroys table objects after print (previously leaked several per help invocation) - project 0.4.4 (CHANGELOG entry) Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- CHANGELOG.md | 4 + punkproject.toml | 2 +- src/modules/punk-999999.0a1.0.tm | 1000 +++++++++++++++-------------- src/modules/punk-buildversion.txt | 7 +- 4 files changed, 535 insertions(+), 478 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 49feef3d..1c2e2202 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ The latest `## [X.Y.Z]` header must match the `version` field in `punkproject.to Entries are newest-first; one bullet per notable change. See the root `AGENTS.md` "Project Versioning" section for the bump policy. +## [0.4.4] - 2026-07-08 + +- help system restructured onto a topic registry (punk module 0.2.0, `::punk::helptopic`): each topic (`topics|help`, `tcl`, `env|environment`, `console|term|terminal`) is a handler proc with its own punk::args definition, and the `::punk::help`/`::punk::help_chunks` definitions are (re)generated from the registry — `i help` now renders a documented usage table with topic choices and summaries, and `i help ` shows per-topic documented usage (previously an autogenerated stub). `help topics` is derived from the registry (lists all aliases, fits 80 columns). No-arg overview and command-fallthrough (`help `) output byte-identical to before; 80-column layout preserved; verified on both generations, script and shell subcommands. `help env` without an initialised punk::config (e.g. script contexts) degrades to a one-line notice instead of an error stack. The registry is the intended seam for future subshell-declared topics (punk::config-gated — not yet a goal). + ## [0.4.3] - 2026-07-08 - vendored tcludp upgraded 1.0.12 -> 1.0.13 in the tcl9 kit vfs folders (punk9win.vfs, punk9win_for_tkruntime.vfs) and src/vendorlib_tcl9 — 1.0.12's Windows per-thread exit handler closed the process-global tcludp synchronization events, so the first udp-loaded worker thread to die froze every other udp-loaded thread's event loop (root cause of the G-036 wedge; fixed upstream in 1.0.13). Verified with the G-036 regression harness: run-2 syslog workers alive (baseline on 1.0.12: wedged 4/4). Note: punk8win.vfs still bundles udp 1.0.12 (8.6 appeared immune; pending decision). The manual vfs copy was required because `libs`/`vfscommonupdate`/`project` do not propagate vendorlib_tcl platform libraries into kit vfs lib_tcl trees — gap recorded as goal G-037. diff --git a/punkproject.toml b/punkproject.toml index 0f2795e1..f3876006 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,3 +1,3 @@ [project] name = "punkshell" -version = "0.4.3" +version = "0.4.4" diff --git a/src/modules/punk-999999.0a1.0.tm b/src/modules/punk-999999.0a1.0.tm index 86a59b79..b6fd8119 100644 --- a/src/modules/punk-999999.0a1.0.tm +++ b/src/modules/punk-999999.0a1.0.tm @@ -8411,38 +8411,507 @@ namespace eval punk { } puts -nonewline stdout \n } - #return list of {chan chunk} elements - namespace eval argdoc { + #punk::help topic registry + #Each registered topic has: + # - a handler proc ::punk::helptopic:: taking a context dict plus any extra words, + # returning the topic's help content as a list of {channel text} chunks + # - a punk::args definition with id ::punk::helptopic:: so that 'i help ' shows documented usage + #Registering a topic (re)generates the ::punk::help and ::punk::help_chunks punk::args definitions, + #so the documented topic choices always match the registry. + #The 'overview' handler is not a registered topic - it is what a plain 'help' displays. + #Unregistered topic words fall through to basic command-info lookup (see ::punk::help_chunks). + namespace eval helptopic { + variable topics [dict create] + + tcl::namespace::import ::punk::ansi::a ::punk::ansi::a+ + + proc register {topic aliases summary} { + variable topics + if {![llength [info commands [namespace current]::$topic]]} { + error "punk::helptopic::register - no handler proc '[namespace current]::$topic' exists for topic '$topic'" + } + dict set topics $topic [dict create aliases $aliases summary $summary] + define_docs + return + } + + #return the canonical topic name for a topic word or alias - empty string if not a registered topic + proc resolve {word} { + variable topics + dict for {topic tinfo} $topics { + if {$word eq $topic || $word in [dict get $tinfo aliases]} { + return $topic + } + } + return "" + } + + #standard command-info table as used by the help overview blocks + proc table_block {frametype title rows {minwidth 80}} { + set t [textblock::class::table new -minwidth $minwidth -show_seps 0] + $t configure -frametype $frametype + foreach row $rows { + $t add_row $row + } + $t configure_column 0 -minwidth [expr {[$t column_datawidth 0] + 2}] + $t configure_column 1 -minwidth [expr {[$t column_datawidth 1] + 1}] + $t configure -title $title + set text [$t print] + $t destroy + return $text + } + + #(re)generate the punk::args definitions for ::punk::help and ::punk::help_chunks from the registry + #so that 'i help' shows a documented topic table matching the registered topics. + proc define_docs {} { + variable topics + set choices [list] + set choiceinfo [dict create] + set choicelabels [dict create] + dict for {topic tinfo} $topics { + foreach name [list $topic {*}[dict get $tinfo aliases]] { + lappend choices $name + dict set choiceinfo $name [list [list doctype punkargs] [list subhelp [namespace current]::$topic]] + dict set choicelabels $name [dict get $tinfo summary] + } + } + set basehelp {Help system for the punk shell. + With no arguments - an overview of some key shell commands is displayed. + When the first argument is a recognised topic - help for that topic is displayed. + ('help topics' lists the available topics) + Anything else is treated as a command name - basic command info (type and + synopsis) is shown for a resolvable command, or the resolved path for an + external executable.} + set topichelp {Help topic, or command words for basic command info. (topics must match exactly - no prefix matching)} + set specs [list] + lappend specs ::punk::help help "Punk shell help system." "" + lappend specs ::punk::help_chunks punk::help_chunks "Punk shell help system - content as {channel text} chunks." "\n\nhelp_chunks returns the help content as a list of {channel text} chunks rather than emitting it." + foreach {id name summary extra} $specs { + set def "" + append def "@id -id $id" \n + append def "@cmd -name $name -summary \"$summary\" -help \"$basehelp$extra\"" \n + append def "@leaders -min 0 -max -1" \n + append def "topic -optional 1 -multiple 1 -type string -choiceprefix 0 -choicerestricted 0 -choices {$choices} -choiceinfo {$choiceinfo} -choicelabels {$choicelabels} -help \"$topichelp\"" \n + append def "@values -min 0 -max 0" + if {[punk::args::id_exists $id]} { + #quiet undefine - redefinition on registry change is expected, not noteworthy + punk::args::undefine $id 1 + } + punk::args::define $def + } + } + + #The no-topic overview of key shell commands (what a plain 'help' displays) + proc overview {context args} { + set frametype [dict get $context frametype] + set I [dict get $context I] + set NI [dict get $context NI] + set chunks [list] + + set title "[a+ brightgreen] Filesystem navigation: " + set cmdinfo [list] + lappend cmdinfo [list ./ "?${I}glob${NI}?" "view/change dir, list dirs."] + lappend cmdinfo [list .// "?${I}glob${NI}?" "view/change dir, list dirs and files"] + lappend cmdinfo [list ../ "?${I}path${NI}" "go up one dir, then to path if given"] + lappend cmdinfo [list newdir "${I}subdir${NI}..." "make new dir or dirs and show status"] + lappend cmdinfo [list fcat "${I}file ?file?...${NI}" "cat file(s)"] + lappend chunks [list stdout [table_block $frametype $title $cmdinfo]\n] + + set title "[a+ brightgreen] Namespace navigation: " + set cmdinfo [list] + lappend cmdinfo [list n/ "?${I}ns${NI}|${I}glob${NI}?" "view/change namespace\n (accepts ns path globs e.g **::*get* to match\n commands at any level )"] + lappend cmdinfo [list n// "?${I}ns${NI}|${I}glob${NI}?" "view/change namespace (with command listing)"] + lappend cmdinfo [list "nn/" "" "go up one namespace"] + lappend cmdinfo [list "newns" "${I}ns${NI}" "make child namespace and switch to it"] + lappend chunks [list stdout [table_block $frametype $title $cmdinfo]\n] + + set title "[a+ brightgreen] Command help: " + set cmdinfo [list] + lappend cmdinfo [list i "${I}cmd${NI} ?${I}subcommand${NI}...?" "Show usage for a command or ensemble subcommand"] + lappend cmdinfo [list s "${I}cmd${NI} ?${I}subcommand${NI}...?" "Show synopsis for a command or ensemble subcommand"] + lappend cmdinfo [list eg "${I}cmd${NI} ?${I}subcommand${NI}...?" "Show example from manpage"] + lappend cmdinfo [list corp "${I}proc${NI}" "View proc body and arguments with basic highlighting"] + lappend chunks [list stdout [table_block $frametype $title $cmdinfo]\n] + + set title "[a+ brightgreen] Miscellaneous: " + #todo - load from source code annotation? + set cmdinfo [list] + lappend cmdinfo [list dev "?${I}subcommand${NI}?" "(ensemble command to make new projects/modules and\n to generate docs)"] + lappend cmdinfo [list a? "?${I}subcommand${NI}...?" "view ANSI colours\n e.g a? web\n or individual code samples/diagnostics\n e.g a? red bold\n e.g a? underline web-orange Term-purple3"] + lappend cmdinfo [list a+ "?${I}colourcode${NI}...?" "Return ANSI codes\n e.g puts \"\[a+ purple\]purple\[a+ Green\]purple on green\[a\]\"\n [a+ purple]purple[a+ Green]purple on green[a] "] + lappend cmdinfo [list a "?${I}colourcode${NI}...?" "Return ANSI codes (with leading reset)\n e.g puts \"\[a+ purple\]purple\[a Green\]normal on green\[a\]\"\n [a+ purple]purple[a Green]normal on green[a] "] + lappend chunks [list stdout [table_block $frametype $title $cmdinfo]] + + return $chunks + } + punk::args::define { - @id -id ::punk::help_chunks - @cmd -name "punk::help_chunks"\ - -summary\ - ""\ - -help\ - "" - @opts - -- -type none - @values -min 0 -max -1 - arg -type any -optional 1 -multiple 1 + @id -id ::punk::helptopic::topics + @cmd -name "help topics" -summary "List help topics." -help "Show the table of topics known to the help system, including registered aliases for each topic." + @values -min 0 -max 0 + } + proc topics {context args} { + variable topics + set frametype [dict get $context frametype] + set t [textblock::class::table new -show_seps 0] + $t configure -frametype $frametype + $t add_column -headers [list "Topic"] + $t add_column + dict for {topic tinfo} $topics { + $t add_row [list [join [list $topic {*}[dict get $tinfo aliases]] |] [dict get $tinfo summary]] + } + $t add_row [list "*" "Look up as a command or external executable"] + $t configure_column 0 -minwidth [expr {[$t column_datawidth 0] + 4}] + set text \n[$t print] + $t destroy + return [list [list stdout $text]] + } + + punk::args::define { + @id -id ::punk::helptopic::tcl + @cmd -name "help tcl" -summary "Tcl version warnings." -help "Show the running Tcl patchlevel and build-info, with warnings for known Tcl bugs affecting this interpreter (as detected by the punk::lib::check::has_tclbug_* checks)." + @values -min 0 -max 0 + } + proc tcl {context args} { + set chunks [list] + set warningblock "" + set text "Tcl Patchlevel: [info patchlevel]" + catch { + append text \n "Tcl build-info: [::tcl::build-info]" + } + #generate warningblocks for each triggered Tcl bug in namespace ::punk::lib::check + set bugcheck_procs [info procs ::punk::lib::check::has_tclbug*] + foreach bp $bugcheck_procs { + set buginfo [$bp] + if {[dict get $buginfo bug]} { + set level unknown + if {[dict exists $buginfo level]} { + set level [dict get $buginfo level] + } + switch -- $level { + minor {set highlight [punk::ansi::a+ cyan]} + medium {set highlight [punk::ansi::a+ yellow]} + major {set highlight [punk::ansi::a+ red bold]} + default {set highlight ""} + } + append warningblock \n $highlight "warning level: $level $bp triggered." + if {[dict exists $buginfo description]} { + set indent " " + append warningblock \n "[punk::lib::indent [dict get $buginfo description] $indent]" + } + if {[dict exists $buginfo bugref] && [dict get $buginfo bugref] ne ""} { + set bugref [dict get $buginfo bugref] + append warningblock \n "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/$bugref]" + } + append warningblock [a] + } + } + + if {[catch {lsearch -stride 2 {a b} b}]} { + #has_tclbug_lsearch_strideallinline will have reported bug false because it couldn't test it. + set indent " " + append warningblock \n "[a+ web-red]warning: lsearch does not seem to support -stride option" \n + append warningblock "${indent}(Consider upgrading to a late release of tcl 8.6 or tcl 9+ )" \n + append warningblock [a] + } + lappend chunks [list stdout $text] + lappend chunks [list stderr $warningblock] + return $chunks + } + + punk::args::define { + @id -id ::punk::helptopic::env + @cmd -name "help env" -summary "punkshell environment vars." -help "Show punk-related and other relevant environment variables with their current values." + @values -min 0 -max 0 + } + proc env {context args} { + if {[catch {package require punk::config} errM]} { + return [list [list stderr "help env: punk::config package not available - no environment variable info ($errM)\n"]] + } + if {![info exists ::punk::config::punk_env_vars_config] || ![info exists ::punk::config::other_env_vars_config]} { + #punk::config::init has side effects (config dir/file creation) - don't trigger it just for help + return [list [list stderr "help env: punk::config not initialised - no environment variable info\n"]] + } + set frametype [dict get $context frametype] + set linesep [string repeat - 76] + set chunks [list] + set text "" + #todo - move to punk::config? + upvar ::punk::config::punk_env_vars_config punkenv_config + upvar ::punk::config::other_env_vars_config otherenv_config + + set known_punk [dict keys $punkenv_config] + set known_other [dict keys $otherenv_config] + append text \n + set usetable 1 + if {$usetable} { + set t [textblock::class::table new -show_hseps 0 -show_header 1 -ansiborder_header [a+ web-green]] + $t configure -frametype $frametype + if {"windows" eq $::tcl_platform(platform)} { + #If any env vars have been set to empty string - this is considered a deletion of the variable on windows. + #The Tcl ::env array is linked to the underlying process view of the environment + #- but info exists ::env(var) can misreport as true if it has been deleted by setting to empty string rather than using unset. + #an 'array get' will resynchronise. + #Even if an env variable didn't exist before - setting it to empty string can get it to this inconsistent state. + array get ::env + } + #do an array read on ::env + foreach {v vinfo} $punkenv_config { + if {[info exists ::env($v)]} { + set c2 [set ::env($v)] + } else { + set c2 "(NOT SET)" + } + set help "" + if {[dict exists $vinfo help]} { + set help [dict get $vinfo help] + } + $t add_row [list $v $c2 $help] + } + $t configure_column 0 -headers [list "Punk environment vars"] + $t configure_column 0 -minwidth [expr {[$t column_datawidth 0]+4}] -blockalign left -textalign left -header_colspans {any} + + set punktable [$t print] + $t destroy + + set t [textblock::class::table new -show_hseps 0 -show_header 1 -ansiborder_header [a+ web-green]] + $t configure -frametype $frametype + foreach {v vinfo} $otherenv_config { + if {[info exists ::env($v)]} { + set env_val [set ::env($v)] + if {[string match "*_TM_PATH" $v]} { + set entries [split $env_val $::tcl_platform(pathSeparator)] + set c2 [join $entries \n] + } else { + set c2 $::env($v) + } + } else { + set c2 "(NOT SET)" + } + $t add_row [list $v $c2] + } + $t configure_column 0 -headers [list "Other environment vars"] + $t configure_column 0 -minwidth [expr {[$t column_datawidth 0]+4}] -blockalign left -textalign left -header_colspans {any} + + set othertable [$t print] + $t destroy + #append text [textblock::join -- $punktable " " $othertable]\n + append text $punktable\n$othertable\n + } else { + + append text $linesep\n + append text "punk environment vars:\n" + append text $linesep\n + set col1 [string repeat " " 25] + set col2 [string repeat " " 50] + foreach v $known_punk { + set c1 [overtype::left $col1 $v] + if {[info exists ::env($v)]} { + set c2 [overtype::left $col2 [set ::env($v)]] + } else { + set c2 [overtype::right $col2 "(NOT SET)"] + } + append text "$c1 $c2\n" + } + append text $linesep\n + } + + lappend chunks [list stdout $text] + return $chunks + } + + punk::args::define { + @id -id ::punk::helptopic::console + @cmd -name "help console" -summary "Console behaviour tests and warnings." -help "Run some console/terminal behaviour tests (control string hiding, grapheme cluster support, cursor position query timing) and report warnings. Requires a responsive interactive console." + @values -min 0 -max 0 + } + proc console {context args} { + set chunks [list] + set warningblock "" + set term_env_vars {TERM TERM_PROGRAM TERM_PROGRAM_VERSION COLORTERM} + set term_dict [dict create] + foreach e $term_env_vars { + if {[info exists ::env($e)]} { + dict set term_dict $e [set ::env($e)] + } else { + dict set term_dict $e "(NOT SET)" + } + } + set text "Terminal environment variables:\n" + append text [punk::lib::showdict $term_dict] \n + lappend chunks [list stdout $text] + set text "" + set indent [string repeat " " [string length "WARNING: "]] + + if {[catch {package require punk::console} result]} { + set text "Unable to load punk::console package - cannot test\n$result" + lappend chunks [list stdout $text] + } else { + + if {![catch {punk::console::class_info} console_class_info]} { + set text "Terminal class info (from device secondary attributes query to terminal):\n" + append text [punk::lib::showdict $console_class_info] \n + } else { + set text "Unable to query terminal class info - err:$console_class_info\n" + } + lappend chunks [list stdout $text] + + lappend cstring_tests [dict create {*}{ + type "PM " + msg "UN" + f7 punk::ansi::controlstring_PM + f7prefix "7bit ESC ^ secret " + f7suffix "safe" + f8 punk::ansi::controlstring_PM8 + f8prefix "8bit \\x9e secret " + f8suffix "safe" + }] + lappend cstring_tests [dict create {*}{ + type SOS + msg "NOT" + f7 punk::ansi::controlstring_SOS + f7prefix "7bit ESC X string " + f7suffix " hidden" + f8 punk::ansi::controlstring_SOS8 + f8prefix "8bit \\x98 string " + f8suffix " hidden" + }] + lappend cstring_tests [dict create {*}{ + type APC + msg "NOT" + f7 punk::ansi::controlstring_APC + f7prefix "7bit ESC _ APPLICATION PROGRAM COMMAND " + f7suffix " hidden" + f8 punk::ansi::controlstring_APC8 + f8prefix "8bit \\x9f APPLICATION PROGRAM COMMAND " + f8suffix " hidden" + }] + + foreach test $cstring_tests { + set m [[dict get $test f7] [dict get $test msg]] + set hidden_width_m [punk::console::test_char_width $m] + set m8 [[dict get $test f8] [dict get $test msg]] + set hidden_width_m8 [punk::console::test_char_width $m8] + if {$hidden_width_m != 0 || $hidden_width_m8 != 0} { + if {$hidden_width_m == 0} { + set d "[a+ green bold][dict get $test f7prefix][a red]${m}[a][a+ green bold][dict get $test f7suffix][a]" + } else { + set d "[a+ yellow bold][dict get $test f7prefix][a red]$m[a][a+ yellow bold][dict get $test f7suffix][a]" + } + if {$hidden_width_m8 == 0} { + set d8 "[a+ green ][dict get $test f8prefix][a red]$m8[a][a+ green][dict get $test f8suffix][a]" + } else { + set d8 "[a+ yellow bold][dict get $test f8prefix][a red]$m8[a][a+ yellow bold][dict get $test f8suffix][a]" + } + append warningblock \n "WARNING: terminal doesn't hide all [dict get $test type] control strings: $d $d8" + } + } + if {![catch {punk::console::check::has_bug_legacysymbolwidth} result]} { + if {$result} { + append warningblock \n "WARNING: terminal has legacysymbolwidth bug - screen position for symbol reports 2 wide but displays 1 wide." + append warningblock \n $indent "Layout using 'legacy symbols for computing' affected." + append warningblock \n $indent "(e.g textblock frametype block2 unsupported)" + append warningblock \n $indent "This can cause extreme layout deformation when ANSI is present" + append warningblock \n $indent "In some cases unwanted spacing effects occur at a distance from the characters causing it" + } + } else { + append warningblock \n "WARNING: terminal unable to check for legacysymbolwidth bug. err:$result" + } + + if {![catch {punk::console::check::has_bug_zwsp} result]} { + if {$result} { + append warningblock \n "WARNING: terminal has zero width space (\\u200b) bug - cursor position incremented when it shouldn't be." + append warningblock \n $indent "The zwsp may or may not be displayed. zwsp contributes to line length and wrapping point" + } + } else { + append warningblock \n "WARNING: terminal unable to check for zwsp bug. err:$result" + } + + + set grapheme_support [punk::console::grapheme_cluster_support] + #mode, 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) + if {![dict size $grapheme_support] || [dict get $grapheme_support mode] eq "unsupported" } { + append warningblock \n "WARNING: terminal either doesn't support grapheme clusters, or doesn't report so via decmode 2027 query." + if {[dict size $grapheme_support] && [dict get $grapheme_support available]} { + append warningblock \n $indent "(but punk::console::grapheme_cluster_support has determined it is probably available)" + } + } else { + if {![dict get $grapheme_support available]} { + switch -- [dict get $grapheme_support mode] { + "unset" { + append warningblock \n "WARNING: terminal reports via decmode 2027 that grapheme cluster support is off." + } + "permanently_unset" { + append warningblock \n "WARNING: terminal reports via decmode 2027 that grapheme cluster support is permanently off." + } + "BAD_RESPONSE" { + append warningblock \n "WARNING: terminal doesn't seem to recognize decmode 2027 query. No grapheme cluster support." + } + } + } + } + set posn [punk::console::get_cursor_pos] ;#warmup call - and test if works + if {$posn eq ""} { + append warningblock \n "WARNING: terminal doesn't respond to cursor position query - may cause display bugs in some cases." + } else { + set timeresult [timerate {set cpos [punk::console::get_cursor_pos]}] + lassign [split $cpos {;}] row col + if {![string is integer -strict $row] || ![string is integer -strict $col]} { + append warningblock \n "WARNING: terminal returns non-integer values for cursor position query - may cause display bugs in some cases. got row:'$row' col:'$col'" + } else { + set micros [lindex $timeresult 0] + if {$micros > 2000} { + append warningblock \n "WARNING: terminal cursor position query is very slow ($micros microseconds - expect < 2000us )" + append warningblock \n $indent "- may cause display lag/bugs in some cases." + } else { + if {$micros > 1000} { + set text "\n[a+ yellow]Terminal cursor position query test passed." + append text \n $indent "Response time: ${micros} microseconds (OK, good would be <= 1000us).[a]" + + } else { + set text "[a+ green]Terminal cursor position query test passed." + append text \n $indent "Response time: ${micros} microseconds (GOOD).[a]" + } + lappend chunks [list stdout $text] + } + } + } + + + if {![string length $warningblock]} { + set text "[a+ green]No terminal warnings[a]\n" + lappend chunks [list stdout $text] + } else { + set mode [punk::console::mode] + if {$mode eq "line"} { + append warningblock \n "Terminal appears to be in line mode. Consider switching to raw mode and re-testing (command: punk::console::mode raw)." + } + } + puts stdout [punk::ansi::move_back 200] ;#hack for some horizontal position bugs where the above tests can leave the cursor in the wrong place for the next output. + #200 is arbitrary large number to move back enough to get to start of line. + } + lappend chunks [list stderr $warningblock] + return $chunks } + + register topics {help} "List help topics" + register tcl {} "Tcl version warnings" + register env {environment} "punkshell environment vars" + register console {term terminal} "Some console behaviour tests and warnings" } + + #return list of {chan chunk} elements proc help_chunks {args} { - set argd [punk::args::parse $args withid ::punk::help_chunks] + set argd [punk::args::parse $args withid ::punk::help] lassign [dict values $argd] leaders opts values received - if {[dict exists $values arg]} { - set topicparts [dict get $values arg] + if {[dict exists $leaders topic]} { + set topicparts [dict get $leaders topic] } else { set topicparts [list ""] } - #set topic [lindex $args end] - #set argopts [lrange $args 0 end-1] - set chunks [list] - set linesep [string repeat - 76] - - set warningblock "" set I [punk::ansi::a+ italic] set NI [punk::ansi::a+ noitalic] @@ -8471,6 +8940,8 @@ namespace eval punk { } + set context [dict create cols $cols rows $rows frametype $frametype I $I NI $NI] + # ------------------------------------------------------- set logoblock "" if {[catch { @@ -8483,473 +8954,54 @@ namespace eval punk { set title "[a+ brightgreen] Help System: " set cmdinfo [list] lappend cmdinfo [list help "?${I}topic${NI}?" "This help.\nTo see available subitems type:\nhelp topics\n\nFor an unrecognised ${I}topic${NI}\nhelp will look for basic\ninfo for it as a command.\n"] - set t [textblock::class::table new -minwidth 51 -show_seps 0] - $t configure -frametype $frametype - foreach row $cmdinfo { - $t add_row $row - } - set width_0 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$width_0 + 2}] - set width_1 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$width_1 + 1}] - $t configure -title $title - set text [$t print] + set text [helptopic::table_block $frametype $title $cmdinfo 51] set introblock [textblock::join -- $logoblock $text] lappend chunks [list stdout $introblock\n] # ------------------------------------------------------- - switch -- [lindex $topicparts 0] { - "" { - - # ------------------------------------------------------- - set title "[a+ brightgreen] Filesystem navigation: " - set cmdinfo [list] - lappend cmdinfo [list ./ "?${I}glob${NI}?" "view/change dir, list dirs."] - lappend cmdinfo [list .// "?${I}glob${NI}?" "view/change dir, list dirs and files"] - lappend cmdinfo [list ../ "?${I}path${NI}" "go up one dir, then to path if given"] - lappend cmdinfo [list newdir "${I}subdir${NI}..." "make new dir or dirs and show status"] - lappend cmdinfo [list fcat "${I}file ?file?...${NI}" "cat file(s)"] - set t [textblock::class::table new -minwidth 80 -show_seps 0] - $t configure -frametype $frametype - foreach row $cmdinfo { - $t add_row $row - } - set width_0 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$width_0 + 2}] - set width_1 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$width_1 + 1}] - $t configure -title $title - - set text "" - append text [$t print] - lappend chunks [list stdout $text\n] - # ------------------------------------------------------- - - - # ------------------------------------------------------- - set title "[a+ brightgreen] Namespace navigation: " - set cmdinfo [list] - lappend cmdinfo [list n/ "?${I}ns${NI}|${I}glob${NI}?" "view/change namespace\n (accepts ns path globs e.g **::*get* to match\n commands at any level )"] - lappend cmdinfo [list n// "?${I}ns${NI}|${I}glob${NI}?" "view/change namespace (with command listing)"] - lappend cmdinfo [list "nn/" "" "go up one namespace"] - lappend cmdinfo [list "newns" "${I}ns${NI}" "make child namespace and switch to it"] - set t [textblock::class::table new -minwidth 80 -show_seps 0] - $t configure -frametype $frametype - foreach row $cmdinfo { - $t add_row $row - } - set width_0 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$width_0 + 2}] - set width_1 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$width_1 + 1}] - $t configure -title $title - - set text "" - append text [$t print] - lappend chunks [list stdout $text\n] - # ------------------------------------------------------- - - # ------------------------------------------------------- - set title "[a+ brightgreen] Command help: " - set cmdinfo [list] - lappend cmdinfo [list i "${I}cmd${NI} ?${I}subcommand${NI}...?" "Show usage for a command or ensemble subcommand"] - lappend cmdinfo [list s "${I}cmd${NI} ?${I}subcommand${NI}...?" "Show synopsis for a command or ensemble subcommand"] - lappend cmdinfo [list eg "${I}cmd${NI} ?${I}subcommand${NI}...?" "Show example from manpage"] - lappend cmdinfo [list corp "${I}proc${NI}" "View proc body and arguments with basic highlighting"] - set t [textblock::class::table new -minwidth 80 -show_seps 0] - $t configure -frametype $frametype - foreach row $cmdinfo { - $t add_row $row - } - set width_0 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$width_0 + 2}] - set width_1 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$width_1 + 1}] - $t configure -title $title - - set text "" - append text [$t print] - lappend chunks [list stdout $text\n] - # ------------------------------------------------------- - - - set title "[a+ brightgreen] Miscellaneous: " - #todo - load from source code annotation? - set cmdinfo [list] - lappend cmdinfo [list dev "?${I}subcommand${NI}?" "(ensemble command to make new projects/modules and\n to generate docs)"] - lappend cmdinfo [list a? "?${I}subcommand${NI}...?" "view ANSI colours\n e.g a? web\n or individual code samples/diagnostics\n e.g a? red bold\n e.g a? underline web-orange Term-purple3"] - lappend cmdinfo [list a+ "?${I}colourcode${NI}...?" "Return ANSI codes\n e.g puts \"\[a+ purple\]purple\[a+ Green\]purple on green\[a\]\"\n [a+ purple]purple[a+ Green]purple on green[a] "] - lappend cmdinfo [list a "?${I}colourcode${NI}...?" "Return ANSI codes (with leading reset)\n e.g puts \"\[a+ purple\]purple\[a Green\]normal on green\[a\]\"\n [a+ purple]purple[a Green]normal on green[a] "] - - set t [textblock::class::table new -minwidth 80 -show_seps 0] - $t configure -frametype $frametype - foreach row $cmdinfo { - $t add_row $row - } - set width_0 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$width_0 + 2}] - set width_1 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$width_1 + 1}] - $t configure -title $title - - set text "" - append text [$t print] - lappend chunks [list stdout $text] - # ------------------------------------------------------- - - } - tcl { - set text "Tcl Patchlevel: [info patchlevel]" - catch { - append text \n "Tcl build-info: [::tcl::build-info]" - } - #generate warningblocks for each triggered Tcl bug in namespace ::punk::lib::check - set bugcheck_procs [info procs ::punk::lib::check::has_tclbug*] - foreach bp $bugcheck_procs { - set buginfo [$bp] - if {[dict get $buginfo bug]} { - set level unknown - if {[dict exists $buginfo level]} { - set level [dict get $buginfo level] - } - switch -- $level { - minor {set highlight [punk::ansi::a+ cyan]} - medium {set highlight [punk::ansi::a+ yellow]} - major {set highlight [punk::ansi::a+ red bold]} - default {set highlight ""} - } - append warningblock \n $highlight "warning level: $level $bp triggered." - if {[dict exists $buginfo description]} { - set indent " " - append warningblock \n "[punk::lib::indent [dict get $buginfo description] $indent]" - } - if {[dict exists $buginfo bugref] && [dict get $buginfo bugref] ne ""} { - set bugref [dict get $buginfo bugref] - append warningblock \n "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/$bugref]" - } - append warningblock [a] - } - } - - if {[catch {lsearch -stride 2 {a b} b}]} { - #has_tclbug_lsearch_strideallinline will have reported bug false because it couldn't test it. - set indent " " - append warningblock \n "[a+ web-red]warning: lsearch does not seem to support -stride option" \n - append warningblock "${indent}(Consider upgrading to a late release of tcl 8.6 or tcl 9+ )" \n - append warningblock [a] - } - lappend chunks [list stdout $text] - } - env - environment { - set text "" - #todo - move to punk::config? - upvar ::punk::config::punk_env_vars_config punkenv_config - upvar ::punk::config::other_env_vars_config otherenv_config - - set known_punk [dict keys $punkenv_config] - set known_other [dict keys $otherenv_config] - append text \n - set usetable 1 - if {$usetable} { - set t [textblock::class::table new -show_hseps 0 -show_header 1 -ansiborder_header [a+ web-green]] - $t configure -frametype $frametype - if {"windows" eq $::tcl_platform(platform)} { - #If any env vars have been set to empty string - this is considered a deletion of the variable on windows. - #The Tcl ::env array is linked to the underlying process view of the environment - #- but info exists ::env(var) can misreport as true if it has been deleted by setting to empty string rather than using unset. - #an 'array get' will resynchronise. - #Even if an env variable didn't exist before - setting it to empty string can get it to this inconsistent state. - array get ::env - } - #do an array read on ::env - foreach {v vinfo} $punkenv_config { - if {[info exists ::env($v)]} { - set c2 [set ::env($v)] - } else { - set c2 "(NOT SET)" - } - set help "" - if {[dict exists $vinfo help]} { - set help [dict get $vinfo help] - } - $t add_row [list $v $c2 $help] - } - $t configure_column 0 -headers [list "Punk environment vars"] - $t configure_column 0 -minwidth [expr {[$t column_datawidth 0]+4}] -blockalign left -textalign left -header_colspans {any} - - set punktable [$t print] - $t destroy - - set t [textblock::class::table new -show_hseps 0 -show_header 1 -ansiborder_header [a+ web-green]] - $t configure -frametype $frametype - foreach {v vinfo} $otherenv_config { - if {[info exists ::env($v)]} { - set env_val [set ::env($v)] - if {[string match "*_TM_PATH" $v]} { - set entries [split $env_val $::tcl_platform(pathSeparator)] - set c2 [join $entries \n] - } else { - set c2 $::env($v) - } - } else { - set c2 "(NOT SET)" - } - $t add_row [list $v $c2] - } - $t configure_column 0 -headers [list "Other environment vars"] - $t configure_column 0 -minwidth [expr {[$t column_datawidth 0]+4}] -blockalign left -textalign left -header_colspans {any} - - set othertable [$t print] - $t destroy - #append text [textblock::join -- $punktable " " $othertable]\n - append text $punktable\n$othertable\n + set word0 [lindex $topicparts 0] + set topic [helptopic::resolve $word0] + if {$word0 eq ""} { + #no topic supplied - overview of key shell commands + lappend chunks {*}[helptopic::overview $context {*}[lrange $topicparts 1 end]] + } elseif {$topic ne ""} { + lappend chunks {*}[helptopic::$topic $context {*}[lrange $topicparts 1 end]] + } else { + #not a registered topic - fall through to basic command info lookup + set text "" + set cinfo [uplevel 1 [list ::punk::ns::cmdwhich [lindex $topicparts 0]]] + set wtype [dict get $cinfo whichtype] + if {$wtype eq "notfound"} { + set externalinfo [auto_execok [lindex $topicparts 0]] + if {[string length $externalinfo]} { + set text "$topicparts" + append text \n "Base type: External command" + append text \n "$externalinfo [lrange $topicparts 1 end]" } else { - - append text $linesep\n - append text "punk environment vars:\n" - append text $linesep\n - set col1 [string repeat " " 25] - set col2 [string repeat " " 50] - foreach v $known_punk { - set c1 [overtype::left $col1 $v] - if {[info exists ::env($v)]} { - set c2 [overtype::left $col2 [set ::env($v)]] - } else { - set c2 [overtype::right $col2 "(NOT SET)"] - } - append text "$c1 $c2\n" - } - append text $linesep\n + set text "$topicparts\n" + append text "No matching internal or external command found" } - - lappend chunks [list stdout $text] - } - console - term - terminal { - set term_env_vars {TERM TERM_PROGRAM TERM_PROGRAM_VERSION COLORTERM} - set term_dict [dict create] - foreach e $term_env_vars { - if {[info exists ::env($e)]} { - dict set term_dict $e [set ::env($e)] - } else { - dict set term_dict $e "(NOT SET)" - } - } - set text "Terminal environment variables:\n" - append text [punk::lib::showdict $term_dict] \n - lappend chunks [list stdout $text] - set text "" - set indent [string repeat " " [string length "WARNING: "]] - - if {[catch {package require punk::console} result]} { - set text "Unable to load punk::console package - cannot test\n$result" - lappend chunks [list stdout $text] - } else { - - if {![catch {punk::console::class_info} console_class_info]} { - set text "Terminal class info (from device secondary attributes query to terminal):\n" - append text [punk::lib::showdict $console_class_info] \n - } else { - set text "Unable to query terminal class info - err:$console_class_info\n" - } - lappend chunks [list stdout $text] - - lappend cstring_tests [dict create {*}{ - type "PM " - msg "UN" - f7 punk::ansi::controlstring_PM - f7prefix "7bit ESC ^ secret " - f7suffix "safe" - f8 punk::ansi::controlstring_PM8 - f8prefix "8bit \\x9e secret " - f8suffix "safe" - }] - lappend cstring_tests [dict create {*}{ - type SOS - msg "NOT" - f7 punk::ansi::controlstring_SOS - f7prefix "7bit ESC X string " - f7suffix " hidden" - f8 punk::ansi::controlstring_SOS8 - f8prefix "8bit \\x98 string " - f8suffix " hidden" - }] - lappend cstring_tests [dict create {*}{ - type APC - msg "NOT" - f7 punk::ansi::controlstring_APC - f7prefix "7bit ESC _ APPLICATION PROGRAM COMMAND " - f7suffix " hidden" - f8 punk::ansi::controlstring_APC8 - f8prefix "8bit \\x9f APPLICATION PROGRAM COMMAND " - f8suffix " hidden" - }] - - foreach test $cstring_tests { - set m [[dict get $test f7] [dict get $test msg]] - set hidden_width_m [punk::console::test_char_width $m] - set m8 [[dict get $test f8] [dict get $test msg]] - set hidden_width_m8 [punk::console::test_char_width $m8] - if {$hidden_width_m != 0 || $hidden_width_m8 != 0} { - if {$hidden_width_m == 0} { - set d "[a+ green bold][dict get $test f7prefix][a red]${m}[a][a+ green bold][dict get $test f7suffix][a]" - } else { - set d "[a+ yellow bold][dict get $test f7prefix][a red]$m[a][a+ yellow bold][dict get $test f7suffix][a]" - } - if {$hidden_width_m8 == 0} { - set d8 "[a+ green ][dict get $test f8prefix][a red]$m8[a][a+ green][dict get $test f8suffix][a]" - } else { - set d8 "[a+ yellow bold][dict get $test f8prefix][a red]$m8[a][a+ yellow bold][dict get $test f8suffix][a]" - } - append warningblock \n "WARNING: terminal doesn't hide all [dict get $test type] control strings: $d $d8" - } - } - if {![catch {punk::console::check::has_bug_legacysymbolwidth} result]} { - if {$result} { - append warningblock \n "WARNING: terminal has legacysymbolwidth bug - screen position for symbol reports 2 wide but displays 1 wide." - append warningblock \n $indent "Layout using 'legacy symbols for computing' affected." - append warningblock \n $indent "(e.g textblock frametype block2 unsupported)" - append warningblock \n $indent "This can cause extreme layout deformation when ANSI is present" - append warningblock \n $indent "In some cases unwanted spacing effects occur at a distance from the characters causing it" - } - } else { - append warningblock \n "WARNING: terminal unable to check for legacysymbolwidth bug. err:$result" - } - - if {![catch {punk::console::check::has_bug_zwsp} result]} { - if {$result} { - append warningblock \n "WARNING: terminal has zero width space (\\u200b) bug - cursor position incremented when it shouldn't be." - append warningblock \n $indent "The zwsp may or may not be displayed. zwsp contributes to line length and wrapping point" - } - } else { - append warningblock \n "WARNING: terminal unable to check for zwsp bug. err:$result" - } - - - set grapheme_support [punk::console::grapheme_cluster_support] - #mode, 1 = set, 2 = unset. (0 = mode not recognised, 3 = permanently set, 4 = permanently unset) - if {![dict size $grapheme_support] || [dict get $grapheme_support mode] eq "unsupported" } { - append warningblock \n "WARNING: terminal either doesn't support grapheme clusters, or doesn't report so via decmode 2027 query." - if {[dict size $grapheme_support] && [dict get $grapheme_support available]} { - append warningblock \n $indent "(but punk::console::grapheme_cluster_support has determined it is probably available)" - } - } else { - if {![dict get $grapheme_support available]} { - switch -- [dict get $grapheme_support mode] { - "unset" { - append warningblock \n "WARNING: terminal reports via decmode 2027 that grapheme cluster support is off." - } - "permanently_unset" { - append warningblock \n "WARNING: terminal reports via decmode 2027 that grapheme cluster support is permanently off." - } - "BAD_RESPONSE" { - append warningblock \n "WARNING: terminal doesn't seem to recognize decmode 2027 query. No grapheme cluster support." - } - } - } - } - set posn [punk::console::get_cursor_pos] ;#warmup call - and test if works - if {$posn eq ""} { - append warningblock \n "WARNING: terminal doesn't respond to cursor position query - may cause display bugs in some cases." - } else { - set timeresult [timerate {set cpos [punk::console::get_cursor_pos]}] - lassign [split $cpos {;}] row col - if {![string is integer -strict $row] || ![string is integer -strict $col]} { - append warningblock \n "WARNING: terminal returns non-integer values for cursor position query - may cause display bugs in some cases. got row:'$row' col:'$col'" - } else { - set micros [lindex $timeresult 0] - if {$micros > 2000} { - append warningblock \n "WARNING: terminal cursor position query is very slow ($micros microseconds - expect < 2000us )" - append warningblock \n $indent "- may cause display lag/bugs in some cases." - } else { - if {$micros > 1000} { - set text "\n[a+ yellow]Terminal cursor position query test passed." - append text \n $indent "Response time: ${micros} microseconds (OK, good would be <= 1000us).[a]" - - } else { - set text "[a+ green]Terminal cursor position query test passed." - append text \n $indent "Response time: ${micros} microseconds (GOOD).[a]" - } - lappend chunks [list stdout $text] - } - } - } - - - if {![string length $warningblock]} { - set text "[a+ green]No terminal warnings[a]\n" - lappend chunks [list stdout $text] + } else { + set text "[dict get $cinfo which] [lrange $topicparts 1 end]" + append text \n "Base type: $wtype" + set synopsis [uplevel 1 [list ::punk::ns::synopsis {*}$topicparts]] + set synshow "" + foreach sline [split $synopsis \n] { + if {[regexp {\s*#.*} $sline]} { + append synshow [punk::ansi::a+ bold term-darkgreen Term-white]$sline[punk::ansi::a] \n } else { - set mode [punk::console::mode] - if {$mode eq "line"} { - append warningblock \n "Terminal appears to be in line mode. Consider switching to raw mode and re-testing (command: punk::console::mode raw)." - } + append synshow $sline \n } - puts stdout [punk::ansi::move_back 200] ;#hack for some horizontal position bugs where the above tests can leave the cursor in the wrong place for the next output. - #200 is arbitrary large number to move back enough to get to start of line. - } - } - topics - help { - set text "" - set topics [dict create {*}{ - "topics|help" "List help topics" - "tcl" "Tcl version warnings" - "env|environment" "punkshell environment vars" - "console|terminal" "Some console behaviour tests and warnings" - "*" "Try to find help on the topic as a command or external executable" - }] - - set t [textblock::class::table new -show_seps 0] - $t configure -frametype $frametype - $t add_column -headers [list "Topic"] - $t add_column - foreach {k v} $topics { - $t add_row [list $k $v] } - set widest0 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$widest0 + 4}] - append text \n [$t print] - - lappend chunks [list stdout $text] - } - default { - set text "" - set cinfo [uplevel 1 [list ::punk::ns::cmdwhich [lindex $topicparts 0]]] - set wtype [dict get $cinfo whichtype] - if {$wtype eq "notfound"} { - set externalinfo [auto_execok [lindex $topicparts 0]] - if {[string length $externalinfo]} { - set text "$topicparts" - append text \n "Base type: External command" - append text \n "$externalinfo [lrange $topicparts 1 end]" - } else { - set text "$topicparts\n" - append text "No matching internal or external command found" - } - } else { - set text "[dict get $cinfo which] [lrange $topicparts 1 end]" - append text \n "Base type: $wtype" - set synopsis [uplevel 1 [list ::punk::ns::synopsis {*}$topicparts]] - set synshow "" - foreach sline [split $synopsis \n] { - if {[regexp {\s*#.*} $sline]} { - append synshow [punk::ansi::a+ bold term-darkgreen Term-white]$sline[punk::ansi::a] \n - } else { - append synshow $sline \n - } - } - if {[string index $synshow end] eq "\n"} { - set synshow [string range $synshow 0 end-1] - } - append text \n $synshow + if {[string index $synshow end] eq "\n"} { + set synshow [string range $synshow 0 end-1] } - lappend chunks [list stdout $text] + append text \n $synshow } + lappend chunks [list stdout $text] } - - - lappend chunks [list stderr $warningblock] return $chunks } proc mode {{raw_or_line query}} { diff --git a/src/modules/punk-buildversion.txt b/src/modules/punk-buildversion.txt index 48ca3d02..40163c14 100644 --- a/src/modules/punk-buildversion.txt +++ b/src/modules/punk-buildversion.txt @@ -1,3 +1,4 @@ -0.1.1 -#First line must be a semantic version number -#all other lines are ignored. +0.2.0 +#First line must be a semantic version number +#all other lines are ignored. +#0.2.0 - help system restructured onto a topic registry (::punk::helptopic: register/resolve, per-topic handler procs each with a punk::args definition); ::punk::help and ::punk::help_chunks punk::args definitions (re)generated from the registry so 'i help' / 'i help ' render documented usage; 'help topics' derived from the registry; command-fallthrough and no-arg overview output unchanged; 'help env' degrades cleanly when punk::config is not initialised; help table objects destroyed after printing (leak fix)