+#if HAVE_TCL_H
+static int cmd_tcl_begin (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ struct lexSpec *spec = clientData;
+ if (argc < 2)
+ return TCL_ERROR;
+ if (!strcmp(argv[1], "record") && argc == 3)
+ {
+ char *absynName = argv[2];
+ data1_absyn *absyn;
+
+#if REGX_DEBUG
+ logf (LOG_DEBUG, "begin record %s", absynName);
+#endif
+ if (!(absyn = data1_get_absyn (spec->dh, absynName)))
+ logf (LOG_WARN, "Unknown tagset: %s", absynName);
+ else
+ {
+ data1_node *res;
+
+ res = data1_mk_node (spec->dh, spec->m);
+ res->which = DATA1N_root;
+ res->u.root.type = absynName;
+ res->u.root.absyn = absyn;
+ res->root = res;
+
+ spec->d1_stack[spec->d1_level] = res;
+ spec->d1_stack[++(spec->d1_level)] = NULL;
+ }
+ }
+ else if (!strcmp(argv[1], "element") && argc == 3)
+ {
+ tagBegin (spec, argv[2], strlen(argv[2]));
+ }
+ else if (!strcmp (argv[1], "variant") && argc == 5)
+ {
+ variantBegin (spec, argv[2], strlen(argv[2]),
+ argv[3], strlen(argv[3]),
+ argv[4], strlen(argv[4]));
+ }
+ else if (!strcmp (argv[1], "context") && argc == 3)
+ {
+ struct lexContext *lc = spec->context;
+#if REGX_DEBUG
+ logf (LOG_DEBUG, "begin context %s",argv[2]);
+#endif
+ while (lc && strcmp (argv[2], lc->name))
+ lc = lc->next;
+ if (lc)
+ {
+ spec->context_stack[++(spec->context_stack_top)] = lc;
+ }
+ else
+ logf (LOG_WARN, "unknown context %s", argv[2]);
+ }
+ else
+ return TCL_ERROR;
+ return TCL_OK;
+}
+
+static int cmd_tcl_end (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ struct lexSpec *spec = clientData;
+ if (argc < 2)
+ return TCL_ERROR;
+
+ if (!strcmp (argv[1], "record"))
+ {
+ while (spec->d1_level)
+ {
+ tagDataRelease (spec);
+ (spec->d1_level)--;
+ }
+#if REGX_DEBUG
+ logf (LOG_DEBUG, "end record");
+#endif
+ spec->stop_flag = 1;
+ }
+ else if (!strcmp (argv[1], "element"))
+ {
+ int min_level = 1;
+ char *element = 0;
+ if (!strcmp(argv[2], "-record"))
+ {
+ min_level = 0;
+ if (argc == 4)
+ element = argv[3];
+ }
+ else
+ {
+ if (argc == 3)
+ element = argv[2];
+ }
+ tagEnd (spec, min_level, element, (element ? strlen(element) : 0));
+ if (spec->d1_level == 0)
+ {
+#if REGX_DEBUG
+ logf (LOG_DEBUG, "end element end records");
+#endif
+ spec->stop_flag = 1;
+ }
+ }
+ else if (!strcmp (argv[1], "context"))
+ {
+#if REGX_DEBUG
+ logf (LOG_DEBUG, "end context");
+#endif
+ if (spec->context_stack_top)
+ (spec->context_stack_top)--;
+ }
+ else
+ return TCL_ERROR;
+ return TCL_OK;
+}
+
+static int cmd_tcl_data (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ int argi = 1;
+ int textFlag = 0;
+ const char *element = 0;
+ struct lexSpec *spec = clientData;
+
+ while (argi < argc)
+ {
+ if (!strcmp("-text", argv[argi]))
+ {
+ textFlag = 1;
+ argi++;
+ }
+ else if (!strcmp("-element", argv[argi]))
+ {
+ argi++;
+ if (argi < argc)
+ element = argv[argi++];
+ }
+ else
+ break;
+ }
+ if (element)
+ tagBegin (spec, element, strlen(element));
+
+ while (argi < argc)
+ {
+ execData (spec, argv[argi], strlen(argv[argi]), textFlag);
+ argi++;
+ }
+ if (element)
+ tagEnd (spec, 1, NULL, 0);
+ return TCL_OK;
+}
+
+static int cmd_tcl_unread (ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv)
+{
+ struct lexSpec *spec = clientData;
+ int argi = 1;
+ int offset = 0;
+ int no;
+
+ while (argi < argc)
+ {
+ if (!strcmp("-offset", argv[argi]))
+ {
+ argi++;
+ if (argi < argc)
+ {
+ offset = atoi(argv[argi]);
+ argi++;
+ }
+ }
+ else
+ break;
+ }
+ if (argi != argc-1)
+ return TCL_ERROR;
+ no = atoi(argv[argi]);
+ if (no >= spec->arg_no)
+ no = spec->arg_no - 1;
+ spec->ptr = spec->arg_start[no] + offset;
+ return TCL_OK;
+}
+
+static void execTcl (struct lexSpec *spec, struct regxCode *code)
+{
+ int i;
+ for (i = 0; i < spec->arg_no; i++)
+ {
+ char var_name[10], *var_buf;
+ int var_len, ch;
+
+ sprintf (var_name, "%d", i);
+ var_buf = f_win_get (spec, spec->arg_start[i], spec->arg_end[i],
+ &var_len);
+ if (var_buf)
+ {
+ ch = var_buf[var_len];
+ var_buf[var_len] = '\0';
+ Tcl_SetVar (spec->tcl_interp, var_name, var_buf, 0);
+ var_buf[var_len] = ch;
+ }
+ }
+ Tcl_Eval (spec->tcl_interp, code->str);
+}
+/* HAVE_TCL_H */
+#endif
+
+static void execCode (struct lexSpec *spec, struct regxCode *code)
projects / idzebra-moved-to-github.git / commitdiff