[Emacs-diffs] /srv/bzr/emacs/trunk r109626: Extract better font information from the GTK >= 3.2 font chooser.

[Chong Yidong]

------------------------------------------------------------
revno: 109626
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Wed 2012-08-15 15:58:34 +0800
message:
  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.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/frame.el
  src/ChangeLog
  src/gtkutil.c
  src/gtkutil.h
  src/xfaces.c
  src/xfns.c

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2012-08-13 14:12:47 +0000
+++ b/etc/NEWS  2012-08-15 07:58:34 +0000
@@ -506,6 +506,10 @@
 
 * 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.

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-08-15 03:46:47 +0000
+++ b/lisp/ChangeLog    2012-08-15 07:58:34 +0000
@@ -1,3 +1,7 @@
+2012-08-15  Chong Yidong  <address@hidden>
+
+       * frame.el (set-frame-font): Accept font objects.
+
 2012-08-15  Stefan Monnier  <address@hidden>
 
        * textmodes/tex-mode.el (tex-insert-quote): ~ is a space (bug#12137).

=== modified file 'lisp/frame.el'
--- a/lisp/frame.el     2012-07-10 11:51:54 +0000
+++ b/lisp/frame.el     2012-08-15 07:58:34 +0000
@@ -1051,10 +1051,12 @@
 
 (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 @@
                                  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 @@
          ;; (: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

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2012-08-15 04:02:14 +0000
+++ b/src/ChangeLog     2012-08-15 07:58:34 +0000
@@ -1,3 +1,16 @@
+2012-08-15  Chong Yidong  <address@hidden>
+
+       * 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  <address@hidden>
 
        * minibuf.c (read_minibuf): Ignore caller's inhibit-read-only

=== modified file 'src/gtkutil.c'
--- a/src/gtkutil.c     2012-08-14 08:06:07 +0000
+++ b/src/gtkutil.c     2012-08-15 07:58:34 +0000
@@ -24,6 +24,7 @@
 #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 @@
 #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 @@
   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 @@
    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 @@
   w = gtk_font_chooser_dialog_new
     ("Pick a font", GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
 
-  if (!default_name)
-    default_name = "Monospace 10";
-
-  gtk_font_chooser_set_font (GTK_FONT_CHOOSER (w), default_name);
+  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;
+
+  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 @@
 #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 @@
   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 */

=== modified file 'src/gtkutil.h'
--- a/src/gtkutil.h     2012-07-16 03:36:46 +0000
+++ b/src/gtkutil.h     2012-08-15 07:58:34 +0000
@@ -86,7 +86,7 @@
                                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,

=== modified file 'src/xfaces.c'
--- a/src/xfaces.c      2012-08-07 07:33:18 +0000
+++ b/src/xfaces.c      2012-08-15 07:58:34 +0000
@@ -319,9 +319,9 @@
 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;

=== modified file 'src/xfns.c'
--- a/src/xfns.c        2012-08-14 08:44:24 +0000
+++ b/src/xfns.c        2012-08-15 07:58:34 +0000
@@ -21,7 +21,6 @@
 #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 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 @@
 #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 @@
         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 @@
 
 #if defined (USE_GTK) && defined (HAVE_FREETYPE)
   defsubr (&Sx_select_font);
-  x_last_font_name = NULL;
 #endif
 }