Changeset 9d2a70c in tol for toltcl/generic/toltcl.c

Timestamp:

Feb 13, 2012, 5:03:25 PM (15 years ago)

Author:

Jorge Pérez <josp.jorge@…>

Branches:

1941-docker-image-to-test, devel, master

Children:

ab6d232

Parents:

96de79c

Message:

refs #994, #1404: implementing the command tol::checksyntax

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@4124 be4846ae-f051-483a-831f-b64e7d08527f

File:

• toltcl/generic/toltcl.c (modified) (3 diffs)

toltcl/generic/toltcl.c

@@ -40 +40 @@
 
 static int Tol_InitLibraryCmd _ANSI_ARGS_((ClientData clientData,
+                                           Tcl_Interp *interp,
+                                           int objc, Tcl_Obj *CONST objv[]));
+
+static int Tol_CheckSyntaxCmd _ANSI_ARGS_((ClientData clientData,
                                            Tcl_Interp *interp,
                                            int objc, Tcl_Obj *CONST objv[]));
@@ -257 +261 @@
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
 
+  Tcl_CreateObjCommand( interp, "::tol::checksyntax", Tol_CheckSyntaxCmd,
+                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
+
   Tcl_CreateObjCommand( interp, "::tol::include", Tol_IncludeCmd,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
@@ -351 +358 @@
   }
   return status;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tol_CheckSyntaxCmd --
+ *
+ *      Implements the new Tcl "::tol::checksyntax" command.
+ *
+ * Results:
+ *
+ *      Returns the syntax error found in the tol expression given as
+ *      argument. If no error is found then the empty string is
+ *      returned.
+ *
+ * Side effects:
+ *      None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Tol_CheckSyntaxCmd(clientData, interp, objc, objv)
+     ClientData clientData;  /* Not used. */
+     Tcl_Interp *interp;             /* Current interpreter */
+     int objc;                                 /* Number of arguments */
+     Tcl_Obj *CONST objv[];  /* Argument objects */
+{
+  Tcl_Obj * obj_result= Tcl_NewObj();
+  int tcl_result;
+  
+  if (objc != 2) {
+    Tcl_SetStringObj(obj_result,
+                     "wrong # args: should be \"::tol::checksyntax tolcode\"",
+                     -1);
+    tcl_result = TCL_ERROR;
+  } else
+    tcl_result = Tol_CheckSyntax( interp, objv[1], obj_result );
+  Tcl_SetObjResult( interp, obj_result );
+  return tcl_result;
 }