Index: generic/tkFont.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkFont.c,v
retrieving revision 1.21
diff -c -u -r1.21 tkFont.c
--- generic/tkFont.c	2 Sep 2002 19:13:47 -0000	1.21
+++ generic/tkFont.c	31 Jul 2003 00:51:25 -0000
@@ -325,9 +325,6 @@
 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));
@@ -604,7 +601,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);
@@ -613,8 +610,6 @@
 	case FONT_DELETE: {
 	    int i;
 	    char *string;
-	    NamedFont *nfPtr;
-	    Tcl_HashEntry *namedHashPtr;
 
 	    /*
 	     * Delete the named font.  If there are still widgets using this
@@ -627,19 +622,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", (char *) 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;
 	}
@@ -865,7 +848,7 @@
 /*
  *---------------------------------------------------------------------------
  *
- * CreateNamedFont --
+ * TkCreateNamedFont --
  *
  *	Create the specified named font with the given attributes in the
  *	named font table associated with the interp.  
@@ -886,8 +869,8 @@
  *---------------------------------------------------------------------------
  */
 
-static int
-CreateNamedFont(interp, tkwin, name, faPtr)
+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. */
@@ -929,6 +912,45 @@
     nfPtr->fa = *faPtr;
     nfPtr->refCount = 0;	
     nfPtr->deletePending = 0;
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkDeleteNamedFont --
+ *
+ *	Delete the named font.  If there are still widgets using this
+ *	font, then it isn't deleted right away.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TkDeleteNamedFont(interp, tkwin, name)
+    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;
 }
 
Index: generic/tkFont.h
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkFont.h,v
retrieving revision 1.5
diff -c -u -r1.5 tkFont.h
--- generic/tkFont.h	16 Apr 1999 01:51:14 -0000	1.5
+++ generic/tkFont.h	31 Jul 2003 00:51:25 -0000
@@ -205,6 +205,10 @@
 			    int size));
 EXTERN char **		TkFontGetGlobalClass _ANSI_ARGS_((void));
 EXTERN char **		TkFontGetSymbolClass _ANSI_ARGS_((void));
+EXTERN int		TkCreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, CONST char *name, TkFontAttributes *faPtr));
+EXTERN int		TkDeleteNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tk_Window tkwin, CONST char *name));
 
 /*
  * Low-level API exported by platform-specific code to generic code. 
Index: win/tkWinFont.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/win/tkWinFont.c,v
retrieving revision 1.17
diff -c -u -r1.17 tkWinFont.c
--- win/tkWinFont.c	26 Feb 2003 02:47:05 -0000	1.17
+++ win/tkWinFont.c	31 Jul 2003 00:51:27 -0000
@@ -158,8 +158,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"},
@@ -204,6 +206,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);
@@ -256,6 +263,8 @@
 
 	systemEncoding = TkWinGetUnicodeEncoding();
     }
+
+    TkWinSetupSystemFonts(mainPtr);
 }
 
 /*
@@ -306,6 +315,119 @@
 
 /*
  *---------------------------------------------------------------------------
+ * 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;
+    
+    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, "SystemMenuFont",
+	    &ncMetrics.lfMenuFont);
+    CreateNamedSystemLogFont(interp, tkwin, "SystemStatusFont",
+	    &ncMetrics.lfStatusFont);
+    CreateNamedSystemLogFont(interp, tkwin, "SystemMessageFont",
+	    &ncMetrics.lfMessageFont);
+    CreateNamedSystemLogFont(interp, tkwin, "SystemCaptionFont",
+	    &ncMetrics.lfCaptionFont);
+    CreateNamedSystemLogFont(interp, tkwin, "SystemSmallCaptionFont",
+	    &ncMetrics.lfSmCaptionFont);
+    
+    iconMetrics.cbSize = sizeof(iconMetrics);
+    SystemParametersInfo(SPI_GETICONMETRICS, sizeof(iconMetrics),
+	    &iconMetrics, 0);
+    CreateNamedSystemLogFont(interp, tkwin, "SystemIconFont",
+	    &iconMetrics.lfFont);
+    
+    for (mapPtr = systemMap; mapPtr->strKey != NULL; mapPtr++) {
+        HFONT hFont = (HFONT)GetStockObject(mapPtr->numKey);
+        CreateNamedSystemFont(interp, tkwin, mapPtr->strKey, hFont);
+    }
+}
+
+/*
+ *---------------------------------------------------------------------------
  *
  * TkpGetFontFromAttributes -- 
  *
@@ -400,8 +522,8 @@
 
     hFont = GetScreenFont(faPtr, faceName, TkFontGetPixels(tkwin, faPtr->size));
     if (tkFontPtr == NULL) {
-	fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
-    } else {
+	fontPtr = (WinFont *) ckalloc(sizeof(WinFont)); 
+   } else {
 	fontPtr = (WinFont *) tkFontPtr;
 	ReleaseFont(fontPtr);
     }
Index: win/tkWinInt.h
===================================================================
RCS file: /cvsroot/tktoolkit/tk/win/tkWinInt.h,v
retrieving revision 1.14
diff -c -u -r1.14 tkWinInt.h
--- win/tkWinInt.h	26 Feb 2003 02:47:05 -0000	1.14
+++ win/tkWinInt.h	31 Jul 2003 00:51:27 -0000
@@ -201,6 +201,7 @@
 
 extern Tcl_Encoding TkWinGetKeyInputEncoding _ANSI_ARGS_((void));
 extern Tcl_Encoding TkWinGetUnicodeEncoding _ANSI_ARGS_((void));
+extern void	TkWinSetupSystemFonts _ANSI_ARGS_((TkMainInfo *mainPtr));
 
 #endif /* _TKWININT */
 
Index: win/tkWinWm.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/win/tkWinWm.c,v
retrieving revision 1.55
diff -c -u -r1.55 tkWinWm.c
--- win/tkWinWm.c	12 Mar 2003 00:25:42 -0000	1.55
+++ win/tkWinWm.c	31 Jul 2003 00:51:30 -0000
@@ -6871,6 +6871,12 @@
 	    result = InstallColormaps(hwnd, WM_QUERYNEWPALETTE, TRUE);
 	    goto done;
 
+	case WM_SETTINGCHANGE:
+	    winPtr = GetTopLevel(hwnd);
+	    TkWinSetupSystemFonts(winPtr->mainPtr);
+	    result = 0;
+	    goto done;
+
 	case WM_WINDOWPOSCHANGED:
 	    ConfigureTopLevel((WINDOWPOS *) lParam);
 	    result = 0;
