--- a/src/objects-msw.c	Mon Aug 13 11:32:27 2007 +0200
+++ b/src/objects-msw.c	Mon Aug 13 11:33:38 2007 +0200
@@ -938,15 +938,15 @@
 struct font_enum_t
 {
   HDC hdc;
-  struct device *d;
+  Lisp_Object list;
 };
 
 static int CALLBACK
 font_enum_callback_2 (ENUMLOGFONTEX *lpelfe, NEWTEXTMETRICEX *lpntme, 
 		      int FontType, struct font_enum_t *font_enum)
 {
-  struct mswindows_font_enum *fontlist, **fonthead;
   char fontname[MSW_FONTSIZE];
+  Lisp_Object fontname_lispstr;
   int i;
 
   /*
@@ -967,7 +967,7 @@
     /* Formula for pointsize->height from LOGFONT docs in Platform SDK */
     sprintf (fontname, "%s::%d::", lpelfe->elfLogFont.lfFaceName,
 	     MulDiv (lpntme->ntmTm.tmHeight - lpntme->ntmTm.tmInternalLeading,
-	             72, DEVICE_MSWINDOWS_LOGPIXELSY (font_enum->d)));
+	             72, GetDeviceCaps (font_enum->hdc, LOGPIXELSY)));
 
   /*
    * The enumerated font character set strings are not to be trusted because
@@ -985,25 +985,11 @@
   if (i==countof (charset_map))
     strcpy (fontname, charset_map[0].name);
 
-  /* Check that the new font is not a duplicate */
-  fonthead = &DEVICE_MSWINDOWS_FONTLIST (font_enum->d);
-  fontlist = *fonthead;
-  while (fontlist)
-    if (!strcmp (fontname, fontlist->fontname))
-      return 1;		/* found a duplicate */
-    else
-      fontlist = fontlist->next;
+  /* Add the font name to the list if not already there */
+  fontname_lispstr = build_string (fontname);
+  if (NILP (memq_no_quit (fontname_lispstr, font_enum->list)))
+    font_enum->list = Fcons (fontname_lispstr, font_enum->list);
 
-  /* Insert entry at head */
-  fontlist = *fonthead;
-  *fonthead = xmalloc (sizeof (struct mswindows_font_enum));
-  if (*fonthead == NULL)
-    {
-      *fonthead = fontlist;
-      return 0;
-    }
-  strcpy ((*fonthead)->fontname, fontname);
-  (*fonthead)->next = fontlist;
   return 1;
 }
 
@@ -1019,13 +1005,13 @@
 }
 
 /*
- * Enumerate the available fonts. Called by mswindows_init_device().
- * Fills in the device's device-type-specfic fontlist.
+ * Enumerate the available on the HDC fonts and return a list of string
+ * font names.
  */
-void
-mswindows_enumerate_fonts (struct device *d)
+Lisp_Object
+mswindows_enumerate_fonts (HDC hdc)
 {
-  HDC hdc = CreateCompatibleDC (NULL);
+  /* This cannot CG */
   LOGFONT logfont;
   struct font_enum_t font_enum;
 
@@ -1034,26 +1020,79 @@
   logfont.lfFaceName[0] = '\0';
   logfont.lfPitchAndFamily = DEFAULT_PITCH;
   font_enum.hdc = hdc;
-  font_enum.d = d;
-  DEVICE_MSWINDOWS_FONTLIST (d) = NULL;
+  font_enum.list = Qnil;
   EnumFontFamiliesEx (hdc, &logfont, (FONTENUMPROC) font_enum_callback_1,
 		      (LPARAM) (&font_enum), 0);
-  DeleteDC (hdc);
+  return font_enum.list;
 }
 
+static void
+mswindows_create_font_variant (Lisp_Font_Instance* f,
+			       int under, int strike)
+{
+  /* Cannot GC */
+
+  LOGFONT lf;
+  HFONT hfont;
+
+  assert (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) == NULL);
+
+  if (GetObject (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0),
+		 sizeof (lf), (void*) &lf) == 0)
+    {
+      hfont = MSWINDOWS_BAD_HFONT;
+    }
+  else
+    {
+      lf.lfUnderline = under;
+      lf.lfStrikeOut = strike;
+
+      hfont = CreateFontIndirect (&lf);
+      if (hfont == NULL)
+	hfont = MSWINDOWS_BAD_HFONT;
+    }
+
+  FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) = hfont;
+}
+
+HFONT
+mswindows_get_hfont (Lisp_Font_Instance* f,
+		     int under, int strike)
+{
+  /* Cannot GC */
+  HFONT hfont;
+
+  if (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) == NULL)
+    mswindows_create_font_variant (f, under, strike);
+
+  assert (FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike) != NULL);
+
+  hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, under, strike);
+
+  /* If strikeout/underline variant of the font could not be
+     created, then use the base version of the font */
+  if (hfont == MSWINDOWS_BAD_HFONT)
+    hfont = FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f, 0, 0);
+
+  assert (hfont != NULL && hfont != MSWINDOWS_BAD_HFONT);
+
+  return hfont;
+}
 
 /************************************************************************/
 /*                               methods                                */
 /************************************************************************/
 
 static int
-mswindows_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
+mswindows_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name,
 			       Lisp_Object device, Error_behavior errb)
 {
   CONST char *extname;
   COLORREF color;
 
-  GET_C_STRING_CTEXT_DATA_ALLOCA (name, extname);
+  TO_EXTERNAL_FORMAT (LISP_STRING, name,
+		      C_STRING_ALLOCA, extname,
+		      Qctext);
   color = mswindows_string_to_color(extname);
   if (color != -1)
     {
@@ -1067,15 +1106,15 @@
 
 #if 0
 static void
-mswindows_mark_color_instance (struct Lisp_Color_Instance *c)
+mswindows_mark_color_instance (Lisp_Color_Instance *c)
 {
 }
 #endif
 
 static void
-mswindows_print_color_instance (struct Lisp_Color_Instance *c,
-			  Lisp_Object printcharfun,
-			  int escapeflag)
+mswindows_print_color_instance (Lisp_Color_Instance *c,
+				Lisp_Object printcharfun,
+				int escapeflag)
 {
   char buf[32];
   COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c);
@@ -1085,7 +1124,7 @@
 }
 
 static void
-mswindows_finalize_color_instance (struct Lisp_Color_Instance *c)
+mswindows_finalize_color_instance (Lisp_Color_Instance *c)
 {
   if (c->data)
     {
@@ -1095,21 +1134,21 @@
 }
 
 static int
-mswindows_color_instance_equal (struct Lisp_Color_Instance *c1,
-			  struct Lisp_Color_Instance *c2,
-			  int depth)
+mswindows_color_instance_equal (Lisp_Color_Instance *c1,
+				Lisp_Color_Instance *c2,
+				int depth)
 {
   return (COLOR_INSTANCE_MSWINDOWS_COLOR(c1) == COLOR_INSTANCE_MSWINDOWS_COLOR(c2));
 }
 
 static unsigned long
-mswindows_color_instance_hash (struct Lisp_Color_Instance *c, int depth)
+mswindows_color_instance_hash (Lisp_Color_Instance *c, int depth)
 {
   return (unsigned long) COLOR_INSTANCE_MSWINDOWS_COLOR(c);
 }
 
 static Lisp_Object
-mswindows_color_instance_rgb_components (struct Lisp_Color_Instance *c)
+mswindows_color_instance_rgb_components (Lisp_Color_Instance *c)
 {
   COLORREF color = COLOR_INSTANCE_MSWINDOWS_COLOR (c);
   return list3 (make_int (GetRValue (color) * 257),
@@ -1122,26 +1161,25 @@
 {
   CONST char *extname;
 
-  GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname);
+  TO_EXTERNAL_FORMAT (LISP_STRING, color,
+		      C_STRING_ALLOCA, extname,
+		      Qctext);
   return (mswindows_string_to_color(extname)!=-1);
 }
 
 
 
 static void
-mswindows_finalize_font_instance (struct Lisp_Font_Instance *f)
-{
-  if (f->data)
-    {
-      DeleteObject(f->data);
-      f->data=0;
-    }
-}
+mswindows_finalize_font_instance (Lisp_Font_Instance *f);
 
-
+/*
+ * This is a work horse for both mswindows_initialize_font_instanc and
+ * msprinter_initialize_font_instance.
+ */
 static int
-mswindows_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name,
-				    Lisp_Object device, Error_behavior errb)
+initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name,
+			  Lisp_Object device_font_list, HDC hdc,
+			  Error_behavior errb)
 {
   CONST char *extname;
   LOGFONT logfont;
@@ -1150,8 +1188,7 @@
   char fontname[LF_FACESIZE], weight[LF_FACESIZE], *style, points[8];
   char effects[LF_FACESIZE], charset[LF_FACESIZE];
   char *c;
-  HDC hdc;
-  HFONT holdfont;
+  HFONT hfont, holdfont;
   TEXTMETRIC metrics;
 
   extname = XSTRING_DATA (name);
@@ -1255,7 +1292,7 @@
     }
 
   /* Formula for pointsize->height from LOGFONT docs in MSVC5 Platform SDK */
-  logfont.lfHeight = -MulDiv(pt, DEVICE_MSWINDOWS_LOGPIXELSY (XDEVICE (device)), 72);
+  logfont.lfHeight = -MulDiv(pt, GetDeviceCaps (hdc, LOGPIXELSY), 72);
   logfont.lfWidth = 0;
 
   /* Effects */
@@ -1353,85 +1390,140 @@
   /* Default to monospaced if the specified fontname doesn't exist. */
   logfont.lfPitchAndFamily = FF_MODERN;
 
-  /* Windows will silently substitute a default font if the fontname 
-   * specifies a non-existent font. So we check the font against the device's
-   * list of font patterns to make sure that at least one of them matches. */
-  {
-    struct mswindows_font_enum *fontlist;
-    char truename[MSW_FONTSIZE];
-    int done = 0;
-    
-    sprintf (truename, "%s:%s:%d:%s:%s", fontname, weight, pt, effects, charset);
-    fontlist = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device));
-    while (fontlist && !done)
-      {
-        done = match_font (fontlist->fontname, truename, NULL);
-        fontlist = fontlist->next;
-      }
-    if (!done)
-      {
-	maybe_signal_simple_error ("No matching font", name, Qfont, errb);
-	return 0;
-      }
-  }
+  /* Windows will silently substitute a default font if the fontname
+   specifies a non-existent font. So we check the font against the
+   device's list of font patterns to make sure that at least one of
+   them matches.
+
+   Personally, I do not like the idea - it is better to come out with
+   some font than completely without one. The diversity of printer
+   fonts is much greater than that of screen font. We can tread on
+   that. -- kkm. */
+
+  if (!NILP (device_font_list))
+    {
+      Lisp_Object fonttail;
+      char truename[MSW_FONTSIZE];
 
-  if ((f->data = CreateFontIndirect(&logfont)) == NULL)
+      sprintf (truename, "%s:%s:%d:%s:%s", fontname, weight, pt, effects, charset);
+      LIST_LOOP (fonttail, device_font_list)
+	{
+	  if (match_font (XSTRING_DATA (XCAR (fonttail)), truename, NULL))
+	    break;
+	}
+      if (NILP (fonttail))
+	{
+	  maybe_signal_simple_error ("No matching font", name, Qfont, errb);
+	  return 0;
+	}
+    }
+
+  if ((hfont = CreateFontIndirect(&logfont)) == NULL)
   {
     maybe_signal_simple_error ("Couldn't create font", name, Qfont, errb);
     return 0;
   }
 
-  hdc = CreateCompatibleDC (NULL);
-  if (hdc)
+  f->data = xnew_and_zero (struct mswindows_font_instance_data);
+  FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f,0,0) = hfont;
+  
+  holdfont = SelectObject(hdc, hfont);
+  if (!holdfont)
     {
-      holdfont = SelectObject(hdc, f->data);
-      if (holdfont)
+      mswindows_finalize_font_instance (f);
+      maybe_signal_simple_error ("Couldn't map font", name, Qfont, errb);
+      return 0;
+    }
+
+  GetTextMetrics (hdc, &metrics);
+  SelectObject(hdc, holdfont);
+
+  f->width = (unsigned short) metrics.tmAveCharWidth;
+  f->height = (unsigned short) metrics.tmHeight;
+  /* Font variant metrics hack. The problem is that in Windows
+     some underlined fonts have the descent of one pixel more
+     than their non-underlined counterparts.  Font variants
+     though are assumed to have identical metrics. Lowering
+     the font's baseline one pixel down cures the problem, and
+     is visually undetectable. - kkm */
+  f->ascent = (unsigned short) metrics.tmAscent - 1;
+  f->descent = (unsigned short) metrics.tmDescent + 1;
+  f->proportional_p = (metrics.tmPitchAndFamily & TMPF_FIXED_PITCH);
+
+  return 1;
+}
+
+static int
+mswindows_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name,
+				    Lisp_Object device, Error_behavior errb)
+{
+  HDC hdc = CreateCompatibleDC (NULL);
+  Lisp_Object font_list = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device));
+  int res = initialize_font_instance (f, name, font_list, hdc, errb);
+  DeleteDC (hdc);
+  return res;
+}
+
+static int
+msprinter_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object name,
+				    Lisp_Object device, Error_behavior errb)
+{
+  HDC hdc = DEVICE_MSPRINTER_HDC (XDEVICE (device));
+  Lisp_Object font_list = DEVICE_MSPRINTER_FONTLIST (XDEVICE (device));
+  return initialize_font_instance (f, name, font_list, hdc, errb);
+}
+
+static void
+mswindows_finalize_font_instance (Lisp_Font_Instance *f)
+{
+  int i;
+
+  if (f->data)
+    {
+      for (i = 0; i < MSWINDOWS_NUM_FONT_VARIANTS; i++)
 	{
-	  GetTextMetrics (hdc, &metrics);
-	  SelectObject(hdc, holdfont);
-	  DeleteDC (hdc);
-	  f->width = (unsigned short) metrics.tmAveCharWidth;
-	  f->height = (unsigned short) metrics.tmHeight;
-	  f->ascent = (unsigned short) metrics.tmAscent;
-	  f->descent = (unsigned short) metrics.tmDescent;
-	  f->proportional_p = (metrics.tmPitchAndFamily & TMPF_FIXED_PITCH);
-	  return 1;
+	  if (FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i) != NULL
+	      && FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i) != MSWINDOWS_BAD_HFONT)
+	    DeleteObject (FONT_INSTANCE_MSWINDOWS_HFONT_I (f, i));
 	}
-      DeleteDC (hdc);
-    }
-  mswindows_finalize_font_instance (f);
-  maybe_signal_simple_error ("Couldn't map font", name, Qfont, errb);
-  return 0;
+
+      xfree (f->data);
+      f->data = 0;
+   }
 }
 
 #if 0
 static void
-mswindows_mark_font_instance (struct Lisp_Font_Instance *f)
+mswindows_mark_font_instance (Lisp_Font_Instance *f)
 {
 }
 #endif
 
 static void
-mswindows_print_font_instance (struct Lisp_Font_Instance *f,
-			 Lisp_Object printcharfun,
-			 int escapeflag)
+mswindows_print_font_instance (Lisp_Font_Instance *f,
+			       Lisp_Object printcharfun,
+			       int escapeflag)
 {
+  char buf[10];
+  sprintf (buf, " 0x%lx", 
+	   (unsigned long)FONT_INSTANCE_MSWINDOWS_HFONT_VARIANT (f,0,0));
+  write_c_string (buf, printcharfun);
 }
 
 static Lisp_Object
 mswindows_list_fonts (Lisp_Object pattern, Lisp_Object device)
 {
-  Lisp_Object result = Qnil;
-  struct mswindows_font_enum *fontlist;
-  char fontname[MSW_FONTSIZE], *extpattern;
+  Lisp_Object fonttail, result = Qnil;
+  char *extpattern;
 
-  GET_C_STRING_CTEXT_DATA_ALLOCA (pattern, extpattern);
-  fontlist = DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device));
-  while (fontlist)
+  TO_EXTERNAL_FORMAT (LISP_STRING, pattern,
+		      C_STRING_ALLOCA, extpattern,
+		      Qctext);
+
+  LIST_LOOP (fonttail, DEVICE_MSWINDOWS_FONTLIST (XDEVICE (device)))
     {
-      if (match_font (fontlist->fontname, extpattern, fontname))
-	 result = Fcons (build_string (fontname), result);
-      fontlist = fontlist->next;
+      if (match_font (XSTRING_DATA (XCAR (fonttail)), extpattern, NULL))
+	result = Fcons (XCAR (fonttail), result);
     }
 
   return Fnreverse (result);
@@ -1448,7 +1540,7 @@
  * Missing parts of the font spec should be filled in with these values:
  *	Courier New:Regular:10::Western */
 static Lisp_Object
-mswindows_font_instance_truename (struct Lisp_Font_Instance *f, Error_behavior errb)
+mswindows_font_instance_truename (Lisp_Font_Instance *f, Error_behavior errb)
 {
   int nsep=0;
   char *name = (char *) XSTRING_DATA (f->name);
@@ -1479,7 +1571,7 @@
     default:;
     }
   
-  return build_ext_string (extname, FORMAT_OS);
+  return build_ext_string (extname, Qnative);
 }
 
 #ifdef MULE
@@ -1562,6 +1654,29 @@
   CONSOLE_HAS_METHOD (mswindows, font_spec_matches_charset);
   CONSOLE_HAS_METHOD (mswindows, find_charset_font);
 #endif
+
+  /* Printer methods - delegate most to windows methods,
+     since graphical objects behave the same way. */
+
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, initialize_color_instance);
+/*  CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_color_instance); */
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_color_instance);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_color_instance);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_equal);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_hash);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, color_instance_rgb_components);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, valid_color_name_p);
+
+  CONSOLE_HAS_METHOD (msprinter, initialize_font_instance);
+/*  CONSOLE_INHERITS_METHOD (msprinter, mswindows, mark_font_instance); */
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, print_font_instance);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, finalize_font_instance);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_instance_truename); 
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, list_fonts);
+#ifdef MULE
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, font_spec_matches_charset);
+  CONSOLE_INHERITS_METHOD (msprinter, mswindows, find_charset_font);
+#endif
 }
 
 void