git.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclplus.h

   1 /*
   2  * tcl++.h --
   3  *
   4  * This file defines a C++ classes that can be used to access a Tcl
   5  * interpreter. If tcl.h is not already included, it includes it. Tcl.h has
   6  * macros that allow it to work with K&R C, ANSI C and C++.
   7  *-----------------------------------------------------------------------------
   8  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
   9  *
  10  * Permission to use, copy, modify, and distribute this software and its
  11  * documentation for any purpose and without fee is hereby granted, provided
  12  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  13  * Mark Diekhans make no representations about the suitability of this
  14  * software for any purpose.  It is provided "as is" without express or
  15  * implied warranty.
  16  *-----------------------------------------------------------------------------
  17  * Based on Tcl C++ classes developed by Parag Patel.
  18  *-----------------------------------------------------------------------------
  19  * $Id: tcl++.h,v 2.0 1992/10/16 04:51:25 markd Rel $
  20  *-----------------------------------------------------------------------------
  21  */
  22
  23 #ifndef _TCL_PLUS_PLUS_H
  24 #define _TCL_PLUS_PLUS_H
  25
  26 #include <stddef.h>
  27 #include <stdlib.h>
  28 #include <string.h>
  29 #include <stdarg.h>
  30 #ifndef TCLEXTEND_H
  31 #    include "tclxtend.h"
  32 #endif
  33
  34 class TclInterp_cl
  35 {
  36     Tcl_Interp *interp;
  37
  38     friend class TclTrace_cl;
  39
  40 private:
  41     char *
  42     CatVarArgs (va_list  argPtr);
  43
  44 public:
  45     inline
  46     TclInterp_cl ()
  47     {
  48         interp = Tcl_CreateExtendedInterp ();
  49     }
  50
  51     inline
  52     ~TclInterp_cl ()
  53     {
  54         Tcl_DeleteInterp (interp);
  55     }
  56
  57     inline char *
  58     Result ()
  59     {
  60         return interp->result;
  61     }
  62
  63     inline int
  64     ErrorLine ()
  65     {
  66         return interp->errorLine;
  67     }
  68
  69     inline Tcl_Interp *
  70     GetInterp ()
  71     {
  72         return interp;
  73     }
  74
  75    /*
  76     * Exported Tcl procedures (from standard baseline):
  77     */
  78
  79     inline void
  80     AppendElement (const char *string,
  81                    int         noSep)
  82     {
  83         Tcl_AppendElement (interp, (char *) string, noSep);
  84     }
  85
  86     void
  87     AppendResult (const char *p,
  88                   ...);
  89
  90     inline void
  91     AddErrorInfo (const char *message)
  92     {
  93         Tcl_AddErrorInfo (interp, (char *)message);
  94     }
  95
  96     inline void
  97     CreateCommand (const char        *cmdName,
  98                    Tcl_CmdProc       *proc,
  99                    ClientData         data,
 100                    Tcl_CmdDeleteProc *deleteProc)
 101     {
 102         Tcl_CreateCommand (interp, (char*) cmdName, proc, data, deleteProc);
 103     }
 104
 105     inline int
 106     CreatePipeline (int    argc,
 107                     char **argv,
 108                     int  **pidArrayPtr,
 109                     int   *inPipePtr,
 110                     int   *outPipePtr,
 111                     int   *errFilePtr)
 112     {
 113         return Tcl_CreatePipeline (interp, argc, argv, pidArrayPtr, inPipePtr,
 114                                    outPipePtr, errFilePtr);
 115     }
 116
 117     inline Tcl_Trace
 118     CreateTrace (int               level,
 119                  Tcl_CmdTraceProc *proc,
 120                  ClientData        data)
 121     {
 122         return Tcl_CreateTrace (interp, level, proc, data);
 123     }
 124
 125     inline void
 126     DeleteCommand (const char *cmdName)
 127     {
 128         Tcl_DeleteCommand (interp, (char *)cmdName);
 129     }
 130
 131     inline void
 132     DeleteTrace (Tcl_Trace trace)
 133     {
 134         Tcl_DeleteTrace(interp, trace);
 135     }
 136
 137     inline void
 138     DetachPids (int  numPids,
 139                 int *pidPtr)
 140     {
 141         Tcl_DetachPids (numPids, pidPtr);
 142     }
 143
 144     inline int
 145     Eval (const char   *cmd,
 146           char          flags = 0,
 147           char        **termPtr = NULL)
 148         { return Tcl_Eval (interp, (char *) cmd, flags, termPtr); }
 149
 150     inline int
 151     EvalFile (const char *fileName)
 152     {
 153         return Tcl_EvalFile (interp, (char *) fileName);
 154     }
 155
 156     inline int
 157     ExprBoolean (const char *string,
 158                  int        *ptr)
 159     {
 160         return Tcl_ExprBoolean (interp, (char *) string, ptr);
 161     }
 162
 163     inline int
 164     ExprDouble (const char *string,
 165                 double     *ptr)
 166     {
 167         return Tcl_ExprDouble (interp, (char *) string, ptr);
 168     }
 169
 170     inline int
 171     ExprLong (const char *string,
 172               long       *ptr)
 173     {
 174         return Tcl_ExprLong (interp, (char *) string, ptr);
 175     }
 176
 177     inline int
 178     ExprString (const char *string)
 179     {
 180         return Tcl_ExprString (interp, (char *) string);
 181     }
 182
 183     inline int
 184     GetBoolean (Tcl_Interp *interp,
 185                 const char *string,
 186                 int        *boolPtr)
 187     {
 188         return Tcl_GetBoolean (interp, (char *) string, boolPtr);
 189     }
 190
 191     inline int
 192     GetDouble (Tcl_Interp *interp,
 193                const char *string,
 194                double     *doublePtr)
 195     {
 196         return Tcl_GetDouble (interp, (char *) string, doublePtr);
 197     }
 198
 199     inline int
 200     GetInt (Tcl_Interp *interp,
 201             const char *string,
 202             int        *intPtr)
 203     {
 204         return Tcl_GetInt (interp, (char *) string, intPtr);
 205     }
 206
 207     inline const char *
 208     GetVar (const char *varName,
 209             int         flags = 0)
 210     {
 211         return Tcl_GetVar (interp, (char *) varName, flags);
 212     }
 213
 214     inline const char *
 215     GetVar2 (const char *name1,
 216              const char *name2,
 217              int         flags = 0)
 218     {
 219         return Tcl_GetVar2 (interp, (char *) name1, (char *) name2, flags);
 220     }
 221
 222     inline void
 223     InitMemory ()
 224     {
 225         Tcl_InitMemory (interp);
 226     }
 227
 228     inline char *
 229     ParseVar (const char  *string,
 230               char       **termPtr)
 231        { return Tcl_ParseVar (interp, (char *) string, termPtr); }
 232
 233     inline int
 234     RecordAndEval (const char *cmd,
 235                    char        flags)
 236         { return Tcl_RecordAndEval (interp, (char *) cmd, flags); }
 237
 238     inline void
 239     ResetResult ()
 240     {
 241         Tcl_ResetResult (interp);
 242     }
 243
 244     void
 245     SetErrorCode (char *p,
 246                   ...);
 247
 248     inline void
 249     SetResult (const char *string)
 250     {
 251         Tcl_SetResult (interp, (char *) string, TCL_VOLATILE);
 252     }
 253
 254     inline void
 255     SetResult (const char   *string,
 256                Tcl_FreeProc *freeProc)
 257     {
 258         Tcl_SetResult (interp, (char *) string, freeProc);
 259     }
 260
 261     inline const char *
 262     SetVar (const char  *varName,
 263             const char  *newValue,
 264             int          global = 0)
 265     {
 266         return Tcl_SetVar (interp, (char *) varName, (char *) newValue,
 267                            global);
 268     }
 269
 270     inline const char *
 271     SetVar2 (const char *name1,
 272              const char *name2,
 273              const char *newValue,
 274              int         global)
 275     {
 276          return Tcl_SetVar2 (interp, (char *) name1, (char *) name2,
 277                              (char *) newValue, global);
 278     }
 279
 280     inline int
 281     SplitList (const char   *list,
 282                int          &argcP,
 283                char       **&argvP)
 284         { return Tcl_SplitList (interp, (char *) list, &argcP, &argvP); }
 285
 286     inline char *
 287     TildeSubst (Tcl_Interp *interp,
 288                 const char *name)
 289         { return Tcl_TildeSubst (interp, (char *) name); }
 290
 291     int
 292     TraceVar (const char       *varName,
 293               int               flags,
 294               Tcl_VarTraceProc *proc,
 295               ClientData        clientData)
 296     {
 297          return Tcl_TraceVar (interp, (char *) varName, flags, proc,
 298                               clientData);
 299     }
 300
 301     inline int
 302     TraceVar2 (const char       *name1,
 303                const char       *name2,
 304                int               flags,
 305                Tcl_VarTraceProc *proc,
 306                ClientData        clientData)
 307     {
 308          return Tcl_TraceVar2 (interp, (char *) name1, (char *) name2, flags,
 309                                proc, clientData);
 310     }
 311
 312     inline const char *
 313     UnixError ()
 314     {
 315         return Tcl_UnixError (interp);
 316     }
 317
 318     inline void
 319     UnsetVar (Tcl_Interp *interp,
 320               const char *varName,
 321               int         global)
 322         { Tcl_UnsetVar (interp, (char *) varName, global); }
 323
 324     inline void
 325     UnsetVar2 (Tcl_Interp *interp,
 326                const char *name1,
 327                const char *name2,
 328                int         global)
 329         { Tcl_UnsetVar2 (interp, (char *) name1, (char *) name2, global); }
 330
 331     inline void
 332     UntraceVar (const char       *varName,
 333                 int               flags,
 334                 Tcl_VarTraceProc *proc,
 335                 ClientData        clientData)
 336     {
 337         Tcl_UntraceVar (interp, (char *) varName, flags, proc, clientData);
 338     }
 339
 340
 341     inline void
 342     UntraceVar2 (Tcl_Interp       *interp,
 343                  const char       *name1,
 344                  const char       *name2,
 345                  int               flags,
 346                  Tcl_VarTraceProc *proc,
 347                  ClientData        clientData)
 348     {
 349         Tcl_UntraceVar2 (interp, (char *) name1, (char *) name2, flags, proc,
 350                          clientData);
 351     }
 352
 353     int
 354     VarEval (const char *p,
 355               ...);
 356
 357     inline ClientData
 358     VarTraceInfo (const char       *varName,
 359                   int               flags,
 360                   Tcl_VarTraceProc *procPtr,
 361                   ClientData        prevClientData)
 362     {
 363         return Tcl_VarTraceInfo (interp, (char *) varName, flags, procPtr,
 364                                  prevClientData);
 365     }
 366
 367     inline ClientData
 368     VarTraceInfo2 (const char       *name1,
 369                    const char       *name2,
 370                    int               flags,
 371                    Tcl_VarTraceProc *procPtr,
 372                    ClientData        prevClientData)
 373     {
 374         return Tcl_VarTraceInfo2 (interp, (char *) name1, (char *) name2,
 375                                   flags, procPtr, prevClientData);
 376     }
 377
 378     /*
 379      * Exported Tcl functions added to baseline Tcl by the Extended Tcl
 380      * implementation.
 381      */
 382
 383     inline void
 384     CommandLoop (FILE       *inFile,
 385                  FILE       *outFile,
 386                  int         (*evalProc) (),
 387                  unsigned    options)
 388     {
 389         Tcl_CommandLoop (interp, inFile, outFile, evalProc, options);
 390     }
 391
 392     inline char *
 393     DeleteKeyedListField (const char  *fieldName,
 394                           const char  *keyedList)
 395     {
 396         return Tcl_DeleteKeyedListField (interp, fieldName, keyedList);
 397     }
 398
 399     inline void
 400     ErrorAbort (int  exitCode)
 401     {
 402         Tcl_ErrorAbort (interp, exitCode);
 403     }
 404
 405     inline int
 406     GetKeyedListField (const char  *fieldName,
 407                        const char  *keyedList,
 408                        char       **fieldValuePtr)
 409     {
 410         return Tcl_GetKeyedListField (interp, fieldName, keyedList,
 411                                       fieldValuePtr);
 412     }
 413
 414     inline int
 415     GetKeyedListKeys (const char  *subFieldName,
 416                       const char  *keyedList,
 417                       int         *keyesArgcPtr,
 418                       char      ***keyesArgvPtr)
 419     {
 420
 421         return Tcl_GetKeyedListKeys (interp, subFieldName, keyedList,
 422                                      keyesArgcPtr, keyesArgvPtr);
 423     }
 424
 425     inline int
 426     GetLong (Tcl_Interp *interp,
 427              const char *string,
 428              long       *longPtr)
 429     {
 430         return Tcl_GetLong (interp, string, longPtr);
 431     }
 432
 433     inline int
 434     GetUnsigned (Tcl_Interp *interp,
 435                  const char *string,
 436                  unsigned   *unsignedPtr)
 437     {
 438          return Tcl_GetUnsigned (interp, string, unsignedPtr);
 439     }
 440
 441     inline char *
 442     SetKeyedListField (const char  *fieldName,
 443                        const char  *fieldvalue,
 444                        const char  *keyedList)
 445     {
 446         return Tcl_SetKeyedListField (interp, fieldName, fieldvalue,
 447                                       keyedList);
 448     }
 449
 450     inline int
 451     ShellEnvInit (unsigned     options,
 452                   const char  *programName,
 453                   int          argc,
 454                   const char **argv,
 455                   int          interactive,
 456                   const char  *defaultFile)
 457      {
 458          return Tcl_ShellEnvInit (interp, options, programName, argc, argv,
 459                                   interactive, defaultFile);
 460      }
 461
 462     inline void
 463     Startup (int          argc,
 464              const char **argv,
 465              const char  *defaultFile,
 466              unsigned     options = 0)
 467     {
 468         Tcl_Startup (interp, argc, argv, defaultFile, options);
 469     }
 470
 471     inline int
 472     System (const char *command)
 473     {
 474         return Tcl_System (interp, (char*) command);
 475     }
 476 };
 477
 478 class TclTrace_cl
 479 {
 480     Tcl_Trace trace;
 481     Tcl_Interp *interp;
 482
 483 public:
 484     inline
 485     TclTrace_cl (TclInterp_cl     &interpCl,
 486                  int               level,
 487                  Tcl_CmdTraceProc *proc,
 488                  ClientData        data)
 489     {
 490         trace = Tcl_CreateTrace (interp = interpCl.interp, level, proc, data);
 491     }
 492
 493     inline ~TclTrace_cl ()
 494         { Tcl_DeleteTrace (interp, trace); }
 495 };
 496
 497
 498 class TclCmdBuf_cl
 499 {
 500     Tcl_CmdBuf buf;
 501
 502 public:
 503     inline
 504     TclCmdBuf_cl ()
 505         { buf = Tcl_CreateCmdBuf (); }
 506
 507     inline
 508     ~TclCmdBuf_cl ()
 509         { Tcl_DeleteCmdBuf (buf); }
 510
 511     inline const char *
 512     AssembleCmd (const char *string)
 513         { return Tcl_AssembleCmd (buf, (char *) string); }
 514 };
 515
 516 class TclHandleTbl_cl
 517 {
 518     void_pt headerPtr;
 519
 520 public:
 521     inline
 522     TclHandleTbl_cl (const char *handleBase,
 523                      int         entrySize,
 524                      int         initEntries)
 525
 526     {
 527         headerPtr = Tcl_HandleTblInit (handleBase, entrySize, initEntries);
 528     }
 529
 530     inline
 531     ~TclHandleTbl_cl ()
 532     {
 533         Tcl_HandleTblRelease (headerPtr);
 534     }
 535
 536     inline void_pt
 537     HandleAlloc (char *handlePtr)
 538     {
 539         return Tcl_HandleAlloc (headerPtr, handlePtr);
 540     }
 541
 542     inline void
 543     HandleFree (void_pt  entryPtr)
 544     {
 545         Tcl_HandleFree (headerPtr, entryPtr);
 546     }
 547
 548     inline int
 549     HandleTblUseCount (int amount)
 550     {
 551         return Tcl_HandleTblUseCount (headerPtr, amount);
 552     }
 553
 554     inline void_pt
 555     HandleWalk (int *walkKeyPtr)
 556     {
 557         return Tcl_HandleWalk (headerPtr, walkKeyPtr);
 558     }
 559
 560     inline void_pt
 561     HandleXlate (Tcl_Interp  *interp,
 562                  const  char *handle)
 563     {
 564         return Tcl_HandleXlate (interp, headerPtr, handle);
 565     }
 566 };
 567
 568 #endif /* _TCL_PLUS_PLUS_H */
 569
 570