/[dtapublic]/projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkfont.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkfont.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.42  
changed lines
  Added in v.98

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25