home *** CD-ROM | disk | FTP | other *** search
/ Practical Programming in Tcl & Tk (4th Edition) / TCLBOOK4.BIN / pc / exsource.old / 45_15.c < prev    next >
C/C++ Source or Header  |  2003-04-15  |  3KB  |  155 lines
  1. /*
  2.  * Example 45-15
  3.  * Calling C command procedure directly with Tcl_Invoke.
  4.  */
  5.  
  6. #include <tcl.h>
  7.  
  8. #if defined(__STDC__) || defined(HAS_STDARG)
  9. #   include <stdarg.h>
  10. #else
  11. #   include <varargs.h>
  12. #endif
  13.  
  14. /*
  15. * Tcl_Invoke --
  16. *        Directly invoke a Tcl command or procedure
  17. *
  18. *        Call Tcl_Invoke somewhat like Tcl_VarEval
  19. *        Each arg becomes one argument to the command,
  20. *        with no further substitutions or parsing.
  21. */
  22.     /* VARARGS2 */ /* ARGSUSED */
  23.  
  24. int
  25. Tcl_Invoke TCL_VARARGS_DEF(Tcl_Interp *, arg1)
  26. {
  27.     va_list argList;
  28.     Tcl_Interp *interp;
  29.     char *cmd;                        /* Command name */
  30.     char *arg;                        /* Command argument */
  31.     char **argv;                        /* String vector for arguments */
  32.     int argc, i, max;                        /* Number of arguments */
  33.     Tcl_CmdInfo info;                        /* Info about command procedures */
  34.     int result;                        /* TCL_OK or TCL_ERROR */
  35.  
  36.     interp = TCL_VARARGS_START(Tcl_Interp *, arg1, argList);
  37.     Tcl_ResetResult(interp);
  38.  
  39.     /*
  40.      * Map from the command name to a C procedure
  41.      */
  42.     cmd = va_arg(argList, char *);
  43.     if (! Tcl_GetCommandInfo(interp, cmd, &info)) {
  44.         Tcl_AppendResult(interp, "unknown command \"", 
  45.             cmd, "\"", NULL);
  46.         va_end(argList);
  47.         return TCL_ERROR;
  48.     }
  49.  
  50.     max = 20;                        /* Initial size of argument vector */
  51.  
  52. #if TCL_MAJOR_VERSION > 7
  53.     /*
  54.      * Check whether the object interface is preferred for
  55.      * this command
  56.      */
  57.  
  58.     if (info.isNativeObjectProc) {
  59.         Tcl_Obj **objv;                        /* Object vector for arguments */
  60.         Tcl_Obj *resultPtr;                        /* The result object */
  61.         int objc;
  62.  
  63.         objv = (Tcl_Obj **) ckalloc(max * sizeof(Tcl_Obj *));
  64.         objv[0] = Tcl_NewStringObj(cmd, strlen(cmd));
  65.         Tcl_IncrRefCount(objv[0]); /* ref count == 1*/
  66.         objc = 1;
  67.  
  68.         /*
  69.          * Build a vector out of the rest of the arguments
  70.          */
  71.  
  72.         while (1) {
  73.             arg = va_arg(argList, char *);
  74.             if (arg == (char *)NULL) {
  75.                 objv[objc] = (Tcl_Obj *)NULL;
  76.                 break;
  77.             }
  78.             objv[objc] = Tcl_NewStringObj(arg, strlen(arg));
  79.             Tcl_IncrRefCount(objv[objc]); /* ref count == 1*/
  80.             objc++;
  81.             if (objc >= max) {
  82.                 /* allocate a bigger vector and copy old one */
  83.                 Tcl_Obj **oldv = objv;
  84.                 max *= 2;
  85.                 objv = (Tcl_Obj **) ckalloc(max *
  86.                         sizeof(Tcl_Obj *));
  87.                 for (i = 0 ; i < objc ; i++) {
  88.                     objv[i] = oldv[i];
  89.                 }
  90.                 Tcl_Free((char *)oldv);
  91.             }
  92.         }
  93.         va_end(argList);
  94.  
  95.         /*
  96.          * Invoke the C procedure
  97.          */
  98.         result = (*info.objProc)(info.objClientData, interp,
  99.                 objc, objv);
  100.  
  101.         /*
  102.          * Make sure the string value of the result is valid
  103.          * and release our references to the arguments
  104.          */
  105.         (void) Tcl_GetStringResult(interp);
  106.         for (i = 0 ; i < objc ; i++) {
  107.             Tcl_DecrRefCount(objv[i]);
  108.         }
  109.         Tcl_Free((char *)objv);
  110.  
  111.         return result;
  112.     }
  113. #endif
  114.     argv = (char **) ckalloc(max * sizeof(char *));
  115.     argv[0] = cmd;
  116.     argc = 1;
  117.  
  118.     /*
  119.      * Build a vector out of the rest of the arguments
  120.      */
  121.     while (1) {
  122.         arg = va_arg(argList, char *);
  123.         argv[argc] = arg;
  124.         if (arg == (char *)NULL) {
  125.             break;
  126.         }
  127.         argc++;
  128.         if (argc >= max) {
  129.             /* allocate a bigger vector and copy old one */
  130.             char **oldv = argv;
  131.             max *= 2;
  132.             argv = (char **) ckalloc(max * sizeof(char *));
  133.             for (i = 0 ; i < argc ; i++) {
  134.                 argv[i] = oldv[i];
  135.             }
  136.             Tcl_Free((char *) oldv);
  137.         }
  138.     }
  139.     va_end(argList);
  140.  
  141.     /*
  142.      * Invoke the C procedure
  143.      */
  144.     result = (*info.proc)(info.clientData, interp, argc, argv);
  145.  
  146.     /*
  147.      * Release the arguments
  148.      */
  149.     Tcl_Free((char *) argv);
  150.     return result;
  151.  
  152. }
  153.  
  154.  
  155.