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.

8 files changed, 145 insertions, 56 deletions

diff --git a/etc/NEWS b/etc/NEWS
index af5577f1066..5b0291a8f05 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -506,6 +506,10 @@ inefficiency, and not namespace-clean.
 
 * Incompatible Lisp Changes in Emacs 24.2
 
+** The function `x-select-font' can return a font spec, instead of a
+font name as a string.  Whether it returns a font spec or a font name
+depends on the graphical library.
+
 ** If the NEWTEXT arg to `replace-match' contains a substring "\?",
 that substring is inserted literally even if the LITERAL arg is
 non-nil, instead of causing an error to be signaled.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7bb7c4c3c1c..cf8e3ee2181 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2012-08-15  Chong Yidong  <cyd@gnu.org>
+
+	* frame.el (set-frame-font): Accept font objects.
+
 2012-08-15  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* textmodes/tex-mode.el (tex-insert-quote): ~ is a space (bug#12137).
diff --git a/lisp/frame.el b/lisp/frame.el
index 778028390e7..e905e66a5f9 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1051,10 +1051,12 @@ If FRAME is omitted, describe the currently selected frame."
 
 (define-obsolete-function-alias 'set-default-font 'set-frame-font "23.1")
 
-(defun set-frame-font (font-name &optional keep-size frames)
-  "Set the default font to FONT-NAME.
+(defun set-frame-font (font &optional keep-size frames)
+  "Set the default font to FONT.
 When called interactively, prompt for the name of a font, and use
-that font on the selected frame.
+that font on the selected frame.  When called from Lisp, FONT
+should be a font name (a string), a font object, font entity, or
+font spec.
 
 If KEEP-SIZE is nil, keep the number of frame lines and columns
 fixed.  If KEEP-SIZE is non-nil (or with a prefix argument), try
@@ -1076,7 +1078,7 @@ this session\", so that the font is applied to future frames."
                                  nil nil nil nil
                                  (frame-parameter nil 'font))))
      (list font current-prefix-arg nil)))
-  (when (stringp font-name)
+  (when (or (stringp font) (fontp font))
     (let* ((this-frame (selected-frame))
 	   ;; FRAMES nil means affect the selected frame.
 	   (frame-list (cond ((null frames)
@@ -1097,7 +1099,7 @@ this session\", so that the font is applied to future frames."
 	  ;; (:width, :weight, etc.) so reset them too (Bug#2476).
 	  (set-face-attribute 'default f
 			      :width 'normal :weight 'normal
-			      :slant 'normal :font font-name)
+			      :slant 'normal :font font)
 	  (if keep-size
 	      (modify-frame-parameters
 	       f
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
 }