Hello,
not so long ago Mo wrote,
> The history command should be very easy.
And he was right. Indeed it was *so* easy,
that I managed it before xmas :-)
I attached the differences and the modified history.test of Tcl8.2
Greetings, Krischan
--
Christian Krone, SQL Datenbanksysteme GmbH
*** ConsoleEvent.java.org Sun May 9 01:55:57 1999
--- ConsoleEvent.java Wed Nov 24 17:52:46 1999
***************
*** 87,93 ****
int flags) // Same as flags passed to Notifier.doOneEvent.
{
try {
! interp.eval(script, 0);
evalResult = interp.getResult();
evalResult.preserve();
} catch (TclException e) {
--- 87,93 ----
int flags) // Same as flags passed to Notifier.doOneEvent.
{
try {
! interp.recordAndEval(script, 0);
evalResult = interp.getResult();
evalResult.preserve();
} catch (TclException e) {
*** Interp.java.org Tue Aug 31 02:54:32 1999
--- Interp.java Thu Nov 25 15:20:56 1999
***************
*** 2045,2050 ****
--- 2045,2096 ----
/*
*----------------------------------------------------------------------
*
+ * recordAndEval --
+ *
+ * This procedure adds its command argument to the current list of
+ * recorded events and then executes the command by calling eval.
+ *
+ * Results:
+ * The return value is void. However, a standard Tcl Exception
+ * may be generated. The interpreter's result object will contain
+ * the value of the evaluation but will persist only until the next
+ * call to one of the eval functions.
+ *
+ * Side effects:
+ * The side effects will be determined by the exact Tcl code to be
+ * evaluated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ public void
+ recordAndEval(
+ String string, // A script to evaluate.
+ int flags) // Flags, either 0 or TCL_GLOBAL_ONLY.
+ throws
+ TclException // A standard Tcl exception.
+ {
+ // Append the string to the event list by calling "history add <string>".
+ // We call the eval method with the command of type TclObject, so that
+ // we don't have to deal with funny chars ("{}[]$\) in the string.
+
+ try {
+ Interp interp = this;
+ TclObject cmd = TclList.newInstance();
+ TclList.append(interp, cmd, TclString.newInstance("history"));
+ TclList.append(interp, cmd, TclString.newInstance("add"));
+ TclList.append(interp, cmd, TclString.newInstance(string));
+ eval(cmd, 0);
+ } catch (Exception e) {}
+
+ // Finally evaluate the string.
+
+ eval(string, flags);
+ }
+
+ /*
+ *----------------------------------------------------------------------
+ *
* eval --
*
* Execute a Tcl command in a string or Tcl Object.
*** history.tcl.org Wed Oct 14 23:09:21 1998
--- history.tcl Thu Nov 25 15:22:05 1999
***************
*** 10,23 ****
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
- # For now, the history command is disabled.
-
- proc history {args} {
- return -code error "error: the history command is currently disabled."
- }
-
- return
-
# The tcl::history array holds the history list and
# some additional bookkeeping variables.
#
--- 10,15 ----
*** init.tcl.org Sun May 9 03:41:08 1999
--- init.tcl Thu Nov 25 12:35:17 1999
***************
*** 196,221 ****
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
! # The following cases are temporarily commented out until the
! # Tcl history, regexp, and regsub commands are implemented in
! # Jacl. No replacement code is necessary.
! # if {$name == "!!"} \{
! # set newcmd [history event]
! # \} elseif {[regexp {^!(.+)$} $name dummy event]} \{
! # set newcmd [history event $event]
! # \} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} \{
! # set newcmd [history event -1]
! # catch {regsub -all -- $old $newcmd $new newcmd}
! # \}
!
! # if [info exists newcmd] \{
! # tclLog $newcmd
! # history change $newcmd 0
! # return [uplevel $newcmd]
! # \}
!
! # end temporary comments
set ret [catch {set cmds [info commands $name*]} msg]
if {[string compare $name "::"] == 0} {
--- 196,215 ----
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
! if {$name == "!!"} {
! set newcmd [history event]
! } elseif {[regexp {^!(.+)$} $name dummy event]} {
! set newcmd [history event $event]
! } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
! set newcmd [history event -1]
! catch {regsub -all -- $old $newcmd $new newcmd}
! }
! if [info exists newcmd] {
! tclLog $newcmd
! history change $newcmd 0
! return [uplevel $newcmd]
! }
set ret [catch {set cmds [info commands $name*]} msg]
if {[string compare $name "::"] == 0} {
*** Eval.htm.org Sun May 9 00:26:17 1999
--- Eval.htm Thu Nov 25 15:32:59 1999
***************
*** 8,13 ****
--- 8,14 ----
<DL><DD>void <B>eval</B>(String <I>str</I>, int <I>flags</I>) throws
TclException</DL>
<DL><DD>void <B>eval</B>(TclObject <I>tobj</I>, int <I>flags</I>) throws
TclException</DL>
<DL><DD>void <B>evalFile</B>(String <I>fileName</I>) throws TclException</DL>
+ <DL><DD>void <B>recordAndEval</B>(String <I>str</I>, int <I>flags</I>) throws
+TclException</DL>
<DL><DD>static boolean <B>commandComplete</B>(String <I>cmdName</I>) throws
TclException</DL>
<DD><A HREF="Eval.htm#M4" NAME="L26">OTHER METHODS</A>
<DD><A HREF="Eval.htm#M5" NAME="L27">ARGUMENTS</A>
***************
*** 17,27 ****
<DL>
<DD><A HREF="Eval.htm#M7" NAME="L29"><B>eval</B></A>
<DD><A HREF="Eval.htm#M8" NAME="L30"><B>evalFile</B></A>
! <DD><A HREF="Eval.htm#M9" NAME="L31"><B>commandComplete</B></A>
</DL>
! <DD><A HREF="Eval.htm#M10" NAME="L32">EQUIVALENT C FUNCTIONS</A>
! <DD><A HREF="Eval.htm#M11" NAME="L33">SEE ALSO</A>
! <DD><A HREF="Eval.htm#M12" NAME="L34">KEYWORDS</A>
</DL><HR>
<H3><A NAME="M2">CLASS</A></H3>
tcl.lang.Interp -- This manual entry contains Interp methods that execute or
--- 18,29 ----
<DL>
<DD><A HREF="Eval.htm#M7" NAME="L29"><B>eval</B></A>
<DD><A HREF="Eval.htm#M8" NAME="L30"><B>evalFile</B></A>
! <DD><A HREF="Eval.htm#M9" NAME="L31"><B>recordAndEval</B></A>
! <DD><A HREF="Eval.htm#M10" NAME="L32"><B>commandComplete</B></A>
</DL>
! <DD><A HREF="Eval.htm#M11" NAME="L33">EQUIVALENT C FUNCTIONS</A>
! <DD><A HREF="Eval.htm#M12" NAME="L34">SEE ALSO</A>
! <DD><A HREF="Eval.htm#M13" NAME="L35">KEYWORDS</A>
</DL><HR>
<H3><A NAME="M2">CLASS</A></H3>
tcl.lang.Interp -- This manual entry contains Interp methods that execute or
***************
*** 81,87 ****
The <B>evalFile</B> method reads the file given by <I>fileName</I> and
evaluates its contents as a Tcl script. It behaves the same as
<B>eval</B>.
! <P><DT><A NAME="M9"><B>commandComplete</B></A><DD>
The <B>commandComplete</B> method takes a Tcl command <I>str</I>
as argument and determines whether it contains one or more
complete commands (i.e. there are no unclosed quotes, braces,
--- 83,93 ----
The <B>evalFile</B> method reads the file given by <I>fileName</I> and
evaluates its contents as a Tcl script. It behaves the same as
<B>eval</B>.
! <P><DT><A NAME="M9"><B>recordAndEval</B></A><DD>
! The <B>recordAndEval</B> method adds the script stored in <I>str</I>
! to the current list of recorded events and then executes the command by
! calling <B>eval</B>.
! <P><DT><A NAME="M10"><B>commandComplete</B></A><DD>
The <B>commandComplete</B> method takes a Tcl command <I>str</I>
as argument and determines whether it contains one or more
complete commands (i.e. there are no unclosed quotes, braces,
***************
*** 90,100 ****
returns false.
<P></DL>
! <H3><A NAME="M10">EQUIVALENT C FUNCTIONS</A></H3>
! <A href="../cFunctions.html">Tcl_Eval</A>, <A
href="../cFunctions.html">Tcl_GlobalEval</A>, <A
href="../cFunctions.html">Tcl_EvalObj</A>, <A
href="../cFunctions.html">Tcl_EvalFile</A>, <A
href="../cFunctions.html">Tcl_CommandComplete</A>
! <H3><A NAME="M11">SEE ALSO</A></H3>
<B><A HREF="../TclJavaLib/Interp.htm">Interp</A></B>, <B><A
HREF="../TclJavaLib/setVar.htm">setVar</A></B>, <B><A
HREF="../TclJavaLib/setResult.htm">setResult</A></B>, <B><A
HREF="../TclJavaLib/backgdErr.htm">addErrorInfo</A></B>, <B><A
HREF="../TclJavaLib/dispose.htm">dispose</A></B>, <B><A
HREF="../TclJavaLib/TclException.htm">TclException</A></B>, <B><A
HREF="../TclJavaLib/runtimeError.htm">TclRuntimeError</A></B>, <B><A
HREF="../TclJavaLib/TclEvent.htm">TclEvent</A></B>
! <H3><A NAME="M12">KEYWORDS</A></H3>
<A href="../Keywords/C.htm#complete command">complete command</A>, <A
href="../Keywords/E.htm#execute">execute</A>, <A
href="../Keywords/F.htm#file">file</A>, <A href="../Keywords/G.htm#global">global</A>,
<A href="../Keywords/I.htm#interpreter">interpreter</A>, <A
href="../Keywords/O.htm#object">object</A>, <A href="../Keywords/P.htm#partial
command">partial
command</A>, <A href="../Keywords/R.htm#result">result</A>, <A
href="../Keywords/S.htm#script">script</A>
--- 96,106 ----
returns false.
<P></DL>
! <H3><A NAME="M11">EQUIVALENT C FUNCTIONS</A></H3>
! <A href="../cFunctions.html">Tcl_Eval</A>, <A
href="../cFunctions.html">Tcl_GlobalEval</A>, <A
href="../cFunctions.html">Tcl_EvalObj</A>, <A
href="../cFunctions.html">Tcl_EvalFile</A>, <A
href="../cFunctions.html">Tcl_RecordAndEval</A>, <A
href="../cFunctions.html">Tcl_CommandComplete</A>
! <H3><A NAME="M12">SEE ALSO</A></H3>
<B><A HREF="../TclJavaLib/Interp.htm">Interp</A></B>, <B><A
HREF="../TclJavaLib/setVar.htm">setVar</A></B>, <B><A
HREF="../TclJavaLib/setResult.htm">setResult</A></B>, <B><A
HREF="../TclJavaLib/backgdErr.htm">addErrorInfo</A></B>, <B><A
HREF="../TclJavaLib/dispose.htm">dispose</A></B>, <B><A
HREF="../TclJavaLib/TclException.htm">TclException</A></B>, <B><A
HREF="../TclJavaLib/runtimeError.htm">TclRuntimeError</A></B>, <B><A
HREF="../TclJavaLib/TclEvent.htm">TclEvent</A></B>
! <H3><A NAME="M13">KEYWORDS</A></H3>
<A href="../Keywords/C.htm#complete command">complete command</A>, <A
href="../Keywords/E.htm#execute">execute</A>, <A
href="../Keywords/F.htm#file">file</A>, <A href="../Keywords/G.htm#global">global</A>,
<A href="../Keywords/I.htm#interpreter">interpreter</A>, <A
href="../Keywords/O.htm#object">object</A>, <A href="../Keywords/P.htm#partial
command">partial
command</A>, <A href="../Keywords/R.htm#result">result</A>, <A
href="../Keywords/S.htm#script">script</A>
*** cFunctions.html.org Sun May 9 00:26:09 1999
--- cFunctions.html Thu Nov 25 15:37:17 1999
***************
*** 28,34 ****
<A HREF="TclJavaLib/Eval.htm">Tcl_EvalObj</A> <A
HREF="TclJavaLib/TclList.htm">Tcl_NewListObj</A> <A
HREF="TclJavaLib/traceVar.htm">Tcl_UntraceVar</A>
<A HREF="TclJavaLib/EventDeleter.htm">Tcl_EventDeleteProc</A> <A
HREF="TclJavaLib/TclObject.htm">Tcl_NewObj</A> <A
HREF="TclJavaLib/traceVar.htm">Tcl_UntraceVar2</A>
<A HREF="TclJavaLib/TclEvent.htm">Tcl_EventProc</A> <A
HREF="TclJavaLib/TclString.htm">Tcl_NewStringObj</A> <A
HREF="TclJavaLib/runtimeError.htm">panic</A>
! <A HREF="TclJavaLib/setAssocData.htm">Tcl_GetAssocData</A> <A
HREF="TclJavaLib/InternalRep.htm">Tcl_ObjType.dupIntRepProc</A>
</PRE>
<HR>
--- 28,34 ----
<A HREF="TclJavaLib/Eval.htm">Tcl_EvalObj</A> <A
HREF="TclJavaLib/TclList.htm">Tcl_NewListObj</A> <A
HREF="TclJavaLib/traceVar.htm">Tcl_UntraceVar</A>
<A HREF="TclJavaLib/EventDeleter.htm">Tcl_EventDeleteProc</A> <A
HREF="TclJavaLib/TclObject.htm">Tcl_NewObj</A> <A
HREF="TclJavaLib/traceVar.htm">Tcl_UntraceVar2</A>
<A HREF="TclJavaLib/TclEvent.htm">Tcl_EventProc</A> <A
HREF="TclJavaLib/TclString.htm">Tcl_NewStringObj</A> <A
HREF="TclJavaLib/runtimeError.htm">panic</A>
! <A HREF="TclJavaLib/setAssocData.htm">Tcl_GetAssocData</A> <A
HREF="TclJavaLib/InternalRep.htm">Tcl_ObjType.dupIntRepProc</A> <A
HREF="TclJavaLib/Eval.htm">recordAndEval</A>
</PRE>
<HR>
# Commands covered: history
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: history.test,v 1.4 1999/06/26 03:54:14 jenn Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
if {[catch {history}]} {
puts stdout "This version of Tcl was built without the history command;\n"
puts stdout "history tests will be skipped.\n"
return
}
set num [history nextid]
history keep 3
history add {set a 12345}
history add {set b [format {A test %s} string]}
history add {Another test}
# "history event"
test history-1.1 {event option} {history event -1} \
{set b [format {A test %s} string]}
test history-1.2 {event option} {history event $num} \
{set a 12345}
test history-1.3 {event option} {history event [expr $num+2]} \
{Another test}
test history-1.4 {event option} {history event set} \
{set b [format {A test %s} string]}
test history-1.5 {event option} {history e "* a*"} \
{set a 12345}
test history-1.6 {event option} {catch {history event *gorp} msg} 1
test history-1.7 {event option} {
catch {history event *gorp} msg
set msg
} {no event matches "*gorp"}
test history-1.8 {event option} {history event} \
{set b [format {A test %s} string]}
test history-1.9 {event option} {catch {history event 123 456} msg} 1
test history-1.10 {event option} {
catch {history event 123 456} msg
set msg
} {wrong # args: should be "history event ?event?"}
# "history redo"
set a 0
history redo -2
test history-2.1 {redo option} {set a} 12345
set b 0
history redo
test history-2.2 {redo option} {set b} {A test string}
test history-2.3 {redo option} {catch {history redo -3 -4}} 1
test history-2.4 {redo option} {
catch {history redo -3 -4} msg
set msg
} {wrong # args: should be "history redo ?event?"}
# "history add"
history add "set a 444" exec
test history-3.1 {add option} {set a} 444
test history-3.2 {add option} {catch {history add "set a 444" execGorp}} 1
test history-3.3 {add option} {
catch {history add "set a 444" execGorp} msg
set msg
} {bad argument "execGorp": should be "exec"}
test history-3.4 {add option} {catch {history add "set a 444" a} msg} 1
test history-3.5 {add option} {
catch {history add "set a 444" a} msg
set msg
} {bad argument "a": should be "exec"}
history add "set a 555" e
test history-3.6 {add option} {set a} 555
history add "set a 666"
test history-3.7 {add option} {set a} 555
test history-3.8 {add option} {catch {history add "set a 666" e f} msg} 1
test history-3.9 {add option} {
catch {history add "set a 666" e f} msg
set msg
} {wrong # args: should be "history add event ?exec?"}
# "history change"
history change "A test value"
test history-4.1 {change option} {history event [expr {[history n]-1}]} \
"A test value"
history ch "Another test" -1
test history-4.2 {change option} {history e} "Another test"
test history-4.3 {change option} {history event [expr {[history n]-1}]} \
"A test value"
test history-4.4 {change option} {catch {history change Foo 4 10}} 1
test history-4.5 {change option} {
catch {history change Foo 4 10} msg
set msg
} {wrong # args: should be "history change newValue ?event?"}
test history-4.6 {change option} {
catch {history change Foo [expr {[history n]-4}]}
} 1
set num [expr {[history n]-4}]
test history-4.7 {change option} {
catch {history change Foo $num} msg
set msg
} "event \"$num\" is too far in the past"
# "history info"
set num [history n]
history add set\ a\ {b\nc\ d\ e}
history add {set b 1234}
history add set\ c\ {a\nb\nc}
test history-5.1 {info option} {history info} [format {%6d set a {b
c d e}
%6d set b 1234
%6d set c {a
b
c}} $num [expr $num+1] [expr $num+2]]
test history-5.2 {info option} {history i 2} [format {%6d set b 1234
%6d set c {a
b
c}} [expr $num+1] [expr $num+2]]
test history-5.3 {info option} {catch {history i 2 3}} 1
test history-5.4 {info option} {
catch {history i 2 3} msg
set msg
} {wrong # args: should be "history info ?count?"}
test history-5.5 {info option} {history} [format {%6d set a {b
c d e}
%6d set b 1234
%6d set c {a
b
c}} $num [expr $num+1] [expr $num+2]]
# "history keep"
history add "foo1"
history add "foo2"
history add "foo3"
history keep 2
test history-6.1 {keep option} {history event [expr [history n]-1]} foo3
test history-6.2 {keep option} {history event -1} foo2
test history-6.3 {keep option} {catch {history event -3}} 1
test history-6.4 {keep option} {
catch {history event -3} msg
set msg
} {event "-3" is too far in the past}
history k 5
test history-6.5 {keep option} {history event -1} foo2
test history-6.6 {keep option} {history event -2} {}
test history-6.7 {keep option} {history event -3} {}
test history-6.8 {keep option} {history event -4} {}
test history-6.9 {keep option} {catch {history event -5}} 1
test history-6.10 {keep option} {catch {history keep 4 6}} 1
test history-6.11 {keep option} {
catch {history keep 4 6} msg
set msg
} {wrong # args: should be "history keep ?count?"}
test history-6.12 {keep option} {catch {history keep}} 0
test history-6.13 {keep option} {
history keep
} {5}
test history-6.14 {keep option} {catch {history keep -3}} 1
test history-6.15 {keep option} {
catch {history keep -3} msg
set msg
} {illegal keep count "-3"}
test history-6.16 {keep option} {
catch {history keep butter} msg
set msg
} {illegal keep count "butter"}
# "history nextid"
set num [history n]
history add "Testing"
history add "Testing2"
test history-7.1 {nextid option} {history event} "Testing"
test history-7.2 {nextid option} {history next} [expr $num+2]
test history-7.3 {nextid option} {catch {history nextid garbage}} 1
test history-7.4 {nextid option} {
catch {history nextid garbage} msg
set msg
} {wrong # args: should be "history nextid"}
# "history clear"
set num [history n]
history add "Testing"
history add "Testing2"
test history-8.1 {clear option} {catch {history clear junk}} 1
test history-8.2 {clear option} {history clear} {}
history add "Testing"
test history-8.3 {clear option} {history} { 1 Testing}
# miscellaneous
test history-9.1 {miscellaneous} {catch {history gorp} msg} 1
test history-9.2 {miscellaneous} {
catch {history gorp} msg
set msg
} {bad option "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
