* w32fns.c (Fw32_select_font): Removed old font API function.

* w32font.c (logfont_to_fcname): New function.
(Fx_select_font): New font dialog function compatible with
GTK/fontconfig version.

* font.c (font_style_symbolic_from_value): New function.
(font_style_symbolic): Use it.

* font.h (font_style_symbolic_from_value): Declare new function.

src/ChangeLog

+2008-06-13  Jason Rumney  <jasonr@gnu.org>
+
+        * w32fns.c (Fw32_select_font): Removed old font API function.
+
+        * w32font.c (logfont_to_fcname): New function.
+        (Fx_select_font): New font dialog function compatible with
+        GTK/fontconfig version.
+
+        * font.c (font_style_symbolic_from_value): New function.
+        (font_style_symbolic): Use it.
+
+        * font.h (font_style_symbolic_from_value): Declare new function.
+
 2008-06-13  Juanma Barranquero  <lekktu@gmail.com>
 
 	* font.c (syms_of_font) <font-weight-table, font-slant-table>:
@@ -39,7 +52,6 @@
 	(font_update_lface): Don't parse "foundry-family" form here.
 	Handle FONT_FOUNDRY_INDEX.
 	(font_find_for_lface): Likewise.  Handle alternate families here.
-	If registry is nil, try iso8859-1 and ascii-0.
 	(font_open_for_lface): Pay attention to size in ENTITY.
 	(font_open_by_name): Simplify by calling font_load_for_lface.
 	(free_font_driver_list): Delete it.

src/font.c

@@ -355,12 +355,11 @@ font_style_to_value (prop, val, noerror)
 }
 
 Lisp_Object
-font_style_symbolic (font, prop, for_face)
-     Lisp_Object font;
+font_style_symbolic_from_value (prop, val, for_face)
      enum font_property_index prop;
+     Lisp_Object val;
      int for_face;
 {
-  Lisp_Object val = AREF (font, prop);
   Lisp_Object table, elt;
   int i;
 
@@ -371,7 +370,17 @@ font_style_symbolic (font, prop, for_face)
   font_assert (((i >> 4) & 0xF) < ASIZE (table));
   elt = AREF (table, ((i >> 4) & 0xF));
   font_assert ((i & 0xF) + 1 < ASIZE (elt));
-  return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
+  return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));  
+}
+
+Lisp_Object
+font_style_symbolic (font, prop, for_face)
+     Lisp_Object font;
+     enum font_property_index prop;
+     int for_face;
+{
+  Lisp_Object val = AREF (font, prop);
+  return font_style_symbolic_from_value (prop, val, for_face);
 }
 
 extern Lisp_Object Vface_alternative_font_family_alist;

src/font.h

@@ -776,7 +776,11 @@ extern int font_style_to_value P_ ((enum font_property_index prop,
 extern Lisp_Object font_style_symbolic P_ ((Lisp_Object font,
 					    enum font_property_index prop,
 					    int for_face));
-
+extern Lisp_Object font_style_symbolic_from_value
+                      P_ ((enum font_property_index prop,
+                           Lisp_Object val,
+                           int for_face));
+                           
 extern int font_match_p P_ ((Lisp_Object spec, Lisp_Object entity));
 extern Lisp_Object font_list_entities P_ ((Lisp_Object frame,
 					   Lisp_Object spec));

src/w32fns.c

@@ -8195,62 +8195,6 @@ If ONLY-DIR-P is non-nil, the user can only select directories.  */)
                          w32 specialized functions
  ***********************************************************************/
 
-DEFUN ("w32-select-font", Fw32_select_font, Sw32_select_font, 0, 2, 0,
-       doc: /* Select a font for the named FRAME using the W32 font dialog.
-Return an X-style font string corresponding to the selection.
-
-If FRAME is omitted or nil, it defaults to the selected frame.
-If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
-in the font selection dialog. */)
-  (frame, include_proportional)
-     Lisp_Object frame, include_proportional;
-{
-  FRAME_PTR f = check_x_frame (frame);
-  CHOOSEFONT cf;
-  LOGFONT lf;
-  TEXTMETRIC tm;
-  HDC hdc;
-  HANDLE oldobj;
-  char buf[100];
-
-  bzero (&cf, sizeof (cf));
-  bzero (&lf, sizeof (lf));
-
-  cf.lStructSize = sizeof (cf);
-  cf.hwndOwner = FRAME_W32_WINDOW (f);
-  cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
-
-  /* Unless include_proportional is non-nil, limit the selection to
-     monospaced fonts.  */
-  if (NILP (include_proportional))
-    cf.Flags |= CF_FIXEDPITCHONLY;
-
-  cf.lpLogFont = &lf;
-
-  /* Initialize as much of the font details as we can from the current
-     default font.  */
-  hdc = GetDC (FRAME_W32_WINDOW (f));
-  oldobj = SelectObject (hdc, FONT_COMPAT (FRAME_FONT (f))->hfont);
-  GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
-  if (GetTextMetrics (hdc, &tm))
-    {
-      lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
-      lf.lfWeight = tm.tmWeight;
-      lf.lfItalic = tm.tmItalic;
-      lf.lfUnderline = tm.tmUnderlined;
-      lf.lfStrikeOut = tm.tmStruckOut;
-      lf.lfCharSet = tm.tmCharSet;
-      cf.Flags |= CF_INITTOLOGFONTSTRUCT;
-    }
-  SelectObject (hdc, oldobj);
-  ReleaseDC (FRAME_W32_WINDOW (f), hdc);
-
-  if (!ChooseFont (&cf) || !w32_to_x_font (&lf, buf, 100, NULL))
-      return Qnil;
-
-  return build_string (buf);
-}
-
 DEFUN ("w32-send-sys-command", Fw32_send_sys_command,
        Sw32_send_sys_command, 1, 2, 0,
        doc: /* Send frame a Windows WM_SYSCOMMAND message of type COMMAND.
@@ -9308,7 +9252,6 @@ versions of Windows) characters.  */);
 
   /* W32 specific functions */
 
-  defsubr (&Sw32_select_font);
   defsubr (&Sw32_define_rgb_color);
   defsubr (&Sw32_default_color_map);
   defsubr (&Sw32_load_color_file);

src/w32font.c

@@ -20,6 +20,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <windows.h>
 #include <math.h>
 #include <ctype.h>
+#include <commdlg.h>
 
 #include "lisp.h"
 #include "w32term.h"
@@ -1861,7 +1862,7 @@ w32font_full_name (font, font_obj, pixel_size, name, nbytes)
   if (outline)
     len += 11; /* -SIZE */
   else
-    len = strlen (font->lfFaceName) + 21;
+    len += 21;
 
   if (font->lfItalic)
     len += 7; /* :italic */
@@ -1911,6 +1912,66 @@ w32font_full_name (font, font_obj, pixel_size, name, nbytes)
   return (p - name);
 }
 
+/* Convert a logfont and point size into a fontconfig style font name.
+   POINTSIZE is in tenths of points.
+   If SIZE indicates the size of buffer FCNAME, into which the font name
+   is written.  If the buffer is not large enough to contain the name,
+   the function returns -1, otherwise it returns the number of bytes
+   written to FCNAME.  */
+static int logfont_to_fcname(font, pointsize, fcname, size)
+     LOGFONT* font;
+     int pointsize;
+     char *fcname;
+     int size;
+{
+  int len, height;
+  char *p = fcname;
+  Lisp_Object weight = Qnil;
+
+  len = strlen (font->lfFaceName) + 2;
+  height = pointsize / 10;
+  while (height /= 10)
+    len++;
+
+  if (pointsize % 10)
+    len += 2;
+
+  if (font->lfItalic)
+    len += 7; /* :italic */
+  if (font->lfWeight && font->lfWeight != FW_NORMAL)
+    {
+      int fc_weight = w32_decode_weight (font->lfWeight);
+      weight = font_style_symbolic_from_value (FONT_WEIGHT_INDEX,
+                                               make_number (fc_weight), 0);
+      len += 8; /* :weight= */
+      if (SYMBOLP (weight))
+        len += SBYTES (SYMBOL_NAME (weight));
+      else
+        {
+          weight = make_number (fc_weight);
+          len++;
+          while (fc_weight /= 10)
+            len++;
+        }
+    }
+
+  if (len > size)
+    return -1;
+
+  p += sprintf (p, "%s-%d", font->lfFaceName, pointsize / 10);
+  if (pointsize % 10)
+    p += sprintf (p, ".%d", pointsize % 10);
+
+  if (font->lfItalic)
+    p += sprintf (p, ":italic");
+
+  if (SYMBOLP (weight) && !NILP (weight))
+    p += sprintf (p, "weight=%s", SDATA (SYMBOL_NAME (weight)));
+  else if (INTEGERP (weight))
+    p += sprintf (p, "weight=%d", XINT (weight));
+
+  return (p - fcname);
+}
 
 static void
 compute_metrics (dc, w32_font, code, metrics)
@@ -1963,6 +2024,63 @@ clear_cached_metrics (w32_font)
     }
 }
 
+DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
+       doc: /* Read a font name using a W32 font selection dialog.
+Return fontconfig style font string corresponding to the selection.
+
+If FRAME is omitted or nil, it defaults to the selected frame.
+If INCLUDE-PROPORTIONAL is non-nil, include proportional fonts
+in the font selection dialog. */)
+  (frame, include_proportional)
+     Lisp_Object frame, include_proportional;
+{
+  FRAME_PTR f = check_x_frame (frame);
+  CHOOSEFONT cf;
+  LOGFONT lf;
+  TEXTMETRIC tm;
+  HDC hdc;
+  HANDLE oldobj;
+  char buf[100];
+
+  bzero (&cf, sizeof (cf));
+  bzero (&lf, sizeof (lf));
+
+  cf.lStructSize = sizeof (cf);
+  cf.hwndOwner = FRAME_W32_WINDOW (f);
+  cf.Flags = CF_FORCEFONTEXIST | CF_SCREENFONTS | CF_NOVERTFONTS;
+
+  /* Unless include_proportional is non-nil, limit the selection to
+     monospaced fonts.  */
+  if (NILP (include_proportional))
+    cf.Flags |= CF_FIXEDPITCHONLY;
+
+  cf.lpLogFont = &lf;
+
+  /* Initialize as much of the font details as we can from the current
+     default font.  */
+  hdc = GetDC (FRAME_W32_WINDOW (f));
+  oldobj = SelectObject (hdc, FONT_COMPAT (FRAME_FONT (f))->hfont);
+  GetTextFace (hdc, LF_FACESIZE, lf.lfFaceName);
+  if (GetTextMetrics (hdc, &tm))
+    {
+      lf.lfHeight = tm.tmInternalLeading - tm.tmHeight;
+      lf.lfWeight = tm.tmWeight;
+      lf.lfItalic = tm.tmItalic;
+      lf.lfUnderline = tm.tmUnderlined;
+      lf.lfStrikeOut = tm.tmStruckOut;
+      lf.lfCharSet = tm.tmCharSet;
+      cf.Flags |= CF_INITTOLOGFONTSTRUCT;
+    }
+  SelectObject (hdc, oldobj);
+  ReleaseDC (FRAME_W32_WINDOW (f), hdc);
+
+  if (!ChooseFont (&cf)
+      || logfont_to_fcname (&lf, cf.iPointSize, buf, 100) < 0)
+    return Qnil;
+
+  return build_string (buf);
+}
+
 struct font_driver w32font_driver =
   {
     0, /* Qgdi */
@@ -2100,6 +2218,8 @@ syms_of_w32font ()
   DEFSYM (Qtifinagh, "tifinagh");
   DEFSYM (Qugaritic, "ugaritic");
 
+  defsubr (&Sx_select_font);
+
   w32font_driver.type = Qgdi;
   register_font_driver (&w32font_driver, NULL);
 }