From 2b339bf0e039d85111f23e3d6713a51e7f7e2e26 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sat, 18 Jul 2026 17:29:07 +1000 Subject: [PATCH] vfscommon + bootsupport: punk::path 0.3.0, punk::args 0.12.6, punk::ns 0.9.0 (punkcheck-managed build outputs) Batch refresh via make.tcl packages/bootsupport/vfscommonupdate: punk::path 0.2.2 -> 0.3.0 (extensionless lib: tcl identification - this change-set), plus promotion of punk::args 0.12.6 and punk::ns 0.9.0 built at the previous source commit. vfscommon lib copies of app-punkscript/app-punkshell/ app_shellrun pick up the shared scriptlib_resolve refactor. Includes the project-layout bootsupport snapshot copies (punkboot-bootsupport installer). Kit deploys to bin/ for punk91.exe and punk902z.exe were blocked by running shell instances holding the executables (build reported the failed deletes); rerun make.tcl project (or close the shells first) to deploy - tests were run against the freshly built kit from src/_build. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- .../punk/{args-0.12.5.tm => args-0.12.6.tm} | 104 ++++++++++--- .../modules/punk/ns-0.9.0.tm} | 77 ++++++++- .../modules/punk/path-0.3.0.tm} | 147 +++++++++++++++--- .../bootsupport/modules/punk/args-0.12.6.tm} | 104 ++++++++++--- .../src/bootsupport/modules/punk/ns-0.9.0.tm} | 77 ++++++++- .../bootsupport/modules/punk/path-0.3.0.tm} | 147 +++++++++++++++--- .../bootsupport/modules/punk/args-0.12.6.tm} | 104 ++++++++++--- .../modules/punk/{ns-0.8.1.tm => ns-0.9.0.tm} | 77 ++++++++- .../bootsupport/modules/punk/path-0.3.0.tm} | 147 +++++++++++++++--- .../lib/app-punkscript/punkscript.tcl | 10 +- .../lib/app-punkshell/punkshell.tcl | 105 ++++--------- .../lib/app_shellrun/app_shellrun.tcl | 105 ++++--------- .../modules/punk/args-0.12.6.tm} | 104 ++++++++++--- .../modules/punk/{ns-0.8.1.tm => ns-0.9.0.tm} | 77 ++++++++- .../punk/{path-0.2.2.tm => path-0.3.0.tm} | 147 +++++++++++++++--- 15 files changed, 1158 insertions(+), 374 deletions(-) rename src/bootsupport/modules/punk/{args-0.12.5.tm => args-0.12.6.tm} (99%) rename src/{project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.8.1.tm => bootsupport/modules/punk/ns-0.9.0.tm} (98%) rename src/{project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.2.2.tm => bootsupport/modules/punk/path-0.3.0.tm} (91%) rename src/project_layouts/custom/_project/{punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.5.tm => punk.project-0.1/src/bootsupport/modules/punk/args-0.12.6.tm} (99%) rename src/{bootsupport/modules/punk/ns-0.8.1.tm => project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm} (98%) rename src/project_layouts/custom/_project/{punk.shell-0.1/src/bootsupport/modules/punk/path-0.2.2.tm => punk.project-0.1/src/bootsupport/modules/punk/path-0.3.0.tm} (91%) rename src/{vfs/_vfscommon.vfs/modules/punk/args-0.12.5.tm => project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.6.tm} (99%) rename src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/{ns-0.8.1.tm => ns-0.9.0.tm} (98%) rename src/{bootsupport/modules/punk/path-0.2.2.tm => project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.3.0.tm} (91%) rename src/{project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.5.tm => vfs/_vfscommon.vfs/modules/punk/args-0.12.6.tm} (99%) rename src/vfs/_vfscommon.vfs/modules/punk/{ns-0.8.1.tm => ns-0.9.0.tm} (98%) rename src/vfs/_vfscommon.vfs/modules/punk/{path-0.2.2.tm => path-0.3.0.tm} (91%) diff --git a/src/bootsupport/modules/punk/args-0.12.5.tm b/src/bootsupport/modules/punk/args-0.12.6.tm similarity index 99% rename from src/bootsupport/modules/punk/args-0.12.5.tm rename to src/bootsupport/modules/punk/args-0.12.6.tm index c1636210..3d9acb4c 100644 --- a/src/bootsupport/modules/punk/args-0.12.5.tm +++ b/src/bootsupport/modules/punk/args-0.12.6.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::args 0.12.5 +# Application punk::args 0.12.6 # Meta platform tcl # Meta license # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::args 0 0.12.5] +#[manpage_begin punkshell_module_punk::args 0 0.12.6] #[copyright "2024"] #[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}] @@ -5246,7 +5246,11 @@ tcl::namespace::eval punk::args { # use basic colours here to support terminals without extended colours #todo - add checks column (e.g -minsize -maxsize) - set errmsg $msg + #2026-07-18 (user direction): the supplied error message (and any per-form + #match detail it carries) renders once, BELOW the usage output - see the + #bottom-append near the end of this proc. It previously also rendered here + #at the top, duplicating the block above and below the usage display. + set errmsg "" if {![catch {package require textblock}]} { set has_textblock 1 } else { @@ -5260,14 +5264,8 @@ tcl::namespace::eval punk::args { } set errlines [list] ;#for non-textblock output if {[catch { - if {$use_table} { - append errmsg \n - } else { - if {!$has_textblock && ($returntype in {table tableobject})} { - append errmsg \n "$CLR(errormsg)(layout package textblock is missing)$RST" \n - } else { - append errmsg \n - } + if {!$use_table && !$has_textblock && ($returntype in {table tableobject})} { + append errmsg "$CLR(errormsg)(layout package textblock is missing)$RST" \n } set cmdname [Dict_getdef $spec_dict cmd_info -name ""] set cmdsummary [Dict_getdef $spec_dict cmd_info -summary ""] @@ -6031,12 +6029,35 @@ tcl::namespace::eval punk::args { $choicetableobj configure -title $CLR(groupname)$groupname #append help \n[textblock::join -- " " [$choicetableobj print]] } else { + #string renderer (2026-07-18): markdown-subset list structure so + #choices are machine-distinguishable from their label text (the + #previous flat join left choice names and multi-line labels at + #inconsistent depths with nothing marking which lines were + #choices once ANSI is stripped). Each choice renders as a + #'- `choice`' bullet at a fixed indent; the label's first line + #follows on the bullet line after the closing backtick, label + #continuation lines indent 2 past the bullet dash. The backticked + #token may carry a trailing choiceinfo marker glyph. if {$groupname ne ""} { - append help \n \n "$CLR(groupname)Group: $groupname$RST" - } else { - append help \n + append help \n " $CLR(groupname)Group '$groupname':$RST" + } + foreach cformatted $formatted { + set clines [split $cformatted \n] + set bulletline " - `[lindex $clines 0]`" + set lbllines [lrange $clines 1 end] + if {[llength $lbllines]} { + set lblfirst [lindex $lbllines 0] + if {[string trim $lblfirst] ne ""} { + append bulletline " - [string trimleft $lblfirst]" + } + append help \n $bulletline + foreach lblline [lrange $lbllines 1 end] { + append help \n " $lblline" + } + } else { + append help \n $bulletline + } } - append help \n [join $formatted \n] } } else { #we were given an empty set of choices. @@ -6159,8 +6180,26 @@ tcl::namespace::eval punk::args { $t configure_row [expr {[$t row_count]-1}] -ansibase $A_GOODARG } } else { - #review - formatting will be all over the shop due to newlines in typesshow, help - set linetail " TYPE:$typeshow DEFAULT:$default MULTI:$multiple" + #single-line field layout (2026-07-18): the table-cell fields are + #multi-line (type constraints such as -minsize each on their own + #line) - flatten them so each argument renders as one 'name + #TYPE:... ?DEFAULT:...? ?MULTI:yes?' line, and omit empty + #DEFAULT/MULTI rather than rendering empty labels. Constraint + #annotations attach to the type in parentheses e.g + #TYPE:list(-minsize 2 -maxsize 2). + set typeline [string map [list \n " "] $typeshow] + if {$typeline ne $typeshow} { + #had constraint lines - parenthesize them onto the base type + set tparts [split $typeshow \n] + set typeline "[lindex $tparts 0]([join [lrange $tparts 1 end] { }])" + } + set linetail " TYPE:$typeline" + if {[dict exists $arginfo -default]} { + append linetail " DEFAULT:[string map [list \n " "] $default]" + } + if {$is_multiple} { + append linetail " MULTI:yes" + } if {$hint ne ""} { set arghelp [textblock::join -- "[a+ bold]$argshow\n$hint$RST" $linetail] } else { @@ -6172,8 +6211,10 @@ tcl::namespace::eval punk::args { } elseif {$arg_status eq "ok"} { set arghelp [punk::ansi::ansiwrap -rawansi $A_GOODARG $arghelp] } - foreach ln [split $help \n] { - append arghelp " $ln" \n + if {[string trim [punk::ansi::ansistripraw $help]] ne ""} { + foreach ln [split $help \n] { + append arghelp " $ln" \n + } } lappend errlines $arghelp } @@ -6225,7 +6266,11 @@ tcl::namespace::eval punk::args { if {$use_table} { $t add_row [list "$argshow" $tp $default "" ""] } else { - set arghelp "[a+ bold]$argshow$RST TYPE:$tp DEFAULT:$default\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$tp" + if {$default ne ""} { + append arghelp " DEFAULT:$default" + } + append arghelp \n lappend errlines $arghelp } } @@ -6246,7 +6291,11 @@ tcl::namespace::eval punk::args { if {$use_table} { $t add_row [list "$argshow" $tp $default "" ""] } else { - set arghelp "[a+ bold]$argshow$RST TYPE:$tp DEFAULT:$default\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$tp" + if {$default ne ""} { + append arghelp " DEFAULT:$default" + } + append arghelp \n lappend errlines $arghelp } } @@ -6290,12 +6339,17 @@ tcl::namespace::eval punk::args { set result $t } } else { - #put original error at bottom of table too - append result \n $msg + #sole emission of the original error message - below the usage table + if {$msg ne ""} { + append result \n $msg + } } } else { set result $errmsg - append result \n $msg + #sole emission of the original error message - below the usage text + if {$msg ne ""} { + append result \n $msg + } } if {$as_error} { #add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it. @@ -14017,7 +14071,7 @@ package provide punk::args [tcl::namespace::eval punk::args { tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version - set version 0.12.5 + set version 0.12.6 }] return diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.8.1.tm b/src/bootsupport/modules/punk/ns-0.9.0.tm similarity index 98% rename from src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.8.1.tm rename to src/bootsupport/modules/punk/ns-0.9.0.tm index 5cb07840..79994f5e 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.8.1.tm +++ b/src/bootsupport/modules/punk/ns-0.9.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::ns 0.8.1 +# Application punk::ns 0.9.0 # Meta platform tcl # Meta license # @@ Meta End @@ -5386,11 +5386,12 @@ y" {return quirkykeyscript} usage information as this is inherently risky. (could create a file, exit the interp etc) " - -return -type string -default table -choices {string table tableobject dict} -choicelabels { + -return -type string -default table -choices {string table tableobject dict text} -choicelabels { string "no table layout" table "full table layout" tableobject "table object cmd" dict "machine-parsable resolution + parse-status" + text "plain text, ANSI-free, all forms" } -help\ "Return form of the usage information. 'dict' returns a dict with keys origin, docid, cmdtype, @@ -5399,7 +5400,13 @@ y" {return quirkykeyscript} the resolved definition (see punk::args::parse_status for the documented structure; empty if the command is undocumented). Its per-argument statuses distinguish a fully-valid, an invalid - and an incomplete argument set machine-parsably." + and an incomplete argument set machine-parsably. + 'text' returns plain text with no ANSI codes and no table + layout, rendering the argument section of every command form + (or of each form in an explicit -form selection) in a single + output - unlike the interactive displays, which render only + the best-matching form's argument table. Intended for + machine/LLM consumption of the full documentation." } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { @@ -5468,6 +5475,68 @@ y" {return quirkykeyscript} set nextopts [dict remove $opts -grepstr] #JJJ + if {$opt_return eq "text"} { + #Plain-text renderer for machine/LLM consumption: no ANSI, no table layout, + #and the argument section of every selected command form rendered in one + #output rather than only the G-041 best-matching form's argument table. + #Resolution (aliases, ensembles, docid, form candidacy) is delegated to the + #-return dict recursion; each form's argument section then renders via the + #string renderer and the sections are joined below the common header. + set dinfo [uplevel 1 [list ::punk::ns::cmdhelp -return dict -form $opt_form -- $querycommand {*}$queryargs]] + set docid [dict get $dinfo docid] + if {$docid eq ""} { + return "Undocumented command [dict get $dinfo origin]. Type: [dict get $dinfo cmdtype]" + } + set spec [punk::args::get_spec $docid] + set pstatus [dict get $dinfo parsestatus] + if {$opt_form ne "*"} { + set forms $opt_form + } elseif {[llength [dict get $dinfo args_remaining]]} { + #argument words were supplied - restrict to the form(s) the advisory + #parse selected (matched/best-candidate; all candidates on noformmatch) + if {![dict get $pstatus ok] && [dict get $pstatus failureclass] in {noformmatch multipleformmatches}} { + set forms [dict keys [dict get $pstatus formstatus]] + } else { + set forms [dict get $pstatus form] + } + } else { + set forms [dict get $spec form_names] + } + if {[llength [dict get $spec form_names]] < 2} { + set result [punk::ansi::ansistripraw [punk::args::arg_error "" $spec -aserror 0 -return string -scheme nocolour -form [lindex $forms 0]]] + } else { + set marker " --ARGUMENTS-- " ;#the string renderer's argument-section heading line + set result "" + set fnum 0 + foreach fid $forms { + set fout [punk::ansi::ansistripraw [punk::args::arg_error "" $spec -aserror 0 -return string -scheme nocolour -form $fid]] + set idx [string first $marker $fout] + if {$idx < 0} { + #no argument-section heading (e.g custom FORMDISPLAY) - emit whole output once + if {$fnum == 0} { + append result $fout + } + } else { + if {$fnum == 0} { + #common header (command help + all-forms synopsis) - emit once + append result [string range $fout 0 $idx-1] + } + append result " --ARGUMENTS (form '$fid')-- " [string range $fout $idx+[string length $marker] end] \n + } + incr fnum + } + set result [string trimright $result \n] + } + if {$opt_grepstr ne ""} { + if {[llength $opt_grepstr] == 1} { + set result [punk::ansi::grepstr --ignore-case -return all [lindex $opt_grepstr 0] $result] + } else { + set result [punk::ansi::grepstr --ignore-case -return all -highlight [lrange $opt_grepstr 1 end] [lindex $opt_grepstr 0] $result] + } + } + return $result + } + set whichinfo [uplevel 1 [list ::punk::ns::cmdwhich $querycommand]] set rootorigin [dict get $whichinfo origin] set which [dict get $whichinfo which] @@ -6572,6 +6641,6 @@ namespace eval ::punk::args::register { ## Ready package provide punk::ns [tcl::namespace::eval punk::ns { variable version - set version 0.8.1 + set version 0.9.0 }] return diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.2.2.tm b/src/bootsupport/modules/punk/path-0.3.0.tm similarity index 91% rename from src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.2.2.tm rename to src/bootsupport/modules/punk/path-0.3.0.tm index 0ae49215..2f1858e8 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.2.2.tm +++ b/src/bootsupport/modules/punk/path-0.3.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::path 0.2.2 +# Application punk::path 0.3.0 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::path 0 0.2.2] +#[manpage_begin punkshell_module_punk::path 0 0.3.0] #[copyright "2023"] #[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}] #[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] @@ -504,15 +504,32 @@ namespace eval punk::path { an executable in /bin. 3. /scriptlib. - If the name's extension (lowercased) is not one of the known - scriptlib extensions (.tcl .py .pl .ps1 .sh), '.tcl' is - appended - only .tcl scripts may be named extensionlessly. + If the name's extension (lowercased) is one of the known + scriptlib extensions (.tcl .kit .py .pl .ps1 .sh), only that + exact name is searched. Otherwise two spellings are tried within + EACH location before moving to the next (so the kit-internal + precedence above is never crossed by a spelling preference): + 1. the exact name as called - accepted only if the file's + first lines identify it as a tcl script: a leading + '# tcl' comment, a shebang naming tclsh/tclkit/wish, or + the portable sh-trampoline ('#!/bin/sh' followed by a + commented 'exec tclsh ...' in the next lines). + 2. the name with '.tcl' appended. + An exact-name file that fails the tcl identification check is + skipped (recorded in notes) and resolution falls through. Returns a dict with keys: path - resolved absolute path, or empty string if not found - scriptname - the name searched for (extension applied) + scriptname - the relative name that matched; when not found, + the primary name searched for + scripttype - resolved script type: the extension without its + dot (tcl, kit, py, pl, ps1, sh), 'tcl' for an + extensionless file that passed the identification + check, or empty string when not found candidates - the locations that were (or would be) checked, - for use in error messages. + for use in error messages + notes - explanatory notes (e.g files skipped by the tcl + identification check), for use in error messages. Raises an error if name is not a relative path." @leaders name -type string -optional 0 -help\ @@ -522,20 +539,26 @@ namespace eval punk::path { } proc scriptlib_resolve {name} { #shared resolution policy for the 'lib:' script prefix - used by the punk - #executable 'script' subcommand (app-punkscript); app-punkshell's shell - #subcommand encodes the same policy (todo: refactor it onto this proc). + #executable 'script' subcommand (app-punkscript) and the shell subcommand's + #lib: handling (app-punkshell, app_shellrun). if {[lindex [pathtype $name] 0] ne "relative"} { error "punk::path::scriptlib_resolve name must be a relative path (got '$name')" } - set known_extensions [list .tcl .py .pl .ps1 .sh] + set known_extensions [list .tcl .kit .py .pl .ps1 .sh] + #spellings: {relname needs_tcl_check} pairs tried in order within each + #directory - the spelling matching the way the script was called wins + #per-directory, and directory precedence (kit-internal first) is never + #crossed by a spelling preference. if {[string tolower [file extension $name]] ni $known_extensions} { - #only .tcl scripts allowed to be called extensionlessly + #extensionless (or unknown-extension) call: the exact name wins when + #the file identifies as tcl, else fall through to the .tcl spelling. + set spellings [list [list $name 1] [list $name.tcl 0]] set scriptname $name.tcl } else { + set spellings [list [list $name 0]] set scriptname $name } set exepath [file dirname [file normalize [file join [info nameofexecutable] ___]]] ;#symlink resolve - set candidates [list] #1) kit-internal scriptlib - not overridable externally set has_zipfs_command [expr {[info commands ::tcl::zipfs::root] ne ""}] set kit_base "" @@ -550,21 +573,38 @@ namespace eval punk::path { } elseif {[file exists $exepath/scriptlib]} { set kit_libdir $exepath/scriptlib } + set search_dirs [list] if {$kit_libdir ne ""} { - lappend candidates $kit_libdir/$scriptname - if {[file exists $kit_libdir/$scriptname]} { - return [dict create path $kit_libdir/$scriptname scriptname $scriptname candidates $candidates] - } + lappend search_dirs $kit_libdir } #2,3) external scriptlib folders relative to the executable location set exedir [file dirname $exepath] - foreach dir [list [file join $exedir scriptlib] [file join [file dirname $exedir] scriptlib]] { - lappend candidates [file join $dir $scriptname] - if {[file isdirectory $dir] && [file exists [file join $dir $scriptname]]} { - return [dict create path [file join $dir $scriptname] scriptname $scriptname candidates $candidates] + lappend search_dirs [file join $exedir scriptlib] [file join [file dirname $exedir] scriptlib] + + set candidates [list] + set notes [list] + foreach dir $search_dirs { + foreach spelling $spellings { + lassign $spelling relname needs_tcl_check + set fpath [file join $dir $relname] + lappend candidates $fpath + if {![file isfile $fpath]} { + #isfile (not exists) - an extensionless call must not match a directory of the same name + continue + } + if {$needs_tcl_check} { + if {![punk::path::system::scriptfile_is_tcl $fpath]} { + lappend notes "$fpath exists but its first lines do not identify it as tcl (leading '# tcl' comment or tcl shebang) - skipped" + continue + } + set scripttype tcl + } else { + set scripttype [string range [string tolower [file extension $fpath]] 1 end] + } + return [dict create path $fpath scriptname $relname scripttype $scripttype candidates $candidates notes $notes] } } - return [dict create path "" scriptname $scriptname candidates $candidates] + return [dict create path "" scriptname $scriptname scripttype "" candidates $candidates notes $notes] } proc plain {str} { @@ -1676,14 +1716,71 @@ namespace eval punk::path::system { #[subsection {Namespace punk::path::system}] #[para] Internal functions that are not part of the API - - + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punk::path::system::scriptfile_is_tcl + @cmd -name "punk::path::system::scriptfile_is_tcl"\ + -summary\ + "Test whether a script file's first lines identify it as a tcl script"\ + -help\ + "Reads a small bounded chunk (512 bytes) of the file and reports 1 if + the first line is a '# tcl'-prefixed comment (case-insensitive), a + shebang naming tclsh/tclkit/wish, or any other shebang whose next + few lines contain the portable sh-trampoline 'exec tclsh ...' idiom. + A UTF-8 BOM and CRLF line endings are tolerated. Returns 0 for + unreadable files and anything not identified as tcl. + Used by punk::path::scriptlib_resolve to allow extensionless tcl + scripts to be called via the lib: prefix." + @leaders + fpath -type string -optional 0 -help\ + "path of the file to examine" + }] + } + proc scriptfile_is_tcl {fpath} { + if {[catch {open $fpath r} fd]} { + return 0 + } + set chunk "" + catch {chan configure $fd -encoding utf-8} + catch {set chunk [read $fd 512]} + catch {close $fd} + if {[string index $chunk 0] eq "\uFEFF"} { + #utf-8 BOM as decoded above + set chunk [string range $chunk 1 end] + } + set lines [lmap ln [lrange [split $chunk \n] 0 3] {string trimright $ln \r}] + set line1 [lindex $lines 0] + if {[string index $line1 0] ne "#"} { + return 0 + } + if {[regexp {^#!.*\m(tclsh|tclkit|wish)} $line1]} { + #shebang naming a tcl interpreter e.g #!/usr/bin/env tclsh, #!/usr/bin/tclsh9.0 + return 1 + } + if {[regexp -nocase {^#\s*tcl} $line1]} { + #'# tcl' marker comment (prefix match - '# tclscript' etc also accepted) + return 1 + } + if {[string range $line1 0 1] eq "#!"} { + #any other shebang (e.g #!/bin/sh): accept the portable sh-trampoline idiom + # #!/bin/sh + # # \ + # exec tclsh "$0" ${1+"$@"} + #(the backslash-continued comment hides the exec line from tcl but not from sh) + foreach ln [lrange $lines 1 end] { + if {[regexp {^\s*exec\s.*\m(tclsh|tclkit|wish)} $ln]} { + return 1 + } + } + } + return 0 + } } namespace eval ::punk::args::register { #use fully qualified so 8.6 doesn't find existing var in global namespace #documentation-only PUNKARGS registration - discovered lazily if/when punk::args loads - lappend ::punk::args::register::NAMESPACES ::punk::path::argdoc + lappend ::punk::args::register::NAMESPACES ::punk::path::argdoc ::punk::path::system::argdoc } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -1691,7 +1788,7 @@ namespace eval ::punk::args::register { package provide punk::path [namespace eval punk::path { variable pkg punk::path variable version - set version 0.2.2 + set version 0.3.0 }] return diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.5.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.6.tm similarity index 99% rename from src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.5.tm rename to src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.6.tm index c1636210..3d9acb4c 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.5.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.6.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::args 0.12.5 +# Application punk::args 0.12.6 # Meta platform tcl # Meta license # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::args 0 0.12.5] +#[manpage_begin punkshell_module_punk::args 0 0.12.6] #[copyright "2024"] #[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}] @@ -5246,7 +5246,11 @@ tcl::namespace::eval punk::args { # use basic colours here to support terminals without extended colours #todo - add checks column (e.g -minsize -maxsize) - set errmsg $msg + #2026-07-18 (user direction): the supplied error message (and any per-form + #match detail it carries) renders once, BELOW the usage output - see the + #bottom-append near the end of this proc. It previously also rendered here + #at the top, duplicating the block above and below the usage display. + set errmsg "" if {![catch {package require textblock}]} { set has_textblock 1 } else { @@ -5260,14 +5264,8 @@ tcl::namespace::eval punk::args { } set errlines [list] ;#for non-textblock output if {[catch { - if {$use_table} { - append errmsg \n - } else { - if {!$has_textblock && ($returntype in {table tableobject})} { - append errmsg \n "$CLR(errormsg)(layout package textblock is missing)$RST" \n - } else { - append errmsg \n - } + if {!$use_table && !$has_textblock && ($returntype in {table tableobject})} { + append errmsg "$CLR(errormsg)(layout package textblock is missing)$RST" \n } set cmdname [Dict_getdef $spec_dict cmd_info -name ""] set cmdsummary [Dict_getdef $spec_dict cmd_info -summary ""] @@ -6031,12 +6029,35 @@ tcl::namespace::eval punk::args { $choicetableobj configure -title $CLR(groupname)$groupname #append help \n[textblock::join -- " " [$choicetableobj print]] } else { + #string renderer (2026-07-18): markdown-subset list structure so + #choices are machine-distinguishable from their label text (the + #previous flat join left choice names and multi-line labels at + #inconsistent depths with nothing marking which lines were + #choices once ANSI is stripped). Each choice renders as a + #'- `choice`' bullet at a fixed indent; the label's first line + #follows on the bullet line after the closing backtick, label + #continuation lines indent 2 past the bullet dash. The backticked + #token may carry a trailing choiceinfo marker glyph. if {$groupname ne ""} { - append help \n \n "$CLR(groupname)Group: $groupname$RST" - } else { - append help \n + append help \n " $CLR(groupname)Group '$groupname':$RST" + } + foreach cformatted $formatted { + set clines [split $cformatted \n] + set bulletline " - `[lindex $clines 0]`" + set lbllines [lrange $clines 1 end] + if {[llength $lbllines]} { + set lblfirst [lindex $lbllines 0] + if {[string trim $lblfirst] ne ""} { + append bulletline " - [string trimleft $lblfirst]" + } + append help \n $bulletline + foreach lblline [lrange $lbllines 1 end] { + append help \n " $lblline" + } + } else { + append help \n $bulletline + } } - append help \n [join $formatted \n] } } else { #we were given an empty set of choices. @@ -6159,8 +6180,26 @@ tcl::namespace::eval punk::args { $t configure_row [expr {[$t row_count]-1}] -ansibase $A_GOODARG } } else { - #review - formatting will be all over the shop due to newlines in typesshow, help - set linetail " TYPE:$typeshow DEFAULT:$default MULTI:$multiple" + #single-line field layout (2026-07-18): the table-cell fields are + #multi-line (type constraints such as -minsize each on their own + #line) - flatten them so each argument renders as one 'name + #TYPE:... ?DEFAULT:...? ?MULTI:yes?' line, and omit empty + #DEFAULT/MULTI rather than rendering empty labels. Constraint + #annotations attach to the type in parentheses e.g + #TYPE:list(-minsize 2 -maxsize 2). + set typeline [string map [list \n " "] $typeshow] + if {$typeline ne $typeshow} { + #had constraint lines - parenthesize them onto the base type + set tparts [split $typeshow \n] + set typeline "[lindex $tparts 0]([join [lrange $tparts 1 end] { }])" + } + set linetail " TYPE:$typeline" + if {[dict exists $arginfo -default]} { + append linetail " DEFAULT:[string map [list \n " "] $default]" + } + if {$is_multiple} { + append linetail " MULTI:yes" + } if {$hint ne ""} { set arghelp [textblock::join -- "[a+ bold]$argshow\n$hint$RST" $linetail] } else { @@ -6172,8 +6211,10 @@ tcl::namespace::eval punk::args { } elseif {$arg_status eq "ok"} { set arghelp [punk::ansi::ansiwrap -rawansi $A_GOODARG $arghelp] } - foreach ln [split $help \n] { - append arghelp " $ln" \n + if {[string trim [punk::ansi::ansistripraw $help]] ne ""} { + foreach ln [split $help \n] { + append arghelp " $ln" \n + } } lappend errlines $arghelp } @@ -6225,7 +6266,11 @@ tcl::namespace::eval punk::args { if {$use_table} { $t add_row [list "$argshow" $tp $default "" ""] } else { - set arghelp "[a+ bold]$argshow$RST TYPE:$tp DEFAULT:$default\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$tp" + if {$default ne ""} { + append arghelp " DEFAULT:$default" + } + append arghelp \n lappend errlines $arghelp } } @@ -6246,7 +6291,11 @@ tcl::namespace::eval punk::args { if {$use_table} { $t add_row [list "$argshow" $tp $default "" ""] } else { - set arghelp "[a+ bold]$argshow$RST TYPE:$tp DEFAULT:$default\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$tp" + if {$default ne ""} { + append arghelp " DEFAULT:$default" + } + append arghelp \n lappend errlines $arghelp } } @@ -6290,12 +6339,17 @@ tcl::namespace::eval punk::args { set result $t } } else { - #put original error at bottom of table too - append result \n $msg + #sole emission of the original error message - below the usage table + if {$msg ne ""} { + append result \n $msg + } } } else { set result $errmsg - append result \n $msg + #sole emission of the original error message - below the usage text + if {$msg ne ""} { + append result \n $msg + } } if {$as_error} { #add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it. @@ -14017,7 +14071,7 @@ package provide punk::args [tcl::namespace::eval punk::args { tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version - set version 0.12.5 + set version 0.12.6 }] return diff --git a/src/bootsupport/modules/punk/ns-0.8.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm similarity index 98% rename from src/bootsupport/modules/punk/ns-0.8.1.tm rename to src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm index 5cb07840..79994f5e 100644 --- a/src/bootsupport/modules/punk/ns-0.8.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::ns 0.8.1 +# Application punk::ns 0.9.0 # Meta platform tcl # Meta license # @@ Meta End @@ -5386,11 +5386,12 @@ y" {return quirkykeyscript} usage information as this is inherently risky. (could create a file, exit the interp etc) " - -return -type string -default table -choices {string table tableobject dict} -choicelabels { + -return -type string -default table -choices {string table tableobject dict text} -choicelabels { string "no table layout" table "full table layout" tableobject "table object cmd" dict "machine-parsable resolution + parse-status" + text "plain text, ANSI-free, all forms" } -help\ "Return form of the usage information. 'dict' returns a dict with keys origin, docid, cmdtype, @@ -5399,7 +5400,13 @@ y" {return quirkykeyscript} the resolved definition (see punk::args::parse_status for the documented structure; empty if the command is undocumented). Its per-argument statuses distinguish a fully-valid, an invalid - and an incomplete argument set machine-parsably." + and an incomplete argument set machine-parsably. + 'text' returns plain text with no ANSI codes and no table + layout, rendering the argument section of every command form + (or of each form in an explicit -form selection) in a single + output - unlike the interactive displays, which render only + the best-matching form's argument table. Intended for + machine/LLM consumption of the full documentation." } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { @@ -5468,6 +5475,68 @@ y" {return quirkykeyscript} set nextopts [dict remove $opts -grepstr] #JJJ + if {$opt_return eq "text"} { + #Plain-text renderer for machine/LLM consumption: no ANSI, no table layout, + #and the argument section of every selected command form rendered in one + #output rather than only the G-041 best-matching form's argument table. + #Resolution (aliases, ensembles, docid, form candidacy) is delegated to the + #-return dict recursion; each form's argument section then renders via the + #string renderer and the sections are joined below the common header. + set dinfo [uplevel 1 [list ::punk::ns::cmdhelp -return dict -form $opt_form -- $querycommand {*}$queryargs]] + set docid [dict get $dinfo docid] + if {$docid eq ""} { + return "Undocumented command [dict get $dinfo origin]. Type: [dict get $dinfo cmdtype]" + } + set spec [punk::args::get_spec $docid] + set pstatus [dict get $dinfo parsestatus] + if {$opt_form ne "*"} { + set forms $opt_form + } elseif {[llength [dict get $dinfo args_remaining]]} { + #argument words were supplied - restrict to the form(s) the advisory + #parse selected (matched/best-candidate; all candidates on noformmatch) + if {![dict get $pstatus ok] && [dict get $pstatus failureclass] in {noformmatch multipleformmatches}} { + set forms [dict keys [dict get $pstatus formstatus]] + } else { + set forms [dict get $pstatus form] + } + } else { + set forms [dict get $spec form_names] + } + if {[llength [dict get $spec form_names]] < 2} { + set result [punk::ansi::ansistripraw [punk::args::arg_error "" $spec -aserror 0 -return string -scheme nocolour -form [lindex $forms 0]]] + } else { + set marker " --ARGUMENTS-- " ;#the string renderer's argument-section heading line + set result "" + set fnum 0 + foreach fid $forms { + set fout [punk::ansi::ansistripraw [punk::args::arg_error "" $spec -aserror 0 -return string -scheme nocolour -form $fid]] + set idx [string first $marker $fout] + if {$idx < 0} { + #no argument-section heading (e.g custom FORMDISPLAY) - emit whole output once + if {$fnum == 0} { + append result $fout + } + } else { + if {$fnum == 0} { + #common header (command help + all-forms synopsis) - emit once + append result [string range $fout 0 $idx-1] + } + append result " --ARGUMENTS (form '$fid')-- " [string range $fout $idx+[string length $marker] end] \n + } + incr fnum + } + set result [string trimright $result \n] + } + if {$opt_grepstr ne ""} { + if {[llength $opt_grepstr] == 1} { + set result [punk::ansi::grepstr --ignore-case -return all [lindex $opt_grepstr 0] $result] + } else { + set result [punk::ansi::grepstr --ignore-case -return all -highlight [lrange $opt_grepstr 1 end] [lindex $opt_grepstr 0] $result] + } + } + return $result + } + set whichinfo [uplevel 1 [list ::punk::ns::cmdwhich $querycommand]] set rootorigin [dict get $whichinfo origin] set which [dict get $whichinfo which] @@ -6572,6 +6641,6 @@ namespace eval ::punk::args::register { ## Ready package provide punk::ns [tcl::namespace::eval punk::ns { variable version - set version 0.8.1 + set version 0.9.0 }] return diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.2.2.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.3.0.tm similarity index 91% rename from src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.2.2.tm rename to src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.3.0.tm index 0ae49215..2f1858e8 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.2.2.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.3.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::path 0.2.2 +# Application punk::path 0.3.0 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::path 0 0.2.2] +#[manpage_begin punkshell_module_punk::path 0 0.3.0] #[copyright "2023"] #[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}] #[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] @@ -504,15 +504,32 @@ namespace eval punk::path { an executable in /bin. 3. /scriptlib. - If the name's extension (lowercased) is not one of the known - scriptlib extensions (.tcl .py .pl .ps1 .sh), '.tcl' is - appended - only .tcl scripts may be named extensionlessly. + If the name's extension (lowercased) is one of the known + scriptlib extensions (.tcl .kit .py .pl .ps1 .sh), only that + exact name is searched. Otherwise two spellings are tried within + EACH location before moving to the next (so the kit-internal + precedence above is never crossed by a spelling preference): + 1. the exact name as called - accepted only if the file's + first lines identify it as a tcl script: a leading + '# tcl' comment, a shebang naming tclsh/tclkit/wish, or + the portable sh-trampoline ('#!/bin/sh' followed by a + commented 'exec tclsh ...' in the next lines). + 2. the name with '.tcl' appended. + An exact-name file that fails the tcl identification check is + skipped (recorded in notes) and resolution falls through. Returns a dict with keys: path - resolved absolute path, or empty string if not found - scriptname - the name searched for (extension applied) + scriptname - the relative name that matched; when not found, + the primary name searched for + scripttype - resolved script type: the extension without its + dot (tcl, kit, py, pl, ps1, sh), 'tcl' for an + extensionless file that passed the identification + check, or empty string when not found candidates - the locations that were (or would be) checked, - for use in error messages. + for use in error messages + notes - explanatory notes (e.g files skipped by the tcl + identification check), for use in error messages. Raises an error if name is not a relative path." @leaders name -type string -optional 0 -help\ @@ -522,20 +539,26 @@ namespace eval punk::path { } proc scriptlib_resolve {name} { #shared resolution policy for the 'lib:' script prefix - used by the punk - #executable 'script' subcommand (app-punkscript); app-punkshell's shell - #subcommand encodes the same policy (todo: refactor it onto this proc). + #executable 'script' subcommand (app-punkscript) and the shell subcommand's + #lib: handling (app-punkshell, app_shellrun). if {[lindex [pathtype $name] 0] ne "relative"} { error "punk::path::scriptlib_resolve name must be a relative path (got '$name')" } - set known_extensions [list .tcl .py .pl .ps1 .sh] + set known_extensions [list .tcl .kit .py .pl .ps1 .sh] + #spellings: {relname needs_tcl_check} pairs tried in order within each + #directory - the spelling matching the way the script was called wins + #per-directory, and directory precedence (kit-internal first) is never + #crossed by a spelling preference. if {[string tolower [file extension $name]] ni $known_extensions} { - #only .tcl scripts allowed to be called extensionlessly + #extensionless (or unknown-extension) call: the exact name wins when + #the file identifies as tcl, else fall through to the .tcl spelling. + set spellings [list [list $name 1] [list $name.tcl 0]] set scriptname $name.tcl } else { + set spellings [list [list $name 0]] set scriptname $name } set exepath [file dirname [file normalize [file join [info nameofexecutable] ___]]] ;#symlink resolve - set candidates [list] #1) kit-internal scriptlib - not overridable externally set has_zipfs_command [expr {[info commands ::tcl::zipfs::root] ne ""}] set kit_base "" @@ -550,21 +573,38 @@ namespace eval punk::path { } elseif {[file exists $exepath/scriptlib]} { set kit_libdir $exepath/scriptlib } + set search_dirs [list] if {$kit_libdir ne ""} { - lappend candidates $kit_libdir/$scriptname - if {[file exists $kit_libdir/$scriptname]} { - return [dict create path $kit_libdir/$scriptname scriptname $scriptname candidates $candidates] - } + lappend search_dirs $kit_libdir } #2,3) external scriptlib folders relative to the executable location set exedir [file dirname $exepath] - foreach dir [list [file join $exedir scriptlib] [file join [file dirname $exedir] scriptlib]] { - lappend candidates [file join $dir $scriptname] - if {[file isdirectory $dir] && [file exists [file join $dir $scriptname]]} { - return [dict create path [file join $dir $scriptname] scriptname $scriptname candidates $candidates] + lappend search_dirs [file join $exedir scriptlib] [file join [file dirname $exedir] scriptlib] + + set candidates [list] + set notes [list] + foreach dir $search_dirs { + foreach spelling $spellings { + lassign $spelling relname needs_tcl_check + set fpath [file join $dir $relname] + lappend candidates $fpath + if {![file isfile $fpath]} { + #isfile (not exists) - an extensionless call must not match a directory of the same name + continue + } + if {$needs_tcl_check} { + if {![punk::path::system::scriptfile_is_tcl $fpath]} { + lappend notes "$fpath exists but its first lines do not identify it as tcl (leading '# tcl' comment or tcl shebang) - skipped" + continue + } + set scripttype tcl + } else { + set scripttype [string range [string tolower [file extension $fpath]] 1 end] + } + return [dict create path $fpath scriptname $relname scripttype $scripttype candidates $candidates notes $notes] } } - return [dict create path "" scriptname $scriptname candidates $candidates] + return [dict create path "" scriptname $scriptname scripttype "" candidates $candidates notes $notes] } proc plain {str} { @@ -1676,14 +1716,71 @@ namespace eval punk::path::system { #[subsection {Namespace punk::path::system}] #[para] Internal functions that are not part of the API - - + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punk::path::system::scriptfile_is_tcl + @cmd -name "punk::path::system::scriptfile_is_tcl"\ + -summary\ + "Test whether a script file's first lines identify it as a tcl script"\ + -help\ + "Reads a small bounded chunk (512 bytes) of the file and reports 1 if + the first line is a '# tcl'-prefixed comment (case-insensitive), a + shebang naming tclsh/tclkit/wish, or any other shebang whose next + few lines contain the portable sh-trampoline 'exec tclsh ...' idiom. + A UTF-8 BOM and CRLF line endings are tolerated. Returns 0 for + unreadable files and anything not identified as tcl. + Used by punk::path::scriptlib_resolve to allow extensionless tcl + scripts to be called via the lib: prefix." + @leaders + fpath -type string -optional 0 -help\ + "path of the file to examine" + }] + } + proc scriptfile_is_tcl {fpath} { + if {[catch {open $fpath r} fd]} { + return 0 + } + set chunk "" + catch {chan configure $fd -encoding utf-8} + catch {set chunk [read $fd 512]} + catch {close $fd} + if {[string index $chunk 0] eq "\uFEFF"} { + #utf-8 BOM as decoded above + set chunk [string range $chunk 1 end] + } + set lines [lmap ln [lrange [split $chunk \n] 0 3] {string trimright $ln \r}] + set line1 [lindex $lines 0] + if {[string index $line1 0] ne "#"} { + return 0 + } + if {[regexp {^#!.*\m(tclsh|tclkit|wish)} $line1]} { + #shebang naming a tcl interpreter e.g #!/usr/bin/env tclsh, #!/usr/bin/tclsh9.0 + return 1 + } + if {[regexp -nocase {^#\s*tcl} $line1]} { + #'# tcl' marker comment (prefix match - '# tclscript' etc also accepted) + return 1 + } + if {[string range $line1 0 1] eq "#!"} { + #any other shebang (e.g #!/bin/sh): accept the portable sh-trampoline idiom + # #!/bin/sh + # # \ + # exec tclsh "$0" ${1+"$@"} + #(the backslash-continued comment hides the exec line from tcl but not from sh) + foreach ln [lrange $lines 1 end] { + if {[regexp {^\s*exec\s.*\m(tclsh|tclkit|wish)} $ln]} { + return 1 + } + } + } + return 0 + } } namespace eval ::punk::args::register { #use fully qualified so 8.6 doesn't find existing var in global namespace #documentation-only PUNKARGS registration - discovered lazily if/when punk::args loads - lappend ::punk::args::register::NAMESPACES ::punk::path::argdoc + lappend ::punk::args::register::NAMESPACES ::punk::path::argdoc ::punk::path::system::argdoc } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -1691,7 +1788,7 @@ namespace eval ::punk::args::register { package provide punk::path [namespace eval punk::path { variable pkg punk::path variable version - set version 0.2.2 + set version 0.3.0 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args-0.12.5.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.6.tm similarity index 99% rename from src/vfs/_vfscommon.vfs/modules/punk/args-0.12.5.tm rename to src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.6.tm index c1636210..3d9acb4c 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args-0.12.5.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.6.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::args 0.12.5 +# Application punk::args 0.12.6 # Meta platform tcl # Meta license # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::args 0 0.12.5] +#[manpage_begin punkshell_module_punk::args 0 0.12.6] #[copyright "2024"] #[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}] @@ -5246,7 +5246,11 @@ tcl::namespace::eval punk::args { # use basic colours here to support terminals without extended colours #todo - add checks column (e.g -minsize -maxsize) - set errmsg $msg + #2026-07-18 (user direction): the supplied error message (and any per-form + #match detail it carries) renders once, BELOW the usage output - see the + #bottom-append near the end of this proc. It previously also rendered here + #at the top, duplicating the block above and below the usage display. + set errmsg "" if {![catch {package require textblock}]} { set has_textblock 1 } else { @@ -5260,14 +5264,8 @@ tcl::namespace::eval punk::args { } set errlines [list] ;#for non-textblock output if {[catch { - if {$use_table} { - append errmsg \n - } else { - if {!$has_textblock && ($returntype in {table tableobject})} { - append errmsg \n "$CLR(errormsg)(layout package textblock is missing)$RST" \n - } else { - append errmsg \n - } + if {!$use_table && !$has_textblock && ($returntype in {table tableobject})} { + append errmsg "$CLR(errormsg)(layout package textblock is missing)$RST" \n } set cmdname [Dict_getdef $spec_dict cmd_info -name ""] set cmdsummary [Dict_getdef $spec_dict cmd_info -summary ""] @@ -6031,12 +6029,35 @@ tcl::namespace::eval punk::args { $choicetableobj configure -title $CLR(groupname)$groupname #append help \n[textblock::join -- " " [$choicetableobj print]] } else { + #string renderer (2026-07-18): markdown-subset list structure so + #choices are machine-distinguishable from their label text (the + #previous flat join left choice names and multi-line labels at + #inconsistent depths with nothing marking which lines were + #choices once ANSI is stripped). Each choice renders as a + #'- `choice`' bullet at a fixed indent; the label's first line + #follows on the bullet line after the closing backtick, label + #continuation lines indent 2 past the bullet dash. The backticked + #token may carry a trailing choiceinfo marker glyph. if {$groupname ne ""} { - append help \n \n "$CLR(groupname)Group: $groupname$RST" - } else { - append help \n + append help \n " $CLR(groupname)Group '$groupname':$RST" + } + foreach cformatted $formatted { + set clines [split $cformatted \n] + set bulletline " - `[lindex $clines 0]`" + set lbllines [lrange $clines 1 end] + if {[llength $lbllines]} { + set lblfirst [lindex $lbllines 0] + if {[string trim $lblfirst] ne ""} { + append bulletline " - [string trimleft $lblfirst]" + } + append help \n $bulletline + foreach lblline [lrange $lbllines 1 end] { + append help \n " $lblline" + } + } else { + append help \n $bulletline + } } - append help \n [join $formatted \n] } } else { #we were given an empty set of choices. @@ -6159,8 +6180,26 @@ tcl::namespace::eval punk::args { $t configure_row [expr {[$t row_count]-1}] -ansibase $A_GOODARG } } else { - #review - formatting will be all over the shop due to newlines in typesshow, help - set linetail " TYPE:$typeshow DEFAULT:$default MULTI:$multiple" + #single-line field layout (2026-07-18): the table-cell fields are + #multi-line (type constraints such as -minsize each on their own + #line) - flatten them so each argument renders as one 'name + #TYPE:... ?DEFAULT:...? ?MULTI:yes?' line, and omit empty + #DEFAULT/MULTI rather than rendering empty labels. Constraint + #annotations attach to the type in parentheses e.g + #TYPE:list(-minsize 2 -maxsize 2). + set typeline [string map [list \n " "] $typeshow] + if {$typeline ne $typeshow} { + #had constraint lines - parenthesize them onto the base type + set tparts [split $typeshow \n] + set typeline "[lindex $tparts 0]([join [lrange $tparts 1 end] { }])" + } + set linetail " TYPE:$typeline" + if {[dict exists $arginfo -default]} { + append linetail " DEFAULT:[string map [list \n " "] $default]" + } + if {$is_multiple} { + append linetail " MULTI:yes" + } if {$hint ne ""} { set arghelp [textblock::join -- "[a+ bold]$argshow\n$hint$RST" $linetail] } else { @@ -6172,8 +6211,10 @@ tcl::namespace::eval punk::args { } elseif {$arg_status eq "ok"} { set arghelp [punk::ansi::ansiwrap -rawansi $A_GOODARG $arghelp] } - foreach ln [split $help \n] { - append arghelp " $ln" \n + if {[string trim [punk::ansi::ansistripraw $help]] ne ""} { + foreach ln [split $help \n] { + append arghelp " $ln" \n + } } lappend errlines $arghelp } @@ -6225,7 +6266,11 @@ tcl::namespace::eval punk::args { if {$use_table} { $t add_row [list "$argshow" $tp $default "" ""] } else { - set arghelp "[a+ bold]$argshow$RST TYPE:$tp DEFAULT:$default\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$tp" + if {$default ne ""} { + append arghelp " DEFAULT:$default" + } + append arghelp \n lappend errlines $arghelp } } @@ -6246,7 +6291,11 @@ tcl::namespace::eval punk::args { if {$use_table} { $t add_row [list "$argshow" $tp $default "" ""] } else { - set arghelp "[a+ bold]$argshow$RST TYPE:$tp DEFAULT:$default\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$tp" + if {$default ne ""} { + append arghelp " DEFAULT:$default" + } + append arghelp \n lappend errlines $arghelp } } @@ -6290,12 +6339,17 @@ tcl::namespace::eval punk::args { set result $t } } else { - #put original error at bottom of table too - append result \n $msg + #sole emission of the original error message - below the usage table + if {$msg ne ""} { + append result \n $msg + } } } else { set result $errmsg - append result \n $msg + #sole emission of the original error message - below the usage text + if {$msg ne ""} { + append result \n $msg + } } if {$as_error} { #add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it. @@ -14017,7 +14071,7 @@ package provide punk::args [tcl::namespace::eval punk::args { tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version - set version 0.12.5 + set version 0.12.6 }] return diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.8.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm similarity index 98% rename from src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.8.1.tm rename to src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm index 5cb07840..79994f5e 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.8.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::ns 0.8.1 +# Application punk::ns 0.9.0 # Meta platform tcl # Meta license # @@ Meta End @@ -5386,11 +5386,12 @@ y" {return quirkykeyscript} usage information as this is inherently risky. (could create a file, exit the interp etc) " - -return -type string -default table -choices {string table tableobject dict} -choicelabels { + -return -type string -default table -choices {string table tableobject dict text} -choicelabels { string "no table layout" table "full table layout" tableobject "table object cmd" dict "machine-parsable resolution + parse-status" + text "plain text, ANSI-free, all forms" } -help\ "Return form of the usage information. 'dict' returns a dict with keys origin, docid, cmdtype, @@ -5399,7 +5400,13 @@ y" {return quirkykeyscript} the resolved definition (see punk::args::parse_status for the documented structure; empty if the command is undocumented). Its per-argument statuses distinguish a fully-valid, an invalid - and an incomplete argument set machine-parsably." + and an incomplete argument set machine-parsably. + 'text' returns plain text with no ANSI codes and no table + layout, rendering the argument section of every command form + (or of each form in an explicit -form selection) in a single + output - unlike the interactive displays, which render only + the best-matching form's argument table. Intended for + machine/LLM consumption of the full documentation." } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { @@ -5468,6 +5475,68 @@ y" {return quirkykeyscript} set nextopts [dict remove $opts -grepstr] #JJJ + if {$opt_return eq "text"} { + #Plain-text renderer for machine/LLM consumption: no ANSI, no table layout, + #and the argument section of every selected command form rendered in one + #output rather than only the G-041 best-matching form's argument table. + #Resolution (aliases, ensembles, docid, form candidacy) is delegated to the + #-return dict recursion; each form's argument section then renders via the + #string renderer and the sections are joined below the common header. + set dinfo [uplevel 1 [list ::punk::ns::cmdhelp -return dict -form $opt_form -- $querycommand {*}$queryargs]] + set docid [dict get $dinfo docid] + if {$docid eq ""} { + return "Undocumented command [dict get $dinfo origin]. Type: [dict get $dinfo cmdtype]" + } + set spec [punk::args::get_spec $docid] + set pstatus [dict get $dinfo parsestatus] + if {$opt_form ne "*"} { + set forms $opt_form + } elseif {[llength [dict get $dinfo args_remaining]]} { + #argument words were supplied - restrict to the form(s) the advisory + #parse selected (matched/best-candidate; all candidates on noformmatch) + if {![dict get $pstatus ok] && [dict get $pstatus failureclass] in {noformmatch multipleformmatches}} { + set forms [dict keys [dict get $pstatus formstatus]] + } else { + set forms [dict get $pstatus form] + } + } else { + set forms [dict get $spec form_names] + } + if {[llength [dict get $spec form_names]] < 2} { + set result [punk::ansi::ansistripraw [punk::args::arg_error "" $spec -aserror 0 -return string -scheme nocolour -form [lindex $forms 0]]] + } else { + set marker " --ARGUMENTS-- " ;#the string renderer's argument-section heading line + set result "" + set fnum 0 + foreach fid $forms { + set fout [punk::ansi::ansistripraw [punk::args::arg_error "" $spec -aserror 0 -return string -scheme nocolour -form $fid]] + set idx [string first $marker $fout] + if {$idx < 0} { + #no argument-section heading (e.g custom FORMDISPLAY) - emit whole output once + if {$fnum == 0} { + append result $fout + } + } else { + if {$fnum == 0} { + #common header (command help + all-forms synopsis) - emit once + append result [string range $fout 0 $idx-1] + } + append result " --ARGUMENTS (form '$fid')-- " [string range $fout $idx+[string length $marker] end] \n + } + incr fnum + } + set result [string trimright $result \n] + } + if {$opt_grepstr ne ""} { + if {[llength $opt_grepstr] == 1} { + set result [punk::ansi::grepstr --ignore-case -return all [lindex $opt_grepstr 0] $result] + } else { + set result [punk::ansi::grepstr --ignore-case -return all -highlight [lrange $opt_grepstr 1 end] [lindex $opt_grepstr 0] $result] + } + } + return $result + } + set whichinfo [uplevel 1 [list ::punk::ns::cmdwhich $querycommand]] set rootorigin [dict get $whichinfo origin] set which [dict get $whichinfo which] @@ -6572,6 +6641,6 @@ namespace eval ::punk::args::register { ## Ready package provide punk::ns [tcl::namespace::eval punk::ns { variable version - set version 0.8.1 + set version 0.9.0 }] return diff --git a/src/bootsupport/modules/punk/path-0.2.2.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.3.0.tm similarity index 91% rename from src/bootsupport/modules/punk/path-0.2.2.tm rename to src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.3.0.tm index 0ae49215..2f1858e8 100644 --- a/src/bootsupport/modules/punk/path-0.2.2.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.3.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::path 0.2.2 +# Application punk::path 0.3.0 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::path 0 0.2.2] +#[manpage_begin punkshell_module_punk::path 0 0.3.0] #[copyright "2023"] #[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}] #[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] @@ -504,15 +504,32 @@ namespace eval punk::path { an executable in /bin. 3. /scriptlib. - If the name's extension (lowercased) is not one of the known - scriptlib extensions (.tcl .py .pl .ps1 .sh), '.tcl' is - appended - only .tcl scripts may be named extensionlessly. + If the name's extension (lowercased) is one of the known + scriptlib extensions (.tcl .kit .py .pl .ps1 .sh), only that + exact name is searched. Otherwise two spellings are tried within + EACH location before moving to the next (so the kit-internal + precedence above is never crossed by a spelling preference): + 1. the exact name as called - accepted only if the file's + first lines identify it as a tcl script: a leading + '# tcl' comment, a shebang naming tclsh/tclkit/wish, or + the portable sh-trampoline ('#!/bin/sh' followed by a + commented 'exec tclsh ...' in the next lines). + 2. the name with '.tcl' appended. + An exact-name file that fails the tcl identification check is + skipped (recorded in notes) and resolution falls through. Returns a dict with keys: path - resolved absolute path, or empty string if not found - scriptname - the name searched for (extension applied) + scriptname - the relative name that matched; when not found, + the primary name searched for + scripttype - resolved script type: the extension without its + dot (tcl, kit, py, pl, ps1, sh), 'tcl' for an + extensionless file that passed the identification + check, or empty string when not found candidates - the locations that were (or would be) checked, - for use in error messages. + for use in error messages + notes - explanatory notes (e.g files skipped by the tcl + identification check), for use in error messages. Raises an error if name is not a relative path." @leaders name -type string -optional 0 -help\ @@ -522,20 +539,26 @@ namespace eval punk::path { } proc scriptlib_resolve {name} { #shared resolution policy for the 'lib:' script prefix - used by the punk - #executable 'script' subcommand (app-punkscript); app-punkshell's shell - #subcommand encodes the same policy (todo: refactor it onto this proc). + #executable 'script' subcommand (app-punkscript) and the shell subcommand's + #lib: handling (app-punkshell, app_shellrun). if {[lindex [pathtype $name] 0] ne "relative"} { error "punk::path::scriptlib_resolve name must be a relative path (got '$name')" } - set known_extensions [list .tcl .py .pl .ps1 .sh] + set known_extensions [list .tcl .kit .py .pl .ps1 .sh] + #spellings: {relname needs_tcl_check} pairs tried in order within each + #directory - the spelling matching the way the script was called wins + #per-directory, and directory precedence (kit-internal first) is never + #crossed by a spelling preference. if {[string tolower [file extension $name]] ni $known_extensions} { - #only .tcl scripts allowed to be called extensionlessly + #extensionless (or unknown-extension) call: the exact name wins when + #the file identifies as tcl, else fall through to the .tcl spelling. + set spellings [list [list $name 1] [list $name.tcl 0]] set scriptname $name.tcl } else { + set spellings [list [list $name 0]] set scriptname $name } set exepath [file dirname [file normalize [file join [info nameofexecutable] ___]]] ;#symlink resolve - set candidates [list] #1) kit-internal scriptlib - not overridable externally set has_zipfs_command [expr {[info commands ::tcl::zipfs::root] ne ""}] set kit_base "" @@ -550,21 +573,38 @@ namespace eval punk::path { } elseif {[file exists $exepath/scriptlib]} { set kit_libdir $exepath/scriptlib } + set search_dirs [list] if {$kit_libdir ne ""} { - lappend candidates $kit_libdir/$scriptname - if {[file exists $kit_libdir/$scriptname]} { - return [dict create path $kit_libdir/$scriptname scriptname $scriptname candidates $candidates] - } + lappend search_dirs $kit_libdir } #2,3) external scriptlib folders relative to the executable location set exedir [file dirname $exepath] - foreach dir [list [file join $exedir scriptlib] [file join [file dirname $exedir] scriptlib]] { - lappend candidates [file join $dir $scriptname] - if {[file isdirectory $dir] && [file exists [file join $dir $scriptname]]} { - return [dict create path [file join $dir $scriptname] scriptname $scriptname candidates $candidates] + lappend search_dirs [file join $exedir scriptlib] [file join [file dirname $exedir] scriptlib] + + set candidates [list] + set notes [list] + foreach dir $search_dirs { + foreach spelling $spellings { + lassign $spelling relname needs_tcl_check + set fpath [file join $dir $relname] + lappend candidates $fpath + if {![file isfile $fpath]} { + #isfile (not exists) - an extensionless call must not match a directory of the same name + continue + } + if {$needs_tcl_check} { + if {![punk::path::system::scriptfile_is_tcl $fpath]} { + lappend notes "$fpath exists but its first lines do not identify it as tcl (leading '# tcl' comment or tcl shebang) - skipped" + continue + } + set scripttype tcl + } else { + set scripttype [string range [string tolower [file extension $fpath]] 1 end] + } + return [dict create path $fpath scriptname $relname scripttype $scripttype candidates $candidates notes $notes] } } - return [dict create path "" scriptname $scriptname candidates $candidates] + return [dict create path "" scriptname $scriptname scripttype "" candidates $candidates notes $notes] } proc plain {str} { @@ -1676,14 +1716,71 @@ namespace eval punk::path::system { #[subsection {Namespace punk::path::system}] #[para] Internal functions that are not part of the API - - + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punk::path::system::scriptfile_is_tcl + @cmd -name "punk::path::system::scriptfile_is_tcl"\ + -summary\ + "Test whether a script file's first lines identify it as a tcl script"\ + -help\ + "Reads a small bounded chunk (512 bytes) of the file and reports 1 if + the first line is a '# tcl'-prefixed comment (case-insensitive), a + shebang naming tclsh/tclkit/wish, or any other shebang whose next + few lines contain the portable sh-trampoline 'exec tclsh ...' idiom. + A UTF-8 BOM and CRLF line endings are tolerated. Returns 0 for + unreadable files and anything not identified as tcl. + Used by punk::path::scriptlib_resolve to allow extensionless tcl + scripts to be called via the lib: prefix." + @leaders + fpath -type string -optional 0 -help\ + "path of the file to examine" + }] + } + proc scriptfile_is_tcl {fpath} { + if {[catch {open $fpath r} fd]} { + return 0 + } + set chunk "" + catch {chan configure $fd -encoding utf-8} + catch {set chunk [read $fd 512]} + catch {close $fd} + if {[string index $chunk 0] eq "\uFEFF"} { + #utf-8 BOM as decoded above + set chunk [string range $chunk 1 end] + } + set lines [lmap ln [lrange [split $chunk \n] 0 3] {string trimright $ln \r}] + set line1 [lindex $lines 0] + if {[string index $line1 0] ne "#"} { + return 0 + } + if {[regexp {^#!.*\m(tclsh|tclkit|wish)} $line1]} { + #shebang naming a tcl interpreter e.g #!/usr/bin/env tclsh, #!/usr/bin/tclsh9.0 + return 1 + } + if {[regexp -nocase {^#\s*tcl} $line1]} { + #'# tcl' marker comment (prefix match - '# tclscript' etc also accepted) + return 1 + } + if {[string range $line1 0 1] eq "#!"} { + #any other shebang (e.g #!/bin/sh): accept the portable sh-trampoline idiom + # #!/bin/sh + # # \ + # exec tclsh "$0" ${1+"$@"} + #(the backslash-continued comment hides the exec line from tcl but not from sh) + foreach ln [lrange $lines 1 end] { + if {[regexp {^\s*exec\s.*\m(tclsh|tclkit|wish)} $ln]} { + return 1 + } + } + } + return 0 + } } namespace eval ::punk::args::register { #use fully qualified so 8.6 doesn't find existing var in global namespace #documentation-only PUNKARGS registration - discovered lazily if/when punk::args loads - lappend ::punk::args::register::NAMESPACES ::punk::path::argdoc + lappend ::punk::args::register::NAMESPACES ::punk::path::argdoc ::punk::path::system::argdoc } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -1691,7 +1788,7 @@ namespace eval ::punk::args::register { package provide punk::path [namespace eval punk::path { variable pkg punk::path variable version - set version 0.2.2 + set version 0.3.0 }] return diff --git a/src/vfs/_vfscommon.vfs/lib/app-punkscript/punkscript.tcl b/src/vfs/_vfscommon.vfs/lib/app-punkscript/punkscript.tcl index 3f38604b..16f1043f 100644 --- a/src/vfs/_vfscommon.vfs/lib/app-punkscript/punkscript.tcl +++ b/src/vfs/_vfscommon.vfs/lib/app-punkscript/punkscript.tcl @@ -81,6 +81,9 @@ apply {{} { #Resolution policy is shared with the shell subcommand's scheme via #punk::path::scriptlib_resolve (vfs-internal scriptlib wins and is #not externally overridable, then scriptlib dirs relative to the exe). + #An extensionless call may also match an extensionless tcl file whose + #first lines identify it as tcl ('# tcl' comment or tcl shebang); + #the spelling matching the call wins when both spellings exist. set libname [string trimleft [string range $scriptname [string first : $scriptname]+1 end] :] package require punk::path if {[catch {punk::path::scriptlib_resolve $libname} resolved]} { @@ -93,10 +96,13 @@ apply {{} { foreach c [dict get $resolved candidates] { puts stderr " $c" } + foreach n [dict get $resolved notes] { + puts stderr " note: $n" + } exit 1 } - if {[string tolower [file extension $scriptpath]] ne ".tcl"} { - puts stderr "punk script: only .tcl scripts are supported via lib: in the script subcommand (resolved: $scriptpath)" + if {[dict get $resolved scripttype] ne "tcl"} { + puts stderr "punk script: only tcl scripts are supported via lib: in the script subcommand (resolved: $scriptpath)" exit 1 } set scriptpath [file normalize $scriptpath] diff --git a/src/vfs/_vfscommon.vfs/lib/app-punkshell/punkshell.tcl b/src/vfs/_vfscommon.vfs/lib/app-punkshell/punkshell.tcl index 097b29e1..7f2734f7 100644 --- a/src/vfs/_vfscommon.vfs/lib/app-punkshell/punkshell.tcl +++ b/src/vfs/_vfscommon.vfs/lib/app-punkshell/punkshell.tcl @@ -303,92 +303,41 @@ dict with prevglobal {} switch -glob -nocase -- $script_or_kit { lib:* { set exitinfo {} - #scriptlib - #There may be one or more colons after lib + #scriptlib script: lib: (one or more colons after lib), with or + #without .tcl extension - an extensionless call may also match an + #extensionless tcl file whose first lines identify it as tcl. + #Resolution policy is shared with the 'script' subcommand via + #punk::path::scriptlib_resolve (vfs-internal scriptlib wins and is + #not externally overridable, then scriptlib dirs relative to the exe). set cposn [string first : $script_or_kit] - set script_or_kit [string trimleft [string range $script_or_kit $cposn+1 end] :] - if {[file pathtype $script_or_kit] eq "relative"} { - set has_globchars [regexp {[*?]} $script_or_kit] ;#basic globs only? - - - set exepath [file dirname [file normalize [file join [info nameofexecutable] ___]]] ;#symlink resolve - review should we resolve scriptlib relative to a symlink too? - set kit_libdir "" ;#metakit or zipkit libdir - set known_extensions [list .tcl .py .pl .ps1 .sh] ;#review - set ext [file extension $script_or_kit] - if {[string tolower $ext] ni $known_extensions} { - #only .tcl scripts allowed to be called extensionlessly - set scriptname $script_or_kit.tcl - } else { - set scriptname $script_or_kit - } - set lower_ext [string tolower [file extension $scriptname]] - if {$lower_ext in {.tcl .kit}} { - set has_zipfs_command [expr {[info commands ::tcl::zipfs::root] ne ""}] - set kit_base "" - if {$has_zipfs_command && [file exists [tcl::zipfs::root]]} { - set kit_base [tcl::zipfs::root] - } elseif {[file type $exepath] eq "directory"} { - set kit_base $exepath + set libname [string trimleft [string range $script_or_kit $cposn+1 end] :] + package require punk::path + if {[catch {punk::path::scriptlib_resolve $libname} resolved]} { + #covers the non-relative-path rejection + puts stderr "punkshell: $resolved" + } else { + set scriptpath [dict get $resolved path] + if {$scriptpath eq ""} { + puts stderr "script '[dict get $resolved scriptname]' not found in vfs or in scriptlib folders relative to the executable. Locations checked:" + foreach c [dict get $resolved candidates] { + puts stderr " $c" } - if {$has_zipfs_command && [file exists $kit_base/app/scriptlib]} { - set kit_libdir $kit_base/app/scriptlib - } elseif {[file exists $exepath/scriptlib]} { - set kit_libdir $exepath/scriptlib + foreach n [dict get $resolved notes] { + puts stderr " note: $n" } - - #partly for performance benefit - we don't allow overriding of vfs internal scripts. - #Only additional scripts can be provided by the bin/scriptlib or ../bin/scriptlib folders - if {$kit_libdir ne "" && [file exists $kit_libdir/$scriptname]} { - switch -- $lower_ext { - .tcl { - set exitinfo [punkshell::do_script $kit_libdir/$scriptname {*}$arglist] - } - .kit { - set exitinfo [punkshell::do_tclkit $kit_libdir/$scriptname "no_repl" {*}$arglist] - } - } - } else { - #fallback to external filesystem - set exedir [file dirname $exepath] - set bin_scripts [file join $exedir scriptlib] - set binsibling_scripts [file join [file dirname $exedir] scriptlib] - set script_check_paths [list] - if {[file exists $bin_scripts]} { - lappend script_check_paths $bin_scripts/$scriptname + } else { + switch -- [dict get $resolved scripttype] { + tcl { + set exitinfo [punkshell::do_script $scriptpath {*}$arglist] } - if {[file exists $binsibling_scripts]} { - lappend script_check_paths $binsibling_scripts/$scriptname + kit { + set exitinfo [punkshell::do_tclkit $scriptpath "no_repl" {*}$arglist] } - if {[llength $script_check_paths]} { - foreach check_path $script_check_paths { - if {[file exists $check_path]} { - switch -- $lower_ext { - .tcl { - set exitinfo [punkshell::do_script $check_path {*}$arglist] - } - .kit { - set exitinfo [punkshell::do_tclkit $check_path "no_repl" {*}$arglist] - } - } - break - } - } - } else { - puts stderr "script $script_or_kit not found in vfs or in filesystem relative to $exedir" - puts stderr "valid locations:" - if {$kit_base ne ""} { - puts stderr " $kit_base/scriptlib/$scriptname" - } - puts stderr " $bin_scripts/$scriptname" - puts stderr " $binsibling_scripts/$scriptname" + default { + puts stderr "No current support for extension [file extension $scriptpath] via lib: (resolved: $scriptpath)" } } - } else { - puts stderr "No current support for extension [file extension $scriptname]" } - - } else { - puts stderr "Path supplied to lib: must be a relative path" } } *.tcl { diff --git a/src/vfs/_vfscommon.vfs/lib/app_shellrun/app_shellrun.tcl b/src/vfs/_vfscommon.vfs/lib/app_shellrun/app_shellrun.tcl index 99280ec2..5a0749d0 100644 --- a/src/vfs/_vfscommon.vfs/lib/app_shellrun/app_shellrun.tcl +++ b/src/vfs/_vfscommon.vfs/lib/app_shellrun/app_shellrun.tcl @@ -250,92 +250,41 @@ dict with prevglobal {} switch -glob -nocase -- $script_or_kit { lib:* { set exitinfo {} - #scriptlib - #There may be one or more colons after lib + #scriptlib script: lib: (one or more colons after lib), with or + #without .tcl extension - an extensionless call may also match an + #extensionless tcl file whose first lines identify it as tcl. + #Resolution policy is shared with the 'script' subcommand via + #punk::path::scriptlib_resolve (vfs-internal scriptlib wins and is + #not externally overridable, then scriptlib dirs relative to the exe). set cposn [string first : $script_or_kit] - set script_or_kit [string trimleft [string range $script_or_kit $cposn+1 end] :] - if {[file pathtype $script_or_kit] eq "relative"} { - set has_globchars [regexp {[*?]} $script_or_kit] ;#basic globs only? - - - set exepath [file dirname [file normalize [file join [info nameofexecutable] ___]]] ;#symlink resolve - review should we resolve scriptlib relative to a symlink too? - set kit_libdir "" ;#metakit or zipkit libdir - set known_extensions [list .tcl .py .pl .ps1 .sh] ;#review - set ext [file extension $script_or_kit] - if {[string tolower $ext] ni $known_extensions} { - #only .tcl scripts allowed to be called extensionlessly - set scriptname $script_or_kit.tcl - } else { - set scriptname $script_or_kit - } - set lower_ext [string tolower [file extension $scriptname]] - if {$lower_ext in {.tcl .kit}} { - set has_zipfs_command [expr {[info commands ::tcl::zipfs::root] ne ""}] - set kit_base "" - if {$has_zipfs_command && [file exists [tcl::zipfs::root]]} { - set kit_base [tcl::zipfs::root] - } elseif {[file type $exepath] eq "directory"} { - set kit_base $exepath + set libname [string trimleft [string range $script_or_kit $cposn+1 end] :] + package require punk::path + if {[catch {punk::path::scriptlib_resolve $libname} resolved]} { + #covers the non-relative-path rejection + puts stderr "punkshell: $resolved" + } else { + set scriptpath [dict get $resolved path] + if {$scriptpath eq ""} { + puts stderr "script '[dict get $resolved scriptname]' not found in vfs or in scriptlib folders relative to the executable. Locations checked:" + foreach c [dict get $resolved candidates] { + puts stderr " $c" } - if {$has_zipfs_command && [file exists $kit_base/app/scriptlib]} { - set kit_libdir $kit_base/app/scriptlib - } elseif {[file exists $exepath/scriptlib]} { - set kit_libdir $exepath/scriptlib + foreach n [dict get $resolved notes] { + puts stderr " note: $n" } - - #partly for performance benefit - we don't allow overriding of vfs internal scripts. - #Only additional scripts can be provided by the bin/scriptlib or ../bin/scriptlib folders - if {$kit_libdir ne "" && [file exists $kit_libdir/$scriptname]} { - switch -- $lower_ext { - .tcl { - set exitinfo [punkshell::do_script $kit_libdir/$scriptname {*}$arglist] - } - .kit { - set exitinfo [punkshell::do_tclkit $kit_libdir/$scriptname "no_repl" {*}$arglist] - } - } - } else { - #fallback to external filesystem - set exedir [file dirname $exepath] - set bin_scripts [file join $exedir scriptlib] - set binsibling_scripts [file join [file dirname $exedir] scriptlib] - set script_check_paths [list] - if {[file exists $bin_scripts]} { - lappend script_check_paths $bin_scripts/$scriptname + } else { + switch -- [dict get $resolved scripttype] { + tcl { + set exitinfo [punkshell::do_script $scriptpath {*}$arglist] } - if {[file exists $binsibling_scripts]} { - lappend script_check_paths $binsibling_scripts/$scriptname + kit { + set exitinfo [punkshell::do_tclkit $scriptpath "no_repl" {*}$arglist] } - if {[llength $script_check_paths]} { - foreach check_path $script_check_paths { - if {[file exists $check_path]} { - switch -- $lower_ext { - .tcl { - set exitinfo [punkshell::do_script $check_path {*}$arglist] - } - .kit { - set exitinfo [punkshell::do_tclkit $check_path "no_repl" {*}$arglist] - } - } - break - } - } - } else { - puts stderr "script $script_or_kit not found in vfs or in filesystem relative to $exedir" - puts stderr "valid locations:" - if {$kit_base ne ""} { - puts stderr " $kit_base/scriptlib/$scriptname" - } - puts stderr " $bin_scripts/$scriptname" - puts stderr " $binsibling_scripts/$scriptname" + default { + puts stderr "No current support for extension [file extension $scriptpath] via lib: (resolved: $scriptpath)" } } - } else { - puts stderr "No current support for extension [file extension $scriptname]" } - - } else { - puts stderr "Path supplied to lib: must be a relative path" } } *.tcl { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.5.tm b/src/vfs/_vfscommon.vfs/modules/punk/args-0.12.6.tm similarity index 99% rename from src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.5.tm rename to src/vfs/_vfscommon.vfs/modules/punk/args-0.12.6.tm index c1636210..3d9acb4c 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.5.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args-0.12.6.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::args 0.12.5 +# Application punk::args 0.12.6 # Meta platform tcl # Meta license # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::args 0 0.12.5] +#[manpage_begin punkshell_module_punk::args 0 0.12.6] #[copyright "2024"] #[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] #[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}] @@ -5246,7 +5246,11 @@ tcl::namespace::eval punk::args { # use basic colours here to support terminals without extended colours #todo - add checks column (e.g -minsize -maxsize) - set errmsg $msg + #2026-07-18 (user direction): the supplied error message (and any per-form + #match detail it carries) renders once, BELOW the usage output - see the + #bottom-append near the end of this proc. It previously also rendered here + #at the top, duplicating the block above and below the usage display. + set errmsg "" if {![catch {package require textblock}]} { set has_textblock 1 } else { @@ -5260,14 +5264,8 @@ tcl::namespace::eval punk::args { } set errlines [list] ;#for non-textblock output if {[catch { - if {$use_table} { - append errmsg \n - } else { - if {!$has_textblock && ($returntype in {table tableobject})} { - append errmsg \n "$CLR(errormsg)(layout package textblock is missing)$RST" \n - } else { - append errmsg \n - } + if {!$use_table && !$has_textblock && ($returntype in {table tableobject})} { + append errmsg "$CLR(errormsg)(layout package textblock is missing)$RST" \n } set cmdname [Dict_getdef $spec_dict cmd_info -name ""] set cmdsummary [Dict_getdef $spec_dict cmd_info -summary ""] @@ -6031,12 +6029,35 @@ tcl::namespace::eval punk::args { $choicetableobj configure -title $CLR(groupname)$groupname #append help \n[textblock::join -- " " [$choicetableobj print]] } else { + #string renderer (2026-07-18): markdown-subset list structure so + #choices are machine-distinguishable from their label text (the + #previous flat join left choice names and multi-line labels at + #inconsistent depths with nothing marking which lines were + #choices once ANSI is stripped). Each choice renders as a + #'- `choice`' bullet at a fixed indent; the label's first line + #follows on the bullet line after the closing backtick, label + #continuation lines indent 2 past the bullet dash. The backticked + #token may carry a trailing choiceinfo marker glyph. if {$groupname ne ""} { - append help \n \n "$CLR(groupname)Group: $groupname$RST" - } else { - append help \n + append help \n " $CLR(groupname)Group '$groupname':$RST" + } + foreach cformatted $formatted { + set clines [split $cformatted \n] + set bulletline " - `[lindex $clines 0]`" + set lbllines [lrange $clines 1 end] + if {[llength $lbllines]} { + set lblfirst [lindex $lbllines 0] + if {[string trim $lblfirst] ne ""} { + append bulletline " - [string trimleft $lblfirst]" + } + append help \n $bulletline + foreach lblline [lrange $lbllines 1 end] { + append help \n " $lblline" + } + } else { + append help \n $bulletline + } } - append help \n [join $formatted \n] } } else { #we were given an empty set of choices. @@ -6159,8 +6180,26 @@ tcl::namespace::eval punk::args { $t configure_row [expr {[$t row_count]-1}] -ansibase $A_GOODARG } } else { - #review - formatting will be all over the shop due to newlines in typesshow, help - set linetail " TYPE:$typeshow DEFAULT:$default MULTI:$multiple" + #single-line field layout (2026-07-18): the table-cell fields are + #multi-line (type constraints such as -minsize each on their own + #line) - flatten them so each argument renders as one 'name + #TYPE:... ?DEFAULT:...? ?MULTI:yes?' line, and omit empty + #DEFAULT/MULTI rather than rendering empty labels. Constraint + #annotations attach to the type in parentheses e.g + #TYPE:list(-minsize 2 -maxsize 2). + set typeline [string map [list \n " "] $typeshow] + if {$typeline ne $typeshow} { + #had constraint lines - parenthesize them onto the base type + set tparts [split $typeshow \n] + set typeline "[lindex $tparts 0]([join [lrange $tparts 1 end] { }])" + } + set linetail " TYPE:$typeline" + if {[dict exists $arginfo -default]} { + append linetail " DEFAULT:[string map [list \n " "] $default]" + } + if {$is_multiple} { + append linetail " MULTI:yes" + } if {$hint ne ""} { set arghelp [textblock::join -- "[a+ bold]$argshow\n$hint$RST" $linetail] } else { @@ -6172,8 +6211,10 @@ tcl::namespace::eval punk::args { } elseif {$arg_status eq "ok"} { set arghelp [punk::ansi::ansiwrap -rawansi $A_GOODARG $arghelp] } - foreach ln [split $help \n] { - append arghelp " $ln" \n + if {[string trim [punk::ansi::ansistripraw $help]] ne ""} { + foreach ln [split $help \n] { + append arghelp " $ln" \n + } } lappend errlines $arghelp } @@ -6225,7 +6266,11 @@ tcl::namespace::eval punk::args { if {$use_table} { $t add_row [list "$argshow" $tp $default "" ""] } else { - set arghelp "[a+ bold]$argshow$RST TYPE:$tp DEFAULT:$default\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$tp" + if {$default ne ""} { + append arghelp " DEFAULT:$default" + } + append arghelp \n lappend errlines $arghelp } } @@ -6246,7 +6291,11 @@ tcl::namespace::eval punk::args { if {$use_table} { $t add_row [list "$argshow" $tp $default "" ""] } else { - set arghelp "[a+ bold]$argshow$RST TYPE:$tp DEFAULT:$default\n" + set arghelp "[a+ bold]$argshow$RST TYPE:$tp" + if {$default ne ""} { + append arghelp " DEFAULT:$default" + } + append arghelp \n lappend errlines $arghelp } } @@ -6290,12 +6339,17 @@ tcl::namespace::eval punk::args { set result $t } } else { - #put original error at bottom of table too - append result \n $msg + #sole emission of the original error message - below the usage table + if {$msg ne ""} { + append result \n $msg + } } } else { set result $errmsg - append result \n $msg + #sole emission of the original error message - below the usage text + if {$msg ne ""} { + append result \n $msg + } } if {$as_error} { #add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it. @@ -14017,7 +14071,7 @@ package provide punk::args [tcl::namespace::eval punk::args { tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version - set version 0.12.5 + set version 0.12.6 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.8.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.0.tm similarity index 98% rename from src/vfs/_vfscommon.vfs/modules/punk/ns-0.8.1.tm rename to src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.0.tm index 5cb07840..79994f5e 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.8.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::ns 0.8.1 +# Application punk::ns 0.9.0 # Meta platform tcl # Meta license # @@ Meta End @@ -5386,11 +5386,12 @@ y" {return quirkykeyscript} usage information as this is inherently risky. (could create a file, exit the interp etc) " - -return -type string -default table -choices {string table tableobject dict} -choicelabels { + -return -type string -default table -choices {string table tableobject dict text} -choicelabels { string "no table layout" table "full table layout" tableobject "table object cmd" dict "machine-parsable resolution + parse-status" + text "plain text, ANSI-free, all forms" } -help\ "Return form of the usage information. 'dict' returns a dict with keys origin, docid, cmdtype, @@ -5399,7 +5400,13 @@ y" {return quirkykeyscript} the resolved definition (see punk::args::parse_status for the documented structure; empty if the command is undocumented). Its per-argument statuses distinguish a fully-valid, an invalid - and an incomplete argument set machine-parsably." + and an incomplete argument set machine-parsably. + 'text' returns plain text with no ANSI codes and no table + layout, rendering the argument section of every command form + (or of each form in an explicit -form selection) in a single + output - unlike the interactive displays, which render only + the best-matching form's argument table. Intended for + machine/LLM consumption of the full documentation." } {${[punk::args::resolved_def -types opts ::punk::args::arg_error -scheme]}} { @@ -5468,6 +5475,68 @@ y" {return quirkykeyscript} set nextopts [dict remove $opts -grepstr] #JJJ + if {$opt_return eq "text"} { + #Plain-text renderer for machine/LLM consumption: no ANSI, no table layout, + #and the argument section of every selected command form rendered in one + #output rather than only the G-041 best-matching form's argument table. + #Resolution (aliases, ensembles, docid, form candidacy) is delegated to the + #-return dict recursion; each form's argument section then renders via the + #string renderer and the sections are joined below the common header. + set dinfo [uplevel 1 [list ::punk::ns::cmdhelp -return dict -form $opt_form -- $querycommand {*}$queryargs]] + set docid [dict get $dinfo docid] + if {$docid eq ""} { + return "Undocumented command [dict get $dinfo origin]. Type: [dict get $dinfo cmdtype]" + } + set spec [punk::args::get_spec $docid] + set pstatus [dict get $dinfo parsestatus] + if {$opt_form ne "*"} { + set forms $opt_form + } elseif {[llength [dict get $dinfo args_remaining]]} { + #argument words were supplied - restrict to the form(s) the advisory + #parse selected (matched/best-candidate; all candidates on noformmatch) + if {![dict get $pstatus ok] && [dict get $pstatus failureclass] in {noformmatch multipleformmatches}} { + set forms [dict keys [dict get $pstatus formstatus]] + } else { + set forms [dict get $pstatus form] + } + } else { + set forms [dict get $spec form_names] + } + if {[llength [dict get $spec form_names]] < 2} { + set result [punk::ansi::ansistripraw [punk::args::arg_error "" $spec -aserror 0 -return string -scheme nocolour -form [lindex $forms 0]]] + } else { + set marker " --ARGUMENTS-- " ;#the string renderer's argument-section heading line + set result "" + set fnum 0 + foreach fid $forms { + set fout [punk::ansi::ansistripraw [punk::args::arg_error "" $spec -aserror 0 -return string -scheme nocolour -form $fid]] + set idx [string first $marker $fout] + if {$idx < 0} { + #no argument-section heading (e.g custom FORMDISPLAY) - emit whole output once + if {$fnum == 0} { + append result $fout + } + } else { + if {$fnum == 0} { + #common header (command help + all-forms synopsis) - emit once + append result [string range $fout 0 $idx-1] + } + append result " --ARGUMENTS (form '$fid')-- " [string range $fout $idx+[string length $marker] end] \n + } + incr fnum + } + set result [string trimright $result \n] + } + if {$opt_grepstr ne ""} { + if {[llength $opt_grepstr] == 1} { + set result [punk::ansi::grepstr --ignore-case -return all [lindex $opt_grepstr 0] $result] + } else { + set result [punk::ansi::grepstr --ignore-case -return all -highlight [lrange $opt_grepstr 1 end] [lindex $opt_grepstr 0] $result] + } + } + return $result + } + set whichinfo [uplevel 1 [list ::punk::ns::cmdwhich $querycommand]] set rootorigin [dict get $whichinfo origin] set which [dict get $whichinfo which] @@ -6572,6 +6641,6 @@ namespace eval ::punk::args::register { ## Ready package provide punk::ns [tcl::namespace::eval punk::ns { variable version - set version 0.8.1 + set version 0.9.0 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punk/path-0.2.2.tm b/src/vfs/_vfscommon.vfs/modules/punk/path-0.3.0.tm similarity index 91% rename from src/vfs/_vfscommon.vfs/modules/punk/path-0.2.2.tm rename to src/vfs/_vfscommon.vfs/modules/punk/path-0.3.0.tm index 0ae49215..2f1858e8 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/path-0.2.2.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/path-0.3.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::path 0.2.2 +# Application punk::path 0.3.0 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::path 0 0.2.2] +#[manpage_begin punkshell_module_punk::path 0 0.3.0] #[copyright "2023"] #[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}] #[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] @@ -504,15 +504,32 @@ namespace eval punk::path { an executable in /bin. 3. /scriptlib. - If the name's extension (lowercased) is not one of the known - scriptlib extensions (.tcl .py .pl .ps1 .sh), '.tcl' is - appended - only .tcl scripts may be named extensionlessly. + If the name's extension (lowercased) is one of the known + scriptlib extensions (.tcl .kit .py .pl .ps1 .sh), only that + exact name is searched. Otherwise two spellings are tried within + EACH location before moving to the next (so the kit-internal + precedence above is never crossed by a spelling preference): + 1. the exact name as called - accepted only if the file's + first lines identify it as a tcl script: a leading + '# tcl' comment, a shebang naming tclsh/tclkit/wish, or + the portable sh-trampoline ('#!/bin/sh' followed by a + commented 'exec tclsh ...' in the next lines). + 2. the name with '.tcl' appended. + An exact-name file that fails the tcl identification check is + skipped (recorded in notes) and resolution falls through. Returns a dict with keys: path - resolved absolute path, or empty string if not found - scriptname - the name searched for (extension applied) + scriptname - the relative name that matched; when not found, + the primary name searched for + scripttype - resolved script type: the extension without its + dot (tcl, kit, py, pl, ps1, sh), 'tcl' for an + extensionless file that passed the identification + check, or empty string when not found candidates - the locations that were (or would be) checked, - for use in error messages. + for use in error messages + notes - explanatory notes (e.g files skipped by the tcl + identification check), for use in error messages. Raises an error if name is not a relative path." @leaders name -type string -optional 0 -help\ @@ -522,20 +539,26 @@ namespace eval punk::path { } proc scriptlib_resolve {name} { #shared resolution policy for the 'lib:' script prefix - used by the punk - #executable 'script' subcommand (app-punkscript); app-punkshell's shell - #subcommand encodes the same policy (todo: refactor it onto this proc). + #executable 'script' subcommand (app-punkscript) and the shell subcommand's + #lib: handling (app-punkshell, app_shellrun). if {[lindex [pathtype $name] 0] ne "relative"} { error "punk::path::scriptlib_resolve name must be a relative path (got '$name')" } - set known_extensions [list .tcl .py .pl .ps1 .sh] + set known_extensions [list .tcl .kit .py .pl .ps1 .sh] + #spellings: {relname needs_tcl_check} pairs tried in order within each + #directory - the spelling matching the way the script was called wins + #per-directory, and directory precedence (kit-internal first) is never + #crossed by a spelling preference. if {[string tolower [file extension $name]] ni $known_extensions} { - #only .tcl scripts allowed to be called extensionlessly + #extensionless (or unknown-extension) call: the exact name wins when + #the file identifies as tcl, else fall through to the .tcl spelling. + set spellings [list [list $name 1] [list $name.tcl 0]] set scriptname $name.tcl } else { + set spellings [list [list $name 0]] set scriptname $name } set exepath [file dirname [file normalize [file join [info nameofexecutable] ___]]] ;#symlink resolve - set candidates [list] #1) kit-internal scriptlib - not overridable externally set has_zipfs_command [expr {[info commands ::tcl::zipfs::root] ne ""}] set kit_base "" @@ -550,21 +573,38 @@ namespace eval punk::path { } elseif {[file exists $exepath/scriptlib]} { set kit_libdir $exepath/scriptlib } + set search_dirs [list] if {$kit_libdir ne ""} { - lappend candidates $kit_libdir/$scriptname - if {[file exists $kit_libdir/$scriptname]} { - return [dict create path $kit_libdir/$scriptname scriptname $scriptname candidates $candidates] - } + lappend search_dirs $kit_libdir } #2,3) external scriptlib folders relative to the executable location set exedir [file dirname $exepath] - foreach dir [list [file join $exedir scriptlib] [file join [file dirname $exedir] scriptlib]] { - lappend candidates [file join $dir $scriptname] - if {[file isdirectory $dir] && [file exists [file join $dir $scriptname]]} { - return [dict create path [file join $dir $scriptname] scriptname $scriptname candidates $candidates] + lappend search_dirs [file join $exedir scriptlib] [file join [file dirname $exedir] scriptlib] + + set candidates [list] + set notes [list] + foreach dir $search_dirs { + foreach spelling $spellings { + lassign $spelling relname needs_tcl_check + set fpath [file join $dir $relname] + lappend candidates $fpath + if {![file isfile $fpath]} { + #isfile (not exists) - an extensionless call must not match a directory of the same name + continue + } + if {$needs_tcl_check} { + if {![punk::path::system::scriptfile_is_tcl $fpath]} { + lappend notes "$fpath exists but its first lines do not identify it as tcl (leading '# tcl' comment or tcl shebang) - skipped" + continue + } + set scripttype tcl + } else { + set scripttype [string range [string tolower [file extension $fpath]] 1 end] + } + return [dict create path $fpath scriptname $relname scripttype $scripttype candidates $candidates notes $notes] } } - return [dict create path "" scriptname $scriptname candidates $candidates] + return [dict create path "" scriptname $scriptname scripttype "" candidates $candidates notes $notes] } proc plain {str} { @@ -1676,14 +1716,71 @@ namespace eval punk::path::system { #[subsection {Namespace punk::path::system}] #[para] Internal functions that are not part of the API - - + namespace eval argdoc { + lappend PUNKARGS [list { + @id -id ::punk::path::system::scriptfile_is_tcl + @cmd -name "punk::path::system::scriptfile_is_tcl"\ + -summary\ + "Test whether a script file's first lines identify it as a tcl script"\ + -help\ + "Reads a small bounded chunk (512 bytes) of the file and reports 1 if + the first line is a '# tcl'-prefixed comment (case-insensitive), a + shebang naming tclsh/tclkit/wish, or any other shebang whose next + few lines contain the portable sh-trampoline 'exec tclsh ...' idiom. + A UTF-8 BOM and CRLF line endings are tolerated. Returns 0 for + unreadable files and anything not identified as tcl. + Used by punk::path::scriptlib_resolve to allow extensionless tcl + scripts to be called via the lib: prefix." + @leaders + fpath -type string -optional 0 -help\ + "path of the file to examine" + }] + } + proc scriptfile_is_tcl {fpath} { + if {[catch {open $fpath r} fd]} { + return 0 + } + set chunk "" + catch {chan configure $fd -encoding utf-8} + catch {set chunk [read $fd 512]} + catch {close $fd} + if {[string index $chunk 0] eq "\uFEFF"} { + #utf-8 BOM as decoded above + set chunk [string range $chunk 1 end] + } + set lines [lmap ln [lrange [split $chunk \n] 0 3] {string trimright $ln \r}] + set line1 [lindex $lines 0] + if {[string index $line1 0] ne "#"} { + return 0 + } + if {[regexp {^#!.*\m(tclsh|tclkit|wish)} $line1]} { + #shebang naming a tcl interpreter e.g #!/usr/bin/env tclsh, #!/usr/bin/tclsh9.0 + return 1 + } + if {[regexp -nocase {^#\s*tcl} $line1]} { + #'# tcl' marker comment (prefix match - '# tclscript' etc also accepted) + return 1 + } + if {[string range $line1 0 1] eq "#!"} { + #any other shebang (e.g #!/bin/sh): accept the portable sh-trampoline idiom + # #!/bin/sh + # # \ + # exec tclsh "$0" ${1+"$@"} + #(the backslash-continued comment hides the exec line from tcl but not from sh) + foreach ln [lrange $lines 1 end] { + if {[regexp {^\s*exec\s.*\m(tclsh|tclkit|wish)} $ln]} { + return 1 + } + } + } + return 0 + } } namespace eval ::punk::args::register { #use fully qualified so 8.6 doesn't find existing var in global namespace #documentation-only PUNKARGS registration - discovered lazily if/when punk::args loads - lappend ::punk::args::register::NAMESPACES ::punk::path::argdoc + lappend ::punk::args::register::NAMESPACES ::punk::path::argdoc ::punk::path::system::argdoc } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ @@ -1691,7 +1788,7 @@ namespace eval ::punk::args::register { package provide punk::path [namespace eval punk::path { variable pkg punk::path variable version - set version 0.2.2 + set version 0.3.0 }] return