Logo Search packages:      
Sourcecode: saods9 version File versions

tkFont.c

/* 
 * tkFont.c --
 *
 *    This file maintains a database of fonts for the Tk toolkit.
 *    It also provides several utility procedures for measuring and
 *    displaying text.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkFont.c,v 1.1.1.1 2004/04/02 22:35:06 joye Exp $
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkFont.h"

/*
 * The following structure is used to keep track of all the fonts that
 * exist in the current application.  It must be stored in the
 * TkMainInfo for the application.
 */
 
typedef struct TkFontInfo {
    Tcl_HashTable fontCache;  /* Map a string to an existing Tk_Font.
                         * Keys are string font names, values are
                         * TkFont pointers. */
    Tcl_HashTable namedTable; /* Map a name to a set of attributes for a
                         * font, used when constructing a Tk_Font from
                         * a named font description.  Keys are
                         * strings, values are NamedFont pointers. */
    TkMainInfo *mainPtr;      /* Application that owns this structure. */
    int updatePending;        /* Non-zero when a World Changed event has
                         * already been queued to handle a change to
                         * a named font. */
} TkFontInfo;

/*
 * The following data structure is used to keep track of the font attributes
 * for each named font that has been defined.  The named font is only deleted
 * when the last reference to it goes away.
 */

typedef struct NamedFont {
    int refCount;       /* Number of users of named font. */
    int deletePending;        /* Non-zero if font should be deleted when
                         * last reference goes away. */
    TkFontAttributes fa;      /* Desired attributes for named font. */
} NamedFont;
    
/*
 * The following two structures are used to keep track of string
 * measurement information when using the text layout facilities.
 *
 * A LayoutChunk represents a contiguous range of text that can be measured
 * and displayed by low-level text calls.  In general, chunks will be
 * delimited by newlines and tabs.  Low-level, platform-specific things
 * like kerning and non-integer character widths may occur between the
 * characters in a single chunk, but not between characters in different
 * chunks.
 *
 * A TextLayout is a collection of LayoutChunks.  It can be displayed with
 * respect to any origin.  It is the implementation of the Tk_TextLayout
 * opaque token.
 */

typedef struct LayoutChunk {
    CONST char *start;        /* Pointer to simple string to be displayed.
                         * This is a pointer into the TkTextLayout's
                         * string. */
    int numBytes;       /* The number of bytes in this chunk. */
    int numChars;       /* The number of characters in this chunk. */
    int numDisplayChars;      /* The number of characters to display when
                         * this chunk is displayed.  Can be less than
                         * numChars if extra space characters were
                         * absorbed by the end of the chunk.  This
                         * will be < 0 if this is a chunk that is
                         * holding a tab or newline. */
    int x, y;                 /* The origin of the first character in this
                         * chunk with respect to the upper-left hand
                         * corner of the TextLayout. */
    int totalWidth;           /* Width in pixels of this chunk.  Used
                         * when hit testing the invisible spaces at
                         * the end of a chunk. */
    int displayWidth;         /* Width in pixels of the displayable
                         * characters in this chunk.  Can be less than
                         * width if extra space characters were
                         * absorbed by the end of the chunk. */
} LayoutChunk;

typedef struct TextLayout {
    Tk_Font tkfont;           /* The font used when laying out the text. */
    CONST char *string;       /* The string that was layed out. */
    int width;                /* The maximum width of all lines in the
                         * text layout. */
    int numChunks;            /* Number of chunks actually used in
                         * following array. */
    LayoutChunk chunks[1];    /* Array of chunks.  The actual size will
                         * be maxChunks.  THIS FIELD MUST BE THE LAST
                         * IN THE STRUCTURE. */
} TextLayout;

/*
 * The following structures are used as two-way maps between the values for
 * the fields in the TkFontAttributes structure and the strings used in
 * Tcl, when parsing both option-value format and style-list format font
 * name strings.
 */

static TkStateMap weightMap[] = {
    {TK_FW_NORMAL,      "normal"},
    {TK_FW_BOLD,  "bold"},
    {TK_FW_UNKNOWN,     NULL}
};

static TkStateMap slantMap[] = {
    {TK_FS_ROMAN, "roman"},
    {TK_FS_ITALIC,      "italic"},
    {TK_FS_UNKNOWN,     NULL}
};

static TkStateMap underlineMap[] = {
    {1,                 "underline"},
    {0,                 NULL}
};

static TkStateMap overstrikeMap[] = {
    {1,                 "overstrike"},
    {0,                 NULL}
};

/*
 * The following structures are used when parsing XLFD's into a set of
 * TkFontAttributes.
 */

static TkStateMap xlfdWeightMap[] = {
    {TK_FW_NORMAL,      "normal"},
    {TK_FW_NORMAL,      "medium"},
    {TK_FW_NORMAL,      "book"},
    {TK_FW_NORMAL,      "light"},
    {TK_FW_BOLD,  "bold"},
    {TK_FW_BOLD,  "demi"},
    {TK_FW_BOLD,  "demibold"},
    {TK_FW_NORMAL,      NULL}       /* Assume anything else is "normal". */
}; 

static TkStateMap xlfdSlantMap[] = {
    {TK_FS_ROMAN, "r"},
    {TK_FS_ITALIC,      "i"},
    {TK_FS_OBLIQUE,     "o"},
    {TK_FS_ROMAN, NULL}       /* Assume anything else is "roman". */
};

static TkStateMap xlfdSetwidthMap[] = {
    {TK_SW_NORMAL,      "normal"},
    {TK_SW_CONDENSE,    "narrow"},
    {TK_SW_CONDENSE,    "semicondensed"},
    {TK_SW_CONDENSE,    "condensed"},
    {TK_SW_UNKNOWN,     NULL}
};

/*
 * The following structure and defines specify the valid builtin options 
 * when configuring a set of font attributes.
 */

static CONST char *fontOpt[] = {
    "-family",
    "-size",
    "-weight",
    "-slant",
    "-underline",
    "-overstrike",
    NULL
};

#define FONT_FAMILY     0
#define FONT_SIZE 1
#define FONT_WEIGHT     2
#define FONT_SLANT      3
#define FONT_UNDERLINE  4
#define FONT_OVERSTRIKE 5
#define FONT_NUMFIELDS  6

/*
 * Hardcoded font aliases.  These are used to describe (mostly) identical
 * fonts whose names differ from platform to platform.  If the
 * user-supplied font name matches any of the names in one of the alias
 * lists, the other names in the alias list are also automatically tried.
 */

static char *timesAliases[] = {
    "Times",                  /* Unix. */
    "Times New Roman",        /* Windows. */
    "New York",               /* Mac. */
    NULL
};

static char *helveticaAliases[] = {
    "Helvetica",        /* Unix. */
    "Arial",                  /* Windows. */
    "Geneva",                 /* Mac. */
    NULL
};

static char *courierAliases[] = {
    "Courier",                /* Unix and Mac. */
    "Courier New",            /* Windows. */
    NULL
};

static char *minchoAliases[] = {
    "mincho",                 /* Unix. */
    "\357\274\255\357\274\263 \346\230\216\346\234\235",
                        /* Windows (MS mincho). */
    "\346\234\254\346\230\216\346\234\235\342\210\222\357\274\255",
                        /* Mac (honmincho-M). */
    NULL
};

static char *gothicAliases[] = {
    "gothic",                 /* Unix. */
    "\357\274\255\357\274\263 \343\202\264\343\202\267\343\203\203\343\202\257",
                        /* Windows (MS goshikku). */
    "\344\270\270\343\202\264\343\202\267\343\203\203\343\202\257\342\210\222\357\274\255",
                        /* Mac (goshikku-M). */
    NULL    
};

static char *dingbatsAliases[] = {
    "dingbats", "zapfdingbats", "itc zapfdingbats",
                        /* Unix. */
                        /* Windows. */
    "zapf dingbats",          /* Mac. */
    NULL
};

static char **fontAliases[] = {
    timesAliases,
    helveticaAliases,
    courierAliases,
    minchoAliases,
    gothicAliases,
    dingbatsAliases,
    NULL
};  

/*
 * Hardcoded font classes.  If the character cannot be found in the base 
 * font, the classes are examined in order to see if some other similar 
 * font should be examined also.  
 */

static char *systemClass[] = {
    "fixed",                        /* Unix. */
                              /* Windows. */
    "chicago", "osaka", "sistemny", /* Mac. */
    NULL
};

static char *serifClass[] = {
    "times", "palatino", "mincho",  /* All platforms. */
    "song ti",                      /* Unix. */
    "ms serif", "simplified arabic",      /* Windows. */
    "latinski",                     /* Mac. */
    NULL
};

static char *sansClass[] = {
    "helvetica", "gothic",          /* All platforms. */
                              /* Unix. */
    "ms sans serif", "traditional arabic",
                              /* Windows. */
    "bastion",                      /* Mac. */
    NULL
};

static char *monoClass[] = {
    "courier", "gothic",            /* All platforms. */
    "fangsong ti",                  /* Unix. */
    "simplified arabic fixed",            /* Windows. */
    "monaco", "pryamoy",            /* Mac. */
    NULL
};

static char *symbolClass[] = {
    "symbol", "dingbats", "wingdings", NULL
};

static char **fontFallbacks[] = {
    systemClass,
    serifClass,
    sansClass,
    monoClass,
    symbolClass,
    NULL
};

/*
 * Global fallbacks.  If the character could not be found in the preferred
 * fallback list, this list is examined.  If the character still cannot be
 * found, all font families in the system are examined. 
 */

static char *globalFontClass[] = {
    "symbol",                 /* All platforms. */
                        /* Unix. */
    "lucida sans unicode",    /* Windows. */
    "bitstream cyberbit",     /* Windows popular CJK font */
    "chicago",                /* Mac. */
    NULL
};

#define GetFontAttributes(tkfont) \
            ((CONST TkFontAttributes *) &((TkFont *) (tkfont))->fa)

#define GetFontMetrics(tkfont)    \
            ((CONST TkFontMetrics *) &((TkFont *) (tkfont))->fm)


static int        ConfigAttributesObj _ANSI_ARGS_((Tcl_Interp *interp,
                      Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[],
                      TkFontAttributes *faPtr));
static int        CreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
                      Tk_Window tkwin, CONST char *name,
                      TkFontAttributes *faPtr));
static void       DupFontObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
                      Tcl_Obj *dupObjPtr));
static int        FieldSpecified _ANSI_ARGS_((CONST char *field));
static void       FreeFontObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
static int        GetAttributeInfoObj _ANSI_ARGS_((Tcl_Interp *interp,
                      CONST TkFontAttributes *faPtr, Tcl_Obj *objPtr));
static LayoutChunk *    NewChunk _ANSI_ARGS_((TextLayout **layoutPtrPtr,
                      int *maxPtr, CONST char *start, int numChars,
                      int curX, int newX, int y));
static int        ParseFontNameObj _ANSI_ARGS_((Tcl_Interp *interp,
                      Tk_Window tkwin, Tcl_Obj *objPtr,
                      TkFontAttributes *faPtr));
static void       RecomputeWidgets _ANSI_ARGS_((TkWindow *winPtr));
static int        SetFontFromAny _ANSI_ARGS_((Tcl_Interp *interp,
                      Tcl_Obj *objPtr));
static void       TheWorldHasChanged _ANSI_ARGS_((
                      ClientData clientData));
static void       UpdateDependentFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
                      Tk_Window tkwin, Tcl_HashEntry *namedHashPtr));

/*
 * The following structure defines the implementation of the "font" Tcl
 * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of
 * each font object points to the TkFont structure for the font, or
 * NULL.
 */

Tcl_ObjType tkFontObjType = {
    "font",             /* name */
    FreeFontObjProc,          /* freeIntRepProc */
    DupFontObjProc,           /* dupIntRepProc */
    NULL,               /* updateStringProc */
    SetFontFromAny            /* setFromAnyProc */
};


/*
 *---------------------------------------------------------------------------
 *
 * TkFontPkgInit --
 *
 *    This procedure is called when an application is created.  It
 *    initializes all the structures that are used by the font
 *    package on a per application basis.
 *
 * Results:
 *    Stores a token in the mainPtr to hold information needed by this 
 *    package on a per application basis. 
 *
 * Side effects:
 *    Memory allocated.
 *
 *---------------------------------------------------------------------------
 */
void
TkFontPkgInit(mainPtr)
    TkMainInfo *mainPtr;      /* The application being created. */
{
    TkFontInfo *fiPtr;

    fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo));
    Tcl_InitHashTable(&fiPtr->fontCache, TCL_STRING_KEYS);
    Tcl_InitHashTable(&fiPtr->namedTable, TCL_STRING_KEYS);
    fiPtr->mainPtr = mainPtr;
    fiPtr->updatePending = 0;
    mainPtr->fontInfoPtr = fiPtr;

    TkpFontPkgInit(mainPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkFontPkgFree --
 *
 *    This procedure is called when an application is deleted.  It
 *    deletes all the structures that were used by the font package
 *    for this application.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Memory freed.
 *
 *---------------------------------------------------------------------------
 */

void
TkFontPkgFree(mainPtr)
    TkMainInfo *mainPtr;      /* The application being deleted. */
{
    TkFontInfo *fiPtr;
    Tcl_HashEntry *hPtr, *searchPtr;
    Tcl_HashSearch search;
    int fontsLeft;

    fiPtr = mainPtr->fontInfoPtr;

    fontsLeft = 0;
    for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
          searchPtr != NULL;
          searchPtr = Tcl_NextHashEntry(&search)) {
      fontsLeft++;
      fprintf(stderr, "Font %s still in cache.\n", 
            Tcl_GetHashKey(&fiPtr->fontCache, searchPtr));
    }
#ifdef PURIFY
    if (fontsLeft) {
      panic("TkFontPkgFree: all fonts should have been freed already");
    }
#endif
    Tcl_DeleteHashTable(&fiPtr->fontCache);

    hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
    while (hPtr != NULL) {
      ckfree((char *) Tcl_GetHashValue(hPtr));
      hPtr = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(&fiPtr->namedTable);
    if (fiPtr->updatePending != 0) {
      Tcl_CancelIdleCall(TheWorldHasChanged, (ClientData) fiPtr);
    }
    ckfree((char *) fiPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FontObjCmd -- 
 *
 *    This procedure is implemented to process the "font" Tcl command.
 *    See the user documentation for details on what it does.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tk_FontObjCmd(clientData, interp, objc, objv)
    ClientData clientData;    /* Main window associated with interpreter. */
    Tcl_Interp *interp;       /* Current interpreter. */
    int objc;                 /* Number of arguments. */
    Tcl_Obj *CONST objv[];    /* Argument objects. */
{
    int index;
    Tk_Window tkwin;
    TkFontInfo *fiPtr;
    static CONST char *optionStrings[] = {
      "actual",   "configure",      "create",   "delete",
      "families", "measure",  "metrics",  "names",
      NULL
    };
    enum options {
      FONT_ACTUAL,      FONT_CONFIGURE,   FONT_CREATE,      FONT_DELETE,
      FONT_FAMILIES,    FONT_MEASURE,     FONT_METRICS,     FONT_NAMES
    };

    tkwin = (Tk_Window) clientData;
    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;

    if (objc < 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
      return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
          &index) != TCL_OK) {
      return TCL_ERROR;
    }

    switch ((enum options) index) {
      case FONT_ACTUAL: {
          int skip, result;
          Tk_Font tkfont;
          Tcl_Obj *objPtr;
          CONST TkFontAttributes *faPtr;

          skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
          if (skip < 0) {
            return TCL_ERROR;
          }
          if ((objc < 3) || (objc - skip > 4)) {
            Tcl_WrongNumArgs(interp, 2, objv,
                  "font ?-displayof window? ?option?");
            return TCL_ERROR;
          }
          tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
          if (tkfont == NULL) {
            return TCL_ERROR;
          }
          objc -= skip;
          objv += skip;
          faPtr = GetFontAttributes(tkfont);
          objPtr = NULL;
          if (objc > 3) {
            objPtr = objv[3];
          }
          result = GetAttributeInfoObj(interp, faPtr, objPtr);
          Tk_FreeFont(tkfont);
          return result;
      }
      case FONT_CONFIGURE: {
          int result;
          char *string;
          Tcl_Obj *objPtr;
          NamedFont *nfPtr;
          Tcl_HashEntry *namedHashPtr;

          if (objc < 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?");
            return TCL_ERROR;
          }
          string = Tcl_GetString(objv[2]);
          namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
          nfPtr = NULL;       /* lint. */
          if (namedHashPtr != NULL) {
            nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
          }
          if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) {
            Tcl_AppendResult(interp, "named font \"", string,
                  "\" doesn't exist", NULL);
            return TCL_ERROR;
          }
          if (objc == 3) {
            objPtr = NULL;
          } else if (objc == 4) {
            objPtr = objv[3];
          } else {
            result = ConfigAttributesObj(interp, tkwin, objc - 3,
                  objv + 3, &nfPtr->fa);
            UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
            return result;
          }
          return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
      }
      case FONT_CREATE: {
          int skip, i;
          char *name;
          char buf[16 + TCL_INTEGER_SPACE];
          TkFontAttributes fa;
          Tcl_HashEntry *namedHashPtr;

          skip = 3;
          if (objc < 3) {
            name = NULL;
          } else {
            name = Tcl_GetString(objv[2]);
            if (name[0] == '-') {
                name = NULL;
            }
          }
          if (name == NULL) {
            /*
             * No font name specified.  Generate one of the form "fontX".
             */

            for (i = 1; ; i++) {
                sprintf(buf, "font%d", i);
                namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, buf);
                if (namedHashPtr == NULL) {
                  break;
                }
            }
            name = buf;
            skip = 2;
          }
          TkInitFontAttributes(&fa);
          if (ConfigAttributesObj(interp, tkwin, objc - skip, objv + skip,
                &fa) != TCL_OK) {
            return TCL_ERROR;
          }
          if (CreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
            return TCL_ERROR;
          }
          Tcl_AppendResult(interp, name, NULL);
          break;
      }
      case FONT_DELETE: {
          int i;
          char *string;
          NamedFont *nfPtr;
          Tcl_HashEntry *namedHashPtr;

          /*
           * Delete the named font.  If there are still widgets using this
           * font, then it isn't deleted right away.
           */

          if (objc < 3) {
            Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?");
            return TCL_ERROR;
          }
          for (i = 2; i < objc; i++) {
            string = Tcl_GetString(objv[i]);
            namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
            if (namedHashPtr == NULL) {
                Tcl_AppendResult(interp, "named font \"", string,
                      "\" doesn't exist", (char *) NULL);
                return TCL_ERROR;
            }
            nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
            if (nfPtr->refCount != 0) {
                nfPtr->deletePending = 1;
            } else {
                Tcl_DeleteHashEntry(namedHashPtr);
                ckfree((char *) nfPtr);
            }
          }
          break;
      }
      case FONT_FAMILIES: {
          int skip;

          skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
          if (skip < 0) {
            return TCL_ERROR;
          }
          if (objc - skip != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
            return TCL_ERROR;
          }
          TkpGetFontFamilies(interp, tkwin);
          break;
      }
      case FONT_MEASURE: {
          char *string;
          Tk_Font tkfont;
          int length, skip;
          Tcl_Obj *resultPtr;
          
          skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
          if (skip < 0) {
            return TCL_ERROR;
          }
          if (objc - skip != 4) {
            Tcl_WrongNumArgs(interp, 2, objv,
                  "font ?-displayof window? text");
            return TCL_ERROR;
          }
          tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
          if (tkfont == NULL) {
            return TCL_ERROR;
          }
          string = Tcl_GetStringFromObj(objv[3 + skip], &length);
          resultPtr = Tcl_GetObjResult(interp);
          Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length));
          Tk_FreeFont(tkfont);
          break;
      }
      case FONT_METRICS: {
          Tk_Font tkfont;
          int skip, index, i;
          CONST TkFontMetrics *fmPtr;
          static CONST char *switches[] = {
            "-ascent", "-descent", "-linespace", "-fixed", NULL
          };

          skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
          if (skip < 0) {
            return TCL_ERROR;
          }
          if ((objc < 3) || ((objc - skip) > 4)) {
            Tcl_WrongNumArgs(interp, 2, objv,
                  "font ?-displayof window? ?option?");
            return TCL_ERROR;
          }
          tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
          if (tkfont == NULL) {
            return TCL_ERROR;
          }
          objc -= skip;
          objv += skip;
          fmPtr = GetFontMetrics(tkfont);
          if (objc == 3) {
            char buf[64 + TCL_INTEGER_SPACE * 4];

            sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d",
                  fmPtr->ascent, fmPtr->descent,
                  fmPtr->ascent + fmPtr->descent,
                  fmPtr->fixed);
            Tcl_AppendResult(interp, buf, NULL);
          } else {
            if (Tcl_GetIndexFromObj(interp, objv[3], switches,
                  "metric", 0, &index) != TCL_OK) {
                Tk_FreeFont(tkfont);
                return TCL_ERROR;
            }
            i = 0;                  /* Needed only to prevent compiler
                               * warning. */
            switch (index) {
                case 0: i = fmPtr->ascent;                  break;
                case 1: i = fmPtr->descent;                 break;
                case 2: i = fmPtr->ascent + fmPtr->descent; break;
                case 3: i = fmPtr->fixed;             break;
            }
            Tcl_SetIntObj(Tcl_GetObjResult(interp), i);
          }
          Tk_FreeFont(tkfont);
          break;
      }
      case FONT_NAMES: {
          char *string;
          NamedFont *nfPtr;
          Tcl_HashSearch search;
          Tcl_HashEntry *namedHashPtr;
          Tcl_Obj *strPtr, *resultPtr;
          
          if (objc != 2) {
            Tcl_WrongNumArgs(interp, 1, objv, "names");
            return TCL_ERROR;
          }
          resultPtr = Tcl_GetObjResult(interp);
          namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
          while (namedHashPtr != NULL) {
            nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
            if (nfPtr->deletePending == 0) {
                string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr);
                strPtr = Tcl_NewStringObj(string, -1);
                Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
            }
            namedHashPtr = Tcl_NextHashEntry(&search);
          }
          break;
      }
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * UpdateDependentFonts, TheWorldHasChanged, RecomputeWidgets --
 *
 *    Called when the attributes of a named font changes.  Updates all
 *    the instantiated fonts that depend on that named font and then
 *    uses the brute force approach and prepares every widget to
 *    recompute its geometry.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Things get queued for redisplay.
 *
 *---------------------------------------------------------------------------
 */

static void
UpdateDependentFonts(fiPtr, tkwin, namedHashPtr)
    TkFontInfo *fiPtr;        /* Info about application's fonts. */
    Tk_Window tkwin;          /* A window in the application. */
    Tcl_HashEntry *namedHashPtr;/* The named font that is changing. */
{
    Tcl_HashEntry *cacheHashPtr;
    Tcl_HashSearch search;
    TkFont *fontPtr;
    NamedFont *nfPtr;

    nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
    if (nfPtr->refCount == 0) {
      /*
       * Well nobody's using this named font, so don't have to tell
       * any widgets to recompute themselves.
       */

      return;
    }

    cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
    while (cacheHashPtr != NULL) {
      for (fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
            fontPtr != NULL; fontPtr = fontPtr->nextPtr) {
          if (fontPtr->namedHashPtr == namedHashPtr) {
            TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
            if (fiPtr->updatePending == 0) {
                fiPtr->updatePending = 1;
                Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr);
            }
          }
      }
      cacheHashPtr = Tcl_NextHashEntry(&search);
    }
}

static void
TheWorldHasChanged(clientData)
    ClientData clientData;    /* Info about application's fonts. */
{
    TkFontInfo *fiPtr;

    fiPtr = (TkFontInfo *) clientData;
    fiPtr->updatePending = 0;

    RecomputeWidgets(fiPtr->mainPtr->winPtr);
}

static void
RecomputeWidgets(winPtr)
    TkWindow *winPtr;         /* Window to which command is sent. */
{
    Tk_ClassWorldChangedProc *proc;
    proc = Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc);
    if (proc != NULL) {
      (*proc)(winPtr->instanceData);
    }

    /*
     * Notify all the descendants of this window that the world has changed.
     *
     * This could be done recursively or iteratively.  The recursive version
     * is easier to implement and understand, and typically, windows with a
     * -font option will be leaf nodes in the widget heirarchy (buttons,
     * labels, etc.), so the recursion depth will be shallow.
     *
     * However, the additional overhead of the recursive calls may become
     * a performance problem if typical usage alters such that -font'ed widgets
     * appear high in the heirarchy, causing deep recursion.  This could happen
     * with text widgets, or more likely with the (not yet existant) labeled
     * frame widget.  With these widgets it is possible, even likely, that a
     * -font'ed widget (text or labeled frame) will not be a leaf node, but
     * will instead have many descendants.  If this is ever found to cause
     * a performance problem, it may be worth investigating an iterative
     * version of the code below.
     */
    for (winPtr = winPtr->childList; winPtr != NULL; winPtr = winPtr->nextPtr) {
      RecomputeWidgets(winPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * CreateNamedFont --
 *
 *    Create the specified named font with the given attributes in the
 *    named font table associated with the interp.  
 *
 * Results:
 *    Returns TCL_OK if the font was successfully created, or TCL_ERROR
 *    if the named font already existed.  If TCL_ERROR is returned, an
 *    error message is left in the interp's result.
 *
 * Side effects:
 *    Assume there used to exist a named font by the specified name, and
 *    that the named font had been deleted, but there were still some
 *    widgets using the named font at the time it was deleted.  If a
 *    new named font is created with the same name, all those widgets
 *    that were using the old named font will be redisplayed using
 *    the new named font's attributes.
 *
 *---------------------------------------------------------------------------
 */

static int
CreateNamedFont(interp, tkwin, name, faPtr)
    Tcl_Interp *interp;       /* Interp for error return. */
    Tk_Window tkwin;          /* A window associated with interp. */
    CONST char *name;         /* Name for the new named font. */
    TkFontAttributes *faPtr;  /* Attributes for the new named font. */
{
    TkFontInfo *fiPtr;
    Tcl_HashEntry *namedHashPtr;
    int new;
    NamedFont *nfPtr;    

    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;

    namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
                
    if (new == 0) {
      nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
      if (nfPtr->deletePending == 0) {
          Tcl_ResetResult(interp);
          Tcl_AppendResult(interp, "named font \"", name,
                "\" already exists", (char *) NULL);
          return TCL_ERROR;
      }

      /*
       * Recreating a named font with the same name as a previous
       * named font.  Some widgets were still using that named
       * font, so they need to get redisplayed.
       */

      nfPtr->fa = *faPtr;
      nfPtr->deletePending = 0;
      UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
      return TCL_OK;
    }

    nfPtr = (NamedFont *) ckalloc(sizeof(NamedFont));
    nfPtr->deletePending = 0;
    Tcl_SetHashValue(namedHashPtr, nfPtr);
    nfPtr->fa = *faPtr;
    nfPtr->refCount = 0;      
    nfPtr->deletePending = 0;
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_GetFont -- 
 *
 *    Given a string description of a font, map the description to a
 *    corresponding Tk_Font that represents the font.
 *
 * Results:
 *    The return value is token for the font, or NULL if an error
 *    prevented the font from being created.  If NULL is returned, an
 *    error message will be left in the interp's result.
 *
 * Side effects:
 *    The font is added to an internal database with a reference
 *    count.  For each call to this procedure, there should eventually
 *    be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
 *    database is cleaned up when fonts aren't in use anymore.
 *
 *---------------------------------------------------------------------------
 */

Tk_Font
Tk_GetFont(interp, tkwin, string)
    Tcl_Interp *interp;       /* Interp for database and error return. */
    Tk_Window tkwin;          /* For display on which font will be used. */
    CONST char *string;       /* String describing font, as: named font,
                         * native format, or parseable string. */
{
    Tk_Font tkfont; 
    Tcl_Obj *strPtr;

    strPtr = Tcl_NewStringObj((char *) string, -1);
    Tcl_IncrRefCount(strPtr);
    tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);
    Tcl_DecrRefCount(strPtr); 
    return tkfont;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_AllocFontFromObj -- 
 *
 *    Given a string description of a font, map the description to a
 *    corresponding Tk_Font that represents the font.
 *
 * Results:
 *    The return value is token for the font, or NULL if an error
 *    prevented the font from being created.  If NULL is returned, an
 *    error message will be left in interp's result object.
 *
 * Side effects:
 *    The font is added to an internal database with a reference
 *    count.  For each call to this procedure, there should eventually
 *    be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
 *    database is cleaned up when fonts aren't in use anymore.
 *
 *---------------------------------------------------------------------------
 */

Tk_Font
Tk_AllocFontFromObj(interp, tkwin, objPtr)
    Tcl_Interp *interp;       /* Interp for database and error return. */
    Tk_Window tkwin;          /* For screen on which font will be used. */
    Tcl_Obj *objPtr;          /* Object describing font, as: named font,
                         * native format, or parseable string. */
{
    TkFontInfo *fiPtr;
    Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
    TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
    int new, descent;
    NamedFont *nfPtr;

    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
    if (objPtr->typePtr != &tkFontObjType) {
      SetFontFromAny(interp, objPtr);
    }

    oldFontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;

    if (oldFontPtr != NULL) {
      if (oldFontPtr->resourceRefCount == 0) {
          /*
           * This is a stale reference: it refers to a TkFont that's
           * no longer in use.  Clear the reference.
           */

          FreeFontObjProc(objPtr);
          oldFontPtr = NULL;
      } else if (Tk_Screen(tkwin) == oldFontPtr->screen) {
          oldFontPtr->resourceRefCount++;
          return (Tk_Font) oldFontPtr;
      }
    }

    /*
     * Next, search the list of fonts that have the name we want, to see
     * if one of them is for the right screen.
     */

    new = 0;
    if (oldFontPtr != NULL) {
      cacheHashPtr = oldFontPtr->cacheHashPtr;
      FreeFontObjProc(objPtr);
    } else {
      cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache,
            Tcl_GetString(objPtr), &new);
    }
    firstFontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
    for (fontPtr = firstFontPtr; (fontPtr != NULL);
          fontPtr = fontPtr->nextPtr) {
      if (Tk_Screen(tkwin) == fontPtr->screen) {
          fontPtr->resourceRefCount++;
          fontPtr->objRefCount++;
          objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
          return (Tk_Font) fontPtr;
      }
    }

    /*
     * The desired font isn't in the table.  Make a new one.
     */

    namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
          Tcl_GetString(objPtr));
    if (namedHashPtr != NULL) {
      /*
       * Construct a font based on a named font.
       */

      nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
      nfPtr->refCount++;

      fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa);
    } else {
      /*
       * Native font?
       */

      fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr));
      if (fontPtr == NULL) {
          TkFontAttributes fa;
          Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr);

          if (ParseFontNameObj(interp, tkwin, dupObjPtr, &fa) != TCL_OK) {
            if (new) {
                Tcl_DeleteHashEntry(cacheHashPtr);
            }
            Tcl_DecrRefCount(dupObjPtr);
            return NULL;
          }
          Tcl_DecrRefCount(dupObjPtr);

          /*
           * String contained the attributes inline.
           */

          fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
      }
    }

    fontPtr->resourceRefCount = 1;
    fontPtr->objRefCount = 1;
    fontPtr->cacheHashPtr = cacheHashPtr;
    fontPtr->namedHashPtr = namedHashPtr;
    fontPtr->screen = Tk_Screen(tkwin);
    fontPtr->nextPtr = firstFontPtr;
    Tcl_SetHashValue(cacheHashPtr, fontPtr);

    Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, -1, 0, &fontPtr->tabWidth);
    if (fontPtr->tabWidth == 0) {
      fontPtr->tabWidth = fontPtr->fm.maxWidth;
    }
    fontPtr->tabWidth *= 8;

    /*
     * Make sure the tab width isn't zero (some fonts may not have enough
     * information to set a reasonable tab width).
     */

    if (fontPtr->tabWidth == 0) {
      fontPtr->tabWidth = 1;
    }

    /*
     * Get information used for drawing underlines in generic code on a
     * non-underlined font.
     */
    
    descent = fontPtr->fm.descent;
    fontPtr->underlinePos = descent / 2;
    fontPtr->underlineHeight = TkFontGetPixels(tkwin, fontPtr->fa.size) / 10;
    if (fontPtr->underlineHeight == 0) {
      fontPtr->underlineHeight = 1;
    }
    if (fontPtr->underlinePos + fontPtr->underlineHeight > descent) {
      /*
       * If this set of values would cause the bottom of the underline
       * bar to stick below the descent of the font, jack the underline
       * up a bit higher.
       */

      fontPtr->underlineHeight = descent - fontPtr->underlinePos;
      if (fontPtr->underlineHeight == 0) {
          fontPtr->underlinePos--;
          fontPtr->underlineHeight = 1;
      }
    }
    
    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
    return (Tk_Font) fontPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetFontFromObj --
 *
 *    Find the font that corresponds to a given object.  The font must
 *    have already been created by Tk_GetFont or Tk_AllocFontFromObj.
 *
 * Results:
 *    The return value is a token for the font that matches objPtr
 *    and is suitable for use in tkwin.
 *
 * Side effects:
 *    If the object is not already a font ref, the conversion will free
 *    any old internal representation. 
 *
 *----------------------------------------------------------------------
 */

Tk_Font
Tk_GetFontFromObj(tkwin, objPtr)
    Tk_Window tkwin;          /* The window that the font will be used in. */
    Tcl_Obj *objPtr;          /* The object from which to get the font. */
{
    TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
    TkFont *fontPtr;
    Tcl_HashEntry *hashPtr;
 
    if (objPtr->typePtr != &tkFontObjType) {
      SetFontFromAny((Tcl_Interp *) NULL, objPtr);
    }

    fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;

    if (fontPtr != NULL) {
      if (fontPtr->resourceRefCount == 0) {
          /*
           * This is a stale reference: it refers to a TkFont that's
           * no longer in use.  Clear the reference.
           */

          FreeFontObjProc(objPtr);
          fontPtr = NULL;
      } else if (Tk_Screen(tkwin) == fontPtr->screen) {
          return (Tk_Font) fontPtr;
      }
    }

    /*
     * Next, search the list of fonts that have the name we want, to see
     * if one of them is for the right screen.
     */

    if (fontPtr != NULL) {
      hashPtr = fontPtr->cacheHashPtr;
      FreeFontObjProc(objPtr);
    } else {
      hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr));
    }
    if (hashPtr != NULL) {
      for (fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); fontPtr != NULL;
            fontPtr = fontPtr->nextPtr) {
          if (Tk_Screen(tkwin) == fontPtr->screen) {
            fontPtr->objRefCount++;
            objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
            return (Tk_Font) fontPtr;
          }
      }
    }

    panic("Tk_GetFontFromObj called with non-existent font!");
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * SetFontFromAny --
 *
 *    Convert the internal representation of a Tcl object to the
 *    font internal form.
 *
 * Results:
 *    Always returns TCL_OK.
 *
 * Side effects:
 *    The object is left with its typePtr pointing to tkFontObjType.
 *    The TkFont pointer is NULL.
 *
 *----------------------------------------------------------------------
 */

static int
SetFontFromAny(interp, objPtr)
    Tcl_Interp *interp;       /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;          /* The object to convert. */
{
    Tcl_ObjType *typePtr;

    /*
     * Free the old internalRep before setting the new one. 
     */

    Tcl_GetString(objPtr);
    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
      (*typePtr->freeIntRepProc)(objPtr);
    }
    objPtr->typePtr = &tkFontObjType;
    objPtr->internalRep.twoPtrValue.ptr1 = NULL;

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_NameOfFont --
 *
 *    Given a font, return a textual string identifying it.
 *
 * Results:
 *    The return value is the description that was passed to
 *    Tk_GetFont() to create the font.  The storage for the returned
 *    string is only guaranteed to persist until the font is deleted.
 *    The caller should not modify this string.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

CONST char *
Tk_NameOfFont(tkfont)
    Tk_Font tkfont;           /* Font whose name is desired. */
{
    TkFont *fontPtr;

    fontPtr = (TkFont *) tkfont;
    return fontPtr->cacheHashPtr->key.string;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FreeFont -- 
 *
 *    Called to release a font allocated by Tk_GetFont().
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The reference count associated with font is decremented, and
 *    only deallocated when no one is using it.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_FreeFont(tkfont)
    Tk_Font tkfont;           /* Font to be released. */
{
    TkFont *fontPtr, *prevPtr;
    NamedFont *nfPtr;

    if (tkfont == NULL) {
      return;
    }
    fontPtr = (TkFont *) tkfont;
    fontPtr->resourceRefCount--;
    if (fontPtr->resourceRefCount > 0) {
      return;
    }
    if (fontPtr->namedHashPtr != NULL) {
      /*
       * This font derived from a named font.  Reduce the reference
       * count on the named font and free it if no-one else is
       * using it.
       */

      nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr);
      nfPtr->refCount--;
      if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) {
          Tcl_DeleteHashEntry(fontPtr->namedHashPtr);
          ckfree((char *) nfPtr);
      }
    }

    prevPtr = (TkFont *) Tcl_GetHashValue(fontPtr->cacheHashPtr);
    if (prevPtr == fontPtr) {
      if (fontPtr->nextPtr == NULL) {
          Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);
      } else  {
          Tcl_SetHashValue(fontPtr->cacheHashPtr, fontPtr->nextPtr);
      }
    } else {
      while (prevPtr->nextPtr != fontPtr) {
          prevPtr = prevPtr->nextPtr;
      }
      prevPtr->nextPtr = fontPtr->nextPtr;
    }

    TkpDeleteFont(fontPtr);
    if (fontPtr->objRefCount == 0) {
      ckfree((char *) fontPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FreeFontFromObj -- 
 *
 *    Called to release a font inside a Tcl_Obj *. Decrements the refCount
 *    of the font and removes it from the hash tables if necessary.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The reference count associated with font is decremented, and
 *    only deallocated when no one is using it.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_FreeFontFromObj(tkwin, objPtr)
    Tk_Window tkwin;          /* The window this font lives in. Needed
                         * for the screen value. */
    Tcl_Obj *objPtr;          /* The Tcl_Obj * to be freed. */
{
    Tk_FreeFont(Tk_GetFontFromObj(tkwin, objPtr));
}

/*
 *---------------------------------------------------------------------------
 *
 * FreeFontObjProc -- 
 *
 *    This proc is called to release an object reference to a font.
 *    Called when the object's internal rep is released or when
 *    the cached fontPtr needs to be changed.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The object reference count is decremented. When both it
 *    and the hash ref count go to zero, the font's resources
 *    are released.
 *
 *---------------------------------------------------------------------------
 */

static void
FreeFontObjProc(objPtr)
    Tcl_Obj *objPtr;          /* The object we are releasing. */
{
    TkFont *fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;

    if (fontPtr != NULL) {
      fontPtr->objRefCount--;
      if ((fontPtr->resourceRefCount == 0) && (fontPtr->objRefCount == 0)) {
          ckfree((char *) fontPtr);
          objPtr->internalRep.twoPtrValue.ptr1 = NULL;
      }
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * DupFontObjProc -- 
 *
 *    When a cached font object is duplicated, this is called to
 *    update the internal reps.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The font's objRefCount is incremented and the internal rep
 *    of the copy is set to point to it.
 *
 *---------------------------------------------------------------------------
 */

static void
DupFontObjProc(srcObjPtr, dupObjPtr)
    Tcl_Obj *srcObjPtr;       /* The object we are copying from. */
    Tcl_Obj *dupObjPtr;       /* The object we are copying to. */
{
    TkFont *fontPtr = (TkFont *) srcObjPtr->internalRep.twoPtrValue.ptr1;
    
    dupObjPtr->typePtr = srcObjPtr->typePtr;
    dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;

    if (fontPtr != NULL) {
      fontPtr->objRefCount++;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FontId --
 *
 *    Given a font, return an opaque handle that should be selected
 *    into the XGCValues structure in order to get the constructed
 *    gc to use this font.  This procedure would go away if the
 *    XGCValues structure were replaced with a TkGCValues structure.
 *
 * Results:
 *    As above.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

Font
Tk_FontId(tkfont)
    Tk_Font tkfont;     /* Font that is going to be selected into GC. */
{
    TkFont *fontPtr;

    fontPtr = (TkFont *) tkfont;
    return fontPtr->fid;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_GetFontMetrics --
 *
 *    Returns overall ascent and descent metrics for the given font.
 *    These values can be used to space multiple lines of text and
 *    to align the baselines of text in different fonts.
 *
 * Results:
 *    If *heightPtr is non-NULL, it is filled with the overall height
 *    of the font, which is the sum of the ascent and descent.
 *    If *ascentPtr or *descentPtr is non-NULL, they are filled with
 *    the ascent and/or descent information for the font.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */
void
Tk_GetFontMetrics(tkfont, fmPtr)
    Tk_Font tkfont;           /* Font in which metrics are calculated. */
    Tk_FontMetrics *fmPtr;    /* Pointer to structure in which font
                         * metrics for tkfont will be stored. */
{
    TkFont *fontPtr;

    fontPtr = (TkFont *) tkfont;
    fmPtr->ascent = fontPtr->fm.ascent;
    fmPtr->descent = fontPtr->fm.descent;
    fmPtr->linespace = fontPtr->fm.ascent + fontPtr->fm.descent;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_PostscriptFontName --
 *
 *    Given a Tk_Font, return the name of the corresponding Postscript
 *    font.
 *
 * Results:
 *    The return value is the pointsize of the given Tk_Font.
 *    The name of the Postscript font is appended to dsPtr.
 *
 * Side effects:
 *    If the font does not exist on the printer, the print job will
 *    fail at print time.  Given a "reasonable" Postscript printer,
 *    the following Tk_Font font families should print correctly:
 *
 *        Avant Garde, Arial, Bookman, Courier, Courier New, Geneva,
 *        Helvetica, Monaco, New Century Schoolbook, New York,
 *        Palatino, Symbol, Times, Times New Roman, Zapf Chancery,
 *        and Zapf Dingbats.
 *
 *    Any other Tk_Font font families may not print correctly
 *    because the computed Postscript font name may be incorrect.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_PostscriptFontName(tkfont, dsPtr)
    Tk_Font tkfont;           /* Font in which text will be printed. */
    Tcl_DString *dsPtr;       /* Pointer to an initialized Tcl_DString to
                         * which the name of the Postscript font that
                         * corresponds to tkfont will be appended. */
{
    TkFont *fontPtr;
    Tk_Uid family, weightString, slantString;
    char *src, *dest;
    int upper, len;

    len = Tcl_DStringLength(dsPtr);
    fontPtr = (TkFont *) tkfont;

    /*
     * Convert the case-insensitive Tk_Font family name to the
     * case-sensitive Postscript family name.  Take out any spaces and
     * capitalize the first letter of each word.
     */

    family = fontPtr->fa.family;
    if (strncasecmp(family, "itc ", 4) == 0) {
      family = family + 4;
    }
    if ((strcasecmp(family, "Arial") == 0)
          || (strcasecmp(family, "Geneva") == 0)) {
      family = "Helvetica";
    } else if ((strcasecmp(family, "Times New Roman") == 0)
          || (strcasecmp(family, "New York") == 0)) {
      family = "Times";
    } else if ((strcasecmp(family, "Courier New") == 0)
          || (strcasecmp(family, "Monaco") == 0)) {
      family = "Courier";
    } else if (strcasecmp(family, "AvantGarde") == 0) {
      family = "AvantGarde";
    } else if (strcasecmp(family, "ZapfChancery") == 0) {
      family = "ZapfChancery";
    } else if (strcasecmp(family, "ZapfDingbats") == 0) {
      family = "ZapfDingbats";
    } else {
      Tcl_UniChar ch;

      /*
       * Inline, capitalize the first letter of each word, lowercase the
       * rest of the letters in each word, and then take out the spaces
       * between the words.  This may make the DString shorter, which is
       * safe to do.
       */

      Tcl_DStringAppend(dsPtr, family, -1);

      src = dest = Tcl_DStringValue(dsPtr) + len;
      upper = 1;
      for (; *src != '\0'; ) {
          while (isspace(UCHAR(*src))) { /* INTL: ISO space */
            src++;
            upper = 1;
          }
          src += Tcl_UtfToUniChar(src, &ch);
          if (upper) {
            ch = Tcl_UniCharToUpper(ch);
            upper = 0;
          } else {
              ch = Tcl_UniCharToLower(ch);
          }
          dest += Tcl_UniCharToUtf(ch, dest);
      }
      *dest = '\0';
      Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
      family = Tcl_DStringValue(dsPtr) + len;
    }
    if (family != Tcl_DStringValue(dsPtr) + len) {
      Tcl_DStringAppend(dsPtr, family, -1);
      family = Tcl_DStringValue(dsPtr) + len;
    }

    if (strcasecmp(family, "NewCenturySchoolbook") == 0) {
      Tcl_DStringSetLength(dsPtr, len);
      Tcl_DStringAppend(dsPtr, "NewCenturySchlbk", -1);
      family = Tcl_DStringValue(dsPtr) + len;
    }

    /*
     * Get the string to use for the weight.
     */

    weightString = NULL;
    if (fontPtr->fa.weight == TK_FW_NORMAL) {
      if (strcmp(family, "Bookman") == 0) {
          weightString = "Light";
      } else if (strcmp(family, "AvantGarde") == 0) {
          weightString = "Book";
      } else if (strcmp(family, "ZapfChancery") == 0) {
          weightString = "Medium";
      }
    } else {
      if ((strcmp(family, "Bookman") == 0)
            || (strcmp(family, "AvantGarde") == 0)) {
          weightString = "Demi";
      } else {
          weightString = "Bold";
      }
    }

    /*
     * Get the string to use for the slant.
     */

    slantString = NULL;
    if (fontPtr->fa.slant == TK_FS_ROMAN) {
      ;
    } else {
      if ((strcmp(family, "Helvetica") == 0)
            || (strcmp(family, "Courier") == 0)
            || (strcmp(family, "AvantGarde") == 0)) {
          slantString = "Oblique";
      } else {
          slantString = "Italic";
      }
    }

    /*
     * The string "Roman" needs to be added to some fonts that are not bold
     * and not italic.
     */

    if ((slantString == NULL) && (weightString == NULL)) {
      if ((strcmp(family, "Times") == 0) 
            || (strcmp(family, "NewCenturySchlbk") == 0)
            || (strcmp(family, "Palatino") == 0)) {
          Tcl_DStringAppend(dsPtr, "-Roman", -1);
      }
    } else {
      Tcl_DStringAppend(dsPtr, "-", -1);
      if (weightString != NULL) {
          Tcl_DStringAppend(dsPtr, weightString, -1);
      }
      if (slantString != NULL) {
          Tcl_DStringAppend(dsPtr, slantString, -1);
      }
    }

    return fontPtr->fa.size;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_TextWidth --
 *
 *    A wrapper function for the more complicated interface of
 *    Tk_MeasureChars.  Computes how much space the given
 *    simple string needs.
 *
 * Results:
 *    The return value is the width (in pixels) of the given string.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_TextWidth(tkfont, string, numBytes)
    Tk_Font tkfont;           /* Font in which text will be measured. */
    CONST char *string;       /* String whose width will be computed. */
    int numBytes;       /* Number of bytes to consider from
                         * string, or < 0 for strlen(). */
{
    int width;

    if (numBytes < 0) {
      numBytes = strlen(string);
    }
    Tk_MeasureChars(tkfont, string, numBytes, -1, 0, &width);
    return width;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_UnderlineChars --
 *
 *    This procedure draws an underline for a given range of characters
 *    in a given string.  It doesn't draw the characters (which are
 *    assumed to have been displayed previously); it just draws the
 *    underline.  This procedure would mainly be used to quickly
 *    underline a few characters without having to construct an
 *    underlined font.  To produce properly underlined text, the
 *    appropriate underlined font should be constructed and used. 
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Information gets displayed in "drawable".
 *
 *----------------------------------------------------------------------
 */

void
Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstByte,
      lastByte)
    Display *display;         /* Display on which to draw. */
    Drawable drawable;        /* Window or pixmap in which to draw. */
    GC gc;              /* Graphics context for actually drawing
                         * line. */
    Tk_Font tkfont;           /* Font used in GC;  must have been allocated
                         * by Tk_GetFont().  Used for character
                         * dimensions, etc. */
    CONST char *string;       /* String containing characters to be
                         * underlined or overstruck. */
    int x, y;                 /* Coordinates at which first character of
                         * string is drawn. */
    int firstByte;            /* Index of first byte of first character. */
    int lastByte;       /* Index of first byte after the last
                         * character. */
{
    TkFont *fontPtr;
    int startX, endX;

    fontPtr = (TkFont *) tkfont;
    
    Tk_MeasureChars(tkfont, string, firstByte, -1, 0, &startX);
    Tk_MeasureChars(tkfont, string, lastByte, -1, 0, &endX);

    XFillRectangle(display, drawable, gc, x + startX,
          y + fontPtr->underlinePos, (unsigned int) (endX - startX),
          (unsigned int) fontPtr->underlineHeight);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_ComputeTextLayout --
 *
 *    Computes the amount of screen space needed to display a
 *    multi-line, justified string of text.  Records all the
 *    measurements that were done to determine to size and
 *    positioning of the individual lines of text; this information
 *    can be used by the Tk_DrawTextLayout() procedure to
 *    display the text quickly (without remeasuring it).
 *
 *    This procedure is useful for simple widgets that want to
 *    display single-font, multi-line text and want Tk to handle the
 *    details.
 *
 * Results:
 *    The return value is a Tk_TextLayout token that holds the
 *    measurement information for the given string.  The token is
 *    only valid for the given string.  If the string is freed,
 *    the token is no longer valid and must also be freed.  To free
 *    the token, call Tk_FreeTextLayout().
 *
 *    The dimensions of the screen area needed to display the text
 *    are stored in *widthPtr and *heightPtr.
 *
 * Side effects:
 *    Memory is allocated to hold the measurement information.  
 *
 *---------------------------------------------------------------------------
 */

Tk_TextLayout
Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
      widthPtr, heightPtr)
    Tk_Font tkfont;           /* Font that will be used to display text. */
    CONST char *string;       /* String whose dimensions are to be
                         * computed. */
    int numChars;       /* Number of characters to consider from
                         * string, or < 0 for strlen(). */
    int wrapLength;           /* Longest permissible line length, in
                         * pixels.  <= 0 means no automatic wrapping:
                         * just let lines get as long as needed. */
    Tk_Justify justify;       /* How to justify lines. */
    int flags;                /* Flag bits OR-ed together.
                         * TK_IGNORE_TABS means that tab characters
                         * should not be expanded.  TK_IGNORE_NEWLINES
                         * means that newline characters should not
                         * cause a line break. */
    int *widthPtr;            /* Filled with width of string. */
    int *heightPtr;           /* Filled with height of string. */
{
    TkFont *fontPtr;
    CONST char *start, *end, *special;
    int n, y, bytesThisChunk, maxChunks;
    int baseline, height, curX, newX, maxWidth;
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;
    CONST TkFontMetrics *fmPtr;
    Tcl_DString lineBuffer;
    int *lineLengths;
    int curLine, layoutHeight;

    Tcl_DStringInit(&lineBuffer);
    
    fontPtr = (TkFont *) tkfont;
    if ((fontPtr == NULL) || (string == NULL)) {
      if (widthPtr != NULL) {
          *widthPtr = 0;
      }
      if (heightPtr != NULL) {
          *heightPtr = 0;
      }
      return NULL;
    }

    fmPtr = &fontPtr->fm;

    height = fmPtr->ascent + fmPtr->descent;

    if (numChars < 0) {
      numChars = Tcl_NumUtfChars(string, -1);
    }
    if (wrapLength == 0) {
      wrapLength = -1;
    }

    maxChunks = 1;

    layoutPtr = (TextLayout *) ckalloc(sizeof(TextLayout)
          + (maxChunks - 1) * sizeof(LayoutChunk));
    layoutPtr->tkfont       = tkfont;
    layoutPtr->string       = string;
    layoutPtr->numChunks    = 0;

    baseline = fmPtr->ascent;
    maxWidth = 0;

    /*
     * Divide the string up into simple strings and measure each string.
     */

    curX = 0;

    end = Tcl_UtfAtIndex(string, numChars);
    special = string;

    flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
    flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;      
    for (start = string; start < end; ) {
      if (start >= special) {
          /*
           * Find the next special character in the string.
           *
           * INTL: Note that it is safe to increment by byte, because we are
           * looking for 7-bit characters that will appear unchanged in
           * UTF-8.  At some point we may need to support the full Unicode
           * whitespace set.
           */

          for (special = start; special < end; special++) {
            if (!(flags & TK_IGNORE_NEWLINES)) {
                if ((*special == '\n') || (*special == '\r')) {
                  break;
                }
            }
            if (!(flags & TK_IGNORE_TABS)) {
                if (*special == '\t') {
                  break;
                }
            }
          }
      }

      /*
       * Special points at the next special character (or the end of the
       * string).  Process characters between start and special.
       */

      chunkPtr = NULL;
      if (start < special) {
          bytesThisChunk = Tk_MeasureChars(tkfont, start, special - start,
                wrapLength - curX, flags, &newX);
          newX += curX;
          flags &= ~TK_AT_LEAST_ONE;
          if (bytesThisChunk > 0) {
            chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
                  bytesThisChunk, curX, newX, baseline);
                  
            start += bytesThisChunk;
            curX = newX;
          }
      }

      if ((start == special) && (special < end)) {
          /*
           * Handle the special character.
           *
           * INTL: Special will be pointing at a 7-bit character so we
           * can safely treat it as a single byte.
           */

          chunkPtr = NULL;
          if (*special == '\t') {
            newX = curX + fontPtr->tabWidth;
            newX -= newX % fontPtr->tabWidth;
            NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX,
                  baseline)->numDisplayChars = -1;
            start++;
            if ((start < end) &&
                  ((wrapLength <= 0) || (newX <= wrapLength))) {
                /*
                 * More chars can still fit on this line.
                 */

                curX = newX;
                flags &= ~TK_AT_LEAST_ONE;
                continue;
            }
          } else {      
            NewChunk(&layoutPtr, &maxChunks, start, 1, curX, curX,
                  baseline)->numDisplayChars = -1;
            start++;
            goto wrapLine;
          }
      }

      /*
       * No more characters are going to go on this line, either because
       * no more characters can fit or there are no more characters left.
       * Consume all extra spaces at end of line.  
       */

      while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */
          if (!(flags & TK_IGNORE_NEWLINES)) {
            if ((*start == '\n') || (*start == '\r')) {
                break;
            }
          }
          if (!(flags & TK_IGNORE_TABS)) {
            if (*start == '\t') {
                break;
            }
          }
          start++;
      }
      if (chunkPtr != NULL) {
          CONST char *end;

          /*
           * Append all the extra spaces on this line to the end of the
           * last text chunk.  This is a little tricky because we are
           * switching back and forth between characters and bytes.
           */

          end = chunkPtr->start + chunkPtr->numBytes;
          bytesThisChunk = start - end;
          if (bytesThisChunk > 0) {
            bytesThisChunk = Tk_MeasureChars(tkfont, end, bytesThisChunk,
                  -1, 0, &chunkPtr->totalWidth);
            chunkPtr->numBytes += bytesThisChunk;
            chunkPtr->numChars += Tcl_NumUtfChars(end, bytesThisChunk);
            chunkPtr->totalWidth += curX;
          }
      }

        wrapLine: 
      flags |= TK_AT_LEAST_ONE;

      /*
       * Save current line length, then move current position to start of
       * next line.
       */

      if (curX > maxWidth) {
          maxWidth = curX;
      }

      /*
       * Remember width of this line, so that all chunks on this line
       * can be centered or right justified, if necessary.
       */

      Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));

      curX = 0;
      baseline += height;
    }

    /*
     * If last line ends with a newline, then we need to make a 0 width
     * chunk on the next line.  Otherwise "Hello" and "Hello\n" are the
     * same height.
     */

    if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) {
      if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
          chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
                curX, baseline);
          chunkPtr->numDisplayChars = -1;
          Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
          baseline += height;
      }
    }     

    layoutPtr->width = maxWidth;
    layoutHeight = baseline - fmPtr->ascent;
    if (layoutPtr->numChunks == 0) {
      layoutHeight = height;

      /*
       * This fake chunk is used by the other procedures so that they can
       * pretend that there is a chunk with no chars in it, which makes
       * the coding simpler.
       */

      layoutPtr->numChunks = 1;
      layoutPtr->chunks[0].start          = string;
      layoutPtr->chunks[0].numBytes       = 0;
      layoutPtr->chunks[0].numChars       = 0;
      layoutPtr->chunks[0].numDisplayChars      = -1;
      layoutPtr->chunks[0].x              = 0;
      layoutPtr->chunks[0].y              = fmPtr->ascent;
      layoutPtr->chunks[0].totalWidth           = 0;
      layoutPtr->chunks[0].displayWidth   = 0;
    } else {
      /*
       * Using maximum line length, shift all the chunks so that the lines
       * are all justified correctly.
       */
    
      curLine = 0;
      chunkPtr = layoutPtr->chunks;
      y = chunkPtr->y;
      lineLengths = (int *) Tcl_DStringValue(&lineBuffer);
      for (n = 0; n < layoutPtr->numChunks; n++) {
          int extra;

          if (chunkPtr->y != y) {
            curLine++;
            y = chunkPtr->y;
          }
          extra = maxWidth - lineLengths[curLine];
          if (justify == TK_JUSTIFY_CENTER) {
            chunkPtr->x += extra / 2;
          } else if (justify == TK_JUSTIFY_RIGHT) {
            chunkPtr->x += extra;
          }
          chunkPtr++;
      }
    }

    if (widthPtr != NULL) {
      *widthPtr = layoutPtr->width;
    }
    if (heightPtr != NULL) {
      *heightPtr = layoutHeight;
    }
    Tcl_DStringFree(&lineBuffer);

    return (Tk_TextLayout) layoutPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_FreeTextLayout --
 *
 *    This procedure is called to release the storage associated with
 *    a Tk_TextLayout when it is no longer needed.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Memory is freed.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_FreeTextLayout(textLayout)
    Tk_TextLayout textLayout; /* The text layout to be released. */
{
    TextLayout *layoutPtr;

    layoutPtr = (TextLayout *) textLayout;
    if (layoutPtr != NULL) {
      ckfree((char *) layoutPtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_DrawTextLayout --
 *
 *    Use the information in the Tk_TextLayout token to display a
 *    multi-line, justified string of text.
 *
 *    This procedure is useful for simple widgets that need to
 *    display single-font, multi-line text and want Tk to handle
 *    the details.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Text drawn on the screen.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar)
    Display *display;         /* Display on which to draw. */
    Drawable drawable;        /* Window or pixmap in which to draw. */
    GC gc;              /* Graphics context to use for drawing text. */
    Tk_TextLayout layout;     /* Layout information, from a previous call
                         * to Tk_ComputeTextLayout(). */
    int x, y;                 /* Upper-left hand corner of rectangle in
                         * which to draw (pixels). */
    int firstChar;            /* The index of the first character to draw
                         * from the given text item.  0 specfies the
                         * beginning. */
    int lastChar;       /* The index just after the last character
                         * to draw from the given text item.  A number
                         * < 0 means to draw all characters. */
{
    TextLayout *layoutPtr;
    int i, numDisplayChars, drawX;
    CONST char *firstByte;
    CONST char *lastByte;
    LayoutChunk *chunkPtr;

    layoutPtr = (TextLayout *) layout;
    if (layoutPtr == NULL) {
      return;
    }

    if (lastChar < 0) {
      lastChar = 100000000;
    }
    chunkPtr = layoutPtr->chunks;
    for (i = 0; i < layoutPtr->numChunks; i++) {
      numDisplayChars = chunkPtr->numDisplayChars;
      if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
          if (firstChar <= 0) {
            drawX = 0;
            firstChar = 0;
            firstByte = chunkPtr->start;
          } else {
            firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar);
            Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start,
                  firstByte - chunkPtr->start, -1, 0, &drawX);
          }
          if (lastChar < numDisplayChars) {
            numDisplayChars = lastChar;
          }
          lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars);
          Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont,
                firstByte, lastByte - firstByte,
                x + chunkPtr->x + drawX, y + chunkPtr->y);
      }
      firstChar -= chunkPtr->numChars;
      lastChar -= chunkPtr->numChars;
      if (lastChar <= 0) {
          break;
      }
      chunkPtr++;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_UnderlineTextLayout --
 *
 *    Use the information in the Tk_TextLayout token to display an
 *    underline below an individual character.  This procedure does
 *    not draw the text, just the underline.
 *
 *    This procedure is useful for simple widgets that need to
 *    display single-font, multi-line text with an individual
 *    character underlined and want Tk to handle the details.
 *    To display larger amounts of underlined text, construct
 *    and use an underlined font.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Underline drawn on the screen.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_UnderlineTextLayout(display, drawable, gc, layout, x, y, underline)
    Display *display;         /* Display on which to draw. */
    Drawable drawable;        /* Window or pixmap in which to draw. */
    GC gc;              /* Graphics context to use for drawing text. */
    Tk_TextLayout layout;     /* Layout information, from a previous call
                         * to Tk_ComputeTextLayout(). */
    int x, y;                 /* Upper-left hand corner of rectangle in
                         * which to draw (pixels). */
    int underline;            /* Index of the single character to
                         * underline, or -1 for no underline. */
{
    TextLayout *layoutPtr;
    TkFont *fontPtr;
    int xx, yy, width, height;

    if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0)
          && (width != 0)) {
      layoutPtr = (TextLayout *) layout;
      fontPtr = (TkFont *) layoutPtr->tkfont;

      XFillRectangle(display, drawable, gc, x + xx, 
            y + yy + fontPtr->fm.ascent + fontPtr->underlinePos,
            (unsigned int) width, (unsigned int) fontPtr->underlineHeight);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_PointToChar --
 *
 *    Use the information in the Tk_TextLayout token to determine the
 *    character closest to the given point.  The point must be
 *    specified with respect to the upper-left hand corner of the
 *    text layout, which is considered to be located at (0, 0).
 *
 *    Any point whose y-value is less that 0 will be considered closest
 *    to the first character in the text layout; any point whose y-value
 *    is greater than the height of the text layout will be considered
 *    closest to the last character in the text layout.
 *
 *    Any point whose x-value is less than 0 will be considered closest
 *    to the first character on that line; any point whose x-value is
 *    greater than the width of the text layout will be considered
 *    closest to the last character on that line.
 *
 * Results:
 *    The return value is the index of the character that was
 *    closest to the point.  Given a text layout with no characters,
 *    the value 0 will always be returned, referring to a hypothetical
 *    zero-width placeholder character.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_PointToChar(layout, x, y)
    Tk_TextLayout layout;     /* Layout information, from a previous call
                         * to Tk_ComputeTextLayout(). */
    int x, y;                 /* Coordinates of point to check, with
                         * respect to the upper-left corner of the
                         * text layout. */
{
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr, *lastPtr;
    TkFont *fontPtr;
    int i, n, dummy, baseline, pos, numChars;

    if (y < 0) {
      /*
       * Point lies above any line in this layout.  Return the index of
       * the first char.
       */

      return 0;
    }

    /*
     * Find which line contains the point.
     */

    layoutPtr = (TextLayout *) layout;
    fontPtr = (TkFont *) layoutPtr->tkfont;
    lastPtr = chunkPtr = layoutPtr->chunks;
    numChars = 0;
    for (i = 0; i < layoutPtr->numChunks; i++) {
      baseline = chunkPtr->y;
      if (y < baseline + fontPtr->fm.descent) {
          if (x < chunkPtr->x) {
            /*
             * Point is to the left of all chunks on this line.  Return
             * the index of the first character on this line.
             */

            return numChars;
          }
          if (x >= layoutPtr->width) {
            /*
             * If point lies off right side of the text layout, return
             * the last char in the last chunk on this line.  Without
             * this, it might return the index of the first char that
             * was located outside of the text layout.
             */

            x = INT_MAX;
          }

          /*
           * Examine all chunks on this line to see which one contains
           * the specified point.
           */

          lastPtr = chunkPtr;
          while ((i < layoutPtr->numChunks) && (chunkPtr->y == baseline))  {
            if (x < chunkPtr->x + chunkPtr->totalWidth) {
                /*
                 * Point falls on one of the characters in this chunk.
                 */

                if (chunkPtr->numDisplayChars < 0) {
                  /*
                   * This is a special chunk that encapsulates a single
                   * tab or newline char.
                   */

                  return numChars;
                }
                n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
                      chunkPtr->numBytes, x - chunkPtr->x,
                      0, &dummy);
                return numChars + Tcl_NumUtfChars(chunkPtr->start, n);
            }
            numChars += chunkPtr->numChars;
            lastPtr = chunkPtr;
            chunkPtr++;
            i++;
          }

          /*
           * Point is to the right of all chars in all the chunks on this
           * line.  Return the index just past the last char in the last
           * chunk on this line.
           */

          pos = numChars;
          if (i < layoutPtr->numChunks) {
            pos--;
          }
          return pos;
      }
      numChars += chunkPtr->numChars;
      lastPtr = chunkPtr;
      chunkPtr++;
    }

    /*
     * Point lies below any line in this text layout.  Return the index
     * just past the last char.
     */

    return (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_CharBbox --
 *
 *    Use the information in the Tk_TextLayout token to return the
 *    bounding box for the character specified by index.  
 *
 *    The width of the bounding box is the advance width of the
 *    character, and does not include and left- or right-bearing.
 *    Any character that extends partially outside of the
 *    text layout is considered to be truncated at the edge.  Any
 *    character which is located completely outside of the text
 *    layout is considered to be zero-width and pegged against
 *    the edge.
 *
 *    The height of the bounding box is the line height for this font,
 *    extending from the top of the ascent to the bottom of the
 *    descent.  Information about the actual height of the individual
 *    letter is not available.
 *
 *    A text layout that contains no characters is considered to
 *    contain a single zero-width placeholder character.
 * 
 * Results:
 *    The return value is 0 if the index did not specify a character
 *    in the text layout, or non-zero otherwise.  In that case,
 *    *bbox is filled with the bounding box of the character.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr)
    Tk_TextLayout layout;   /* Layout information, from a previous call to
                       * Tk_ComputeTextLayout(). */
    int index;              /* The index of the character whose bbox is
                       * desired. */
    int *xPtr, *yPtr;       /* Filled with the upper-left hand corner, in
                       * pixels, of the bounding box for the character
                       * specified by index, if non-NULL. */
    int *widthPtr, *heightPtr;
                      /* Filled with the width and height of the
                       * bounding box for the character specified by
                       * index, if non-NULL. */
{
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;
    int i, x, w;
    Tk_Font tkfont;
    TkFont *fontPtr;
    CONST char *end;

    if (index < 0) {
      return 0;
    }

    layoutPtr = (TextLayout *) layout;
    chunkPtr = layoutPtr->chunks;
    tkfont = layoutPtr->tkfont;
    fontPtr = (TkFont *) tkfont;

    for (i = 0; i < layoutPtr->numChunks; i++) {
      if (chunkPtr->numDisplayChars < 0) {
          if (index == 0) {
            x = chunkPtr->x;
            w = chunkPtr->totalWidth;
            goto check;
          }
      } else if (index < chunkPtr->numChars) {
          end = Tcl_UtfAtIndex(chunkPtr->start, index);
          if (xPtr != NULL) {
            Tk_MeasureChars(tkfont, chunkPtr->start,
                  end -  chunkPtr->start, -1, 0, &x);
            x += chunkPtr->x;
          }
          if (widthPtr != NULL) {
            Tk_MeasureChars(tkfont, end, Tcl_UtfNext(end) - end,
                  -1, 0, &w);
          }
          goto check;
      }
      index -= chunkPtr->numChars;
      chunkPtr++;
    }
    if (index == 0) {
      /*
       * Special case to get location just past last char in layout.
       */

      chunkPtr--;
      x = chunkPtr->x + chunkPtr->totalWidth;
      w = 0;
    } else {
      return 0;
    }

    /*
     * Ensure that the bbox lies within the text layout.  This forces all
     * chars that extend off the right edge of the text layout to have
     * truncated widths, and all chars that are completely off the right
     * edge of the text layout to peg to the edge and have 0 width.
     */
    check:
    if (yPtr != NULL) {
      *yPtr = chunkPtr->y - fontPtr->fm.ascent;
    }
    if (heightPtr != NULL) {
      *heightPtr = fontPtr->fm.ascent + fontPtr->fm.descent;
    }

    if (x > layoutPtr->width) {
      x = layoutPtr->width;
    }
    if (xPtr != NULL) {
      *xPtr = x;
    }
    if (widthPtr != NULL) {
      if (x + w > layoutPtr->width) {
          w = layoutPtr->width - x;
      }
      *widthPtr = w;
    }

    return 1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_DistanceToTextLayout --
 *
 *    Computes the distance in pixels from the given point to the
 *    given text layout.  Non-displaying space characters that occur
 *    at the end of individual lines in the text layout are ignored
 *    for hit detection purposes.
 *
 * Results:
 *    The return value is 0 if the point (x, y) is inside the text
 *    layout.  If the point isn't inside the text layout then the
 *    return value is the distance in pixels from the point to the
 *    text item.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_DistanceToTextLayout(layout, x, y)
    Tk_TextLayout layout;     /* Layout information, from a previous call
                         * to Tk_ComputeTextLayout(). */
    int x, y;                 /* Coordinates of point to check, with
                         * respect to the upper-left corner of the
                         * text layout (in pixels). */
{
    int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent;
    LayoutChunk *chunkPtr;
    TextLayout *layoutPtr;
    TkFont *fontPtr;

    layoutPtr = (TextLayout *) layout;
    fontPtr = (TkFont *) layoutPtr->tkfont;
    ascent = fontPtr->fm.ascent;
    descent = fontPtr->fm.descent;
    
    minDist = 0;
    chunkPtr = layoutPtr->chunks;
    for (i = 0; i < layoutPtr->numChunks; i++) {
      if (chunkPtr->start[0] == '\n') {
          /*
           * Newline characters are not counted when computing distance
           * (but tab characters would still be considered).
           */

          chunkPtr++;
          continue;
      }

      x1 = chunkPtr->x;
      y1 = chunkPtr->y - ascent;
      x2 = chunkPtr->x + chunkPtr->displayWidth;
      y2 = chunkPtr->y + descent;

      if (x < x1) {
          xDiff = x1 - x;
      } else if (x >= x2) {
          xDiff = x - x2 + 1;
      } else {
          xDiff = 0;
      }

      if (y < y1) {
          yDiff = y1 - y;
      } else if (y >= y2) {
          yDiff = y - y2 + 1;
      } else {
          yDiff = 0;
      }
      if ((xDiff == 0) && (yDiff == 0)) {
          return 0;
      }
      dist = (int) hypot((double) xDiff, (double) yDiff);
      if ((dist < minDist) || (minDist == 0)) {
          minDist = dist;
      }
      chunkPtr++;
    }
    return minDist;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_IntersectTextLayout --
 *
 *    Determines whether a text layout lies entirely inside,
 *    entirely outside, or overlaps a given rectangle.  Non-displaying
 *    space characters that occur at the end of individual lines in
 *    the text layout are ignored for intersection calculations.
 *
 * Results:
 *    The return value is -1 if the text layout is entirely outside of
 *    the rectangle, 0 if it overlaps, and 1 if it is entirely inside
 *    of the rectangle.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

int
Tk_IntersectTextLayout(layout, x, y, width, height)
    Tk_TextLayout layout;     /* Layout information, from a previous call
                         * to Tk_ComputeTextLayout(). */
    int x, y;                 /* Upper-left hand corner, in pixels, of
                         * rectangular area to compare with text
                         * layout.  Coordinates are with respect to
                         * the upper-left hand corner of the text
                         * layout itself. */
    int width, height;        /* The width and height of the above
                         * rectangular area, in pixels. */
{
    int result, i, x1, y1, x2, y2;
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;
    TkFont *fontPtr;
    int left, top, right, bottom;

    /*
     * Scan the chunks one at a time, seeing whether each is entirely in,
     * entirely out, or overlapping the rectangle.  If an overlap is
     * detected, return immediately; otherwise wait until all chunks have
     * been processed and see if they were all inside or all outside.
     */
    
    layoutPtr = (TextLayout *) layout;
    chunkPtr = layoutPtr->chunks;
    fontPtr = (TkFont *) layoutPtr->tkfont;

    left    = x;
    top         = y;
    right   = x + width;
    bottom  = y + height;

    result = 0;
    for (i = 0; i < layoutPtr->numChunks; i++) {
      if (chunkPtr->start[0] == '\n') {
          /*
           * Newline characters are not counted when computing area
           * intersection (but tab characters would still be considered).
           */

          chunkPtr++;
          continue;
      }

      x1 = chunkPtr->x;
      y1 = chunkPtr->y - fontPtr->fm.ascent;
      x2 = chunkPtr->x + chunkPtr->displayWidth;
      y2 = chunkPtr->y + fontPtr->fm.descent;

      if ((right < x1) || (left >= x2)
            || (bottom < y1) || (top >= y2)) {
          if (result == 1) {
            return 0;
          }
          result = -1;
      } else if ((x1 < left) || (x2 >= right)
            || (y1 < top) || (y2 >= bottom)) {
          return 0;
      } else if (result == -1) {
          return 0;
      } else {
          result = 1;
      }
      chunkPtr++;
    }
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_TextLayoutToPostscript --
 *
 *    Outputs the contents of a text layout in Postscript format.
 *    The set of lines in the text layout will be rendered by the user
 *    supplied Postscript function.  The function should be of the form:
 *
 *        justify x y string  function  --
 *
 *    Justify is -1, 0, or 1, depending on whether the following string
 *    should be left, center, or right justified, x and y is the
 *    location for the origin of the string, string is the sequence
 *    of characters to be printed, and function is the name of the
 *    caller-provided function; the function should leave nothing
 *    on the stack.
 *
 *    The meaning of the origin of the string (x and y) depends on
 *    the justification.  For left justification, x is where the
 *    left edge of the string should appear.  For center justification,
 *    x is where the center of the string should appear.  And for right
 *    justification, x is where the right edge of the string should
 *    appear.  This behavior is necessary because, for example, right
 *    justified text on the screen is justified with screen metrics.
 *    The same string needs to be justified with printer metrics on
 *    the printer to appear in the correct place with respect to other
 *    similarly justified strings.  In all circumstances, y is the
 *    location of the baseline for the string.
 *
 * Results:
 *    The interp's result is modified to hold the Postscript code that
 *    will render the text layout.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

void
Tk_TextLayoutToPostscript(interp, layout)
    Tcl_Interp *interp;       /* Filled with Postscript code. */
    Tk_TextLayout layout;     /* The layout to be rendered. */
{
#define MAXUSE 128
    char buf[MAXUSE+30];
    LayoutChunk *chunkPtr;
    int i, j, used, c, baseline;
    Tcl_UniChar ch;
    CONST char *p, *last_p,*glyphname;
    TextLayout *layoutPtr;
    char uindex[5]="\0\0\0\0";
    char one_char[5];
    int charsize;
    int bytecount=0;

    layoutPtr = (TextLayout *) layout;
    chunkPtr = layoutPtr->chunks;
    baseline = chunkPtr->y;
    used = 0;
    buf[used++] = '[';
    buf[used++] = '(';
    for (i = 0; i < layoutPtr->numChunks; i++) {
      if (baseline != chunkPtr->y) {
          buf[used++] = ')';
          buf[used++] = ']';
          buf[used++] = '\n';
          buf[used++] = '[';
          buf[used++] = '(';
          baseline = chunkPtr->y;
      }
      if (chunkPtr->numDisplayChars <= 0) {
          if (chunkPtr->start[0] == '\t') {
            buf[used++] = '\\';
            buf[used++] = 't';
          }
      } else {
          p = chunkPtr->start;
          for (j = 0; j < chunkPtr->numDisplayChars; j++) {
            /*
             * INTL: For now we just treat the characters as binary
             * data and display the lower byte.  Eventually this should
             * be revised to handle international postscript fonts.
             */
            last_p=p;
            p +=(charsize= Tcl_UtfToUniChar(p,&ch));
            Tcl_UtfToExternal(interp,NULL,last_p,charsize,0,NULL,one_char,4,
                  NULL,&bytecount,NULL); 
                if (bytecount == 1) {
                c = UCHAR(one_char[0]);
                /* c = UCHAR( ch & 0xFF) */;
                if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
                      || (c >= UCHAR(0x7f))) {
                  /*
                   * Tricky point:  the "03" is necessary in the sprintf
                   * below, so that a full three digits of octal are
                   * always generated.  Without the "03", a number
                   * following this sequence could be interpreted by
                   * Postscript as part of this sequence.
                   */

                  sprintf(buf + used, "\\%03o", c);
                  used += 4;
                } else {
                  buf[used++] = c;
                }
            } else {
                /* This character doesn't belong to system character set.
                 * So, we must use full glyph name */
                sprintf(uindex,"%04X",ch); /* endianness? */
                if ((glyphname = Tcl_GetVar2( interp , "::tk::psglyphs",uindex,0))) {
                  if (used > 0 && buf [used-1] == '(') 
                      --used;
                  else
                      buf[used++] = ')';
                  buf[used++] = '/';
                  while( (*glyphname) && (used < (MAXUSE+27))) 
                      buf[used++] = *glyphname++ ;
                  buf[used++] = '(';
                }
                
            }
            if (used >= MAXUSE) {
                buf[used] = '\0';
                Tcl_AppendResult(interp, buf, (char *) NULL);
                used = 0;
            }
          }
      }
      if (used >= MAXUSE) {
          /*
           * If there are a whole bunch of returns or tabs in a row,
           * then buf[] could get filled up.
           */
           
          buf[used] = '\0';
          Tcl_AppendResult(interp, buf, (char *) NULL);
          used = 0;
      }
      chunkPtr++;
    }
    buf[used++] = ')';
    buf[used++] = ']';
    buf[used++] = '\n';
    buf[used] = '\0';
    Tcl_AppendResult(interp, buf, (char *) NULL);
}

/*
 *---------------------------------------------------------------------------
 *
 * ConfigAttributesObj --
 *
 *    Process command line options to fill in fields of a properly
 *    initialized font attributes structure.
 *
 * Results:
 *    A standard Tcl return value.  If TCL_ERROR is returned, an
 *    error message will be left in interp's result object.
 *
 * Side effects:
 *    The fields of the font attributes structure get filled in with
 *    information from argc/argv.  If an error occurs while parsing,
 *    the font attributes structure will contain all modifications
 *    specified in the command line options up to the point of the
 *    error.
 *
 *---------------------------------------------------------------------------
 */

static int
ConfigAttributesObj(interp, tkwin, objc, objv, faPtr)
    Tcl_Interp *interp;       /* Interp for error return. */
    Tk_Window tkwin;          /* For display on which font will be used. */
    int objc;                 /* Number of elements in argv. */
    Tcl_Obj *CONST objv[];    /* Command line options. */
    TkFontAttributes *faPtr;  /* Font attributes structure whose fields
                         * are to be modified.  Structure must already
                         * be properly initialized. */
{
    int i, n, index;
    Tcl_Obj *optionPtr, *valuePtr;
    char *value;
    
    for (i = 0; i < objc; i += 2) {
      optionPtr = objv[i];
      valuePtr = objv[i + 1];

      if (Tcl_GetIndexFromObj(interp, optionPtr, fontOpt, "option", 1,
            &index) != TCL_OK) {
          return TCL_ERROR;
      }
      if ((i+2 >= objc) && (objc & 1)) {
          /*
           * This test occurs after Tcl_GetIndexFromObj() so that
           * "font create xyz -xyz" will return the error message
           * that "-xyz" is a bad option, rather than that the value
           * for "-xyz" is missing.
           */

          Tcl_AppendResult(interp, "value for \"",
                Tcl_GetString(optionPtr), "\" option missing",
                (char *) NULL);
          return TCL_ERROR;
      }

      switch (index) {
          case FONT_FAMILY: {
            value = Tcl_GetString(valuePtr);
            faPtr->family = Tk_GetUid(value);
            break;
          }
          case FONT_SIZE: {
            if (Tcl_GetIntFromObj(interp, valuePtr, &n) != TCL_OK) {
                return TCL_ERROR;
            }
            faPtr->size = n;
            break;
          }
          case FONT_WEIGHT: {
            n = TkFindStateNumObj(interp, optionPtr, weightMap, valuePtr);
            if (n == TK_FW_UNKNOWN) {
                return TCL_ERROR;
            }
            faPtr->weight = n;
            break;
          }
          case FONT_SLANT: {
            n = TkFindStateNumObj(interp, optionPtr, slantMap, valuePtr);
            if (n == TK_FS_UNKNOWN) {
                return TCL_ERROR;
            }
            faPtr->slant = n;
            break;
          }
          case FONT_UNDERLINE: {
            if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
                return TCL_ERROR;
            }
            faPtr->underline = n;
            break;
          }
          case FONT_OVERSTRIKE: {
            if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
                return TCL_ERROR;
            }
            faPtr->overstrike = n;
            break;
          }
      }
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * GetAttributeInfoObj --
 *
 *    Return information about the font attributes as a Tcl list.
 *
 * Results:
 *    The return value is TCL_OK if the objPtr was non-NULL and
 *    specified a valid font attribute, TCL_ERROR otherwise.  If TCL_OK
 *    is returned, the interp's result object is modified to hold a
 *    description of either the current value of a single option, or a
 *    list of all options and their current values for the given font
 *    attributes.  If TCL_ERROR is returned, the interp's result is
 *    set to an error message describing that the objPtr did not refer
 *    to a valid option.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

static int
GetAttributeInfoObj(interp, faPtr, objPtr)
    Tcl_Interp *interp;             /* Interp to hold result. */
    CONST TkFontAttributes *faPtr;  /* The font attributes to inspect. */
    Tcl_Obj *objPtr;                /* If non-NULL, indicates the single
                               * option whose value is to be
                               * returned. Otherwise information is
                               * returned for all options. */
{
    int i, index, start, end;
    CONST char *str;
    Tcl_Obj *optionPtr, *valuePtr, *resultPtr;

    resultPtr = Tcl_GetObjResult(interp);

    start = 0;
    end = FONT_NUMFIELDS;
    if (objPtr != NULL) {
      if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", TCL_EXACT,
            &index) != TCL_OK) {
          return TCL_ERROR;
      }
      start = index;
      end = index + 1;
    }

    valuePtr = NULL;
    for (i = start; i < end; i++) {
      switch (i) {
          case FONT_FAMILY:
            str = faPtr->family;
            valuePtr = Tcl_NewStringObj(str, ((str == NULL) ? 0 : -1));
            break;

          case FONT_SIZE:
            valuePtr = Tcl_NewIntObj(faPtr->size);
            break;

          case FONT_WEIGHT:
            str = TkFindStateString(weightMap, faPtr->weight);
            valuePtr = Tcl_NewStringObj(str, -1);
            break;
      
          case FONT_SLANT:
            str = TkFindStateString(slantMap, faPtr->slant);
            valuePtr = Tcl_NewStringObj(str, -1);
            break;

          case FONT_UNDERLINE:
            valuePtr = Tcl_NewBooleanObj(faPtr->underline);
            break;

          case FONT_OVERSTRIKE:
            valuePtr = Tcl_NewBooleanObj(faPtr->overstrike);
            break;
      }
      if (objPtr != NULL) {
          Tcl_SetObjResult(interp, valuePtr);
          return TCL_OK;
      }
      optionPtr = Tcl_NewStringObj(fontOpt[i], -1);
      Tcl_ListObjAppendElement(NULL, resultPtr, optionPtr);
      Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr);
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * ParseFontNameObj --
 *
 *    Converts a object into a set of font attributes that can be used
 *    to construct a font.
 *
 *    The string rep of the object can be one of the following forms:
 *          XLFD (see X documentation)
 *          "family [size] [style1 [style2 ...]"
 *          "-option value [-option value ...]"
 *
 * Results:
 *    The return value is TCL_ERROR if the object was syntactically
 *    invalid.  In that case an error message is left in interp's
 *    result object.  Otherwise, fills the font attribute buffer with
 *    the values parsed from the string and returns TCL_OK;
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

static int
ParseFontNameObj(interp, tkwin, objPtr, faPtr)
    Tcl_Interp *interp;       /* Interp for error return.  Must not be
                         * NULL. */
    Tk_Window tkwin;          /* For display on which font is used. */
    Tcl_Obj *objPtr;          /* Parseable font description object. */
    TkFontAttributes *faPtr;  /* Filled with attributes parsed from font
                         * name.  Any attributes that were not
                         * specified in font name are filled with
                         * default values. */
{
    char *dash;
    int objc, result, i, n;
    Tcl_Obj **objv;
    char *string;
    
    TkInitFontAttributes(faPtr);

    string = Tcl_GetString(objPtr);
    if (*string == '-') {
      /*
       * This may be an XLFD or an "-option value" string.
       *
       * If the string begins with "-*" or a "-foundry-family-*" pattern,
       * then consider it an XLFD.  
       */

      if (string[1] == '*') {
          goto xlfd;
      }
      dash = strchr(string + 1, '-');
      if ((dash != NULL)
            && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */
          goto xlfd;
      }

      if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
          return TCL_ERROR;
      }

      return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr);
    }
    
    if (*string == '*') {
      /*
       * This is appears to be an XLFD.  Under Unix, all valid XLFDs were
       * already handled by TkpGetNativeFont.  If we are here, either we
       * have something that initially looks like an XLFD but isn't or we
       * have encountered an XLFD on Windows or Mac.
       */

      xlfd:
      result = TkFontParseXLFD(string, faPtr, NULL);
      if (result == TCL_OK) {
          return TCL_OK;
      }
    }

    /*
     * Wasn't an XLFD or "-option value" string.  Try it as a
     * "font size style" list.
     */

    if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK)
          || (objc < 1)) {
      Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist",
            (char *) NULL);
      return TCL_ERROR;
    }

    faPtr->family = Tk_GetUid(Tcl_GetString(objv[0]));
    if (objc > 1) {
      if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
          return TCL_ERROR;
      }
      faPtr->size = n;
    }

    i = 2;
    if (objc == 3) {
      if (Tcl_ListObjGetElements(interp, objv[2], &objc, &objv) != TCL_OK) {
          return TCL_ERROR;
      }
      i = 0;
    }
    for ( ; i < objc; i++) {
      n = TkFindStateNumObj(NULL, NULL, weightMap, objv[i]);
      if (n != TK_FW_UNKNOWN) {
          faPtr->weight = n;
          continue;
      }
      n = TkFindStateNumObj(NULL, NULL, slantMap, objv[i]);
      if (n != TK_FS_UNKNOWN) {
          faPtr->slant = n;
          continue;
      }
      n = TkFindStateNumObj(NULL, NULL, underlineMap, objv[i]);
      if (n != 0) {
          faPtr->underline = n;
          continue;
      }
      n = TkFindStateNumObj(NULL, NULL, overstrikeMap, objv[i]);
      if (n != 0) {
          faPtr->overstrike = n;
          continue;
      }

      /*
       * Unknown style.
       */

      Tcl_AppendResult(interp, "unknown font style \"",
            Tcl_GetString(objv[i]), "\"", (char *) NULL);
      return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * NewChunk --
 *
 *    Helper function for Tk_ComputeTextLayout().  Encapsulates a
 *    measured set of characters in a chunk that can be quickly
 *    drawn.
 *
 * Results:
 *    A pointer to the new chunk in the text layout.
 *
 * Side effects:
 *    The text layout is reallocated to hold more chunks as necessary.
 *
 *    Currently, Tk_ComputeTextLayout() stores contiguous ranges of
 *    "normal" characters in a chunk, along with individual tab
 *    and newline chars in their own chunks.  All characters in the
 *    text layout are accounted for.
 *
 *---------------------------------------------------------------------------
 */
static LayoutChunk *
NewChunk(layoutPtrPtr, maxPtr, start, numBytes, curX, newX, y)
    TextLayout **layoutPtrPtr;
    int *maxPtr;
    CONST char *start;
    int numBytes;
    int curX;
    int newX;
    int y;
{
    TextLayout *layoutPtr;
    LayoutChunk *chunkPtr;
    int maxChunks, numChars;
    size_t s;
    
    layoutPtr = *layoutPtrPtr;
    maxChunks = *maxPtr;
    if (layoutPtr->numChunks == maxChunks) {
      maxChunks *= 2;
      s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk));
      layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s);

      *layoutPtrPtr = layoutPtr;
      *maxPtr = maxChunks;
    }
    numChars = Tcl_NumUtfChars(start, numBytes);
    chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
    chunkPtr->start           = start;
    chunkPtr->numBytes        = numBytes;
    chunkPtr->numChars        = numChars;
    chunkPtr->numDisplayChars = numChars;
    chunkPtr->x               = curX;
    chunkPtr->y               = y;
    chunkPtr->totalWidth      = newX - curX;
    chunkPtr->displayWidth    = newX - curX;
    layoutPtr->numChunks++;

    return chunkPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TkFontParseXLFD --
 *
 *    Break up a fully specified XLFD into a set of font attributes.
 *
 * Results:
 *    Return value is TCL_ERROR if string was not a fully specified XLFD.
 *    Otherwise, fills font attribute buffer with the values parsed
 *    from the XLFD and returns TCL_OK.  
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

int
TkFontParseXLFD(string, faPtr, xaPtr)
    CONST char *string;       /* Parseable font description string. */
    TkFontAttributes *faPtr;  /* Filled with attributes parsed from font
                         * name.  Any attributes that were not
                         * specified in font name are filled with
                         * default values. */
    TkXLFDAttributes *xaPtr;  /* Filled with X-specific attributes parsed
                         * from font name.  Any attributes that were
                         * not specified in font name are filled with
                         * default values.  May be NULL if such
                         * information is not desired. */
{
    char *src;
    CONST char *str;
    int i, j;
    char *field[XLFD_NUMFIELDS + 2];
    Tcl_DString ds;
    TkXLFDAttributes xa;
    
    if (xaPtr == NULL) {
      xaPtr = &xa;
    }
    TkInitFontAttributes(faPtr);
    TkInitXLFDAttributes(xaPtr);

    memset(field, '\0', sizeof(field));

    str = string;
    if (*str == '-') {
      str++;
    }

    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, (char *) str, -1);
    src = Tcl_DStringValue(&ds);

    field[0] = src;
    for (i = 0; *src != '\0'; src++) {
      if (!(*src & 0x80)
            && Tcl_UniCharIsUpper(UCHAR(*src))) {
          *src = (char) Tcl_UniCharToLower(UCHAR(*src));
      }
      if (*src == '-') {
          i++;
          if (i == XLFD_NUMFIELDS) {
            continue;
          }
          *src = '\0';
          field[i] = src + 1;
          if (i > XLFD_NUMFIELDS) {
            break;
          }
      }
    }

    /*
     * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common,
     * but it is (strictly) malformed, because the first * is eliding both
     * the Setwidth and the Addstyle fields.  If the Addstyle field is a
     * number, then assume the above incorrect form was used and shift all
     * the rest of the fields right by one, so the number gets interpreted
     * as a pixelsize.  This fix is so that we don't get a million reports
     * that "it works under X (as a native font name), but gives a syntax
     * error under Windows (as a parsed set of attributes)".
     */

    if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) {
      if (atoi(field[XLFD_ADD_STYLE]) != 0) {
          for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) {
            field[j + 1] = field[j];
          }
          field[XLFD_ADD_STYLE] = NULL;
          i++;
      }
    }

    /*
     * Bail if we don't have enough of the fields (up to pointsize).
     */

    if (i < XLFD_FAMILY) {
      Tcl_DStringFree(&ds);
      return TCL_ERROR;
    }

    if (FieldSpecified(field[XLFD_FOUNDRY])) {
      xaPtr->foundry = Tk_GetUid(field[XLFD_FOUNDRY]);
    }

    if (FieldSpecified(field[XLFD_FAMILY])) {
      faPtr->family = Tk_GetUid(field[XLFD_FAMILY]);
    }
    if (FieldSpecified(field[XLFD_WEIGHT])) {
      faPtr->weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
            field[XLFD_WEIGHT]);
    }
    if (FieldSpecified(field[XLFD_SLANT])) {
      xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap,
            field[XLFD_SLANT]);
      if (xaPtr->slant == TK_FS_ROMAN) {
          faPtr->slant = TK_FS_ROMAN;
      } else {
          faPtr->slant = TK_FS_ITALIC;
      }
    }
    if (FieldSpecified(field[XLFD_SETWIDTH])) {
      xaPtr->setwidth = TkFindStateNum(NULL, NULL, xlfdSetwidthMap,
            field[XLFD_SETWIDTH]);
    }

    /* XLFD_ADD_STYLE ignored. */

    /*
     * Pointsize in tenths of a point, but treat it as tenths of a pixel
     * for historical compatibility.
     */

    faPtr->size = 12;

    if (FieldSpecified(field[XLFD_POINT_SIZE])) {
      if (field[XLFD_POINT_SIZE][0] == '[') {
          /*
           * Some X fonts have the point size specified as follows:
           *
           *          [ N1 N2 N3 N4 ]
           *
           * where N1 is the point size (in points, not decipoints!), and
           * N2, N3, and N4 are some additional numbers that I don't know
           * the purpose of, so I ignore them.
           */

          faPtr->size = atoi(field[XLFD_POINT_SIZE] + 1);
      } else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
            &faPtr->size) == TCL_OK) {
          faPtr->size /= 10;
      } else {
          return TCL_ERROR;
      }
    }

    /*
     * Pixel height of font.  If specified, overrides pointsize.
     */

    if (FieldSpecified(field[XLFD_PIXEL_SIZE])) {
      if (field[XLFD_PIXEL_SIZE][0] == '[') {
          /*
           * Some X fonts have the pixel size specified as follows:
           *
           *          [ N1 N2 N3 N4 ]
           *
           * where N1 is the pixel size, and where N2, N3, and N4 
           * are some additional numbers that I don't know
           * the purpose of, so I ignore them.
           */

          faPtr->size = atoi(field[XLFD_PIXEL_SIZE] + 1);
      } else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
            &faPtr->size) != TCL_OK) {
          return TCL_ERROR;
      }
    }

    faPtr->size = -faPtr->size;

    /* XLFD_RESOLUTION_X ignored. */

    /* XLFD_RESOLUTION_Y ignored. */

    /* XLFD_SPACING ignored. */

    /* XLFD_AVERAGE_WIDTH ignored. */

    if (FieldSpecified(field[XLFD_CHARSET])) {
      xaPtr->charset = Tk_GetUid(field[XLFD_CHARSET]);
    } else {
      xaPtr->charset = Tk_GetUid("iso8859-1");
    }
    Tcl_DStringFree(&ds);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * FieldSpecified --
 *
 *    Helper function for TkParseXLFD().  Determines if a field in the
 *    XLFD was set to a non-null, non-don't-care value.
 *
 * Results:
 *    The return value is 0 if the field in the XLFD was not set and
 *    should be ignored, non-zero otherwise.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */

static int
FieldSpecified(field)
    CONST char *field;  /* The field of the XLFD to check.  Strictly
                   * speaking, only when the string is "*" does it mean
                   * don't-care.  However, an unspecified or question
                   * mark is also interpreted as don't-care. */
{
    char ch;

    if (field == NULL) {
      return 0;
    }
    ch = field[0];
    return (ch != '*' && ch != '?');
}

/*
 *---------------------------------------------------------------------------
 *
 * TkFontGetPixels --
 *
 *    Given a font size specification (as described in the TkFontAttributes
 *    structure) return the number of pixels it represents.
 *
 * Results:
 *    As above.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */
 
int
TkFontGetPixels(tkwin, size)
    Tk_Window tkwin;          /* For point->pixel conversion factor. */
    int size;                 /* Font size. */
{
    double d;

    if (size < 0) {
      return -size;
    }

    d = size * 25.4 / 72.0;
    d *= WidthOfScreen(Tk_Screen(tkwin));
    d /= WidthMMOfScreen(Tk_Screen(tkwin));
    return (int) (d + 0.5);
}

/*
 *---------------------------------------------------------------------------
 *
 * TkFontGetPoints --
 *
 *    Given a font size specification (as described in the TkFontAttributes
 *    structure) return the number of points it represents.
 *
 * Results:
 *    As above.
 *
 * Side effects:
 *    None.
 *
 *---------------------------------------------------------------------------
 */
 
int
TkFontGetPoints(tkwin, size)
    Tk_Window tkwin;          /* For pixel->point conversion factor. */
    int size;                 /* Font size. */
{
    double d;

    if (size >= 0) {
      return size;
    }

    d = -size * 72.0 / 25.4;
    d *= WidthMMOfScreen(Tk_Screen(tkwin));
    d /= WidthOfScreen(Tk_Screen(tkwin));
    return (int) (d + 0.5);
}

/*
 *-------------------------------------------------------------------------
 *
 * TkFontGetAliasList --
 *
 *    Given a font name, find the list of all aliases for that font
 *    name.  One of the names in this list will probably be the name
 *    that this platform expects when asking for the font.
 *
 * Results:
 *    As above.  The return value is NULL if the font name has no 
 *    aliases.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------------
 */
      
char **
TkFontGetAliasList(faceName)
    CONST char *faceName;     /* Font name to test for aliases. */
{   
    int i, j;

    for (i = 0; fontAliases[i] != NULL; i++) {
      for (j = 0; fontAliases[i][j] != NULL; j++) {
          if (strcasecmp(faceName, fontAliases[i][j]) == 0) {
            return fontAliases[i];
          }
      }
    }
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * TkFontGetFallbacks --
 *
 *    Get the list of font fallbacks that the platform-specific code
 *    can use to try to find the closest matching font the name 
 *    requested.
 *
 * Results:
 *    As above.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------------
 */
      
char ***
TkFontGetFallbacks()
{
    return fontFallbacks;
}

/*
 *-------------------------------------------------------------------------
 *
 * TkFontGetGlobalClass --
 *
 *    Get the list of fonts to try if the requested font name does not
 *    exist and no fallbacks for that font name could be used either.
 *    The names in this list are considered preferred over all the other
 *    font names in the system when looking for a last-ditch fallback.
 *
 * Results:
 *    As above.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------------
 */
      
char **
TkFontGetGlobalClass()
{
    return globalFontClass;
}

/*
 *-------------------------------------------------------------------------
 *
 * TkFontGetSymbolClass --
 *
 *    Get the list of fonts that are symbolic; used if the operating 
 *    system cannot apriori identify symbolic fonts on its own.
 *
 * Results:
 *    As above.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------------
 */
      
char **
TkFontGetSymbolClass()
{
    return symbolClass;
}

/*
 *----------------------------------------------------------------------
 *
 * TkDebugFont --
 *
 *    This procedure returns debugging information about a font.
 *
 * Results:
 *    The return value is a list with one sublist for each TkFont
 *    corresponding to "name".  Each sublist has two elements that
 *    contain the resourceRefCount and objRefCount fields from the
 *    TkFont structure.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TkDebugFont(tkwin, name)
    Tk_Window tkwin;          /* The window in which the font will be
                         * used (not currently used). */
    char *name;               /* Name of the desired color. */
{
    TkFont *fontPtr;
    Tcl_HashEntry *hashPtr;
    Tcl_Obj *resultPtr, *objPtr;

    resultPtr = Tcl_NewObj();
    hashPtr = Tcl_FindHashEntry(
          &((TkWindow *) tkwin)->mainPtr->fontInfoPtr->fontCache, name);
    if (hashPtr != NULL) {
      fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr);
      if (fontPtr == NULL) {
          panic("TkDebugFont found empty hash table entry");
      }
      for ( ; (fontPtr != NULL); fontPtr = fontPtr->nextPtr) {
          objPtr = Tcl_NewObj();
          Tcl_ListObjAppendElement(NULL, objPtr,
                Tcl_NewIntObj(fontPtr->resourceRefCount));
          Tcl_ListObjAppendElement(NULL, objPtr,
                Tcl_NewIntObj(fontPtr->objRefCount)); 
          Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
      }
    }
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TkFontGetFirstTextLayout --
 *
 *    This procedure returns the first chunk of a Tk_TextLayout,
 *    i.e. until the first font change on the first line (or the
 *    whole first line if there is no such font change).
 *
 * Results:
 *    The return value is the byte length of the chunk, the chunk
 *    itself is copied into dst and its Tk_Font into font.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

int
TkFontGetFirstTextLayout(
    Tk_TextLayout layout,     /* Layout information, from a previous call
                         * to Tk_ComputeTextLayout(). */
    Tk_Font * font,
    char    * dst)
{
    TextLayout  *layoutPtr;
    LayoutChunk *chunkPtr;
    int numBytesInChunk;

    layoutPtr = (TextLayout *)layout;
    if ((layoutPtr==NULL)
            || (layoutPtr->numChunks==0)
            || (layoutPtr->chunks->numDisplayChars <= 0)) {
        dst[0] = '\0';
        return 0;
    }
    chunkPtr = layoutPtr->chunks;
    numBytesInChunk = chunkPtr->numBytes;
    strncpy(dst, chunkPtr->start, (size_t) numBytesInChunk);
    *font = layoutPtr->tkfont;
    return numBytesInChunk;
}

Generated by  Doxygen 1.6.0   Back to index