]> code.delx.au - gnu-emacs/blobdiff - src/font.c
* ralloc.c (r_alloc_reset_variable): New function.
[gnu-emacs] / src / font.c
index 340b69869a1e932e56571e43cd2766785af94325..2f98141b53dd8137e4d9b5c80e6a9d79356ee9c0 100644 (file)
@@ -23,9 +23,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <stdio.h>
 #include <stdlib.h>
 #include <ctype.h>
-#ifdef HAVE_M17N_FLT
-#include <m17n-flt.h>
-#endif
 
 #include "lisp.h"
 #include "buffer.h"
@@ -51,7 +48,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #endif /* HAVE_NS */
 
 Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
+
 #ifdef HAVE_NS
 extern Lisp_Object Qfontsize;
 #endif
@@ -403,7 +400,7 @@ 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));
 }
 
 extern Lisp_Object Vface_alternative_font_family_alist;
@@ -1601,7 +1598,6 @@ font_unparse_fcname (font, pixel_size, name, nbytes)
   Lisp_Object family, foundry;
   Lisp_Object tail, val;
   int point_size;
-  int dpi;
   int i, len = 1;
   char *p;
   Lisp_Object styles[3];
@@ -1656,7 +1652,7 @@ font_unparse_fcname (font, pixel_size, name, nbytes)
     }
 
   if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
-    len += sprintf (work, ":dpi=%d", dpi);
+    len += sprintf (work, ":dpi=%d", XINT (AREF (font, FONT_DPI_INDEX)));
   if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
     len += strlen (":spacing=100");
   if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
@@ -2169,6 +2165,38 @@ static int font_compare P_ ((const void *, const void *));
 static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object,
                                          Lisp_Object, int));
 
+/* Return a rescaling ratio of FONT_ENTITY.  */
+extern Lisp_Object Vface_font_rescale_alist;
+
+static double
+font_rescale_ratio (font_entity)
+     Lisp_Object font_entity;
+{
+  Lisp_Object tail, elt;
+  Lisp_Object name = Qnil;
+
+  for (tail = Vface_font_rescale_alist; CONSP (tail); tail = XCDR (tail))
+    {
+      elt = XCAR (tail);
+      if (FLOATP (XCDR (elt)))
+       {
+         if (STRINGP (XCAR (elt)))
+           {
+             if (NILP (name))
+               name = Ffont_xlfd_name (font_entity, Qnil);
+             if (fast_string_match_ignore_case (XCAR (elt), name) >= 0)
+               return XFLOAT_DATA (XCDR (elt));
+           }
+         else if (FONT_SPEC_P (XCAR (elt)))
+           {
+             if (font_match_p (XCAR (elt), font_entity))
+               return XFLOAT_DATA (XCDR (elt));
+           }
+       }
+    }
+  return 1.0;
+}
+
 /* We sort fonts by scoring each of them against a specified
    font-spec.  The score value is 32 bit (`unsigned'), and the smaller
    the value is, the closer the font is to the font-spec.
@@ -2209,12 +2237,17 @@ font_score (entity, spec_prop)
 
   /* Score the size.  Maximum difference is 127.  */
   i = FONT_SIZE_INDEX;
-  if (! NILP (spec_prop[i]) && XINT (AREF (entity, i)) > 0)
+  if (! NILP (spec_prop[FONT_SIZE_INDEX])
+      && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
     {
       /* We use the higher 6-bit for the actual size difference.  The
         lowest bit is set if the DPI is different.  */
-      int diff = XINT (spec_prop[i]) - XINT (AREF (entity, i));
+      int diff;
+      int pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]);
 
+      if (CONSP (Vface_font_rescale_alist))
+       pixel_size *= font_rescale_ratio (entity);
+      diff = pixel_size - XINT (AREF (entity, FONT_SIZE_INDEX));
       if (diff < 0)
        diff = - diff;
       diff <<= 1;
@@ -2477,11 +2510,36 @@ font_match_p (spec, font)
       else if (EQ (key, QCscript))
        {
          val2 = assq_no_quit (val, Vscript_representative_chars);
-         if (! NILP (val2))
-           for (val2 = XCDR (val2); CONSP (val2); val2 = XCDR (val2))
-             if (font_encode_char (font, XINT (XCAR (val2)))
-                 == FONT_INVALID_CODE)
-               return 0;
+         if (CONSP (val2))
+           {
+             val2 = XCDR (val2);
+             if (CONSP (val2))
+               {
+                 /* All characters in the list must be supported.  */
+                 for (; CONSP (val2); val2 = XCDR (val2))
+                   {
+                     if (! NATNUMP (XCAR (val2)))
+                       continue;
+                     if (font_encode_char (font, XFASTINT (XCAR (val2)))
+                         == FONT_INVALID_CODE)
+                       return 0;
+                   }
+               }
+             else if (VECTORP (val2))
+               {
+                 /* At most one character in the vector must be supported.  */
+                 for (i = 0; i < ASIZE (val2); i++)
+                   {
+                     if (! NATNUMP (AREF (val2, i)))
+                       continue;
+                     if (font_encode_char (font, XFASTINT (AREF (val2, i)))
+                         != FONT_INVALID_CODE)
+                       break;
+                   }
+                 if (i == ASIZE (val2))
+                   return 0;
+               }
+           }
        }
       else if (EQ (key, QCotf))
        {
@@ -2593,21 +2651,21 @@ font_clear_cache (f, cache, driver)
      struct font_driver *driver;
 {
   Lisp_Object tail, elt;
+  Lisp_Object tail2, entity;
 
   /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
   for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
     {
       elt = XCAR (tail);
-      if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)) && VECTORP (XCDR (elt)))
+      /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
+      if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
        {
-         Lisp_Object vec = XCDR (elt);
-         int i;
-
-         for (i = 0; i < ASIZE (vec); i++)
+         for (tail2 = XCDR (elt); CONSP (tail2); tail2 = XCDR (tail2))
            {
-             Lisp_Object entity = AREF (vec, i);
+             entity = XCAR (tail2);
 
-             if (EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
+             if (FONT_ENTITY_P (entity)
+                 && EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
                {
                  Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
 
@@ -2665,11 +2723,13 @@ font_delete_unmatched (list, spec, size)
       if (prop < FONT_SPEC_MAX
          && INTEGERP (AREF (spec, FONT_DPI_INDEX))
          && INTEGERP (AREF (entity, FONT_DPI_INDEX))
+         && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
          && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
        prop = FONT_SPEC_MAX;
       if (prop < FONT_SPEC_MAX
          && INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX))
          && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
+         && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0
          && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
                   AREF (entity, FONT_AVGWIDTH_INDEX)))
        prop = FONT_SPEC_MAX;
@@ -2765,12 +2825,18 @@ font_matching_entity (f, attrs, spec)
   struct font_driver_list *driver_list = f->font_driver_list;
   Lisp_Object ftype, size, entity;
   Lisp_Object frame;
+  Lisp_Object work = Fcopy_font_spec (spec);
 
   XSETFRAME (frame, f);
   ftype = AREF (spec, FONT_TYPE_INDEX);
   size = AREF (spec, FONT_SIZE_INDEX);
+
   if (FLOATP (size))
-    ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
+    ASET (work, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
+  FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
+  FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
+  FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
+
   entity = Qnil;
   for (; driver_list; driver_list = driver_list->next)
     if (driver_list->on
@@ -2779,23 +2845,21 @@ font_matching_entity (f, attrs, spec)
        Lisp_Object cache = font_get_cache (f, driver_list->driver);
        Lisp_Object copy;
 
-       ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type);
-       entity = assoc_no_quit (spec, XCDR (cache));
+       ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
+       entity = assoc_no_quit (work, XCDR (cache));
        if (CONSP (entity))
          entity = XCDR (entity);
        else
          {
-           entity = driver_list->driver->match (frame, spec);
-           copy = Fcopy_font_spec (spec);
+           entity = driver_list->driver->match (frame, work);
+           copy = Fcopy_font_spec (work);
            ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
            XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
          }
        if (! NILP (entity))
          break;
       }
-  ASET (spec, FONT_TYPE_INDEX, ftype);
-  ASET (spec, FONT_SIZE_INDEX, size);
-  font_add_log ("match", spec, entity);
+  font_add_log ("match", work, entity);
   return entity;
 }
 
@@ -2813,11 +2877,14 @@ font_open_entity (f, entity, pixel_size)
   Lisp_Object objlist, size, val, font_object;
   struct font *font;
   int min_width, height;
+  int scaled_pixel_size;
 
   font_assert (FONT_ENTITY_P (entity));
   size = AREF (entity, FONT_SIZE_INDEX);
   if (XINT (size) != 0)
-    pixel_size = XINT (size);
+    scaled_pixel_size = pixel_size = XINT (size);
+  else if (CONSP (Vface_font_rescale_alist))
+    scaled_pixel_size = pixel_size * font_rescale_ratio (entity);
 
   for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
        objlist = XCDR (objlist))
@@ -2832,7 +2899,8 @@ font_open_entity (f, entity, pixel_size)
   if (! driver_list)
     return Qnil;
 
-  font_object = driver_list->driver->open (f, entity, pixel_size);
+  font_object = driver_list->driver->open (f, entity, scaled_pixel_size);
+  ASET (font_object, FONT_SIZE_INDEX, make_number (pixel_size));
   font_add_log ("open", entity, font_object);
   if (NILP (font_object))
     return Qnil;
@@ -2993,7 +3061,9 @@ font_clear_prop (attrs, prop)
   if (! FONTP (font))
     return;
   if (NILP (AREF (font, prop))
-      && prop != FONT_FAMILY_INDEX && prop != FONT_FOUNDRY_INDEX
+      && prop != FONT_FAMILY_INDEX
+      && prop != FONT_FOUNDRY_INDEX
+      && prop != FONT_WIDTH_INDEX
       && prop != FONT_SIZE_INDEX)
     return;
   font = Fcopy_font_spec (font);
@@ -3015,6 +3085,8 @@ font_clear_prop (attrs, prop)
       ASET (font, FONT_SPACING_INDEX, Qnil);
       ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
     }
+  else if (prop == FONT_WIDTH_INDEX)
+    ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
   attrs[LFACE_FONT_INDEX] = font;
 }
 
@@ -3053,10 +3125,13 @@ font_update_lface (f, attrs)
            dpi = XINT (val);
          point = PIXEL_TO_POINT (XINT (AREF (spec, FONT_SIZE_INDEX)) * 10,
                                  dpi);
+         attrs[LFACE_HEIGHT_INDEX] = make_number (point);
        }
       else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
-       point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
-      attrs[LFACE_HEIGHT_INDEX] = make_number (point);
+       {
+         point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
+         attrs[LFACE_HEIGHT_INDEX] = make_number (point);
+       }
     }
 }
 
@@ -3166,7 +3241,13 @@ font_find_for_lface (f, attrs, spec, c)
   else
     {
       Lisp_Object alters
-       = Fassoc_string (val, Vface_alternative_font_family_alist, Qt);
+       = Fassoc_string (val, Vface_alternative_font_family_alist,
+#ifndef HAVE_NS
+                        Qt
+#else
+                        Qnil
+#endif
+                        );
 
       if (! NILP (alters))
        {
@@ -3413,7 +3494,7 @@ register_font_driver (driver, f)
     if (EQ (list->driver->type, driver->type))
       error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
 
-  list = malloc (sizeof (struct font_driver_list));
+  list = xmalloc (sizeof (struct font_driver_list));
   list->on = 0;
   list->driver = driver;
   list->next = NULL;
@@ -3427,6 +3508,20 @@ register_font_driver (driver, f)
     num_font_drivers++;
 }
 
+void
+free_font_driver_list (f)
+     FRAME_PTR f;
+{
+  struct font_driver_list *list, *next;
+
+  for (list = f->font_driver_list; list; list = next)
+    {
+      next = list->next;
+      xfree (list);
+    }
+  f->font_driver_list = NULL;
+}
+
 
 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
    symbols, e.g. xft, x).  If NEW_DRIVERS is t, make F use all
@@ -3493,7 +3588,7 @@ font_update_drivers (f, new_drivers)
        }
       for (list = f->font_driver_list; list; list = list->next)
        if (! list->on)
-         list_table[i] = list;
+         list_table[i++] = list;
       list_table[i] = NULL;
 
       next = &f->font_driver_list;
@@ -3539,9 +3634,7 @@ font_put_frame_data (f, driver, data)
 
   if (! list)
     {
-      list = malloc (sizeof (struct font_data_list));
-      if (! list)
-       return -1;
+      list = xmalloc (sizeof (struct font_data_list));
       list->driver = driver;
       list->next = f->font_data_list;
       f->font_data_list = list;
@@ -3584,11 +3677,13 @@ font_at (c, pos, face, w, string)
   int multibyte;
   Lisp_Object font_object;
 
+  multibyte = (NILP (string)
+              ? ! NILP (current_buffer->enable_multibyte_characters)
+              : STRING_MULTIBYTE (string));
   if (c < 0)
     {
       if (NILP (string))
        {
-         multibyte = ! NILP (current_buffer->enable_multibyte_characters);
          if (multibyte)
            {
              EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
@@ -3795,7 +3890,12 @@ specifying the font size.  It specifies the font size in pixels
 `:name'
 
 VALUE must be a string of XLFD-style or fontconfig-style font name.
-usage: (font-spec ARGS ...)  */)
+
+`:script'
+
+VALUE must be a symbol representing a script that the font must
+support.
+usage: (font-spec ARGS...)  */)
      (nargs, args)
      int nargs;
      Lisp_Object *args;
@@ -3891,7 +3991,13 @@ properties in TO.  */)
 
 DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
        doc: /* Return the value of FONT's property KEY.
-FONT is a font-spec, a font-entity, or a font-object.  */)
+FONT is a font-spec, a font-entity, or a font-object.
+KEY must be one of these symbols:
+  :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
+  :size, :name, :script
+See the documentation of `font-spec' for their meanings.
+If FONT is a font-entity or font-object, the value of :script may be
+a list of scripts that are supported by the font.  */)
      (font, key)
      Lisp_Object font, key;
 {
@@ -4224,8 +4330,8 @@ created glyph-string.  Otherwise, the value is nil.  */)
 {
   struct font *font;
   Lisp_Object font_object, n, glyph;
-  int i;
-  
+  int i, j, from, to;
+
   if (! composition_gstring_p (gstring))
     signal_error ("Invalid glyph-string: ", gstring);
   if (! NILP (LGSTRING_ID (gstring)))
@@ -4248,25 +4354,44 @@ created glyph-string.  Otherwise, the value is nil.  */)
     }
   if (i == 3 || XINT (n) == 0)
     return Qnil;
-  
+
   glyph = LGSTRING_GLYPH (gstring, 0);
-  for (i = 1; i < LGSTRING_GLYPH_LEN (gstring); i++)
+  from = LGLYPH_FROM (glyph);
+  to = LGLYPH_TO (glyph);
+  for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
     {
       Lisp_Object this = LGSTRING_GLYPH (gstring, i);
 
       if (NILP (this))
        break;
       if (NILP (LGLYPH_ADJUSTMENT (this)))
-       glyph = this;
+       {
+         if (j < i - 1)
+           for (; j < i; j++)
+             {
+               glyph = LGSTRING_GLYPH (gstring, j);
+               LGLYPH_SET_FROM (glyph, from);
+               LGLYPH_SET_TO (glyph, to);
+             }
+         from = LGLYPH_FROM (this);
+         to = LGLYPH_TO (this);
+         j = i;
+       }
       else
        {
-         int from = LGLYPH_FROM (glyph);
-         int to = LGLYPH_TO (glyph);
-
-         LGLYPH_SET_FROM (this, from);
-         LGLYPH_SET_TO (this, to);
+         if (from > LGLYPH_FROM (this))
+           from = LGLYPH_FROM (this);
+         if (to < LGLYPH_TO (this))
+           to = LGLYPH_TO (this);
        }
     }
+  if (j < i - 1)
+    for (; j < i; j++)
+      {
+       glyph = LGSTRING_GLYPH (gstring, j);
+       LGLYPH_SET_FROM (glyph, from);
+       LGLYPH_SET_TO (glyph, to);
+      }
   return composition_gstring_put_cache (gstring, XINT (n));
 }
 
@@ -4415,7 +4540,7 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
     {
       CHECK_NUMBER_OR_FLOAT (size);
       if (FLOATP (size))
-       isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
+       isize = POINT_TO_PIXEL (XFLOAT_DATA (size), XFRAME (frame)->resy);
       else
        isize = XINT (size);
       if (isize == 0)
@@ -4778,13 +4903,16 @@ font_add_log (action, arg, result)
           tail = XCDR (tail))
        {
          elt = XCAR (tail);
-         if (EQ (XCAR (elt), QCscript))
+         if (EQ (XCAR (elt), QCscript)
+             && SYMBOLP (XCDR (elt)))
            val = concat3 (val, SYMBOL_NAME (QCscript),
                           concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
-         else if (EQ (XCAR (elt), QClang))
+         else if (EQ (XCAR (elt), QClang)
+                  && SYMBOLP (XCDR (elt)))
            val = concat3 (val, SYMBOL_NAME (QClang),
                           concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
-         else if (EQ (XCAR (elt), QCotf) && CONSP (XCDR (elt)))
+         else if (EQ (XCAR (elt), QCotf)
+                  && CONSP (XCDR (elt)) && SYMBOLP (XCAR (XCDR (elt))))
            val = concat3 (val, SYMBOL_NAME (QCotf),
                           concat2 (equalstr,
                                    SYMBOL_NAME (XCAR (XCDR (elt)))));
@@ -4836,7 +4964,7 @@ font_deferred_log (action, arg, result)
   ASET (Vfont_log_deferred, 0, build_string (action));
   ASET (Vfont_log_deferred, 1, arg);
   ASET (Vfont_log_deferred, 2, result);
-}     
+}
 
 extern void syms_of_ftfont P_ (());
 extern void syms_of_xfont P_ (());