tk/generic/tkFont.c

   1 /*
   2  * tkFont.c --
   3  *
   4  *      This file maintains a database of fonts for the Tk toolkit.
   5  *      It also provides several utility procedures for measuring and
   6  *      displaying text.
   7  *
   8  * Copyright (c) 1990-1994 The Regents of the University of California.
   9  * Copyright (c) 1994-1998 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 "tkPort.h"
  18 #include "tkInt.h"
  19 #include "tkFont.h"
  20
  21 /*
  22  * The following structure is used to keep track of all the fonts that
  23  * exist in the current application.  It must be stored in the
  24  * TkMainInfo for the application.
  25  */
  26
  27 typedef struct TkFontInfo {
  28     Tcl_HashTable fontCache;    /* Map a string to an existing Tk_Font.
  29                                  * Keys are string font names, values are
  30                                  * TkFont pointers. */
  31     Tcl_HashTable namedTable;   /* Map a name to a set of attributes for a
  32                                  * font, used when constructing a Tk_Font from
  33                                  * a named font description.  Keys are
  34                                  * strings, values are NamedFont pointers. */
  35     TkMainInfo *mainPtr;        /* Application that owns this structure. */
  36     int updatePending;          /* Non-zero when a World Changed event has
  37                                  * already been queued to handle a change to
  38                                  * a named font. */
  39 } TkFontInfo;
  40
  41 /*
  42  * The following data structure is used to keep track of the font attributes
  43  * for each named font that has been defined.  The named font is only deleted
  44  * when the last reference to it goes away.
  45  */
  46
  47 typedef struct NamedFont {
  48     int refCount;               /* Number of users of named font. */
  49     int deletePending;          /* Non-zero if font should be deleted when
  50                                  * last reference goes away. */
  51     TkFontAttributes fa;        /* Desired attributes for named font. */
  52 } NamedFont;
  53
  54 /*
  55  * The following two structures are used to keep track of string
  56  * measurement information when using the text layout facilities.
  57  *
  58  * A LayoutChunk represents a contiguous range of text that can be measured
  59  * and displayed by low-level text calls.  In general, chunks will be
  60  * delimited by newlines and tabs.  Low-level, platform-specific things
  61  * like kerning and non-integer character widths may occur between the
  62  * characters in a single chunk, but not between characters in different
  63  * chunks.
  64  *
  65  * A TextLayout is a collection of LayoutChunks.  It can be displayed with
  66  * respect to any origin.  It is the implementation of the Tk_TextLayout
  67  * opaque token.
  68  */
  69
  70 typedef struct LayoutChunk {
  71     CONST char *start;          /* Pointer to simple string to be displayed.
  72                                  * This is a pointer into the TkTextLayout's
  73                                  * string. */
  74     int numBytes;               /* The number of bytes in this chunk. */
  75     int numChars;               /* The number of characters in this chunk. */
  76     int numDisplayChars;        /* The number of characters to display when
  77                                  * this chunk is displayed.  Can be less than
  78                                  * numChars if extra space characters were
  79                                  * absorbed by the end of the chunk.  This
  80                                  * will be < 0 if this is a chunk that is
  81                                  * holding a tab or newline. */
  82     int x, y;                   /* The origin of the first character in this
  83                                  * chunk with respect to the upper-left hand
  84                                  * corner of the TextLayout. */
  85     int totalWidth;             /* Width in pixels of this chunk.  Used
  86                                  * when hit testing the invisible spaces at
  87                                  * the end of a chunk. */
  88     int displayWidth;           /* Width in pixels of the displayable
  89                                  * characters in this chunk.  Can be less than
  90                                  * width if extra space characters were
  91                                  * absorbed by the end of the chunk. */
  92 } LayoutChunk;
  93
  94 typedef struct TextLayout {
  95     Tk_Font tkfont;             /* The font used when laying out the text. */
  96     CONST char *string;         /* The string that was layed out. */
  97     int width;                  /* The maximum width of all lines in the
  98                                  * text layout. */
  99     int numChunks;              /* Number of chunks actually used in
 100                                  * following array. */
 101     LayoutChunk chunks[1];      /* Array of chunks.  The actual size will
 102                                  * be maxChunks.  THIS FIELD MUST BE THE LAST
 103                                  * IN THE STRUCTURE. */
 104 } TextLayout;
 105
 106 /*
 107  * The following structures are used as two-way maps between the values for
 108  * the fields in the TkFontAttributes structure and the strings used in
 109  * Tcl, when parsing both option-value format and style-list format font
 110  * name strings.
 111  */
 112
 113 static TkStateMap weightMap[] = {
 114     {TK_FW_NORMAL,      "normal"},
 115     {TK_FW_BOLD,        "bold"},
 116     {TK_FW_UNKNOWN,     NULL}
 117 };
 118
 119 static TkStateMap slantMap[] = {
 120     {TK_FS_ROMAN,       "roman"},
 121     {TK_FS_ITALIC,      "italic"},
 122     {TK_FS_UNKNOWN,     NULL}
 123 };
 124
 125 static TkStateMap underlineMap[] = {
 126     {1,                 "underline"},
 127     {0,                 NULL}
 128 };
 129
 130 static TkStateMap overstrikeMap[] = {
 131     {1,                 "overstrike"},
 132     {0,                 NULL}
 133 };
 134
 135 /*
 136  * The following structures are used when parsing XLFD's into a set of
 137  * TkFontAttributes.
 138  */
 139
 140 static TkStateMap xlfdWeightMap[] = {
 141     {TK_FW_NORMAL,      "normal"},
 142     {TK_FW_NORMAL,      "medium"},
 143     {TK_FW_NORMAL,      "book"},
 144     {TK_FW_NORMAL,      "light"},
 145     {TK_FW_BOLD,        "bold"},
 146     {TK_FW_BOLD,        "demi"},
 147     {TK_FW_BOLD,        "demibold"},
 148     {TK_FW_NORMAL,      NULL}           /* Assume anything else is "normal". */
 149 };
 150
 151 static TkStateMap xlfdSlantMap[] = {
 152     {TK_FS_ROMAN,       "r"},
 153     {TK_FS_ITALIC,      "i"},
 154     {TK_FS_OBLIQUE,     "o"},
 155     {TK_FS_ROMAN,       NULL}           /* Assume anything else is "roman". */
 156 };
 157
 158 static TkStateMap xlfdSetwidthMap[] = {
 159     {TK_SW_NORMAL,      "normal"},
 160     {TK_SW_CONDENSE,    "narrow"},
 161     {TK_SW_CONDENSE,    "semicondensed"},
 162     {TK_SW_CONDENSE,    "condensed"},
 163     {TK_SW_UNKNOWN,     NULL}
 164 };
 165
 166 /*
 167  * The following structure and defines specify the valid builtin options
 168  * when configuring a set of font attributes.
 169  */
 170
 171 static CONST char *fontOpt[] = {
 172     "-family",
 173     "-size",
 174     "-weight",
 175     "-slant",
 176     "-underline",
 177     "-overstrike",
 178     NULL
 179 };
 180
 181 #define FONT_FAMILY     0
 182 #define FONT_SIZE       1
 183 #define FONT_WEIGHT     2
 184 #define FONT_SLANT      3
 185 #define FONT_UNDERLINE  4
 186 #define FONT_OVERSTRIKE 5
 187 #define FONT_NUMFIELDS  6
 188
 189 /*
 190  * Hardcoded font aliases.  These are used to describe (mostly) identical
 191  * fonts whose names differ from platform to platform.  If the
 192  * user-supplied font name matches any of the names in one of the alias
 193  * lists, the other names in the alias list are also automatically tried.
 194  */
 195
 196 static char *timesAliases[] = {
 197     "Times",                    /* Unix. */
 198     "Times New Roman",          /* Windows. */
 199     "New York",                 /* Mac. */
 200     NULL
 201 };
 202
 203 static char *helveticaAliases[] = {
 204     "Helvetica",                /* Unix. */
 205     "Arial",                    /* Windows. */
 206     "Geneva",                   /* Mac. */
 207     NULL
 208 };
 209
 210 static char *courierAliases[] = {
 211     "Courier",                  /* Unix and Mac. */
 212     "Courier New",              /* Windows. */
 213     NULL
 214 };
 215
 216 static char *minchoAliases[] = {
 217     "mincho",                   /* Unix. */
 218     "\357\274\255\357\274\263 \346\230\216\346\234\235",
 219                                 /* Windows (MS mincho). */
 220     "\346\234\254\346\230\216\346\234\235\342\210\222\357\274\255",
 221                                 /* Mac (honmincho-M). */
 222     NULL
 223 };
 224
 225 static char *gothicAliases[] = {
 226     "gothic",                   /* Unix. */
 227     "\357\274\255\357\274\263 \343\202\264\343\202\267\343\203\203\343\202\257",
 228                                 /* Windows (MS goshikku). */
 229     "\344\270\270\343\202\264\343\202\267\343\203\203\343\202\257\342\210\222\357\274\255",
 230                                 /* Mac (goshikku-M). */
 231     NULL
 232 };
 233
 234 static char *dingbatsAliases[] = {
 235     "dingbats", "zapfdingbats", "itc zapfdingbats",
 236                                 /* Unix. */
 237                                 /* Windows. */
 238     "zapf dingbats",            /* Mac. */
 239     NULL
 240 };
 241
 242 static char **fontAliases[] = {
 243     timesAliases,
 244     helveticaAliases,
 245     courierAliases,
 246     minchoAliases,
 247     gothicAliases,
 248     dingbatsAliases,
 249     NULL
 250 };
 251
 252 /*
 253  * Hardcoded font classes.  If the character cannot be found in the base
 254  * font, the classes are examined in order to see if some other similar
 255  * font should be examined also.
 256  */
 257
 258 static char *systemClass[] = {
 259     "fixed",                            /* Unix. */
 260                                         /* Windows. */
 261     "chicago", "osaka", "sistemny",     /* Mac. */
 262     NULL
 263 };
 264
 265 static char *serifClass[] = {
 266     "times", "palatino", "mincho",      /* All platforms. */
 267     "song ti",                          /* Unix. */
 268     "ms serif", "simplified arabic",    /* Windows. */
 269     "latinski",                         /* Mac. */
 270     NULL
 271 };
 272
 273 static char *sansClass[] = {
 274     "helvetica", "gothic",              /* All platforms. */
 275                                         /* Unix. */
 276     "ms sans serif", "traditional arabic",
 277                                         /* Windows. */
 278     "bastion",                          /* Mac. */
 279     NULL
 280 };
 281
 282 static char *monoClass[] = {
 283     "courier", "gothic",                /* All platforms. */
 284     "fangsong ti",                      /* Unix. */
 285     "simplified arabic fixed",          /* Windows. */
 286     "monaco", "pryamoy",                /* Mac. */
 287     NULL
 288 };
 289
 290 static char *symbolClass[] = {
 291     "symbol", "dingbats", "wingdings", NULL
 292 };
 293
 294 static char **fontFallbacks[] = {
 295     systemClass,
 296     serifClass,
 297     sansClass,
 298     monoClass,
 299     symbolClass,
 300     NULL
 301 };
 302
 303 /*
 304  * Global fallbacks.  If the character could not be found in the preferred
 305  * fallback list, this list is examined.  If the character still cannot be
 306  * found, all font families in the system are examined.
 307  */
 308
 309 static char *globalFontClass[] = {
 310     "symbol",                   /* All platforms. */
 311                                 /* Unix. */
 312     "lucida sans unicode",      /* Windows. */
 313     "bitstream cyberbit",       /* Windows popular CJK font */
 314     "chicago",                  /* Mac. */
 315     NULL
 316 };
 317
 318 #define GetFontAttributes(tkfont) \
 319                 ((CONST TkFontAttributes *) &((TkFont *) (tkfont))->fa)
 320
 321 #define GetFontMetrics(tkfont)    \
 322                 ((CONST TkFontMetrics *) &((TkFont *) (tkfont))->fm)
 323
 324
 325 static int              ConfigAttributesObj _ANSI_ARGS_((Tcl_Interp *interp,
 326                             Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[],
 327                             TkFontAttributes *faPtr));
 328 static int              CreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
 329                             Tk_Window tkwin, CONST char *name,
 330                             TkFontAttributes *faPtr));
 331 static void             DupFontObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
 332                             Tcl_Obj *dupObjPtr));
 333 static int              FieldSpecified _ANSI_ARGS_((CONST char *field));
 334 static void             FreeFontObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
 335 static int              GetAttributeInfoObj _ANSI_ARGS_((Tcl_Interp *interp,
 336                             CONST TkFontAttributes *faPtr, Tcl_Obj *objPtr));
 337 static LayoutChunk *    NewChunk _ANSI_ARGS_((TextLayout **layoutPtrPtr,
 338                             int *maxPtr, CONST char *start, int numChars,
 339                             int curX, int newX, int y));
 340 static int              ParseFontNameObj _ANSI_ARGS_((Tcl_Interp *interp,
 341                             Tk_Window tkwin, Tcl_Obj *objPtr,
 342                             TkFontAttributes *faPtr));
 343 static void             RecomputeWidgets _ANSI_ARGS_((TkWindow *winPtr));
 344 static int              SetFontFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 345                             Tcl_Obj *objPtr));
 346 static void             TheWorldHasChanged _ANSI_ARGS_((
 347                             ClientData clientData));
 348 static void             UpdateDependentFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
 349                             Tk_Window tkwin, Tcl_HashEntry *namedHashPtr));
 350
 351 /*
 352  * The following structure defines the implementation of the "font" Tcl
 353  * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of
 354  * each font object points to the TkFont structure for the font, or
 355  * NULL.
 356  */
 357
 358 Tcl_ObjType tkFontObjType = {
 359     "font",                     /* name */
 360     FreeFontObjProc,            /* freeIntRepProc */
 361     DupFontObjProc,             /* dupIntRepProc */
 362     NULL,                       /* updateStringProc */
 363     SetFontFromAny              /* setFromAnyProc */
 364 };
 365
 366 \f
 367 /*
 368  *---------------------------------------------------------------------------
 369  *
 370  * TkFontPkgInit --
 371  *
 372  *      This procedure is called when an application is created.  It
 373  *      initializes all the structures that are used by the font
 374  *      package on a per application basis.
 375  *
 376  * Results:
 377  *      Stores a token in the mainPtr to hold information needed by this
 378  *      package on a per application basis.
 379  *
 380  * Side effects:
 381  *      Memory allocated.
 382  *
 383  *---------------------------------------------------------------------------
 384  */
 385 void
 386 TkFontPkgInit(mainPtr)
 387     TkMainInfo *mainPtr;        /* The application being created. */
 388 {
 389     TkFontInfo *fiPtr;
 390
 391     fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo));
 392     Tcl_InitHashTable(&fiPtr->fontCache, TCL_STRING_KEYS);
 393     Tcl_InitHashTable(&fiPtr->namedTable, TCL_STRING_KEYS);
 394     fiPtr->mainPtr = mainPtr;
 395     fiPtr->updatePending = 0;
 396     mainPtr->fontInfoPtr = fiPtr;
 397
 398     TkpFontPkgInit(mainPtr);
 399 }
 400 \f
 401 /*
 402  *---------------------------------------------------------------------------
 403  *
 404  * TkFontPkgFree --
 405  *
 406  *      This procedure is called when an application is deleted.  It
 407  *      deletes all the structures that were used by the font package
 408  *      for this application.
 409  *
 410  * Results:
 411  *      None.
 412  *
 413  * Side effects:
 414  *      Memory freed.
 415  *
 416  *---------------------------------------------------------------------------
 417  */
 418
 419 void
 420 TkFontPkgFree(mainPtr)
 421     TkMainInfo *mainPtr;        /* The application being deleted. */
 422 {
 423     TkFontInfo *fiPtr;
 424     Tcl_HashEntry *hPtr, *searchPtr;
 425     Tcl_HashSearch search;
 426     int fontsLeft;
 427
 428     fiPtr = mainPtr->fontInfoPtr;
 429
 430     fontsLeft = 0;
 431     for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
 432             searchPtr != NULL;
 433             searchPtr = Tcl_NextHashEntry(&search)) {
 434         fontsLeft++;
 435         fprintf(stderr, "Font %s still in cache.\n",
 436                 Tcl_GetHashKey(&fiPtr->fontCache, searchPtr));
 437     }
 438 #ifdef PURIFY
 439     if (fontsLeft) {
 440         panic("TkFontPkgFree: all fonts should have been freed already");
 441     }
 442 #endif
 443     Tcl_DeleteHashTable(&fiPtr->fontCache);
 444
 445     hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
 446     while (hPtr != NULL) {
 447         ckfree((char *) Tcl_GetHashValue(hPtr));
 448         hPtr = Tcl_NextHashEntry(&search);
 449     }
 450     Tcl_DeleteHashTable(&fiPtr->namedTable);
 451     if (fiPtr->updatePending != 0) {
 452         Tcl_CancelIdleCall(TheWorldHasChanged, (ClientData) fiPtr);
 453     }
 454     ckfree((char *) fiPtr);
 455 }
 456 \f
 457 /*
 458  *---------------------------------------------------------------------------
 459  *
 460  * Tk_FontObjCmd --
 461  *
 462  *      This procedure is implemented to process the "font" Tcl command.
 463  *      See the user documentation for details on what it does.
 464  *
 465  * Results:
 466  *      A standard Tcl result.
 467  *
 468  * Side effects:
 469  *      See the user documentation.
 470  *
 471  *----------------------------------------------------------------------
 472  */
 473
 474 int
 475 Tk_FontObjCmd(clientData, interp, objc, objv)
 476     ClientData clientData;      /* Main window associated with interpreter. */
 477     Tcl_Interp *interp;         /* Current interpreter. */
 478     int objc;                   /* Number of arguments. */
 479     Tcl_Obj *CONST objv[];      /* Argument objects. */
 480 {
 481     int index;
 482     Tk_Window tkwin;
 483     TkFontInfo *fiPtr;
 484     static CONST char *optionStrings[] = {
 485         "actual",       "configure",    "create",       "delete",
 486         "families",     "measure",      "metrics",      "names",
 487         NULL
 488     };
 489     enum options {
 490         FONT_ACTUAL,    FONT_CONFIGURE, FONT_CREATE,    FONT_DELETE,
 491         FONT_FAMILIES,  FONT_MEASURE,   FONT_METRICS,   FONT_NAMES
 492     };
 493
 494     tkwin = (Tk_Window) clientData;
 495     fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
 496
 497     if (objc < 2) {
 498         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
 499         return TCL_ERROR;
 500     }
 501     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
 502             &index) != TCL_OK) {
 503         return TCL_ERROR;
 504     }
 505
 506     switch ((enum options) index) {
 507         case FONT_ACTUAL: {
 508             int skip, result;
 509             Tk_Font tkfont;
 510             Tcl_Obj *objPtr;
 511             CONST TkFontAttributes *faPtr;
 512
 513             skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
 514             if (skip < 0) {
 515                 return TCL_ERROR;
 516             }
 517             if ((objc < 3) || (objc - skip > 4)) {
 518                 Tcl_WrongNumArgs(interp, 2, objv,
 519                         "font ?-displayof window? ?option?");
 520                 return TCL_ERROR;
 521             }
 522             tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
 523             if (tkfont == NULL) {
 524                 return TCL_ERROR;
 525             }
 526             objc -= skip;
 527             objv += skip;
 528             faPtr = GetFontAttributes(tkfont);
 529             objPtr = NULL;
 530             if (objc > 3) {
 531                 objPtr = objv[3];
 532             }
 533             result = GetAttributeInfoObj(interp, faPtr, objPtr);
 534             Tk_FreeFont(tkfont);
 535             return result;
 536         }
 537         case FONT_CONFIGURE: {
 538             int result;
 539             char *string;
 540             Tcl_Obj *objPtr;
 541             NamedFont *nfPtr;
 542             Tcl_HashEntry *namedHashPtr;
 543
 544             if (objc < 3) {
 545                 Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?");
 546                 return TCL_ERROR;
 547             }
 548             string = Tcl_GetString(objv[2]);
 549             namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
 550             nfPtr = NULL;               /* lint. */
 551             if (namedHashPtr != NULL) {
 552                 nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
 553             }
 554             if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) {
 555                 Tcl_AppendResult(interp, "named font \"", string,
 556                         "\" doesn't exist", NULL);
 557                 return TCL_ERROR;
 558             }
 559             if (objc == 3) {
 560                 objPtr = NULL;
 561             } else if (objc == 4) {
 562                 objPtr = objv[3];
 563             } else {
 564                 result = ConfigAttributesObj(interp, tkwin, objc - 3,
 565                         objv + 3, &nfPtr->fa);
 566                 UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
 567                 return result;
 568             }
 569             return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
 570         }
 571         case FONT_CREATE: {
 572             int skip, i;
 573             char *name;
 574             char buf[16 + TCL_INTEGER_SPACE];
 575             TkFontAttributes fa;
 576             Tcl_HashEntry *namedHashPtr;
 577
 578             skip = 3;
 579             if (objc < 3) {
 580                 name = NULL;
 581             } else {
 582                 name = Tcl_GetString(objv[2]);
 583                 if (name[0] == '-') {
 584                     name = NULL;
 585                 }
 586             }
 587             if (name == NULL) {
 588                 /*
 589                  * No font name specified.  Generate one of the form "fontX".
 590                  */
 591
 592                 for (i = 1; ; i++) {
 593                     sprintf(buf, "font%d", i);
 594                     namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, buf);
 595                     if (namedHashPtr == NULL) {
 596                         break;
 597                     }
 598                 }
 599                 name = buf;
 600                 skip = 2;
 601             }
 602             TkInitFontAttributes(&fa);
 603             if (ConfigAttributesObj(interp, tkwin, objc - skip, objv + skip,
 604                     &fa) != TCL_OK) {
 605                 return TCL_ERROR;
 606             }
 607             if (CreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
 608                 return TCL_ERROR;
 609             }
 610             Tcl_AppendResult(interp, name, NULL);
 611             break;
 612         }
 613         case FONT_DELETE: {
 614             int i;
 615             char *string;
 616             NamedFont *nfPtr;
 617             Tcl_HashEntry *namedHashPtr;
 618
 619             /*
 620              * Delete the named font.  If there are still widgets using this
 621              * font, then it isn't deleted right away.
 622              */
 623
 624             if (objc < 3) {
 625                 Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?");
 626                 return TCL_ERROR;
 627             }
 628             for (i = 2; i < objc; i++) {
 629                 string = Tcl_GetString(objv[i]);
 630                 namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
 631                 if (namedHashPtr == NULL) {
 632                     Tcl_AppendResult(interp, "named font \"", string,
 633                             "\" doesn't exist", (char *) NULL);
 634                     return TCL_ERROR;
 635                 }
 636                 nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
 637                 if (nfPtr->refCount != 0) {
 638                     nfPtr->deletePending = 1;
 639                 } else {
 640                     Tcl_DeleteHashEntry(namedHashPtr);
 641                     ckfree((char *) nfPtr);
 642                 }
 643             }
 644             break;
 645         }
 646         case FONT_FAMILIES: {
 647             int skip;
 648
 649             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
 650             if (skip < 0) {
 651                 return TCL_ERROR;
 652             }
 653             if (objc - skip != 2) {
 654                 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
 655                 return TCL_ERROR;
 656             }
 657             TkpGetFontFamilies(interp, tkwin);
 658             break;
 659         }
 660         case FONT_MEASURE: {
 661             char *string;
 662             Tk_Font tkfont;
 663             int length, skip;
 664             Tcl_Obj *resultPtr;
 665
 666             skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
 667             if (skip < 0) {
 668                 return TCL_ERROR;
 669             }
 670             if (objc - skip != 4) {
 671                 Tcl_WrongNumArgs(interp, 2, objv,
 672                         "font ?-displayof window? text");
 673                 return TCL_ERROR;
 674             }
 675             tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
 676             if (tkfont == NULL) {
 677                 return TCL_ERROR;
 678             }
 679             string = Tcl_GetStringFromObj(objv[3 + skip], &length);
 680             resultPtr = Tcl_GetObjResult(interp);
 681             Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length));
 682             Tk_FreeFont(tkfont);
 683             break;
 684         }
 685         case FONT_METRICS: {
 686             Tk_Font tkfont;
 687             int skip, index, i;
 688             CONST TkFontMetrics *fmPtr;
 689             static CONST char *switches[] = {
 690                 "-ascent", "-descent", "-linespace", "-fixed", NULL
 691             };
 692
 693             skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
 694             if (skip < 0) {
 695                 return TCL_ERROR;
 696             }
 697             if ((objc < 3) || ((objc - skip) > 4)) {
 698                 Tcl_WrongNumArgs(interp, 2, objv,
 699                         "font ?-displayof window? ?option?");
 700                 return TCL_ERROR;
 701             }
 702             tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
 703             if (tkfont == NULL) {
 704                 return TCL_ERROR;
 705             }
 706             objc -= skip;
 707             objv += skip;
 708             fmPtr = GetFontMetrics(tkfont);
 709             if (objc == 3) {
 710                 char buf[64 + TCL_INTEGER_SPACE * 4];
 711
 712                 sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d",
 713                         fmPtr->ascent, fmPtr->descent,
 714                         fmPtr->ascent + fmPtr->descent,
 715                         fmPtr->fixed);
 716                 Tcl_AppendResult(interp, buf, NULL);
 717             } else {
 718                 if (Tcl_GetIndexFromObj(interp, objv[3], switches,
 719                         "metric", 0, &index) != TCL_OK) {
 720                     Tk_FreeFont(tkfont);
 721                     return TCL_ERROR;
 722                 }
 723                 i = 0;                  /* Needed only to prevent compiler
 724                                          * warning. */
 725                 switch (index) {
 726                     case 0: i = fmPtr->ascent;                  break;
 727                     case 1: i = fmPtr->descent;                 break;
 728                     case 2: i = fmPtr->ascent + fmPtr->descent; break;
 729                     case 3: i = fmPtr->fixed;                   break;
 730                 }
 731                 Tcl_SetIntObj(Tcl_GetObjResult(interp), i);
 732             }
 733             Tk_FreeFont(tkfont);
 734             break;
 735         }
 736         case FONT_NAMES: {
 737             char *string;
 738             NamedFont *nfPtr;
 739             Tcl_HashSearch search;
 740             Tcl_HashEntry *namedHashPtr;
 741             Tcl_Obj *strPtr, *resultPtr;
 742
 743             if (objc != 2) {
 744                 Tcl_WrongNumArgs(interp, 1, objv, "names");
 745                 return TCL_ERROR;
 746             }
 747             resultPtr = Tcl_GetObjResult(interp);
 748             namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
 749             while (namedHashPtr != NULL) {
 750                 nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
 751                 if (nfPtr->deletePending == 0) {
 752                     string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr);
 753                     strPtr = Tcl_NewStringObj(string, -1);
 754                     Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
 755                 }
 756                 namedHashPtr = Tcl_NextHashEntry(&search);
 757             }
 758             break;
 759         }
 760     }
 761     return TCL_OK;
 762 }
 763 \f
 764 /*
 765  *---------------------------------------------------------------------------
 766  *
 767  * UpdateDependentFonts, TheWorldHasChanged, RecomputeWidgets --
 768  *
 769  *      Called when the attributes of a named font changes.  Updates all
 770  *      the instantiated fonts that depend on that named font and then
 771  *      uses the brute force approach and prepares every widget to
 772  *      recompute its geometry.
 773  *
 774  * Results:
 775  *      None.
 776  *
 777  * Side effects:
 778  *      Things get queued for redisplay.
 779  *
 780  *---------------------------------------------------------------------------
 781  */
 782
 783 static void
 784 UpdateDependentFonts(fiPtr, tkwin, namedHashPtr)
 785     TkFontInfo *fiPtr;          /* Info about application's fonts. */
 786     Tk_Window tkwin;            /* A window in the application. */
 787     Tcl_HashEntry *namedHashPtr;/* The named font that is changing. */
 788 {
 789     Tcl_HashEntry *cacheHashPtr;
 790     Tcl_HashSearch search;
 791     TkFont *fontPtr;
 792     NamedFont *nfPtr;
 793
 794     nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
 795     if (nfPtr->refCount == 0) {
 796         /*
 797          * Well nobody's using this named font, so don't have to tell
 798          * any widgets to recompute themselves.
 799          */
 800
 801         return;
 802     }
 803
 804     cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
 805     while (cacheHashPtr != NULL) {
 806         for (fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
 807                 fontPtr != NULL; fontPtr = fontPtr->nextPtr) {
 808             if (fontPtr->namedHashPtr == namedHashPtr) {
 809                 TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
 810                 if (fiPtr->updatePending == 0) {
 811                     fiPtr->updatePending = 1;
 812                     Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr);
 813                 }
 814             }
 815         }
 816         cacheHashPtr = Tcl_NextHashEntry(&search);
 817     }
 818 }
 819
 820 static void
 821 TheWorldHasChanged(clientData)
 822     ClientData clientData;      /* Info about application's fonts. */
 823 {
 824     TkFontInfo *fiPtr;
 825
 826     fiPtr = (TkFontInfo *) clientData;
 827     fiPtr->updatePending = 0;
 828
 829     RecomputeWidgets(fiPtr->mainPtr->winPtr);
 830 }
 831
 832 static void
 833 RecomputeWidgets(winPtr)
 834     TkWindow *winPtr;           /* Window to which command is sent. */
 835 {
 836     Tk_ClassWorldChangedProc *proc;
 837     proc = Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc);
 838     if (proc != NULL) {
 839         (*proc)(winPtr->instanceData);
 840     }
 841
 842     /*
 843      * Notify all the descendants of this window that the world has changed.
 844      *
 845      * This could be done recursively or iteratively.  The recursive version
 846      * is easier to implement and understand, and typically, windows with a
 847      * -font option will be leaf nodes in the widget heirarchy (buttons,
 848      * labels, etc.), so the recursion depth will be shallow.
 849      *
 850      * However, the additional overhead of the recursive calls may become
 851      * a performance problem if typical usage alters such that -font'ed widgets
 852      * appear high in the heirarchy, causing deep recursion.  This could happen
 853      * with text widgets, or more likely with the (not yet existant) labeled
 854      * frame widget.  With these widgets it is possible, even likely, that a
 855      * -font'ed widget (text or labeled frame) will not be a leaf node, but
 856      * will instead have many descendants.  If this is ever found to cause
 857      * a performance problem, it may be worth investigating an iterative
 858      * version of the code below.
 859      */
 860     for (winPtr = winPtr->childList; winPtr != NULL; winPtr = winPtr->nextPtr) {
 861         RecomputeWidgets(winPtr);
 862     }
 863 }
 864 \f
 865 /*
 866  *---------------------------------------------------------------------------
 867  *
 868  * CreateNamedFont --
 869  *
 870  *      Create the specified named font with the given attributes in the
 871  *      named font table associated with the interp.
 872  *
 873  * Results:
 874  *      Returns TCL_OK if the font was successfully created, or TCL_ERROR
 875  *      if the named font already existed.  If TCL_ERROR is returned, an
 876  *      error message is left in the interp's result.
 877  *
 878  * Side effects:
 879  *      Assume there used to exist a named font by the specified name, and
 880  *      that the named font had been deleted, but there were still some
 881  *      widgets using the named font at the time it was deleted.  If a
 882  *      new named font is created with the same name, all those widgets
 883  *      that were using the old named font will be redisplayed using
 884  *      the new named font's attributes.
 885  *
 886  *---------------------------------------------------------------------------
 887  */
 888
 889 static int
 890 CreateNamedFont(interp, tkwin, name, faPtr)
 891     Tcl_Interp *interp;         /* Interp for error return. */
 892     Tk_Window tkwin;            /* A window associated with interp. */
 893     CONST char *name;           /* Name for the new named font. */
 894     TkFontAttributes *faPtr;    /* Attributes for the new named font. */
 895 {
 896     TkFontInfo *fiPtr;
 897     Tcl_HashEntry *namedHashPtr;
 898     int new;
 899     NamedFont *nfPtr;
 900
 901     fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
 902
 903     namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
 904
 905     if (new == 0) {
 906         nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
 907         if (nfPtr->deletePending == 0) {
 908             Tcl_ResetResult(interp);
 909             Tcl_AppendResult(interp, "named font \"", name,
 910                     "\" already exists", (char *) NULL);
 911             return TCL_ERROR;
 912         }
 913
 914         /*
 915          * Recreating a named font with the same name as a previous
 916          * named font.  Some widgets were still using that named
 917          * font, so they need to get redisplayed.
 918          */
 919
 920         nfPtr->fa = *faPtr;
 921         nfPtr->deletePending = 0;
 922         UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
 923         return TCL_OK;
 924     }
 925
 926     nfPtr = (NamedFont *) ckalloc(sizeof(NamedFont));
 927     nfPtr->deletePending = 0;
 928     Tcl_SetHashValue(namedHashPtr, nfPtr);
 929     nfPtr->fa = *faPtr;
 930     nfPtr->refCount = 0;
 931     nfPtr->deletePending = 0;
 932     return TCL_OK;
 933 }
 934 \f
 935 /*
 936  *---------------------------------------------------------------------------
 937  *
 938  * Tk_GetFont --
 939  *
 940  *      Given a string description of a font, map the description to a
 941  *      corresponding Tk_Font that represents the font.
 942  *
 943  * Results:
 944  *      The return value is token for the font, or NULL if an error
 945  *      prevented the font from being created.  If NULL is returned, an
 946  *      error message will be left in the interp's result.
 947  *
 948  * Side effects:
 949  *      The font is added to an internal database with a reference
 950  *      count.  For each call to this procedure, there should eventually
 951  *      be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
 952  *      database is cleaned up when fonts aren't in use anymore.
 953  *
 954  *---------------------------------------------------------------------------
 955  */
 956
 957 Tk_Font
 958 Tk_GetFont(interp, tkwin, string)
 959     Tcl_Interp *interp;         /* Interp for database and error return. */
 960     Tk_Window tkwin;            /* For display on which font will be used. */
 961     CONST char *string;         /* String describing font, as: named font,
 962                                  * native format, or parseable string. */
 963 {
 964     Tk_Font tkfont;
 965     Tcl_Obj *strPtr;
 966
 967     strPtr = Tcl_NewStringObj((char *) string, -1);
 968     Tcl_IncrRefCount(strPtr);
 969     tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);
 970     Tcl_DecrRefCount(strPtr);
 971     return tkfont;
 972 }
 973 \f
 974 /*
 975  *---------------------------------------------------------------------------
 976  *
 977  * Tk_AllocFontFromObj --
 978  *
 979  *      Given a string description of a font, map the description to a
 980  *      corresponding Tk_Font that represents the font.
 981  *
 982  * Results:
 983  *      The return value is token for the font, or NULL if an error
 984  *      prevented the font from being created.  If NULL is returned, an
 985  *      error message will be left in interp's result object.
 986  *
 987  * Side effects:
 988  *      The font is added to an internal database with a reference
 989  *      count.  For each call to this procedure, there should eventually
 990  *      be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
 991  *      database is cleaned up when fonts aren't in use anymore.
 992  *
 993  *---------------------------------------------------------------------------
 994  */
 995
 996 Tk_Font
 997 Tk_AllocFontFromObj(interp, tkwin, objPtr)
 998     Tcl_Interp *interp;         /* Interp for database and error return. */
 999     Tk_Window tkwin;            /* For screen on which font will be used. */
1000     Tcl_Obj *objPtr;            /* Object describing font, as: named font,
1001                                  * native format, or parseable string. */
1002 {
1003     TkFontInfo *fiPtr;
1004     Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
1005     TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
1006     int new, descent;
1007     NamedFont *nfPtr;
1008
1009     fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
1010     if (objPtr->typePtr != &tkFontObjType) {
1011         SetFontFromAny(interp, objPtr);
1012     }
1013
1014     oldFontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
1015
1016     if (oldFontPtr != NULL) {
1017         if (oldFontPtr->resourceRefCount == 0) {
1018             /*
1019              * This is a stale reference: it refers to a TkFont that's
1020              * no longer in use.  Clear the reference.
1021              */
1022
1023             FreeFontObjProc(objPtr);
1024             oldFontPtr = NULL;
1025         } else if (Tk_Screen(tkwin) == oldFontPtr->screen) {
1026             oldFontPtr->resourceRefCount++;
1027             return (Tk_Font) oldFontPtr;
1028         }
1029     }
1030
1031     /*
1032      * Next, search the list of fonts that have the name we want, to see
1033      * if one of them is for the right screen.
1034      */
1035
1036     new = 0;
1037     if (oldFontPtr != NULL) {
1038         cacheHashPtr = oldFontPtr->cacheHashPtr;
1039         FreeFontObjProc(objPtr);
1040     } else {
1041         cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache,
1042                 Tcl_GetString(objPtr), &new);
1043     }
1044     firstFontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
1045     for (fontPtr = firstFontPtr; (fontPtr != NULL);
1046             fontPtr = fontPtr->nextPtr) {
1047         if (Tk_Screen(tkwin) == fontPtr->screen) {
1048             fontPtr->resourceRefCount++;
1049             fontPtr->objRefCount++;
1050             objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
1051             return (Tk_Font) fontPtr;
1052         }
1053     }
1054
1055     /*
1056      * The desired font isn't in the table.  Make a new one.
1057      */
1058
1059     namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
1060             Tcl_GetString(objPtr));
1061     if (namedHashPtr != NULL) {
1062         /*
1063          * Construct a font based on a named font.
1064          */
1065
1066         nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
1067         nfPtr->refCount++;
1068
1069         fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa);
1070     } else {
1071         /*
1072          * Native font?
1073          */
1074
1075         fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr));
1076         if (fontPtr == NULL) {
1077             TkFontAttributes fa;
1078             Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr);
1079
1080             if (ParseFontNameObj(interp, tkwin, dupObjPtr, &fa) != TCL_OK) {
1081                 if (new) {
1082                     Tcl_DeleteHashEntry(cacheHashPtr);
1083                 }
1084                 Tcl_DecrRefCount(dupObjPtr);
1085                 return NULL;
1086             }
1087             Tcl_DecrRefCount(dupObjPtr);
1088
1089             /*
1090              * String contained the attributes inline.
1091              */
1092
1093             fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
1094         }
1095     }
1096
1097     fontPtr->resourceRefCount = 1;
1098     fontPtr->objRefCount = 1;
1099     fontPtr->cacheHashPtr = cacheHashPtr;
1100     fontPtr->namedHashPtr = namedHashPtr;
1101     fontPtr->screen = Tk_Screen(tkwin);
1102     fontPtr->nextPtr = firstFontPtr;
1103     Tcl_SetHashValue(cacheHashPtr, fontPtr);
1104
1105     Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, -1, 0, &fontPtr->tabWidth);
1106     if (fontPtr->tabWidth == 0) {
1107         fontPtr->tabWidth = fontPtr->fm.maxWidth;
1108     }
1109     fontPtr->tabWidth *= 8;
1110
1111     /*
1112      * Make sure the tab width isn't zero (some fonts may not have enough
1113      * information to set a reasonable tab width).
1114      */
1115
1116     if (fontPtr->tabWidth == 0) {
1117         fontPtr->tabWidth = 1;
1118     }
1119
1120     /*
1121      * Get information used for drawing underlines in generic code on a
1122      * non-underlined font.
1123      */
1124
1125     descent = fontPtr->fm.descent;
1126     fontPtr->underlinePos = descent / 2;
1127     fontPtr->underlineHeight = TkFontGetPixels(tkwin, fontPtr->fa.size) / 10;
1128     if (fontPtr->underlineHeight == 0) {
1129         fontPtr->underlineHeight = 1;
1130     }
1131     if (fontPtr->underlinePos + fontPtr->underlineHeight > descent) {
1132         /*
1133          * If this set of values would cause the bottom of the underline
1134          * bar to stick below the descent of the font, jack the underline
1135          * up a bit higher.
1136          */
1137
1138         fontPtr->underlineHeight = descent - fontPtr->underlinePos;
1139         if (fontPtr->underlineHeight == 0) {
1140             fontPtr->underlinePos--;
1141             fontPtr->underlineHeight = 1;
1142         }
1143     }
1144
1145     objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
1146     return (Tk_Font) fontPtr;
1147 }
1148 \f
1149 /*
1150  *----------------------------------------------------------------------
1151  *
1152  * Tk_GetFontFromObj --
1153  *
1154  *      Find the font that corresponds to a given object.  The font must
1155  *      have already been created by Tk_GetFont or Tk_AllocFontFromObj.
1156  *
1157  * Results:
1158  *      The return value is a token for the font that matches objPtr
1159  *      and is suitable for use in tkwin.
1160  *
1161  * Side effects:
1162  *      If the object is not already a font ref, the conversion will free
1163  *      any old internal representation.
1164  *
1165  *----------------------------------------------------------------------
1166  */
1167
1168 Tk_Font
1169 Tk_GetFontFromObj(tkwin, objPtr)
1170     Tk_Window tkwin;            /* The window that the font will be used in. */
1171     Tcl_Obj *objPtr;            /* The object from which to get the font. */
1172 {
1173     TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
1174     TkFont *fontPtr;
1175     Tcl_HashEntry *hashPtr;
1176
1177     if (objPtr->typePtr != &tkFontObjType) {
1178         SetFontFromAny((Tcl_Interp *) NULL, objPtr);
1179     }
1180
1181     fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
1182
1183     if (fontPtr != NULL) {
1184         if (fontPtr->resourceRefCount == 0) {
1185             /*
1186              * This is a stale reference: it refers to a TkFont that's
1187              * no longer in use.  Clear the reference.
1188              */
1189
1190             FreeFontObjProc(objPtr);
1191             fontPtr = NULL;
1192         } else if (Tk_Screen(tkwin) == fontPtr->screen) {
1193             return (Tk_Font) fontPtr;
1194         }
1195     }
1196
1197     /*
1198      * Next, search the list of fonts that have the name we want, to see
1199      * if one of them is for the right screen.
1200      */
1201
1202     if (fontPtr != NULL) {
1203         hashPtr = fontPtr->cacheHashPtr;
1204         FreeFontObjProc(objPtr);
1205     } else {
1206         hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr));
1207     }
1208     if (hashPtr != NULL) {
1209         for (fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); fontPtr != NULL;
1210                 fontPtr = fontPtr->nextPtr) {
1211             if (Tk_Screen(tkwin) == fontPtr->screen) {
1212                 fontPtr->objRefCount++;
1213                 objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
1214                 return (Tk_Font) fontPtr;
1215             }
1216         }
1217     }
1218
1219     panic("Tk_GetFontFromObj called with non-existent font!");
1220     return NULL;
1221 }
1222 \f
1223 /*
1224  *----------------------------------------------------------------------
1225  *
1226  * SetFontFromAny --
1227  *
1228  *      Convert the internal representation of a Tcl object to the
1229  *      font internal form.
1230  *
1231  * Results:
1232  *      Always returns TCL_OK.
1233  *
1234  * Side effects:
1235  *      The object is left with its typePtr pointing to tkFontObjType.
1236  *      The TkFont pointer is NULL.
1237  *
1238  *----------------------------------------------------------------------
1239  */
1240
1241 static int
1242 SetFontFromAny(interp, objPtr)
1243     Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
1244     Tcl_Obj *objPtr;            /* The object to convert. */
1245 {
1246     Tcl_ObjType *typePtr;
1247
1248     /*
1249      * Free the old internalRep before setting the new one.
1250      */
1251
1252     Tcl_GetString(objPtr);
1253     typePtr = objPtr->typePtr;
1254     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
1255         (*typePtr->freeIntRepProc)(objPtr);
1256     }
1257     objPtr->typePtr = &tkFontObjType;
1258     objPtr->internalRep.twoPtrValue.ptr1 = NULL;
1259
1260     return TCL_OK;
1261 }
1262 \f
1263 /*
1264  *---------------------------------------------------------------------------
1265  *
1266  * Tk_NameOfFont --
1267  *
1268  *      Given a font, return a textual string identifying it.
1269  *
1270  * Results:
1271  *      The return value is the description that was passed to
1272  *      Tk_GetFont() to create the font.  The storage for the returned
1273  *      string is only guaranteed to persist until the font is deleted.
1274  *      The caller should not modify this string.
1275  *
1276  * Side effects:
1277  *      None.
1278  *
1279  *---------------------------------------------------------------------------
1280  */
1281
1282 CONST char *
1283 Tk_NameOfFont(tkfont)
1284     Tk_Font tkfont;             /* Font whose name is desired. */
1285 {
1286     TkFont *fontPtr;
1287
1288     fontPtr = (TkFont *) tkfont;
1289     return fontPtr->cacheHashPtr->key.string;
1290 }
1291 \f
1292 /*
1293  *---------------------------------------------------------------------------
1294  *
1295  * Tk_FreeFont --
1296  *
1297  *      Called to release a font allocated by Tk_GetFont().
1298  *
1299  * Results:
1300  *      None.
1301  *
1302  * Side effects:
1303  *      The reference count associated with font is decremented, and
1304  *      only deallocated when no one is using it.
1305  *
1306  *---------------------------------------------------------------------------
1307  */
1308
1309 void
1310 Tk_FreeFont(tkfont)
1311     Tk_Font tkfont;             /* Font to be released. */
1312 {
1313     TkFont *fontPtr, *prevPtr;
1314     NamedFont *nfPtr;
1315
1316     if (tkfont == NULL) {
1317         return;
1318     }
1319     fontPtr = (TkFont *) tkfont;
1320     fontPtr->resourceRefCount--;
1321     if (fontPtr->resourceRefCount > 0) {
1322         return;
1323     }
1324     if (fontPtr->namedHashPtr != NULL) {
1325         /*
1326          * This font derived from a named font.  Reduce the reference
1327          * count on the named font and free it if no-one else is
1328          * using it.
1329          */
1330
1331         nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr);
1332         nfPtr->refCount--;
1333         if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) {
1334             Tcl_DeleteHashEntry(fontPtr->namedHashPtr);
1335             ckfree((char *) nfPtr);
1336         }
1337     }
1338
1339     prevPtr = (TkFont *) Tcl_GetHashValue(fontPtr->cacheHashPtr);
1340     if (prevPtr == fontPtr) {
1341         if (fontPtr->nextPtr == NULL) {
1342             Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);
1343         } else  {
1344             Tcl_SetHashValue(fontPtr->cacheHashPtr, fontPtr->nextPtr);
1345         }
1346     } else {
1347         while (prevPtr->nextPtr != fontPtr) {
1348             prevPtr = prevPtr->nextPtr;
1349         }
1350         prevPtr->nextPtr = fontPtr->nextPtr;
1351     }
1352
1353     TkpDeleteFont(fontPtr);
1354     if (fontPtr->objRefCount == 0) {
1355         ckfree((char *) fontPtr);
1356     }
1357 }
1358 \f
1359 /*
1360  *---------------------------------------------------------------------------
1361  *
1362  * Tk_FreeFontFromObj --
1363  *
1364  *      Called to release a font inside a Tcl_Obj *. Decrements the refCount
1365  *      of the font and removes it from the hash tables if necessary.
1366  *
1367  * Results:
1368  *      None.
1369  *
1370  * Side effects:
1371  *      The reference count associated with font is decremented, and
1372  *      only deallocated when no one is using it.
1373  *
1374  *---------------------------------------------------------------------------
1375  */
1376
1377 void
1378 Tk_FreeFontFromObj(tkwin, objPtr)
1379     Tk_Window tkwin;            /* The window this font lives in. Needed
1380                                  * for the screen value. */
1381     Tcl_Obj *objPtr;            /* The Tcl_Obj * to be freed. */
1382 {
1383     Tk_FreeFont(Tk_GetFontFromObj(tkwin, objPtr));
1384 }
1385 \f
1386 /*
1387  *---------------------------------------------------------------------------
1388  *
1389  * FreeFontObjProc --
1390  *
1391  *      This proc is called to release an object reference to a font.
1392  *      Called when the object's internal rep is released or when
1393  *      the cached fontPtr needs to be changed.
1394  *
1395  * Results:
1396  *      None.
1397  *
1398  * Side effects:
1399  *      The object reference count is decremented. When both it
1400  *      and the hash ref count go to zero, the font's resources
1401  *      are released.
1402  *
1403  *---------------------------------------------------------------------------
1404  */
1405
1406 static void
1407 FreeFontObjProc(objPtr)
1408     Tcl_Obj *objPtr;            /* The object we are releasing. */
1409 {
1410     TkFont *fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
1411
1412     if (fontPtr != NULL) {
1413         fontPtr->objRefCount--;
1414         if ((fontPtr->resourceRefCount == 0) && (fontPtr->objRefCount == 0)) {
1415             ckfree((char *) fontPtr);
1416             objPtr->internalRep.twoPtrValue.ptr1 = NULL;
1417         }
1418     }
1419 }
1420 \f
1421 /*
1422  *---------------------------------------------------------------------------
1423  *
1424  * DupFontObjProc --
1425  *
1426  *      When a cached font object is duplicated, this is called to
1427  *      update the internal reps.
1428  *
1429  * Results:
1430  *      None.
1431  *
1432  * Side effects:
1433  *      The font's objRefCount is incremented and the internal rep
1434  *      of the copy is set to point to it.
1435  *
1436  *---------------------------------------------------------------------------
1437  */
1438
1439 static void
1440 DupFontObjProc(srcObjPtr, dupObjPtr)
1441     Tcl_Obj *srcObjPtr;         /* The object we are copying from. */
1442     Tcl_Obj *dupObjPtr;         /* The object we are copying to. */
1443 {
1444     TkFont *fontPtr = (TkFont *) srcObjPtr->internalRep.twoPtrValue.ptr1;
1445
1446     dupObjPtr->typePtr = srcObjPtr->typePtr;
1447     dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
1448
1449     if (fontPtr != NULL) {
1450         fontPtr->objRefCount++;
1451     }
1452 }
1453 \f
1454 /*
1455  *---------------------------------------------------------------------------
1456  *
1457  * Tk_FontId --
1458  *
1459  *      Given a font, return an opaque handle that should be selected
1460  *      into the XGCValues structure in order to get the constructed
1461  *      gc to use this font.  This procedure would go away if the
1462  *      XGCValues structure were replaced with a TkGCValues structure.
1463  *
1464  * Results:
1465  *      As above.
1466  *
1467  * Side effects:
1468  *      None.
1469  *
1470  *---------------------------------------------------------------------------
1471  */
1472
1473 Font
1474 Tk_FontId(tkfont)
1475     Tk_Font tkfont;     /* Font that is going to be selected into GC. */
1476 {
1477     TkFont *fontPtr;
1478
1479     fontPtr = (TkFont *) tkfont;
1480     return fontPtr->fid;
1481 }
1482 \f
1483 /*
1484  *---------------------------------------------------------------------------
1485  *
1486  * Tk_GetFontMetrics --
1487  *
1488  *      Returns overall ascent and descent metrics for the given font.
1489  *      These values can be used to space multiple lines of text and
1490  *      to align the baselines of text in different fonts.
1491  *
1492  * Results:
1493  *      If *heightPtr is non-NULL, it is filled with the overall height
1494  *      of the font, which is the sum of the ascent and descent.
1495  *      If *ascentPtr or *descentPtr is non-NULL, they are filled with
1496  *      the ascent and/or descent information for the font.
1497  *
1498  * Side effects:
1499  *      None.
1500  *
1501  *---------------------------------------------------------------------------
1502  */
1503 void
1504 Tk_GetFontMetrics(tkfont, fmPtr)
1505     Tk_Font tkfont;             /* Font in which metrics are calculated. */
1506     Tk_FontMetrics *fmPtr;      /* Pointer to structure in which font
1507                                  * metrics for tkfont will be stored. */
1508 {
1509     TkFont *fontPtr;
1510
1511     fontPtr = (TkFont *) tkfont;
1512     fmPtr->ascent = fontPtr->fm.ascent;
1513     fmPtr->descent = fontPtr->fm.descent;
1514     fmPtr->linespace = fontPtr->fm.ascent + fontPtr->fm.descent;
1515 }
1516 \f
1517 /*
1518  *---------------------------------------------------------------------------
1519  *
1520  * Tk_PostscriptFontName --
1521  *
1522  *      Given a Tk_Font, return the name of the corresponding Postscript
1523  *      font.
1524  *
1525  * Results:
1526  *      The return value is the pointsize of the given Tk_Font.
1527  *      The name of the Postscript font is appended to dsPtr.
1528  *
1529  * Side effects:
1530  *      If the font does not exist on the printer, the print job will
1531  *      fail at print time.  Given a "reasonable" Postscript printer,
1532  *      the following Tk_Font font families should print correctly:
1533  *
1534  *          Avant Garde, Arial, Bookman, Courier, Courier New, Geneva,
1535  *          Helvetica, Monaco, New Century Schoolbook, New York,
1536  *          Palatino, Symbol, Times, Times New Roman, Zapf Chancery,
1537  *          and Zapf Dingbats.
1538  *
1539  *      Any other Tk_Font font families may not print correctly
1540  *      because the computed Postscript font name may be incorrect.
1541  *
1542  *---------------------------------------------------------------------------
1543  */
1544
1545 int
1546 Tk_PostscriptFontName(tkfont, dsPtr)
1547     Tk_Font tkfont;             /* Font in which text will be printed. */
1548     Tcl_DString *dsPtr;         /* Pointer to an initialized Tcl_DString to
1549                                  * which the name of the Postscript font that
1550                                  * corresponds to tkfont will be appended. */
1551 {
1552     TkFont *fontPtr;
1553     Tk_Uid family, weightString, slantString;
1554     char *src, *dest;
1555     int upper, len;
1556
1557     len = Tcl_DStringLength(dsPtr);
1558     fontPtr = (TkFont *) tkfont;
1559
1560     /*
1561      * Convert the case-insensitive Tk_Font family name to the
1562      * case-sensitive Postscript family name.  Take out any spaces and
1563      * capitalize the first letter of each word.
1564      */
1565
1566     family = fontPtr->fa.family;
1567     if (strncasecmp(family, "itc ", 4) == 0) {
1568         family = family + 4;
1569     }
1570     if ((strcasecmp(family, "Arial") == 0)
1571             || (strcasecmp(family, "Geneva") == 0)) {
1572         family = "Helvetica";
1573     } else if ((strcasecmp(family, "Times New Roman") == 0)
1574             || (strcasecmp(family, "New York") == 0)) {
1575         family = "Times";
1576     } else if ((strcasecmp(family, "Courier New") == 0)
1577             || (strcasecmp(family, "Monaco") == 0)) {
1578         family = "Courier";
1579     } else if (strcasecmp(family, "AvantGarde") == 0) {
1580         family = "AvantGarde";
1581     } else if (strcasecmp(family, "ZapfChancery") == 0) {
1582         family = "ZapfChancery";
1583     } else if (strcasecmp(family, "ZapfDingbats") == 0) {
1584         family = "ZapfDingbats";
1585     } else {
1586         Tcl_UniChar ch;
1587
1588         /*
1589          * Inline, capitalize the first letter of each word, lowercase the
1590          * rest of the letters in each word, and then take out the spaces
1591          * between the words.  This may make the DString shorter, which is
1592          * safe to do.
1593          */
1594
1595         Tcl_DStringAppend(dsPtr, family, -1);
1596
1597         src = dest = Tcl_DStringValue(dsPtr) + len;
1598         upper = 1;
1599         for (; *src != '\0'; ) {
1600             while (isspace(UCHAR(*src))) { /* INTL: ISO space */
1601                 src++;
1602                 upper = 1;
1603             }
1604             src += Tcl_UtfToUniChar(src, &ch);
1605             if (upper) {
1606                 ch = Tcl_UniCharToUpper(ch);
1607                 upper = 0;
1608             } else {
1609                 ch = Tcl_UniCharToLower(ch);
1610             }
1611             dest += Tcl_UniCharToUtf(ch, dest);
1612         }
1613         *dest = '\0';
1614         Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
1615         family = Tcl_DStringValue(dsPtr) + len;
1616     }
1617     if (family != Tcl_DStringValue(dsPtr) + len) {
1618         Tcl_DStringAppend(dsPtr, family, -1);
1619         family = Tcl_DStringValue(dsPtr) + len;
1620     }
1621
1622     if (strcasecmp(family, "NewCenturySchoolbook") == 0) {
1623         Tcl_DStringSetLength(dsPtr, len);
1624         Tcl_DStringAppend(dsPtr, "NewCenturySchlbk", -1);
1625         family = Tcl_DStringValue(dsPtr) + len;
1626     }
1627
1628     /*
1629      * Get the string to use for the weight.
1630      */
1631
1632     weightString = NULL;
1633     if (fontPtr->fa.weight == TK_FW_NORMAL) {
1634         if (strcmp(family, "Bookman") == 0) {
1635             weightString = "Light";
1636         } else if (strcmp(family, "AvantGarde") == 0) {
1637             weightString = "Book";
1638         } else if (strcmp(family, "ZapfChancery") == 0) {
1639             weightString = "Medium";
1640         }
1641     } else {
1642         if ((strcmp(family, "Bookman") == 0)
1643                 || (strcmp(family, "AvantGarde") == 0)) {
1644             weightString = "Demi";
1645         } else {
1646             weightString = "Bold";
1647         }
1648     }
1649
1650     /*
1651      * Get the string to use for the slant.
1652      */
1653
1654     slantString = NULL;
1655     if (fontPtr->fa.slant == TK_FS_ROMAN) {
1656         ;
1657     } else {
1658         if ((strcmp(family, "Helvetica") == 0)
1659                 || (strcmp(family, "Courier") == 0)
1660                 || (strcmp(family, "AvantGarde") == 0)) {
1661             slantString = "Oblique";
1662         } else {
1663             slantString = "Italic";
1664         }
1665     }
1666
1667     /*
1668      * The string "Roman" needs to be added to some fonts that are not bold
1669      * and not italic.
1670      */
1671
1672     if ((slantString == NULL) && (weightString == NULL)) {
1673         if ((strcmp(family, "Times") == 0)
1674                 || (strcmp(family, "NewCenturySchlbk") == 0)
1675                 || (strcmp(family, "Palatino") == 0)) {
1676             Tcl_DStringAppend(dsPtr, "-Roman", -1);
1677         }
1678     } else {
1679         Tcl_DStringAppend(dsPtr, "-", -1);
1680         if (weightString != NULL) {
1681             Tcl_DStringAppend(dsPtr, weightString, -1);
1682         }
1683         if (slantString != NULL) {
1684             Tcl_DStringAppend(dsPtr, slantString, -1);
1685         }
1686     }
1687
1688     return fontPtr->fa.size;
1689 }
1690 \f
1691 /*
1692  *---------------------------------------------------------------------------
1693  *
1694  * Tk_TextWidth --
1695  *
1696  *      A wrapper function for the more complicated interface of
1697  *      Tk_MeasureChars.  Computes how much space the given
1698  *      simple string needs.
1699  *
1700  * Results:
1701  *      The return value is the width (in pixels) of the given string.
1702  *
1703  * Side effects:
1704  *      None.
1705  *
1706  *---------------------------------------------------------------------------
1707  */
1708
1709 int
1710 Tk_TextWidth(tkfont, string, numBytes)
1711     Tk_Font tkfont;             /* Font in which text will be measured. */
1712     CONST char *string;         /* String whose width will be computed. */
1713     int numBytes;               /* Number of bytes to consider from
1714                                  * string, or < 0 for strlen(). */
1715 {
1716     int width;
1717
1718     if (numBytes < 0) {
1719         numBytes = strlen(string);
1720     }
1721     Tk_MeasureChars(tkfont, string, numBytes, -1, 0, &width);
1722     return width;
1723 }
1724 \f
1725 /*
1726  *---------------------------------------------------------------------------
1727  *
1728  * Tk_UnderlineChars --
1729  *
1730  *      This procedure draws an underline for a given range of characters
1731  *      in a given string.  It doesn't draw the characters (which are
1732  *      assumed to have been displayed previously); it just draws the
1733  *      underline.  This procedure would mainly be used to quickly
1734  *      underline a few characters without having to construct an
1735  *      underlined font.  To produce properly underlined text, the
1736  *      appropriate underlined font should be constructed and used.
1737  *
1738  * Results:
1739  *      None.
1740  *
1741  * Side effects:
1742  *      Information gets displayed in "drawable".
1743  *
1744  *----------------------------------------------------------------------
1745  */
1746
1747 void
1748 Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstByte,
1749         lastByte)
1750     Display *display;           /* Display on which to draw. */
1751     Drawable drawable;          /* Window or pixmap in which to draw. */
1752     GC gc;                      /* Graphics context for actually drawing
1753                                  * line. */
1754     Tk_Font tkfont;             /* Font used in GC;  must have been allocated
1755                                  * by Tk_GetFont().  Used for character
1756                                  * dimensions, etc. */
1757     CONST char *string;         /* String containing characters to be
1758                                  * underlined or overstruck. */
1759     int x, y;                   /* Coordinates at which first character of
1760                                  * string is drawn. */
1761     int firstByte;              /* Index of first byte of first character. */
1762     int lastByte;               /* Index of first byte after the last
1763                                  * character. */
1764 {
1765     TkFont *fontPtr;
1766     int startX, endX;
1767
1768     fontPtr = (TkFont *) tkfont;
1769
1770     Tk_MeasureChars(tkfont, string, firstByte, -1, 0, &startX);
1771     Tk_MeasureChars(tkfont, string, lastByte, -1, 0, &endX);
1772
1773     XFillRectangle(display, drawable, gc, x + startX,
1774             y + fontPtr->underlinePos, (unsigned int) (endX - startX),
1775             (unsigned int) fontPtr->underlineHeight);
1776 }
1777 \f
1778 /*
1779  *---------------------------------------------------------------------------
1780  *
1781  * Tk_ComputeTextLayout --
1782  *
1783  *      Computes the amount of screen space needed to display a
1784  *      multi-line, justified string of text.  Records all the
1785  *      measurements that were done to determine to size and
1786  *      positioning of the individual lines of text; this information
1787  *      can be used by the Tk_DrawTextLayout() procedure to
1788  *      display the text quickly (without remeasuring it).
1789  *
1790  *      This procedure is useful for simple widgets that want to
1791  *      display single-font, multi-line text and want Tk to handle the
1792  *      details.
1793  *
1794  * Results:
1795  *      The return value is a Tk_TextLayout token that holds the
1796  *      measurement information for the given string.  The token is
1797  *      only valid for the given string.  If the string is freed,
1798  *      the token is no longer valid and must also be freed.  To free
1799  *      the token, call Tk_FreeTextLayout().
1800  *
1801  *      The dimensions of the screen area needed to display the text
1802  *      are stored in *widthPtr and *heightPtr.
1803  *
1804  * Side effects:
1805  *      Memory is allocated to hold the measurement information.
1806  *
1807  *---------------------------------------------------------------------------
1808  */
1809
1810 Tk_TextLayout
1811 Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
1812         widthPtr, heightPtr)
1813     Tk_Font tkfont;             /* Font that will be used to display text. */
1814     CONST char *string;         /* String whose dimensions are to be
1815                                  * computed. */
1816     int numChars;               /* Number of characters to consider from
1817                                  * string, or < 0 for strlen(). */
1818     int wrapLength;             /* Longest permissible line length, in
1819                                  * pixels.  <= 0 means no automatic wrapping:
1820                                  * just let lines get as long as needed. */
1821     Tk_Justify justify;         /* How to justify lines. */
1822     int flags;                  /* Flag bits OR-ed together.
1823                                  * TK_IGNORE_TABS means that tab characters
1824                                  * should not be expanded.  TK_IGNORE_NEWLINES
1825                                  * means that newline characters should not
1826                                  * cause a line break. */
1827     int *widthPtr;              /* Filled with width of string. */
1828     int *heightPtr;             /* Filled with height of string. */
1829 {
1830     TkFont *fontPtr;
1831     CONST char *start, *end, *special;
1832     int n, y, bytesThisChunk, maxChunks;
1833     int baseline, height, curX, newX, maxWidth;
1834     TextLayout *layoutPtr;
1835     LayoutChunk *chunkPtr;
1836     CONST TkFontMetrics *fmPtr;
1837     Tcl_DString lineBuffer;
1838     int *lineLengths;
1839     int curLine, layoutHeight;
1840
1841     Tcl_DStringInit(&lineBuffer);
1842
1843     fontPtr = (TkFont *) tkfont;
1844     if ((fontPtr == NULL) || (string == NULL)) {
1845         if (widthPtr != NULL) {
1846             *widthPtr = 0;
1847         }
1848         if (heightPtr != NULL) {
1849             *heightPtr = 0;
1850         }
1851         return NULL;
1852     }
1853
1854     fmPtr = &fontPtr->fm;
1855
1856     height = fmPtr->ascent + fmPtr->descent;
1857
1858     if (numChars < 0) {
1859         numChars = Tcl_NumUtfChars(string, -1);
1860     }
1861     if (wrapLength == 0) {
1862         wrapLength = -1;
1863     }
1864
1865     maxChunks = 1;
1866
1867     layoutPtr = (TextLayout *) ckalloc(sizeof(TextLayout)
1868             + (maxChunks - 1) * sizeof(LayoutChunk));
1869     layoutPtr->tkfont       = tkfont;
1870     layoutPtr->string       = string;
1871     layoutPtr->numChunks    = 0;
1872
1873     baseline = fmPtr->ascent;
1874     maxWidth = 0;
1875
1876     /*
1877      * Divide the string up into simple strings and measure each string.
1878      */
1879
1880     curX = 0;
1881
1882     end = Tcl_UtfAtIndex(string, numChars);
1883     special = string;
1884
1885     flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
1886     flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;
1887     for (start = string; start < end; ) {
1888         if (start >= special) {
1889             /*
1890              * Find the next special character in the string.
1891              *
1892              * INTL: Note that it is safe to increment by byte, because we are
1893              * looking for 7-bit characters that will appear unchanged in
1894              * UTF-8.  At some point we may need to support the full Unicode
1895              * whitespace set.
1896              */
1897
1898             for (special = start; special < end; special++) {
1899                 if (!(flags & TK_IGNORE_NEWLINES)) {
1900                     if ((*special == '\n') || (*special == '\r')) {
1901                         break;
1902                     }
1903                 }
1904                 if (!(flags & TK_IGNORE_TABS)) {
1905                     if (*special == '\t') {
1906                         break;
1907                     }
1908                 }
1909             }
1910         }
1911
1912         /*
1913          * Special points at the next special character (or the end of the
1914          * string).  Process characters between start and special.
1915          */
1916
1917         chunkPtr = NULL;
1918         if (start < special) {
1919             bytesThisChunk = Tk_MeasureChars(tkfont, start, special - start,
1920                     wrapLength - curX, flags, &newX);
1921             newX += curX;
1922             flags &= ~TK_AT_LEAST_ONE;
1923             if (bytesThisChunk > 0) {
1924                 chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
1925                         bytesThisChunk, curX, newX, baseline);
1926
1927                 start += bytesThisChunk;
1928                 curX = newX;
1929             }
1930         }
1931
1932         if ((start == special) && (special < end)) {
1933             /*
1934              * Handle the special character.
1935              *
1936              * INTL: Special will be pointing at a 7-bit character so we
1937              * can safely treat it as a single byte.
1938              */
1939
1940             chunkPtr = NULL;
1941             if (*special == '\t') {
1942                 newX = curX + fontPtr->tabWidth;
1943                 newX -= newX % fontPtr->tabWidth;
1944                 NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX,
1945                         baseline)->numDisplayChars = -1;
1946                 start++;
1947                 if ((start < end) &&
1948                         ((wrapLength <= 0) || (newX <= wrapLength))) {
1949                     /*
1950                      * More chars can still fit on this line.
1951                      */
1952
1953                     curX = newX;
1954                     flags &= ~TK_AT_LEAST_ONE;
1955                     continue;
1956                 }
1957             } else {
1958                 NewChunk(&layoutPtr, &maxChunks, start, 1, curX, curX,
1959                         baseline)->numDisplayChars = -1;
1960                 start++;
1961                 goto wrapLine;
1962             }
1963         }
1964
1965         /*
1966          * No more characters are going to go on this line, either because
1967          * no more characters can fit or there are no more characters left.
1968          * Consume all extra spaces at end of line.
1969          */
1970
1971         while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */
1972             if (!(flags & TK_IGNORE_NEWLINES)) {
1973                 if ((*start == '\n') || (*start == '\r')) {
1974                     break;
1975                 }
1976             }
1977             if (!(flags & TK_IGNORE_TABS)) {
1978                 if (*start == '\t') {
1979                     break;
1980                 }
1981             }
1982             start++;
1983         }
1984         if (chunkPtr != NULL) {
1985             CONST char *end;
1986
1987             /*
1988              * Append all the extra spaces on this line to the end of the
1989              * last text chunk.  This is a little tricky because we are
1990              * switching back and forth between characters and bytes.
1991              */
1992
1993             end = chunkPtr->start + chunkPtr->numBytes;
1994             bytesThisChunk = start - end;
1995             if (bytesThisChunk > 0) {
1996                 bytesThisChunk = Tk_MeasureChars(tkfont, end, bytesThisChunk,
1997                         -1, 0, &chunkPtr->totalWidth);
1998                 chunkPtr->numBytes += bytesThisChunk;
1999                 chunkPtr->numChars += Tcl_NumUtfChars(end, bytesThisChunk);
2000                 chunkPtr->totalWidth += curX;
2001             }
2002         }
2003
2004         wrapLine:
2005         flags |= TK_AT_LEAST_ONE;
2006
2007         /*
2008          * Save current line length, then move current position to start of
2009          * next line.
2010          */
2011
2012         if (curX > maxWidth) {
2013             maxWidth = curX;
2014         }
2015
2016         /*
2017          * Remember width of this line, so that all chunks on this line
2018          * can be centered or right justified, if necessary.
2019          */
2020
2021         Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
2022
2023         curX = 0;
2024         baseline += height;
2025     }
2026
2027     /*
2028      * If last line ends with a newline, then we need to make a 0 width
2029      * chunk on the next line.  Otherwise "Hello" and "Hello\n" are the
2030      * same height.
2031      */
2032
2033     if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) {
2034         if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
2035             chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
2036                     curX, baseline);
2037             chunkPtr->numDisplayChars = -1;
2038             Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
2039             baseline += height;
2040         }
2041     }
2042
2043     layoutPtr->width = maxWidth;
2044     layoutHeight = baseline - fmPtr->ascent;
2045     if (layoutPtr->numChunks == 0) {
2046         layoutHeight = height;
2047
2048         /*
2049          * This fake chunk is used by the other procedures so that they can
2050          * pretend that there is a chunk with no chars in it, which makes
2051          * the coding simpler.
2052          */
2053
2054         layoutPtr->numChunks = 1;
2055         layoutPtr->chunks[0].start              = string;
2056         layoutPtr->chunks[0].numBytes           = 0;
2057         layoutPtr->chunks[0].numChars           = 0;
2058         layoutPtr->chunks[0].numDisplayChars    = -1;
2059         layoutPtr->chunks[0].x                  = 0;
2060         layoutPtr->chunks[0].y                  = fmPtr->ascent;
2061         layoutPtr->chunks[0].totalWidth         = 0;
2062         layoutPtr->chunks[0].displayWidth       = 0;
2063     } else {
2064         /*
2065          * Using maximum line length, shift all the chunks so that the lines
2066          * are all justified correctly.
2067          */
2068
2069         curLine = 0;
2070         chunkPtr = layoutPtr->chunks;
2071         y = chunkPtr->y;
2072         lineLengths = (int *) Tcl_DStringValue(&lineBuffer);
2073         for (n = 0; n < layoutPtr->numChunks; n++) {
2074             int extra;
2075
2076             if (chunkPtr->y != y) {
2077                 curLine++;
2078                 y = chunkPtr->y;
2079             }
2080             extra = maxWidth - lineLengths[curLine];
2081             if (justify == TK_JUSTIFY_CENTER) {
2082                 chunkPtr->x += extra / 2;
2083             } else if (justify == TK_JUSTIFY_RIGHT) {
2084                 chunkPtr->x += extra;
2085             }
2086             chunkPtr++;
2087         }
2088     }
2089
2090     if (widthPtr != NULL) {
2091         *widthPtr = layoutPtr->width;
2092     }
2093     if (heightPtr != NULL) {
2094         *heightPtr = layoutHeight;
2095     }
2096     Tcl_DStringFree(&lineBuffer);
2097
2098     return (Tk_TextLayout) layoutPtr;
2099 }
2100 \f
2101 /*
2102  *---------------------------------------------------------------------------
2103  *
2104  * Tk_FreeTextLayout --
2105  *
2106  *      This procedure is called to release the storage associated with
2107  *      a Tk_TextLayout when it is no longer needed.
2108  *
2109  * Results:
2110  *      None.
2111  *
2112  * Side effects:
2113  *      Memory is freed.
2114  *
2115  *---------------------------------------------------------------------------
2116  */
2117
2118 void
2119 Tk_FreeTextLayout(textLayout)
2120     Tk_TextLayout textLayout;   /* The text layout to be released. */
2121 {
2122     TextLayout *layoutPtr;
2123
2124     layoutPtr = (TextLayout *) textLayout;
2125     if (layoutPtr != NULL) {
2126         ckfree((char *) layoutPtr);
2127     }
2128 }
2129 \f
2130 /*
2131  *---------------------------------------------------------------------------
2132  *
2133  * Tk_DrawTextLayout --
2134  *
2135  *      Use the information in the Tk_TextLayout token to display a
2136  *      multi-line, justified string of text.
2137  *
2138  *      This procedure is useful for simple widgets that need to
2139  *      display single-font, multi-line text and want Tk to handle
2140  *      the details.
2141  *
2142  * Results:
2143  *      None.
2144  *
2145  * Side effects:
2146  *      Text drawn on the screen.
2147  *
2148  *---------------------------------------------------------------------------
2149  */
2150
2151 void
2152 Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar)
2153     Display *display;           /* Display on which to draw. */
2154     Drawable drawable;          /* Window or pixmap in which to draw. */
2155     GC gc;                      /* Graphics context to use for drawing text. */
2156     Tk_TextLayout layout;       /* Layout information, from a previous call
2157                                  * to Tk_ComputeTextLayout(). */
2158     int x, y;                   /* Upper-left hand corner of rectangle in
2159                                  * which to draw (pixels). */
2160     int firstChar;              /* The index of the first character to draw
2161                                  * from the given text item.  0 specfies the
2162                                  * beginning. */
2163     int lastChar;               /* The index just after the last character
2164                                  * to draw from the given text item.  A number
2165                                  * < 0 means to draw all characters. */
2166 {
2167     TextLayout *layoutPtr;
2168     int i, numDisplayChars, drawX;
2169     CONST char *firstByte;
2170     CONST char *lastByte;
2171     LayoutChunk *chunkPtr;
2172
2173     layoutPtr = (TextLayout *) layout;
2174     if (layoutPtr == NULL) {
2175         return;
2176     }
2177
2178     if (lastChar < 0) {
2179         lastChar = 100000000;
2180     }
2181     chunkPtr = layoutPtr->chunks;
2182     for (i = 0; i < layoutPtr->numChunks; i++) {
2183         numDisplayChars = chunkPtr->numDisplayChars;
2184         if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
2185             if (firstChar <= 0) {
2186                 drawX = 0;
2187                 firstChar = 0;
2188                 firstByte = chunkPtr->start;
2189             } else {
2190                 firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar);
2191                 Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start,
2192                         firstByte - chunkPtr->start, -1, 0, &drawX);
2193             }
2194             if (lastChar < numDisplayChars) {
2195                 numDisplayChars = lastChar;
2196             }
2197             lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars);
2198             Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont,
2199                     firstByte, lastByte - firstByte,
2200                     x + chunkPtr->x + drawX, y + chunkPtr->y);
2201         }
2202         firstChar -= chunkPtr->numChars;
2203         lastChar -= chunkPtr->numChars;
2204         if (lastChar <= 0) {
2205             break;
2206         }
2207         chunkPtr++;
2208     }
2209 }
2210 \f
2211 /*
2212  *---------------------------------------------------------------------------
2213  *
2214  * Tk_UnderlineTextLayout --
2215  *
2216  *      Use the information in the Tk_TextLayout token to display an
2217  *      underline below an individual character.  This procedure does
2218  *      not draw the text, just the underline.
2219  *
2220  *      This procedure is useful for simple widgets that need to
2221  *      display single-font, multi-line text with an individual
2222  *      character underlined and want Tk to handle the details.
2223  *      To display larger amounts of underlined text, construct
2224  *      and use an underlined font.
2225  *
2226  * Results:
2227  *      None.
2228  *
2229  * Side effects:
2230  *      Underline drawn on the screen.
2231  *
2232  *---------------------------------------------------------------------------
2233  */
2234
2235 void
2236 Tk_UnderlineTextLayout(display, drawable, gc, layout, x, y, underline)
2237     Display *display;           /* Display on which to draw. */
2238     Drawable drawable;          /* Window or pixmap in which to draw. */
2239     GC gc;                      /* Graphics context to use for drawing text. */
2240     Tk_TextLayout layout;       /* Layout information, from a previous call
2241                                  * to Tk_ComputeTextLayout(). */
2242     int x, y;                   /* Upper-left hand corner of rectangle in
2243                                  * which to draw (pixels). */
2244     int underline;              /* Index of the single character to
2245                                  * underline, or -1 for no underline. */
2246 {
2247     TextLayout *layoutPtr;
2248     TkFont *fontPtr;
2249     int xx, yy, width, height;
2250
2251     if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0)
2252             && (width != 0)) {
2253         layoutPtr = (TextLayout *) layout;
2254         fontPtr = (TkFont *) layoutPtr->tkfont;
2255
2256         XFillRectangle(display, drawable, gc, x + xx,
2257                 y + yy + fontPtr->fm.ascent + fontPtr->underlinePos,
2258                 (unsigned int) width, (unsigned int) fontPtr->underlineHeight);
2259     }
2260 }
2261 \f
2262 /*
2263  *---------------------------------------------------------------------------
2264  *
2265  * Tk_PointToChar --
2266  *
2267  *      Use the information in the Tk_TextLayout token to determine the
2268  *      character closest to the given point.  The point must be
2269  *      specified with respect to the upper-left hand corner of the
2270  *      text layout, which is considered to be located at (0, 0).
2271  *
2272  *      Any point whose y-value is less that 0 will be considered closest
2273  *      to the first character in the text layout; any point whose y-value
2274  *      is greater than the height of the text layout will be considered
2275  *      closest to the last character in the text layout.
2276  *
2277  *      Any point whose x-value is less than 0 will be considered closest
2278  *      to the first character on that line; any point whose x-value is
2279  *      greater than the width of the text layout will be considered
2280  *      closest to the last character on that line.
2281  *
2282  * Results:
2283  *      The return value is the index of the character that was
2284  *      closest to the point.  Given a text layout with no characters,
2285  *      the value 0 will always be returned, referring to a hypothetical
2286  *      zero-width placeholder character.
2287  *
2288  * Side effects:
2289  *      None.
2290  *
2291  *---------------------------------------------------------------------------
2292  */
2293
2294 int
2295 Tk_PointToChar(layout, x, y)
2296     Tk_TextLayout layout;       /* Layout information, from a previous call
2297                                  * to Tk_ComputeTextLayout(). */
2298     int x, y;                   /* Coordinates of point to check, with
2299                                  * respect to the upper-left corner of the
2300                                  * text layout. */
2301 {
2302     TextLayout *layoutPtr;
2303     LayoutChunk *chunkPtr, *lastPtr;
2304     TkFont *fontPtr;
2305     int i, n, dummy, baseline, pos, numChars;
2306
2307     if (y < 0) {
2308         /*
2309          * Point lies above any line in this layout.  Return the index of
2310          * the first char.
2311          */
2312
2313         return 0;
2314     }
2315
2316     /*
2317      * Find which line contains the point.
2318      */
2319
2320     layoutPtr = (TextLayout *) layout;
2321     fontPtr = (TkFont *) layoutPtr->tkfont;
2322     lastPtr = chunkPtr = layoutPtr->chunks;
2323     numChars = 0;
2324     for (i = 0; i < layoutPtr->numChunks; i++) {
2325         baseline = chunkPtr->y;
2326         if (y < baseline + fontPtr->fm.descent) {
2327             if (x < chunkPtr->x) {
2328                 /*
2329                  * Point is to the left of all chunks on this line.  Return
2330                  * the index of the first character on this line.
2331                  */
2332
2333                 return numChars;
2334             }
2335             if (x >= layoutPtr->width) {
2336                 /*
2337                  * If point lies off right side of the text layout, return
2338                  * the last char in the last chunk on this line.  Without
2339                  * this, it might return the index of the first char that
2340                  * was located outside of the text layout.
2341                  */
2342
2343                 x = INT_MAX;
2344             }
2345
2346             /*
2347              * Examine all chunks on this line to see which one contains
2348              * the specified point.
2349              */
2350
2351             lastPtr = chunkPtr;
2352             while ((i < layoutPtr->numChunks) && (chunkPtr->y == baseline))  {
2353                 if (x < chunkPtr->x + chunkPtr->totalWidth) {
2354                     /*
2355                      * Point falls on one of the characters in this chunk.
2356                      */
2357
2358                     if (chunkPtr->numDisplayChars < 0) {
2359                         /*
2360                          * This is a special chunk that encapsulates a single
2361                          * tab or newline char.
2362                          */
2363
2364                         return numChars;
2365                     }
2366                     n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
2367                             chunkPtr->numBytes, x - chunkPtr->x,
2368                             0, &dummy);
2369                     return numChars + Tcl_NumUtfChars(chunkPtr->start, n);
2370                 }
2371                 numChars += chunkPtr->numChars;
2372                 lastPtr = chunkPtr;
2373                 chunkPtr++;
2374                 i++;
2375             }
2376
2377             /*
2378              * Point is to the right of all chars in all the chunks on this
2379              * line.  Return the index just past the last char in the last
2380              * chunk on this line.
2381              */
2382
2383             pos = numChars;
2384             if (i < layoutPtr->numChunks) {
2385                 pos--;
2386             }
2387             return pos;
2388         }
2389         numChars += chunkPtr->numChars;
2390         lastPtr = chunkPtr;
2391         chunkPtr++;
2392     }
2393
2394     /*
2395      * Point lies below any line in this text layout.  Return the index
2396      * just past the last char.
2397      */
2398
2399     return (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
2400 }
2401 \f
2402 /*
2403  *---------------------------------------------------------------------------
2404  *
2405  * Tk_CharBbox --
2406  *
2407  *      Use the information in the Tk_TextLayout token to return the
2408  *      bounding box for the character specified by index.
2409  *
2410  *      The width of the bounding box is the advance width of the
2411  *      character, and does not include and left- or right-bearing.
2412  *      Any character that extends partially outside of the
2413  *      text layout is considered to be truncated at the edge.  Any
2414  *      character which is located completely outside of the text
2415  *      layout is considered to be zero-width and pegged against
2416  *      the edge.
2417  *
2418  *      The height of the bounding box is the line height for this font,
2419  *      extending from the top of the ascent to the bottom of the
2420  *      descent.  Information about the actual height of the individual
2421  *      letter is not available.
2422  *
2423  *      A text layout that contains no characters is considered to
2424  *      contain a single zero-width placeholder character.
2425  *
2426  * Results:
2427  *      The return value is 0 if the index did not specify a character
2428  *      in the text layout, or non-zero otherwise.  In that case,
2429  *      *bbox is filled with the bounding box of the character.
2430  *
2431  * Side effects:
2432  *      None.
2433  *
2434  *---------------------------------------------------------------------------
2435  */
2436
2437 int
2438 Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr)
2439     Tk_TextLayout layout;   /* Layout information, from a previous call to
2440                              * Tk_ComputeTextLayout(). */
2441     int index;              /* The index of the character whose bbox is
2442                              * desired. */
2443     int *xPtr, *yPtr;       /* Filled with the upper-left hand corner, in
2444                              * pixels, of the bounding box for the character
2445                              * specified by index, if non-NULL. */
2446     int *widthPtr, *heightPtr;
2447                             /* Filled with the width and height of the
2448                              * bounding box for the character specified by
2449                              * index, if non-NULL. */
2450 {
2451     TextLayout *layoutPtr;
2452     LayoutChunk *chunkPtr;
2453     int i, x, w;
2454     Tk_Font tkfont;
2455     TkFont *fontPtr;
2456     CONST char *end;
2457
2458     if (index < 0) {
2459         return 0;
2460     }
2461
2462     layoutPtr = (TextLayout *) layout;
2463     chunkPtr = layoutPtr->chunks;
2464     tkfont = layoutPtr->tkfont;
2465     fontPtr = (TkFont *) tkfont;
2466
2467     for (i = 0; i < layoutPtr->numChunks; i++) {
2468         if (chunkPtr->numDisplayChars < 0) {
2469             if (index == 0) {
2470                 x = chunkPtr->x;
2471                 w = chunkPtr->totalWidth;
2472                 goto check;
2473             }
2474         } else if (index < chunkPtr->numChars) {
2475             end = Tcl_UtfAtIndex(chunkPtr->start, index);
2476             if (xPtr != NULL) {
2477                 Tk_MeasureChars(tkfont, chunkPtr->start,
2478                         end -  chunkPtr->start, -1, 0, &x);
2479                 x += chunkPtr->x;
2480             }
2481             if (widthPtr != NULL) {
2482                 Tk_MeasureChars(tkfont, end, Tcl_UtfNext(end) - end,
2483                         -1, 0, &w);
2484             }
2485             goto check;
2486         }
2487         index -= chunkPtr->numChars;
2488         chunkPtr++;
2489     }
2490     if (index == 0) {
2491         /*
2492          * Special case to get location just past last char in layout.
2493          */
2494
2495         chunkPtr--;
2496         x = chunkPtr->x + chunkPtr->totalWidth;
2497         w = 0;
2498     } else {
2499         return 0;
2500     }
2501
2502     /*
2503      * Ensure that the bbox lies within the text layout.  This forces all
2504      * chars that extend off the right edge of the text layout to have
2505      * truncated widths, and all chars that are completely off the right
2506      * edge of the text layout to peg to the edge and have 0 width.
2507      */
2508     check:
2509     if (yPtr != NULL) {
2510         *yPtr = chunkPtr->y - fontPtr->fm.ascent;
2511     }
2512     if (heightPtr != NULL) {
2513         *heightPtr = fontPtr->fm.ascent + fontPtr->fm.descent;
2514     }
2515
2516     if (x > layoutPtr->width) {
2517         x = layoutPtr->width;
2518     }
2519     if (xPtr != NULL) {
2520         *xPtr = x;
2521     }
2522     if (widthPtr != NULL) {
2523         if (x + w > layoutPtr->width) {
2524             w = layoutPtr->width - x;
2525         }
2526         *widthPtr = w;
2527     }
2528
2529     return 1;
2530 }
2531 \f
2532 /*
2533  *---------------------------------------------------------------------------
2534  *
2535  * Tk_DistanceToTextLayout --
2536  *
2537  *      Computes the distance in pixels from the given point to the
2538  *      given text layout.  Non-displaying space characters that occur
2539  *      at the end of individual lines in the text layout are ignored
2540  *      for hit detection purposes.
2541  *
2542  * Results:
2543  *      The return value is 0 if the point (x, y) is inside the text
2544  *      layout.  If the point isn't inside the text layout then the
2545  *      return value is the distance in pixels from the point to the
2546  *      text item.
2547  *
2548  * Side effects:
2549  *      None.
2550  *
2551  *---------------------------------------------------------------------------
2552  */
2553
2554 int
2555 Tk_DistanceToTextLayout(layout, x, y)
2556     Tk_TextLayout layout;       /* Layout information, from a previous call
2557                                  * to Tk_ComputeTextLayout(). */
2558     int x, y;                   /* Coordinates of point to check, with
2559                                  * respect to the upper-left corner of the
2560                                  * text layout (in pixels). */
2561 {
2562     int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent;
2563     LayoutChunk *chunkPtr;
2564     TextLayout *layoutPtr;
2565     TkFont *fontPtr;
2566
2567     layoutPtr = (TextLayout *) layout;
2568     fontPtr = (TkFont *) layoutPtr->tkfont;
2569     ascent = fontPtr->fm.ascent;
2570     descent = fontPtr->fm.descent;
2571
2572     minDist = 0;
2573     chunkPtr = layoutPtr->chunks;
2574     for (i = 0; i < layoutPtr->numChunks; i++) {
2575         if (chunkPtr->start[0] == '\n') {
2576             /*
2577              * Newline characters are not counted when computing distance
2578              * (but tab characters would still be considered).
2579              */
2580
2581             chunkPtr++;
2582             continue;
2583         }
2584
2585         x1 = chunkPtr->x;
2586         y1 = chunkPtr->y - ascent;
2587         x2 = chunkPtr->x + chunkPtr->displayWidth;
2588         y2 = chunkPtr->y + descent;
2589
2590         if (x < x1) {
2591             xDiff = x1 - x;
2592         } else if (x >= x2) {
2593             xDiff = x - x2 + 1;
2594         } else {
2595             xDiff = 0;
2596         }
2597
2598         if (y < y1) {
2599             yDiff = y1 - y;
2600         } else if (y >= y2) {
2601             yDiff = y - y2 + 1;
2602         } else {
2603             yDiff = 0;
2604         }
2605         if ((xDiff == 0) && (yDiff == 0)) {
2606             return 0;
2607         }
2608         dist = (int) hypot((double) xDiff, (double) yDiff);
2609         if ((dist < minDist) || (minDist == 0)) {
2610             minDist = dist;
2611         }
2612         chunkPtr++;
2613     }
2614     return minDist;
2615 }
2616 \f
2617 /*
2618  *---------------------------------------------------------------------------
2619  *
2620  * Tk_IntersectTextLayout --
2621  *
2622  *      Determines whether a text layout lies entirely inside,
2623  *      entirely outside, or overlaps a given rectangle.  Non-displaying
2624  *      space characters that occur at the end of individual lines in
2625  *      the text layout are ignored for intersection calculations.
2626  *
2627  * Results:
2628  *      The return value is -1 if the text layout is entirely outside of
2629  *      the rectangle, 0 if it overlaps, and 1 if it is entirely inside
2630  *      of the rectangle.
2631  *
2632  * Side effects:
2633  *      None.
2634  *
2635  *---------------------------------------------------------------------------
2636  */
2637
2638 int
2639 Tk_IntersectTextLayout(layout, x, y, width, height)
2640     Tk_TextLayout layout;       /* Layout information, from a previous call
2641                                  * to Tk_ComputeTextLayout(). */
2642     int x, y;                   /* Upper-left hand corner, in pixels, of
2643                                  * rectangular area to compare with text
2644                                  * layout.  Coordinates are with respect to
2645                                  * the upper-left hand corner of the text
2646                                  * layout itself. */
2647     int width, height;          /* The width and height of the above
2648                                  * rectangular area, in pixels. */
2649 {
2650     int result, i, x1, y1, x2, y2;
2651     TextLayout *layoutPtr;
2652     LayoutChunk *chunkPtr;
2653     TkFont *fontPtr;
2654     int left, top, right, bottom;
2655
2656     /*
2657      * Scan the chunks one at a time, seeing whether each is entirely in,
2658      * entirely out, or overlapping the rectangle.  If an overlap is
2659      * detected, return immediately; otherwise wait until all chunks have
2660      * been processed and see if they were all inside or all outside.
2661      */
2662
2663     layoutPtr = (TextLayout *) layout;
2664     chunkPtr = layoutPtr->chunks;
2665     fontPtr = (TkFont *) layoutPtr->tkfont;
2666
2667     left    = x;
2668     top     = y;
2669     right   = x + width;
2670     bottom  = y + height;
2671
2672     result = 0;
2673     for (i = 0; i < layoutPtr->numChunks; i++) {
2674         if (chunkPtr->start[0] == '\n') {
2675             /*
2676              * Newline characters are not counted when computing area
2677              * intersection (but tab characters would still be considered).
2678              */
2679
2680             chunkPtr++;
2681             continue;
2682         }
2683
2684         x1 = chunkPtr->x;
2685         y1 = chunkPtr->y - fontPtr->fm.ascent;
2686         x2 = chunkPtr->x + chunkPtr->displayWidth;
2687         y2 = chunkPtr->y + fontPtr->fm.descent;
2688
2689         if ((right < x1) || (left >= x2)
2690                 || (bottom < y1) || (top >= y2)) {
2691             if (result == 1) {
2692                 return 0;
2693             }
2694             result = -1;
2695         } else if ((x1 < left) || (x2 >= right)
2696                 || (y1 < top) || (y2 >= bottom)) {
2697             return 0;
2698         } else if (result == -1) {
2699             return 0;
2700         } else {
2701             result = 1;
2702         }
2703         chunkPtr++;
2704     }
2705     return result;
2706 }
2707 \f
2708 /*
2709  *---------------------------------------------------------------------------
2710  *
2711  * Tk_TextLayoutToPostscript --
2712  *
2713  *      Outputs the contents of a text layout in Postscript format.
2714  *      The set of lines in the text layout will be rendered by the user
2715  *      supplied Postscript function.  The function should be of the form:
2716  *
2717  *          justify x y string  function  --
2718  *
2719  *      Justify is -1, 0, or 1, depending on whether the following string
2720  *      should be left, center, or right justified, x and y is the
2721  *      location for the origin of the string, string is the sequence
2722  *      of characters to be printed, and function is the name of the
2723  *      caller-provided function; the function should leave nothing
2724  *      on the stack.
2725  *
2726  *      The meaning of the origin of the string (x and y) depends on
2727  *      the justification.  For left justification, x is where the
2728  *      left edge of the string should appear.  For center justification,
2729  *      x is where the center of the string should appear.  And for right
2730  *      justification, x is where the right edge of the string should
2731  *      appear.  This behavior is necessary because, for example, right
2732  *      justified text on the screen is justified with screen metrics.
2733  *      The same string needs to be justified with printer metrics on
2734  *      the printer to appear in the correct place with respect to other
2735  *      similarly justified strings.  In all circumstances, y is the
2736  *      location of the baseline for the string.
2737  *
2738  * Results:
2739  *      The interp's result is modified to hold the Postscript code that
2740  *      will render the text layout.
2741  *
2742  * Side effects:
2743  *      None.
2744  *
2745  *---------------------------------------------------------------------------
2746  */
2747
2748 void
2749 Tk_TextLayoutToPostscript(interp, layout)
2750     Tcl_Interp *interp;         /* Filled with Postscript code. */
2751     Tk_TextLayout layout;       /* The layout to be rendered. */
2752 {
2753 #define MAXUSE 128
2754     char buf[MAXUSE+30];
2755     LayoutChunk *chunkPtr;
2756     int i, j, used, c, baseline;
2757     Tcl_UniChar ch;
2758     CONST char *p, *last_p,*glyphname;
2759     TextLayout *layoutPtr;
2760     char uindex[5]="\0\0\0\0";
2761     char one_char[5];
2762     int charsize;
2763     int bytecount=0;
2764
2765     layoutPtr = (TextLayout *) layout;
2766     chunkPtr = layoutPtr->chunks;
2767     baseline = chunkPtr->y;
2768     used = 0;
2769     buf[used++] = '[';
2770     buf[used++] = '(';
2771     for (i = 0; i < layoutPtr->numChunks; i++) {
2772         if (baseline != chunkPtr->y) {
2773             buf[used++] = ')';
2774             buf[used++] = ']';
2775             buf[used++] = '\n';
2776             buf[used++] = '[';
2777             buf[used++] = '(';
2778             baseline = chunkPtr->y;
2779         }
2780         if (chunkPtr->numDisplayChars <= 0) {
2781             if (chunkPtr->start[0] == '\t') {
2782                 buf[used++] = '\\';
2783                 buf[used++] = 't';
2784             }
2785         } else {
2786             p = chunkPtr->start;
2787             for (j = 0; j < chunkPtr->numDisplayChars; j++) {
2788                 /*
2789                  * INTL: For now we just treat the characters as binary
2790                  * data and display the lower byte.  Eventually this should
2791                  * be revised to handle international postscript fonts.
2792                  */
2793                 last_p=p;
2794                 p +=(charsize= Tcl_UtfToUniChar(p,&ch));
2795                 Tcl_UtfToExternal(interp,NULL,last_p,charsize,0,NULL,one_char,4,
2796                         NULL,&bytecount,NULL);
2797                 if (bytecount == 1) {
2798                     c = UCHAR(one_char[0]);
2799                     /* c = UCHAR( ch & 0xFF) */;
2800                     if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
2801                             || (c >= UCHAR(0x7f))) {
2802                         /*
2803                          * Tricky point:  the "03" is necessary in the sprintf
2804                          * below, so that a full three digits of octal are
2805                          * always generated.  Without the "03", a number
2806                          * following this sequence could be interpreted by
2807                          * Postscript as part of this sequence.
2808                          */
2809
2810                         sprintf(buf + used, "\\%03o", c);
2811                         used += 4;
2812                     } else {
2813                         buf[used++] = c;
2814                     }
2815                 } else {
2816                     /* This character doesn't belong to system character set.
2817                      * So, we must use full glyph name */
2818                     sprintf(uindex,"%04X",ch); /* endianness? */
2819                     if ((glyphname = Tcl_GetVar2( interp , "::tk::psglyphs",uindex,0))) {
2820                         if (used > 0 && buf [used-1] == '(')
2821                             --used;
2822                         else
2823                             buf[used++] = ')';
2824                         buf[used++] = '/';
2825                         while( (*glyphname) && (used < (MAXUSE+27)))
2826                             buf[used++] = *glyphname++ ;
2827                         buf[used++] = '(';
2828                     }
2829
2830                 }
2831                 if (used >= MAXUSE) {
2832                     buf[used] = '\0';
2833                     Tcl_AppendResult(interp, buf, (char *) NULL);
2834                     used = 0;
2835                 }
2836             }
2837         }
2838         if (used >= MAXUSE) {
2839             /*
2840              * If there are a whole bunch of returns or tabs in a row,
2841              * then buf[] could get filled up.
2842              */
2843
2844             buf[used] = '\0';
2845             Tcl_AppendResult(interp, buf, (char *) NULL);
2846             used = 0;
2847         }
2848         chunkPtr++;
2849     }
2850     buf[used++] = ')';
2851     buf[used++] = ']';
2852     buf[used++] = '\n';
2853     buf[used] = '\0';
2854     Tcl_AppendResult(interp, buf, (char *) NULL);
2855 }
2856 \f
2857 /*
2858  *---------------------------------------------------------------------------
2859  *
2860  * ConfigAttributesObj --
2861  *
2862  *      Process command line options to fill in fields of a properly
2863  *      initialized font attributes structure.
2864  *
2865  * Results:
2866  *      A standard Tcl return value.  If TCL_ERROR is returned, an
2867  *      error message will be left in interp's result object.
2868  *
2869  * Side effects:
2870  *      The fields of the font attributes structure get filled in with
2871  *      information from argc/argv.  If an error occurs while parsing,
2872  *      the font attributes structure will contain all modifications
2873  *      specified in the command line options up to the point of the
2874  *      error.
2875  *
2876  *---------------------------------------------------------------------------
2877  */
2878
2879 static int
2880 ConfigAttributesObj(interp, tkwin, objc, objv, faPtr)
2881     Tcl_Interp *interp;         /* Interp for error return. */
2882     Tk_Window tkwin;            /* For display on which font will be used. */
2883     int objc;                   /* Number of elements in argv. */
2884     Tcl_Obj *CONST objv[];      /* Command line options. */
2885     TkFontAttributes *faPtr;    /* Font attributes structure whose fields
2886                                  * are to be modified.  Structure must already
2887                                  * be properly initialized. */
2888 {
2889     int i, n, index;
2890     Tcl_Obj *optionPtr, *valuePtr;
2891     char *value;
2892
2893     for (i = 0; i < objc; i += 2) {
2894         optionPtr = objv[i];
2895         valuePtr = objv[i + 1];
2896
2897         if (Tcl_GetIndexFromObj(interp, optionPtr, fontOpt, "option", 1,
2898                 &index) != TCL_OK) {
2899             return TCL_ERROR;
2900         }
2901         if ((i+2 >= objc) && (objc & 1)) {
2902             /*
2903              * This test occurs after Tcl_GetIndexFromObj() so that
2904              * "font create xyz -xyz" will return the error message
2905              * that "-xyz" is a bad option, rather than that the value
2906              * for "-xyz" is missing.
2907              */
2908
2909             Tcl_AppendResult(interp, "value for \"",
2910                     Tcl_GetString(optionPtr), "\" option missing",
2911                     (char *) NULL);
2912             return TCL_ERROR;
2913         }
2914
2915         switch (index) {
2916             case FONT_FAMILY: {
2917                 value = Tcl_GetString(valuePtr);
2918                 faPtr->family = Tk_GetUid(value);
2919                 break;
2920             }
2921             case FONT_SIZE: {
2922                 if (Tcl_GetIntFromObj(interp, valuePtr, &n) != TCL_OK) {
2923                     return TCL_ERROR;
2924                 }
2925                 faPtr->size = n;
2926                 break;
2927             }
2928             case FONT_WEIGHT: {
2929                 n = TkFindStateNumObj(interp, optionPtr, weightMap, valuePtr);
2930                 if (n == TK_FW_UNKNOWN) {
2931                     return TCL_ERROR;
2932                 }
2933                 faPtr->weight = n;
2934                 break;
2935             }
2936             case FONT_SLANT: {
2937                 n = TkFindStateNumObj(interp, optionPtr, slantMap, valuePtr);
2938                 if (n == TK_FS_UNKNOWN) {
2939                     return TCL_ERROR;
2940                 }
2941                 faPtr->slant = n;
2942                 break;
2943             }
2944             case FONT_UNDERLINE: {
2945                 if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
2946                     return TCL_ERROR;
2947                 }
2948                 faPtr->underline = n;
2949                 break;
2950             }
2951             case FONT_OVERSTRIKE: {
2952                 if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
2953                     return TCL_ERROR;
2954                 }
2955                 faPtr->overstrike = n;
2956                 break;
2957             }
2958         }
2959     }
2960     return TCL_OK;
2961 }
2962 \f
2963 /*
2964  *---------------------------------------------------------------------------
2965  *
2966  * GetAttributeInfoObj --
2967  *
2968  *      Return information about the font attributes as a Tcl list.
2969  *
2970  * Results:
2971  *      The return value is TCL_OK if the objPtr was non-NULL and
2972  *      specified a valid font attribute, TCL_ERROR otherwise.  If TCL_OK
2973  *      is returned, the interp's result object is modified to hold a
2974  *      description of either the current value of a single option, or a
2975  *      list of all options and their current values for the given font
2976  *      attributes.  If TCL_ERROR is returned, the interp's result is
2977  *      set to an error message describing that the objPtr did not refer
2978  *      to a valid option.
2979  *
2980  * Side effects:
2981  *      None.
2982  *
2983  *---------------------------------------------------------------------------
2984  */
2985
2986 static int
2987 GetAttributeInfoObj(interp, faPtr, objPtr)
2988     Tcl_Interp *interp;                 /* Interp to hold result. */
2989     CONST TkFontAttributes *faPtr;      /* The font attributes to inspect. */
2990     Tcl_Obj *objPtr;                    /* If non-NULL, indicates the single
2991                                          * option whose value is to be
2992                                          * returned. Otherwise information is
2993                                          * returned for all options. */
2994 {
2995     int i, index, start, end;
2996     CONST char *str;
2997     Tcl_Obj *optionPtr, *valuePtr, *resultPtr;
2998
2999     resultPtr = Tcl_GetObjResult(interp);
3000
3001     start = 0;
3002     end = FONT_NUMFIELDS;
3003     if (objPtr != NULL) {
3004         if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", TCL_EXACT,
3005                 &index) != TCL_OK) {
3006             return TCL_ERROR;
3007         }
3008         start = index;
3009         end = index + 1;
3010     }
3011
3012     valuePtr = NULL;
3013     for (i = start; i < end; i++) {
3014         switch (i) {
3015             case FONT_FAMILY:
3016                 str = faPtr->family;
3017                 valuePtr = Tcl_NewStringObj(str, ((str == NULL) ? 0 : -1));
3018                 break;
3019
3020             case FONT_SIZE:
3021                 valuePtr = Tcl_NewIntObj(faPtr->size);
3022                 break;
3023
3024             case FONT_WEIGHT:
3025                 str = TkFindStateString(weightMap, faPtr->weight);
3026                 valuePtr = Tcl_NewStringObj(str, -1);
3027                 break;
3028
3029             case FONT_SLANT:
3030                 str = TkFindStateString(slantMap, faPtr->slant);
3031                 valuePtr = Tcl_NewStringObj(str, -1);
3032                 break;
3033
3034             case FONT_UNDERLINE:
3035                 valuePtr = Tcl_NewBooleanObj(faPtr->underline);
3036                 break;
3037
3038             case FONT_OVERSTRIKE:
3039                 valuePtr = Tcl_NewBooleanObj(faPtr->overstrike);
3040                 break;
3041         }
3042         if (objPtr != NULL) {
3043             Tcl_SetObjResult(interp, valuePtr);
3044             return TCL_OK;
3045         }
3046         optionPtr = Tcl_NewStringObj(fontOpt[i], -1);
3047         Tcl_ListObjAppendElement(NULL, resultPtr, optionPtr);
3048         Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr);
3049     }
3050     return TCL_OK;
3051 }
3052 \f
3053 /*
3054  *---------------------------------------------------------------------------
3055  *
3056  * ParseFontNameObj --
3057  *
3058  *      Converts a object into a set of font attributes that can be used
3059  *      to construct a font.
3060  *
3061  *      The string rep of the object can be one of the following forms:
3062  *              XLFD (see X documentation)
3063  *              "family [size] [style1 [style2 ...]"
3064  *              "-option value [-option value ...]"
3065  *
3066  * Results:
3067  *      The return value is TCL_ERROR if the object was syntactically
3068  *      invalid.  In that case an error message is left in interp's
3069  *      result object.  Otherwise, fills the font attribute buffer with
3070  *      the values parsed from the string and returns TCL_OK;
3071  *
3072  * Side effects:
3073  *      None.
3074  *
3075  *---------------------------------------------------------------------------
3076  */
3077
3078 static int
3079 ParseFontNameObj(interp, tkwin, objPtr, faPtr)
3080     Tcl_Interp *interp;         /* Interp for error return.  Must not be
3081                                  * NULL. */
3082     Tk_Window tkwin;            /* For display on which font is used. */
3083     Tcl_Obj *objPtr;            /* Parseable font description object. */
3084     TkFontAttributes *faPtr;    /* Filled with attributes parsed from font
3085                                  * name.  Any attributes that were not
3086                                  * specified in font name are filled with
3087                                  * default values. */
3088 {
3089     char *dash;
3090     int objc, result, i, n;
3091     Tcl_Obj **objv;
3092     char *string;
3093
3094     TkInitFontAttributes(faPtr);
3095
3096     string = Tcl_GetString(objPtr);
3097     if (*string == '-') {
3098         /*
3099          * This may be an XLFD or an "-option value" string.
3100          *
3101          * If the string begins with "-*" or a "-foundry-family-*" pattern,
3102          * then consider it an XLFD.
3103          */
3104
3105         if (string[1] == '*') {
3106             goto xlfd;
3107         }
3108         dash = strchr(string + 1, '-');
3109         if ((dash != NULL)
3110                 && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */
3111             goto xlfd;
3112         }
3113
3114         if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
3115             return TCL_ERROR;
3116         }
3117
3118         return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr);
3119     }
3120
3121     if (*string == '*') {
3122         /*
3123          * This is appears to be an XLFD.  Under Unix, all valid XLFDs were
3124          * already handled by TkpGetNativeFont.  If we are here, either we
3125          * have something that initially looks like an XLFD but isn't or we
3126          * have encountered an XLFD on Windows or Mac.
3127          */
3128
3129         xlfd:
3130         result = TkFontParseXLFD(string, faPtr, NULL);
3131         if (result == TCL_OK) {
3132             return TCL_OK;
3133         }
3134     }
3135
3136     /*
3137      * Wasn't an XLFD or "-option value" string.  Try it as a
3138      * "font size style" list.
3139      */
3140
3141     if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK)
3142             || (objc < 1)) {
3143         Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist",
3144                 (char *) NULL);
3145         return TCL_ERROR;
3146     }
3147
3148     faPtr->family = Tk_GetUid(Tcl_GetString(objv[0]));
3149     if (objc > 1) {
3150         if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
3151             return TCL_ERROR;
3152         }
3153         faPtr->size = n;
3154     }
3155
3156     i = 2;
3157     if (objc == 3) {
3158         if (Tcl_ListObjGetElements(interp, objv[2], &objc, &objv) != TCL_OK) {
3159             return TCL_ERROR;
3160         }
3161         i = 0;
3162     }
3163     for ( ; i < objc; i++) {
3164         n = TkFindStateNumObj(NULL, NULL, weightMap, objv[i]);
3165         if (n != TK_FW_UNKNOWN) {
3166             faPtr->weight = n;
3167             continue;
3168         }
3169         n = TkFindStateNumObj(NULL, NULL, slantMap, objv[i]);
3170         if (n != TK_FS_UNKNOWN) {
3171             faPtr->slant = n;
3172             continue;
3173         }
3174         n = TkFindStateNumObj(NULL, NULL, underlineMap, objv[i]);
3175         if (n != 0) {
3176             faPtr->underline = n;
3177             continue;
3178         }
3179         n = TkFindStateNumObj(NULL, NULL, overstrikeMap, objv[i]);
3180         if (n != 0) {
3181             faPtr->overstrike = n;
3182             continue;
3183         }
3184
3185         /*
3186          * Unknown style.
3187          */
3188
3189         Tcl_AppendResult(interp, "unknown font style \"",
3190                 Tcl_GetString(objv[i]), "\"", (char *) NULL);
3191         return TCL_ERROR;
3192     }
3193     return TCL_OK;
3194 }
3195 \f
3196 /*
3197  *---------------------------------------------------------------------------
3198  *
3199  * NewChunk --
3200  *
3201  *      Helper function for Tk_ComputeTextLayout().  Encapsulates a
3202  *      measured set of characters in a chunk that can be quickly
3203  *      drawn.
3204  *
3205  * Results:
3206  *      A pointer to the new chunk in the text layout.
3207  *
3208  * Side effects:
3209  *      The text layout is reallocated to hold more chunks as necessary.
3210  *
3211  *      Currently, Tk_ComputeTextLayout() stores contiguous ranges of
3212  *      "normal" characters in a chunk, along with individual tab
3213  *      and newline chars in their own chunks.  All characters in the
3214  *      text layout are accounted for.
3215  *
3216  *---------------------------------------------------------------------------
3217  */
3218 static LayoutChunk *
3219 NewChunk(layoutPtrPtr, maxPtr, start, numBytes, curX, newX, y)
3220     TextLayout **layoutPtrPtr;
3221     int *maxPtr;
3222     CONST char *start;
3223     int numBytes;
3224     int curX;
3225     int newX;
3226     int y;
3227 {
3228     TextLayout *layoutPtr;
3229     LayoutChunk *chunkPtr;
3230     int maxChunks, numChars;
3231     size_t s;
3232
3233     layoutPtr = *layoutPtrPtr;
3234     maxChunks = *maxPtr;
3235     if (layoutPtr->numChunks == maxChunks) {
3236         maxChunks *= 2;
3237         s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk));
3238         layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s);
3239
3240         *layoutPtrPtr = layoutPtr;
3241         *maxPtr = maxChunks;
3242     }
3243     numChars = Tcl_NumUtfChars(start, numBytes);
3244     chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
3245     chunkPtr->start             = start;
3246     chunkPtr->numBytes          = numBytes;
3247     chunkPtr->numChars          = numChars;
3248     chunkPtr->numDisplayChars   = numChars;
3249     chunkPtr->x                 = curX;
3250     chunkPtr->y                 = y;
3251     chunkPtr->totalWidth        = newX - curX;
3252     chunkPtr->displayWidth      = newX - curX;
3253     layoutPtr->numChunks++;
3254
3255     return chunkPtr;
3256 }
3257 \f
3258 /*
3259  *---------------------------------------------------------------------------
3260  *
3261  * TkFontParseXLFD --
3262  *
3263  *      Break up a fully specified XLFD into a set of font attributes.
3264  *
3265  * Results:
3266  *      Return value is TCL_ERROR if string was not a fully specified XLFD.
3267  *      Otherwise, fills font attribute buffer with the values parsed
3268  *      from the XLFD and returns TCL_OK.
3269  *
3270  * Side effects:
3271  *      None.
3272  *
3273  *---------------------------------------------------------------------------
3274  */
3275
3276 int
3277 TkFontParseXLFD(string, faPtr, xaPtr)
3278     CONST char *string;         /* Parseable font description string. */
3279     TkFontAttributes *faPtr;    /* Filled with attributes parsed from font
3280                                  * name.  Any attributes that were not
3281                                  * specified in font name are filled with
3282                                  * default values. */
3283     TkXLFDAttributes *xaPtr;    /* Filled with X-specific attributes parsed
3284                                  * from font name.  Any attributes that were
3285                                  * not specified in font name are filled with
3286                                  * default values.  May be NULL if such
3287                                  * information is not desired. */
3288 {
3289     char *src;
3290     CONST char *str;
3291     int i, j;
3292     char *field[XLFD_NUMFIELDS + 2];
3293     Tcl_DString ds;
3294     TkXLFDAttributes xa;
3295
3296     if (xaPtr == NULL) {
3297         xaPtr = &xa;
3298     }
3299     TkInitFontAttributes(faPtr);
3300     TkInitXLFDAttributes(xaPtr);
3301
3302     memset(field, '\0', sizeof(field));
3303
3304     str = string;
3305     if (*str == '-') {
3306         str++;
3307     }
3308
3309     Tcl_DStringInit(&ds);
3310     Tcl_DStringAppend(&ds, (char *) str, -1);
3311     src = Tcl_DStringValue(&ds);
3312
3313     field[0] = src;
3314     for (i = 0; *src != '\0'; src++) {
3315         if (!(*src & 0x80)
3316                 && Tcl_UniCharIsUpper(UCHAR(*src))) {
3317             *src = (char) Tcl_UniCharToLower(UCHAR(*src));
3318         }
3319         if (*src == '-') {
3320             i++;
3321             if (i == XLFD_NUMFIELDS) {
3322                 continue;
3323             }
3324             *src = '\0';
3325             field[i] = src + 1;
3326             if (i > XLFD_NUMFIELDS) {
3327                 break;
3328             }
3329         }
3330     }
3331
3332     /*
3333      * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common,
3334      * but it is (strictly) malformed, because the first * is eliding both
3335      * the Setwidth and the Addstyle fields.  If the Addstyle field is a
3336      * number, then assume the above incorrect form was used and shift all
3337      * the rest of the fields right by one, so the number gets interpreted
3338      * as a pixelsize.  This fix is so that we don't get a million reports
3339      * that "it works under X (as a native font name), but gives a syntax
3340      * error under Windows (as a parsed set of attributes)".
3341      */
3342
3343     if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) {
3344         if (atoi(field[XLFD_ADD_STYLE]) != 0) {
3345             for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) {
3346                 field[j + 1] = field[j];
3347             }
3348             field[XLFD_ADD_STYLE] = NULL;
3349             i++;
3350         }
3351     }
3352
3353     /*
3354      * Bail if we don't have enough of the fields (up to pointsize).
3355      */
3356
3357     if (i < XLFD_FAMILY) {
3358         Tcl_DStringFree(&ds);
3359         return TCL_ERROR;
3360     }
3361
3362     if (FieldSpecified(field[XLFD_FOUNDRY])) {
3363         xaPtr->foundry = Tk_GetUid(field[XLFD_FOUNDRY]);
3364     }
3365
3366     if (FieldSpecified(field[XLFD_FAMILY])) {
3367         faPtr->family = Tk_GetUid(field[XLFD_FAMILY]);
3368     }
3369     if (FieldSpecified(field[XLFD_WEIGHT])) {
3370         faPtr->weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
3371                 field[XLFD_WEIGHT]);
3372     }
3373     if (FieldSpecified(field[XLFD_SLANT])) {
3374         xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap,
3375                 field[XLFD_SLANT]);
3376         if (xaPtr->slant == TK_FS_ROMAN) {
3377             faPtr->slant = TK_FS_ROMAN;
3378         } else {
3379             faPtr->slant = TK_FS_ITALIC;
3380         }
3381     }
3382     if (FieldSpecified(field[XLFD_SETWIDTH])) {
3383         xaPtr->setwidth = TkFindStateNum(NULL, NULL, xlfdSetwidthMap,
3384                 field[XLFD_SETWIDTH]);
3385     }
3386
3387     /* XLFD_ADD_STYLE ignored. */
3388
3389     /*
3390      * Pointsize in tenths of a point, but treat it as tenths of a pixel
3391      * for historical compatibility.
3392      */
3393
3394     faPtr->size = 12;
3395
3396     if (FieldSpecified(field[XLFD_POINT_SIZE])) {
3397         if (field[XLFD_POINT_SIZE][0] == '[') {
3398             /*
3399              * Some X fonts have the point size specified as follows:
3400              *
3401              *      [ N1 N2 N3 N4 ]
3402              *
3403              * where N1 is the point size (in points, not decipoints!), and
3404              * N2, N3, and N4 are some additional numbers that I don't know
3405              * the purpose of, so I ignore them.
3406              */
3407
3408             faPtr->size = atoi(field[XLFD_POINT_SIZE] + 1);
3409         } else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
3410                 &faPtr->size) == TCL_OK) {
3411             faPtr->size /= 10;
3412         } else {
3413             return TCL_ERROR;
3414         }
3415     }
3416
3417     /*
3418      * Pixel height of font.  If specified, overrides pointsize.
3419      */
3420
3421     if (FieldSpecified(field[XLFD_PIXEL_SIZE])) {
3422         if (field[XLFD_PIXEL_SIZE][0] == '[') {
3423             /*
3424              * Some X fonts have the pixel size specified as follows:
3425              *
3426              *      [ N1 N2 N3 N4 ]
3427              *
3428              * where N1 is the pixel size, and where N2, N3, and N4
3429              * are some additional numbers that I don't know
3430              * the purpose of, so I ignore them.
3431              */
3432
3433             faPtr->size = atoi(field[XLFD_PIXEL_SIZE] + 1);
3434         } else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
3435                 &faPtr->size) != TCL_OK) {
3436             return TCL_ERROR;
3437         }
3438     }
3439
3440     faPtr->size = -faPtr->size;
3441
3442     /* XLFD_RESOLUTION_X ignored. */
3443
3444     /* XLFD_RESOLUTION_Y ignored. */
3445
3446     /* XLFD_SPACING ignored. */
3447
3448     /* XLFD_AVERAGE_WIDTH ignored. */
3449
3450     if (FieldSpecified(field[XLFD_CHARSET])) {
3451         xaPtr->charset = Tk_GetUid(field[XLFD_CHARSET]);
3452     } else {
3453         xaPtr->charset = Tk_GetUid("iso8859-1");
3454     }
3455     Tcl_DStringFree(&ds);
3456     return TCL_OK;
3457 }
3458 \f
3459 /*
3460  *---------------------------------------------------------------------------
3461  *
3462  * FieldSpecified --
3463  *
3464  *      Helper function for TkParseXLFD().  Determines if a field in the
3465  *      XLFD was set to a non-null, non-don't-care value.
3466  *
3467  * Results:
3468  *      The return value is 0 if the field in the XLFD was not set and
3469  *      should be ignored, non-zero otherwise.
3470  *
3471  * Side effects:
3472  *      None.
3473  *
3474  *---------------------------------------------------------------------------
3475  */
3476
3477 static int
3478 FieldSpecified(field)
3479     CONST char *field;  /* The field of the XLFD to check.  Strictly
3480                          * speaking, only when the string is "*" does it mean
3481                          * don't-care.  However, an unspecified or question
3482                          * mark is also interpreted as don't-care. */
3483 {
3484     char ch;
3485
3486     if (field == NULL) {
3487         return 0;
3488     }
3489     ch = field[0];
3490     return (ch != '*' && ch != '?');
3491 }
3492 \f
3493 /*
3494  *---------------------------------------------------------------------------
3495  *
3496  * TkFontGetPixels --
3497  *
3498  *      Given a font size specification (as described in the TkFontAttributes
3499  *      structure) return the number of pixels it represents.
3500  *
3501  * Results:
3502  *      As above.
3503  *
3504  * Side effects:
3505  *      None.
3506  *
3507  *---------------------------------------------------------------------------
3508  */
3509
3510 int
3511 TkFontGetPixels(tkwin, size)
3512     Tk_Window tkwin;            /* For point->pixel conversion factor. */
3513     int size;                   /* Font size. */
3514 {
3515     double d;
3516
3517     if (size < 0) {
3518         return -size;
3519     }
3520
3521     d = size * 25.4 / 72.0;
3522     d *= WidthOfScreen(Tk_Screen(tkwin));
3523     d /= WidthMMOfScreen(Tk_Screen(tkwin));
3524     return (int) (d + 0.5);
3525 }
3526 \f
3527 /*
3528  *---------------------------------------------------------------------------
3529  *
3530  * TkFontGetPoints --
3531  *
3532  *      Given a font size specification (as described in the TkFontAttributes
3533  *      structure) return the number of points it represents.
3534  *
3535  * Results:
3536  *      As above.
3537  *
3538  * Side effects:
3539  *      None.
3540  *
3541  *---------------------------------------------------------------------------
3542  */
3543
3544 int
3545 TkFontGetPoints(tkwin, size)
3546     Tk_Window tkwin;            /* For pixel->point conversion factor. */
3547     int size;                   /* Font size. */
3548 {
3549     double d;
3550
3551     if (size >= 0) {
3552         return size;
3553     }
3554
3555     d = -size * 72.0 / 25.4;
3556     d *= WidthMMOfScreen(Tk_Screen(tkwin));
3557     d /= WidthOfScreen(Tk_Screen(tkwin));
3558     return (int) (d + 0.5);
3559 }
3560 \f
3561 /*
3562  *-------------------------------------------------------------------------
3563  *
3564  * TkFontGetAliasList --
3565  *
3566  *      Given a font name, find the list of all aliases for that font
3567  *      name.  One of the names in this list will probably be the name
3568  *      that this platform expects when asking for the font.
3569  *
3570  * Results:
3571  *      As above.  The return value is NULL if the font name has no
3572  *      aliases.
3573  *
3574  * Side effects:
3575  *      None.
3576  *
3577  *-------------------------------------------------------------------------
3578  */
3579
3580 char **
3581 TkFontGetAliasList(faceName)
3582     CONST char *faceName;       /* Font name to test for aliases. */
3583 {
3584     int i, j;
3585
3586     for (i = 0; fontAliases[i] != NULL; i++) {
3587         for (j = 0; fontAliases[i][j] != NULL; j++) {
3588             if (strcasecmp(faceName, fontAliases[i][j]) == 0) {
3589                 return fontAliases[i];
3590             }
3591         }
3592     }
3593     return NULL;
3594 }
3595 \f
3596 /*
3597  *-------------------------------------------------------------------------
3598  *
3599  * TkFontGetFallbacks --
3600  *
3601  *      Get the list of font fallbacks that the platform-specific code
3602  *      can use to try to find the closest matching font the name
3603  *      requested.
3604  *
3605  * Results:
3606  *      As above.
3607  *
3608  * Side effects:
3609  *      None.
3610  *
3611  *-------------------------------------------------------------------------
3612  */
3613
3614 char ***
3615 TkFontGetFallbacks()
3616 {
3617     return fontFallbacks;
3618 }
3619 \f
3620 /*
3621  *-------------------------------------------------------------------------
3622  *
3623  * TkFontGetGlobalClass --
3624  *
3625  *      Get the list of fonts to try if the requested font name does not
3626  *      exist and no fallbacks for that font name could be used either.
3627  *      The names in this list are considered preferred over all the other
3628  *      font names in the system when looking for a last-ditch fallback.
3629  *
3630  * Results:
3631  *      As above.
3632  *
3633  * Side effects:
3634  *      None.
3635  *
3636  *-------------------------------------------------------------------------
3637  */
3638
3639 char **
3640 TkFontGetGlobalClass()
3641 {
3642     return globalFontClass;
3643 }
3644 \f
3645 /*
3646  *-------------------------------------------------------------------------
3647  *
3648  * TkFontGetSymbolClass --
3649  *
3650  *      Get the list of fonts that are symbolic; used if the operating
3651  *      system cannot apriori identify symbolic fonts on its own.
3652  *
3653  * Results:
3654  *      As above.
3655  *
3656  * Side effects:
3657  *      None.
3658  *
3659  *-------------------------------------------------------------------------
3660  */
3661
3662 char **
3663 TkFontGetSymbolClass()
3664 {
3665     return symbolClass;
3666 }
3667 \f
3668 /*
3669  *----------------------------------------------------------------------
3670  *
3671  * TkDebugFont --
3672  *
3673  *      This procedure returns debugging information about a font.
3674  *
3675  * Results:
3676  *      The return value is a list with one sublist for each TkFont
3677  *      corresponding to "name".  Each sublist has two elements that
3678  *      contain the resourceRefCount and objRefCount fields from the
3679  *      TkFont structure.
3680  *
3681  * Side effects:
3682  *      None.
3683  *
3684  *----------------------------------------------------------------------
3685  */
3686
3687 Tcl_Obj *
3688 TkDebugFont(tkwin, name)
3689     Tk_Window tkwin;            /* The window in which the font will be
3690                                  * used (not currently used). */
3691     char *name;                 /* Name of the desired color. */
3692 {
3693     TkFont *fontPtr;
3694     Tcl_HashEntry *hashPtr;
3695     Tcl_Obj *resultPtr, *objPtr;
3696
3697     resultPtr = Tcl_NewObj();
3698     hashPtr = Tcl_FindHashEntry(
3699             &((TkWindow *) tkwin)->mainPtr->fontInfoPtr->fontCache, name);
3700     if (hashPtr != NULL) {
3701         fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr);
3702         if (fontPtr == NULL) {
3703             panic("TkDebugFont found empty hash table entry");
3704         }
3705         for ( ; (fontPtr != NULL); fontPtr = fontPtr->nextPtr) {
3706             objPtr = Tcl_NewObj();
3707             Tcl_ListObjAppendElement(NULL, objPtr,
3708                     Tcl_NewIntObj(fontPtr->resourceRefCount));
3709             Tcl_ListObjAppendElement(NULL, objPtr,
3710                     Tcl_NewIntObj(fontPtr->objRefCount));
3711             Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
3712         }
3713     }
3714     return resultPtr;
3715 }
3716 \f
3717 /*
3718  *----------------------------------------------------------------------
3719  *
3720  * TkFontGetFirstTextLayout --
3721  *
3722  *      This procedure returns the first chunk of a Tk_TextLayout,
3723  *      i.e. until the first font change on the first line (or the
3724  *      whole first line if there is no such font change).
3725  *
3726  * Results:
3727  *      The return value is the byte length of the chunk, the chunk
3728  *      itself is copied into dst and its Tk_Font into font.
3729  *
3730  * Side effects:
3731  *      None.
3732  *
3733  *----------------------------------------------------------------------
3734  */
3735
3736 int
3737 TkFontGetFirstTextLayout(
3738     Tk_TextLayout layout,       /* Layout information, from a previous call
3739                                  * to Tk_ComputeTextLayout(). */
3740     Tk_Font * font,
3741     char    * dst)
3742 {
3743     TextLayout  *layoutPtr;
3744     LayoutChunk *chunkPtr;
3745     int numBytesInChunk;
3746
3747     layoutPtr = (TextLayout *)layout;
3748     if ((layoutPtr==NULL)
3749             || (layoutPtr->numChunks==0)
3750             || (layoutPtr->chunks->numDisplayChars <= 0)) {
3751         dst[0] = '\0';
3752         return 0;
3753     }
3754     chunkPtr = layoutPtr->chunks;
3755     numBytesInChunk = chunkPtr->numBytes;
3756     strncpy(dst, chunkPtr->start, (size_t) numBytesInChunk);
3757     *font = layoutPtr->tkfont;
3758     return numBytesInChunk;
3759 }