diff options
author | Steve Bennett <steveb@workware.net.au> | 2013-11-11 19:02:00 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2013-11-11 20:40:46 +1000 |
commit | 7430907e4db9a9bbdce8934bd4438987a616c8e1 (patch) | |
tree | 7db8e78f324179f9ccef2f9967aa1e6b6344c52f /examples/jtclsh.tcl | |
parent | 5a8a3016b9e1218dd6f478259e890510c2a53e3d (diff) | |
download | jimtcl-7430907e4db9a9bbdce8934bd4438987a616c8e1.zip jimtcl-7430907e4db9a9bbdce8934bd4438987a616c8e1.tar.gz jimtcl-7430907e4db9a9bbdce8934bd4438987a616c8e1.tar.bz2 |
Enhance examples/jtclsh.tcl
Now uses [info complete] to support continuations.
Includes error code indication
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'examples/jtclsh.tcl')
-rw-r--r-- | examples/jtclsh.tcl | 44 |
1 files changed, 33 insertions, 11 deletions
diff --git a/examples/jtclsh.tcl b/examples/jtclsh.tcl index dc92bca..b384717 100644 --- a/examples/jtclsh.tcl +++ b/examples/jtclsh.tcl @@ -8,29 +8,51 @@ package require history set histfile [env HOME]/.jtclsh history load $histfile -while 1 { - if {[history getline "jim> " cmd] < 0} { - break +set prefix "" +while {1} { + # Read a complete line (script) + set prompt "${prefix}jim> " + set cmd {} + while {1} { + if {[history getline $prompt line] < 0} { + exit 0 + } + if {$cmd ne ""} { + append cmd \n + } + append cmd $line + if {[info complete $cmd char]} { + break + } + set prompt "$char> " } + if {$cmd eq "h"} { history show continue } + # Don't bother adding single char commands to the history if {[string length $cmd] > 1} { history add $cmd history save $histfile } - # jimsh also does: - # - check for a complete command: [info complete] - # - handle other non-error return codes and changes the prompt: [info returncodes] - # - displays the complete error message: [errorInfo] + + # Evaluate the script and display the error try { set result [eval $cmd] - if {$result ne {}} { - puts $result + set prefix "" + } on {error return break continue signal} {result opts} { + set rcname [info returncodes $opts(-code)] + if {$rcname eq "ok" } { + # Note: return set -code to 0 + set rcname return + } elseif {$rcname eq "error"} { + set result [errorInfo $result] } - } on error msg { - puts $msg + set prefix "\[$rcname\] " + } + if {$result ne {}} { + puts $result } } |