libgui/src/tkTableTag.c

   1 /*
   2  * tkTableTag.c --
   3  *
   4  *      This module implements tags for table widgets.
   5  *
   6  * Copyright (c) 1998-2001 Jeffrey Hobbs
   7  *
   8  * See the file "license.terms" for information on usage and redistribution
   9  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10  *
  11  * RCS: @(#) $Id$
  12  */
  13
  14 #include "tkTable.h"
  15
  16 static TableTag *TableTagGetEntry _ANSI_ARGS_((Table *tablePtr, char *name,
  17         int objc, char **argv));
  18 static unsigned int     TableTagGetPriority _ANSI_ARGS_((Table *tablePtr,
  19         TableTag *tagPtr));
  20 static void     TableImageProc _ANSI_ARGS_((ClientData clientData, int x,
  21         int y, int width, int height, int imageWidth, int imageHeight));
  22
  23 static char *tagCmdNames[] = {
  24     "celltag", "cget", "coltag", "configure", "delete", "exists",
  25     "includes", "lower", "names", "raise", "rowtag", (char *) NULL
  26 };
  27
  28 enum tagCmd {
  29     TAG_CELLTAG, TAG_CGET, TAG_COLTAG, TAG_CONFIGURE, TAG_DELETE, TAG_EXISTS,
  30     TAG_INCLUDES, TAG_LOWER, TAG_NAMES, TAG_RAISE, TAG_ROWTAG
  31 };
  32
  33 static Cmd_Struct tagState_vals[]= {
  34     {"unknown",  STATE_UNKNOWN},
  35     {"normal",   STATE_NORMAL},
  36     {"disabled", STATE_DISABLED},
  37     {"",         0 }
  38 };
  39
  40 static Tk_CustomOption tagStateOpt      = { Cmd_OptionSet, Cmd_OptionGet,
  41                                             (ClientData)(&tagState_vals) };
  42 static Tk_CustomOption tagBdOpt         = { TableOptionBdSet, TableOptionBdGet,
  43                                             (ClientData) BD_TABLE_TAG };
  44
  45 /*
  46  * The default specification for configuring tags
  47  * Done like this to make the command line parsing easy
  48  */
  49
  50 static Tk_ConfigSpec tagConfig[] = {
  51   {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", "center",
  52    Tk_Offset(TableTag, anchor), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
  53   {TK_CONFIG_BORDER, "-background", "background", "Background", NULL,
  54    Tk_Offset(TableTag, bg), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
  55   {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *)NULL, (char *)NULL, 0, 0},
  56   {TK_CONFIG_SYNONYM, "-bg", "background", (char *)NULL, (char *)NULL, 0, 0},
  57   {TK_CONFIG_CUSTOM, "-borderwidth", "borderWidth", "BorderWidth", "",
  58    0 /* no offset */,
  59    TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK, &tagBdOpt },
  60   {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground", NULL,
  61    Tk_Offset(TableTag, fg), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
  62   {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *)NULL, (char *)NULL, 0, 0},
  63   {TK_CONFIG_FONT, "-font", "font", "Font", NULL,
  64    Tk_Offset(TableTag, tkfont), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
  65   {TK_CONFIG_STRING, "-image", "image", "Image", NULL,
  66    Tk_Offset(TableTag, imageStr),
  67    TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
  68   {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", "left",
  69    Tk_Offset(TableTag, justify), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
  70   {TK_CONFIG_INT, "-multiline", "multiline", "Multiline", "-1",
  71    Tk_Offset(TableTag, multiline), TK_CONFIG_DONT_SET_DEFAULT },
  72   {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", "flat",
  73    Tk_Offset(TableTag, relief), TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
  74   {TK_CONFIG_INT, "-showtext", "showText", "ShowText", "-1",
  75    Tk_Offset(TableTag, showtext), TK_CONFIG_DONT_SET_DEFAULT },
  76   {TK_CONFIG_CUSTOM, "-state", "state", "State", "unknown",
  77    Tk_Offset(TableTag, state), TK_CONFIG_DONT_SET_DEFAULT, &tagStateOpt },
  78   {TK_CONFIG_INT, "-wrap", "wrap", "Wrap", "-1",
  79    Tk_Offset(TableTag, wrap), TK_CONFIG_DONT_SET_DEFAULT },
  80   {TK_CONFIG_END, (char *)NULL, (char *)NULL, (char *)NULL, (char *)NULL, 0, 0}
  81 };
  82
  83 /*
  84  * The join tag structure is used to create a combined tag, so it
  85  * keeps priority info.
  86  */
  87 typedef struct {
  88     TableTag    tag;            /* must be first */
  89     unsigned int magic;
  90     unsigned int pbg, pfg, pborders, prelief, ptkfont, panchor, pimage;
  91     unsigned int pstate, pjustify, pmultiline, pwrap, pshowtext;
  92 } TableJoinTag;
  93 \f
  94 /*
  95  *----------------------------------------------------------------------
  96  *
  97  * TableImageProc --
  98  *      Called when an image associated with a tag is changed.
  99  *
 100  * Results:
 101  *      None.
 102  *
 103  * Side effects:
 104  *      Invalidates the whole table.
 105  *      This should only invalidate affected cells, but that info
 106  *      is not managed...
 107  *
 108  *----------------------------------------------------------------------
 109  */
 110 static void
 111 TableImageProc(ClientData clientData, int x, int y, int width, int height,
 112                int imageWidth, int imageHeight)
 113 {
 114     TableInvalidateAll((Table *)clientData, 0);
 115 }
 116 \f
 117 /*
 118  *----------------------------------------------------------------------
 119  *
 120  * TableNewTag --
 121  *      ckallocs space for a new tag structure and inits the structure.
 122  *
 123  * Results:
 124  *      Returns a pointer to the new structure.  Must be freed later.
 125  *
 126  * Side effects:
 127  *      None.
 128  *
 129  *----------------------------------------------------------------------
 130  */
 131 TableTag *
 132 TableNewTag(Table *tablePtr)
 133 {
 134     TableTag *tagPtr;
 135
 136     /*
 137      * If tablePtr is NULL, make a regular tag, otherwise make a join tag.
 138      */
 139     if (tablePtr == NULL) {
 140         tagPtr = (TableTag *) ckalloc(sizeof(TableTag));
 141         memset((VOID *) tagPtr, 0, sizeof(TableTag));
 142
 143         /*
 144          * Set the values that aren't 0/NULL by default
 145          */
 146         tagPtr->anchor          = (Tk_Anchor)-1;
 147         tagPtr->justify         = (Tk_Justify)-1;
 148         tagPtr->multiline       = -1;
 149         tagPtr->relief          = -1;
 150         tagPtr->showtext        = -1;
 151         tagPtr->state           = STATE_UNKNOWN;
 152         tagPtr->wrap            = -1;
 153     } else {
 154         TableJoinTag *jtagPtr = (TableJoinTag *) ckalloc(sizeof(TableJoinTag));
 155         memset((VOID *) jtagPtr, 0, sizeof(TableJoinTag));
 156         tagPtr = (TableTag *) jtagPtr;
 157
 158         tagPtr->anchor          = (Tk_Anchor)-1;
 159         tagPtr->justify         = (Tk_Justify)-1;
 160         tagPtr->multiline       = -1;
 161         tagPtr->relief          = -1;
 162         tagPtr->showtext        = -1;
 163         tagPtr->state           = STATE_UNKNOWN;
 164         tagPtr->wrap            = -1;
 165         jtagPtr->magic          = 0x99ABCDEF;
 166         jtagPtr->pbg            = -1;
 167         jtagPtr->pfg            = -1;
 168         jtagPtr->pborders       = -1;
 169         jtagPtr->prelief        = -1;
 170         jtagPtr->ptkfont        = -1;
 171         jtagPtr->panchor        = -1;
 172         jtagPtr->pimage         = -1;
 173         jtagPtr->pstate         = -1;
 174         jtagPtr->pjustify       = -1;
 175         jtagPtr->pmultiline     = -1;
 176         jtagPtr->pwrap          = -1;
 177         jtagPtr->pshowtext      = -1;
 178     }
 179
 180     return (TableTag *) tagPtr;
 181 }
 182 \f
 183 /*
 184  *----------------------------------------------------------------------
 185  *
 186  * TableResetTag --
 187  *      This routine resets a given tag to the table defaults.
 188  *
 189  * Results:
 190  *      Tag will have values changed.
 191  *
 192  * Side effects:
 193  *      None.
 194  *
 195  *----------------------------------------------------------------------
 196  */
 197 void
 198 TableResetTag(Table *tablePtr, TableTag *tagPtr)
 199 {
 200     TableJoinTag *jtagPtr = (TableJoinTag *) tagPtr;
 201
 202     if (jtagPtr->magic != 0x99ABCDEF) {
 203         panic("bad mojo in TableResetTag");
 204     }
 205
 206     memset((VOID *) jtagPtr, 0, sizeof(TableJoinTag));
 207
 208     tagPtr->anchor      = (Tk_Anchor)-1;
 209     tagPtr->justify     = (Tk_Justify)-1;
 210     tagPtr->multiline   = -1;
 211     tagPtr->relief      = -1;
 212     tagPtr->showtext    = -1;
 213     tagPtr->state       = STATE_UNKNOWN;
 214     tagPtr->wrap        = -1;
 215     jtagPtr->magic      = 0x99ABCDEF;
 216     jtagPtr->pbg        = -1;
 217     jtagPtr->pfg        = -1;
 218     jtagPtr->pborders   = -1;
 219     jtagPtr->prelief    = -1;
 220     jtagPtr->ptkfont    = -1;
 221     jtagPtr->panchor    = -1;
 222     jtagPtr->pimage     = -1;
 223     jtagPtr->pstate     = -1;
 224     jtagPtr->pjustify   = -1;
 225     jtagPtr->pmultiline = -1;
 226     jtagPtr->pwrap      = -1;
 227     jtagPtr->pshowtext  = -1;
 228
 229     /*
 230      * Merge in the default tag.
 231      */
 232     memcpy((VOID *) jtagPtr, (VOID *) &(tablePtr->defaultTag),
 233             sizeof(TableTag));
 234 }
 235 \f
 236 /*
 237  *----------------------------------------------------------------------
 238  *
 239  * TableMergeTag --
 240  *      This routine merges two tags by adding any fields from the addTag
 241  *      that are set to the baseTag.
 242  *
 243  * Results:
 244  *      baseTag will inherit all set characteristics of addTag
 245  *      (addTag thus has the priority).
 246  *
 247  * Side effects:
 248  *      None.
 249  *
 250  *----------------------------------------------------------------------
 251  */
 252 void
 253 TableMergeTag(Table *tablePtr, TableTag *baseTag, TableTag *addTag)
 254 {
 255     TableJoinTag *jtagPtr = (TableJoinTag *) baseTag;
 256     unsigned int prio;
 257
 258     if (jtagPtr->magic != 0x99ABCDEF) {
 259         panic("bad mojo in TableMergeTag");
 260     }
 261
 262 #ifndef NO_TAG_PRIORITIES
 263     /*
 264      * Find priority for the tag to merge
 265      */
 266     prio = TableTagGetPriority(tablePtr, addTag);
 267
 268     if ((addTag->anchor != -1) && (prio < jtagPtr->panchor)) {
 269         baseTag->anchor         = addTag->anchor;
 270         jtagPtr->panchor        = prio;
 271     }
 272     if ((addTag->bg != NULL) && (prio < jtagPtr->pbg)) {
 273         baseTag->bg             = addTag->bg;
 274         jtagPtr->pbg            = prio;
 275     }
 276     if ((addTag->fg != NULL) && (prio < jtagPtr->pfg)) {
 277         baseTag->fg             = addTag->fg;
 278         jtagPtr->pfg            = prio;
 279     }
 280     if ((addTag->tkfont != NULL) && (prio < jtagPtr->ptkfont)) {
 281         baseTag->tkfont         = addTag->tkfont;
 282         jtagPtr->ptkfont        = prio;
 283     }
 284     if ((addTag->imageStr != NULL) && (prio < jtagPtr->pimage)) {
 285         baseTag->imageStr       = addTag->imageStr;
 286         baseTag->image          = addTag->image;
 287         jtagPtr->pimage         = prio;
 288     }
 289     if ((addTag->multiline >= 0) && (prio < jtagPtr->pmultiline)) {
 290         baseTag->multiline      = addTag->multiline;
 291         jtagPtr->pmultiline     = prio;
 292     }
 293     if ((addTag->relief != -1) && (prio < jtagPtr->prelief)) {
 294         baseTag->relief         = addTag->relief;
 295         jtagPtr->prelief        = prio;
 296     }
 297     if ((addTag->showtext >= 0) && (prio < jtagPtr->pshowtext)) {
 298         baseTag->showtext       = addTag->showtext;
 299         jtagPtr->pshowtext      = prio;
 300     }
 301     if ((addTag->state != STATE_UNKNOWN) && (prio < jtagPtr->pstate)) {
 302         baseTag->state          = addTag->state;
 303         jtagPtr->pstate         = prio;
 304     }
 305     if ((addTag->justify != -1) && (prio < jtagPtr->pjustify)) {
 306         baseTag->justify        = addTag->justify;
 307         jtagPtr->pjustify       = prio;
 308     }
 309     if ((addTag->wrap >= 0) && (prio < jtagPtr->pwrap)) {
 310         baseTag->wrap           = addTag->wrap;
 311         jtagPtr->pwrap          = prio;
 312     }
 313     if ((addTag->borders) && (prio < jtagPtr->pborders)) {
 314         baseTag->borderStr      = addTag->borderStr;
 315         baseTag->borders        = addTag->borders;
 316         baseTag->bd[0]          = addTag->bd[0];
 317         baseTag->bd[1]          = addTag->bd[1];
 318         baseTag->bd[2]          = addTag->bd[2];
 319         baseTag->bd[3]          = addTag->bd[3];
 320         jtagPtr->pborders       = prio;
 321     }
 322 #else
 323     if (addTag->anchor != -1)   baseTag->anchor = addTag->anchor;
 324     if (addTag->bg != NULL)     baseTag->bg     = addTag->bg;
 325     if (addTag->fg != NULL)     baseTag->fg     = addTag->fg;
 326     if (addTag->tkfont != NULL) baseTag->tkfont = addTag->tkfont;
 327     if (addTag->imageStr != NULL) {
 328         baseTag->imageStr       = addTag->imageStr;
 329         baseTag->image          = addTag->image;
 330     }
 331     if (addTag->multiline >= 0) baseTag->multiline      = addTag->multiline;
 332     if (addTag->relief != -1)   baseTag->relief         = addTag->relief;
 333     if (addTag->showtext >= 0)  baseTag->showtext       = addTag->showtext;
 334     if (addTag->state != STATE_UNKNOWN) baseTag->state  = addTag->state;
 335     if (addTag->justify != -1)  baseTag->justify        = addTag->justify;
 336     if (addTag->wrap >= 0)      baseTag->wrap           = addTag->wrap;
 337     if (addTag->borders) {
 338         baseTag->borderStr      = addTag->borderStr;
 339         baseTag->borders        = addTag->borders;
 340         baseTag->bd[0]          = addTag->bd[0];
 341         baseTag->bd[1]          = addTag->bd[1];
 342         baseTag->bd[2]          = addTag->bd[2];
 343         baseTag->bd[3]          = addTag->bd[3];
 344     }
 345 #endif
 346 }
 347 \f
 348 /*
 349  *----------------------------------------------------------------------
 350  *
 351  * TableInvertTag --
 352  *      This routine swaps background and foreground for the selected tag.
 353  *
 354  * Results:
 355  *      Inverts fg and bg of tag.
 356  *
 357  * Side effects:
 358  *      None.
 359  *
 360  *----------------------------------------------------------------------
 361  */
 362 void
 363 TableInvertTag(TableTag *baseTag)
 364 {
 365     Tk_3DBorder tmpBg;
 366
 367     tmpBg       = baseTag->fg;
 368     baseTag->fg = baseTag->bg;
 369     baseTag->bg = tmpBg;
 370 }
 371 \f
 372 /*
 373  *----------------------------------------------------------------------
 374  *
 375  * TableGetTagBorders --
 376  *      This routine gets the border values based on a tag.
 377  *
 378  * Results:
 379  *      It returns the values in the int*'s (if not NULL), and the
 380  *      total number of defined borders as a result.
 381  *
 382  * Side effects:
 383  *      None.
 384  *
 385  *----------------------------------------------------------------------
 386  */
 387 int
 388 TableGetTagBorders(TableTag *tagPtr,
 389         int *left, int *right, int *top, int *bottom)
 390 {
 391     switch (tagPtr->borders) {
 392         case 0:
 393             if (left)   { *left         = 0; }
 394             if (right)  { *right        = 0; }
 395             if (top)    { *top          = 0; }
 396             if (bottom) { *bottom       = 0; }
 397             break;
 398         case 1:
 399             if (left)   { *left         = tagPtr->bd[0]; }
 400             if (right)  { *right        = tagPtr->bd[0]; }
 401             if (top)    { *top          = tagPtr->bd[0]; }
 402             if (bottom) { *bottom       = tagPtr->bd[0]; }
 403             break;
 404         case 2:
 405             if (left)   { *left         = tagPtr->bd[0]; }
 406             if (right)  { *right        = tagPtr->bd[1]; }
 407             if (top)    { *top          = 0; }
 408             if (bottom) { *bottom       = 0; }
 409             break;
 410         case 4:
 411             if (left)   { *left         = tagPtr->bd[0]; }
 412             if (right)  { *right        = tagPtr->bd[1]; }
 413             if (top)    { *top          = tagPtr->bd[2]; }
 414             if (bottom) { *bottom       = tagPtr->bd[3]; }
 415             break;
 416         default:
 417             panic("invalid border value '%d'\n", tagPtr->borders);
 418             break;
 419     }
 420     return tagPtr->borders;
 421 }
 422 \f
 423 /*
 424  *----------------------------------------------------------------------
 425  *
 426  * TableTagGetEntry --
 427  *      Takes a name and optional args and creates a tag entry in the
 428  *      table's tag table.
 429  *
 430  * Results:
 431  *      A new tag entry will be created and returned.
 432  *
 433  * Side effects:
 434  *      None.
 435  *
 436  *----------------------------------------------------------------------
 437  */
 438 static TableTag *
 439 TableTagGetEntry(Table *tablePtr, char *name, int objc, char **argv)
 440 {
 441     Tcl_HashEntry *entryPtr;
 442     TableTag *tagPtr = NULL;
 443     int new;
 444
 445     entryPtr = Tcl_CreateHashEntry(tablePtr->tagTable, name, &new);
 446     if (new) {
 447         tagPtr = TableNewTag(NULL);
 448         Tcl_SetHashValue(entryPtr, (ClientData) tagPtr);
 449         if (tablePtr->tagPrioSize >= tablePtr->tagPrioMax) {
 450             int i;
 451             /*
 452              * Increase the priority list size in blocks of 10
 453              */
 454             tablePtr->tagPrioMax += 10;
 455             tablePtr->tagPrioNames = (char **) ckrealloc(
 456                 (char *) tablePtr->tagPrioNames,
 457                 sizeof(TableTag *) * tablePtr->tagPrioMax);
 458             tablePtr->tagPrios = (TableTag **) ckrealloc(
 459                 (char *) tablePtr->tagPrios,
 460                 sizeof(TableTag *) * tablePtr->tagPrioMax);
 461             for (i = tablePtr->tagPrioSize; i < tablePtr->tagPrioMax; i++) {
 462                 tablePtr->tagPrioNames[i] = (char *) NULL;
 463                 tablePtr->tagPrios[i] = (TableTag *) NULL;
 464             }
 465         }
 466         tablePtr->tagPrioNames[tablePtr->tagPrioSize] =
 467             (char *) Tcl_GetHashKey(tablePtr->tagTable, entryPtr);
 468         tablePtr->tagPrios[tablePtr->tagPrioSize] = tagPtr;
 469         tablePtr->tagPrioSize++;
 470     } else {
 471         tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
 472     }
 473     if (objc) {
 474         Tk_ConfigureWidget(tablePtr->interp, tablePtr->tkwin, tagConfig,
 475                 objc, argv, (char *)tagPtr, TK_CONFIG_ARGV_ONLY);
 476     }
 477     return tagPtr;
 478 }
 479 \f
 480 /*
 481  *----------------------------------------------------------------------
 482  *
 483  * TableTagGetPriority --
 484  *      Get the priority value for a tag.
 485  *
 486  * Results:
 487  *      returns the priority.
 488  *
 489  * Side effects:
 490  *      None.
 491  *
 492  *----------------------------------------------------------------------
 493  */
 494 static unsigned int
 495 TableTagGetPriority(Table *tablePtr, TableTag *tagPtr)
 496 {
 497     unsigned int prio = 0;
 498     while (tagPtr != tablePtr->tagPrios[prio]) { prio++; }
 499     return prio;
 500 }
 501 \f
 502 /*
 503  *----------------------------------------------------------------------
 504  *
 505  * TableInitTags --
 506  *      Creates the static table tags.
 507  *
 508  * Results:
 509  *      active, sel, title and flash are created as tags.
 510  *
 511  * Side effects:
 512  *      None.
 513  *
 514  *----------------------------------------------------------------------
 515  */
 516 void
 517 TableInitTags(Table *tablePtr)
 518 {
 519     static char *activeArgs[]   = {"-bg", ACTIVE_BG, "-relief", "flat" };
 520     static char *selArgs[]      = {"-bg", SELECT_BG, "-fg", SELECT_FG,
 521                                    "-relief", "sunken" };
 522     static char *titleArgs[]    = {"-bg", DISABLED, "-fg", "white",
 523                                    "-relief", "flat", "-state", "disabled" };
 524     static char *flashArgs[]    = {"-bg", "red" };
 525     /*
 526      * The order of creation is important to priority.
 527      */
 528     TableTagGetEntry(tablePtr, "flash", ARSIZE(flashArgs), flashArgs);
 529     TableTagGetEntry(tablePtr, "active", ARSIZE(activeArgs), activeArgs);
 530     TableTagGetEntry(tablePtr, "sel", ARSIZE(selArgs), selArgs);
 531     TableTagGetEntry(tablePtr, "title", ARSIZE(titleArgs), titleArgs);
 532 }
 533 \f
 534 /*
 535  *----------------------------------------------------------------------
 536  *
 537  * FindRowColTag --
 538  *      Finds a row/col tag based on the row/col styles and tagCommand.
 539  *
 540  * Results:
 541  *      Returns tag associated with row/col cell, if any.
 542  *
 543  * Side effects:
 544  *      Possible side effects from eval of tagCommand.
 545  *      IMPORTANT: This plays with the interp result object,
 546  *      so use of resultPtr in prior command may be invalid after
 547  *      calling this function.
 548  *
 549  *----------------------------------------------------------------------
 550  */
 551 TableTag *
 552 FindRowColTag(Table *tablePtr, int cell, int mode)
 553 {
 554     Tcl_HashEntry *entryPtr;
 555     TableTag *tagPtr = NULL;
 556
 557     entryPtr = Tcl_FindHashEntry((mode == ROW) ? tablePtr->rowStyles
 558                                  : tablePtr->colStyles, (char *) cell);
 559     if (entryPtr == NULL) {
 560         char *cmd = (mode == ROW) ? tablePtr->rowTagCmd : tablePtr->colTagCmd;
 561         if (cmd) {
 562             register Tcl_Interp *interp = tablePtr->interp;
 563             char buf[INDEX_BUFSIZE];
 564             /*
 565              * Since no specific row/col tag exists, eval the given command
 566              * with row/col appended
 567              */
 568             sprintf(buf, " %d", cell);
 569             Tcl_Preserve((ClientData) interp);
 570             if (Tcl_VarEval(interp, cmd, buf, (char *)NULL) == TCL_OK) {
 571                 char *name = Tcl_GetStringResult(interp);
 572                 if (name && *name) {
 573                     /*
 574                      * If a result was returned, check to see if it is
 575                      * a valid tag.
 576                      */
 577                     entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, name);
 578                 }
 579             }
 580             Tcl_Release((ClientData) interp);
 581             Tcl_ResetResult(interp);
 582         }
 583     }
 584     if (entryPtr != NULL) {
 585         /*
 586          * This can be either the one in row|colStyles,
 587          * or that returned by eval'ing the row|colTagCmd
 588          */
 589         tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
 590     }
 591     return tagPtr;
 592 }
 593 \f
 594 /*
 595  *----------------------------------------------------------------------
 596  *
 597  * TableCleanupTag --
 598  *      Releases the resources used by a tag before it is freed up.
 599  *
 600  * Results:
 601  *      None.
 602  *
 603  * Side effects:
 604  *      The tag is no longer valid.
 605  *
 606  *----------------------------------------------------------------------
 607  */
 608 void
 609 TableCleanupTag(Table *tablePtr, TableTag *tagPtr)
 610 {
 611     /*
 612      * Free resources that the optionSpec doesn't specifically know about
 613      */
 614     if (tagPtr->image) {
 615         Tk_FreeImage(tagPtr->image);
 616     }
 617
 618     Tk_FreeOptions(tagConfig, (char *) tagPtr, tablePtr->display, 0);
 619 }
 620 \f
 621 /*
 622  *--------------------------------------------------------------
 623  *
 624  * Table_TagCmd --
 625  *      This procedure is invoked to process the tag method
 626  *      that corresponds to a widget managed by this module.
 627  *      See the user documentation for details on what it does.
 628  *
 629  * Results:
 630  *      A standard Tcl result.
 631  *
 632  * Side effects:
 633  *      See the user documentation.
 634  *
 635  *--------------------------------------------------------------
 636  */
 637 int
 638 Table_TagCmd(ClientData clientData, register Tcl_Interp *interp,
 639             int objc, Tcl_Obj *CONST objv[])
 640 {
 641     register Table *tablePtr = (Table *)clientData;
 642     int result = TCL_OK, cmdIndex, i, newEntry, value, len;
 643     int row, col, tagPrio, refresh = 0;
 644     TableTag *tagPtr, *tag2Ptr;
 645     Tcl_HashEntry *entryPtr, *scanPtr;
 646     Tcl_HashTable *hashTblPtr;
 647     Tcl_HashSearch search;
 648     Tk_Image image;
 649     Tcl_Obj *objPtr, *resultPtr;
 650     char buf[INDEX_BUFSIZE], *keybuf, *tagname;
 651
 652     if (objc < 3) {
 653         Tcl_WrongNumArgs(interp, 2, objv, "option ?arg arg ...?");
 654         return TCL_ERROR;
 655     }
 656
 657     result = Tcl_GetIndexFromObj(interp, objv[2], tagCmdNames,
 658                                  "tag option", 0, &cmdIndex);
 659     if (result != TCL_OK) {
 660         return result;
 661     }
 662     /*
 663      * Before using this object, make sure there aren't any calls that
 664      * could have changed the interp result, thus freeing the object.
 665      */
 666     resultPtr = Tcl_GetObjResult(interp);
 667
 668     switch ((enum tagCmd) cmdIndex) {
 669         case TAG_CELLTAG:       /* add named tag to a (group of) cell(s) */
 670             if (objc < 4) {
 671                 Tcl_WrongNumArgs(interp, 3, objv, "tag ?arg arg ...?");
 672                 return TCL_ERROR;
 673             }
 674             tagname = Tcl_GetStringFromObj(objv[3], &len);
 675             if (len == 0) {
 676                 /*
 677                  * An empty string was specified, so just delete the tag.
 678                  */
 679                 tagPtr = NULL;
 680             } else {
 681                 /*
 682                  * Get the pointer to the tag structure.  If it doesn't
 683                  * exist, it will be created.
 684                  */
 685                 tagPtr = TableTagGetEntry(tablePtr, tagname, 0, NULL);
 686             }
 687
 688             if (objc == 4) {
 689                 /*
 690                  * The user just wants the cells with this tag returned.
 691                  * Handle specially tags named: active, flash, sel, title
 692                  */
 693
 694                 if ((tablePtr->flags & HAS_ACTIVE) &&
 695                         STREQ(tagname, "active")) {
 696                     TableMakeArrayIndex(
 697                         tablePtr->activeRow+tablePtr->rowOffset,
 698                         tablePtr->activeCol+tablePtr->colOffset, buf);
 699                     Tcl_SetStringObj(resultPtr, buf, -1);
 700                 } else if ((tablePtr->flashMode && STREQ(tagname, "flash"))
 701                         || STREQ(tagname, "sel")) {
 702                     hashTblPtr = (*tagname == 's') ?
 703                         tablePtr->selCells : tablePtr->flashCells;
 704                     for (scanPtr = Tcl_FirstHashEntry(hashTblPtr, &search);
 705                          scanPtr != NULL;
 706                          scanPtr = Tcl_NextHashEntry(&search)) {
 707                         keybuf = (char *) Tcl_GetHashKey(hashTblPtr, scanPtr);
 708                         Tcl_ListObjAppendElement(NULL, resultPtr,
 709                                 Tcl_NewStringObj(keybuf, -1));
 710                     }
 711                 } else if (STREQ(tagname, "title") &&
 712                         (tablePtr->titleRows || tablePtr->titleCols)) {
 713                     for (row = tablePtr->rowOffset;
 714                          row < tablePtr->rowOffset+tablePtr->rows; row++) {
 715                         for (col = tablePtr->colOffset;
 716                              col < tablePtr->colOffset+tablePtr->titleCols;
 717                              col++) {
 718                             TableMakeArrayIndex(row, col, buf);
 719                             Tcl_ListObjAppendElement(NULL, resultPtr,
 720                                     Tcl_NewStringObj(buf, -1));
 721                         }
 722                     }
 723                     for (row = tablePtr->rowOffset;
 724                          row < tablePtr->rowOffset+tablePtr->titleRows;
 725                          row++) {
 726                         for (col = tablePtr->colOffset+tablePtr->titleCols;
 727                              col < tablePtr->colOffset+tablePtr->cols; col++) {
 728                             TableMakeArrayIndex(row, col, buf);
 729                             Tcl_ListObjAppendElement(NULL, resultPtr,
 730                                     Tcl_NewStringObj(buf, -1));
 731                         }
 732                     }
 733                 } else {
 734                     /*
 735                      * Check this tag pointer amongst all tagged cells
 736                      */
 737                     for (scanPtr = Tcl_FirstHashEntry(tablePtr->cellStyles,
 738                             &search);
 739                          scanPtr != NULL;
 740                          scanPtr = Tcl_NextHashEntry(&search)) {
 741                         if ((TableTag *) Tcl_GetHashValue(scanPtr) == tagPtr) {
 742                             keybuf = (char *) Tcl_GetHashKey(
 743                                 tablePtr->cellStyles, scanPtr);
 744                             Tcl_ListObjAppendElement(NULL, resultPtr,
 745                                     Tcl_NewStringObj(keybuf, -1));
 746                         }
 747                     }
 748                 }
 749                 return TCL_OK;
 750             }
 751
 752             /*
 753              * Loop through the arguments and fill in the hash table
 754              */
 755             for (i = 4; i < objc; i++) {
 756                 /*
 757                  * Try and parse the index
 758                  */
 759                 if (TableGetIndexObj(tablePtr, objv[i], &row, &col)
 760                         != TCL_OK) {
 761                     return TCL_ERROR;
 762                 }
 763                 /*
 764                  * Get the hash key ready
 765                  */
 766                 TableMakeArrayIndex(row, col, buf);
 767
 768                 if (tagPtr == NULL) {
 769                     /*
 770                      * This is a deletion
 771                      */
 772                     entryPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf);
 773                     if (entryPtr != NULL) {
 774                         Tcl_DeleteHashEntry(entryPtr);
 775                         refresh = 1;
 776                     }
 777                 } else {
 778                     /*
 779                      * Add a key to the hash table and set it to point to the
 780                      * Tag structure if it wasn't the same as an existing one
 781                      */
 782                     entryPtr = Tcl_CreateHashEntry(tablePtr->cellStyles,
 783                             buf, &newEntry);
 784                     if (newEntry || (tagPtr !=
 785                             (TableTag *) Tcl_GetHashValue(entryPtr))) {
 786                         Tcl_SetHashValue(entryPtr, (ClientData) tagPtr);
 787                         refresh = 1;
 788                     }
 789                 }
 790                 /*
 791                  * Now invalidate this cell for redraw
 792                  */
 793                 if (refresh) {
 794                     TableRefresh(tablePtr, row-tablePtr->rowOffset,
 795                             col-tablePtr->colOffset, CELL);
 796                 }
 797             }
 798             return TCL_OK;
 799
 800         case TAG_COLTAG:
 801         case TAG_ROWTAG: {          /* tag a row or a column */
 802             int forRows = (cmdIndex == TAG_ROWTAG);
 803
 804             if (objc < 4) {
 805                 Tcl_WrongNumArgs(interp, 3, objv, "tag ?arg arg ..?");
 806                 return TCL_ERROR;
 807             }
 808             tagname = Tcl_GetStringFromObj(objv[3], &len);
 809             if (len == 0) {
 810                 /*
 811                  * Empty string, so we want to delete this element
 812                  */
 813                 tagPtr = NULL;
 814             } else {
 815                 /*
 816                  * Get the pointer to the tag structure.  If it doesn't
 817                  * exist, it will be created.
 818                  */
 819                 tagPtr = TableTagGetEntry(tablePtr, tagname, 0, NULL);
 820             }
 821
 822             /*
 823              * Choose the correct hash table based on args
 824              */
 825             hashTblPtr = forRows ? tablePtr->rowStyles : tablePtr->colStyles;
 826
 827             if (objc == 4) {
 828                 /* the user just wants the tagged cells to be returned */
 829                 /* Special handling for tags: active, flash, sel, title */
 830
 831                 if ((tablePtr->flags & HAS_ACTIVE) &&
 832                         strcmp(tagname, "active") == 0) {
 833                     Tcl_SetIntObj(resultPtr,
 834                             (forRows ?
 835                                     tablePtr->activeRow+tablePtr->rowOffset :
 836                                     tablePtr->activeCol+tablePtr->colOffset));
 837                 } else if ((tablePtr->flashMode && STREQ(tagname, "flash"))
 838                         || STREQ(tagname, "sel")) {
 839                     Tcl_HashTable *cacheTblPtr;
 840
 841                     cacheTblPtr = (Tcl_HashTable *)
 842                         ckalloc(sizeof(Tcl_HashTable));
 843                     Tcl_InitHashTable(cacheTblPtr, TCL_ONE_WORD_KEYS);
 844
 845                     hashTblPtr = (*tagname == 's') ?
 846                         tablePtr->selCells : tablePtr->flashCells;
 847                     for (scanPtr = Tcl_FirstHashEntry(hashTblPtr, &search);
 848                          scanPtr != NULL;
 849                          scanPtr = Tcl_NextHashEntry(&search)) {
 850                         TableParseArrayIndex(&row, &col,
 851                                 Tcl_GetHashKey(hashTblPtr, scanPtr));
 852                         value = forRows ? row : col;
 853                         entryPtr = Tcl_CreateHashEntry(cacheTblPtr,
 854                                 (char *)value, &newEntry);
 855                         if (newEntry) {
 856                             Tcl_ListObjAppendElement(NULL, resultPtr,
 857                                     Tcl_NewIntObj(value));
 858                         }
 859                     }
 860
 861                     Tcl_DeleteHashTable(cacheTblPtr);
 862                     ckfree((char *) (cacheTblPtr));
 863                 } else if (STREQ(tagname, "title") &&
 864                         (forRows?tablePtr->titleRows:tablePtr->titleCols)) {
 865                     if (forRows) {
 866                         for (row = tablePtr->rowOffset;
 867                              row < tablePtr->rowOffset+tablePtr->titleRows;
 868                              row++) {
 869                             Tcl_ListObjAppendElement(NULL, resultPtr,
 870                                     Tcl_NewIntObj(row));
 871                         }
 872                     } else {
 873                         for (col = tablePtr->colOffset;
 874                              col < tablePtr->colOffset+tablePtr->titleCols;
 875                              col++) {
 876                             Tcl_ListObjAppendElement(NULL, resultPtr,
 877                                     Tcl_NewIntObj(col));
 878                         }
 879                     }
 880                 } else {
 881                     for (scanPtr = Tcl_FirstHashEntry(hashTblPtr, &search);
 882                          scanPtr != NULL;
 883                          scanPtr = Tcl_NextHashEntry(&search)) {
 884                         /* is this the tag pointer on this row */
 885                         if ((TableTag *) Tcl_GetHashValue(scanPtr) == tagPtr) {
 886                             objPtr = Tcl_NewIntObj(
 887                                 (int) Tcl_GetHashKey(hashTblPtr, scanPtr));
 888                             Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
 889                         }
 890                     }
 891                 }
 892                 return TCL_OK;
 893             }
 894
 895             /*
 896              * Loop through the arguments and fill in the hash table
 897              */
 898             for (i = 4; i < objc; i++) {
 899                 /*
 900                  * Try and parse the index
 901                  */
 902                 if (Tcl_GetIntFromObj(interp, objv[i], &value) != TCL_OK) {
 903                     return TCL_ERROR;
 904                 }
 905                 if (tagPtr == NULL) {
 906                     /*
 907                      * This is a deletion
 908                      */
 909                     entryPtr = Tcl_FindHashEntry(hashTblPtr, (char *)value);
 910                     if (entryPtr != NULL) {
 911                         Tcl_DeleteHashEntry(entryPtr);
 912                         refresh = 1;
 913                     }
 914                 } else {
 915                     /*
 916                      * Add a key to the hash table and set it to point to the
 917                      * Tag structure if it wasn't the same as an existing one
 918                      */
 919                     entryPtr = Tcl_CreateHashEntry(hashTblPtr,
 920                             (char *) value, &newEntry);
 921                     if (newEntry || (tagPtr !=
 922                             (TableTag *) Tcl_GetHashValue(entryPtr))) {
 923                         Tcl_SetHashValue(entryPtr, (ClientData) tagPtr);
 924                         refresh = 1;
 925                     }
 926                 }
 927                 /* and invalidate the row or column affected */
 928                 if (refresh) {
 929                     if (cmdIndex == TAG_ROWTAG) {
 930                         TableRefresh(tablePtr, value-tablePtr->rowOffset, 0,
 931                                 ROW);
 932                     } else {
 933                         TableRefresh(tablePtr, 0, value-tablePtr->colOffset,
 934                                 COL);
 935                     }
 936                 }
 937             }
 938             return TCL_OK;      /* COLTAG && ROWTAG */
 939         }
 940
 941         case TAG_CGET:
 942             if (objc != 5) {
 943                 Tcl_WrongNumArgs(interp, 3, objv, "tagName option");
 944                 return TCL_ERROR;
 945             }
 946             tagname  = Tcl_GetString(objv[3]);
 947             entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
 948             if (entryPtr == NULL) {
 949                 goto invalidtag;
 950             } else {
 951                 tagPtr = (TableTag *) Tcl_GetHashValue (entryPtr);
 952                 result = Tk_ConfigureValue(interp, tablePtr->tkwin, tagConfig,
 953                         (char *) tagPtr, Tcl_GetString(objv[4]), 0);
 954             }
 955             return result;      /* CGET */
 956
 957         case TAG_CONFIGURE:
 958             if (objc < 4) {
 959                 Tcl_WrongNumArgs(interp, 3, objv, "tagName ?arg arg  ...?");
 960                 return TCL_ERROR;
 961             }
 962
 963             /*
 964              * Get the pointer to the tag structure.  If it doesn't
 965              * exist, it will be created.
 966              */
 967             tagPtr = TableTagGetEntry(tablePtr, Tcl_GetString(objv[3]),
 968                     0, NULL);
 969
 970             /*
 971              * If there were less than 6 args, we return the configuration
 972              * (for all or just one option), even for new tags
 973              */
 974             if (objc < 6) {
 975                 result = Tk_ConfigureInfo(interp, tablePtr->tkwin, tagConfig,
 976                         (char *) tagPtr, (objc == 5) ?
 977                         Tcl_GetString(objv[4]) : NULL, 0);
 978             } else {
 979                 char **argv;
 980
 981                 /* Stringify */
 982                 argv = (char **) ckalloc((objc + 1) * sizeof(char *));
 983                 for (i = 0; i < objc; i++)
 984                     argv[i] = Tcl_GetString(objv[i]);
 985                 argv[objc] = NULL;
 986
 987                 result = Tk_ConfigureWidget(interp, tablePtr->tkwin,
 988                         tagConfig, objc-4, argv+4, (char *) tagPtr,
 989                         TK_CONFIG_ARGV_ONLY);
 990                 ckfree((char *) argv);
 991                 if (result == TCL_ERROR) {
 992                     return TCL_ERROR;
 993                 }
 994
 995                 /*
 996                  * Handle change of image name
 997                  */
 998                 if (tagPtr->imageStr) {
 999                     image = Tk_GetImage(interp, tablePtr->tkwin,
1000                             tagPtr->imageStr,
1001                             TableImageProc, (ClientData)tablePtr);
1002                     if (image == NULL) {
1003                         result = TCL_ERROR;
1004                     }
1005                 } else {
1006                     image = NULL;
1007                 }
1008                 if (tagPtr->image) {
1009                     Tk_FreeImage(tagPtr->image);
1010                 }
1011                 tagPtr->image = image;
1012
1013                 /*
1014                  * We reconfigured, so invalidate the table to redraw
1015                  */
1016                 TableInvalidateAll(tablePtr, 0);
1017             }
1018             return result;
1019
1020         case TAG_DELETE:
1021             /* delete a tag */
1022             if (objc < 4) {
1023                 Tcl_WrongNumArgs(interp, 3, objv, "tagName ?tagName ...?");
1024                 return TCL_ERROR;
1025             }
1026             /* run through the remaining arguments */
1027             for (i = 3; i < objc; i++) {
1028                 tagname  = Tcl_GetString(objv[i]);
1029                 /* cannot delete the title tag */
1030                 if (STREQ(tagname, "title") ||
1031                         STREQ(tagname, "sel") ||
1032                         STREQ(tagname, "flash") ||
1033                         STREQ(tagname, "active")) {
1034                     Tcl_AppendStringsToObj(resultPtr, "cannot delete ",
1035                             tagname, " tag", (char *) NULL);
1036                     return TCL_ERROR;
1037                 }
1038                 entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
1039                 if (entryPtr != NULL) {
1040                     /* get the tag pointer */
1041                     tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
1042
1043                     /* delete all references to this tag in rows */
1044                     scanPtr = Tcl_FirstHashEntry(tablePtr->rowStyles, &search);
1045                     for (; scanPtr != NULL;
1046                          scanPtr = Tcl_NextHashEntry(&search)) {
1047                         if ((TableTag *)Tcl_GetHashValue(scanPtr) == tagPtr) {
1048                             Tcl_DeleteHashEntry(scanPtr);
1049                             refresh = 1;
1050                         }
1051                     }
1052
1053                     /* delete all references to this tag in cols */
1054                     scanPtr = Tcl_FirstHashEntry(tablePtr->colStyles, &search);
1055                     for (; scanPtr != NULL;
1056                          scanPtr = Tcl_NextHashEntry(&search)) {
1057                         if ((TableTag *)Tcl_GetHashValue(scanPtr) == tagPtr) {
1058                             Tcl_DeleteHashEntry(scanPtr);
1059                             refresh = 1;
1060                         }
1061                     }
1062
1063                     /* delete all references to this tag in cells */
1064                     scanPtr = Tcl_FirstHashEntry(tablePtr->cellStyles,
1065                             &search);
1066                     for (; scanPtr != NULL;
1067                          scanPtr = Tcl_NextHashEntry(&search)) {
1068                         if ((TableTag *)Tcl_GetHashValue(scanPtr) == tagPtr) {
1069                             Tcl_DeleteHashEntry(scanPtr);
1070                             refresh = 1;
1071                         }
1072                     }
1073
1074                     /*
1075                      * Remove the tag from the prio list and collapse
1076                      * the rest of the tags.  We could check for shrinking
1077                      * the prio list as well.
1078                      */
1079                     for (i = 0; i < tablePtr->tagPrioSize; i++) {
1080                         if (tablePtr->tagPrios[i] == tagPtr) break;
1081                     }
1082                     for ( ; i < tablePtr->tagPrioSize; i++) {
1083                         tablePtr->tagPrioNames[i] =
1084                             tablePtr->tagPrioNames[i+1];
1085                         tablePtr->tagPrios[i] = tablePtr->tagPrios[i+1];
1086                     }
1087                     tablePtr->tagPrioSize--;
1088
1089                     /* Release the tag structure */
1090                     TableCleanupTag(tablePtr, tagPtr);
1091                     ckfree((char *) tagPtr);
1092
1093                     /* And free the hash table entry */
1094                     Tcl_DeleteHashEntry(entryPtr);
1095                 }
1096             }
1097             /* since we deleted a tag, redraw the screen */
1098             if (refresh) {
1099                 TableInvalidateAll(tablePtr, 0);
1100             }
1101             return result;
1102
1103         case TAG_EXISTS:
1104             if (objc != 4) {
1105                 Tcl_WrongNumArgs(interp, 3, objv, "tagName");
1106                 return TCL_ERROR;
1107             }
1108             Tcl_SetBooleanObj(resultPtr,
1109                     (Tcl_FindHashEntry(tablePtr->tagTable,
1110                             Tcl_GetString(objv[3])) != NULL));
1111             return TCL_OK;
1112
1113         case TAG_INCLUDES:
1114             /* does a tag contain a index ? */
1115             if (objc != 5) {
1116                 Tcl_WrongNumArgs(interp, 3, objv, "tag index");
1117                 return TCL_ERROR;
1118             }
1119             tagname  = Tcl_GetString(objv[3]);
1120             /* check to see if the tag actually exists */
1121             entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
1122             if (entryPtr == NULL) {
1123                 /* Unknown tag, just return 0 */
1124                 Tcl_SetBooleanObj(resultPtr, 0);
1125                 return TCL_OK;
1126             }
1127             /* parse index */
1128             if (TableGetIndexObj(tablePtr, objv[4], &row, &col) != TCL_OK) {
1129                 return TCL_ERROR;
1130             }
1131             /* create hash key */
1132             TableMakeArrayIndex(row, col, buf);
1133
1134             if (STREQ(tagname, "active")) {
1135                 result = (tablePtr->activeRow+tablePtr->rowOffset==row &&
1136                         tablePtr->activeCol+tablePtr->colOffset==col);
1137             } else if (STREQ(tagname, "flash")) {
1138                 result = (tablePtr->flashMode &&
1139                         (Tcl_FindHashEntry(tablePtr->flashCells, buf)
1140                                 != NULL));
1141             } else if (STREQ(tagname, "sel")) {
1142                 result = (Tcl_FindHashEntry(tablePtr->selCells, buf) != NULL);
1143             } else if (STREQ(tagname, "title")) {
1144                 result = (row < tablePtr->titleRows+tablePtr->rowOffset ||
1145                         col < tablePtr->titleCols+tablePtr->colOffset);
1146             } else {
1147                 /* get the pointer to the tag structure */
1148                 tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
1149                 scanPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf);
1150                 /*
1151                  * Look to see if there is a cell, row, or col tag
1152                  * for this cell
1153                  */
1154                 result = ((scanPtr &&
1155                         (tagPtr == (TableTag *) Tcl_GetHashValue(scanPtr))) ||
1156                         (tagPtr == FindRowColTag(tablePtr, row, ROW)) ||
1157                         (tagPtr == FindRowColTag(tablePtr, col, COL)));
1158             }
1159             /*
1160              * Because we may call FindRowColTag above, we can't use
1161              * the resultPtr, but this is almost equivalent, and is SAFE
1162              */
1163             Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
1164             return TCL_OK;
1165
1166         case TAG_NAMES:
1167             /*
1168              * Print out the tag names in priority order
1169              */
1170             if (objc < 3 || objc > 4) {
1171                 Tcl_WrongNumArgs(interp, 3, objv, "?pattern?");
1172                 return TCL_ERROR;
1173             }
1174             tagname = (objc == 4) ? Tcl_GetString(objv[3]) : NULL;
1175             for (i = 0; i < tablePtr->tagPrioSize; i++) {
1176                 keybuf = tablePtr->tagPrioNames[i];
1177                 if (objc == 3 || Tcl_StringMatch(keybuf, tagname)) {
1178                     objPtr = Tcl_NewStringObj(keybuf, -1);
1179                     Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
1180                 }
1181             }
1182             return TCL_OK;
1183
1184         case TAG_LOWER:
1185         case TAG_RAISE:
1186             /*
1187              * Change priority of the named tag
1188              */
1189             if (objc != 4 && objc != 5) {
1190                 Tcl_WrongNumArgs(interp, 3, objv, (cmdIndex == TAG_LOWER) ?
1191                         "tagName ?belowThis?" : "tagName ?aboveThis?");
1192                 return TCL_ERROR;
1193             }
1194             tagname  = Tcl_GetString(objv[3]);
1195             /* check to see if the tag actually exists */
1196             entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
1197             if (entryPtr == NULL) {
1198                 goto invalidtag;
1199             }
1200             tagPtr  = (TableTag *) Tcl_GetHashValue(entryPtr);
1201             tagPrio = TableTagGetPriority(tablePtr, tagPtr);
1202             keybuf  = tablePtr->tagPrioNames[tagPrio];
1203             /*
1204              * In the RAISE case, the priority is one higher (-1) because
1205              * we want the named tag to move above the other in priority.
1206              */
1207             if (objc == 5) {
1208                 tagname  = Tcl_GetString(objv[4]);
1209                 entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, tagname);
1210                 if (entryPtr == NULL) {
1211                     goto invalidtag;
1212                 }
1213                 tag2Ptr  = (TableTag *) Tcl_GetHashValue(entryPtr);
1214                 if (cmdIndex == TAG_LOWER) {
1215                     value = TableTagGetPriority(tablePtr, tag2Ptr);
1216                 } else {
1217                     value = TableTagGetPriority(tablePtr, tag2Ptr) - 1;
1218                 }
1219             } else {
1220                 if (cmdIndex == TAG_LOWER) {
1221                     /*
1222                      * Lower this tag's priority to the bottom.
1223                      */
1224                     value = tablePtr->tagPrioSize - 1;
1225                 } else {
1226                     /*
1227                      * Raise this tag's priority to the top.
1228                      */
1229                     value = -1;
1230                 }
1231             }
1232             if (value < tagPrio) {
1233                 /*
1234                  * Move tag up in priority.
1235                  */
1236                 for (i = tagPrio; i > value; i--) {
1237                     tablePtr->tagPrioNames[i] = tablePtr->tagPrioNames[i-1];
1238                     tablePtr->tagPrios[i]     = tablePtr->tagPrios[i-1];
1239                 }
1240                 i++;
1241                 tablePtr->tagPrioNames[i] = keybuf;
1242                 tablePtr->tagPrios[i]     = tagPtr;
1243                 refresh = 1;
1244             } else if (value > tagPrio) {
1245                 /*
1246                  * Move tag down in priority.
1247                  */
1248                 for (i = tagPrio; i < value; i++) {
1249                     tablePtr->tagPrioNames[i] = tablePtr->tagPrioNames[i+1];
1250                     tablePtr->tagPrios[i]     = tablePtr->tagPrios[i+1];
1251                 }
1252                 tablePtr->tagPrioNames[i] = keybuf;
1253                 tablePtr->tagPrios[i]     = tagPtr;
1254                 refresh = 1;
1255             }
1256             /* since we deleted a tag, redraw the screen */
1257             if (refresh) {
1258                 TableInvalidateAll(tablePtr, 0);
1259             }
1260             return TCL_OK;
1261
1262     }
1263     return TCL_OK;
1264
1265     invalidtag:
1266     /*
1267      * When jumping here, ensure the invalid 'tagname' is set already.
1268      */
1269     Tcl_AppendStringsToObj(resultPtr, "invalid tag name \"",
1270             tagname, "\"", (char *) NULL);
1271     return TCL_ERROR;
1272 }