tkSimple.c

   1 /*
   2  *-----------------------------------------------------------------------
   3  * tkSimple.c --
   4  *
   5  *   Implementation of a Very simple window which relies on C code for
   6  *   almost all of its event handlers.
   7  *
   8  *-----------------------------------------------------------------------
   9  */
  10
  11 #ifdef TCL_WRAPPER
  12
  13 #include <stdio.h>
  14 #include <stdlib.h>
  15 #include <string.h>
  16
  17 #include <tk.h>
  18 /*
  19 #include <tkInt.h>
  20 #include <tkIntDecls.h>     not portable! (jdk)
  21     this trick seems very broken on my machine so:
  22 declare this thing here, and hope the linker can resolve it
  23 */
  24 EXTERN int              TkpUseWindow _ANSI_ARGS_((Tcl_Interp * interp,
  25                                 Tk_Window tkwin, CONST char * string));
  26
  27 /* Backwards compatibility to tk8.3 and earlier */
  28 #if TK_MAJOR_VERSION == 8
  29   #if TK_MINOR_VERSION <= 3
  30     #define Tk_SetClassProcs(a,b,c) TkSetClassProcs(a,b,c)
  31   #endif
  32 #endif
  33
  34 #ifndef CONST84
  35 #define CONST84
  36 #endif
  37
  38 /*
  39  * A data structure of the following type is kept for each
  40  * simple that currently exists for this process:
  41  */
  42
  43 typedef struct {
  44     Tk_Window tkwin;            /* Window that embodies the simple.  NULL
  45                                  * means that the window has been destroyed
  46                                  * but the data structures haven't yet been
  47                                  * cleaned up. */
  48     Display *display;           /* Display containing widget.  Used, among
  49                                  * other things, so that resources can be
  50                                  * freed even after tkwin has gone away. */
  51     Tcl_Interp *interp;         /* Interpreter associated with widget.  Used
  52                                  * to delete widget command. */
  53     Tcl_Command widgetCmd;      /* Token for simple's widget command. */
  54     char *className;            /* Class name for widget (from configuration
  55                                  * option).  Malloc-ed. */
  56     int width;                  /* Width to request for window.  <= 0 means
  57                                  * don't request any size. */
  58     int height;                 /* Height to request for window.  <= 0 means
  59                                  * don't request any size. */
  60     XColor *background;         /* background pixel used by XClearArea */
  61     char *useThis;              /* If the window is embedded, this points to
  62                                  * the name of the window in which it is
  63                                  * embedded (malloc'ed).  For non-embedded
  64                                  * windows this is NULL. */
  65     char *exitProc;             /* Callback procedure upon window deletion. */
  66     char *commandProc;          /* Callback procedure for commands sent to the window */
  67     char *mydata;               /* This space for hire. */
  68     int flags;                  /* Various flags;  see below for
  69                                  * definitions. */
  70 } Simple;
  71
  72 /*
  73  * Flag bits for simples:
  74  *
  75  * GOT_FOCUS:   non-zero means this widget currently has the input focus.
  76  */
  77
  78 #define GOT_FOCUS               1
  79
  80 static Tk_ConfigSpec configSpecs[] = {
  81     {TK_CONFIG_COLOR, "-background", "background", "Background",
  82         "White", Tk_Offset(Simple, background), 0},
  83     {TK_CONFIG_SYNONYM, "-bg", "background", (char *)NULL,
  84         (char *)NULL, 0, 0},
  85     {TK_CONFIG_PIXELS, "-height", "height", "Height",
  86         "0", Tk_Offset(Simple, height), 0},
  87     {TK_CONFIG_PIXELS, "-width", "width", "Width",
  88         "0", Tk_Offset(Simple, width), 0},
  89     {TK_CONFIG_STRING, "-use", "use", "Use",
  90         "", Tk_Offset(Simple, useThis), TK_CONFIG_NULL_OK},
  91     {TK_CONFIG_STRING, "-exitproc", "exitproc", "ExitProc",
  92         "", Tk_Offset(Simple, exitProc), TK_CONFIG_NULL_OK},
  93     {TK_CONFIG_STRING, "-commandproc", "commandproc", "CommandProc",
  94         "", Tk_Offset(Simple, commandProc), TK_CONFIG_NULL_OK},
  95     {TK_CONFIG_STRING, "-data", "data", "Data",
  96         "", Tk_Offset(Simple, mydata), TK_CONFIG_NULL_OK},
  97     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
  98         (char *) NULL, 0, 0}
  99 };
 100
 101 /*
 102  * Forward declarations for procedures defined later in this file:
 103  */
 104
 105 static int              ConfigureSimple _ANSI_ARGS_((Tcl_Interp *interp,
 106                             Simple *simplePtr, int objc, Tcl_Obj *CONST objv[],
 107                             int flags));
 108 static void             DestroySimple _ANSI_ARGS_((char *memPtr));
 109 static void             SimpleCmdDeletedProc _ANSI_ARGS_((
 110                             ClientData clientData));
 111 static void             SimpleEventProc _ANSI_ARGS_((ClientData clientData,
 112                             XEvent *eventPtr));
 113 static int              SimpleWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
 114                             Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 115 \f
 116
 117 /*
 118  *--------------------------------------------------------------
 119  *
 120  * Tk_SimpleObjCmd --
 121  *
 122  *      This procedure is invoked to process the "simple"
 123  *      Tcl command.
 124  *
 125  * Results:
 126  *      A standard Tcl result.
 127  *
 128  * Side effects:
 129  *      See the user documentation.  These procedures are just wrappers;
 130  *      they call ButtonCreate to do all of the real work.
 131  *
 132  *--------------------------------------------------------------
 133  */
 134
 135 int
 136 Tk_SimpleObjCmd(clientData, interp, objc, objv)
 137     ClientData clientData;      /* Main window associated with
 138                                  * interpreter. */
 139     Tcl_Interp *interp;         /* Current interpreter. */
 140     int objc;                   /* Number of arguments. */
 141     Tcl_Obj *CONST objv[];      /* Argument objects. */
 142 {
 143     Tk_Window tkwin = (Tk_Window) clientData;
 144     Simple *simplePtr;
 145     Tk_Window new;
 146     char *arg, *useOption;
 147     int i, c;  /* , depth; (jdk) */
 148     size_t length;
 149     unsigned int mask;
 150
 151     if (objc < 2) {
 152         Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
 153         return TCL_ERROR;
 154     }
 155
 156     /*
 157      * Pre-process the argument list.  Scan through it to find any
 158      * "-use" option, or the "-main" option.  If the "-main" option
 159      * is selected, then the application will exit if this window
 160      * is deleted.
 161      */
 162
 163     useOption = NULL;
 164     for (i = 2; i < objc; i += 2) {
 165         arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
 166         if (length < 2) {
 167             continue;
 168         }
 169         c = arg[1];
 170         if ((c == 'u') && (strncmp(arg, "-use", length) == 0)) {
 171             useOption = Tcl_GetString(objv[i+1]);
 172         }
 173     }
 174
 175     /*
 176      * Create the window, and deal with the special option -use.
 177      */
 178
 179     if (tkwin != NULL) {
 180         new = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]),
 181                 NULL);
 182     }
 183     if (new == NULL) {
 184         goto error;
 185     }
 186     Tk_SetClass(new, "Simple");
 187     if (useOption == NULL) {
 188         useOption = (char *)Tk_GetOption(new, "use", "Use");
 189     }
 190     if (useOption != NULL) {
 191         if (TkpUseWindow(interp, new, useOption) != TCL_OK) {
 192             goto error;
 193         }
 194     }
 195
 196     /*
 197      * Create the widget record, process configuration options, and
 198      * create event handlers.  Then fill in a few additional fields
 199      * in the widget record from the special options.
 200      */
 201
 202     simplePtr = (Simple *) ckalloc(sizeof(Simple));
 203     simplePtr->tkwin = new;
 204     simplePtr->display = Tk_Display(new);
 205     simplePtr->interp = interp;
 206     simplePtr->widgetCmd = Tcl_CreateObjCommand(interp,
 207             Tk_PathName(new), SimpleWidgetObjCmd,
 208             (ClientData) simplePtr, SimpleCmdDeletedProc);
 209     simplePtr->className = NULL;
 210     simplePtr->width = 0;
 211     simplePtr->height = 0;
 212     simplePtr->background = NULL;
 213     simplePtr->useThis = NULL;
 214     simplePtr->exitProc = NULL;
 215     simplePtr->commandProc = NULL;
 216     simplePtr->flags = 0;
 217     simplePtr->mydata = NULL;
 218
 219     /*
 220      * Store backreference to simple widget in window structure.
 221      */
 222     Tk_SetClassProcs(new, NULL, (ClientData) simplePtr);
 223
 224     /* We only handle focus and structure events, and even that might change. */
 225     mask = StructureNotifyMask|FocusChangeMask|NoEventMask;
 226     Tk_CreateEventHandler(new, mask, SimpleEventProc, (ClientData) simplePtr);
 227
 228     if (ConfigureSimple(interp, simplePtr, objc-2, objv+2, 0) != TCL_OK) {
 229         goto error;
 230     }
 231     Tcl_SetResult(interp, Tk_PathName(new), TCL_STATIC);
 232     return TCL_OK;
 233
 234     error:
 235     if (new != NULL) {
 236         Tk_DestroyWindow(new);
 237     }
 238     return TCL_ERROR;
 239 }
 240 \f
 241 /*
 242  *--------------------------------------------------------------
 243  *
 244  * SimpleWidgetObjCmd --
 245  *
 246  *      This procedure is invoked to process the Tcl command
 247  *      that corresponds to a simple widget.  See the user
 248  *      documentation for details on what it does.  If the
 249  *      "-commandProc" option has been set for the window,
 250  *      then any unknown command (neither "cget" nor "configure")
 251  *      will execute the command procedure first, then attempt
 252  *      to execute the remainder of the command as an independent
 253  *      Tcl command.
 254  *
 255  * Results:
 256  *      A standard Tcl result.
 257  *
 258  * Side effects:
 259  *      See the user documentation.
 260  *
 261  *--------------------------------------------------------------
 262  */
 263
 264 static int
 265 SimpleWidgetObjCmd(clientData, interp, objc, objv)
 266     ClientData clientData;      /* Information about simple widget. */
 267     Tcl_Interp *interp;         /* Current interpreter. */
 268     int objc;                   /* Number of arguments. */
 269     Tcl_Obj *CONST objv[];      /* Argument objects. */
 270 {
 271     static char *simpleOptions[] = {
 272         "cget", "configure", (char *) NULL
 273     };
 274     enum options {
 275         SIMPLE_CGET, SIMPLE_CONFIGURE
 276     };
 277     register Simple *simplePtr = (Simple *) clientData;
 278     int result = TCL_OK, index;
 279     size_t length;
 280     int c, i;
 281
 282     if (objc < 2) {
 283         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
 284         return TCL_ERROR;
 285     }
 286     if (Tcl_GetIndexFromObj(interp, objv[1],
 287                 (CONST84 char **)simpleOptions, "option", 0,
 288                 &index) != TCL_OK) {
 289         if (simplePtr->commandProc != NULL) {
 290            Tcl_ResetResult(simplePtr->interp);
 291            if (Tcl_EvalEx(simplePtr->interp, simplePtr->commandProc, -1, 0)
 292                         != TCL_OK)
 293               return TCL_ERROR;
 294            else
 295               return Tcl_EvalObjv(simplePtr->interp, --objc, ++objv, TCL_EVAL_DIRECT);
 296         }
 297         else
 298            return TCL_ERROR;
 299     }
 300     Tcl_Preserve((ClientData) simplePtr);
 301     switch ((enum options) index) {
 302       case SIMPLE_CGET: {
 303         if (objc != 3) {
 304             Tcl_WrongNumArgs(interp, 2, objv, "option");
 305             result = TCL_ERROR;
 306             goto done;
 307         }
 308         result = Tk_ConfigureValue(interp, simplePtr->tkwin, configSpecs,
 309                 (char *) simplePtr, Tcl_GetString(objv[2]), 0);
 310         break;
 311       }
 312       case SIMPLE_CONFIGURE: {
 313         if (objc == 2) {
 314             result = Tk_ConfigureInfo(interp, simplePtr->tkwin, configSpecs,
 315                     (char *) simplePtr, (char *) NULL, 0);
 316         } else if (objc == 3) {
 317             result = Tk_ConfigureInfo(interp, simplePtr->tkwin, configSpecs,
 318                     (char *) simplePtr, Tcl_GetString(objv[2]), 0);
 319         } else {
 320             for (i = 2; i < objc; i++) {
 321                 char *arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
 322                 if (length < 2) {
 323                     continue;
 324                 }
 325                 c = arg[1];
 326                 if ((c == 'u') && (strncmp(arg, "-use", length) == 0)) {
 327                     Tcl_AppendResult(interp, "can't modify ", arg,
 328                             " option after widget is created", (char *) NULL);
 329                     result = TCL_ERROR;
 330                     goto done;
 331                 }
 332             }
 333             result = ConfigureSimple(interp, simplePtr, objc-2, objv+2,
 334                     TK_CONFIG_ARGV_ONLY);
 335         }
 336         break;
 337       }
 338     }
 339
 340     done:
 341     Tcl_Release((ClientData) simplePtr);
 342     return result;
 343 }
 344 \f
 345 /*
 346  *----------------------------------------------------------------------
 347  *
 348  * DestroySimple --
 349  *
 350  *      This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
 351  *      to clean up the internal structure of a simple at a safe time
 352  *      (when no-one is using it anymore).
 353  *
 354  * Results:
 355  *      None.
 356  *
 357  * Side effects:
 358  *      Everything associated with the simple is freed up.
 359  *
 360  *----------------------------------------------------------------------
 361  */
 362
 363 static void
 364 DestroySimple(memPtr)
 365     char *memPtr;               /* Info about simple widget. */
 366 {
 367     register Simple *simplePtr = (Simple *) memPtr;
 368
 369     Tk_FreeOptions(configSpecs, (char *) simplePtr, simplePtr->display,
 370             TK_CONFIG_USER_BIT);
 371     if (simplePtr->exitProc != NULL) {
 372         /* Call the exit procedure */
 373         Tcl_EvalEx(simplePtr->interp, simplePtr->exitProc, -1, 0);
 374     }
 375     ckfree((char *) simplePtr);
 376 }
 377 \f
 378 /*
 379  *----------------------------------------------------------------------
 380  *
 381  * ConfigureSimple --
 382  *
 383  *      This procedure is called to process an objv/objc list, plus
 384  *      the Tk option database, in order to configure (or
 385  *      reconfigure) a simple widget.
 386  *
 387  * Results:
 388  *      The return value is a standard Tcl result.  If TCL_ERROR is
 389  *      returned, then the interp's result contains an error message.
 390  *
 391  * Side effects:
 392  *      Configuration information, such as text string, colors, font,
 393  *      etc. get set for simplePtr;  old resources get freed, if there
 394  *      were any.
 395  *
 396  *----------------------------------------------------------------------
 397  */
 398
 399 static int
 400 ConfigureSimple(interp, simplePtr, objc, objv, flags)
 401     Tcl_Interp *interp;         /* Used for error reporting. */
 402     register Simple *simplePtr; /* Information about widget;  may or may
 403                                  * not already have values for some fields. */
 404     int objc;                   /* Number of valid entries in objv. */
 405     Tcl_Obj *CONST objv[];      /* Arguments. */
 406     int flags;                  /* Flags to pass to Tk_ConfigureWidget. */
 407 {
 408   /* char *oldMenuName; (jdk) */
 409
 410     if (Tk_ConfigureWidget(interp, simplePtr->tkwin, configSpecs,
 411             objc, (CONST84 char **) objv, (char *) simplePtr,
 412             flags | TK_CONFIG_OBJS) != TCL_OK) {
 413         return TCL_ERROR;
 414     }
 415
 416     if ((simplePtr->width > 0) || (simplePtr->height > 0)) {
 417         Tk_GeometryRequest(simplePtr->tkwin, simplePtr->width,
 418                 simplePtr->height);
 419     }
 420
 421     if (simplePtr->background != NULL) {
 422         Tk_SetWindowBackground(simplePtr->tkwin, simplePtr->background->pixel);
 423     }
 424
 425     return TCL_OK;
 426 }
 427 \f
 428 /*
 429  *--------------------------------------------------------------
 430  *
 431  * SimpleEventProc --
 432  *
 433  *      This procedure is invoked by the Tk dispatcher on
 434  *      structure changes to a simple.  For simples with 3D
 435  *      borders, this procedure is also invoked for exposures.
 436  *
 437  * Results:
 438  *      None.
 439  *
 440  * Side effects:
 441  *      When the window gets deleted, internal structures get
 442  *      cleaned up.  When it gets exposed, it is redisplayed.
 443  *
 444  *--------------------------------------------------------------
 445  */
 446
 447 static void
 448 SimpleEventProc(clientData, eventPtr)
 449     ClientData clientData;      /* Information about window. */
 450     register XEvent *eventPtr;  /* Information about event. */
 451 {
 452     register Simple *simplePtr = (Simple *) clientData;
 453
 454     if (eventPtr->type == DestroyNotify) {
 455         if (simplePtr->tkwin != NULL) {
 456
 457             /*
 458              * If this window is a container, then this event could be
 459              * coming from the embedded application, in which case
 460              * Tk_DestroyWindow hasn't been called yet.  When Tk_DestroyWindow
 461              * is called later, then another destroy event will be generated.
 462              * We need to be sure we ignore the second event, since the simple
 463              * could be gone by then.  To do so, delete the event handler
 464              * explicitly (normally it's done implicitly by Tk_DestroyWindow).
 465              */
 466
 467             Tk_DeleteEventHandler(simplePtr->tkwin,
 468                     StructureNotifyMask | FocusChangeMask,
 469                     SimpleEventProc, (ClientData) simplePtr);
 470             simplePtr->tkwin = NULL;
 471             Tcl_DeleteCommandFromToken(simplePtr->interp, simplePtr->widgetCmd);
 472         }
 473         Tcl_EventuallyFree((ClientData) simplePtr, DestroySimple);
 474     } else if (eventPtr->type == FocusIn) {
 475         if (eventPtr->xfocus.detail != NotifyInferior) {
 476             simplePtr->flags |= GOT_FOCUS;
 477         }
 478     } else if (eventPtr->type == FocusOut) {
 479         if (eventPtr->xfocus.detail != NotifyInferior) {
 480             simplePtr->flags &= ~GOT_FOCUS;
 481         }
 482     }
 483     return;
 484 }
 485 \f
 486 /*
 487  *----------------------------------------------------------------------
 488  *
 489  * SimpleCmdDeletedProc --
 490  *
 491  *      This procedure is invoked when a widget command is deleted.  If
 492  *      the widget isn't already in the process of being destroyed,
 493  *      this command destroys it.
 494  *
 495  * Results:
 496  *      None.
 497  *
 498  * Side effects:
 499  *      The widget is destroyed.
 500  *
 501  *----------------------------------------------------------------------
 502  */
 503
 504 static void
 505 SimpleCmdDeletedProc(clientData)
 506     ClientData clientData;      /* Pointer to widget record for widget. */
 507 {
 508     Simple *simplePtr = (Simple *) clientData;
 509     Tk_Window tkwin = simplePtr->tkwin;
 510
 511     /*
 512      * This procedure could be invoked either because the window was
 513      * destroyed and the command was then deleted (in which case tkwin
 514      * is NULL) or because the command was deleted, and then this procedure
 515      * destroys the widget.
 516      */
 517
 518     if (tkwin != NULL) {
 519         simplePtr->tkwin = NULL;
 520         Tk_DestroyWindow(tkwin);
 521     }
 522 }
 523
 524 #endif /* TCL_WRAPPER */