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