source: tol/toltcl/generic/toltcl.c @ fe54d8d

1941-docker-image-to-testdevel
Last change on this file since fe54d8d was fe54d8d, checked in by Jorge Pérez <josp.jorge@…>, 16 years ago

refs #740, implement 

tol::info anything $objRef

it is invoked when and Anything object is inserted in the inspector.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@3370 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 48.8 KB
RevLine 
[6d7779d]1/* toltcl.cpp: This file implements a Tcl interface to Tol.
2               GNU/tolTcl Library
3
4   Copyright (C) 2001, 2002, 2003 - Bayes Decisión, SL
5
6   This program is free software; you can redistribute it and/or modify
7   it under the terms of the GNU General Public License as published by
8   the Free Software Foundation; either version 2, or (at your option)
9   any later version.
10
11   This program is distributed in the hope that it will be useful,
12   but WITHOUT ANY WARRANTY; without even the implied warranty of
13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14   GNU General Public License for more details.
15
16   You should have received a copy of the GNU General Public License
17   along with this program; if not, write to the Free Software
18   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
19   USA.
20 */
21
22#if defined(_MSC_VER)
23#  include <win_tolinc.h>
24#endif
25
26#include <string.h>
27#include <gsl/gsl_errno.h>
28
29#include <toltclInt.h>
30#include <toltcl.h>
31#include <tt_crash.h>
32
33#include <tol/tol_init.h>
34
35Tcl_Interp * TT_interp;
36
37static int Tol_InitKernelCmd _ANSI_ARGS_((ClientData clientData,
38                                          Tcl_Interp *interp,
39                                          int objc, Tcl_Obj *CONST objv[]));
40
41static int Tol_InitLibraryCmd _ANSI_ARGS_((ClientData clientData,
42                                           Tcl_Interp *interp,
43                                           int objc, Tcl_Obj *CONST objv[]));
44
45static int Tol_IncludeCmd _ANSI_ARGS_((ClientData clientData,
46                                       Tcl_Interp *interp,
47                                       int objc, Tcl_Obj *CONST objv[]));
48
49static int Tol_DecompileCmd _ANSI_ARGS_((ClientData clientData,
50                                         Tcl_Interp *interp,
51                                         int objc, Tcl_Obj *CONST objv[]));
52
53static int Tol_ConsoleCmd _ANSI_ARGS_((ClientData clientData,
54                                       Tcl_Interp *interp,
55                                       int objc, Tcl_Obj *CONST objv[]));
56
57static int Tol_ForAllChildCmd _ANSI_ARGS_((ClientData clientData,
58                                           Tcl_Interp *interp,
59                                           int objc, Tcl_Obj *CONST objv[]));
60
[87e95d3]61static int Tol_ForEachCmd _ANSI_ARGS_((ClientData clientData,
62                                       Tcl_Interp *interp,
63                                       int objc, Tcl_Obj *CONST objv[]));
64
[6d7779d]65static int Tol_TableSetCmd _ANSI_ARGS_((ClientData clientData,
66                                      Tcl_Interp *interp,
67                                      int objc, Tcl_Obj *CONST objv[]));
68
69static int Tol_TableMatCmd _ANSI_ARGS_((ClientData clientData,
70                                      Tcl_Interp *interp,
71                                      int objc, Tcl_Obj *CONST objv[]));
72
73static int Tol_TableCmd _ANSI_ARGS_((int ismat, ClientData clientData,
74                                     Tcl_Interp *interp,
75                                     int objc, Tcl_Obj *CONST objv[]));
76
77static int Tol_GetSerieCmd _ANSI_ARGS_((ClientData clientData,
78                                        Tcl_Interp *interp,
79                                        int objc, Tcl_Obj *CONST objv[]));
80
81static int Tol_SerieGrpCmd _ANSI_ARGS_((ClientData clientData,
82                                        Tcl_Interp *interp,
83                                        int objc, Tcl_Obj *CONST objv[]));
84
85static int Tol_LanguageCmd _ANSI_ARGS_((ClientData clientData,
86                                        Tcl_Interp *interp,
87                                        int objc, Tcl_Obj *CONST objv[]));
88
89static int Tol_InfoCmd _ANSI_ARGS_((ClientData clientData,
90                                    Tcl_Interp *interp,
91                                    int objc, Tcl_Obj *CONST objv[]));
92
93static int Tol_InfoStruct _ANSI_ARGS_((Tcl_Interp *interp,
94                                       int objc, Tcl_Obj *CONST objv[],
95                                       Tcl_Obj * obj_result));
96
97static int Tol_InfoPath _ANSI_ARGS_((Tcl_Interp *interp,
98                                     int objc, Tcl_Obj *CONST objv[],
99                                     Tcl_Obj * obj_result));
100
101static int Tol_InfoGrammars _ANSI_ARGS_((Tcl_Interp *interp,
102                                         int objc, Tcl_Obj *CONST objv[],
103                                         Tcl_Obj * obj_result));
104
[d3d6a42]105static int Tol_InfoPackages _ANSI_ARGS_((Tcl_Interp *interp,
106                                         int objc, Tcl_Obj *CONST objv[],
107                                         Tcl_Obj * obj_result));
108
[6d7779d]109static int Tol_InfoFunctions _ANSI_ARGS_((Tcl_Interp *interp,
110                                          int objc, Tcl_Obj *CONST objv[],
111                                          Tcl_Obj * obj_result));
112
113static int Tol_InfoVariables _ANSI_ARGS_((Tcl_Interp *interp,
114                                          int objc,Tcl_Obj *CONST objv[],
115                                          Tcl_Obj * obj_result));
116
117static int Tol_GetMatrixCmd _ANSI_ARGS_((ClientData clientData,
118                                         Tcl_Interp *interp,
119                                         int objc, Tcl_Obj *CONST objv[]));
120
121static int Tol_TimeSetCmd _ANSI_ARGS_((ClientData clientData,
122                                       Tcl_Interp *interp,
123                                       int objc, Tcl_Obj *CONST objv[]));
124
125static int Tol_DateCmd _ANSI_ARGS_((ClientData clientData,
126                                    Tcl_Interp *interp,
127                                    int objc, Tcl_Obj *CONST objv[]));
128
129static int Tol_AutoCorrCmd _ANSI_ARGS_((ClientData clientData,
130                                        Tcl_Interp *interp,
131                                        int objc, Tcl_Obj *CONST objv[]));
132
133static int Tol_SerieStatCmd _ANSI_ARGS_((ClientData clientData,
134                                         Tcl_Interp *interp,
135                                         int objc, Tcl_Obj *CONST objv[]));
136
137static int Tol_StopEvalCmd  _ANSI_ARGS_((ClientData clientData,
138                                         Tcl_Interp *interp,
139                                         int objc, Tcl_Obj *CONST objv[]));
140
141static int Tol_LCFormatCmd  _ANSI_ARGS_((ClientData clientData,
142                                         Tcl_Interp *interp,
143                                         int objc, Tcl_Obj *CONST objv[]));
144
145DLLIMPORT gsl_error_handler_t * Tol_gsl_set_error_handler (gsl_error_handler_t * new_handler);
146DLLIMPORT const char * Tol_gsl_strerror (const int gsl_errno);
147
148/*
149 * TT_gsl_error_handler --
150 *
151 *    Tcl hook to a GSL error. This should be used only to detect where the gsl
152 *    errors are reported.
153 */
154
155static void TT_gsl_error_handler(const char * reason, const char * file, int line,
156                                 int gsl_errno)
157{
158  Tcl_CmdInfo cmd_info;
159  int status;
160
161  if (TT_interp && Tcl_GetCommandInfo(TT_interp,"::tol::gsl_error_handler",&cmd_info) ) {
162    Tcl_DString dstr;
163    Tcl_Obj * objv[5];
164   
165    Tcl_DStringInit(&dstr);
166    objv[0] = Tcl_NewStringObj("::tol::gsl_error_handler",-1);
167    Tcl_ExternalToUtfDString(NULL, reason, -1, &dstr);
168    objv[1] = Tcl_NewStringObj(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
169    Tcl_DStringFree(&dstr);
170    Tcl_ExternalToUtfDString(NULL, file, -1, &dstr);
171    objv[2] = Tcl_NewStringObj(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
172    Tcl_DStringFree(&dstr);
173    objv[3] = Tcl_NewIntObj(line);
174    Tcl_ExternalToUtfDString(NULL, Tol_gsl_strerror(gsl_errno), -1, &dstr);
175    objv[4] = Tcl_NewStringObj(Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
176    Tcl_DStringFree(&dstr);
177    status = Tcl_EvalObjv(TT_interp, 5, objv, TCL_EVAL_GLOBAL);
178    if (status != TCL_OK) {
179      printf("%s in file %s at line %d\n. str_ernno : %s",
180             reason, file, line, Tol_gsl_strerror(gsl_errno));
181      printf("interp : %s\n", TT_interp->result);
182    }
183  } 
184}
185
186
187/*
188 *----------------------------------------------------------------------
189 *
190 * Tol_InitKernelCmd --
191 *
192 *        Implements the new Tcl "::tol::initkernel ?lang ?vmode??" command.
193 *       
194 * Results:
195 *       A standard Tcl result
196 *
197 * Side effects:
198 *       None.
199 *
200 *----------------------------------------------------------------------
201 */
202
203static int
204Tol_InitKernelCmd(clientData, interp, objc, objv)
205     ClientData clientData;  /* Not used. */
206     Tcl_Interp *interp;     /* Current interpreter */
207     int objc;               /* Number of arguments */
208     Tcl_Obj *CONST objv[];  /* Argument objects */
209{
210  int lang;
211  char* vmode;
212  if (objc > 3) {
213    Tcl_AppendResult(interp, "wrong # args: should be \"",
214                     Tcl_GetString(objv[0]),"?lang ?vmode??\"", NULL);
215    return TCL_ERROR;
216  }
217  lang = (objc == 1 || !strcasecmp("es", Tcl_GetString(objv[1])));
218  vmode = objc == 3 ? Tcl_GetString(objv[2]) :  NULL;
219  /*
220   * Initialize kernel
221   */
222
223  InitTolKernel(lang, vmode&&vmode[0]?vmode:NULL);
224
225  /*
226   * this should only be called to find out where the GSL errors are generated
227   */
228
229  Tol_gsl_set_error_handler(&TT_gsl_error_handler);
230
231  /*
232   * Install tol::* commands
233   */
234
235  Tcl_CreateObjCommand( interp, "::tol::initlibrary", Tol_InitLibraryCmd,
236                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
237
238  Tcl_CreateObjCommand( interp, "::tol::include", Tol_IncludeCmd,
239                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
240
241  Tcl_CreateObjCommand( interp, "::tol::decompile", Tol_DecompileCmd,
242                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
243
244  Tcl_CreateObjCommand( interp, "::tol::info", Tol_InfoCmd,
245                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
246
247  Tcl_CreateObjCommand( interp, "::tol::language", Tol_LanguageCmd,
248                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
249
250  Tcl_CreateObjCommand( interp, "::tol::console", Tol_ConsoleCmd,
251                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
252
253  Tcl_CreateObjCommand( interp, "::tol::forallchild", Tol_ForAllChildCmd,
254                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
255
[87e95d3]256  Tcl_CreateObjCommand( interp, "::tol::foreach", Tol_ForEachCmd,
257                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
258
[6d7779d]259  Tcl_CreateObjCommand( interp, "::tol::tableset", Tol_TableSetCmd,
260                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
261
262  Tcl_CreateObjCommand( interp, "::tol::tablematrix", Tol_TableMatCmd,
263                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
264
265  Tcl_CreateObjCommand( interp, "::tol::getserie", Tol_GetSerieCmd,
266                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
267
268  Tcl_CreateObjCommand( interp, "::tol::seriegrp", Tol_SerieGrpCmd,
269                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
270
271  Tcl_CreateObjCommand( interp, "::tol::matrix", Tol_GetMatrixCmd,
272                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
273
274  Tcl_CreateObjCommand( interp, "::tol::timeset", Tol_TimeSetCmd,
275                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
276
277  Tcl_CreateObjCommand( interp, "::tol::date", Tol_DateCmd,
278                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
279
280  Tcl_CreateObjCommand( interp, "::tol::autocor", Tol_AutoCorrCmd,
281                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
282
283  Tcl_CreateObjCommand( interp, "::tol::seriestat", Tol_SerieStatCmd,
284                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
285 
286  Tcl_CreateObjCommand( interp, "::tol::stop", Tol_StopEvalCmd,
287                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
288
289  Tcl_CreateObjCommand( interp, "::tol::lc_format", Tol_LCFormatCmd,
290                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
291  return TCL_OK;
292}
293
294
295/*
296 *----------------------------------------------------------------------
297 *
298 * Tol_InitLibraryCmd --
299 *
300 *        Implements the new Tcl "::tol::initlibrary" command.
301 *
302 * Results:
303 *       A standard Tcl result
304 *
305 * Side effects:
306 *       None.
307 *
308 *----------------------------------------------------------------------
309 */
310
311static int
312Tol_InitLibraryCmd(clientData, interp, objc, objv)
313     ClientData clientData;  /* Not used. */
314     Tcl_Interp *interp;     /* Current interpreter */
315     int objc;               /* Number of arguments */
316     Tcl_Obj *CONST objv[];  /* Argument objects */
317{
318  if ( objc != 1 ) {
319    Tcl_AppendResult(interp, "wrong # args: should be \"",
320                     Tcl_GetString(objv[0]),"\"", NULL);
321    return TCL_ERROR;
322  }
323  LoadInitLibrary(Tcl_GetNameOfExecutable());
324  return TCL_OK;
325}
326
327
328/*
329 *----------------------------------------------------------------------
330 *
331 * Tol_IncludeCmd --
332 *
333 *       Implements the new Tcl "::tol::include" command.
334 *
335 * Results:
336 *      A standard Tcl result
337 *
338 * Side effects:
339 *      None.
340 *
341 *----------------------------------------------------------------------
342 */
343
344static int
345Tol_IncludeCmd(clientData, interp, objc, objv)
346     ClientData clientData;  /* Not used. */
347     Tcl_Interp *interp;             /* Current interpreter */
348     int objc;                                 /* Number of arguments */
349     Tcl_Obj *CONST objv[];  /* Argument objects */
350{
351  Tcl_Obj * obj_result= Tcl_NewObj();
352  int tcl_result;
353 
354  if (objc != 2) {
355    Tcl_SetStringObj(obj_result,
356                     "wrong # args: should be \"::tol::include tolfile\"",
357                     -1);
358    tcl_result = TCL_ERROR;
359  } else
360    tcl_result = Tol_IncludeFile(interp,objv[1],obj_result);
361  Tcl_SetObjResult(interp,obj_result);
362  return tcl_result;
363}
364
365
366/*
367 *----------------------------------------------------------------------
368 *
369 * Tol_DecompileCmd --
370 *
371 *       Implements the new Tcl "::tol::decompile" command.
372 *
373 * Results:
374 *      A standard Tcl result
375 *
376 * Side effects:
377 *      None.
378 *
379 *----------------------------------------------------------------------
380 */
381
382static int
383Tol_DecompileCmd(clientData, interp, objc, objv)
384     ClientData clientData;  /* Not used. */
385     Tcl_Interp *interp;             /* Current interpreter */
386     int objc;                                 /* Number of arguments */
387     Tcl_Obj *CONST objv[];  /* Argument objects */
388{
389  Tcl_Obj * obj_result= Tcl_NewObj();
390  int tcl_result;
391 
392  if (objc != 2) {
393    Tcl_AppendStringsToObj(obj_result,
394                           "wrong # args: should be \'",
395                           Tcl_GetString(objv[0]), " tolfile\'", NULL);
396    tcl_result = TCL_ERROR;
397  } else
398    tcl_result = Tol_DecompileFile(interp,objv[1],obj_result);
399  Tcl_SetObjResult(interp,obj_result);
400  return tcl_result;
401}
402
403
404/*
405 *----------------------------------------------------------------------
406 *
407 * Tol_ConsoleCmd --
408 *
409 *  Implements the new Tcl "::tol::console" command.
410 *
411 *    ::tol::console eval tol_expr
412 *
413 *        evaluate a tol_expr, if the result has name then it will be
414 *        stored in the console's stack.
415 *
416 *    ::tol::console stack list [obj_name]
417 *
418 *        return the content of obj_name. If no object is given then
419 *        list the set object contained in the stack.
420 *
421 *    ::tol::console stack release [obj_name]
422 *
423 *        release the specified object contained in the console's
424 *        stack. If no object is given then the whole stack is
425 *        released.
426 *
427 * Results:
428 *      A standard Tcl result
429 *
430 * Side effects:
431 *      None.
432 *
433 *----------------------------------------------------------------------
434 */
435
436static int
437Tol_ConsoleCmd(clientData, interp, objc, objv)
438     ClientData clientData;  /* Not used. */
439     Tcl_Interp *interp;             /* Current interpreter */
440     int objc;                                 /* Number of arguments */
441     Tcl_Obj *CONST objv[];  /* Argument objects */
442{
443  Tcl_Obj * obj_result= Tcl_NewObj();
444  int tcl_result;
445 
446  if (objc < 3) {
447    Tcl_AppendStringsToObj(obj_result,
448                           "wrong # args: should be '",
449                           Tcl_GetString(objv[0]), " option arg ?arg?'",NULL);
450    tcl_result = TCL_ERROR;
451  } else {
452    Tcl_DString dstr;
453    Tcl_DStringInit(&dstr);
454    Tcl_UtfToExternalDString(NULL,Tcl_GetString(objv[1]),-1,&dstr);
455    if (!strncmp(dstr.string,"eval",dstr.length)) {
456      if (objc != 3 && objc != 4) {
457        Tcl_AppendStringsToObj(obj_result,
458                               "wrong # args: should be '",
459                               Tcl_GetString(objv[0]),
460                               " eval ?-hidden? tol_expr'",NULL);
461        tcl_result = TCL_ERROR;
462      } else {
463        Tcl_Obj *obj_expr = NULL;
464        int hidden = 0;
465
466        if (objc==4) {
467          if (strcmp(Tcl_GetString(objv[2]),"-hidden")) {
468            Tcl_AppendStringsToObj(obj_result,
469                                   "invalid option ",
470                                   Tcl_GetString(objv[2]),
471                                   ": should be -hidden",
472                                   NULL);
473            tcl_result = TCL_ERROR;
474          } else {
475            hidden = 1;
476            obj_expr = objv[3];
477          }
478        } else {
479          obj_expr = objv[2];
480        }
481        if (obj_expr) {
482          tcl_result = Tol_EvalExpr(obj_expr, hidden, obj_result);
483        }
484      }
485      Tcl_DStringFree(&dstr);
486    } else if (!strncmp(dstr.string,"stack",dstr.length)) {
487      Tcl_DStringFree(&dstr);
488      Tcl_UtfToExternalDString(NULL,Tcl_GetString(objv[2]),-1,&dstr);
489      if (!strncmp(dstr.string,"list",dstr.length))
490        tcl_result = Tol_ListStack(interp,objc-3,objv+3,obj_result);
491      else if (!strncmp(dstr.string,"release",dstr.length))
492        tcl_result = Tol_ReleaseStack(interp,objc-3,objv+3,obj_result);
493      else {
494        Tcl_AppendStringsToObj(obj_result,
495                               "invalid option '",
496                               Tcl_GetString(objv[2]),
497                               "', should be: list or release",NULL);
498        tcl_result = TCL_ERROR;
499      }
500      Tcl_DStringFree(&dstr);
501    } else {
502      Tcl_AppendStringsToObj(obj_result,
503                             "invalid option '",
504                             Tcl_GetString(objv[1]),
505                             "', should be: eval or stack",NULL);
506      tcl_result = TCL_ERROR;
507      Tcl_DStringFree(&dstr);
508    }
509  }
510  Tcl_SetObjResult(interp,obj_result);
511  return tcl_result;
512}
513
514
515/*
516 *----------------------------------------------------------------------
517 *
518 * Tol_ForAllChildCmd --
519 *
520 *        Implements the new Tcl "::tol::forallchild" command.
521 *
522 *  ::tol::forallchild setName ?indexes? script
523 *
524 * Results:
525 *       A standard Tcl result
526 *
527 * Side effects:
528 *       None.
529 *
530 *----------------------------------------------------------------------
531 */
532
533static int
534Tol_ForAllChildCmd(clientData, interp, objc, objv)
535     ClientData clientData;  /* Not used. */
536     Tcl_Interp *interp;             /* Current interpreter */
537     int objc;                                 /* Number of arguments */
538     Tcl_Obj *CONST objv[];  /* Argument objects */
539{
540  Tcl_Obj * obj_result= Tcl_NewObj();
541  int tcl_result;
542 
543  if (objc != 3) {
544    Tcl_AppendStringsToObj(obj_result, "wrong # args: should be '",
545                           Tcl_GetString(objv[0]), " setref script'", NULL);
546    tcl_result = TCL_ERROR;
547  } else
548    tcl_result = Tol_IterChildren(interp,objc-1,objv+1,obj_result);
[87e95d3]549  Tcl_SetObjResult( interp, obj_result );
550  return tcl_result;
551}
552
553
554/*
555 *----------------------------------------------------------------------
556 *
557 * Tol_ForEachCmd --
558 *
559 *        Implements the new Tcl "::tol::foreach" command.
560 *
561 *  ::tol::foreach varname <Set or NameBlock reference> script
562 *
563 * Results:
564 *       A standard Tcl result
565 *
566 * Side effects:
567 *       None.
568 *
569 *----------------------------------------------------------------------
570 */
571
572static int
573Tol_ForEachCmd(clientData, interp, objc, objv)
574     ClientData clientData;  /* Not used. */
575     Tcl_Interp *interp;             /* Current interpreter */
576     int objc;                                 /* Number of arguments */
577     Tcl_Obj *CONST objv[];  /* Argument objects */
578{
579  Tcl_Obj * obj_result= Tcl_NewObj();
580  int tcl_result;
581 
582  if (objc != 4) {
583    Tcl_AppendStringsToObj(obj_result, "wrong # args: should be '",
584                           Tcl_GetString(objv[0]),
585                           " varName setref script'", NULL);
586    tcl_result = TCL_ERROR;
587  } else
588    tcl_result = Tol_ForEach( interp, objc - 1, objv + 1, obj_result );
589  Tcl_SetObjResult( interp, obj_result );
[6d7779d]590  return tcl_result;
591}
592
593
594/*
595 *----------------------------------------------------------------------
596 *
597 * Tol_GetSerie --
598 *
599 *        Implements the new Tcl "::tol::getserie" command.
600 *
601 * Results:
602 *       A standard Tcl result
603 *
604 * Side effects:
605 *       None.
606 *
607 *----------------------------------------------------------------------
608 */
609
610static int
611Tol_GetSerieCmd(clientData, interp, objc, objv)
612     ClientData clientData;  /* Not used. */
613     Tcl_Interp *interp;             /* Current interpreter */
614     int objc;                                 /* Number of arguments */
615     Tcl_Obj *CONST objv[];  /* Argument objects */
616{
617  Tcl_Obj * obj_result= Tcl_NewObj();
618  int tcl_result;
619 
620  if (objc < 2 || objc > 4) {
621    Tcl_AppendStringsToObj(obj_result,
622                           "wrong # args: should be '",
623                           Tcl_GetString(objv[0]),
624                           " sername ?begin end?'", NULL );
625    tcl_result = TCL_ERROR;
626  } else
627    tcl_result = Tol_GetSerieContent(interp,objc-1,objv+1,obj_result);
628  Tcl_SetObjResult(interp,obj_result);
629  return tcl_result;
630}
631
632/*
633 *----------------------------------------------------------------------
634 *
635 * Tol_TableCmd --
636 *
637 *     Implements the new Tcl "::tol::tableset" command.
638 *     Is an internal interface to the commands tol::tableset
639 *     & tol::tablematrix.
640 *
641 * Results:
642 *       A standard Tcl result
643 *
644 * Side effects:
645 *       None.
646 *
647 *----------------------------------------------------------------------
648 */
649
650static int
651Tol_TableCmd(ismat, clientData, interp, objc, objv)
652  int ismat;
653  ClientData clientData;  /* Not used. */
654  Tcl_Interp *interp;     /* Current interpreter */
655  int objc;               /* Number of arguments */
656  Tcl_Obj *CONST objv[];  /* Argument objects */
657{
658  Tcl_Obj * obj_result= Tcl_NewObj();
659  int tcl_result;
660 
661  if ( objc < 3 ) {
662    Tcl_AppendStringsToObj(obj_result,
663                           "wrong # args: should be '",
664                           Tcl_GetString(objv[0]),
665                           " option arg ?arg?'", NULL );
666    tcl_result = TCL_ERROR;
667  } else {
668    char * option = Tcl_GetString(objv[1]);
669    int length = strlen(option);
670    if (!strncmp("create",option,length)) {
671      if ( objc < 4 ) {
672        Tcl_AppendStringsToObj(obj_result,
673                               "wrong # args: should be '",
674                               Tcl_GetString(objv[0]),
675                               " create tblName (set|matrix)'", NULL );
676        tcl_result = TCL_ERROR;
677      } else {     
678        tcl_result = Tol_CreateTable(interp,objv[2],objv[3], ismat, obj_result);
679        if (tcl_result == TCL_ERROR)
680          Tcl_AppendStringsToObj(obj_result,
681                                 ": could not create '",
682                                 Tcl_GetString(objv[2]),"'",NULL);
683      }
684    } else if (!strncmp("destroy",option,length))
685      if ( objc < 3) {
686        Tcl_AppendStringsToObj(obj_result,
687                               "wrong # args: should be '",
688                               Tcl_GetString(objv[0]),
689                               " destroy tblName ?args?'", NULL );
690        tcl_result = TCL_ERROR;
691      } else {
692        tcl_result = Tol_DestroyTable( interp, objc-2, objv+2, obj_result);
693      }
694    else {
695      Tcl_AppendStringsToObj(obj_result,
696                             "bad option '",
697                             option, "': must be create or destroy", NULL);
698      tcl_result = TCL_ERROR;
699    }
700  }
701
702  Tcl_SetObjResult(interp,obj_result);
703  return tcl_result;
704}
705
706/*
707 *----------------------------------------------------------------------
708 *
709 * Tol_TableSetCmd --
710 *
711 *     Implements the new Tcl "::tol::tableset" command.
712 * 
713 *     ::tol::tableset option arg ?arg?
714 *
715 *     ::tol::tableset ?create? tblName setReference
716 *
717 *     ::tol::tableset destroy tblName ?grpname ...?
718 *
719 * Results:
720 *       A standard Tcl result
721 *
722 * Side effects:
723 *       None.
724 *
725 *----------------------------------------------------------------------
726 */
727
728static int
729Tol_TableSetCmd(clientData, interp, objc, objv)
730  ClientData clientData;  /* Not used. */
731  Tcl_Interp *interp;     /* Current interpreter */
732  int objc;               /* Number of arguments */
733  Tcl_Obj *CONST objv[];  /* Argument objects */
734{
735  return Tol_TableCmd(0, clientData, interp, objc, objv);
736}
737
738/*
739 *----------------------------------------------------------------------
740 *
741 * Tol_TableMatCmd --
742 *
743 *     Implements the new Tcl "::tol::tablematrix" command.
744 * 
745 *     ::tol::tablematrix option arg ?arg?
746 *
747 *     ::tol::tablematrix ?create? tblName setReference
748 *
749 *     ::tol::tablematrix destroy tblName ?grpname ...?
750 *
751 * Results:
752 *       A standard Tcl result
753 *
754 * Side effects:
755 *       None.
756 *
757 *----------------------------------------------------------------------
758 */
759
760static int
761Tol_TableMatCmd(clientData, interp, objc, objv)
762  ClientData clientData;  /* Not used. */
763  Tcl_Interp *interp;     /* Current interpreter */
764  int objc;               /* Number of arguments */
765  Tcl_Obj *CONST objv[];  /* Argument objects */
766{
767  return Tol_TableCmd(1, clientData, interp, objc, objv);
768}
769
770/*
771 *----------------------------------------------------------------------
772 *
773 * Tol_SerieGrpCmd --
774 *
775 *     Implements the new Tcl "::tol::seriegrp" command.
776 * 
777 *     ::tol:seriegrp option arg ?arg?
778 *
779 *     ::tol::seriegrp ?create? grpName ?range? serName ?serName?
780 *
781 *     ::tol::seriegrp destroy grpName ?grpName?
782 *
783 * Results:
784 *       A standard Tcl result
785 *
786 * Side effects:
787 *       None.
788 *
789 *----------------------------------------------------------------------
790 */
791
792static int
793Tol_SerieGrpCmd(clientData, interp, objc, objv)
794     ClientData clientData;  /* Not used. */
795     Tcl_Interp *interp;             /* Current interpreter */
796     int objc;                       /* Number of arguments */
797     Tcl_Obj *CONST objv[];  /* Argument objects */
798{
799  Tcl_Obj * obj_result= Tcl_NewObj();
800  int tcl_result;
801 
802  if ( objc < 3 ) {
803    Tcl_AppendStringsToObj(obj_result,
804                           "wrong # args: should be '",
805                           Tcl_GetString(objv[0]), " option arg ?arg?'", NULL );
806    tcl_result = TCL_ERROR;
807  } else {
808    char * option = Tcl_GetString(objv[1]);
809    int length = strlen(option);
810    if (!strncmp("create",option,length)) {
811      if ( objc == 3 ) {
812        Tcl_AppendStringsToObj(obj_result,
813                               "wrong # args: should be '",
814                               Tcl_GetString(objv[0]),
815                               " create grpName ?-range range? serName ?serName?'", NULL );
816        tcl_result = TCL_ERROR;
817      } else {
818        tcl_result = Tol_CreateSerieGrp(interp,objc-2,objv+2,obj_result);
819        if (tcl_result == TCL_ERROR)
820          Tcl_AppendStringsToObj(obj_result,
821                                 ": could not create '",
822                                 Tcl_GetString(objv[2]),"'",NULL);
823      }
824    } else if (!strncmp("destroy",option,length))
825      tcl_result = Tol_DestroySerieGrp(interp,objc-2,objv+2,obj_result);
826    else {
827      Tcl_AppendStringsToObj(obj_result,
828                             "bad option '",
829                             option, "': must be create or destroy", NULL);
830      tcl_result = TCL_ERROR;
831    }
832  }
833
834  Tcl_SetObjResult(interp,obj_result);
835  return tcl_result;
836}
837
838
839/*
840 *----------------------------------------------------------------------
841 *
842 * Tol_LanguageCmd --
843 *
844 *        Implements the new Tcl "::tol::language" command.
845 *
846 *          ::tol::language ?lang?
847 *
848 * Results:
849 *
850 *       Set or return the language, as required by TOL only english
851 *       or spanish.
852 *
853 *       A standard Tcl result
854 *
855 * Side effects:
856 *       None.
857 *
858 *----------------------------------------------------------------------
859 */
860
861static int
862Tol_LanguageCmd(clientData, interp, objc, objv)
863     ClientData clientData;  /* Not used. */
864     Tcl_Interp *interp;     /* Current interpreter */
865     int objc;               /* Number of arguments */
866     Tcl_Obj *CONST objv[];  /* Argument objects */
867{
868  Tcl_Obj * obj_result = Tcl_NewObj();
869  int tcl_result;
870
871  if ( objc > 2 ) {
872    Tcl_AppendStringsToObj(obj_result,"wrong # args: should be '",
873                           Tcl_GetString(objv[0]),
874                           " ?lang?'", NULL);
875    tcl_result = TCL_ERROR;
876  } else {
877    if ( objc == 2 )
878      tcl_result = Tol_SetLanguage( interp, objv[1], obj_result );
879    else
880      tcl_result = Tol_GetLanguage( interp, obj_result );
881  }
882  Tcl_SetObjResult(interp,obj_result);
883  return tcl_result;
884}
885
886
887/*
888 *----------------------------------------------------------------------
889 *
890 * Tol_InfoCmd --
891 *
892 *        Implements the new Tcl "::tol::info" command.
893 *
894 * Results:
895 *       A standard Tcl result
896 *
897 * Side effects:
898 *       None.
899 *
900 *----------------------------------------------------------------------
901 */
902
903static int
904Tol_InfoCmd(clientData, interp, objc, objv)
905     ClientData clientData;  /* Not used. */
906     Tcl_Interp *interp;             /* Current interpreter */
907     int objc;                                 /* Number of arguments */
908     Tcl_Obj *CONST objv[];  /* Argument objects */
909{
910  Tcl_Obj * obj_result = Tcl_NewObj();
911  int tcl_result;
912  char * arg;
913  int length;
914 
915  if ( objc == 1) {
916    Tcl_AppendStringsToObj( obj_result, "wrong # args: should be '",
917                      Tcl_GetString(objv[0]),
[c14b554]918                      " ?arg arg ...?'", NULL );
[6d7779d]919    tcl_result = TCL_ERROR;
920  } else {
921    arg = Tcl_GetString(objv[1]);
922    length = strlen(arg);
923    if ( !strncasecmp("version", arg, length)) {
924      if ( objc == 2 )
925        tcl_result = Tol_InfoVersion(interp, obj_result);
926      else {
927        Tcl_AppendStringsToObj(obj_result,
928                               "wrong # args: should be '",
929                               Tcl_GetString(objv[0])," version'",
930                               NULL);
931        tcl_result = TCL_ERROR;
932      }
933    } else if (!strncasecmp("reference", arg, length)) {
[c14b554]934//      if (objc > 4 || objc < 3) {
935      if (objc != 3) {
[6d7779d]936        Tcl_AppendStringsToObj(obj_result,
937                               "wrong # args: should be '",
938                               Tcl_GetString(objv[0]),
[c14b554]939//                               " reference ?grammar? obj'",
940                               " reference {grammar|container objname ?indexes?}'",
[6d7779d]941                               NULL);
942        tcl_result = TCL_ERROR;
943      } else
944        tcl_result = Tol_GetReference(interp, objc-2, objv+2, obj_result);
[6f16730]945    } else if (!strncasecmp("address", arg, length)) {
946      if (objc != 3) {
947        Tcl_AppendStringsToObj(obj_result,
948                               "wrong # args: should be '",
949                               Tcl_GetString(objv[0]),
950                               " address {grammar|container objname ?indexes?}'",
951                               NULL);
952        tcl_result = TCL_ERROR;
953      } else {
[6a081c4]954        tcl_result = Tol_GetAddressFromObject( interp,
[6f16730]955                                              objv[2], obj_result );
956      }
[fe54d8d]957    } else if (!strncasecmp("anything", arg, length)) {
958      if (objc != 3) {
959        Tcl_AppendStringsToObj(obj_result,
960                               "wrong # args: should be '",
961                               Tcl_GetString(objv[0]),
962                               " anything {grammar|container objname ?indexes?}'",
963                               NULL);
964        tcl_result = TCL_ERROR;
965      } else {
966        tcl_result = Tol_GetAnythingType( interp,
967                                          objv[2], obj_result );
968      }
[6d7779d]969    } else if (!strncasecmp("included", arg, length)) {
970      if (objc == 2)
971        tcl_result = Tol_InfoIncluded(interp, obj_result);
972      else if (objc == 3)
973        tcl_result = Tol_InfoFile(interp,objv[2],obj_result);
974      else {
975        Tcl_AppendStringsToObj(obj_result,"wrong # args: should be '",
976                               Tcl_GetString(objv[0]), " include'", NULL);
977        tcl_result = TCL_ERROR;
978      }
979    } else if (!strncasecmp("functions", arg, length))
980      tcl_result = Tol_InfoFunctions(interp, objc-1, objv+1, obj_result);
981    else if (!strncasecmp("grammars", arg, length))
982      tcl_result = Tol_InfoGrammars(interp, objc-1, objv+1, obj_result);
[d3d6a42]983    else if (!strncasecmp("packages", arg, length))
984      tcl_result = Tol_InfoPackages(interp, objc-1, objv+1, obj_result);
[6d7779d]985    else if (!strncasecmp("variables", arg, length))
986      tcl_result = Tol_InfoVariables(interp, objc-1, objv+1, obj_result);
987    else if (!strncasecmp("struct", arg, length))
988      tcl_result = Tol_InfoStruct(interp, objc-1, objv+1, obj_result);
989    else if (!strncasecmp("path", arg, length))
990      tcl_result = Tol_InfoPath(interp, objc-1, objv+1, obj_result);
991    else {
992      Tcl_SetStringObj( obj_result, "bad option '", -1);
993      Tcl_AppendStringsToObj( obj_result, Tcl_GetString( objv[1] ),
994                              "' : must be included, functions, grammars, variables, struct, path or version", NULL );
995      tcl_result = TCL_ERROR;
996    }
997  }
998  Tcl_SetObjResult(interp,obj_result);
999  return tcl_result;
1000}
1001
1002
1003/*
1004 *----------------------------------------------------------------------
1005 *
1006 * Tol_InfoStruct --
1007 *
1008 *        Implements the new Tcl "::tol::info struct" subcommand.
1009 *
1010 *  ::tol::info struct ?name?
1011 *
1012 * Results:
1013 *       A standard Tcl result
1014 *
1015 * Side effects:
1016 *       None.
1017 *
1018 *----------------------------------------------------------------------
1019 */
1020
1021static int Tol_InfoStruct(interp, objc, objv, obj_result)
1022     Tcl_Interp *interp;             /* Current interpreter */
1023     int objc;                       /* Number of arguments */
1024     Tcl_Obj *CONST objv[];          /* Argument objects */
1025     Tcl_Obj * obj_result;           /* subcommand's result */
1026{
1027  if ( objc > 2 ) {
1028    Tcl_AppendStringsToObj( obj_result, "wrong # args: should be '",
1029                      Tcl_GetString(objv[0]),
1030                      " struct ?struct-name?'", NULL);
1031    return TCL_ERROR;
1032  }
1033  if ( objc == 1 ) {
1034    Tcl_AppendStringsToObj(obj_result, "wrong # args: '",
1035                           Tcl_GetString(objv[0]),
1036                           " struct\' not implemented yet",
1037                           NULL);
1038    return TCL_ERROR;
1039  }
1040  return Tol_GetStructure( interp, objv[1], obj_result );
1041/*  return  objc == 1 ? Tol_GetAllStructures( interp, obj_result ) :
1042    Tol_GetStructure( interp, objv[1], obj_result ); */
1043}
1044
1045
1046/*
1047 *----------------------------------------------------------------------
1048 *
1049 * Tol_InfoPath --
1050 *
1051 *        Implements the new Tcl "::tol::info path" subcommand.
1052 *
1053 *  ::tol::info path set-reference
1054 *
1055 * Results:
1056 *       A standard Tcl result
1057 *
1058 * Side effects:
1059 *       None.
1060 *
1061 *----------------------------------------------------------------------
1062 */
1063
1064static int Tol_InfoPath(interp, objc, objv, obj_result)
1065     Tcl_Interp *interp;             /* Current interpreter */
1066     int objc;                       /* Number of arguments */
1067     Tcl_Obj *CONST objv[];          /* Argument objects */
1068     Tcl_Obj * obj_result;           /* subcommand's result */
1069{
1070  if ( objc != 2 ) {
1071    Tcl_AppendStringsToObj(obj_result,
1072                           "wrong # args: should be '",
1073                           Tcl_GetString(objv[0]),
1074                           " path set'", NULL);
1075    return TCL_ERROR;
1076  }
1077  return Tol_GetSetPath(interp, objv[1], obj_result);
1078}
1079
1080
1081/*
1082 *----------------------------------------------------------------------
1083 *
1084 * Tol_InfoFunctions --
1085 *
1086 *        Implements the subcommand "::tol::info functions ?function?".
1087 *
1088 * Results:
1089 *       A standard Tcl result
1090 *
1091 * Side effects:
1092 *       None.
1093 *
1094 *----------------------------------------------------------------------
1095 */
1096
1097static int
1098Tol_InfoFunctions(interp, objc, objv, obj_result)
1099     Tcl_Interp *interp;             /* Current interpreter */
1100     int objc;                                 /* Number of arguments */
1101     Tcl_Obj *CONST objv[];  /* Argument objects */
1102     Tcl_Obj * obj_result;   /* subcommand's result */
1103{
1104  if ( objc < 2 || objc > 3 ) {
1105    Tcl_AppendStringsToObj(obj_result,
1106                           "wrong # args: should be '",
1107                           Tcl_GetString(objv[0]),
1108                           " functions graname ?funname?'", NULL);
1109    return TCL_ERROR;
1110  }
1111  return  objc == 2 ? Tol_SetFunctionsObj(interp, objv[1], obj_result) :
1112    Tol_SetFunctionInfoObj(objv[1], objv[2], obj_result);
1113}
1114
1115
1116/*
1117 *----------------------------------------------------------------------
1118 *
1119 * Tol_InfoGrammars --
1120 *
1121 *        Implements the subcommand "::tol::info grammars ?grammar?".
1122 *
1123 * Results:
1124 *       A standard Tcl result
1125 *
1126 * Side effects:
1127 *       None.
1128 *
1129 *----------------------------------------------------------------------
1130 */
1131
1132static int
1133Tol_InfoGrammars(interp, objc, objv, obj_result)
1134     Tcl_Interp *interp;             /* Current interpreter */
1135     int objc;                                 /* Number of arguments */
1136     Tcl_Obj *CONST objv[];  /* Argument objects */
1137     Tcl_Obj * obj_result;
1138{
1139  if ( objc > 2 ) {
1140    Tcl_AppendStringsToObj(obj_result,
1141                           "wrong # args: should be '",
1142                           Tcl_GetString(objv[0]), " grammars ?graname?'",
1143                           NULL);
1144    return TCL_ERROR;
1145  }
1146  return  objc == 1 ? Tol_SetGrammarsObj(interp, obj_result) :
1147    Tol_SetGrammarDescObj(interp, objv[1], obj_result);
1148}
1149
1150
1151/*
1152 *----------------------------------------------------------------------
1153 *
[d3d6a42]1154 * Tol_InfoGrammars --
1155 *
1156 *        Implements the subcommand "::tol::info grammars ?grammar?".
1157 *
1158 * Results:
1159 *       A standard Tcl result
1160 *
1161 * Side effects:
1162 *       None.
1163 *
1164 *----------------------------------------------------------------------
1165 */
1166
1167static int
1168Tol_InfoPackages(interp, objc, objv, obj_result)
1169     Tcl_Interp *interp;       /* Current interpreter */
1170     int objc;                 /* Number of arguments */
1171     Tcl_Obj *CONST objv[];    /* Argument objects */
1172     Tcl_Obj * obj_result;
1173{
1174  if ( objc > 2 ) {
1175    Tcl_AppendStringsToObj(obj_result,
1176                           "wrong # args: should be '",
1177                           Tcl_GetString(objv[0]), " packages ?pkgName?'",
1178                           NULL);
1179    return TCL_ERROR;
1180  }
1181  return  objc == 1 ? Tol_SetPackagesObj(interp, obj_result) :
1182    Tol_SetPackageDescObj(interp, objv[1], obj_result);
1183}
1184
1185
1186/*
1187 *----------------------------------------------------------------------
1188 *
[6d7779d]1189 * Tol_InfoVariables --
1190 *
1191 *        Implements the new Tcl "::tol::info variables" command.
1192 *
1193 * Results:
1194 *       A standard Tcl result
1195 *
1196 * Side effects:
1197 *       None.
1198 *
1199 *----------------------------------------------------------------------
1200 */
1201
1202static int
1203Tol_InfoVariables(interp, objc, objv, obj_result)
1204Tcl_Interp *interp;             /* Current interpreter */
1205     int objc;                                 /* Number of arguments */
1206     Tcl_Obj *CONST objv[];  /* Argument objects */
1207     Tcl_Obj * obj_result;
1208{
[c14b554]1209//  if ( objc < 2 || objc > 3 ) {
1210  if ( objc != 2 ) {
[6d7779d]1211    Tcl_AppendStringsToObj(obj_result,
1212                     "wrong # args: should be '",
1213                     Tcl_GetString(objv[0]),
[c14b554]1214                     " {grammar|container ?objname? ?indexes?}",
[6d7779d]1215                     NULL);
1216    return TCL_ERROR;
1217  }
[c14b554]1218//  return  objc == 2 ? Tol_SetVariablesObj(interp, objv[1], obj_result) :
1219//    Tol_SetVariableInfoObj(objv[1], objv[2], obj_result);
1220  return  Tol_SetVariablesObj(interp, objv[1], obj_result);
[6d7779d]1221}
1222
1223
1224/*
1225 *----------------------------------------------------------------------
1226 *
1227 * Tol_GetMatrixCmd --
1228 *
1229 *        Implements the new Tcl "::tol::matrix" command.
1230 *
1231 * Results:
1232 *       {matname rows colums {<data>}}
1233 *
1234 * Side effects:
1235 *       None.
1236 *
1237 *----------------------------------------------------------------------
1238 */
1239
1240static int
1241Tol_GetMatrixCmd(ClientData  clientData, /* Not used. */
1242                 Tcl_Interp *interp,     /* Current interpreter */
1243                 int objc,               /* Number of arguments */
1244                 Tcl_Obj *CONST objv[])  /* Argument objects */
1245{
1246  Tcl_Obj * obj_result = Tcl_NewObj();
1247  int tcl_result;
1248
1249  if ( objc != 2) {
1250    Tcl_AppendStringsToObj(obj_result,
1251                           "wrong # args: should be '",
1252                            Tcl_GetString(objv[0]),
1253                            " matrix\"", NULL );
1254    tcl_result = TCL_ERROR;
1255  } else {
1256    tcl_result = Tol_GetMatrixContent(interp,objv[1],obj_result);
1257  }
1258  Tcl_SetObjResult(interp,obj_result);
1259  return tcl_result;
1260}
1261
1262
1263/*
1264 *----------------------------------------------------------------------
1265 *
1266 * Tol_TimeSetCmd --
1267 *
1268 *        Implements the new Tcl "::tol::timeset" command.
1269 *
1270 *       tol::timeset create tms toltms
1271 *       tol::timeset destroy tms ?tms?
1272 *
1273 *       tms start date
1274 *       tms get
1275 *       tms next
1276 *       tms previous
1277 *
1278 * Results:
1279 *       the new tms command
1280 *
1281 * Side effects:
1282 *       None.
1283 *
1284 *----------------------------------------------------------------------
1285 */
1286
1287int Tol_TimeSetCmd ( ClientData clientData, Tcl_Interp *interp,
1288                     int objc, Tcl_Obj *CONST objv[] )
1289{
1290  Tcl_Obj * obj_result = Tcl_NewObj();
1291  int tcl_result;
1292
1293  char * cmdname = Tcl_GetString(objv[0]);
1294
1295  if ( objc < 3 ) {
1296    Tcl_AppendStringsToObj(obj_result,
1297                           "wrong # args: should be '",
1298                           cmdname,
1299                           " option arg ?arg?'", NULL );
1300    tcl_result = TCL_ERROR;
1301  } else {
1302    char * option = Tcl_GetString(objv[1]);
1303    int optlen = strlen(option);
1304
1305    if ( !strncmp(option, "create", optlen) ) {
1306      if ( objc != 4 ) {
1307        Tcl_AppendStringsToObj( obj_result, "wrong # args: should be '",
1308                                cmdname, " ", option,
1309                                " tms toltms'", NULL );
1310        tcl_result = TCL_ERROR;
1311      } else
1312        tcl_result = Tol_CreateTMSCmd( interp, objv[2], objv[3], obj_result );
1313    }
1314    else if ( !strncmp(option, "destroy", optlen) )
1315      tcl_result = Tol_DestroyTMSCmd( interp, objc-2, objv+2, obj_result );
1316    else {
1317      Tcl_AppendStringsToObj(obj_result, "invalid option name '", option,
1318                              "', should be: create or destroy", NULL);
1319      tcl_result = TCL_ERROR;
1320    }
1321  }
1322
1323  Tcl_SetObjResult(interp,obj_result);
1324  return tcl_result;
1325}
1326
1327
1328/*
1329 *----------------------------------------------------------------------
1330 *
1331 * Tol_DateCmd --
1332 *
1333 *        Implements the new Tcl "::tol::date" command.
1334 *
1335 *       tol::date first              -> default first date
1336 *       tol::date last               -> default last  date
1337 *       tol::date now     ?fmt?      -> today date & time
1338 *       tol::date weekday date       -> 0(sunday), 1(monday), ..., 6(saturday)
1339 *       tol::date days    year month -> number of days of month/year
1340 *       tol::date +day    date ?n?   -> date ++ ?n days?
1341 *       tol::date +month  date ?n?   -> date ++ ?n months?
1342 *
1343 * Results:
1344 *       a valid date
1345 *
1346 * Side effects:
1347 *       None.
1348 *
1349 *----------------------------------------------------------------------
1350 */
1351
1352static int Tol_DateCmd ( ClientData clientData, Tcl_Interp *interp,
1353                         int objc, Tcl_Obj *CONST objv[] )
1354{
1355  Tcl_Obj * obj_result = Tcl_NewObj();
1356  int tcl_result;
1357
1358  if ( objc < 2 || objc > 4 ) {
1359    char * cmdname = Tcl_GetString(objv[0]);
1360    Tcl_AppendStringsToObj(obj_result, "wrong # args: should be \n",
1361                           cmdname, " first,\n",
1362                           cmdname, " last,\n",
1363                           cmdname, " now ?fmt?,\n",
1364                           cmdname, " weekday,\n",
1365                           cmdname, " days year month,\n",
1366                           cmdname, " +day date ?n?, or\n",
1367                           cmdname, " +month date ?n?", NULL);
1368    tcl_result = TCL_ERROR;
1369  } else
1370    tcl_result = Tol_DateOption(interp, objc, objv, obj_result);
1371
1372  Tcl_SetObjResult(interp,obj_result);
1373  return tcl_result;
1374}
1375
1376
1377/*
1378 *----------------------------------------------------------------------
1379 *
1380 * Tol_AutoCorCmd --
1381 *
1382 *        Implements the new Tcl "::tol::autocor" command.
1383 *
1384 *       tol::autocor type serie ?lagsize?
1385 *
1386 * Results:
1387 *       {sername sigma size {data of autocorrelation}}
1388 *
1389 * Side effects:
1390 *       None.
1391 *
1392 *----------------------------------------------------------------------
1393 */
1394
1395static int Tol_AutoCorrCmd (ClientData clientData, Tcl_Interp *interp,
1396                            int objc, Tcl_Obj *CONST objv[])
1397{
1398  Tcl_Obj * obj_result = Tcl_NewObj();
1399  int tcl_result;
1400
1401
1402  if ( objc < 3 || objc > 4 ) {
1403    Tcl_AppendStringsToObj( obj_result, "wrong # args: should be '",
1404                           Tcl_GetString(objv[0]),
1405                           " type serie ?lagsize?'", NULL );
1406    tcl_result = TCL_ERROR;
1407  } else
1408    tcl_result = Tol_GetAutoCorr( interp, objc-1, objv+1,
1409                                  obj_result );
1410
1411  Tcl_SetObjResult(interp,obj_result);
1412  return tcl_result;
1413}
1414
1415
1416/*
1417 *----------------------------------------------------------------------
1418 *
1419 * Tol_SerieStatCmd --
1420 *
1421 *       Implements the new Tcl "::tol::seriestat" command.
1422 *
1423 *       tol::seriestat serieref     
1424 *           -> {serie-name {list of stats names & values}}
1425 *
1426 *       tol::seriestat serieref statname ?args?
1427 *            -> return the stat value. (not implemented yet)
1428 *
1429 * Results:
1430 *       
1431 *
1432 * Side effects:
1433 *       None.
1434 *
1435 *----------------------------------------------------------------------
1436 */
1437
1438static
1439int Tol_SerieStatCmd ( ClientData clientData, Tcl_Interp *interp,
1440                       int objc, Tcl_Obj *CONST objv[] )
1441{
1442  Tcl_Obj * obj_result = Tcl_NewObj();
1443  int tcl_result;
1444
1445  if ( objc < 2 ) {
1446    Tcl_AppendStringsToObj( obj_result, "wrong # args: should be '",
1447                           Tcl_GetString(objv[0]),
1448                           " serieref ?statname ?args??'", NULL );
1449    tcl_result = TCL_ERROR;
1450  } else
1451    tcl_result = Tol_ComputeSerieStat(interp,objc-1,objv+1,obj_result);
1452
1453  Tcl_SetObjResult(interp,obj_result);
1454  return tcl_result;
1455}
1456
1457/*
1458 * Tol_StopEvalCmd --
1459 *
1460 * Implement the command tol::stop which try to stop the current evaluation
1461 * flow inside Evaluate.
1462 *
1463 */
1464static
1465int Tol_StopEvalCmd (ClientData clientData, Tcl_Interp *interp,
1466                     int objc, Tcl_Obj *CONST objv[])
1467{
1468  if ( objc != 1 ) {
1469    Tcl_AppendResult(interp, "wrong # args: should be '",
1470                     Tcl_GetString(objv[0]),  "'", NULL);
1471    return TCL_ERROR;
1472  }
1473  return Tol_StopEvaluation();
1474}
1475
1476/*
1477 * Tol_LCFormatCmd --
1478 *
1479 * Implement the command tol::lc_format which format a double given
1480 * the format of reals inside TOL.
1481 *
1482 */
1483static
1484int Tol_LCFormatCmd (ClientData clientData, Tcl_Interp *interp,
1485                     int objc, Tcl_Obj *CONST objv[])
1486{
1487  Tcl_Obj * obj_result;
1488  int tcl_result;
1489
1490  if ( objc != 2 ) {
1491    Tcl_AppendResult( interp, "wrong # args: should be '",
1492                      Tcl_GetString(objv[0]),  " double_value'",
1493                      NULL );
1494    tcl_result = TCL_ERROR;
1495  } else {
1496    obj_result = Tcl_NewObj();
1497    tcl_result = Tol_LCFormat(interp,objv[1],obj_result);
1498    Tcl_SetObjResult(interp, obj_result);
1499  }
1500  return tcl_result;
1501}
1502
1503
1504/*
1505 *----------------------------------------------------------------------
1506 *
1507 * Toltcl_Init --
1508 *
1509 *       Initialize the new package.  The string "Toltcl" in the
1510 *       function name must match the PACKAGE declaration at the top of
1511 *       configure.in.
1512 *
1513 * Results:
1514 *       A standard Tcl result
1515 *
1516 * Side effects:
1517 *       The TolTcl package is created.
1518 *      The commands: ::tol::grammars
1519 *
1520 *----------------------------------------------------------------------
1521 */
1522
1523int
1524Toltcl_Init(Tcl_Interp *interp)
1525{
1526  /* Inicializo la captura de segfault */
1527
1528  InitCrashHandler();
1529 
1530  TT_interp = interp;
1531
1532  if (Tcl_InitStubs(interp, "8.3", 0) == NULL) {
1533    return TCL_ERROR;
1534  }
1535  if (Tcl_PkgRequire(interp, "Tcl", "8.3", 0) == NULL) {
1536    return TCL_ERROR;
1537  }
1538  if (Tcl_PkgProvide(interp, "Toltcl", TOLTCL_VERSION) != TCL_OK) {
1539    return TCL_ERROR;
1540  }
1541 
1542  /*
1543   *  Create the commands
1544   *
1545   */
1546 
1547  Tcl_CreateObjCommand( interp, "::tol::initkernel", Tol_InitKernelCmd,
1548                        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL );
1549 
1550  /*
1551   *  Inititialize TOL
1552   *
1553   */
1554 
1555  //InitTolKernel();
1556  Tol_InstallHciWriter();
1557  Tol_InstallMethodsHook();
1558 
1559  return TCL_OK;
1560}
1561
1562#ifdef __WIN32__
1563#ifndef STATIC_BUILD
1564
1565#include <windows.h>
1566
1567/*
1568 * The following declaration is for the VC++ DLL entry point.
1569 */
1570
1571BOOL APIENTRY           DllMain(HINSTANCE hInst, DWORD reason,
1572                                LPVOID reserved);
1573/*
1574 *----------------------------------------------------------------------
1575 *
1576 * DllMain --
1577 *
1578 *      This routine is called by the VC++ C run time library init
1579 *      code, or the DllEntryPoint routine.
1580 *
1581 * Results:
1582 *      TRUE on sucess, FALSE on failure.
1583 *
1584 * Side effects:
1585 *
1586 *----------------------------------------------------------------------
1587 */
1588
1589BOOL APIENTRY
1590DllMain(hInst, reason, reserved)
1591     HINSTANCE hInst;    /* Library instance handle. */
1592     DWORD reason;       /* Reason this function is being called. */
1593     LPVOID reserved;    /* Not used. */
1594{
1595  switch (reason) {
1596  case DLL_PROCESS_ATTACH:
1597    break;
1598  case DLL_PROCESS_DETACH:
1599    break;
1600  }
1601  return TRUE;
1602}
1603
1604#endif /* !STATIC_BUILD */
1605#endif /* __WIN32__ */
Note: See TracBrowser for help on using the repository browser.