Changeset 9d2a70c in tol

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

Location:

toltcl/generic

Files:

• tolaccess.cpp (modified) (2 diffs)
• toltcl.c (modified) (3 diffs)
• toltclInt.h (modified) (1 diff)

toltcl/generic/tolaccess.cpp

@@ -42 +42 @@
 #include <tol/tol_btxtgra.h>
 #include <tol/tol_bmethodhook.h>
+#include <tol/tol_bparser.h>
 
 #include <toltclInt.h>
@@ -1879 +1880 @@
 }
 
+int Tol_CheckSyntax(Tcl_Interp * interp,
+                    Tcl_Obj    * obj_expr,
+                    Tcl_Obj    * obj_result)
+{
+  Tcl_DString dstr;
+  BText tol_expr;
+
+  Tcl_DStringInit(&dstr);
+  tol_expr = Tcl_UtfToExternalDString( NULL, Tcl_GetString( obj_expr ),
+                                       -1, &dstr );
+  Tcl_DStringFree(&dstr);
+  
+  BBool stat = BOut::ErrorHci();
+  BOut::PutErrorHci(BFALSE);
+  BParser* parser = new BParser;
+  Tree* tree = parser->Parsing( tol_expr );
+  Tcl_SetStringObj( obj_result, parser->MessageError(), -1 );
+  delete parser;
+  BOut::PutErrorHci( stat );
+  DESTROY(tree);
+  return TCL_OK;
+}
+
 /*
  * Fill in obj_result the result of evaluating including the file

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;
 }
 

toltcl/generic/toltclInt.h

@@ -61 +61 @@
                                         Tcl_Obj * obj_result));
 
+
+/*! Check the syntax of a given expresion.
+ */
+extern int Tol_CheckSyntax _ANSI_ARGS_((Tcl_Interp * interp,
+                                        Tcl_Obj * obj_expr,
+                                        Tcl_Obj * obj_result));
+
 /*! Fill in obj_result the result of evaluating including the file
  *  given as argument: the absolute path.