Author: coke Date: Sun Sep 25 09:06:01 2005 New Revision: 9247 Modified: branches/leo-ctx5/languages/tcl/TODO branches/leo-ctx5/languages/tcl/tcl.pir Log: support $tcl_prompt1 and $tcl_prompt2 in interactive tclsh
Modified: branches/leo-ctx5/languages/tcl/TODO ============================================================================== --- branches/leo-ctx5/languages/tcl/TODO (original) +++ branches/leo-ctx5/languages/tcl/TODO Sun Sep 25 09:06:01 2005 @@ -35,10 +35,6 @@ is causing things to get rebuilt unecess tcl is not using Keys when getting from aggregates. It probably should, at least for language interoperability. -=item interactive tclsh - - o respect tcl_prompt1, tcl_prompt2 - =item implement default globals, etc. global variables provided by tcl libary. L<tclvars>. Modified: branches/leo-ctx5/languages/tcl/tcl.pir ============================================================================== --- branches/leo-ctx5/languages/tcl/tcl.pir (original) +++ branches/leo-ctx5/languages/tcl/tcl.pir Sun Sep 25 09:06:01 2005 @@ -34,16 +34,14 @@ # If no file was specified, read from stdin. .local string input_line - .local pmc STDIN,STDOUT + .local pmc STDIN STDIN = getstdin - STDOUT = getstdout .local pmc parse parse = find_global "_Tcl", "parse" input_line = "" - print "% " # XXX Doesn't respect a set tcl_prompt1 - STDOUT."flush"() + __prompt(1) input_loop: $S0 = readline STDIN input_line .= $S0 @@ -63,21 +61,24 @@ loop_error: # Are we just missing a close-foo? XXX probably not the best way to check. $P0 = P5[0] # message $S0 = $P0 - if $S0 == "missing close-brace" goto input_loop - if $S0 == "missing quote" goto input_loop + if $S0 == "missing close-brace" goto input_loop_continue2 + if $S0 == "missing quote" goto input_loop_continue2 loop_error_real: .get_stacktrace(P5,$S0) print $S0 print "\n" - goto input_loop_continue + #goto input_loop_continue input_loop_continue: - print "% " # XXX Doesn't respect a set tcl_prompt1 - STDOUT."flush"() + __prompt(1) input_line = "" goto input_loop +input_loop_continue2: + __prompt(2) + goto input_loop + open_file: tcl_interactive = 0 filename = argv[1] @@ -99,3 +100,39 @@ file_error: exit_exception: .rethrow() .end + +.sub __prompt + .param int level + + .local pmc STDOUT + STDOUT = getstdout + + .local string default_prompt + default_prompt = "" + if level == 2 goto got_prompt + default_prompt = "% " + +got_prompt: + + .local string varname + varname = "$tcl_prompt" + $S0 = level + varname .= $S0 + + .local pmc parse + parse = find_global "_Tcl", "parse" + + push_eh no_prompt + $P0 = find_global "Tcl", varname + $P1 = parse($P0) + $P1."interpret"() + clear_eh + + STDOUT."flush"() + .return() + +no_prompt: + print default_prompt + STDOUT."flush"() + .return() +.end
