{Removes the topmost (most recently stacked) rename entry
belonging to renamer and returns the removed record - the
LIFO undo for a package that renames as it loads and
unwinds as it unloads. With command given, the pop is
restricted to that command's stack (equivalent to
'remove_rename [list $command $renamer]'). Without command,
every live stack is searched: when the renamer's entries
all live on one command the pop happens there; entries
spread across multiple commands are ambiguous and raise an
error naming those commands (supply command, or use
commandstack::remove_renamer to remove all of them).
Stacks parked by Rename_stack are maintenance state and are
not searched. The renamer must be known to commandstack or
an error is raised. Returns the empty string when the
renamer has no matching entry.}
@values -min 1 -max 2
renamer -type string -help -&
"Renamer string recorded at rename time (must be known
to commandstack)."
command -type string -optional 1 -help -&
"Restrict the pop to this command's stack (resolved in
the caller's namespace context)."
}]
}
proc pop_rename {renamer {command ""}} {
variable all_stacks
variable known_renamers
variable debug
if {$renamer ni $known_renamers} {
error "(commandstack::pop_rename) ERROR: renamer $renamer not in list of known_renamers '$known_renamers'. Supply the renamer string recorded at rename time."
}
if {$command ne ""} {
set command [uplevel 1 [list namespace which $command]]
if {$command eq "" || ![dict exists $all_stacks $command]} {
return ""
}
set commands [list $command]
} else {
#find the live stacks holding entries for this renamer. Stacks parked
#by Rename_stack are skipped: their records keep the original token
#command, which never equals the parked key.
set commands [list]
dict for {key stack} $all_stacks {
if {![llength $stack]} {
continue
}
if {[lindex [dict get [lindex $stack 0] token] 0] ne $key} {
continue
}
if {[lsearch -index 3 $stack $renamer] > -1} {
lappend commands $key
}
}
if {[llength $commands] > 1} {
error "(commandstack::pop_rename) ERROR: renamer '$renamer' has entries on multiple commands ([join $commands {, }]) - supply the command argument, or use commandstack::remove_renamer to remove all of its entries"
}
if {![llength $commands]} {
return ""
}
}
set command [lindex $commands 0]
set stack [dict get $all_stacks $command]
set topmost [lindex [lsearch -all -index 3 $stack $renamer] end]
if {$topmost eq ""} {
return ""
}
set record [lindex $stack $topmost]
remove_rename [list $command $renamer]
if {$debug} {
puts stderr "(commandstack::pop_rename) popped [dict get $record token]"
}
return $record
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::commandstack::remove_renamer
@cmd -name "commandstack::remove_renamer" -&
-summary -&
"Remove every rename-stack entry belonging to a renamer." -&
-help -&
{The unload-my-package convenience: removes ALL entries
recorded for renamer across every live command stack. Each
command's entries are popped topmost-first through the same
re-linking machinery as remove_rename, so other renamers'
overrides keep delegating correctly. Stacks parked by
Rename_stack are maintenance state and are left untouched.
The renamer must be known to commandstack or an error is
raised; the renamer is NOT removed from known_renamers.
Returns a dict keyed by command name whose values are the
removed records (topmost-first); an empty dict when the
renamer had no entries.}
@values -min 1 -max 1
renamer -type string -help -&
"Renamer string recorded at rename time (must be known
to commandstack)."
}]
}
proc remove_renamer {renamer} {
variable all_stacks
variable known_renamers
variable debug
if {$renamer ni $known_renamers} {
error "(commandstack::remove_renamer) ERROR: renamer $renamer not in list of known_renamers '$known_renamers'. Supply the renamer string recorded at rename time."
}
set removed [dict create]
#remove_rename mutates all_stacks only under the command key it is
#given, so iterating over this snapshot of the stacks dict is safe.
#Stacks parked by Rename_stack are skipped: their records keep the
#original token command, which never equals the parked key.
dict for {command stack} $all_stacks {
if {![llength $stack]} {
continue
}
if {[lindex [dict get [lindex $stack 0] token] 0] ne $command} {
continue
}
while {[set topmost [lindex [lsearch -all -index 3 [dict get $all_stacks $command] $renamer] end]] ne ""} {
set record [lindex [dict get $all_stacks $command] $topmost]
remove_rename [list $command $renamer]
dict lappend removed $command $record
if {$debug} {
puts stderr "(commandstack::remove_renamer) removed [dict get $record token]"
}
}
}
return $removed
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::commandstack::restore_original
@cmd -name "commandstack::restore_original" -&
-summary -&
"Unwind a command's whole rename stack, restoring the original implementation." -&
-help -&
{Removes EVERY record on the command's live rename stack -
regardless of which renamers contributed them - and
restores the bottom-of-stack (original) implementation as
the live command. Records are removed topmost-first through
the same machinery as remove_rename.
This is the repair/reset operation: it is deliberately NOT
gated by known_renamers (unlike remove_rename) - renamers
evidenced by the stack records are registered into
known_renamers first, mirroring rename_command, so a
restore still works after state loss such as a module
re-source that reset known_renamers while stacks survived.
Returns the number of records removed: 0 when the command
has no live stack (never renamed, or only the empty residue
entry - prune that with Delete_stack).}
@values -min 1 -max 1
command -type string -help -&
"Command name (resolved with 'namespace which' in the
caller's context)."
}]
}
proc restore_original {command} {
variable all_stacks
variable known_renamers
variable debug
set command [uplevel 1 [list namespace which $command]]
if {$command eq "" || ![dict exists $all_stacks $command]} {
return 0
}
set stack [dict get $all_stacks $command]
if {![llength $stack]} {
return 0
}
#a repair operation must not be gated by known_renamers (which a module
#re-source may have reset while stacks survived) - register the renamers
#the stack evidences, mirroring rename_command
foreach record $stack {
set record_renamer [dict get $record renamer]
if {$record_renamer ni $known_renamers} {
lappend known_renamers $record_renamer
}
}
set removed_count 0
while {[llength $stack]} {
remove_rename [dict get [lindex $stack end] token]
set stack [dict get $all_stacks $command]
incr removed_count
}
if {$debug} {
puts stderr "(commandstack::restore_original) restored '$command' to its original implementation ($removed_count override(s) unwound)"
