home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tclX6.5c / src / tcl++.C < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-19  |  4.0 KB  |  138 lines
  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 "tcl++.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.  
  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.  
  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.  
  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.  
  138.