Logo Search packages:      
Sourcecode: xcircuit version File versions

tkSimple.c

/* 
 *-----------------------------------------------------------------------
 * tkSimple.c --
 *
 *   Implementation of a Very simple window which relies on C code for
 *   almost all of its event handlers.
 *
 *-----------------------------------------------------------------------
 */

#ifdef TCL_WRAPPER

#include <stdio.h>
#include <stdlib.h>

#include <tk.h>

/* Backwards compatibility to tk8.3 and earlier */
#if TK_MAJOR_VERSION == 8
  #if TK_MINOR_VERSION <= 3
    #define Tk_SetClassProcs(a,b,c) TkSetClassProcs(a,b,c)
  #endif
#endif

/*
 * A data structure of the following type is kept for each
 * simple that currently exists for this process:
 */

typedef struct {
    Tk_Window tkwin;          /* Window that embodies the simple.  NULL
                         * means that the window has been destroyed
                         * but the data structures haven't yet been
                         * cleaned up. */
    Display *display;         /* Display containing widget.  Used, among
                         * other things, so that resources can be
                         * freed even after tkwin has gone away. */
    Tcl_Interp *interp;       /* Interpreter associated with widget.  Used
                         * to delete widget command. */
    Tcl_Command widgetCmd;    /* Token for simple's widget command. */
    char *className;          /* Class name for widget (from configuration
                         * option).  Malloc-ed. */
    int width;                /* Width to request for window.  <= 0 means
                         * don't request any size. */
    int height;               /* Height to request for window.  <= 0 means
                         * don't request any size. */
    XColor *background;       /* background pixel used by XClearArea */
    char *useThis;            /* If the window is embedded, this points to
                         * the name of the window in which it is
                         * embedded (malloc'ed).  For non-embedded
                         * windows this is NULL. */
    char *mydata;       /* This space for hire. */
    int flags;                /* Various flags;  see below for
                         * definitions. */
} Simple;

/*
 * Flag bits for simples:
 *
 * GOT_FOCUS:                 Non-zero means this widget currently
 *                      has the input focus.
 */

#define GOT_FOCUS       1

static Tk_ConfigSpec configSpecs[] = {
    {TK_CONFIG_COLOR, "-background", "background", "Background",
      "White", Tk_Offset(Simple, background), 0},
    {TK_CONFIG_SYNONYM, "-bg", "background", (char *)NULL,
      (char *)NULL, 0, 0},
    {TK_CONFIG_PIXELS, "-height", "height", "Height",
      "0", Tk_Offset(Simple, height), 0},
    {TK_CONFIG_PIXELS, "-width", "width", "Width",
      "0", Tk_Offset(Simple, width), 0},
    {TK_CONFIG_STRING, "-use", "use", "Use",
      "", Tk_Offset(Simple, useThis), TK_CONFIG_NULL_OK},
    {TK_CONFIG_STRING, "-data", "data", "Data",
      "", Tk_Offset(Simple, mydata), TK_CONFIG_NULL_OK},
    {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
      (char *) NULL, 0, 0}
};

/*
 * Forward declarations for procedures defined later in this file:
 */

static int        ConfigureSimple _ANSI_ARGS_((Tcl_Interp *interp,
                      Simple *simplePtr, int objc, Tcl_Obj *CONST objv[],
                      int flags));
static void       DestroySimple _ANSI_ARGS_((char *memPtr));
static void       SimpleCmdDeletedProc _ANSI_ARGS_((
                      ClientData clientData));
static void       SimpleEventProc _ANSI_ARGS_((ClientData clientData,
                      XEvent *eventPtr));
static int        SimpleWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
                      Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));


/*
 *--------------------------------------------------------------
 *
 * Tk_SimpleObjCmd --
 *
 *    This procedure is invoked to process the "simple"
 *    Tcl command.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    See the user documentation.  These procedures are just wrappers;
 *    they call ButtonCreate to do all of the real work.
 *
 *--------------------------------------------------------------
 */

int
Tk_SimpleObjCmd(clientData, interp, objc, objv)
    ClientData clientData;    /* Main window associated with
                         * interpreter. */
    Tcl_Interp *interp;       /* Current interpreter. */
    int objc;                 /* Number of arguments. */
    Tcl_Obj *CONST objv[];    /* Argument objects. */
{
    Tk_Window tkwin = (Tk_Window) clientData;
    Simple *simplePtr;
    Tk_Window new;
    char *arg, *useOption;
    int i, c, depth;
    size_t length;
    unsigned int mask;

    if (objc < 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
      return TCL_ERROR;
    }

    /*
     * Pre-process the argument list.  Scan through it to find any
     * "-use" option.
     */

    useOption = NULL;
    for (i = 2; i < objc; i += 2) {
      arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
      if (length < 2) {
          continue;
      }
      c = arg[1];
      if ((c == 'u') && (strncmp(arg, "-use", length) == 0)) {
          useOption = Tcl_GetString(objv[i+1]);
      }
    }

    /*
     * Create the window, and deal with the special option -use.
     */

    if (tkwin != NULL) {
      new = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]),
            NULL);
    }
    if (new == NULL) {
      goto error;
    }
    Tk_SetClass(new, "Simple");
    if (useOption == NULL) {
      useOption = Tk_GetOption(new, "use", "Use");
    }
    if (useOption != NULL) {
      if (TkpUseWindow(interp, new, useOption) != TCL_OK) {
          goto error;
      }
    }

    /*
     * Create the widget record, process configuration options, and
     * create event handlers.  Then fill in a few additional fields
     * in the widget record from the special options.
     */

    simplePtr = (Simple *) ckalloc(sizeof(Simple));
    simplePtr->tkwin = new;
    simplePtr->display = Tk_Display(new);
    simplePtr->interp = interp;
    simplePtr->widgetCmd = Tcl_CreateObjCommand(interp,
          Tk_PathName(new), SimpleWidgetObjCmd,
          (ClientData) simplePtr, SimpleCmdDeletedProc);
    simplePtr->className = NULL;
    simplePtr->width = 0;
    simplePtr->height = 0;
    simplePtr->background = NULL;
    simplePtr->useThis = NULL;
    simplePtr->flags = 0;
    simplePtr->mydata = NULL;

    /*
     * Store backreference to simple widget in window structure.
     */
    Tk_SetClassProcs(new, NULL, (ClientData) simplePtr);

    /* We only handle focus and structure events, and even that might change. */
    mask = StructureNotifyMask|FocusChangeMask;
    Tk_CreateEventHandler(new, mask, SimpleEventProc, (ClientData) simplePtr);

    if (ConfigureSimple(interp, simplePtr, objc-2, objv+2, 0) != TCL_OK) {
      goto error;
    }
    Tcl_SetResult(interp, Tk_PathName(new), TCL_STATIC);
    return TCL_OK;

    error:
    if (new != NULL) {
      Tk_DestroyWindow(new);
    }
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * SimpleWidgetObjCmd --
 *
 *    This procedure is invoked to process the Tcl command
 *    that corresponds to a simple widget.  See the user
 *    documentation for details on what it does.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    See the user documentation.
 *
 *--------------------------------------------------------------
 */

static int
SimpleWidgetObjCmd(clientData, interp, objc, objv)
    ClientData clientData;    /* Information about simple widget. */
    Tcl_Interp *interp;       /* Current interpreter. */
    int objc;                 /* Number of arguments. */
    Tcl_Obj *CONST objv[];    /* Argument objects. */
{
    static char *simpleOptions[] = {
      "cget", "configure", (char *) NULL
    };
    enum options {
      SIMPLE_CGET, SIMPLE_CONFIGURE
    };
    register Simple *simplePtr = (Simple *) clientData;
    int result = TCL_OK, index;
    size_t length;
    int c, i;

    if (objc < 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
      return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], simpleOptions, "option", 0,
          &index) != TCL_OK) {
      return TCL_ERROR;
    }
    Tcl_Preserve((ClientData) simplePtr);
    switch ((enum options) index) {
      case SIMPLE_CGET: {
      if (objc != 3) {
          Tcl_WrongNumArgs(interp, 2, objv, "option");
          result = TCL_ERROR;
          goto done;
      }
      result = Tk_ConfigureValue(interp, simplePtr->tkwin, configSpecs,
            (char *) simplePtr, Tcl_GetString(objv[2]), 0);
      break;
      }
      case SIMPLE_CONFIGURE: {
      if (objc == 2) {
          result = Tk_ConfigureInfo(interp, simplePtr->tkwin, configSpecs,
                (char *) simplePtr, (char *) NULL, 0);
      } else if (objc == 3) {
          result = Tk_ConfigureInfo(interp, simplePtr->tkwin, configSpecs,
                (char *) simplePtr, Tcl_GetString(objv[2]), 0);
      } else {
          for (i = 2; i < objc; i++) {
            char *arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
            if (length < 2) {
                continue;
            }
            c = arg[1];
            if ((c == 'u') && (strncmp(arg, "-use", length) == 0)) {
                Tcl_AppendResult(interp, "can't modify ", arg,
                      " option after widget is created", (char *) NULL);
                result = TCL_ERROR;
                goto done;
            }
          }
          result = ConfigureSimple(interp, simplePtr, objc-2, objv+2,
                TK_CONFIG_ARGV_ONLY);
      }
      break;
      }
    }

    done:
    Tcl_Release((ClientData) simplePtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DestroySimple --
 *
 *    This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
 *    to clean up the internal structure of a simple at a safe time
 *    (when no-one is using it anymore).
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Everything associated with the simple is freed up.
 *
 *----------------------------------------------------------------------
 */

static void
DestroySimple(memPtr)
    char *memPtr;       /* Info about simple widget. */
{
    register Simple *simplePtr = (Simple *) memPtr;

    Tk_FreeOptions(configSpecs, (char *) simplePtr, simplePtr->display,
          TK_CONFIG_USER_BIT);
    ckfree((char *) simplePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ConfigureSimple --
 *
 *    This procedure is called to process an objv/objc list, plus
 *    the Tk option database, in order to configure (or
 *    reconfigure) a simple widget.
 *
 * Results:
 *    The return value is a standard Tcl result.  If TCL_ERROR is
 *    returned, then the interp's result contains an error message.
 *
 * Side effects:
 *    Configuration information, such as text string, colors, font,
 *    etc. get set for simplePtr;  old resources get freed, if there
 *    were any.
 *
 *----------------------------------------------------------------------
 */

static int
ConfigureSimple(interp, simplePtr, objc, objv, flags)
    Tcl_Interp *interp;       /* Used for error reporting. */
    register Simple *simplePtr;     /* Information about widget;  may or may
                         * not already have values for some fields. */
    int objc;                 /* Number of valid entries in objv. */
    Tcl_Obj *CONST objv[];    /* Arguments. */
    int flags;                /* Flags to pass to Tk_ConfigureWidget. */
{
    char *oldMenuName;
    
    if (Tk_ConfigureWidget(interp, simplePtr->tkwin, configSpecs,
          objc, (char **) objv, (char *) simplePtr,
          flags | TK_CONFIG_OBJS) != TCL_OK) {
      return TCL_ERROR;
    }

    if ((simplePtr->width > 0) || (simplePtr->height > 0)) {
      Tk_GeometryRequest(simplePtr->tkwin, simplePtr->width,
            simplePtr->height);
    }

    if (simplePtr->background != NULL) {
      Tk_SetWindowBackground(simplePtr->tkwin, simplePtr->background->pixel);
    }

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * SimpleEventProc --
 *
 *    This procedure is invoked by the Tk dispatcher on
 *    structure changes to a simple.  For simples with 3D
 *    borders, this procedure is also invoked for exposures.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    When the window gets deleted, internal structures get
 *    cleaned up.  When it gets exposed, it is redisplayed.
 *
 *--------------------------------------------------------------
 */

static void
SimpleEventProc(clientData, eventPtr)
    ClientData clientData;    /* Information about window. */
    register XEvent *eventPtr;      /* Information about event. */
{
    register Simple *simplePtr = (Simple *) clientData;

    if (eventPtr->type == DestroyNotify) {
      if (simplePtr->tkwin != NULL) {

          /*
           * If this window is a container, then this event could be
           * coming from the embedded application, in which case
           * Tk_DestroyWindow hasn't been called yet.  When Tk_DestroyWindow
           * is called later, then another destroy event will be generated.
           * We need to be sure we ignore the second event, since the simple
           * could be gone by then.  To do so, delete the event handler
           * explicitly (normally it's done implicitly by Tk_DestroyWindow).
           */
    
          Tk_DeleteEventHandler(simplePtr->tkwin,
                StructureNotifyMask | FocusChangeMask,
                SimpleEventProc, (ClientData) simplePtr);
          simplePtr->tkwin = NULL;
            Tcl_DeleteCommandFromToken(simplePtr->interp, simplePtr->widgetCmd);
      }
      Tcl_EventuallyFree((ClientData) simplePtr, DestroySimple);
    } else if (eventPtr->type == FocusIn) {
      if (eventPtr->xfocus.detail != NotifyInferior) {
          simplePtr->flags |= GOT_FOCUS;
      }
    } else if (eventPtr->type == FocusOut) {
      if (eventPtr->xfocus.detail != NotifyInferior) {
          simplePtr->flags &= ~GOT_FOCUS;
      }
    }
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * SimpleCmdDeletedProc --
 *
 *    This procedure is invoked when a widget command is deleted.  If
 *    the widget isn't already in the process of being destroyed,
 *    this command destroys it.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The widget is destroyed.
 *
 *----------------------------------------------------------------------
 */

static void
SimpleCmdDeletedProc(clientData)
    ClientData clientData;    /* Pointer to widget record for widget. */
{
    Simple *simplePtr = (Simple *) clientData;
    Tk_Window tkwin = simplePtr->tkwin;

    /*
     * This procedure could be invoked either because the window was
     * destroyed and the command was then deleted (in which case tkwin
     * is NULL) or because the command was deleted, and then this procedure
     * destroys the widget.
     */

    if (tkwin != NULL) {
      simplePtr->tkwin = NULL;
      Tk_DestroyWindow(tkwin);
    }
}

#endif /* TCL_WRAPPER */

Generated by  Doxygen 1.6.0   Back to index