punkshell/scriptlib/developer/nslist.tcl

#!/usr/bin/env tclsh
# nslist.tcl - runtime namespace/command discovery report, aimed at agent/LLM use
#
# Answers "what does this namespace/package actually expose?" - the discovery
# counterpart of whatis.tcl (which answers "how do I call this command?").
# Reports for each namespace matched by <nsglob>:
#   - child namespaces, marking which are also loadable package names
#   - commands classified by kind (procs, aliases, ensembles, native, imported,
#     oo classes/objects, coroutines, interps, zlibstreams)
#   - which commands have punk::args documentation ('documented:' line) - those
#     give full usage detail via whatis.tcl / punk::ns::cmdhelp
#   - namespace export patterns and 'namespace path' entries
# Data comes from punk::ns::get_ns_dicts - the same runtime machinery behind the
# interactive n// and n/// namespace browsers - so runtime-generated commands are
# included and only what is actually loaded is reported.
# If the target namespace does not exist, 'package require' of the name (then of
# successively shorter :: prefixes) is attempted first to populate it.
# An ensemble command name (e.g 'string') is followed to its implementation
# namespace, with a note.
# Options:
#   -synopsis      append punk::args usage lines for each documented command
#   -pathcommands  also list the commands resolvable via each 'namespace path' entry
#
# Must run inside a punkshell interpreter (needs punk::ns, punk::args):
#   punk91 src script scriptlib/developer/nslist.tcl ?-synopsis? ?-pathcommands? <nsglob>...
# Use the 'src' launch argument so the working-tree modules under src/modules are
# loaded and queried rather than the kit-stamped copies inside the executable.
# <nsglob> may be a plain namespace (punk::ns - listed as ::punk::ns::*) or a
# glob: last-segment glob chars match members, earlier-segment glob chars match
# multiple namespaces, and a trailing ::** segment recurses through all
# descendant namespaces.
# Exit 0 if every pattern produced a listing; 1 if any pattern matched nothing;
# 2 usage error.

if {[catch {package require punk::ns} errmsg]} {
    puts stderr "nslist: requires a punkshell interpreter (package require punk::ns failed: $errmsg)"
    exit 1
}
catch {package require punk::args}

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 "%-16s %s" $key: [strip $val]]
}

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

# leading non-glob namespace of a fully-qualified (possibly glob) path e.g ::a::b* -> ::a
proc nonglob_base {fq} {
    set parts [lsearch -all -inline -not [split [string trimleft $fq :] ::] {}]
    set keep [list]
    foreach seg $parts {
        if {[regexp {[*?]} $seg]} {
            break
        }
        lappend keep $seg
    }
    return ::[join $keep ::]
}

proc emit_nsdict {nd opt_pathcommands opt_synopsis} {
    set location [dict get $nd location]
    out namespace $location
    foreach {label key} {
        children        children
        packagetails    packagetails
        packageprefixes packageprefixes
    } {
        set items [dict get $nd $key]
        if {[llength $items]} {
            out $label [lsort -dictionary $items]
        }
    }
    set commands [dict get $nd commands]
    out commands [llength $commands]
    set classified [list]
    foreach {label key} {
        procs            procs
        aliases          aliases
        ensembles        ensembles
        native           native
        imported         imported
        ooclasses        ooclasses
        ooobjects        ooobjects
        ooprivateclasses ooprivateclasses
        ooprivateobjects ooprivateobjects
        coroutines       coroutines
        interps          interps
        zlibstreams      zlibstreams
        undetermined     undetermined
    } {
        set items [dict get $nd $key]
        if {[llength $items]} {
            out $label [lsort -dictionary $items]
            lappend classified {*}$items
        }
    }
    set other [list]
    foreach c $commands {
        if {$c ni $classified} {
            lappend other $c
        }
    }
    if {[llength $other]} {
        out other [lsort -dictionary $other]
    }
    set exported [dict get $nd exported]
    if {[llength $exported]} {
        out exported [lsort -dictionary $exported]
    }
    set documented [lsort -dictionary [dict get $nd usageinfo]]
    if {[llength $documented]} {
        out documented $documented
    }
    set exportpatterns [dict get $nd namespacexport]
    if {[llength $exportpatterns]} {
        out exportpatterns $exportpatterns
    }
    set pathdict [dict get $nd namespacepath]
    if {[dict size $pathdict]} {
        out namespacepath [dict keys $pathdict]
        if {$opt_pathcommands} {
            dict for {p pinfo} $pathdict {
                set pcmds [list]
                if {[dict exists $pinfo commands]} {
                    set pcmds [dict get $pinfo commands]
                }
                puts [format "  pathcommands(%s): %s" $p [strip [lsort -dictionary $pcmds]]]
            }
        }
    }
    if {[dict get $nd itemcount] == 0} {
        out note "(no members matched glob '[dict get $nd glob]' - namespace empty, or the package populating it is not loaded)"
    }
    if {$opt_synopsis && [llength $documented]} {
        puts "synopsis:"
        foreach c $documented {
            set id [punk::ns::nsjoin $location $c]
            if {![punk::args::id_exists $id]} {
                # alias/import - resolve the documentation id the way cmdhelp does
                set id ""
                if {![catch {punk::ns::cmdinfo [punk::ns::nsjoin $location $c]} cinfo]} {
                    set docid [dict get $cinfo docid]
                    if {$docid ne "" && [punk::args::id_exists $docid]} {
                        set id $docid
                    }
                }
            }
            set syn ""
            if {$id ne "" && ![catch {punk::args::synopsis $id} s]} {
                set syn [string trim [strip $s]]
            }
            if {$syn eq ""} {
                puts [format "  %s   (no punk::args synopsis available)" $c]
            } else {
                foreach line [split $syn \n] {
                    puts "  $line"
                }
            }
        }
    }
}

# ---------------------------------------------------------------- arg handling
set opt_synopsis 0
set opt_pathcommands 0
set globs [list]
foreach a $argv {
    switch -- $a {
        -synopsis     {set opt_synopsis 1}
        -pathcommands {set opt_pathcommands 1}
        default       {lappend globs $a}
    }
}
if {![llength $globs]} {
    puts stderr "usage: punk91 src script scriptlib/developer/nslist.tcl ?-synopsis? ?-pathcommands? <nsglob>..."
    puts stderr " e.g:  punk91 src script scriptlib/developer/nslist.tcl punk::ns"
    exit 2
}

# ---------------------------------------------------------------- main
set failures 0
set output_started 0
foreach g $globs {
    set fq [string map {:::: ::} $g]
    if {![string match ::* $fq]} {
        set fq ::[string trimleft $fq :]
    }
    set notes [list]
    set base [nonglob_base $fq]
    if {![namespace exists $base]} {
        set loaded [try_autoload $base]
        if {$loaded ne "" && [namespace exists $base]} {
            lappend notes "loaded package '$loaded [package present $loaded]' to populate $base"
        }
    }
    set query ""
    if {![regexp {[*?]} $fq]} {
        if {[namespace exists $fq]} {
            set query ${fq}::*
            if {[namespace ensemble exists $fq]} {
                lappend notes "$fq is also an ensemble command - whatis.tcl shows its subcommand map"
            }
        } else {
            # not a namespace - maybe a command (follow an ensemble to its namespace)
            set resolved [uplevel #0 [list namespace which -command $fq]]
            if {$resolved ne "" && [namespace ensemble exists $resolved]} {
                set ensns [namespace ensemble configure $resolved -namespace]
                lappend notes "'$g' is an ensemble command implemented in namespace $ensns - listing that (whatis.tcl shows the authoritative subcommand map)"
                set query ${ensns}::*
            } elseif {$resolved ne ""} {
                puts stderr "nslist: '$g' is a command, not a namespace - use the tcl-whatis skill: punk91 src script scriptlib/developer/whatis.tcl [string trimleft $g :]"
                incr failures
                continue
            } else {
                puts stderr "nslist: no namespace (or command) '$g' found - and no package matching it could be loaded"
                incr failures
                continue
            }
        }
    } else {
        if {[namespace exists $base]} {
            set query $fq
        } else {
            puts stderr "nslist: base namespace $base of glob '$g' not found - and no package matching it could be loaded"
            incr failures
            continue
        }
    }
    if {[catch {punk::ns::get_ns_dicts $query -nspathcommands $opt_pathcommands} dicts]} {
        puts stderr "nslist: punk::ns::get_ns_dicts failed for '$query': $dicts"
        incr failures
        continue
    }
    if {![llength $dicts]} {
        puts stderr "nslist: no namespaces matched '$query'"
        incr failures
        continue
    }
    if {$output_started} {
        puts ""
    }
    set output_started 1
    foreach n $notes {
        out note $n
    }
    set i 0
    foreach nd $dicts {
        if {$i > 0} {
            puts ""
        }
        incr i
        emit_nsdict $nd $opt_pathcommands $opt_synopsis
    }
}

exit [expr {$failures == 0 ? 0 : 1}]