From d3d59cdb497bb3c67b3c63e78096ccae4c93e9e5 Mon Sep 17 00:00:00 2001 From: patthoyts Date: Fri, 4 May 2007 21:29:22 +0000 Subject: TIP #145 implementation FossilOrigin-Name: 5c1d2633c30b24b2068350342eb9d853e153dfa6 --- ChangeLog | 11 ++++ generic/tkFont.c | 67 +++++++++++++++-------- generic/tkFont.h | 6 ++- library/demos/widget | 28 +++++++--- library/ttk/fonts.tcl | 19 ++++--- win/tkWinDefault.h | 6 +-- win/tkWinFont.c | 143 +++++++++++++++++++++++++++++++++++++++++++++++++- win/tkWinInt.h | 3 +- win/tkWinWm.c | 11 +++- 9 files changed, 250 insertions(+), 44 deletions(-) diff --git a/ChangeLog b/ChangeLog index 8c9c5fc..f5a3c02 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2007-05-04 Pat Thoyts + + * generic/tkFont.c: TIP #145 implementation - + * generic/tkFont.h: Enhanced font handling. + * win/tkWinDefault.h: + * win/tkWinFont.c: + * win/tkWinInt.h: + * win/tkWinWm.c: + * library/demos/widget: + * library/ttk/fonts.tcl: + 2007-05-04 Donal K. Fellows * doc/ttk_treeview.n, doc/ttk_panedwindow.n, doc/ttk_dialog.n: diff --git a/generic/tkFont.c b/generic/tkFont.c index 217efaa..14fe799 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -10,7 +10,7 @@ * 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.33 2007/04/17 14:32:28 dkf Exp $ + * RCS: @(#) $Id: tkFont.c,v 1.34 2007/05/04 21:29:22 patthoyts Exp $ */ #include "tkPort.h" @@ -326,8 +326,6 @@ static char *globalFontClass[] = { static int ConfigAttributesObj(Tcl_Interp *interp, Tk_Window tkwin, int objc, Tcl_Obj *const objv[], TkFontAttributes *faPtr); -static int CreateNamedFont(Tcl_Interp *interp, Tk_Window tkwin, - const char *name, TkFontAttributes *faPtr); static void DupFontObjProc(Tcl_Obj *srcObjPtr, Tcl_Obj *dupObjPtr); static int FieldSpecified(const char *field); static void FreeFontObjProc(Tcl_Obj *objPtr); @@ -677,7 +675,7 @@ Tk_FontObjCmd( &fa) != TCL_OK) { return TCL_ERROR; } - if (CreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) { + if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) { return TCL_ERROR; } Tcl_AppendResult(interp, name, NULL); @@ -686,8 +684,6 @@ Tk_FontObjCmd( case FONT_DELETE: { int i; char *string; - NamedFont *nfPtr; - Tcl_HashEntry *namedHashPtr; /* * Delete the named font. If there are still widgets using this font, @@ -700,19 +696,7 @@ Tk_FontObjCmd( } 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", NULL); - return TCL_ERROR; - } - nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr); - if (nfPtr->refCount != 0) { - nfPtr->deletePending = 1; - } else { - Tcl_DeleteHashEntry(namedHashPtr); - ckfree((char *) nfPtr); - } + TkDeleteNamedFont(interp, tkwin, string); } break; } @@ -936,7 +920,7 @@ RecomputeWidgets( /* *--------------------------------------------------------------------------- * - * CreateNamedFont -- + * TkCreateNamedFont -- * * Create the specified named font with the given attributes in the named * font table associated with the interp. @@ -957,8 +941,8 @@ RecomputeWidgets( *--------------------------------------------------------------------------- */ -static int -CreateNamedFont( +int +TkCreateNamedFont( Tcl_Interp *interp, /* Interp for error return. */ Tk_Window tkwin, /* A window associated with interp. */ const char *name, /* Name for the new named font. */ @@ -1006,6 +990,45 @@ CreateNamedFont( /* *--------------------------------------------------------------------------- * + * TkDeleteNamedFont -- + * + * Delete the named font. If there are still widgets using this + * font, then it isn't deleted right away. + * + *--------------------------------------------------------------------------- + */ + +int +TkDeleteNamedFont( + Tcl_Interp *interp, /* Interp for error return. */ + Tk_Window tkwin, /* A window associated with interp. */ + CONST char *name) /* Name for the new named font. */ +{ + TkFontInfo *fiPtr; + NamedFont *nfPtr; + Tcl_HashEntry *namedHashPtr; + + fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr; + + namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, name); + if (namedHashPtr == NULL) { + Tcl_AppendResult(interp, "named font \"", name, + "\" 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); + } + return TCL_OK; +} + +/* + *--------------------------------------------------------------------------- + * * Tk_GetFont -- * * Given a string description of a font, map the description to a diff --git a/generic/tkFont.h b/generic/tkFont.h index 9ea3488..448423d 100644 --- a/generic/tkFont.h +++ b/generic/tkFont.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkFont.h,v 1.9 2006/12/01 20:14:23 kennykb Exp $ + * RCS: @(#) $Id: tkFont.h,v 1.10 2007/05/04 21:29:22 patthoyts Exp $ */ #ifndef _TKFONT @@ -203,6 +203,10 @@ MODULE_SCOPE int TkFontGetPixels(Tk_Window tkwin, int size); MODULE_SCOPE int TkFontGetPoints(Tk_Window tkwin, int size); MODULE_SCOPE char ** TkFontGetGlobalClass(void); MODULE_SCOPE char ** TkFontGetSymbolClass(void); +MODULE_SCOPE int TkCreateNamedFont(Tcl_Interp *interp, Tk_Window tkwin, + CONST char *name, TkFontAttributes *faPtr); +MODULE_SCOPE int TkDeleteNamedFont(Tcl_Interp *interp, + Tk_Window tkwin, CONST char *name); MODULE_SCOPE int TkFontGetFirstTextLayout(Tk_TextLayout layout, Tk_Font *font, char *dst); diff --git a/library/demos/widget b/library/demos/widget index ec964f9..c4e9fd6 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -11,7 +11,7 @@ exec wish "$0" "$@" # ".tcl" files is this directory, which are sourced by this script # as needed. # -# RCS: @(#) $Id: widget,v 1.28 2006/09/11 14:41:04 das Exp $ +# RCS: @(#) $Id: widget,v 1.29 2007/05/04 21:29:22 patthoyts Exp $ package require Tcl 8.5 package require Tk 8.5 @@ -33,12 +33,26 @@ if {[tk windowingsystem] eq "x11"} { } if {[lsearch -exact [font names] defaultFont] == -1} { - font create mainFont -family Helvetica -size 12 - font create fixedFont -family Courier -size 10 - font create boldFont -family Helvetica -size 12 -weight bold - font create titleFont -family Helvetica -size 18 -weight bold - font create statusFont -family Helvetica -size 10 - font create varsFont -family Helvetica -size 14 + # TIP #145 defines some standard named fonts + if {[lsearch -exact [font names] TkDefaultFont] != -1} { + # FIX ME: the following tecnique of cloning the font to copy it works + # fine but means that if the system font is changed by + # Tk cannot update the copied font. font alias might be + # useful here -- or fix the app to use TkDefaultFont etc. + font create mainFont {*}[font configure TkDefaultFont] + font create fixedFont {*}[font configure TkFixedFont] + font create boldFont {*}[font configure TkDefaultFont] -weight bold + font create titleFont {*}[font configure TkDefaultFont] -weight bold + font create statusFont {*}[font configure TkDefaultFont] + font create varsFont {*}[font configure TkDefaultFont] + } else { + font create mainFont -family Helvetica -size 12 + font create fixedFont -family Courier -size 10 + font create boldFont -family Helvetica -size 12 -weight bold + font create titleFont -family Helvetica -size 18 -weight bold + font create statusFont -family Helvetica -size 10 + font create varsFont -family Helvetica -size 14 + } } set widgetDemo 1 diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl index db15ad1..8cb6c33 100644 --- a/library/ttk/fonts.tcl +++ b/library/ttk/fonts.tcl @@ -1,5 +1,5 @@ # -# $Id: fonts.tcl,v 1.3 2006/11/28 21:25:27 jenglish Exp $ +# $Id: fonts.tcl,v 1.4 2007/05/04 21:29:22 patthoyts Exp $ # # Font specifications. # @@ -75,7 +75,8 @@ namespace eval ttk { -catch {font create TkDefaultFont} + +set tip145 [catch {font create TkDefaultFont}] catch {font create TkTextFont} catch {font create TkHeadingFont} catch {font create TkCaptionFont} @@ -100,12 +101,14 @@ switch -- [tk windowingsystem] { } set F(size) 8 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(size) - font configure TkCaptionFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(size) + if {!$tip145} { + font configure TkDefaultFont -family $F(family) -size $F(size) + font configure TkTextFont -family $F(family) -size $F(size) + font configure TkHeadingFont -family $F(family) -size $F(size) + font configure TkCaptionFont -family $F(family) -size $F(size) \ + -weight bold + font configure TkTooltipFont -family $F(family) -size $F(size) + } } aqua { set F(family) "Lucida Grande" diff --git a/win/tkWinDefault.h b/win/tkWinDefault.h index e0946c6..f2267fa 100644 --- a/win/tkWinDefault.h +++ b/win/tkWinDefault.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinDefault.h,v 1.21 2006/09/06 22:39:28 hobbs Exp $ + * RCS: @(#) $Id: tkWinDefault.h,v 1.22 2007/05/04 21:29:22 patthoyts Exp $ */ #ifndef _TKWINDEFAULT @@ -28,7 +28,7 @@ #define BLACK "Black" #define WHITE "White" -#define CTL_FONT "{MS Sans Serif} 8" +#define CTL_FONT "TkDefaultFont" /*"{MS Sans Serif} 8"*/ #define NORMAL_BG "SystemButtonFace" #define NORMAL_FG "SystemButtonText" #define ACTIVE_BG NORMAL_BG @@ -285,7 +285,7 @@ #define DEF_MENU_CURSOR "arrow" #define DEF_MENU_DISABLED_FG_COLOR DISABLED #define DEF_MENU_DISABLED_FG_MONO "" -#define DEF_MENU_FONT CTL_FONT +#define DEF_MENU_FONT "TkMenuFont" /* CTL_FONT */ #define DEF_MENU_FG MENU_FG #define DEF_MENU_POST_COMMAND "" #define DEF_MENU_RELIEF "flat" diff --git a/win/tkWinFont.c b/win/tkWinFont.c index 2f5671b..5021955 100644 --- a/win/tkWinFont.c +++ b/win/tkWinFont.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinFont.c,v 1.31 2007/01/18 23:56:44 nijtmans Exp $ + * RCS: @(#) $Id: tkWinFont.c,v 1.32 2007/05/04 21:29:22 patthoyts Exp $ */ #include "tkWinInt.h" @@ -159,8 +159,10 @@ typedef struct CanUse { static const TkStateMap systemMap[] = { {ANSI_FIXED_FONT, "ansifixed"}, + {ANSI_FIXED_FONT, "fixed"}, {ANSI_VAR_FONT, "ansi"}, {DEVICE_DEFAULT_FONT, "device"}, + {DEFAULT_GUI_FONT, "defaultgui"}, {OEM_FIXED_FONT, "oemfixed"}, {SYSTEM_FIXED_FONT, "systemfixed"}, {SYSTEM_FONT, "system"}, @@ -208,6 +210,11 @@ static void InitFont(Tk_Window tkwin, HFONT hFont, int overstrike, WinFont *tkFontPtr); static void InitSubFont(HDC hdc, HFONT hFont, int base, SubFont *subFontPtr); +static int CreateNamedSystemLogFont(Tcl_Interp *interp, + Tk_Window tkwin, CONST char* name, + LOGFONT* logFontPtr); +static int CreateNamedSystemFont(Tcl_Interp *interp, + Tk_Window tkwin, CONST char* name, HFONT hFont); static int LoadFontRanges(HDC hdc, HFONT hFont, USHORT **startCount, USHORT **endCount, int *symbolPtr); @@ -260,6 +267,8 @@ TkpFontPkgInit( systemEncoding = TkWinGetUnicodeEncoding(); } + + TkWinSetupSystemFonts(mainPtr); } /* @@ -311,6 +320,138 @@ TkpGetNativeFont( /* *--------------------------------------------------------------------------- + * CreateNamedSystemFont -- + * + * This function registers a Windows logical font description with the Tk + * named font mechanism. + * + * Side effects + * + * A new named font is added to the Tk font registry. + * + *--------------------------------------------------------------------------- + */ + +static int +CreateNamedSystemLogFont( + Tcl_Interp *interp, + Tk_Window tkwin, + CONST char* name, + LOGFONT* logFontPtr) +{ + HFONT hFont; + int r; + + hFont = CreateFontIndirect(logFontPtr); + r = CreateNamedSystemFont(interp, tkwin, name, hFont); + DeleteObject((HGDIOBJ)hFont); + return r; +} + +/* + *--------------------------------------------------------------------------- + * CreateNamedSystemFont -- + * + * This function registers a Windows font with the Tk + * named font mechanism. + * + * Side effects + * + * A new named font is added to the Tk font registry. + * + *--------------------------------------------------------------------------- + */ + +static int +CreateNamedSystemFont( + Tcl_Interp *interp, + Tk_Window tkwin, + CONST char* name, + HFONT hFont) +{ + TkFontAttributes *faPtr; + WinFont *fontPtr; + int r; + + TkDeleteNamedFont(interp, tkwin, name); + + fontPtr = (WinFont *) ckalloc(sizeof(WinFont)); + InitFont(tkwin, hFont, 0, fontPtr); + faPtr = (TkFontAttributes*)ckalloc(sizeof(TkFontAttributes)); + memcpy(faPtr, &fontPtr->font.fa, sizeof(TkFontAttributes)); + r = TkCreateNamedFont(interp, tkwin, name, faPtr); + TkpDeleteFont((TkFont *)fontPtr); + ckfree((char *) fontPtr); + return r; +} + +/* + *--------------------------------------------------------------------------- + * TkWinSystemFonts -- + * + * Create some platform specific named fonts that to give access to the + * system fonts. These are all defined for the Windows desktop parameters. + * + *--------------------------------------------------------------------------- + */ + +void +TkWinSetupSystemFonts(TkMainInfo *mainPtr) +{ + Tcl_Interp *interp; + Tk_Window tkwin; + const TkStateMap *mapPtr; + NONCLIENTMETRICS ncMetrics; + ICONMETRICS iconMetrics; + HFONT hFont; + + interp = (Tcl_Interp *) mainPtr->interp; + tkwin = (Tk_Window) mainPtr->winPtr; + + /* force this for now */ + if (((TkWindow *) tkwin)->mainPtr == NULL) + ((TkWindow *) tkwin)->mainPtr = mainPtr; + + ncMetrics.cbSize = sizeof(ncMetrics); + SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics), + &ncMetrics, 0); + + CreateNamedSystemLogFont(interp, tkwin, "TkDefaultFont", + &ncMetrics.lfMessageFont); + CreateNamedSystemLogFont(interp, tkwin, "TkHeadingFont", + &ncMetrics.lfMessageFont); + CreateNamedSystemLogFont(interp, tkwin, "TkTextFont", + &ncMetrics.lfMessageFont); + CreateNamedSystemLogFont(interp, tkwin, "TkMenuFont", + &ncMetrics.lfMenuFont); + CreateNamedSystemLogFont(interp, tkwin, "TkTooltipFont", + &ncMetrics.lfStatusFont); + CreateNamedSystemLogFont(interp, tkwin, "TkCaptionFont", + &ncMetrics.lfCaptionFont); + CreateNamedSystemLogFont(interp, tkwin, "TkSmallCaptionFont", + &ncMetrics.lfSmCaptionFont); + + iconMetrics.cbSize = sizeof(iconMetrics); + SystemParametersInfo(SPI_GETICONMETRICS, sizeof(iconMetrics), + &iconMetrics, 0); + CreateNamedSystemLogFont(interp, tkwin, "TkIconFont", + &iconMetrics.lfFont); + + hFont = (HFONT)GetStockObject(ANSI_FIXED_FONT); + CreateNamedSystemFont(interp, tkwin, "TkFixedFont", hFont); + + /* + * Setup the remaining standard Tk font names as named fonts. + */ + + for (mapPtr = systemMap; mapPtr->strKey != NULL; mapPtr++) { + hFont = (HFONT)GetStockObject(mapPtr->numKey); + CreateNamedSystemFont(interp, tkwin, mapPtr->strKey, hFont); + } +} + +/* + *--------------------------------------------------------------------------- * * TkpGetFontFromAttributes -- * diff --git a/win/tkWinInt.h b/win/tkWinInt.h index 1f54c65..c6ba4f7 100644 --- a/win/tkWinInt.h +++ b/win/tkWinInt.h @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinInt.h,v 1.27 2007/01/05 00:00:52 nijtmans Exp $ + * RCS: @(#) $Id: tkWinInt.h,v 1.28 2007/05/04 21:29:23 patthoyts Exp $ */ #ifndef _TKWININT @@ -226,6 +226,7 @@ EXTERN TkWinProcs *tkWinProcs; extern Tcl_Encoding TkWinGetKeyInputEncoding(void); extern Tcl_Encoding TkWinGetUnicodeEncoding(void); +extern void TkWinSetupSystemFonts(TkMainInfo *mainPtr); /* * Values returned by TkWinGetPlatformTheme. diff --git a/win/tkWinWm.c b/win/tkWinWm.c index 2a0df7d..e089985 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinWm.c,v 1.115 2007/02/23 14:15:34 dkf Exp $ + * RCS: @(#) $Id: tkWinWm.c,v 1.116 2007/05/04 21:29:23 patthoyts Exp $ */ #include "tkWinInt.h" @@ -7820,6 +7820,15 @@ WmProc( result = InstallColormaps(hwnd, WM_QUERYNEWPALETTE, TRUE); goto done; + case WM_SETTINGCHANGE: + if (wParam == SPI_SETNONCLIENTMETRICS) { + winPtr = GetTopLevel(hwnd); + TkWinSetupSystemFonts(winPtr->mainPtr); + result = 0; + goto done; + } + break; + case WM_WINDOWPOSCHANGED: ConfigureTopLevel((WINDOWPOS *) lParam); result = 0; -- cgit v0.12