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

   1 /*
   2  * tcl++.C --
   3  *
   4  * It also defines C++ classes that can be used to access a Tcl interpreter.
   5  * If tcl.h is not already included, it includes it. Tcl.h  has macros that
   6  * 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++.C,v 2.0 1992/10/16 04:51:32 markd Rel $
  20  *-----------------------------------------------------------------------------
  21  */
  22
  23 #include "tclplus.h"
  24
  25 /*
  26  *----------------------------------------------------------------------
  27  *
  28  * TclInterp_cl::CatVarArgs --
  29  *
  30  * Concatenate all of the strings passed via varargs into a single string.
  31  *
  32  * Parameters:
  33  *   o argPtr (I) - A pointer to the first argument, as returned by va_start.
  34  *     Should be terminate by a NULL.
  35  *
  36  * Returns:
  37  *   A dynamically allocated string.
  38  *----------------------------------------------------------------------
  39  */
  40 char *
  41 TclInterp_cl::CatVarArgs (va_list argPtr)
  42 {
  43     int      len = 0;
  44     char    *parmPtr, *ptr;
  45     va_list  nextArgPtr = argPtr;
  46
  47     while (1) {
  48         parmPtr = va_arg (nextArgPtr, char *);
  49         if (parmPtr == NULL)
  50             break;
  51         len += strlen (parmPtr);
  52     }
  53     ptr = (char *) ckalloc (len + 1);
  54     ptr [0] = '\0';
  55     nextArgPtr = argPtr;
  56     while (1) {
  57         parmPtr = va_arg (nextArgPtr, char *);
  58         if (parmPtr == NULL)
  59             break;
  60         strcat (ptr, parmPtr);
  61     }
  62     return ptr;
  63 }
  64 \f
  65 /*
  66  *----------------------------------------------------------------------
  67  *
  68  * TclInterp_cl::AppendResult --
  69  *
  70  *    Class interface to Tcl_AppendResult (see Tcl documentation for
  71  * details).  Not inlined since varargs and inline don't work on some C++
  72  * compilers.
  73  *----------------------------------------------------------------------
  74  */
  75 void
  76 TclInterp_cl::AppendResult (const char *p,
  77                             ...)
  78 {
  79     va_list  argPtr;
  80     char    *strPtr;
  81
  82     va_start (argPtr, p);
  83     strPtr = CatVarArgs (argPtr);
  84     Tcl_AppendResult (interp, p, strPtr, (char *) NULL);
  85     ckfree (strPtr)
  86     va_end (argPtr);
  87 }
  88 \f
  89 /*
  90  *----------------------------------------------------------------------
  91  *
  92  * TclInterp_cl::SetErrorCode --
  93  *
  94  *    Class interface to Tcl_SetErrorCode (see Tcl documentation for
  95  * details).  Not inlined since varargs and inline don't work on some C++
  96  * compilers.
  97  *----------------------------------------------------------------------
  98  */
  99 void
 100 TclInterp_cl::SetErrorCode (char *p,
 101                             ...)
 102 {
 103     va_list  argPtr;
 104     char    *strPtr;
 105
 106     va_start (argPtr, p);
 107     strPtr = CatVarArgs (argPtr);
 108     Tcl_SetErrorCode (interp, p, strPtr, (char *) NULL);
 109     ckfree (strPtr)
 110     va_end (argPtr);
 111 }
 112 \f
 113 /*
 114  *----------------------------------------------------------------------
 115  *
 116  * TclInterp_cl::VarEval --
 117  *
 118  *    Class interface to Tcl_VarEval (see Tcl documentation for details).
 119  *  Not inlined since varargs and inline don't work on some C++ compilers.
 120  *----------------------------------------------------------------------
 121  */
 122 int
 123 TclInterp_cl::VarEval (const char *p,
 124                        ...)
 125 {
 126     int      intResult;
 127     va_list  argPtr;
 128     char    *strPtr;
 129
 130     va_start (argPtr, p);
 131     strPtr = CatVarArgs (argPtr);
 132     intResult = Tcl_VarEval (interp, (char *) p, strPtr, (char *) NULL);
 133     ckfree (strPtr);
 134     va_end (argPtr);
 135     return intResult;
 136 }
 137