tk/generic/tkUtil.c

   1 /*
   2  * tkUtil.c --
   3  *
   4  *      This file contains miscellaneous utility procedures that
   5  *      are used by the rest of Tk, such as a procedure for drawing
   6  *      a focus highlight.
   7  *
   8  * Copyright (c) 1994 The Regents of the University of California.
   9  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10  *
  11  * See the file "license.terms" for information on usage and redistribution
  12  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13  *
  14  * RCS: @(#) $Id$
  15  */
  16
  17 #include "tkInt.h"
  18 #include "tkPort.h"
  19
  20 /*
  21  * The structure below defines the implementation of the "statekey"
  22  * Tcl object, used for quickly finding a mapping in a TkStateMap.
  23  */
  24
  25 Tcl_ObjType tkStateKeyObjType = {
  26     "statekey",                         /* name */
  27     (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
  28     (Tcl_DupInternalRepProc *) NULL,    /* dupIntRepProc */
  29     (Tcl_UpdateStringProc *) NULL,      /* updateStringProc */
  30     (Tcl_SetFromAnyProc *) NULL         /* setFromAnyProc */
  31 };
  32
  33 \f
  34 /*
  35  *--------------------------------------------------------------
  36  *
  37  * TkStateParseProc --
  38  *
  39  *      This procedure is invoked during option processing to handle
  40  *      the "-state" and "-default" options.
  41  *
  42  * Results:
  43  *      A standard Tcl return value.
  44  *
  45  * Side effects:
  46  *      The state for a given item gets replaced by the state
  47  *      indicated in the value argument.
  48  *
  49  *--------------------------------------------------------------
  50  */
  51
  52 int
  53 TkStateParseProc(clientData, interp, tkwin, value, widgRec, offset)
  54     ClientData clientData;              /* some flags.*/
  55     Tcl_Interp *interp;                 /* Used for reporting errors. */
  56     Tk_Window tkwin;                    /* Window containing canvas widget. */
  57     CONST char *value;                  /* Value of option. */
  58     char *widgRec;                      /* Pointer to record for item. */
  59     int offset;                         /* Offset into item. */
  60 {
  61     int c;
  62     int flags = (int)clientData;
  63     size_t length;
  64
  65     register Tk_State *statePtr = (Tk_State *) (widgRec + offset);
  66
  67     if(value == NULL || *value == 0) {
  68         *statePtr = TK_STATE_NULL;
  69         return TCL_OK;
  70     }
  71
  72     c = value[0];
  73     length = strlen(value);
  74
  75     if ((c == 'n') && (strncmp(value, "normal", length) == 0)) {
  76         *statePtr = TK_STATE_NORMAL;
  77         return TCL_OK;
  78     }
  79     if ((c == 'd') && (strncmp(value, "disabled", length) == 0)) {
  80         *statePtr = TK_STATE_DISABLED;
  81         return TCL_OK;
  82     }
  83     if ((c == 'a') && (flags&1) && (strncmp(value, "active", length) == 0)) {
  84         *statePtr = TK_STATE_ACTIVE;
  85         return TCL_OK;
  86     }
  87     if ((c == 'h') && (flags&2) && (strncmp(value, "hidden", length) == 0)) {
  88         *statePtr = TK_STATE_HIDDEN;
  89         return TCL_OK;
  90     }
  91
  92     Tcl_AppendResult(interp, "bad ", (flags&4)?"-default" : "state",
  93             " value \"", value, "\": must be normal",
  94             (char *) NULL);
  95     if (flags&1) {
  96         Tcl_AppendResult(interp, ", active",(char *) NULL);
  97     }
  98     if (flags&2) {
  99         Tcl_AppendResult(interp, ", hidden",(char *) NULL);
 100     }
 101     if (flags&3) {
 102         Tcl_AppendResult(interp, ",",(char *) NULL);
 103     }
 104     Tcl_AppendResult(interp, " or disabled",(char *) NULL);
 105     *statePtr = TK_STATE_NORMAL;
 106     return TCL_ERROR;
 107 }
 108 \f
 109 /*
 110  *--------------------------------------------------------------
 111  *
 112  * TkStatePrintProc --
 113  *
 114  *      This procedure is invoked by the Tk configuration code
 115  *      to produce a printable string for the "-state"
 116  *      configuration option.
 117  *
 118  * Results:
 119  *      The return value is a string describing the state for
 120  *      the item referred to by "widgRec".  In addition, *freeProcPtr
 121  *      is filled in with the address of a procedure to call to free
 122  *      the result string when it's no longer needed (or NULL to
 123  *      indicate that the string doesn't need to be freed).
 124  *
 125  * Side effects:
 126  *      None.
 127  *
 128  *--------------------------------------------------------------
 129  */
 130
 131 char *
 132 TkStatePrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
 133     ClientData clientData;              /* Ignored. */
 134     Tk_Window tkwin;                    /* Window containing canvas widget. */
 135     char *widgRec;                      /* Pointer to record for item. */
 136     int offset;                         /* Offset into item. */
 137     Tcl_FreeProc **freeProcPtr;         /* Pointer to variable to fill in with
 138                                          * information about how to reclaim
 139                                          * storage for return string. */
 140 {
 141     register Tk_State *statePtr = (Tk_State *) (widgRec + offset);
 142
 143     if (*statePtr==TK_STATE_NORMAL) {
 144         return "normal";
 145     } else if (*statePtr==TK_STATE_DISABLED) {
 146         return "disabled";
 147     } else if (*statePtr==TK_STATE_HIDDEN) {
 148         return "hidden";
 149     } else if (*statePtr==TK_STATE_ACTIVE) {
 150         return "active";
 151     } else {
 152         return "";
 153     }
 154 }
 155 \f
 156 /*
 157  *--------------------------------------------------------------
 158  *
 159  * TkOrientParseProc --
 160  *
 161  *      This procedure is invoked during option processing to handle
 162  *      the "-orient" option.
 163  *
 164  * Results:
 165  *      A standard Tcl return value.
 166  *
 167  * Side effects:
 168  *      The orientation for a given item gets replaced by the orientation
 169  *      indicated in the value argument.
 170  *
 171  *--------------------------------------------------------------
 172  */
 173
 174 int
 175 TkOrientParseProc(clientData, interp, tkwin, value, widgRec, offset)
 176     ClientData clientData;              /* some flags.*/
 177     Tcl_Interp *interp;                 /* Used for reporting errors. */
 178     Tk_Window tkwin;                    /* Window containing canvas widget. */
 179     CONST char *value;                  /* Value of option. */
 180     char *widgRec;                      /* Pointer to record for item. */
 181     int offset;                         /* Offset into item. */
 182 {
 183     int c;
 184     size_t length;
 185
 186     register int *orientPtr = (int *) (widgRec + offset);
 187
 188     if(value == NULL || *value == 0) {
 189         *orientPtr = 0;
 190         return TCL_OK;
 191     }
 192
 193     c = value[0];
 194     length = strlen(value);
 195
 196     if ((c == 'h') && (strncmp(value, "horizontal", length) == 0)) {
 197         *orientPtr = 0;
 198         return TCL_OK;
 199     }
 200     if ((c == 'v') && (strncmp(value, "vertical", length) == 0)) {
 201         *orientPtr = 1;
 202         return TCL_OK;
 203     }
 204     Tcl_AppendResult(interp, "bad orientation \"", value,
 205             "\": must be vertical or horizontal",
 206             (char *) NULL);
 207     *orientPtr = 0;
 208     return TCL_ERROR;
 209 }
 210 \f
 211 /*
 212  *--------------------------------------------------------------
 213  *
 214  * TkOrientPrintProc --
 215  *
 216  *      This procedure is invoked by the Tk configuration code
 217  *      to produce a printable string for the "-orient"
 218  *      configuration option.
 219  *
 220  * Results:
 221  *      The return value is a string describing the orientation for
 222  *      the item referred to by "widgRec".  In addition, *freeProcPtr
 223  *      is filled in with the address of a procedure to call to free
 224  *      the result string when it's no longer needed (or NULL to
 225  *      indicate that the string doesn't need to be freed).
 226  *
 227  * Side effects:
 228  *      None.
 229  *
 230  *--------------------------------------------------------------
 231  */
 232
 233 char *
 234 TkOrientPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
 235     ClientData clientData;              /* Ignored. */
 236     Tk_Window tkwin;                    /* Window containing canvas widget. */
 237     char *widgRec;                      /* Pointer to record for item. */
 238     int offset;                         /* Offset into item. */
 239     Tcl_FreeProc **freeProcPtr;         /* Pointer to variable to fill in with
 240                                          * information about how to reclaim
 241                                          * storage for return string. */
 242 {
 243     register int *statePtr = (int *) (widgRec + offset);
 244
 245     if (*statePtr) {
 246         return "vertical";
 247     } else {
 248         return "horizontal";
 249     }
 250 }
 251 \f
 252 /*
 253  *----------------------------------------------------------------------
 254  *
 255  * TkOffsetParseProc --
 256  *
 257  *      Converts the offset of a stipple or tile into the Tk_TSOffset structure.
 258  *
 259  *----------------------------------------------------------------------
 260  */
 261
 262 int
 263 TkOffsetParseProc(clientData, interp, tkwin, value, widgRec, offset)
 264     ClientData clientData;      /* not used */
 265     Tcl_Interp *interp;         /* Interpreter to send results back to */
 266     Tk_Window tkwin;            /* Window on same display as tile */
 267     CONST char *value;          /* Name of image */
 268     char *widgRec;              /* Widget structure record */
 269     int offset;                 /* Offset of tile in record */
 270 {
 271     Tk_TSOffset *offsetPtr = (Tk_TSOffset *)(widgRec + offset);
 272     Tk_TSOffset tsoffset;
 273     CONST char *q, *p;
 274     int result;
 275
 276     if ((value == NULL) || (*value == 0)) {
 277         tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE;
 278         goto goodTSOffset;
 279     }
 280     tsoffset.flags = 0;
 281     p = value;
 282
 283     switch(value[0]) {
 284         case '#':
 285             if (((int)clientData) & TK_OFFSET_RELATIVE) {
 286                 tsoffset.flags = TK_OFFSET_RELATIVE;
 287                 p++; break;
 288             }
 289             goto badTSOffset;
 290         case 'e':
 291             switch(value[1]) {
 292                 case '\0':
 293                     tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_MIDDLE;
 294                     goto goodTSOffset;
 295                 case 'n':
 296                     if (value[2]!='d' || value[3]!='\0') {goto badTSOffset;}
 297                     tsoffset.flags = INT_MAX;
 298                     goto goodTSOffset;
 299             }
 300         case 'w':
 301             if (value[1] != '\0') {goto badTSOffset;}
 302             tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_MIDDLE;
 303             goto goodTSOffset;
 304         case 'n':
 305             if ((value[1] != '\0') && (value[2] != '\0')) {
 306                 goto badTSOffset;
 307             }
 308             switch(value[1]) {
 309                 case '\0': tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_TOP;
 310                            goto goodTSOffset;
 311                 case 'w': tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_TOP;
 312                            goto goodTSOffset;
 313                 case 'e': tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_TOP;
 314                            goto goodTSOffset;
 315             }
 316             goto badTSOffset;
 317         case 's':
 318             if ((value[1] != '\0') && (value[2] != '\0')) {
 319                 goto badTSOffset;
 320             }
 321             switch(value[1]) {
 322                 case '\0': tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_BOTTOM;
 323                            goto goodTSOffset;
 324                 case 'w': tsoffset.flags = TK_OFFSET_LEFT|TK_OFFSET_BOTTOM;
 325                            goto goodTSOffset;
 326                 case 'e': tsoffset.flags = TK_OFFSET_RIGHT|TK_OFFSET_BOTTOM;
 327                            goto goodTSOffset;
 328             }
 329             goto badTSOffset;
 330         case 'c':
 331             if (strncmp(value, "center", strlen(value)) != 0) {
 332                 goto badTSOffset;
 333             }
 334             tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE;
 335             goto goodTSOffset;
 336     }
 337     if ((q = strchr(p,',')) == NULL) {
 338         if (((int)clientData) & TK_OFFSET_INDEX) {
 339             if (Tcl_GetInt(interp, (char *) p, &tsoffset.flags) != TCL_OK) {
 340                 Tcl_ResetResult(interp);
 341                 goto badTSOffset;
 342             }
 343             tsoffset.flags |= TK_OFFSET_INDEX;
 344             goto goodTSOffset;
 345         }
 346         goto badTSOffset;
 347     }
 348     *((char *) q) = 0;
 349     result = Tk_GetPixels(interp, tkwin, (char *) p, &tsoffset.xoffset);
 350     *((char *) q) = ',';
 351     if (result != TCL_OK) {
 352         return TCL_ERROR;
 353     }
 354     if (Tk_GetPixels(interp, tkwin, (char *) q+1, &tsoffset.yoffset) != TCL_OK) {
 355         return TCL_ERROR;
 356     }
 357
 358
 359 goodTSOffset:
 360     /* below is a hack to allow the stipple/tile offset to be stored
 361      * in the internal tile structure. Most of the times, offsetPtr
 362      * is a pointer to an already existing tile structure. However
 363      * if this structure is not already created, we must do it
 364      * with Tk_GetTile()!!!!;
 365      */
 366
 367     memcpy(offsetPtr,&tsoffset, sizeof(Tk_TSOffset));
 368     return TCL_OK;
 369
 370 badTSOffset:
 371     Tcl_AppendResult(interp, "bad offset \"", value,
 372             "\": expected \"x,y\"", (char *) NULL);
 373     if (((int) clientData) & TK_OFFSET_RELATIVE) {
 374         Tcl_AppendResult(interp, ", \"#x,y\"", (char *) NULL);
 375     }
 376     if (((int) clientData) & TK_OFFSET_INDEX) {
 377         Tcl_AppendResult(interp, ", <index>", (char *) NULL);
 378     }
 379     Tcl_AppendResult(interp, ", n, ne, e, se, s, sw, w, nw, or center",
 380             (char *) NULL);
 381     return TCL_ERROR;
 382 }
 383 \f
 384 /*
 385  *----------------------------------------------------------------------
 386  *
 387  * TkOffsetPrintProc --
 388  *
 389  *      Returns the offset of the tile.
 390  *
 391  * Results:
 392  *      The offset of the tile is returned.
 393  *
 394  *----------------------------------------------------------------------
 395  */
 396
 397 char *
 398 TkOffsetPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
 399     ClientData clientData;      /* not used */
 400     Tk_Window tkwin;            /* not used */
 401     char *widgRec;              /* Widget structure record */
 402     int offset;                 /* Offset of tile in record */
 403     Tcl_FreeProc **freeProcPtr; /* not used */
 404 {
 405     Tk_TSOffset *offsetPtr = (Tk_TSOffset *)(widgRec + offset);
 406     char *p, *q;
 407
 408     if ((offsetPtr->flags) & TK_OFFSET_INDEX) {
 409         if ((offsetPtr->flags) >= INT_MAX) {
 410             return "end";
 411         }
 412         p = (char *) ckalloc(32);
 413         sprintf(p, "%d",(offsetPtr->flags & (~TK_OFFSET_INDEX)));
 414         *freeProcPtr = TCL_DYNAMIC;
 415         return p;
 416     }
 417     if ((offsetPtr->flags) & TK_OFFSET_TOP) {
 418         if ((offsetPtr->flags) & TK_OFFSET_LEFT) {
 419             return "nw";
 420         } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) {
 421             return "n";
 422         } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) {
 423             return "ne";
 424         }
 425     } else if ((offsetPtr->flags) & TK_OFFSET_MIDDLE) {
 426         if ((offsetPtr->flags) & TK_OFFSET_LEFT) {
 427             return "w";
 428         } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) {
 429             return "center";
 430         } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) {
 431             return "e";
 432         }
 433     } else if ((offsetPtr->flags) & TK_OFFSET_BOTTOM) {
 434         if ((offsetPtr->flags) & TK_OFFSET_LEFT) {
 435             return "sw";
 436         } else if ((offsetPtr->flags) & TK_OFFSET_CENTER) {
 437             return "s";
 438         } else if ((offsetPtr->flags) & TK_OFFSET_RIGHT) {
 439             return "se";
 440         }
 441     }
 442     q = p = (char *) ckalloc(32);
 443     if ((offsetPtr->flags) & TK_OFFSET_RELATIVE) {
 444         *q++ = '#';
 445     }
 446     sprintf(q, "%d,%d",offsetPtr->xoffset, offsetPtr->yoffset);
 447     *freeProcPtr = TCL_DYNAMIC;
 448     return p;
 449 }
 450 \f
 451 \f
 452 /*
 453  *----------------------------------------------------------------------
 454  *
 455  * TkPixelParseProc --
 456  *
 457  *      Converts the name of an image into a tile.
 458  *
 459  *----------------------------------------------------------------------
 460  */
 461
 462 int
 463 TkPixelParseProc(clientData, interp, tkwin, value, widgRec, offset)
 464     ClientData clientData;      /* if non-NULL, negative values are
 465                                  * allowed as well */
 466     Tcl_Interp *interp;         /* Interpreter to send results back to */
 467     Tk_Window tkwin;            /* Window on same display as tile */
 468     CONST char *value;          /* Name of image */
 469     char *widgRec;              /* Widget structure record */
 470     int offset;                 /* Offset of tile in record */
 471 {
 472     double *doublePtr = (double *)(widgRec + offset);
 473     int result;
 474
 475     result = TkGetDoublePixels(interp, tkwin, value, doublePtr);
 476
 477     if ((result == TCL_OK) && (clientData == NULL) && (*doublePtr < 0.0)) {
 478         Tcl_AppendResult(interp, "bad screen distance \"", value,
 479                 "\"", (char *) NULL);
 480         return TCL_ERROR;
 481     }
 482     return result;
 483 }
 484 \f
 485 /*
 486  *----------------------------------------------------------------------
 487  *
 488  * TkPixelPrintProc --
 489  *
 490  *      Returns the name of the tile.
 491  *
 492  * Results:
 493  *      The name of the tile is returned.
 494  *
 495  *----------------------------------------------------------------------
 496  */
 497
 498 char *
 499 TkPixelPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
 500     ClientData clientData;      /* not used */
 501     Tk_Window tkwin;            /* not used */
 502     char *widgRec;              /* Widget structure record */
 503     int offset;                 /* Offset of tile in record */
 504     Tcl_FreeProc **freeProcPtr; /* not used */
 505 {
 506     double *doublePtr = (double *)(widgRec + offset);
 507     char *p;
 508
 509     p = (char *) ckalloc(24);
 510     Tcl_PrintDouble((Tcl_Interp *) NULL, *doublePtr, p);
 511     *freeProcPtr = TCL_DYNAMIC;
 512     return p;
 513 }
 514 \f
 515 /*
 516  *----------------------------------------------------------------------
 517  *
 518  * TkDrawInsetFocusHighlight --
 519  *
 520  *      This procedure draws a rectangular ring around the outside of
 521  *      a widget to indicate that it has received the input focus.  It
 522  *      takes an additional padding argument that specifies how much
 523  *      padding is present outside th widget.
 524  *
 525  * Results:
 526  *      None.
 527  *
 528  * Side effects:
 529  *      A rectangle "width" pixels wide is drawn in "drawable",
 530  *      corresponding to the outer area of "tkwin".
 531  *
 532  *----------------------------------------------------------------------
 533  */
 534
 535 void
 536 TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, padding)
 537     Tk_Window tkwin;            /* Window whose focus highlight ring is
 538                                  * to be drawn. */
 539     GC gc;                      /* Graphics context to use for drawing
 540                                  * the highlight ring. */
 541     int width;                  /* Width of the highlight ring, in pixels. */
 542     Drawable drawable;          /* Where to draw the ring (typically a
 543                                  * pixmap for double buffering). */
 544     int padding;                /* Width of padding outside of widget. */
 545 {
 546     XRectangle rects[4];
 547
 548     rects[0].x = padding;
 549     rects[0].y = padding;
 550     rects[0].width = Tk_Width(tkwin) - (2 * padding);
 551     rects[0].height = width;
 552     rects[1].x = padding;
 553     rects[1].y = Tk_Height(tkwin) - width - padding;
 554     rects[1].width = Tk_Width(tkwin) - (2 * padding);
 555     rects[1].height = width;
 556     rects[2].x = padding;
 557     rects[2].y = width + padding;
 558     rects[2].width = width;
 559     rects[2].height = Tk_Height(tkwin) - 2*width - 2*padding;
 560     rects[3].x = Tk_Width(tkwin) - width - padding;
 561     rects[3].y = rects[2].y;
 562     rects[3].width = width;
 563     rects[3].height = rects[2].height;
 564     XFillRectangles(Tk_Display(tkwin), drawable, gc, rects, 4);
 565 }
 566 \f
 567 /*
 568  *----------------------------------------------------------------------
 569  *
 570  * Tk_DrawFocusHighlight --
 571  *
 572  *      This procedure draws a rectangular ring around the outside of
 573  *      a widget to indicate that it has received the input focus.
 574  *
 575  *      This function is now deprecated.  Use TkpDrawHighlightBorder instead,
 576  *      since this function does not handle drawing the Focus ring properly
 577  *      on the Macintosh - you need to know the background GC as well
 578  *      as the foreground since the Mac focus ring separated from the widget
 579  *      by a 1 pixel border.
 580  *
 581  * Results:
 582  *      None.
 583  *
 584  * Side effects:
 585  *      A rectangle "width" pixels wide is drawn in "drawable",
 586  *      corresponding to the outer area of "tkwin".
 587  *
 588  *----------------------------------------------------------------------
 589  */
 590
 591 void
 592 Tk_DrawFocusHighlight(tkwin, gc, width, drawable)
 593     Tk_Window tkwin;            /* Window whose focus highlight ring is
 594                                  * to be drawn. */
 595     GC gc;                      /* Graphics context to use for drawing
 596                                  * the highlight ring. */
 597     int width;                  /* Width of the highlight ring, in pixels. */
 598     Drawable drawable;          /* Where to draw the ring (typically a
 599                                  * pixmap for double buffering). */
 600 {
 601     TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, 0);
 602 }
 603 \f
 604 /*
 605  *----------------------------------------------------------------------
 606  *
 607  * Tk_GetScrollInfo --
 608  *
 609  *      This procedure is invoked to parse "xview" and "yview"
 610  *      scrolling commands for widgets using the new scrolling
 611  *      command syntax ("moveto" or "scroll" options).
 612  *
 613  * Results:
 614  *      The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
 615  *      TK_SCROLL_UNITS, or TK_SCROLL_ERROR.  This indicates whether
 616  *      the command was successfully parsed and what form the command
 617  *      took.  If TK_SCROLL_MOVETO, *dblPtr is filled in with the
 618  *      desired position;  if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
 619  *      *intPtr is filled in with the number of lines to move (may be
 620  *      negative);  if TK_SCROLL_ERROR, the interp's result contains an
 621  *      error message.
 622  *
 623  * Side effects:
 624  *      None.
 625  *
 626  *----------------------------------------------------------------------
 627  */
 628
 629 int
 630 Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr)
 631     Tcl_Interp *interp;                 /* Used for error reporting. */
 632     int argc;                           /* # arguments for command. */
 633     CONST char **argv;                  /* Arguments for command. */
 634     double *dblPtr;                     /* Filled in with argument "moveto"
 635                                          * option, if any. */
 636     int *intPtr;                        /* Filled in with number of pages
 637                                          * or lines to scroll, if any. */
 638 {
 639     int c;
 640     size_t length;
 641
 642     length = strlen(argv[2]);
 643     c = argv[2][0];
 644     if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) {
 645         if (argc != 4) {
 646             Tcl_AppendResult(interp, "wrong # args: should be \"",
 647                     argv[0], " ", argv[1], " moveto fraction\"",
 648                     (char *) NULL);
 649             return TK_SCROLL_ERROR;
 650         }
 651         if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) {
 652             return TK_SCROLL_ERROR;
 653         }
 654         return TK_SCROLL_MOVETO;
 655     } else if ((c == 's')
 656             && (strncmp(argv[2], "scroll", length) == 0)) {
 657         if (argc != 5) {
 658             Tcl_AppendResult(interp, "wrong # args: should be \"",
 659                     argv[0], " ", argv[1], " scroll number units|pages\"",
 660                     (char *) NULL);
 661             return TK_SCROLL_ERROR;
 662         }
 663         if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) {
 664             return TK_SCROLL_ERROR;
 665         }
 666         length = strlen(argv[4]);
 667         c = argv[4][0];
 668         if ((c == 'p') && (strncmp(argv[4], "pages", length) == 0)) {
 669             return TK_SCROLL_PAGES;
 670         } else if ((c == 'u')
 671                 && (strncmp(argv[4], "units", length) == 0)) {
 672             return TK_SCROLL_UNITS;
 673         } else {
 674             Tcl_AppendResult(interp, "bad argument \"", argv[4],
 675                     "\": must be units or pages", (char *) NULL);
 676             return TK_SCROLL_ERROR;
 677         }
 678     }
 679     Tcl_AppendResult(interp, "unknown option \"", argv[2],
 680             "\": must be moveto or scroll", (char *) NULL);
 681     return TK_SCROLL_ERROR;
 682 }
 683 \f
 684 /*
 685  *----------------------------------------------------------------------
 686  *
 687  * Tk_GetScrollInfoObj --
 688  *
 689  *      This procedure is invoked to parse "xview" and "yview"
 690  *      scrolling commands for widgets using the new scrolling
 691  *      command syntax ("moveto" or "scroll" options).
 692  *
 693  * Results:
 694  *      The return value is either TK_SCROLL_MOVETO, TK_SCROLL_PAGES,
 695  *      TK_SCROLL_UNITS, or TK_SCROLL_ERROR.  This indicates whether
 696  *      the command was successfully parsed and what form the command
 697  *      took.  If TK_SCROLL_MOVETO, *dblPtr is filled in with the
 698  *      desired position;  if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
 699  *      *intPtr is filled in with the number of lines to move (may be
 700  *      negative);  if TK_SCROLL_ERROR, the interp's result contains an
 701  *      error message.
 702  *
 703  * Side effects:
 704  *      None.
 705  *
 706  *----------------------------------------------------------------------
 707  */
 708
 709 int
 710 Tk_GetScrollInfoObj(interp, objc, objv, dblPtr, intPtr)
 711     Tcl_Interp *interp;                 /* Used for error reporting. */
 712     int objc;                           /* # arguments for command. */
 713     Tcl_Obj *CONST objv[];              /* Arguments for command. */
 714     double *dblPtr;                     /* Filled in with argument "moveto"
 715                                          * option, if any. */
 716     int *intPtr;                        /* Filled in with number of pages
 717                                          * or lines to scroll, if any. */
 718 {
 719     int c;
 720     size_t length;
 721     char *arg2, *arg4;
 722
 723     arg2 = Tcl_GetString(objv[2]);
 724     length = strlen(arg2);
 725     c = arg2[0];
 726     if ((c == 'm') && (strncmp(arg2, "moveto", length) == 0)) {
 727         if (objc != 4) {
 728             Tcl_WrongNumArgs(interp, 2, objv, "moveto fraction");
 729             return TK_SCROLL_ERROR;
 730         }
 731         if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) {
 732             return TK_SCROLL_ERROR;
 733         }
 734         return TK_SCROLL_MOVETO;
 735     } else if ((c == 's')
 736             && (strncmp(arg2, "scroll", length) == 0)) {
 737         if (objc != 5) {
 738             Tcl_WrongNumArgs(interp, 2, objv, "scroll number units|pages");
 739             return TK_SCROLL_ERROR;
 740         }
 741         if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) {
 742             return TK_SCROLL_ERROR;
 743         }
 744         arg4 = Tcl_GetString(objv[4]);
 745         length = (strlen(arg4));
 746         c = arg4[0];
 747         if ((c == 'p') && (strncmp(arg4, "pages", length) == 0)) {
 748             return TK_SCROLL_PAGES;
 749         } else if ((c == 'u')
 750                 && (strncmp(arg4, "units", length) == 0)) {
 751             return TK_SCROLL_UNITS;
 752         } else {
 753             Tcl_AppendResult(interp, "bad argument \"", arg4,
 754                     "\": must be units or pages", (char *) NULL);
 755             return TK_SCROLL_ERROR;
 756         }
 757     }
 758     Tcl_AppendResult(interp, "unknown option \"", arg2,
 759             "\": must be moveto or scroll", (char *) NULL);
 760     return TK_SCROLL_ERROR;
 761 }
 762 \f
 763 /*
 764  *---------------------------------------------------------------------------
 765  *
 766  * TkComputeAnchor --
 767  *
 768  *      Determine where to place a rectangle so that it will be properly
 769  *      anchored with respect to the given window.  Used by widgets
 770  *      to align a box of text inside a window.  When anchoring with
 771  *      respect to one of the sides, the rectangle be placed inside of
 772  *      the internal border of the window.
 773  *
 774  * Results:
 775  *      *xPtr and *yPtr set to the upper-left corner of the rectangle
 776  *      anchored in the window.
 777  *
 778  * Side effects:
 779  *      None.
 780  *
 781  *---------------------------------------------------------------------------
 782  */
 783 void
 784 TkComputeAnchor(anchor, tkwin, padX, padY, innerWidth, innerHeight, xPtr, yPtr)
 785     Tk_Anchor anchor;           /* Desired anchor. */
 786     Tk_Window tkwin;            /* Anchored with respect to this window. */
 787     int padX, padY;             /* Use this extra padding inside window, in
 788                                  * addition to the internal border. */
 789     int innerWidth, innerHeight;/* Size of rectangle to anchor in window. */
 790     int *xPtr, *yPtr;           /* Returns upper-left corner of anchored
 791                                  * rectangle. */
 792 {
 793     switch (anchor) {
 794         case TK_ANCHOR_NW:
 795         case TK_ANCHOR_W:
 796         case TK_ANCHOR_SW:
 797             *xPtr = Tk_InternalBorderLeft(tkwin) + padX;
 798             break;
 799
 800         case TK_ANCHOR_N:
 801         case TK_ANCHOR_CENTER:
 802         case TK_ANCHOR_S:
 803             *xPtr = (Tk_Width(tkwin) - innerWidth) / 2;
 804             break;
 805
 806         default:
 807             *xPtr = Tk_Width(tkwin) - (Tk_InternalBorderRight(tkwin) + padX)
 808                     - innerWidth;
 809             break;
 810     }
 811
 812     switch (anchor) {
 813         case TK_ANCHOR_NW:
 814         case TK_ANCHOR_N:
 815         case TK_ANCHOR_NE:
 816             *yPtr = Tk_InternalBorderTop(tkwin) + padY;
 817             break;
 818
 819         case TK_ANCHOR_W:
 820         case TK_ANCHOR_CENTER:
 821         case TK_ANCHOR_E:
 822             *yPtr = (Tk_Height(tkwin) - innerHeight) / 2;
 823             break;
 824
 825         default:
 826             *yPtr = Tk_Height(tkwin) - Tk_InternalBorderBottom(tkwin) - padY
 827                     - innerHeight;
 828             break;
 829     }
 830 }
 831 \f
 832 /*
 833  *---------------------------------------------------------------------------
 834  *
 835  * TkFindStateString --
 836  *
 837  *      Given a lookup table, map a number to a string in the table.
 838  *
 839  * Results:
 840  *      If numKey was equal to the numeric key of one of the elements
 841  *      in the table, returns the string key of that element.
 842  *      Returns NULL if numKey was not equal to any of the numeric keys
 843  *      in the table.
 844  *
 845  * Side effects.
 846  *      None.
 847  *
 848  *---------------------------------------------------------------------------
 849  */
 850
 851 char *
 852 TkFindStateString(mapPtr, numKey)
 853     CONST TkStateMap *mapPtr;   /* The state table. */
 854     int numKey;                 /* The key to try to find in the table. */
 855 {
 856     for ( ; mapPtr->strKey != NULL; mapPtr++) {
 857         if (numKey == mapPtr->numKey) {
 858             return mapPtr->strKey;
 859         }
 860     }
 861     return NULL;
 862 }
 863 \f
 864 /*
 865  *---------------------------------------------------------------------------
 866  *
 867  * TkFindStateNum --
 868  *
 869  *      Given a lookup table, map a string to a number in the table.
 870  *
 871  * Results:
 872  *      If strKey was equal to the string keys of one of the elements
 873  *      in the table, returns the numeric key of that element.
 874  *      Returns the numKey associated with the last element (the NULL
 875  *      string one) in the table if strKey was not equal to any of the
 876  *      string keys in the table.  In that case, an error message is
 877  *      also left in the interp's result (if interp is not NULL).
 878  *
 879  * Side effects.
 880  *      None.
 881  *
 882  *---------------------------------------------------------------------------
 883  */
 884
 885 int
 886 TkFindStateNum(interp, option, mapPtr, strKey)
 887     Tcl_Interp *interp;         /* Interp for error reporting. */
 888     CONST char *option;         /* String to use when constructing error. */
 889     CONST TkStateMap *mapPtr;   /* Lookup table. */
 890     CONST char *strKey;         /* String to try to find in lookup table. */
 891 {
 892     CONST TkStateMap *mPtr;
 893
 894     for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
 895         if (strcmp(strKey, mPtr->strKey) == 0) {
 896             return mPtr->numKey;
 897         }
 898     }
 899     if (interp != NULL) {
 900         mPtr = mapPtr;
 901         Tcl_AppendResult(interp, "bad ", option, " value \"", strKey,
 902                 "\": must be ", mPtr->strKey, (char *) NULL);
 903         for (mPtr++; mPtr->strKey != NULL; mPtr++) {
 904             Tcl_AppendResult(interp,
 905                     ((mPtr[1].strKey != NULL) ? ", " : ", or "),
 906                     mPtr->strKey, (char *) NULL);
 907         }
 908     }
 909     return mPtr->numKey;
 910 }
 911
 912 int
 913 TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr)
 914     Tcl_Interp *interp;         /* Interp for error reporting. */
 915     Tcl_Obj *optionPtr;         /* String to use when constructing error. */
 916     CONST TkStateMap *mapPtr;   /* Lookup table. */
 917     Tcl_Obj *keyPtr;            /* String key to find in lookup table. */
 918 {
 919     CONST TkStateMap *mPtr;
 920     CONST char *key;
 921     CONST Tcl_ObjType *typePtr;
 922
 923     if ((keyPtr->typePtr == &tkStateKeyObjType)
 924             && (keyPtr->internalRep.twoPtrValue.ptr1 == (VOID *) mapPtr)) {
 925         return (int) keyPtr->internalRep.twoPtrValue.ptr2;
 926     }
 927
 928     key = Tcl_GetStringFromObj(keyPtr, NULL);
 929     for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
 930         if (strcmp(key, mPtr->strKey) == 0) {
 931             typePtr = keyPtr->typePtr;
 932             if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
 933                 (*typePtr->freeIntRepProc)(keyPtr);
 934             }
 935             keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr;
 936             keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey;
 937             keyPtr->typePtr = &tkStateKeyObjType;
 938             return mPtr->numKey;
 939         }
 940     }
 941     if (interp != NULL) {
 942         mPtr = mapPtr;
 943         Tcl_AppendResult(interp, "bad ",
 944                 Tcl_GetStringFromObj(optionPtr, NULL), " value \"", key,
 945                 "\": must be ", mPtr->strKey, (char *) NULL);
 946         for (mPtr++; mPtr->strKey != NULL; mPtr++) {
 947             Tcl_AppendResult(interp,
 948                 ((mPtr[1].strKey != NULL) ? ", " : ", or "),
 949                 mPtr->strKey, (char *) NULL);
 950         }
 951     }
 952     return mPtr->numKey;
 953 }