blob: fe406edd85151746242a8eaf10bb188468c63760 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
# Create a single word alias (proc) for one or more words
# e.g. alias x info exists
# if {[x var]} ...
proc alias {name args} {
set prefix $args
proc $name args prefix {
tailcall {*}$prefix {*}$args
}
}
# Creates an anonymous procedure
proc lambda {arglist args} {
set name [ref {} function lambda.finalizer]
tailcall proc $name $arglist {*}$args
}
proc lambda.finalizer {name val} {
rename $name {}
}
# Like alias, but creates and returns an anonyous procedure
proc curry {args} {
set prefix $args
lambda args prefix {
tailcall {*}$prefix {*}$args
}
}
# Returns the given argument.
# Useful with 'local' as follows:
# proc a {} {...}
# local function a
#
# set x [lambda ...]
# local function $x
#
proc function {value} {
return $value
}
# Tcl 8.5 lassign
proc lassign {list args} {
# in case the list is empty...
lappend list {}
uplevel 1 [list foreach $args $list break]
lrange $list [llength $args] end-1
}
# Returns a list of proc filename line ...
# with 3 entries for each stack frame (proc),
# (deepest level first)
proc stacktrace {} {
set trace {}
foreach level [range 1 [info level]] {
lassign [info frame -$level] p f l
lappend trace $p $f $l
}
return $trace
}
# Returns a human-readable version of a stack trace
proc stackdump {stacktrace} {
set result {}
set count 0
foreach {l f p} [lreverse $stacktrace] {
if {$count} {
append result \n
}
incr count
if {$p ne ""} {
append result "in procedure '$p' "
if {$f ne ""} {
append result "called "
}
}
if {$f ne ""} {
append result "at file \"$f\", line $l"
}
}
return $result
}
# Sort of replacement for $::errorInfo
# Usage: errorInfo error ?stacktrace?
proc errorInfo {msg {stacktrace ""}} {
if {$stacktrace eq ""} {
set stacktrace [info stacktrace]
}
lassign $stacktrace p f l
if {$f ne ""} {
set result "Runtime Error: $f:$l: "
}
append result "$msg\n"
append result [stackdump $stacktrace]
# Remove the trailing newline
string trim $result
}
# Finds the current executable by searching along the path
# Returns the empty string if not found.
proc {info nameofexecutable} {} {
if {[info exists ::jim_argv0]} {
if {[string first "/" $::jim_argv0] >= 0} {
return $::jim_argv0
}
foreach path [split [env PATH ""] :] {
set exec [file join $path $::jim_argv0]
if {[file executable $exec]} {
return $exec
}
}
}
return ""
}
|
