summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog11
-rw-r--r--generic/tkFont.c67
-rw-r--r--generic/tkFont.h6
-rw-r--r--library/demos/widget28
-rw-r--r--library/ttk/fonts.tcl19
-rw-r--r--win/tkWinDefault.h6
-rw-r--r--win/tkWinFont.c143
-rw-r--r--win/tkWinInt.h3
-rw-r--r--win/tkWinWm.c11
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 <patthoyts@users.sourceforge.net>
+
+ * 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 <donal.k.fellows@man.ac.uk>
* 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;