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
}