enjoy
- Code: Select all
#
# This is the Tcl based implementation of an expression evaluator which was designed
# to be used as an external UltraEdit/UEx tool.
# For tool functionality refer to the help text (inline).
#
# UEx external tool definition:
# name eval
# command tclsh85 eval.tcl "%sel%"
# append to existing
# capture output
# advanced, replace selection with captured output
#
# UEx macro framework:
# IfSel
# Else
# "?"
# Find Up Select "?"
# EndIf
# RunTool "eval"
# Find Select "@"
# Find "@"
# Replace All SelectText ""
#
# Usage from UEx:
# Insert external tool argument (the expression to be evaluated) into the text.
# Example: type "1+2".
# Select the argument.
# Example: Find Up Select "1".
# Run the framework macro.
# Example: PlayMacro 1 "eval".
# Result will be returned as selected text in place of the input.
# Example: "3" selected.
#
proc run {args} {
if {[llength $args] != 1 || [lindex $args 0] == "?"} {
# request for help
puts ---
puts {Evaluate Expression // one call parameter, result to standard output}
puts USAGE
puts { tclsh eval.tcl "arg" // run Tcl [expr $arg], use default output format}
puts { tclsh eval.tcl "arg,form" // run Tcl [expr $arg], use given output format}
puts { tclsh eval.tcl "arg,s" // run Tcl [eval $arg], take $arg as a Tcl command}
puts { tclsh eval.tcl ? // request help}
puts NOTES
puts {- A format specifier may be appended to the argument.}
puts { The format specifier must be preceeed with ','.}
puts { tclsh eval.tcl "1+10,x" // example requesting hexadecimal output}
puts { The default format specifier depends on detection of a decimal point.}
puts { It is either 'd' (requesting decimal output) or 'g' (floating point).}
puts {- Output is created using Tcl [format %$form [expr $arg]].}
puts {- If the format specifier is 's', then the argument is not treated as an expression}
puts { but as a Tcl command. This means output is created using Tcl [eval $arg].}
puts {- Quoting of the call argument is only required if there are spaces or}
puts { parentheses contained, or if characters conflict with the shell interpreter.}
puts { tclsh eval.tcl 1+2 // this is ok}
puts { tclsh eval.tcl "1 + 2" // this is ok}
puts {- There is support for usage as external tool from within UEx.}
puts { . Character <at> is appended to the output.}
puts { . After returning control to UEx, the <at> can be referenced for highlighting}
puts { the returned string (which is designed to be inserted into the edited text).}
puts {- In case of an error from evaluation or formatting, the call argument is}
puts { returned with a question mark (and <at>) appended.}
puts { tclsh eval.tcl 1,q // example call}
puts { "1,q?<at>" // output}
puts {- For more information refer to Tcl commands [expr] and [format].}
puts { For expressions also refer to Tcl defined math functions.}
puts {- The script can be tried out working in Tcl interactively:}
puts { source eval.tcl}
puts { run 1+2}
puts { puts $errorInfo // check for problem details in case of an error}
puts EXAMPLES
puts { tclsh eval.tcl "string repeat - 80,s" // create a sequence of 80 '-' chars}
puts { tclsh eval.tcl "string length {abc},s" // get string length}
puts { tclsh eval.tcl ~0x15,x // get ones' complement in hex }
puts { tclsh eval.tcl "5 / ([string length {abcd}] + 0.0)"}
puts { // returns "1.25", float format implied}
puts { tclsh eval.tcl "{a}<{b}" // do lexical string comparison }
puts { tclsh eval.tcl "sin(3),f" // note the format must be given here}
puts -nonewline ---@
} else {
# single argument - evaluate
set arg [lindex $args 0]
if {[regexp {,s$} $arg]} {
# Tcl command
set error [catch {set result [eval [string range $arg 0 end-2]]}]
} else {
# expression
set n [string first , $arg]
if {$n == -1} {
# default format
if {[string first . $arg] == -1} {
set form d
} else {
set form g
}
} else {
# format specifier
set form [string range $arg [expr {$n + 1}] end]
set arg [string range $arg 0 [expr {$n - 1}]]
}
set error [catch {set result [format "%$form" [expr "$arg"]]}]
}
if {$error} {
puts -nonewline "[lindex $args 0]?@"
} else {
puts -nonewline "$result@"
}
}
}
if {!$tcl_interactive} {
eval run $argv
}