tkfont.c

linux系统下的音频通信

	    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 = Tk_GetUid(Tcl_GetStringFromObj(objv[i], NULL));
		namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
		if (namedHashPtr == NULL) {
		    Tcl_AppendStringsToObj(Tcl_GetObjResult(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;
	    
	    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_GetFontFromObj(interp, tkwin, objv[2]);
	    if (tkfont == NULL) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetStringFromObj(objv[3 + skip], &length);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_TextWidth(tkfont, string, length));
	    Tk_FreeFont(tkfont);
	    break;
	}
	case FONT_METRICS: {
	    char buf[64];
	    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_GetFontFromObj(interp, tkwin, objv[2]);
	    if (tkfont == NULL) {
		return TCL_ERROR;
	    }
	    objc -= skip;
	    objv += skip;
	    fmPtr = GetFontMetrics(tkfont);
	    if (objc == 3) {
		sprintf(buf, "-ascent %d -descent %d -linespace %d -fixed %d",
			fmPtr->ascent, fmPtr->descent,
			fmPtr->ascent + fmPtr->descent,
			fmPtr->fixed);
		Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
	    } 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;
	    Tcl_Obj *strPtr;
	    NamedFont *nfPtr;
	    Tcl_HashSearch search;
	    Tcl_HashEntry *namedHashPtr;
	    
	    if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "names");
		return TCL_ERROR;
	    }
	    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, Tcl_GetObjResult(interp), strPtr);
		}
		namedHashPtr = Tcl_NextHashEntry(&search);
	    }
	    break;
	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * UpdateDependantFonts, 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
UpdateDependantFonts(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) {
	fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
	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);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TkCreateNamedFont --
 *
 *	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 interp->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.
 *
 *---------------------------------------------------------------------------
 */

int
TkCreateNamedFont(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;

    name = Tk_GetUid(name);
    namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
		    
    if (new == 0) {
	nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
	if (nfPtr->deletePending == 0) {
	    interp->result[0] = '\0';
	    Tcl_AppendResult(interp, "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;
	UpdateDependantFonts(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 interp->result.
 *
 * Side effects:
 *	Calls Tk_GetFontFromObj(), which modifies interp's result object,
 *	then copies the string from the result object into interp->result.
 *	This procedure will go away when Tk_ConfigureWidget() is
 *	made into an object command.
 *
 *---------------------------------------------------------------------------
 */

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. */
{
    Tcl_Obj *strPtr;
    Tk_Font tkfont;
    
    strPtr = Tcl_NewStringObj((char *) string, -1);
    
    tkfont = Tk_GetFontFromObj(interp, tkwin, strPtr);
    if (tkfont == NULL) {
	Tcl_SetResult(interp,
	        Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL),
		TCL_VOLATILE);
    }

    Tcl_DecrRefCount(strPtr);	/* done with object */
    return tkfont;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tk_GetFontFromObj -- 
 *
 *	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() so that the database is cleaned up when
 *	fonts aren't in use anymore.
 *
 *---------------------------------------------------------------------------
 */

Tk_Font
Tk_GetFontFromObj(interp, tkwin, objPtr)
    Tcl_Interp *interp;		/* Interp for database and error return. */
    Tk_Window tkwin;		/* For display on which font will be used. */
    Tcl_Obj *objPtr;		/* Object describing font, as: named font,
				 * native format, or parseable string. */
{
    TkFontInfo *fiPtr;
    CachedFontKey key;
    Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
    TkFont *fontPtr;
    int new, descent;
    NamedFont *nfPtr;
    char *string;
    
    fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
    string = Tcl_GetStringFromObj(objPtr, NULL);

    key.display = Tk_Display(tkwin);
    key.string = Tk_GetUid(string);
    cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache, (char *) &key, &new);

    if (new == 0) {
	/*
	 * We have already constructed a font with this description for
	 * this display.  Bump the reference count of the cached font.
	 */

	fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
	fontPtr->refCount++;
	return (Tk_Font) fontPtr;
    }

    namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, key.string);
    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, string);
	if (fontPtr == NULL) {
	    TkFontAttributes fa;

	    TkInitFontAttributes(&fa);
	    if (ParseFontNameObj(interp, tkwin, objPtr, &fa) != TCL_OK) {
		Tcl_DeleteHashEntry(cacheHashPtr);
		return NULL;
	    }

	    /*
	     * String contained the attributes inline.
	     */

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

    fontPtr->refCount	    = 1;
    fontPtr->cacheHashPtr   = cacheHashPtr;
    fontPtr->namedHashPtr   = namedHashPtr;

    Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, 0, 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;