]> code.delx.au - gnu-emacs/blobdiff - src/font.c
Merge from emacs-24; up to 2014-07-21T01:34:03Z!monnier@iro.umontreal.ca
[gnu-emacs] / src / font.c
index 251d43ba8b224aeea4fa1a0952cc5fec0615daa8..8405065a0d0315acb1aa116ec546db62018b821b 100644 (file)
@@ -225,7 +225,35 @@ font_make_object (int size, Lisp_Object entity, int pixelsize)
   return font_object;
 }
 
-\f
+#if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
+
+static int font_unparse_fcname (Lisp_Object, int, char *, int);
+
+/* Like above, but also set `type', `name' and `fullname' properties
+   of font-object.  */
+
+Lisp_Object
+font_build_object (int vectorsize, Lisp_Object type,
+                  Lisp_Object entity, double pixelsize)
+{
+  int len;
+  char name[256];
+  Lisp_Object font_object = font_make_object (vectorsize, entity, pixelsize);
+
+  ASET (font_object, FONT_TYPE_INDEX, type);
+  len = font_unparse_xlfd (entity, pixelsize, name, sizeof name);
+  if (len > 0)
+    ASET (font_object, FONT_NAME_INDEX, make_string (name, len));
+  len = font_unparse_fcname (entity, pixelsize, name, sizeof name);
+  if (len > 0)
+    ASET (font_object, FONT_FULLNAME_INDEX, make_string (name, len));
+  else
+    ASET (font_object, FONT_FULLNAME_INDEX,
+         AREF (font_object, FONT_NAME_INDEX));
+  return font_object;
+}
+
+#endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
 
 static int font_pixel_size (struct frame *f, Lisp_Object);
 static Lisp_Object font_open_entity (struct frame *, Lisp_Object, int);
@@ -245,10 +273,8 @@ static int num_font_drivers;
 Lisp_Object
 font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
 {
-  ptrdiff_t i;
-  Lisp_Object tem;
-  Lisp_Object obarray;
-  ptrdiff_t nbytes, nchars;
+  ptrdiff_t i, nbytes, nchars;
+  Lisp_Object tem, name, obarray;
 
   if (len == 1 && *str == '*')
     return Qnil;
@@ -279,12 +305,11 @@ font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
   parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
   tem = oblookup (obarray, str,
                  (len == nchars || len != nbytes) ? len : nchars, len);
-
   if (SYMBOLP (tem))
     return tem;
-  tem = make_specified_string (str, nchars, len,
-                              len != nchars && len == nbytes);
-  return Fintern (tem, obarray);
+  name = make_specified_string (str, nchars, len,
+                               len != nchars && len == nbytes);
+  return intern_driver (name, obarray, XINT (tem));
 }
 
 /* Return a pixel size of font-spec SPEC on frame F.  */
@@ -338,7 +363,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val,
     {
       int i, j;
       char *s;
-      Lisp_Object args[2], elt;
+      Lisp_Object elt;
 
       /* At first try exact match.  */
       for (i = 0; i < len; i++)
@@ -370,9 +395,9 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val,
       eassert (len < 255);
       elt = Fmake_vector (make_number (2), make_number (100));
       ASET (elt, 1, val);
-      args[0] = table;
-      args[1] = Fmake_vector (make_number (1), elt);
-      ASET (font_style_table, prop - FONT_WEIGHT_INDEX, Fvconcat (2, args));
+      ASET (font_style_table, prop - FONT_WEIGHT_INDEX,
+           Fvconcat (2, ((Lisp_Object [])
+             { table, Fmake_vector (make_number (1), elt) })));
       return (100 << 8) | (i << 4);
     }
   else
@@ -1158,13 +1183,22 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
        {
          val = prop[XLFD_ENCODING_INDEX];
          if (! NILP (val))
-           val = concat2 (build_string ("*-"), SYMBOL_NAME (val));
+           {
+             AUTO_STRING (stardash, "*-");
+             val = concat2 (stardash, SYMBOL_NAME (val));
+           }
        }
       else if (NILP (prop[XLFD_ENCODING_INDEX]))
-       val = concat2 (SYMBOL_NAME (val), build_string ("-*"));
+       {
+         AUTO_STRING (dashstar, "-*");
+         val = concat2 (SYMBOL_NAME (val), dashstar);
+       }
       else
-       val = concat3 (SYMBOL_NAME (val), build_string ("-"),
-                      SYMBOL_NAME (prop[XLFD_ENCODING_INDEX]));
+       {
+         AUTO_STRING (dash, "-");
+         val = concat3 (SYMBOL_NAME (val), dash,
+                        SYMBOL_NAME (prop[XLFD_ENCODING_INDEX]));
+       }
       if (! NILP (val))
        ASET (font, FONT_REGISTRY_INDEX, Fintern (val, Qnil));
 
@@ -1271,6 +1305,9 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
 
   val = AREF (font, FONT_SIZE_INDEX);
   eassert (NUMBERP (val) || NILP (val));
+  char font_size_index_buf[sizeof "-*"
+                          + max (INT_STRLEN_BOUND (EMACS_INT),
+                                 1 + DBL_MAX_10_EXP + 1)];
   if (INTEGERP (val))
     {
       EMACS_INT v = XINT (val);
@@ -1278,8 +1315,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
        v = pixel_size;
       if (v > 0)
        {
-         f[XLFD_PIXEL_INDEX] = p =
-           alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT));
+         f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
          sprintf (p, "%"pI"d-*", v);
        }
       else
@@ -1288,21 +1324,22 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
   else if (FLOATP (val))
     {
       double v = XFLOAT_DATA (val) * 10;
-      f[XLFD_PIXEL_INDEX] = p = alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP + 1);
+      f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
       sprintf (p, "*-%.0f", v);
     }
   else
     f[XLFD_PIXEL_INDEX] = "*-*";
 
+  char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)];
   if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
     {
       EMACS_INT v = XINT (AREF (font, FONT_DPI_INDEX));
-      f[XLFD_RESX_INDEX] = p =
-       alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT));
+      f[XLFD_RESX_INDEX] = p = dpi_index_buf;
       sprintf (p, "%"pI"d-%"pI"d", v, v);
     }
   else
     f[XLFD_RESX_INDEX] = "*-*";
+
   if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
     {
       EMACS_INT spacing = XINT (AREF (font, FONT_SPACING_INDEX));
@@ -1314,13 +1351,16 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
     }
   else
     f[XLFD_SPACING_INDEX] = "*";
+
+  char avgwidth_index_buf[INT_BUFSIZE_BOUND (EMACS_INT)];
   if (INTEGERP (AREF (font,  FONT_AVGWIDTH_INDEX)))
     {
-      f[XLFD_AVGWIDTH_INDEX] = p = alloca (INT_BUFSIZE_BOUND (EMACS_INT));
+      f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf;
       sprintf (p, "%"pI"d", XINT (AREF (font, FONT_AVGWIDTH_INDEX)));
     }
   else
     f[XLFD_AVGWIDTH_INDEX] = "*";
+
   len = snprintf (name, nbytes, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
                  f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
                  f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
@@ -1573,11 +1613,14 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font)
   return 0;
 }
 
+#if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
+
 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
    NAME (NBYTES length), and return the name length.  If
-   FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.  */
+   FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
+   Return a negative value on error.  */
 
-int
+static int
 font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
 {
   Lisp_Object family, foundry;
@@ -1698,6 +1741,8 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
   return (p - name);
 }
 
+#endif
+
 /* Parse NAME (null terminated) and store information in FONT
    (font-spec or font-entity).  If NAME is successfully parsed, return
    0.  Otherwise return -1.  */
@@ -1718,7 +1763,7 @@ font_parse_name (char *name, ptrdiff_t namelen, Lisp_Object font)
 void
 font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Object font_spec)
 {
-  int len;
+  ptrdiff_t len;
   char *p0, *p1;
 
   if (! NILP (family)
@@ -1749,10 +1794,8 @@ font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Objec
       p1 = strchr (p0, '-');
       if (! p1)
        {
-         if (SDATA (registry)[len - 1] == '*')
-           registry = concat2 (registry, build_string ("-*"));
-         else
-           registry = concat2 (registry, build_string ("*-*"));
+         AUTO_STRING (extra, ("*-*" + (len && p0[len - 1] == '*')));
+         registry = concat2 (registry, extra);
        }
       registry = Fdowncase (registry);
       ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil));
@@ -2125,10 +2168,14 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop)
         lowest bit is set if the DPI is different.  */
       EMACS_INT diff;
       EMACS_INT pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]);
+      EMACS_INT entity_size = XINT (AREF (entity, FONT_SIZE_INDEX));
 
       if (CONSP (Vface_font_rescale_alist))
        pixel_size *= font_rescale_ratio (entity);
-      diff = eabs (pixel_size - XINT (AREF (entity, FONT_SIZE_INDEX))) << 1;
+      if (pixel_size * 2 < entity_size || entity_size * 2 < pixel_size)
+       /* This size is wrong by more than a factor 2: reject it!  */
+       return 0xFFFFFFFF;
+      diff = eabs (pixel_size - entity_size) << 1;
       if (! NILP (spec_prop[FONT_DPI_INDEX])
          && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
        diff |= 1;
@@ -2148,13 +2195,17 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop)
 static Lisp_Object
 font_vconcat_entity_vectors (Lisp_Object list)
 {
-  int nargs = XINT (Flength (list));
-  Lisp_Object *args = alloca (word_size * nargs);
-  int i;
+  EMACS_INT nargs = XFASTINT (Flength (list));
+  Lisp_Object *args;
+  USE_SAFE_ALLOCA;
+  SAFE_ALLOCA_LISP (args, nargs);
+  ptrdiff_t i;
 
   for (i = 0; i < nargs; i++, list = XCDR (list))
     args[i] = XCAR (list);
-  return Fvconcat (nargs, args);
+  Lisp_Object result = Fvconcat (nargs, args);
+  SAFE_FREE ();
+  return result;
 }
 
 
@@ -2637,7 +2688,7 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size)
 {
   Lisp_Object entity, val;
   enum font_property_index prop;
-  int i;
+  ptrdiff_t i;
 
   for (val = Qnil, i = ASIZE (vec) - 1; i >= 0; i--)
     {
@@ -3182,9 +3233,10 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int
       val = attrs[LFACE_FAMILY_INDEX];
       val = font_intern_prop (SSDATA (val), SBYTES (val), 1);
     }
+  Lisp_Object familybuf[3];
   if (NILP (val))
     {
-      family = alloca ((sizeof family[0]) * 2);
+      family = familybuf;
       family[0] = Qnil;
       family[1] = zero_vector; /* terminator.  */
     }
@@ -3205,7 +3257,7 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int
        }
       else
        {
-         family = alloca ((sizeof family[0]) * 3);
+         family = familybuf;
          i = 0;
          family[i++] = val;
          if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
@@ -3492,8 +3544,9 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers)
       struct font_driver_list **list_table, **next;
       Lisp_Object tail;
       int i;
+      USE_SAFE_ALLOCA;
 
-      list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
+      SAFE_NALLOCA (list_table, 1, num_font_drivers + 1);
       for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
        {
          for (list = f->font_driver_list; list; list = list->next)
@@ -3514,6 +3567,7 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers)
          next = &(*next)->next;
        }
       *next = NULL;
+      SAFE_FREE ();
 
       if (! f->font_driver_list->on)
        { /* None of the drivers is enabled: enable them all.
@@ -3539,53 +3593,40 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers)
   return active_drivers;
 }
 
-int
-font_put_frame_data (struct frame *f, struct font_driver *driver, void *data)
+#if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
+
+static void
+fset_font_data (struct frame *f, Lisp_Object val)
 {
-  struct font_data_list *list, *prev;
+  f->font_data = val;
+}
 
-  for (prev = NULL, list = f->font_data_list; list;
-       prev = list, list = list->next)
-    if (list->driver == driver)
-      break;
-  if (! data)
-    {
-      if (list)
-       {
-         if (prev)
-           prev->next = list->next;
-         else
-           f->font_data_list = list->next;
-         xfree (list);
-       }
-      return 0;
-    }
+void
+font_put_frame_data (struct frame *f, Lisp_Object driver, void *data)
+{
+  Lisp_Object val = assq_no_quit (driver, f->font_data);
 
-  if (! list)
+  if (!data)
+    fset_font_data (f, Fdelq (val, f->font_data));
+  else
     {
-      list = xmalloc (sizeof *list);
-      list->driver = driver;
-      list->next = f->font_data_list;
-      f->font_data_list = list;
+      if (NILP (val))
+       fset_font_data (f, Fcons (Fcons (driver, make_save_ptr (data)),
+                                 f->font_data));
+      else
+       XSETCDR (val, make_save_ptr (data));
     }
-  list->data = data;
-  return 0;
 }
 
-
 void *
-font_get_frame_data (struct frame *f, struct font_driver *driver)
+font_get_frame_data (struct frame *f, Lisp_Object driver)
 {
-  struct font_data_list *list;
-
-  for (list = f->font_data_list; list; list = list->next)
-    if (list->driver == driver)
-      break;
-  if (! list)
-    return NULL;
-  return list->data;
+  Lisp_Object val = assq_no_quit (driver, f->font_data);
+
+  return NILP (val) ? NULL : XSAVE_POINTER (XCDR (val), 0);
 }
 
+#endif /* HAVE_XFT || HAVE_FREETYPE */
 
 /* Sets attributes on a font.  Any properties that appear in ALIST and
    BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
@@ -4228,7 +4269,7 @@ the consecutive wildcards are folded into one.  */)
        {
          if (NILP (fold_wildcards))
            return font_name;
-         strcpy (name, SSDATA (font_name));
+         lispstpcpy (name, font_name);
          namelen = SBYTES (font_name);
          goto done;
        }
@@ -4981,7 +5022,7 @@ font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
   if (FONTP (arg))
     {
       Lisp_Object tail, elt;
-      Lisp_Object equalstr = build_string ("=");
+      AUTO_STRING (equalstr, "=");
 
       val = Ffont_xlfd_name (arg, Qt);
       for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
@@ -5014,8 +5055,11 @@ font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
     {
       val = Ffont_xlfd_name (result, Qt);
       if (! FONT_SPEC_P (result))
-       val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
-                      build_string (":"), val);
+       {
+         AUTO_STRING (colon, ":");
+         val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
+                        colon, val);
+       }
       result = val;
     }
   else if (CONSP (result))