Attachment "tkfont-20061222.patch" to
ticket [780617ff]
added by
patthoyts
2006-12-22 17:16:37.
Updated implementation of TIP #145
Index: generic/tkFont.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkFont.c,v
retrieving revision 1.30
diff -u -r1.30 tkFont.c
--- generic/tkFont.c 10 Dec 2006 05:26:42 -0000 1.30
+++ generic/tkFont.c 21 Dec 2006 22:51:14 -0000
@@ -326,8 +326,6 @@
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);
@@ -658,7 +656,7 @@
&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);
@@ -667,8 +665,6 @@
case FONT_DELETE: {
int i;
char *string;
- NamedFont *nfPtr;
- Tcl_HashEntry *namedHashPtr;
/*
* Delete the named font. If there are still widgets using this font,
@@ -681,19 +677,7 @@
}
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;
}
@@ -917,7 +901,7 @@
/*
*---------------------------------------------------------------------------
*
- * CreateNamedFont --
+ * TkCreateNamedFont --
*
* Create the specified named font with the given attributes in the named
* font table associated with the interp.
@@ -938,8 +922,8 @@
*---------------------------------------------------------------------------
*/
-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. */
@@ -987,6 +971,45 @@
/*
*---------------------------------------------------------------------------
*
+ * 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
Index: generic/tkFont.h
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkFont.h,v
retrieving revision 1.9
diff -u -r1.9 tkFont.h
--- generic/tkFont.h 1 Dec 2006 20:14:23 -0000 1.9
+++ generic/tkFont.h 21 Dec 2006 22:51:14 -0000
@@ -203,6 +203,10 @@
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);
Index: library/demos/widget
===================================================================
RCS file: /cvsroot/tktoolkit/tk/library/demos/widget,v
retrieving revision 1.28
diff -u -r1.28 widget
--- library/demos/widget 11 Sep 2006 14:41:04 -0000 1.28
+++ library/demos/widget 22 Dec 2006 09:55:56 -0000
@@ -33,12 +33,26 @@
}
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
Index: library/ttk/fonts.tcl
===================================================================
RCS file: /cvsroot/tktoolkit/tk/library/ttk/fonts.tcl,v
retrieving revision 1.3
diff -u -r1.3 fonts.tcl
--- library/ttk/fonts.tcl 28 Nov 2006 21:25:27 -0000 1.3
+++ library/ttk/fonts.tcl 22 Dec 2006 09:56:16 -0000
@@ -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 @@
}
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"
Index: win/tkWinDefault.h
===================================================================
RCS file: /cvsroot/tktoolkit/tk/win/tkWinDefault.h,v
retrieving revision 1.21
diff -u -r1.21 tkWinDefault.h
--- win/tkWinDefault.h 6 Sep 2006 22:39:28 -0000 1.21
+++ win/tkWinDefault.h 22 Dec 2006 02:10:28 -0000
@@ -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"
Index: win/tkWinFont.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/win/tkWinFont.c,v
retrieving revision 1.28
diff -u -r1.28 tkWinFont.c
--- win/tkWinFont.c 1 Dec 2006 20:14:24 -0000 1.28
+++ win/tkWinFont.c 22 Dec 2006 01:59:46 -0000
@@ -159,8 +159,10 @@
static 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 @@
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 @@
systemEncoding = TkWinGetUnicodeEncoding();
}
+
+ TkWinSetupSystemFonts(mainPtr);
}
/*
@@ -311,6 +320,138 @@
/*
*---------------------------------------------------------------------------
+ * 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;
+ 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 --
*
Index: win/tkWinInt.h
===================================================================
RCS file: /cvsroot/tktoolkit/tk/win/tkWinInt.h,v
retrieving revision 1.26
diff -u -r1.26 tkWinInt.h
--- win/tkWinInt.h 2 Dec 2005 13:42:29 -0000 1.26
+++ win/tkWinInt.h 21 Dec 2006 22:51:14 -0000
@@ -226,6 +226,7 @@
extern Tcl_Encoding TkWinGetKeyInputEncoding(void);
extern Tcl_Encoding TkWinGetUnicodeEncoding(void);
+extern void TkWinSetupSystemFonts(TkMainInfo *mainPtr);
/*
* Values returned by TkWinGetPlatformTheme.
Index: win/tkWinWm.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/win/tkWinWm.c,v
retrieving revision 1.110
diff -u -r1.110 tkWinWm.c
--- win/tkWinWm.c 1 Dec 2006 19:48:00 -0000 1.110
+++ win/tkWinWm.c 21 Dec 2006 22:51:14 -0000
@@ -7809,6 +7809,15 @@
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;
