Extract better font information from the GTK >= 3.2 font chooser.

* gtkutil.c (xg_get_font): Rename from xg_get_font_name.  When
using the new font chooser, use gtk_font_chooser_get_font_desc to
extract the font descriptor instead of just the font name.  In
that case, return a font spec instead of a string.
(x_last_font_name): Move to this file from xfns.c.

* xfns.c (Fx_select_font): The return value can also be a font
spec.  Move x_last_font_name management to gtkutil.c.

* xfaces.c: Make font weight and style symbols non-static.

* lisp/frame.el (set-frame-font): Accept font objects.

5 files changed, 130 insertions, 51 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index adf719d7efd..dc08d002021 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,16 @@
+2012-08-15  Chong Yidong  <cyd@gnu.org>
+
+        * gtkutil.c (xg_get_font): Rename from xg_get_font_name.  When
+        using the new font chooser, use gtk_font_chooser_get_font_desc to
+        extract the font descriptor instead of just the font name.  In
+        that case, return a font spec instead of a string.
+        (x_last_font_name): Move to this file from xfns.c.
+
+        * xfns.c (Fx_select_font): The return value can also be a font
+        spec.  Move x_last_font_name management to gtkutil.c.
+
+        * xfaces.c: Make font weight and style symbols non-static.
+
 2012-08-15  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * minibuf.c (read_minibuf): Ignore caller's inhibit-read-only
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 55f5639fdb7..2c9a1377dca 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -24,6 +24,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <signal.h>
 #include <stdio.h>
 #include <setjmp.h>
+#include <ctype.h>
 #include "lisp.h"
 #include "xterm.h"
 #include "blockinput.h"
@@ -75,16 +76,16 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #define remove_submenu(w) gtk_menu_item_remove_submenu ((w))
 #endif
 
-#if GTK_MAJOR_VERSION < 3 || \
-  (GTK_MAJOR_VERSION == 3 && GTK_MINOR_VERSION < 2)
+#if GTK_MAJOR_VERSION > 3 || (GTK_MAJOR_VERSION == 3 && GTK_MINOR_VERSION >= 2)
+#define USE_NEW_GTK_FONT_CHOOSER 1
+#else
+#define USE_NEW_GTK_FONT_CHOOSER 0
 #define gtk_font_chooser_dialog_new(x, y) \
   gtk_font_selection_dialog_new (x)
 #undef GTK_FONT_CHOOSER
 #define GTK_FONT_CHOOSER(x) GTK_FONT_SELECTION_DIALOG (x)
 #define  gtk_font_chooser_set_font(x, y) \
   gtk_font_selection_dialog_set_font_name (x, y)
-#define gtk_font_chooser_get_font(x) \
-  gtk_font_selection_dialog_get_font_name (x)
 #endif
 
 #ifndef HAVE_GTK3
@@ -2007,7 +2008,39 @@ xg_get_file_name (FRAME_PTR f,
   return fn;
 }
 
+/***********************************************************************
+                      GTK font chooser
+ ***********************************************************************/
+
 #ifdef HAVE_FREETYPE
+
+#if USE_NEW_GTK_FONT_CHOOSER
+
+extern Lisp_Object Qnormal;
+extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold;
+extern Lisp_Object Qbold, Qextra_bold, Qultra_bold;
+extern Lisp_Object Qoblique, Qitalic;
+
+#define XG_WEIGHT_TO_SYMBOL(w)                  \
+  (w <= PANGO_WEIGHT_THIN ? Qextra_light        \
+   : w <= PANGO_WEIGHT_ULTRALIGHT ? Qlight      \
+   : w <= PANGO_WEIGHT_LIGHT ? Qsemi_light      \
+   : w < PANGO_WEIGHT_MEDIUM ? Qnormal          \
+   : w <= PANGO_WEIGHT_SEMIBOLD ? Qsemi_bold    \
+   : w <= PANGO_WEIGHT_BOLD ? Qbold             \
+   : w <= PANGO_WEIGHT_HEAVY ? Qextra_bold      \
+   : Qultra_bold)
+
+#define XG_STYLE_TO_SYMBOL(s)                   \
+  (s == PANGO_STYLE_OBLIQUE ? Qoblique          \
+   : s == PANGO_STYLE_ITALIC ? Qitalic          \
+   : Qnormal)
+
+#endif /* USE_NEW_GTK_FONT_CHOOSER */
+
+
+static char *x_last_font_name;
+
 /* Pop up a GTK font selector and return the name of the font the user
    selects, as a C string.  The returned font name follows GTK's own
    format:
@@ -2017,12 +2050,12 @@ xg_get_file_name (FRAME_PTR f,
    This can be parsed using font_parse_fcname in font.c.
    DEFAULT_NAME, if non-zero, is the default font name.  */
 
-char *
-xg_get_font_name (FRAME_PTR f, const char *default_name)
+Lisp_Object
+xg_get_font (FRAME_PTR f, const char *default_name)
 {
   GtkWidget *w;
-  char *fontname = NULL;
   int done = 0;
+  Lisp_Object font = Qnil;
 
 #if defined (HAVE_PTHREAD) && defined (__SIGRTMIN)
   sigblock (sigmask (__SIGRTMIN));
@@ -2031,12 +2064,26 @@ xg_get_font_name (FRAME_PTR f, const char *default_name)
   w = gtk_font_chooser_dialog_new
     ("Pick a font", GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
 
-  if (!default_name)
-    default_name = "Monospace 10";
+  if (default_name)
+    {
+      /* Convert fontconfig names to Gtk names, i.e. remove - before
+         number */
+      char *p = strrchr (default_name, '-');
+      if (p)
+        {
+          char *ep = p+1;
+          while (isdigit (*ep))
+            ++ep;
+          if (*ep == '\0') *p = ' ';
+        }
+    }
+  else if (x_last_font_name)
+    default_name = x_last_font_name;
 
-  gtk_font_chooser_set_font (GTK_FONT_CHOOSER (w), default_name);
-  gtk_widget_set_name (w, "emacs-fontdialog");
+  if (default_name)
+    gtk_font_chooser_set_font (GTK_FONT_CHOOSER (w), default_name);
 
+  gtk_widget_set_name (w, "emacs-fontdialog");
   done = xg_dialog_run (f, w);
 
 #if defined (HAVE_PTHREAD) && defined (__SIGRTMIN)
@@ -2044,10 +2091,55 @@ xg_get_font_name (FRAME_PTR f, const char *default_name)
 #endif
 
   if (done == GTK_RESPONSE_OK)
-    fontname = gtk_font_chooser_get_font (GTK_FONT_CHOOSER (w));
+    {
+#if USE_NEW_GTK_FONT_CHOOSER
+      /* Use the GTK3 font chooser.  */
+      PangoFontDescription *desc
+        = gtk_font_chooser_get_font_desc (GTK_FONT_CHOOSER (w));
+
+      if (desc)
+        {
+          Lisp_Object args[8];
+          const char *name   = pango_font_description_get_family (desc);
+          PangoWeight weight = pango_font_description_get_weight (desc);
+          PangoStyle   style = pango_font_description_get_style (desc);
+
+          args[0] = QCname;
+          args[1] = build_string (name);
+
+          args[2] = QCsize;
+          args[3] = make_float (((double) pango_font_description_get_size (desc))
+                                / PANGO_SCALE);
+
+          args[4] = QCweight;
+          args[5] = XG_WEIGHT_TO_SYMBOL (weight);
+
+          args[6] = QCslant;
+          args[7] = XG_STYLE_TO_SYMBOL (style);
+
+          font = Ffont_spec (8, args);
+
+          pango_font_description_free (desc);
+          xfree (x_last_font_name);
+          x_last_font_name = xstrdup (name);
+        }
+
+#else /* Use old font selector, which just returns the font name.  */
+
+      char *font_name
+        = gtk_font_selection_dialog_get_font_name (GTK_FONT_CHOOSER (w));
+
+      if (font_name)
+        {
+          font = build_string (font_name);
+          g_free (x_last_font_name);
+          x_last_font_name = font_name;
+        }
+#endif /* USE_NEW_GTK_FONT_CHOOSER */
+    }
 
   gtk_widget_destroy (w);
-  return fontname;
+  return font;
 }
 #endif /* HAVE_FREETYPE */
 
@@ -4928,6 +5020,8 @@ xg_initialize (void)
   gtk_binding_entry_add_signal (binding_set, GDK_KEY_g, GDK_CONTROL_MASK,
                                 "cancel", 0);
   update_theme_scrollbar_width ();
+
+  x_last_font_name = NULL;
 }
 
 #endif /* USE_GTK */
diff --git a/src/gtkutil.h b/src/gtkutil.h
index 94c1a1d96ad..462e879d3e7 100644
--- a/src/gtkutil.h
+++ b/src/gtkutil.h
@@ -86,7 +86,7 @@ extern char *xg_get_file_name (FRAME_PTR f,
                                int mustmatch_p,
                                int only_dir_p);
 
-extern char *xg_get_font_name (FRAME_PTR f, const char *);
+extern Lisp_Object xg_get_font (FRAME_PTR f, const char *);
 
 extern GtkWidget *xg_create_widget (const char *type,
                                     const char *name,
diff --git a/src/xfaces.c b/src/xfaces.c
index ea73001f758..ed372c6b419 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -319,9 +319,9 @@ static Lisp_Object QCfontset;
 Lisp_Object Qnormal;
 Lisp_Object Qbold;
 static Lisp_Object Qline, Qwave;
-static Lisp_Object Qultra_light, Qextra_light, Qlight;
-static Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
-static Lisp_Object Qoblique, Qreverse_oblique, Qreverse_italic;
+Lisp_Object Qultra_light, Qextra_light, Qlight;
+Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold;
+Lisp_Object Qoblique, Qreverse_oblique, Qreverse_italic;
 Lisp_Object Qitalic;
 static Lisp_Object Qultra_condensed, Qextra_condensed;
 Lisp_Object Qcondensed;
diff --git a/src/xfns.c b/src/xfns.c
index 3242af937c9..2e7334b7d71 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -21,7 +21,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <stdio.h>
 #include <math.h>
 #include <setjmp.h>
-#include <ctype.h>
 #include <unistd.h>
 
 /* This makes the fields of a Display accessible, in Xlib header files.  */
@@ -140,10 +139,6 @@ static ptrdiff_t image_cache_refcount;
 static int dpyinfo_refcount;
 #endif
 
-#if defined (USE_GTK) && defined (HAVE_FREETYPE)
-static char *x_last_font_name;
-#endif
-
 static struct x_display_info *x_display_info_for_name (Lisp_Object);
 
 
@@ -5583,14 +5578,15 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories.  */)
 #ifdef HAVE_FREETYPE
 
 DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0,
-       doc: /* Read a font name using a GTK font selection dialog.
-Return a GTK-style font string corresponding to the selection.
+       doc: /* Read a font using a GTK dialog.
+Return either a font spec (for GTK versions >= 3.2) or a string
+containing a GTK-style font name.
 
-If FRAME is omitted or nil, it defaults to the selected frame. */)
+FRAME is the frame on which to pop up the font chooser.  If omitted or
+nil, it defaults to the selected frame. */)
   (Lisp_Object frame, Lisp_Object ignored)
 {
   FRAME_PTR f = check_x_frame (frame);
-  char *name;
   Lisp_Object font;
   Lisp_Object font_param;
   char *default_name = NULL;
@@ -5621,32 +5617,9 @@ If FRAME is omitted or nil, it defaults to the selected frame. */)
         default_name = xstrdup (SSDATA (font_param));
     }
 
-  if (default_name == NULL && x_last_font_name != NULL)
-    default_name = xstrdup (x_last_font_name);
-
-  /* Convert fontconfig names to Gtk names, i.e. remove - before number */
-  if (default_name)
-    {
-      char *p = strrchr (default_name, '-');
-      if (p)
-        {
-          char *ep = p+1;
-          while (isdigit (*ep))
-            ++ep;
-          if (*ep == '\0') *p = ' ';
-        }
-    }
-
-  name = xg_get_font_name (f, default_name);
+  font = xg_get_font (f, default_name);
   xfree (default_name);
 
-  if (name)
-    {
-      font = build_string (name);
-      g_free (x_last_font_name);
-      x_last_font_name = name;
-    }
-
   UNBLOCK_INPUT;
 
   if (NILP (font))
@@ -6011,7 +5984,6 @@ When using Gtk+ tooltips, the tooltip face is not used.  */);
 
 #if defined (USE_GTK) && defined (HAVE_FREETYPE)
   defsubr (&Sx_select_font);
-  x_last_font_name = NULL;
 #endif
 }