home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tclsrc / c / tclLink < prev    next >
Text File  |  1994-12-18  |  11KB  |  357 lines
  1. /* 
  2.  * tclLink.c --
  3.  *
  4.  *    This file implements linked variables (a C variable that is
  5.  *    tied to a Tcl variable).  The idea of linked variables was
  6.  *    first suggested by Andreas Stolcke and this implementation is
  7.  *    based heavily on a prototype implementation provided by
  8.  *    him.
  9.  *
  10.  * Copyright (c) 1993 The Regents of the University of California.
  11.  * Copyright (c) 1994 Sun Microsystems, Inc.
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  */
  16.  
  17. #ifndef lint
  18. static char sccsid[] = "@(#) tclLink.c 1.9 94/12/17 16:14:21";
  19. #endif /* not lint */
  20.  
  21. #include "tclInt.h"
  22.  
  23. /*
  24.  * For each linked variable there is a data structure of the following
  25.  * type, which describes the link and is the clientData for the trace
  26.  * set on the Tcl variable.
  27.  */
  28.  
  29. typedef struct Link {
  30.     Tcl_Interp *interp;        /* Interpreter containing Tcl variable. */
  31.     char *varName;        /* Name of variable (must be global).  This
  32.                  * is needed during trace callbacks, since
  33.                  * the actual variable may be aliased at
  34.                  * that time via upvar. */
  35.     char *addr;            /* Location of C variable. */
  36.     int type;            /* Type of link (TCL_LINK_INT, etc.). */
  37.     int writable;        /* Zero means Tcl variable is read-only. */
  38.     union {
  39.     int i;
  40.     double d;
  41.     } lastValue;        /* Last known value of C variable;  used to
  42.                  * avoid string conversions. */
  43. } Link;
  44.  
  45. /*
  46.  * Forward references to procedures defined later in this file:
  47.  */
  48.  
  49. static char *        LinkTraceProc _ANSI_ARGS_((ClientData clientData,
  50.                 Tcl_Interp *interp, char *name1, char *name2,
  51.                 int flags));
  52. static char *        StringValue _ANSI_ARGS_((Link *linkPtr,
  53.                 char *buffer));
  54.  
  55. /*
  56.  *----------------------------------------------------------------------
  57.  *
  58.  * Tcl_LinkVar --
  59.  *
  60.  *    Link a C variable to a Tcl variable so that changes to either
  61.  *    one causes the other to change.
  62.  *
  63.  * Results:
  64.  *    The return value is TCL_OK if everything went well or TCL_ERROR
  65.  *    if an error occurred (interp->result is also set after errors).
  66.  *
  67.  * Side effects:
  68.  *    The value at *addr is linked to the Tcl variable "varName",
  69.  *    using "type" to convert between string values for Tcl and
  70.  *    binary values for *addr.
  71.  *
  72.  *----------------------------------------------------------------------
  73.  */
  74.  
  75. int
  76. Tcl_LinkVar(interp, varName, addr, type)
  77.     Tcl_Interp *interp;        /* Interpreter in which varName exists. */
  78.     char *varName;        /* Name of a global variable in interp. */
  79.     char *addr;            /* Address of a C variable to be linked
  80.                  * to varName. */
  81.     int type;            /* Type of C variable: TCL_LINK_INT, etc. 
  82.                  * Also may have TCL_LINK_READ_ONLY
  83.                  * OR'ed in. */
  84. {
  85.     Link *linkPtr;
  86.     char buffer[TCL_DOUBLE_SPACE];
  87.     int code;
  88.  
  89.     linkPtr = (Link *) ckalloc(sizeof(Link));
  90.     linkPtr->interp = interp;
  91.     linkPtr->varName = ckalloc((unsigned) (strlen(varName) + 1));
  92.     strcpy(linkPtr->varName, varName);
  93.     linkPtr->addr = addr;
  94.     linkPtr->type = type & ~TCL_LINK_READ_ONLY;
  95.     linkPtr->writable = (type & TCL_LINK_READ_ONLY) == 0;
  96.     if (Tcl_SetVar(interp, varName, StringValue(linkPtr, buffer),
  97.         TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
  98.     ckfree(linkPtr->varName);
  99.     ckfree((char *) linkPtr);
  100.     return TCL_ERROR;
  101.     }
  102.     code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
  103.         |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
  104.         (ClientData) linkPtr);
  105.     if (code != TCL_OK) {
  106.     ckfree(linkPtr->varName);
  107.     ckfree((char *) linkPtr);
  108.     }
  109.     return code;
  110. }
  111.  
  112. /*
  113.  *----------------------------------------------------------------------
  114.  *
  115.  * Tcl_UnlinkVar --
  116.  *
  117.  *    Destroy the link between a Tcl variable and a C variable.
  118.  *
  119.  * Results:
  120.  *    None.
  121.  *
  122.  * Side effects:
  123.  *    If "varName" was previously linked to a C variable, the link
  124.  *    is broken to make the variable independent.  If there was no
  125.  *    previous link for "varName" then nothing happens.
  126.  *
  127.  *----------------------------------------------------------------------
  128.  */
  129.  
  130. void
  131. Tcl_UnlinkVar(interp, varName)
  132.     Tcl_Interp *interp;        /* Interpreter containing variable to unlink. */
  133.     char *varName;        /* Global variable in interp to unlink. */
  134. {
  135.     Link *linkPtr;
  136.  
  137.     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
  138.         LinkTraceProc, (ClientData) NULL);
  139.     if (linkPtr == NULL) {
  140.     return;
  141.     }
  142.     Tcl_UntraceVar(interp, varName,
  143.         TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  144.         LinkTraceProc, (ClientData) linkPtr);
  145.     ckfree(linkPtr->varName);
  146.     ckfree((char *) linkPtr);
  147. }
  148.  
  149. /*
  150.  *----------------------------------------------------------------------
  151.  *
  152.  * LinkTraceProc --
  153.  *
  154.  *    This procedure is invoked when a linked Tcl variable is read,
  155.  *    written, or unset from Tcl.  It's responsible for keeping the
  156.  *    C variable in sync with the Tcl variable.
  157.  *
  158.  * Results:
  159.  *    If all goes well, NULL is returned; otherwise an error message
  160.  *    is returned.
  161.  *
  162.  * Side effects:
  163.  *    The C variable may be updated to make it consistent with the
  164.  *    Tcl variable, or the Tcl variable may be overwritten to reject
  165.  *    a modification.
  166.  *
  167.  *----------------------------------------------------------------------
  168.  */
  169.  
  170. static char *
  171. LinkTraceProc(clientData, interp, name1, name2, flags)
  172.     ClientData clientData;    /* Contains information about the link. */
  173.     Tcl_Interp *interp;        /* Interpreter containing Tcl variable. */
  174.     char *name1;        /* First part of variable name. */
  175.     char *name2;        /* Second part of variable name. */
  176.     int flags;            /* Miscellaneous additional information. */
  177. {
  178.     Link *linkPtr = (Link *) clientData;
  179.     int changed;
  180.     char buffer[TCL_DOUBLE_SPACE];
  181.     char *value, **pp;
  182.     Tcl_DString savedResult;
  183.  
  184.     /*
  185.      * If the variable is being unset, then just re-create it (with a
  186.      * trace) unless the whole interpreter is going away.
  187.      */
  188.  
  189.     if (flags & TCL_TRACE_UNSETS) {
  190.     if (flags & TCL_INTERP_DESTROYED) {
  191.         ckfree(linkPtr->varName);
  192.         ckfree((char *) linkPtr);
  193.     } else if (flags & TCL_TRACE_DESTROYED) {
  194.         Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
  195.             TCL_GLOBAL_ONLY);
  196.         Tcl_TraceVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY
  197.             |TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  198.             LinkTraceProc, (ClientData) linkPtr);
  199.     }
  200.     return NULL;
  201.     }
  202.  
  203.     /*
  204.      * For read accesses, update the Tcl variable if the C variable
  205.      * has changed since the last time we updated the Tcl variable.
  206.      */
  207.  
  208.     if (flags & TCL_TRACE_READS) {
  209.     switch (linkPtr->type) {
  210.         case TCL_LINK_INT:
  211.         case TCL_LINK_BOOLEAN:
  212.         changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
  213.         break;
  214.         case TCL_LINK_DOUBLE:
  215.         changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
  216.         break;
  217.         case TCL_LINK_STRING:
  218.         changed = 1;
  219.         break;
  220.         default:
  221.         return "internal error: bad linked variable type";
  222.     }
  223.     if (changed) {
  224.         Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
  225.             TCL_GLOBAL_ONLY);
  226.     }
  227.     return NULL;
  228.     }
  229.  
  230.     /*
  231.      * For writes, first make sure that the variable is writable.  Then
  232.      * convert the Tcl value to C if possible.  If the variable isn't
  233.      * writable or can't be converted, then restore the varaible's old
  234.      * value and return an error.  Another tricky thing: we have to save
  235.      * and restore the interpreter's result, since the variable access
  236.      * could occur when the result has been partially set.
  237.      */
  238.  
  239.     if (!linkPtr->writable) {
  240.     Tcl_SetVar(interp, linkPtr->varName, StringValue(linkPtr, buffer),
  241.         TCL_GLOBAL_ONLY);
  242.     return "linked variable is read-only";
  243.     }
  244.     value = Tcl_GetVar(interp, linkPtr->varName, TCL_GLOBAL_ONLY);
  245.     if (value == NULL) {
  246.     /*
  247.      * This shouldn't ever happen.
  248.      */
  249.     return "internal error: linked variable couldn't be read";
  250.     }
  251.     Tcl_DStringInit(&savedResult);
  252.     Tcl_DStringAppend(&savedResult, interp->result, -1);
  253.     Tcl_ResetResult(interp);
  254.     switch (linkPtr->type) {
  255.     case TCL_LINK_INT:
  256.         if (Tcl_GetInt(interp, value, &linkPtr->lastValue.i) != TCL_OK) {
  257.         Tcl_DStringResult(interp, &savedResult);
  258.         Tcl_SetVar(interp, linkPtr->varName,
  259.             StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
  260.         return "variable must have integer value";
  261.         }
  262.         *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
  263.         break;
  264.     case TCL_LINK_DOUBLE:
  265.         if (Tcl_GetDouble(interp, value, &linkPtr->lastValue.d)
  266.             != TCL_OK) {
  267.         Tcl_DStringResult(interp, &savedResult);
  268.         Tcl_SetVar(interp, linkPtr->varName,
  269.             StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
  270.         return "variable must have real value";
  271.         }
  272.         *(double *)(linkPtr->addr) = linkPtr->lastValue.d;
  273.         break;
  274.     case TCL_LINK_BOOLEAN:
  275.         if (Tcl_GetBoolean(interp, value, &linkPtr->lastValue.i)
  276.             != TCL_OK) {
  277.         Tcl_DStringResult(interp, &savedResult);
  278.         Tcl_SetVar(interp, linkPtr->varName,
  279.             StringValue(linkPtr, buffer), TCL_GLOBAL_ONLY);
  280.         return "variable must have boolean value";
  281.         }
  282.         *(int *)(linkPtr->addr) = linkPtr->lastValue.i;
  283.         break;
  284.     case TCL_LINK_STRING:
  285.         pp = (char **)(linkPtr->addr);
  286.         if (*pp != NULL) {
  287.         ckfree(*pp);
  288.         }
  289.         *pp = ckalloc((unsigned) (strlen(value) + 1));
  290.         strcpy(*pp, value);
  291.         break;
  292.     default:
  293.         return "internal error: bad linked variable type";
  294.     }
  295.     Tcl_DStringResult(interp, &savedResult);
  296.     return NULL;
  297. }
  298.  
  299. /*
  300.  *----------------------------------------------------------------------
  301.  *
  302.  * StringValue --
  303.  *
  304.  *    Converts the value of a C variable to a string for use in a
  305.  *    Tcl variable to which it is linked.
  306.  *
  307.  * Results:
  308.  *    The return value is a pointer
  309.  to a string that represents
  310.  *    the value of the C variable given by linkPtr.
  311.  *
  312.  * Side effects:
  313.  *    None.
  314.  *
  315.  *----------------------------------------------------------------------
  316.  */
  317.  
  318. static char *
  319. StringValue(linkPtr, buffer)
  320.     Link *linkPtr;        /* Structure describing linked variable. */
  321.     char *buffer;        /* Small buffer to use for converting
  322.                  * values.  Must have TCL_DOUBLE_SPACE
  323.                  * bytes or more. */
  324. {
  325.     char *p;
  326.  
  327.     switch (linkPtr->type) {
  328.     case TCL_LINK_INT:
  329.         linkPtr->lastValue.i = *(int *)(linkPtr->addr);
  330.         sprintf(buffer, "%d", linkPtr->lastValue.i);
  331.         return buffer;
  332.     case TCL_LINK_DOUBLE:
  333.         linkPtr->lastValue.d = *(double *)(linkPtr->addr);
  334.         Tcl_PrintDouble(linkPtr->interp, linkPtr->lastValue.d, buffer);
  335.         return buffer;
  336.     case TCL_LINK_BOOLEAN:
  337.         linkPtr->lastValue.i = *(int *)(linkPtr->addr);
  338.         if (linkPtr->lastValue.i != 0) {
  339.         return "1";
  340.         }
  341.         return "0";
  342.     case TCL_LINK_STRING:
  343.         p = *(char **)(linkPtr->addr);
  344.         if (p == NULL) {
  345.         return "NULL";
  346.         }
  347.         return p;
  348.     }
  349.  
  350.     /*
  351.      * This code only gets executed if the link type is unknown
  352.      * (shouldn't ever happen).
  353.      */
  354.  
  355.     return "??";
  356. }
  357.