1 # Creates an anonymous procedure
2 proc lambda
{arglist args
} {
3 set name
[ref
{} function lambda.finalizer
]
4 tailcall
proc $name $arglist {*}$args
7 proc lambda.finalizer
{name val
} {
11 # Like alias, but creates and returns an anonyous procedure
15 tailcall
{*}$prefix {*}$args
19 # Returns the given argument.
20 # Useful with 'local' as follows:
27 proc function
{value
} {
32 proc lassign
{list args
} {
33 # in case the list is empty...
35 uplevel 1 [list foreach $args $list break]
36 lrange $list [llength $args] end-1
39 # Returns a list of proc filename line ...
40 # with 3 entries for each stack frame (proc),
41 # (deepest level first)
44 foreach level
[range
1 [info level
]] {
45 lassign
[info frame -$level] p f l
46 lappend trace $p $f $l
51 # Returns a human-readable version of a stack trace
52 proc stackdump
{stacktrace
} {
55 foreach {l f p
} [lreverse
$stacktrace] {
61 append result
"in procedure '$p' "
63 append result
"called "
67 append result
"at file \"$f\", line $l"
73 # Sort of replacement for $::errorInfo
74 # Usage: errorInfo error ?stacktrace?
75 proc errorInfo
{msg
{stacktrace
""}} {
76 if {$stacktrace eq
""} {
77 set stacktrace
[info stacktrace
]
79 lassign
$stacktrace p f l
81 set result
"Runtime Error: $f:$l: "
83 append result
"$msg\n"
84 append result
[stackdump
$stacktrace]
86 # Remove the trailing newline
90 # Finds the current executable by searching along the path
91 # Returns the empty string if not found.
92 proc {info nameofexecutable
} {} {
93 if {[info exists
::jim_argv0]} {
94 if {[string match
"*/*" $::jim_argv0]} {
95 return [file join [pwd] $::jim_argv0]
97 foreach path
[split [env PATH
""] $::tcl_platform(pathSeparator
)] {
98 set exec [file join [pwd] [string map
{\\ /} $path] $::jim_argv0]
99 if {[file executable
$exec]} {
107 # Script-based implementation of 'dict with'
108 proc {dict with
} {dictVar args script
} {
111 foreach {n v
} [dict get
$dict {*}$args] {
116 catch {uplevel 1 $script} msg opts
117 if {[info exists dict
] && [dict exists
$dict {*}$args]} {
119 if {[info exists var_
$n]} {
120 dict
set dict
{*}$args $n [set var_
$n]
122 dict
unset dict
{*}$args $n
129 # Script-based implementation of 'dict merge'
130 # This won't get called in the trivial case of no args
131 proc {dict merge
} {dict args
} {
133 # Check for a valid dict