summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdMZ.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdMZ.c')
-rw-r--r--generic/tclCmdMZ.c101
1 files changed, 100 insertions, 1 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index f5f6547..7cb14b5 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.175 2009/01/09 11:21:45 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.176 2009/01/13 20:30:03 dkf Exp $
*/
#include "tclInt.h"
@@ -3911,6 +3911,66 @@ Tcl_SwitchObjCmd(
/*
*----------------------------------------------------------------------
*
+ * Tcl_ThrowObjCmd --
+ *
+ * This procedure is invoked to process the "throw" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_ThrowObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *options;
+ int len;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type message");
+ return TCL_ERROR;
+ }
+
+ /*
+ * The type must be a list of at least length 1.
+ */
+
+ if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (len < 1) {
+ Tcl_AppendResult(interp, "type must be non-empty list", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now prepare the result options dictionary. We use the list API as it is
+ * slightly more convenient.
+ */
+
+ TclNewLiteralStringObj(options, "-code error -level 0 -errorcode");
+ Tcl_ListObjAppendElement(NULL, options, objv[1]);
+
+ /*
+ * We're ready to go. Fire things into the low-level result machinery.
+ */
+
+ Tcl_SetObjResult(interp, objv[2]);
+ return Tcl_SetReturnOptions(interp, options);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_TimeObjCmd --
*
* This object-based procedure is invoked to process the "time" Tcl
@@ -4000,6 +4060,45 @@ Tcl_TimeObjCmd(
return TCL_OK;
}
+#if 0 /* not yet implemented */
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TryObjCmd --
+ *
+ * This procedure is invoked to process the "try" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TryObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, TclNRTryObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRTryObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+
+}
+#endif /* not yet implemented */
+
/*
*----------------------------------------------------------------------
*