(font_style_to_value): Set value for unknown symbols to
[bpt/emacs.git] / src / font.c
index 8988b21..780413f 100644 (file)
@@ -1,6 +1,6 @@
 /* font.c -- "Font" primitives.
-   Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
-   Copyright (C) 2006, 2007, 2008
+   Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+   Copyright (C) 2006, 2007, 2008, 2009
      National Institute of Advanced Industrial Science and Technology (AIST)
      Registration Number H13PRO009
 
@@ -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"
@@ -46,17 +43,28 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "w32term.h"
 #endif /* HAVE_NTGUI */
 
-#ifdef MAC_OS
-#include "macterm.h"
-#endif /* MAC_OS */
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif /* HAVE_NS */
 
-Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
+#ifdef HAVE_NS
+extern Lisp_Object Qfontsize;
+#endif
 
 Lisp_Object Qopentype;
 
 /* Important character set strings.  */
 Lisp_Object Qascii_0, Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip;
 
+#ifdef HAVE_NS
+#define DEFAULT_ENCODING Qiso10646_1
+#else
+#define DEFAULT_ENCODING Qiso8859_1
+#endif
+
+/* Unicode category `Cf'.  */
+static Lisp_Object QCf;
+
 /* Special vector of zero length.  This is repeatedly used by (struct
    font_driver *)->list when a specified font is not found. */
 static Lisp_Object null_vector;
@@ -88,7 +96,7 @@ static struct table_entry weight_table[] =
   { 40, { "extra-light", "extralight" }},
   { 50, { "light" }},
   { 75, { "semi-light", "semilight", "demilight", "book" }},
-  { 100, { "normal", "medium", "regular" }},
+  { 100, { "normal", "medium", "regular", "unspecified" }},
   { 180, { "semi-bold", "semibold", "demibold", "demi" }},
   { 200, { "bold" }},
   { 205, { "extra-bold", "extrabold" }},
@@ -102,7 +110,7 @@ static struct table_entry slant_table[] =
 {
   { 0, { "reverse-oblique", "ro" }},
   { 10, { "reverse-italic", "ri" }},
-  { 100, { "normal", "r" }},
+  { 100, { "normal", "r", "unspecified" }},
   { 200, { "italic" ,"i", "ot" }},
   { 210, { "oblique", "o" }}
 };
@@ -116,7 +124,7 @@ static struct table_entry width_table[] =
   { 63, { "extra-condensed", "extracondensed" }},
   { 75, { "condensed", "compressed", "narrow" }},
   { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
-  { 100, { "normal", "medium", "regular" }},
+  { 100, { "normal", "medium", "regular", "unspecified" }},
   { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
   { 125, { "expanded" }},
   { 150, { "extra-expanded", "extraexpanded" }},
@@ -244,6 +252,7 @@ font_intern_prop (str, len, force_symbol)
   int i;
   Lisp_Object tem;
   Lisp_Object obarray;
+  int nbytes, nchars;
 
   if (len == 1 && *str == '*')
     return Qnil;
@@ -256,14 +265,25 @@ font_intern_prop (str, len, force_symbol)
        return make_number (atoi (str));
     }
 
-  /* The following code is copied from the function intern (in lread.c).  */
+  /* The following code is copied from the function intern (in
+     lread.c), and modified to suite our purpose.  */
   obarray = Vobarray;
   if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
     obarray = check_obarray (obarray);
-  tem = oblookup (obarray, str, len, len);
+  parse_str_as_multibyte (str, len, &nchars, &nbytes);
+  if (len == nchars || len != nbytes)
+    /* CONTENTS contains no multibyte sequences or contains an invalid
+       multibyte sequence.  We'll make a unibyte string.  */
+    tem = oblookup (obarray, str, len, len);
+  else
+    tem = oblookup (obarray, str, nchars, len);
   if (SYMBOLP (tem))
     return tem;
-  return Fintern (make_unibyte_string (str, len), obarray);
+  if (len == nchars || len != nbytes)
+    tem = make_unibyte_string (str, len);
+  else
+    tem = make_multibyte_string (str, nchars, len);
+  return Fintern (tem, obarray);
 }
 
 /* Return a pixel size of font-spec SPEC on frame F.  */
@@ -340,12 +360,12 @@ font_style_to_value (prop, val, noerror)
        return -1;
       if (len == 255)
        abort ();
-      elt = Fmake_vector (make_number (2), make_number (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));
-      return (255 << 8) | (i << 4);
+      return (100 << 8) | (i << 4);
     }
   else
     {
@@ -390,7 +410,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;
@@ -1044,11 +1064,11 @@ font_parse_xlfd (name, font)
   Lisp_Object val;
   char *p;
 
-  if (len > 255)
+  if (len > 255 || !len)
     /* Maximum XLFD name length is 255. */
     return -1;
   /* Accept "*-.." as a fully specified XLFD. */
-  if (name[0] == '*' && name[1] == '-')
+  if (name[0] == '*' && (len == 1 || name[1] == '-'))
     i = 1, f[XLFD_FOUNDRY_INDEX] = name;
   else
     i = 0;
@@ -1588,7 +1608,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];
@@ -1643,7 +1662,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)))
@@ -1793,7 +1812,7 @@ font_parse_name (name, font)
      char *name;
      Lisp_Object font;
 {
-  if (name[0] == '-' || index (name, '*'))
+  if (name[0] == '-' || index (name, '*') || index (name, '?'))
     return font_parse_xlfd (name, font);
   return font_parse_fcname (name, font);
 }
@@ -1883,7 +1902,7 @@ check_gstring (gstring)
   if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
     CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
 
-  for (i = 0; i < LGSTRING_LENGTH (gstring); i++)
+  for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
     {
       val = LGSTRING_GLYPH (gstring, i);
       CHECK_VECTOR (val);
@@ -2148,34 +2167,6 @@ font_otf_Anchor (anchor)
 #endif /* HAVE_LIBOTF */
 #endif /* 0 */
 
-/* G-string (glyph string) handler */
-
-/* G-string is a vector of the form [HEADER GLYPH ...].
-   See the docstring of `font-make-gstring' for more detail.  */
-
-struct font *
-font_prepare_composition (cmp, f)
-     struct composition *cmp;
-     FRAME_PTR f;
-{
-  Lisp_Object gstring
-    = AREF (XHASH_TABLE (composition_hash_table)->key_and_value,
-           cmp->hash_index * 2);
-
-  cmp->font = XFONT_OBJECT (LGSTRING_FONT (gstring));
-  cmp->glyph_len = LGSTRING_LENGTH (gstring);
-  cmp->pixel_width = LGSTRING_WIDTH (gstring);
-  cmp->lbearing = LGSTRING_LBEARING (gstring);
-  cmp->rbearing = LGSTRING_RBEARING (gstring);
-  cmp->ascent = LGSTRING_ASCENT (gstring);
-  cmp->descent = LGSTRING_DESCENT (gstring);
-  cmp->width = cmp->pixel_width / FRAME_COLUMN_WIDTH (f);
-  if (cmp->width == 0)
-    cmp->width = 1;
-
-  return cmp->font;
-}
-
 \f
 /* Font sorting */
 
@@ -2184,6 +2175,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.
@@ -2224,12 +2247,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;
@@ -2394,7 +2422,10 @@ font_check_otf_features (script, langsys, features, table)
   for (negative = 0; CONSP (features); features = XCDR (features))
     {
       if (NILP (XCAR (features)))
-       negative = 1;
+       {
+         negative = 1;
+         continue;
+       }
       if (NILP (Fmemq (XCAR (features), table)) != negative)
        return 0;
     }
@@ -2404,7 +2435,7 @@ font_check_otf_features (script, langsys, features, table)
 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec).  */
 
 static int
-font_check_otf (spec, otf_capability)
+font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
 {
   Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
 
@@ -2492,11 +2523,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))
        {
@@ -2608,21 +2664,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);
 
@@ -2680,11 +2736,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;
@@ -2780,12 +2838,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
@@ -2794,23 +2858,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;
 }
 
@@ -2828,11 +2890,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))
@@ -2847,7 +2912,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;
@@ -2986,15 +3052,21 @@ font_get_spec (font_object)
   return spec;
 }
 
+
+/* Create a new font spec from FONT_NAME, and return it.  If FONT_NAME
+   could not be parsed by font_parse_name, return Qnil.  */
+
 Lisp_Object
 font_spec_from_name (font_name)
      Lisp_Object font_name;
 {
-  Lisp_Object args[2];
+  Lisp_Object spec = Ffont_spec (0, NULL);
 
-  args[0] = QCname;
-  args[1] = font_name;
-  return Ffont_spec (2, args);
+  CHECK_STRING (font_name);
+  if (font_parse_name ((char *) SDATA (font_name), spec) == -1)
+    return Qnil;
+  font_put_extra (spec, QCname, font_name);
+  return spec;
 }
 
 
@@ -3008,7 +3080,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);
@@ -3016,7 +3090,13 @@ font_clear_prop (attrs, prop)
   if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
     {
       if (prop == FONT_FAMILY_INDEX)
-       ASET (font, FONT_FOUNDRY_INDEX, Qnil);
+       {
+         ASET (font, FONT_FOUNDRY_INDEX, Qnil);
+         /* If we are setting the font family, we must also clear
+            FONT_WIDTH_INDEX to avoid rejecting families that lack
+            support for some widths.  */
+         ASET (font, FONT_WIDTH_INDEX, Qnil);
+       }
       ASET (font, FONT_ADSTYLE_INDEX, Qnil);
       ASET (font, FONT_REGISTRY_INDEX, Qnil);
       ASET (font, FONT_SIZE_INDEX, Qnil);
@@ -3030,6 +3110,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;
 }
 
@@ -3051,7 +3133,7 @@ font_update_lface (f, attrs)
   if (! NILP (AREF (spec, FONT_WEIGHT_INDEX)))
     attrs[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (spec);
   if (! NILP (AREF (spec, FONT_SLANT_INDEX)))
-    attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);;
+    attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);
   if (! NILP (AREF (spec, FONT_WIDTH_INDEX)))
     attrs[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (spec);
   if (! NILP (AREF (spec, FONT_SIZE_INDEX)))
@@ -3068,10 +3150,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);
+       }
     }
 }
 
@@ -3096,7 +3181,7 @@ font_find_for_lface (f, attrs, spec, c)
   registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
   if (NILP (registry[0]))
     {
-      registry[0] = Qiso8859_1;
+      registry[0] = DEFAULT_ENCODING;
       registry[1] = Qascii_0;
       registry[2] = null_vector;
     }
@@ -3138,8 +3223,8 @@ font_find_for_lface (f, attrs, spec, c)
     foundry[1] = null_vector;
   else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
     {
-      foundry[0] = font_intern_prop (SDATA (attrs[LFACE_FOUNDRY_INDEX]),
-                                    SBYTES (attrs[LFACE_FOUNDRY_INDEX]), 1);
+      val = attrs[LFACE_FOUNDRY_INDEX];
+      foundry[0] = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
       foundry[1] = Qnil;
       foundry[2] = null_vector;
     }
@@ -3168,8 +3253,10 @@ font_find_for_lface (f, attrs, spec, c)
 
   val = AREF (work, FONT_FAMILY_INDEX);
   if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
-    val = font_intern_prop (SDATA (attrs[LFACE_FAMILY_INDEX]),
-                           SBYTES (attrs[LFACE_FAMILY_INDEX]), 1);
+    {
+      val = attrs[LFACE_FAMILY_INDEX];
+      val = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
+    }
   if (NILP (val))
     {
       family = alloca ((sizeof family[0]) * 2);
@@ -3179,7 +3266,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))
        {
@@ -3302,10 +3395,28 @@ font_open_for_lface (f, entity, attrs, spec)
     size = font_pixel_size (f, spec);
   else
     {
-      double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
+      double pt;
+      if (INTEGERP (attrs[LFACE_HEIGHT_INDEX]))
+       pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
+      else
+       {
+         struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+         Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX];
+         if (INTEGERP (height))
+           pt = XINT (height);
+         else
+           abort(); /* We should never end up here.  */
+       }
 
       pt /= 10;
       size = POINT_TO_PIXEL (pt, f->resy);
+#ifdef HAVE_NS
+      if (size == 0)
+        {
+          Lisp_Object ffsize = get_frame_param(f, Qfontsize);
+          size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
+        }
+#endif
     }
   return font_open_entity (f, entity, size);
 }
@@ -3380,7 +3491,11 @@ font_open_by_name (f, name)
   attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
   attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
     = attrs[LFACE_SLANT_INDEX] = Qnormal;
+#ifndef HAVE_NS
   attrs[LFACE_HEIGHT_INDEX] = make_number (120);
+#else
+  attrs[LFACE_HEIGHT_INDEX] = make_number (0);
+#endif
   attrs[LFACE_FONT_INDEX] = Qnil;
 
   return font_load_for_lface (f, attrs, spec);
@@ -3415,7 +3530,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;
@@ -3429,6 +3544,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
@@ -3495,7 +3624,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;
@@ -3541,9 +3670,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;
@@ -3586,11 +3713,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);
@@ -3646,66 +3775,101 @@ font_at (c, pos, face, w, string)
 }
 
 
-/* Check how many characters after POS (at most to LIMIT) can be
-   displayed by the same font.  FACE is the face selected for the
-   character as POS on frame F.  STRING, if not nil, is the string to
-   check instead of the current buffer.
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Check how many characters after POS (at most to *LIMIT) can be
+   displayed by the same font on the window W.  FACE, if non-NULL, is
+   the face selected for the character at POS.  If STRING is not nil,
+   it is the string to check instead of the current buffer.  In that
+   case, FACE must be not NULL.
+
+   The return value is the font-object for the character at POS.
+   *LIMIT is set to the position where that font can't be used.
 
-   The return value is the position of the character that is displayed
-   by the differnt font than that of the character as POS.  */
+   It is assured that the current buffer (or STRING) is multibyte.  */
 
-EMACS_INT
-font_range (pos, limit, face, f, string)
-     EMACS_INT pos, limit;
+Lisp_Object
+font_range (pos, limit, w, face, string)
+     EMACS_INT pos, *limit;
+     struct window *w;
      struct face *face;
-     FRAME_PTR f;
      Lisp_Object string;
 {
-  int multibyte;
-  EMACS_INT pos_byte;
+  EMACS_INT pos_byte, ignore, start, start_byte;
   int c;
-  struct font *font;
-  int first = 1;
+  Lisp_Object font_object = Qnil;
 
   if (NILP (string))
     {
-      multibyte = ! NILP (current_buffer->enable_multibyte_characters);
       pos_byte = CHAR_TO_BYTE (pos);
+      if (! face)
+       {
+         int face_id;
+
+         face_id = face_at_buffer_position (w, pos, 0, 0, &ignore, *limit, 0);
+         face = FACE_FROM_ID (XFRAME (w->frame), face_id);
+       }
     }
   else
     {
-      multibyte = STRING_MULTIBYTE (string);
+      font_assert (face);
       pos_byte = string_char_to_byte (string, pos);
     }
 
-  if (! multibyte)
-    /* All unibyte character are displayed by the same font.  */
-    return limit;
-
-  while (pos < limit)
+  start = pos, start_byte = pos_byte;
+  while (pos < *limit)
     {
-      int face_id;
+      Lisp_Object category;
 
       if (NILP (string))
        FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
       else
        FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
-      face_id = FACE_FOR_CHAR (f, face, c, pos, string);
-      face = FACE_FROM_ID (f, face_id);
-      if (first)
+      if (NILP (font_object))
        {
-         font = face->font;
-         first = 0;
+         font_object = font_for_char (face, c, pos - 1, string);
+         if (NILP (font_object))
+           return Qnil;
          continue;
        }
-      else if (font != face->font)
+
+      category = CHAR_TABLE_REF (Vunicode_category_table, c);
+      if (! EQ (category, QCf)
+         && ! CHAR_VARIATION_SELECTOR_P (c)
+         && font_encode_char (font_object, c) == FONT_INVALID_CODE)
        {
-         pos--;
-         break;
+         Lisp_Object f = font_for_char (face, c, pos - 1, string);
+         EMACS_INT i, i_byte;
+
+
+         if (NILP (f))
+           {
+             *limit = pos - 1;
+             return font_object;
+           }
+         i = start, i_byte = start_byte;
+         while (i < pos - 1)
+           {
+
+             if (NILP (string))
+               FETCH_CHAR_ADVANCE_NO_CHECK (c, i, i_byte);
+             else
+               FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, i, i_byte);
+             category = CHAR_TABLE_REF (Vunicode_category_table, c);
+             if (! EQ (category, QCf)
+                 && ! CHAR_VARIATION_SELECTOR_P (c)
+                 && font_encode_char (f, c) == FONT_INVALID_CODE)
+               {
+                 *limit = pos - 1;
+                 return font_object;
+               }
+           }
+         font_object = f;
        }
     }
-  return pos;
+  return font_object;
 }
+#endif
 
 \f
 /* Lisp API */
@@ -3758,13 +3922,43 @@ encoding of a font, e.g. ``iso8859-1''.
 `:size'
 
 VALUE must be a non-negative integer or a floating point number
-specifying the font size.  It specifies the font size in pixels
-(if VALUE is an integer), or in points (if VALUE is a float).
+specifying the font size.  It specifies the font size in pixels (if
+VALUE is an integer), or in points (if VALUE is a float).
 
 `: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.  It may be a symbol representing a subgroup of a script
+listed in the variable `script-representative-chars'.
+
+`:lang'
+
+VALUE must be a symbol of two-letter ISO-639 language names,
+e.g. `ja'.
+
+`:otf'
+
+VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
+required OpenType features.
+
+  SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
+  LANGSYS-TAG: OpenType language system tag symbol,
+     or nil for the default language system.
+  GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
+  GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
+
+GSUB and GPOS may contain `nil' element.  In such a case, the font
+must not have any of the remaining elements.
+
+For instance, if the VALUE is `(thai nil nil (mark))', the font must
+be an OpenType font, and whose GPOS table of `thai' script's default
+language system must contain `mark' feature.
+
+usage: (font-spec ARGS...)  */)
      (nargs, args)
      int nargs;
      Lisp_Object *args;
@@ -3860,7 +4054,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;
 {
@@ -4051,17 +4251,12 @@ Optional argument FRAME, if non-nil, specifies the target frame.  */)
     if (driver_list->driver->list_family)
       {
        Lisp_Object val = driver_list->driver->list_family (frame);
+       Lisp_Object tail = list;
 
-       if (NILP (list))
-         list = val;
-       else
-         {
-           Lisp_Object tail = list;
-
-           for (; CONSP (val); val = XCDR (val))
-             if (NILP (Fmemq (XCAR (val), tail)))
-               list = Fcons (XCAR (val), list);
-         }
+       for (; CONSP (val); val = XCDR (val))
+         if (NILP (Fmemq (XCAR (val), tail))
+             && SYMBOLP (XCAR (val)))
+           list = Fcons (SYMBOL_NAME (XCAR (val)), list);
       }
   return list;
 }
@@ -4158,272 +4353,147 @@ DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
   return Qnil;
 }
 
-/* The following three functions are still experimental.  */
-
-DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
-       doc: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
-FONT-OBJECT may be nil if it is not yet known.
-
-G-string is sequence of glyphs of a specific font,
-and is a vector of this form:
-    [ HEADER GLYPH ... ]
-HEADER is a vector of this form:
-    [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
-where
-    FONT-OBJECT is a font-object for all glyphs in the g-string,
-    WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
-GLYPH is a vector of this form:
-    [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
-      [ [X-OFF Y-OFF WADJUST] | nil] ]
-where
-    FROM-IDX and TO-IDX are used internally and should not be touched.
-    C is the character of the glyph.
-    CODE is the glyph-code of C in FONT-OBJECT.
-    WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
-    X-OFF and Y-OFF are offests to the base position for the glyph.
-    WADJUST is the adjustment to the normal width of the glyph.  */)
-     (font_object, num)
-     Lisp_Object font_object, num;
-{
-  Lisp_Object gstring, g;
-  int len;
-  int i;
-
-  if (! NILP (font_object))
-    CHECK_FONT_OBJECT (font_object);
-  CHECK_NATNUM (num);
-
-  len = XINT (num) + 1;
-  gstring = Fmake_vector (make_number (len), Qnil);
-  g = Fmake_vector (make_number (6), Qnil);
-  ASET (g, 0, font_object);
-  ASET (gstring, 0, g);
-  for (i = 1; i < len; i++)
-    ASET (gstring, i, Fmake_vector (make_number (10), Qnil));
-  return gstring;
-}
-
-DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
-       doc: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
-START and END specify the region to extract characters.
-If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
-where to extract characters.
-FONT-OBJECT may be nil if GSTRING already contains one.  */)
-     (gstring, font_object, start, end, object)
-     Lisp_Object gstring, font_object, start, end, object;
+\f
+void
+font_fill_lglyph_metrics (glyph, font_object)
+     Lisp_Object glyph, font_object;
 {
-  int len, i, c;
+  struct font *font = XFONT_OBJECT (font_object);
   unsigned code;
-  struct font *font;
-
-  CHECK_VECTOR (gstring);
-  if (NILP (font_object))
-    font_object = LGSTRING_FONT (gstring);
-  font = XFONT_OBJECT (font_object);
-
-  if (STRINGP (object))
-    {
-      const unsigned char *p;
+  /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings.  */
+  EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
+  struct font_metrics metrics;
 
-      CHECK_NATNUM (start);
-      CHECK_NATNUM (end);
-      if (XINT (start) > XINT (end)
-         || XINT (end) > ASIZE (object)
-         || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
-       args_out_of_range_3 (object, start, end);
+  LGLYPH_SET_CODE (glyph, ecode);
+  code = ecode;
+  font->driver->text_extents (font, &code, 1, &metrics);
+  LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
+  LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
+  LGLYPH_SET_WIDTH (glyph, metrics.width);
+  LGLYPH_SET_ASCENT (glyph, metrics.ascent);
+  LGLYPH_SET_DESCENT (glyph, metrics.descent);
+}
 
-      len = XINT (end) - XINT (start);
-      p = SDATA (object) + string_char_to_byte (object, XINT (start));
-      for (i = 0; i < len; i++)
-       {
-         Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-         /* Shut up GCC warning in comparison with
-            MOST_POSITIVE_FIXNUM below.  */
-         EMACS_INT cod;
-
-         c = STRING_CHAR_ADVANCE (p);
-         cod = code = font->driver->encode_char (font, c);
-         if (cod > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
-           break;
-         LGLYPH_SET_FROM (g, i);
-         LGLYPH_SET_TO (g, i);
-         LGLYPH_SET_CHAR (g, c);
-         LGLYPH_SET_CODE (g, code);
-       }
-    }
-  else
-    {
-      int pos, pos_byte;
 
-      if (! NILP (object))
-       Fset_buffer (object);
-      validate_region (&start, &end);
-      if (XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
-       args_out_of_range (start, end);
-      len = XINT (end) - XINT (start);
-      pos = XINT (start);
-      pos_byte = CHAR_TO_BYTE (pos);
-      for (i = 0; i < len; i++)
-       {
-         Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-         /* Shut up GCC warning in comparison with
-            MOST_POSITIVE_FIXNUM below.  */
-         EMACS_INT cod;
-
-         FETCH_CHAR_ADVANCE (c, pos, pos_byte);
-         cod = code = font->driver->encode_char (font, c);
-         if (cod > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
-           break;
-         LGLYPH_SET_FROM (g, i);
-         LGLYPH_SET_TO (g, i);
-         LGLYPH_SET_CHAR (g, c);
-         LGLYPH_SET_CODE (g, code);
-       }
-    }
-  for (; i < LGSTRING_LENGTH (gstring); i++)
-    LGSTRING_SET_GLYPH (gstring, i, Qnil);
-  return Qnil;
-}
+DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
+       doc: /* Shape the glyph-string GSTRING.
+Shaping means substituting glyphs and/or adjusting positions of glyphs
+to get the correct visual image of character sequences set in the
+header of the glyph-string.
 
-DEFUN ("font-shape-text", Ffont_shape_text, Sfont_shape_text, 3, 4, 0,
-       doc: /* Shape text between FROM and TO by FONT-OBJECT.
-If optional 4th argument STRING is non-nil, it is a string to shape,
-and FROM and TO are indices to the string.
-The value is the end position of the text that can be shaped by
-FONT-OBJECT.  */)
-     (from, to, font_object, string)
-     Lisp_Object from, to, font_object, string;
+If the shaping was successful, the value is GSTRING itself or a newly
+created glyph-string.  Otherwise, the value is nil.  */)
+     (gstring)
+     Lisp_Object gstring;
 {
   struct font *font;
-  struct font_metrics metrics;
-  EMACS_INT start, end;
-  Lisp_Object gstring, n;
-  int len, i;
-
-  if (! FONT_OBJECT_P (font_object))
-    return Qnil;
+  Lisp_Object font_object, n, glyph;
+  int i, j, from, to;
+
+  if (! composition_gstring_p (gstring))
+    signal_error ("Invalid glyph-string: ", gstring);
+  if (! NILP (LGSTRING_ID (gstring)))
+    return gstring;
+  font_object = LGSTRING_FONT (gstring);
+  CHECK_FONT_OBJECT (font_object);
   font = XFONT_OBJECT (font_object);
   if (! font->driver->shape)
     return Qnil;
 
-  if (NILP (string))
-    {
-      validate_region (&from, &to);
-      start = XFASTINT (from);
-      end = XFASTINT (to);
-      modify_region (current_buffer, start, end, 0);
-    }
-  else
-    {
-      CHECK_STRING (string);
-      start = XINT (from);
-      end = XINT (to);
-      if (start < 0 || start > end || end > SCHARS (string))
-       args_out_of_range_3 (string, from, to);
-    }
-
-  len = end - start;
-  gstring = Ffont_make_gstring (font_object, make_number (len));
-  Ffont_fill_gstring (gstring, font_object, from, to, string);
-
   /* Try at most three times with larger gstring each time.  */
   for (i = 0; i < 3; i++)
     {
-      Lisp_Object args[2];
-
       n = font->driver->shape (gstring);
       if (INTEGERP (n))
        break;
-      args[0] = gstring;
-      args[1] = Fmake_vector (make_number (len), Qnil);
-      gstring = Fvconcat (2, args);
+      gstring = larger_vector (gstring,
+                              ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
+                              Qnil);
     }
-  if (! INTEGERP (n) || XINT (n) == 0)
+  if (i == 3 || XINT (n) == 0)
     return Qnil;
-  len = XINT (n);
-
-  for (i = 0; i < len;)
-    {
-      Lisp_Object gstr;
-      Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-      EMACS_INT this_from = LGLYPH_FROM (g);
-      EMACS_INT this_to = LGLYPH_TO (g) + 1;
-      int j, k;
-      int need_composition = 0;
-
-      metrics.lbearing = LGLYPH_LBEARING (g);
-      metrics.rbearing = LGLYPH_RBEARING (g);
-      metrics.ascent = LGLYPH_ASCENT (g);
-      metrics.descent = LGLYPH_DESCENT (g);
-      if (NILP (LGLYPH_ADJUSTMENT (g)))
-       {
-         metrics.width = LGLYPH_WIDTH (g);
-         if (LGLYPH_CHAR (g) == 0 || metrics.width == 0)
-           need_composition = 1;
-       }
-      else
-       {
-         metrics.width = LGLYPH_WADJUST (g);
-         metrics.lbearing += LGLYPH_XOFF (g);
-         metrics.rbearing += LGLYPH_XOFF (g);
-         metrics.ascent -= LGLYPH_YOFF (g);
-         metrics.descent += LGLYPH_YOFF (g);
-         need_composition = 1;
-       }
-      for (j = i + 1; j < len; j++)
-       {
-         int x;
 
-         g = LGSTRING_GLYPH (gstring, j);
-         if (this_from != LGLYPH_FROM (g))
-           break;
-         need_composition = 1;
-         x = metrics.width + LGLYPH_LBEARING (g) + LGLYPH_XOFF (g);
-         if (metrics.lbearing > x)
-           metrics.lbearing = x;
-         x = metrics.width + LGLYPH_RBEARING (g) + LGLYPH_XOFF (g);
-         if (metrics.rbearing < x)
-           metrics.rbearing = x;
-         x = LGLYPH_ASCENT (g) - LGLYPH_YOFF (g);
-         if (metrics.ascent < x)
-           metrics.ascent = x;
-         x = LGLYPH_DESCENT (g) - LGLYPH_YOFF (g);
-         if (metrics.descent < x)
-           metrics.descent = x;
-         if (NILP (LGLYPH_ADJUSTMENT (g)))
-           metrics.width += LGLYPH_WIDTH (g);
-         else
-           metrics.width += LGLYPH_WADJUST (g);
-       }
+  glyph = LGSTRING_GLYPH (gstring, 0);
+  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 (need_composition)
+      if (NILP (this))
+       break;
+      if (NILP (LGLYPH_ADJUSTMENT (this)))
        {
-         gstr = Ffont_make_gstring (font_object, make_number (j - i));
-         LGSTRING_SET_WIDTH (gstr, metrics.width);
-         LGSTRING_SET_LBEARING (gstr, metrics.lbearing);
-         LGSTRING_SET_RBEARING (gstr, metrics.rbearing);
-         LGSTRING_SET_ASCENT (gstr, metrics.ascent);
-         LGSTRING_SET_DESCENT (gstr, metrics.descent);
-         for (k = i; i < j; i++)
-           {
-             Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-
-             LGLYPH_SET_FROM (g, LGLYPH_FROM (g) - this_from);
-             LGLYPH_SET_TO (g, LGLYPH_TO (g) - this_from);
-             LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i));
-           }
-         from = make_number (start + this_from);
-         to = make_number (start + this_to);
-         if (NILP (string))
-           Fcompose_region_internal (from, to, gstr, Qnil);
-         else
-           Fcompose_string_internal (string, from, to, gstr, Qnil);
+         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
-       i = j;
+       {
+         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));
+}
 
-  return to;
+DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs,
+       2, 2, 0,
+       doc: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
+Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
+where
+  VARIATION-SELECTOR is a chracter code of variation selection
+    (#xFE00..#xFE0F or #xE0100..#xE01EF)
+  GLYPH-ID is a glyph code of the corresponding variation glyph.  */)
+     (font_object, character)
+     Lisp_Object font_object, character;
+{
+  unsigned variations[256];
+  struct font *font;
+  int i, n;
+  Lisp_Object val;
+
+  CHECK_FONT_OBJECT (font_object);
+  CHECK_CHARACTER (character);
+  font = XFONT_OBJECT (font_object);
+  if (! font->driver->get_variation_glyphs)
+    return Qnil;
+  n = font->driver->get_variation_glyphs (font, XINT (character), variations);
+  if (! n)
+    return Qnil;
+  val = Qnil;
+  for (i = 0; i < 255; i++)
+    if (variations[i])
+      {
+       Lisp_Object code;
+       int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
+       /* Stops GCC whining about limited range of data type.  */
+       EMACS_INT var = variations[i];
+
+       if (var > MOST_POSITIVE_FIXNUM)
+         code = Fcons (make_number ((variations[i]) >> 16),
+                       make_number ((variations[i]) & 0xFFFF));
+       else
+         code = make_number (variations[i]);
+       val = Fcons (Fcons (make_number (vs), code), val);
+      }
+  return val;
 }
 
 #if 0
@@ -4571,7 +4641,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)
@@ -4891,6 +4961,15 @@ build_style_table (entry, nelement)
 static Lisp_Object Vfont_log;
 static int font_log_env_checked;
 
+/* The deferred font-log data of the form [ACTION ARG RESULT].
+   If ACTION is not nil, that is added to the log when font_add_log is
+   called next time.  At that time, ACTION is set back to nil.  */
+static Lisp_Object Vfont_log_deferred;
+
+/* Prepend the font-related logging data in Vfont_log if it is not
+   `t'.  ACTION describes a kind of font-related action (e.g. listing,
+   opening), ARG is the argument for the action, and RESULT is the
+   result of the action.  */
 void
 font_add_log (action, arg, result)
      char *action;
@@ -4906,8 +4985,41 @@ font_add_log (action, arg, result)
     }
   if (EQ (Vfont_log, Qt))
     return;
+  if (STRINGP (AREF (Vfont_log_deferred, 0)))
+    {
+      char *str = (char *) SDATA (AREF (Vfont_log_deferred, 0));
+
+      ASET (Vfont_log_deferred, 0, Qnil);
+      font_add_log (str, AREF (Vfont_log_deferred, 1),
+                   AREF (Vfont_log_deferred, 2));
+    }
+
   if (FONTP (arg))
-    arg = Ffont_xlfd_name (arg, Qt);
+    {
+      Lisp_Object tail, elt;
+      Lisp_Object equalstr = build_string ("=");
+
+      val = Ffont_xlfd_name (arg, Qt);
+      for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
+          tail = XCDR (tail))
+       {
+         elt = XCAR (tail);
+         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)
+                  && SYMBOLP (XCDR (elt)))
+           val = concat3 (val, SYMBOL_NAME (QClang),
+                          concat2 (equalstr, SYMBOL_NAME (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)))));
+       }
+      arg = val;
+    }
   if (FONTP (result))
     {
       val = Ffont_xlfd_name (result, Qt);
@@ -4941,6 +5053,20 @@ font_add_log (action, arg, result)
   Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
 }
 
+/* Record a font-related logging data to be added to Vfont_log when
+   font_add_log is called next time.  ACTION, ARG, RESULT are the same
+   as font_add_log.  */
+
+void
+font_deferred_log (action, arg, result)
+     char *action;
+     Lisp_Object 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_ (());
 extern void syms_of_xftfont P_ (());
@@ -4948,6 +5074,7 @@ extern void syms_of_ftxfont P_ (());
 extern void syms_of_bdffont P_ (());
 extern void syms_of_w32font P_ (());
 extern void syms_of_atmfont P_ (());
+extern void syms_of_nsfont P_ (());
 
 void
 syms_of_font ()
@@ -4962,10 +5089,6 @@ syms_of_font ()
   staticpro (&font_charset_alist);
   font_charset_alist = Qnil;
 
-  DEFSYM (Qfont_spec, "font-spec");
-  DEFSYM (Qfont_entity, "font-entity");
-  DEFSYM (Qfont_object, "font-object");
-
   DEFSYM (Qopentype, "opentype");
 
   DEFSYM (Qascii_0, "ascii-0");
@@ -4974,6 +5097,8 @@ syms_of_font ()
   DEFSYM (Qunicode_bmp, "unicode-bmp");
   DEFSYM (Qunicode_sip, "unicode-sip");
 
+  DEFSYM (QCf, "Cf");
+
   DEFSYM (QCotf, ":otf");
   DEFSYM (QClang, ":lang");
   DEFSYM (QCscript, ":script");
@@ -5002,6 +5127,9 @@ syms_of_font ()
   staticpro (&scratch_font_prefer);
   scratch_font_prefer = Ffont_spec (0, NULL);
 
+  staticpro (&Vfont_log_deferred);
+  Vfont_log_deferred = Fmake_vector (make_number (3), Qnil);
+
 #if 0
 #ifdef HAVE_LIBOTF
   staticpro (&otf_list);
@@ -5021,9 +5149,8 @@ syms_of_font ()
   defsubr (&Sfind_font);
   defsubr (&Sfont_xlfd_name);
   defsubr (&Sclear_font_cache);
-  defsubr (&Sfont_make_gstring);
-  defsubr (&Sfont_fill_gstring);
-  defsubr (&Sfont_shape_text);
+  defsubr (&Sfont_shape_gstring);
+  defsubr (&Sfont_variation_glyphs);
 #if 0
   defsubr (&Sfont_drive_otf);
   defsubr (&Sfont_otf_alternates);
@@ -5117,9 +5244,9 @@ EMACS_FONT_LOG is set.  Otherwise, it is set to t.  */);
 #ifdef WINDOWSNT
   syms_of_w32font ();
 #endif /* WINDOWSNT */
-#ifdef MAC_OS
-  syms_of_atmfont ();
-#endif /* MAC_OS */
+#ifdef HAVE_NS
+  syms_of_nsfont ();
+#endif /* HAVE_NS */
 #endif /* HAVE_WINDOW_SYSTEM */
 }