aboutsummaryrefslogtreecommitdiff
path: root/stdlib.tcl
diff options
context:
space:
mode:
authorSteve Bennett <steveb@workware.net.au>2023-01-13 10:23:19 +1000
committerSteve Bennett <steveb@workware.net.au>2023-02-13 10:43:00 +1000
commit517d85974c7cf8d4f894f46251462e14b6fc562f (patch)
tree2e4eebd4f75671687827d484803e1a2da1d60d88 /stdlib.tcl
parentdb26fe46ea9a35d403067498f4b85eee82b431b0 (diff)
downloadjimtcl-517d85974c7cf8d4f894f46251462e14b6fc562f.zip
jimtcl-517d85974c7cf8d4f894f46251462e14b6fc562f.tar.gz
jimtcl-517d85974c7cf8d4f894f46251462e14b6fc562f.tar.bz2
Tcl-compatible 'info frame'
Returns a dictionary with file, line, cmd, (possibly) proc and level. And support 'info frame 0' for the current command. Note that now all evaluation frames are captured, not just call frames. Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'stdlib.tcl')
-rw-r--r--stdlib.tcl26
1 files changed, 23 insertions, 3 deletions
diff --git a/stdlib.tcl b/stdlib.tcl
index 37a8007..01d73c0 100644
--- a/stdlib.tcl
+++ b/stdlib.tcl
@@ -38,9 +38,29 @@ proc function {value} {
# (deepest level first)
proc stacktrace {{skip 0}} {
set trace {}
- incr skip
- foreach level [range $skip [info level]] {
- lappend trace {*}[info frame -$level]
+ # Need to skip info frame 0 and this (stacktrace) level
+ incr skip 2
+ loop level $skip [info level]+1 {
+ set frame [info frame -$level]
+ lappend trace [lindex [dict get $frame cmd] 0] [dict get $frame file] [dict get $frame line]
+ }
+ return $trace
+}
+proc stacktrace {{skip 0}} {
+ set trace {}
+ # skip the internal frames
+ incr skip 1
+ set last 0
+ loop level $skip [info frame]+1 {
+ set frame [info frame -$level]
+ set file [dict get $frame file]
+ set line [dict get $frame line]
+ set lev [dict get $frame level]
+ if {$lev != $last && $lev > $skip} {
+ set proc [lindex [dict get $frame cmd] 0]
+ lappend trace $proc $file $line
+ }
+ set last $lev
}
return $trace
}