punkshell/scriptlib/developer/whatis.tcl

#!/usr/bin/env tclsh
# whatis.tcl - runtime introspection report for a command, aimed at agent/LLM use
#
# Reports for a command name (possibly unqualified, possibly followed by
# subcommand words - e.g 'string is', 'dict getdef'):
#   - resolved fully-qualified name and kind (proc / alias / ensemble / native)
#   - subcommand-chain resolution via punk::ns::cmdinfo (ensembles, aliases,
#     nested chains) with any unresolvable trailing words reported
#   - providing package + version and the origin file the loaded copy came from
#   - file:line of the proc definition in that origin file (when locatable)
#   - punk::args synopsis (compact usage line per form)
# Options:
#   -body   append the runtime proc body, numbered with file-relative line numbers
#           when the definition line was located (numbers then match the origin file)
#   -doc    append the full argument documentation for all forms as plain text
#           (punk::ns::cmdhelp -return text)
#
# Must run inside a punkshell interpreter (needs punk::args, punk::ansi, punk::ns):
#   punk91 src script scriptlib/developer/whatis.tcl ?-body? ?-doc? <command> ?subcommand?...
# Use the 'src' launch argument so the working-tree modules under src/modules are
# loaded; without it the kit-stamped copies inside the executable (//zipfs:/...)
# are introspected and file:line will not refer to editable files.
# Exit 0 on success; 1 command not found; 2 usage error.
# Companion: scriptlib/developer/nslist.tcl (tcl-nslist skill) answers the
# namespace-level question - what commands/child namespaces exist below a
# namespace or package at all.

proc strip {text} {
    if {[info commands ::ansistrip] ne ""} {
        return [ansistrip $text]
    } elseif {![catch {package require punk::ansi}]} {
        return [punk::ansi::ansistrip $text]
    }
    return $text
}

proc out {key val} {
    puts [format "%-9s %s" $key: [strip $val]]
}

# longest namespace-prefix of a fully-qualified command that names a package
proc pkg_for_command {fqcmd} {
    set parts [lrange [split [string trimleft $fqcmd :] ::] 0 end]
    set parts [lsearch -all -inline -not $parts {}] ;# split on :: leaves empties
    for {set n [expr {[llength $parts]-1}]} {$n >= 1} {incr n -1} {
        set prefix [join [lrange $parts 0 $n-1] ::]
        if {![catch {package present $prefix} ver]} {
            return [list $prefix $ver]
        }
    }
    return {}
}

# attempt to load a package matching the namespace prefixes of $name
proc try_autoload {name} {
    set parts [lsearch -all -inline -not [split [string trimleft $name :] ::] {}]
    for {set n [expr {[llength $parts]-1}]} {$n >= 1} {incr n -1} {
        set prefix [join [lrange $parts 0 $n-1] ::]
        if {![catch {package require $prefix}]} {
            return $prefix
        }
    }
    return {}
}

# origin file of a loaded package, parsed from its ifneeded script
proc pkg_origin {pkg ver} {
    set script [package ifneeded $pkg $ver]
    if {[regexp {[;\n]?\s*source\s+(?:-encoding\s+\S+\s+)?(.+?)\s*$} $script -> path]} {
        return [string trim $path {"{}}]
    }
    if {[regexp {load\s+(\S+)} $script -> path]} {
        return $path
    }
    return ""
}

# locate the proc definition line in a source file; returns list of line numbers
proc find_def_lines {path fqcmd} {
    if {$path eq "" || [catch {open $path r} fd]} {
        return {}
    }
    set data [read $fd]
    close $fd
    set tail [namespace tail $fqcmd]
    set noco [string trimleft $fqcmd :]
    set exact {}
    set bytail {}
    set ln 0
    foreach line [split $data \n] {
        incr ln
        if {[regexp {^\s*proc\s+(:{0,2}[\w:]+)\s} $line -> pname]} {
            set pclean [string trimleft $pname :]
            if {$pclean eq $noco} {
                lappend exact $ln
            } elseif {[namespace tail $pclean] eq $tail} {
                lappend bytail $ln
            }
        }
    }
    if {[llength $exact]} {
        return $exact
    }
    return $bytail
}

# ---------------------------------------------------------------- arg handling
set opt_body 0
set opt_doc 0
set names {}
foreach a $argv {
    switch -- $a {
        -body   {set opt_body 1}
        -doc    {set opt_doc 1}
        default {lappend names $a}
    }
}
if {![llength $names]} {
    puts stderr "usage: punk91 src script scriptlib/developer/whatis.tcl ?-body? ?-doc? <command> ?subcommand?..."
    exit 2
}
set name [lindex $names 0]
set subwords [lrange $names 1 end]

# ---------------------------------------------------------------- resolution
set resolved [uplevel #0 [list namespace which -command $name]]
if {$resolved eq ""} {
    set loaded [try_autoload $name]
    set resolved [uplevel #0 [list namespace which -command $name]]
    if {$resolved eq "" && $loaded ne ""} {
        puts stderr "whatis: loaded package '$loaded' but no command '$name' appeared"
    }
}
if {$resolved eq ""} {
    # not a command - if it names a namespace (possibly after loading the package of
    # the same name), point at the namespace-discovery counterpart script
    set nsname ::[string trimleft $name :]
    if {![namespace exists $nsname]} {
        catch {package require [string trimleft $name :]}
    }
    if {[namespace exists $nsname]} {
        puts stderr "whatis: '$name' is a namespace, not a command - list its contents with:"
        puts stderr "  punk91 src script scriptlib/developer/nslist.tcl [string trimleft $name :]   (tcl-nslist skill)"
        exit 1
    }
    puts stderr "whatis: command '$name' not found (and no matching package could be loaded)"
    exit 1
}
out command [join $names { }]

set docid $resolved
if {[llength $subwords]} {
    # subcommand-chain resolution (ensembles, aliases, nested chains)
    if {[catch {package require punk::ns}]} {
        puts stderr "whatis: subcommand chains need punk::ns (punk::ns::cmdinfo) which failed to load"
        exit 1
    }
    if {[catch {punk::ns::cmdinfo {*}$names} cinfo]} {
        puts stderr "whatis: punk::ns::cmdinfo failed resolving '[join $names { }]': $cinfo"
        exit 1
    }
    set chain_origin   [dict get $cinfo origin]
    set args_remaining [dict get $cinfo args_remaining]
    set cinfo_docid    [dict get $cinfo docid]
    out resolves $chain_origin
    if {[llength $args_remaining]} {
        out warning "trailing words '[join $args_remaining { }]' could not be resolved as subcommands (cmdtype [dict get $cinfo cmdtype])"
    }
    set resolved [uplevel #0 [list namespace which -command $chain_origin]]
    if {$resolved eq ""} {
        # documentation-only level (cmdtype doconly) or unresolvable - report what we know
        set resolved $chain_origin
    }
    set docid [expr {$cinfo_docid ne "" ? $cinfo_docid : $resolved}]
} else {
    # alias chain (repl aliases are usually registered without leading colons)
    set target $resolved
    for {set depth 0} {$depth < 5} {incr depth} {
        set atarget {}
        foreach token [list [string trimleft $target :] $target] {
            set atarget [interp alias {} $token]
            if {[llength $atarget]} break
        }
        if {![llength $atarget]} break
        out alias "-> $atarget"
        set target [uplevel #0 [list namespace which -command [lindex $atarget 0]]]
        if {$target eq ""} break
    }
    if {$target ne "" && $target ne $resolved} {
        out resolves $target
        set resolved $target
    }
    set docid $resolved
    # prefer cmdinfo's docid when available (handles curried aliases, doc-only ids)
    if {![catch {package require punk::ns}] && ![catch {punk::ns::cmdinfo $name} cinfo]} {
        set cinfo_docid [dict get $cinfo docid]
        if {$cinfo_docid ne ""} {
            set docid $cinfo_docid
        }
    }
}

if {[info procs $resolved] ne ""} {
    set kind proc
} elseif {[namespace ensemble exists $resolved]} {
    set kind ensemble
} else {
    set kind "native command (C-implemented or unavailable as script)"
}
out kind $kind

# ---------------------------------------------------------------- package/origin
set pkginfo [pkg_for_command $resolved]
set origin ""
if {[llength $pkginfo]} {
    lassign $pkginfo pkg ver
    out package "$pkg $ver"
    set origin [pkg_origin $pkg $ver]
    if {$origin ne ""} {
        out origin $origin
        if {[string match //zipfs:* $origin]} {
            out warning "origin is the kit-stamped copy inside the executable - relaunch with 'punk91 src script ...' to introspect the working tree under src/modules"
        }
    }
} else {
    out package "(none matched - Tcl core or statically provided)"
}

set defline 0
if {$kind eq "proc"} {
    set lines [find_def_lines $origin $resolved]
    if {[llength $lines] == 1} {
        set defline [lindex $lines 0]
        out def $origin:$defline
    } elseif {[llength $lines] > 1} {
        out def "ambiguous - candidate lines [join $lines {, }] in $origin"
    } elseif {$origin ne ""} {
        out def "(no proc definition found in origin file - possibly generated at runtime)"
    }
}

if {$kind eq "ensemble"} {
    set ns  [namespace ensemble configure $resolved -namespace]
    set map [namespace ensemble configure $resolved -map]
    set subs [namespace ensemble configure $resolved -subcommands]
    out namespace $ns
    if {[dict size $map]} {
        puts "map:"
        dict for {sub tgt} $map {
            puts [format "  %-20s -> %s" $sub $tgt]
        }
    } elseif {[llength $subs]} {
        out subcommands $subs
    } else {
        out subcommands "(exported commands of $ns: [join [info commands ${ns}::*] { }])"
    }
}

# ---------------------------------------------------------------- synopsis
if {![catch {package require punk::args}]} {
    if {[catch {punk::args::synopsis $docid} syn]} {
        set syn ""
    }
    if {[string trim [strip $syn]] ne ""} {
        puts "synopsis:"
        foreach line [split [string trim [strip $syn]] \n] {
            puts "  $line"
        }
    } else {
        puts "synopsis: (no punk::args definition registered for $docid)"
    }
}

# ---------------------------------------------------------------- optional body
if {$opt_body && $kind eq "proc"} {
    set argspec {}
    foreach arg [info args $resolved] {
        if {[info default $resolved $arg dflt]} {
            lappend argspec [list $arg $dflt]
        } else {
            lappend argspec $arg
        }
    }
    puts ""
    if {$defline} {
        puts "body (line numbers are file-relative to $origin):"
    } else {
        puts "body (line numbers relative to definition - file location unknown):"
    }
    set bodylines [split [info body $resolved] \n]
    puts [format "%5d  proc %s \{%s\} \{" $defline $resolved [join $argspec]]
    set ln $defline
    foreach bline [lrange $bodylines 1 end] {
        incr ln
        puts [format "%5d  %s" $ln $bline]
    }
} elseif {$opt_body} {
    puts "\nbody: (not a proc - no script body available)"
}

# ---------------------------------------------------------------- optional full doc
if {$opt_doc} {
    puts ""
    set gotdoc 0
    if {![catch {package require punk::ns}]} {
        # -return text: plain text, ANSI-free, all forms (punk::ns >= 0.9.0)
        if {![catch {punk::ns::cmdhelp -return text -- {*}$names} doctext]} {
            set gotdoc 1
        }
    }
    if {!$gotdoc} {
        # older punk::ns without -return text (e.g kit-stamped copy) - fall back
        if {[info commands ::i] ne ""} {
            set doctext [strip [i {*}$names]]
        } elseif {![catch {punk::args::usage $docid} usage]} {
            set doctext [strip $usage]
        } else {
            set doctext "doc: (no argument documentation available for $docid)"
        }
    }
    puts $doctext
}

exit 0