jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

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
master
Julian Noble 4 days ago
parent
1eb9dc690b
commit
2b339bf0e0
15 changed files with 1158 additions and 374 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 104
      src/bootsupport/modules/punk/args-0.12.6.tm
  2. 77
      src/bootsupport/modules/punk/ns-0.9.0.tm
  3. 147
      src/bootsupport/modules/punk/path-0.3.0.tm
  4. 104
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.6.tm
  5. 77
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm
  6. 147
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.3.0.tm
  7. 104
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.6.tm
  8. 77
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm
  9. 147
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.3.0.tm
  10. 10
      src/vfs/_vfscommon.vfs/lib/app-punkscript/punkscript.tcl
  11. 105
      src/vfs/_vfscommon.vfs/lib/app-punkshell/punkshell.tcl
  12. 105
      src/vfs/_vfscommon.vfs/lib/app_shellrun/app_shellrun.tcl
  13. 104
      src/vfs/_vfscommon.vfs/modules/punk/args-0.12.6.tm
  14. 77
      src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.0.tm
  15. 147
      src/vfs/_vfscommon.vfs/modules/punk/path-0.3.0.tm

104
src/bootsupport/modules/punk/args-0.12.5.tm → src/bootsupport/modules/punk/args-0.12.6.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

77
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.8.1.tm → src/bootsupport/modules/punk/ns-0.9.0.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

147
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.2.2.tm → src/bootsupport/modules/punk/path-0.3.0.tm
Unescape View File

@ -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 <unspecified>
# @@ 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 <projectroot>/bin.
3. <exedir-grandparent>/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

104
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.5.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.6.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

77
src/bootsupport/modules/punk/ns-0.8.1.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

147
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.2.2.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.3.0.tm
Unescape View File

@ -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 <unspecified>
# @@ 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 <projectroot>/bin.
3. <exedir-grandparent>/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

104
src/vfs/_vfscommon.vfs/modules/punk/args-0.12.5.tm → src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.12.6.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

77
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.8.1.tm → src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.9.0.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

147
src/bootsupport/modules/punk/path-0.2.2.tm → src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.3.0.tm
Unescape View File

@ -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 <unspecified>
# @@ 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 <projectroot>/bin.
3. <exedir-grandparent>/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

10
src/vfs/_vfscommon.vfs/lib/app-punkscript/punkscript.tcl
Unescape View File

@ -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]

105
src/vfs/_vfscommon.vfs/lib/app-punkshell/punkshell.tcl
Unescape View File

@ -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:<name> (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 {

105
src/vfs/_vfscommon.vfs/lib/app_shellrun/app_shellrun.tcl
Unescape View File

@ -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:<name> (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 {

104
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.12.5.tm → src/vfs/_vfscommon.vfs/modules/punk/args-0.12.6.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

77
src/vfs/_vfscommon.vfs/modules/punk/ns-0.8.1.tm → src/vfs/_vfscommon.vfs/modules/punk/ns-0.9.0.tm
Unescape View File

@ -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 <unspecified>
# @@ 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

147
src/vfs/_vfscommon.vfs/modules/punk/path-0.2.2.tm → src/vfs/_vfscommon.vfs/modules/punk/path-0.3.0.tm
Unescape View File

@ -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 <unspecified>
# @@ 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 <projectroot>/bin.
3. <exedir-grandparent>/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
Write Preview
Loading…
Cancel
Save