emacs-28 00159c086c: ; Add commentary to disabled OTF support code in font.c

[Eli Zaretskii]

branch: emacs-28
commit 00159c086c64147798a4c64bf5d9b94c7e8939de
Author: Eli Zaretskii <eliz@gnu.org>
Commit: Eli Zaretskii <eliz@gnu.org>

    ; Add commentary to disabled OTF support code in font.c
    
    * src/font.c (check_gstring, check_otf_features, otf_tag_symbol)
    (otf_open, font_otf_capability, generate_otf_features)
    (font_otf_DeviceTable, font_otf_ValueRecord, font_otf_Anchor):
    Move closer to the primitives that use them.  Add commentary for
    the purpose of this code.
---
 src/font.c | 785 +++++++++++++++++++++++++++++++------------------------------
 1 file changed, 394 insertions(+), 391 deletions(-)

diff --git a/src/font.c b/src/font.c
index dcbcbc46be..8f448d9bdc 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1823,296 +1823,6 @@ font_parse_family_registry (Lisp_Object family, 
Lisp_Object registry, Lisp_Objec
 }
 
 
-/* This part (through the next ^L) is still experimental and not
-   tested much.  We may drastically change codes.  */
-
-/* OTF handler.  */
-
-#if 0
-
-#define LGSTRING_HEADER_SIZE 6
-#define LGSTRING_GLYPH_SIZE 8
-
-static int
-check_gstring (Lisp_Object gstring)
-{
-  Lisp_Object val;
-  ptrdiff_t i;
-  int j;
-
-  CHECK_VECTOR (gstring);
-  val = AREF (gstring, 0);
-  CHECK_VECTOR (val);
-  if (ASIZE (val) < LGSTRING_HEADER_SIZE)
-    goto err;
-  CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
-  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
-    CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
-  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
-    CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
-  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
-    CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
-  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
-    CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
-  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
-    CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
-
-  for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
-    {
-      val = LGSTRING_GLYPH (gstring, i);
-      CHECK_VECTOR (val);
-      if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
-       goto err;
-      if (NILP (AREF (val, LGLYPH_IX_CHAR)))
-       break;
-      CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM));
-      CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO));
-      CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
-      if (!NILP (AREF (val, LGLYPH_IX_CODE)))
-       CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE));
-      if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
-       CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH));
-      if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
-       {
-         val = AREF (val, LGLYPH_IX_ADJUSTMENT);
-         CHECK_VECTOR (val);
-         if (ASIZE (val) < 3)
-           goto err;
-         for (j = 0; j < 3; j++)
-           CHECK_FIXNUM (AREF (val, j));
-       }
-    }
-  return i;
- err:
-  error ("Invalid glyph-string format");
-  return -1;
-}
-
-static void
-check_otf_features (Lisp_Object otf_features)
-{
-  Lisp_Object val;
-
-  CHECK_CONS (otf_features);
-  CHECK_SYMBOL (XCAR (otf_features));
-  otf_features = XCDR (otf_features);
-  CHECK_CONS (otf_features);
-  CHECK_SYMBOL (XCAR (otf_features));
-  otf_features = XCDR (otf_features);
-  for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
-    {
-      CHECK_SYMBOL (XCAR (val));
-      if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
-       error ("Invalid OTF GSUB feature: %s",
-              SDATA (SYMBOL_NAME (XCAR (val))));
-    }
-  otf_features = XCDR (otf_features);
-  for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
-    {
-      CHECK_SYMBOL (XCAR (val));
-      if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
-       error ("Invalid OTF GPOS feature: %s",
-              SDATA (SYMBOL_NAME (XCAR (val))));
-    }
-}
-
-#ifdef HAVE_LIBOTF
-#include <otf.h>
-
-Lisp_Object otf_list;
-
-static Lisp_Object
-otf_tag_symbol (OTF_Tag tag)
-{
-  char name[5];
-
-  OTF_tag_name (tag, name);
-  return Fintern (make_unibyte_string (name, 4), Qnil);
-}
-
-static OTF *
-otf_open (Lisp_Object file)
-{
-  Lisp_Object val = Fassoc (file, otf_list, Qnil);
-  OTF *otf;
-
-  if (! NILP (val))
-    otf = xmint_pointer (XCDR (val));
-  else
-    {
-      otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
-      val = make_mint_ptr (otf);
-      otf_list = Fcons (Fcons (file, val), otf_list);
-    }
-  return otf;
-}
-
-
-/* Return a list describing which scripts/languages FONT supports by
-   which GSUB/GPOS features of OpenType tables.  See the comment of
-   (struct font_driver).otf_capability.  */
-
-Lisp_Object
-font_otf_capability (struct font *font)
-{
-  OTF *otf;
-  Lisp_Object capability = Fcons (Qnil, Qnil);
-  int i;
-
-  otf = otf_open (font->props[FONT_FILE_INDEX]);
-  if (! otf)
-    return Qnil;
-  for (i = 0; i < 2; i++)
-    {
-      OTF_GSUB_GPOS *gsub_gpos;
-      Lisp_Object script_list = Qnil;
-      int j;
-
-      if (OTF_get_features (otf, i == 0) < 0)
-       continue;
-      gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
-      for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
-       {
-         OTF_Script *script = gsub_gpos->ScriptList.Script + j;
-         Lisp_Object langsys_list = Qnil;
-         Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
-         int k;
-
-         for (k = script->LangSysCount; k >= 0; k--)
-           {
-             OTF_LangSys *langsys;
-             Lisp_Object feature_list = Qnil;
-             Lisp_Object langsys_tag;
-             int l;
-
-             if (k == script->LangSysCount)
-               {
-                 langsys = &script->DefaultLangSys;
-                 langsys_tag = Qnil;
-               }
-             else
-               {
-                 langsys = script->LangSys + k;
-                 langsys_tag
-                   = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
-               }
-             for (l = langsys->FeatureCount - 1; l >= 0; l--)
-               {
-                 OTF_Feature *feature
-                   = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
-                 Lisp_Object feature_tag
-                   = otf_tag_symbol (feature->FeatureTag);
-
-                 feature_list = Fcons (feature_tag, feature_list);
-               }
-             langsys_list = Fcons (Fcons (langsys_tag, feature_list),
-                                   langsys_list);
-           }
-         script_list = Fcons (Fcons (script_tag, langsys_list),
-                              script_list);
-       }
-
-      if (i == 0)
-       XSETCAR (capability, script_list);
-      else
-       XSETCDR (capability, script_list);
-    }
-
-  return capability;
-}
-
-/* Parse OTF features in SPEC and write a proper features spec string
-   in FEATURES for the call of OTF_drive_gsub/gpos (of libotf).  It is
-   assured that the sufficient memory has already allocated for
-   FEATURES.  */
-
-static void
-generate_otf_features (Lisp_Object spec, char *features)
-{
-  Lisp_Object val;
-  char *p;
-  bool asterisk;
-
-  p = features;
-  *p = '\0';
-  for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
-    {
-      val = XCAR (spec);
-      CHECK_SYMBOL (val);
-      if (p > features)
-       *p++ = ',';
-      if (SREF (SYMBOL_NAME (val), 0) == '*')
-       {
-         asterisk = 1;
-         *p++ = '*';
-       }
-      else if (! asterisk)
-       {
-         val = SYMBOL_NAME (val);
-         p += esprintf (p, "%s", SDATA (val));
-       }
-      else
-       {
-         val = SYMBOL_NAME (val);
-         p += esprintf (p, "~%s", SDATA (val));
-       }
-    }
-  if (CONSP (spec))
-    error ("OTF spec too long");
-}
-
-Lisp_Object
-font_otf_DeviceTable (OTF_DeviceTable *device_table)
-{
-  int len = device_table->StartSize - device_table->EndSize + 1;
-
-  return Fcons (make_fixnum (len),
-               make_unibyte_string (device_table->DeltaValue, len));
-}
-
-Lisp_Object
-font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
-{
-  Lisp_Object val = make_nil_vector (8);
-
-  if (value_format & OTF_XPlacement)
-    ASET (val, 0, make_fixnum (value_record->XPlacement));
-  if (value_format & OTF_YPlacement)
-    ASET (val, 1, make_fixnum (value_record->YPlacement));
-  if (value_format & OTF_XAdvance)
-    ASET (val, 2, make_fixnum (value_record->XAdvance));
-  if (value_format & OTF_YAdvance)
-    ASET (val, 3, make_fixnum (value_record->YAdvance));
-  if (value_format & OTF_XPlaDevice)
-    ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
-  if (value_format & OTF_YPlaDevice)
-    ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
-  if (value_format & OTF_XAdvDevice)
-    ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
-  if (value_format & OTF_YAdvDevice)
-    ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
-  return val;
-}
-
-Lisp_Object
-font_otf_Anchor (OTF_Anchor *anchor)
-{
-  Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1);
-  ASET (val, 0, make_fixnum (anchor->XCoordinate));
-  ASET (val, 1, make_fixnum (anchor->YCoordinate));
-  if (anchor->AnchorFormat == 2)
-    ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint));
-  else
-    {
-      ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
-      ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
-    }
-  return val;
-}
-#endif /* HAVE_LIBOTF */
-#endif /* 0 */
-
-
 /* Font sorting.  */
 
 static double
@@ -4657,132 +4367,424 @@ where
 a fixnum, if it's small enough, otherwise a bignum.  */)
   (Lisp_Object font_object, Lisp_Object character)
 {
-  unsigned variations[256];
-  struct font *font;
-  int i, n;
-  Lisp_Object val;
+  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, XFIXNUM (character), 
variations);
+  if (! n)
+    return Qnil;
+  val = Qnil;
+  for (i = 0; i < 255; i++)
+    if (variations[i])
+      {
+       int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
+       Lisp_Object code = INT_TO_INTEGER (variations[i]);
+       val = Fcons (Fcons (make_fixnum (vs), code), val);
+      }
+  return val;
+}
+
+/* Return a description of the font at POSITION in the current buffer.
+   If the 2nd optional arg CH is non-nil, it is a character to check
+   the font instead of the character at POSITION.
+
+   For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
+   FONT-OBJECT is the font for the character at POSITION in the current
+   buffer.  This is computed from all the text properties and overlays
+   that apply to POSITION.  POSITION may be nil, in which case,
+   FONT-SPEC is the font for displaying the character CH with the
+   default face.  GLYPH-CODE is the glyph code in the font to use for
+   the character, it is a fixnum, if it is small enough, otherwise a
+   bignum.
+
+   For a text terminal, return a nonnegative integer glyph code for
+   the character, or a negative integer if the character is not
+   displayable.  Terminal glyph codes are system-dependent integers
+   that represent displayable characters: for example, on a Linux x86
+   console they represent VGA code points.
+
+   It returns nil in the following cases:
+
+   (1) The window system doesn't have a font for the character (thus
+   it is displayed by an empty box).
+
+   (2) The character code is invalid.
+
+   (3) If POSITION is not nil, and the current buffer is not displayed
+   in any window.
+
+   (4) For a text terminal, the terminal does not report glyph codes.
+
+   In addition, the returned font name may not take into account of
+   such redisplay engine hooks as what used in jit-lock-mode if
+   POSITION is currently not visible.  */
+
+
+DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
+       doc: /* For internal use only.  */)
+  (Lisp_Object position, Lisp_Object ch)
+{
+  ptrdiff_t pos, pos_byte, dummy;
+  int face_id;
+  int c;
+  struct frame *f;
+
+  if (NILP (position))
+    {
+      CHECK_CHARACTER (ch);
+      c = XFIXNUM (ch);
+      f = XFRAME (selected_frame);
+      face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
+      pos = -1;
+    }
+  else
+    {
+      Lisp_Object window;
+      struct window *w;
+
+      EMACS_INT fixed_pos = fix_position (position);
+      if (! (BEGV <= fixed_pos && fixed_pos < ZV))
+       args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
+      pos = fixed_pos;
+      pos_byte = CHAR_TO_BYTE (pos);
+      if (NILP (ch))
+       c = FETCH_CHAR (pos_byte);
+      else
+       {
+         CHECK_FIXNAT (ch);
+         c = XFIXNUM (ch);
+       }
+      window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
+      if (NILP (window))
+       return Qnil;
+      w = XWINDOW (window);
+      f = XFRAME (w->frame);
+      face_id = face_at_buffer_position (w, pos, &dummy,
+                                         pos + 100, false, -1, 0);
+    }
+  if (! CHAR_VALID_P (c))
+    return Qnil;
+
+  if (! FRAME_WINDOW_P (f))
+    return terminal_glyph_code (FRAME_TERMINAL (f), c);
+
+  /* We need the basic faces to be valid below, so recompute them if
+     some code just happened to clear the face cache.  */
+  if (FRAME_FACE_CACHE (f)->used == 0)
+    recompute_basic_faces (f);
+
+  face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
+  struct face *face = FACE_FROM_ID (f, face_id);
+  if (! face->font)
+    return Qnil;
+  unsigned code = face->font->driver->encode_char (face->font, c);
+  if (code == FONT_INVALID_CODE)
+    return Qnil;
+  Lisp_Object font_object;
+  XSETFONT (font_object, face->font);
+  return Fcons (font_object, INT_TO_INTEGER (code));
+}
+
+
+/* This part (through the next ^L) is still experimental and not
+   tested much.  We may drastically change codes.  */
+
+/* This code implements support for extracting OTF features of a font
+   and exposing them to Lisp, including application of those features
+   to arbitrary stretches of text.  FIXME: it would be good to finish
+   this work and have this in Emacs.  */
+
+/* OTF handler.  */
+
+#if 0
+
+#define LGSTRING_HEADER_SIZE 6
+#define LGSTRING_GLYPH_SIZE 8
+
+static int
+check_gstring (Lisp_Object gstring)
+{
+  Lisp_Object val;
+  ptrdiff_t i;
+  int j;
+
+  CHECK_VECTOR (gstring);
+  val = AREF (gstring, 0);
+  CHECK_VECTOR (val);
+  if (ASIZE (val) < LGSTRING_HEADER_SIZE)
+    goto err;
+  CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
+  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)))
+    CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
+  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
+    CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
+  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
+    CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
+  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
+    CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
+  if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
+    CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
+
+  for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
+    {
+      val = LGSTRING_GLYPH (gstring, i);
+      CHECK_VECTOR (val);
+      if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
+       goto err;
+      if (NILP (AREF (val, LGLYPH_IX_CHAR)))
+       break;
+      CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM));
+      CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO));
+      CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
+      if (!NILP (AREF (val, LGLYPH_IX_CODE)))
+       CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE));
+      if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
+       CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH));
+      if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
+       {
+         val = AREF (val, LGLYPH_IX_ADJUSTMENT);
+         CHECK_VECTOR (val);
+         if (ASIZE (val) < 3)
+           goto err;
+         for (j = 0; j < 3; j++)
+           CHECK_FIXNUM (AREF (val, j));
+       }
+    }
+  return i;
+ err:
+  error ("Invalid glyph-string format");
+  return -1;
+}
+
+static void
+check_otf_features (Lisp_Object otf_features)
+{
+  Lisp_Object val;
+
+  CHECK_CONS (otf_features);
+  CHECK_SYMBOL (XCAR (otf_features));
+  otf_features = XCDR (otf_features);
+  CHECK_CONS (otf_features);
+  CHECK_SYMBOL (XCAR (otf_features));
+  otf_features = XCDR (otf_features);
+  for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
+    {
+      CHECK_SYMBOL (XCAR (val));
+      if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
+       error ("Invalid OTF GSUB feature: %s",
+              SDATA (SYMBOL_NAME (XCAR (val))));
+    }
+  otf_features = XCDR (otf_features);
+  for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
+    {
+      CHECK_SYMBOL (XCAR (val));
+      if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
+       error ("Invalid OTF GPOS feature: %s",
+              SDATA (SYMBOL_NAME (XCAR (val))));
+    }
+}
+
+#ifdef HAVE_LIBOTF
+#include <otf.h>
+
+Lisp_Object otf_list;
+
+static Lisp_Object
+otf_tag_symbol (OTF_Tag tag)
+{
+  char name[5];
+
+  OTF_tag_name (tag, name);
+  return Fintern (make_unibyte_string (name, 4), Qnil);
+}
+
+static OTF *
+otf_open (Lisp_Object file)
+{
+  Lisp_Object val = Fassoc (file, otf_list, Qnil);
+  OTF *otf;
 
-  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, XFIXNUM (character), 
variations);
-  if (! n)
-    return Qnil;
-  val = Qnil;
-  for (i = 0; i < 255; i++)
-    if (variations[i])
-      {
-       int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
-       Lisp_Object code = INT_TO_INTEGER (variations[i]);
-       val = Fcons (Fcons (make_fixnum (vs), code), val);
-      }
-  return val;
+  if (! NILP (val))
+    otf = xmint_pointer (XCDR (val));
+  else
+    {
+      otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
+      val = make_mint_ptr (otf);
+      otf_list = Fcons (Fcons (file, val), otf_list);
+    }
+  return otf;
 }
 
-/* Return a description of the font at POSITION in the current buffer.
-   If the 2nd optional arg CH is non-nil, it is a character to check
-   the font instead of the character at POSITION.
 
-   For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
-   FONT-OBJECT is the font for the character at POSITION in the current
-   buffer.  This is computed from all the text properties and overlays
-   that apply to POSITION.  POSITION may be nil, in which case,
-   FONT-SPEC is the font for displaying the character CH with the
-   default face.  GLYPH-CODE is the glyph code in the font to use for
-   the character, it is a fixnum, if it is small enough, otherwise a
-   bignum.
+/* Return a list describing which scripts/languages FONT supports by
+   which GSUB/GPOS features of OpenType tables.  See the comment of
+   (struct font_driver).otf_capability.  */
 
-   For a text terminal, return a nonnegative integer glyph code for
-   the character, or a negative integer if the character is not
-   displayable.  Terminal glyph codes are system-dependent integers
-   that represent displayable characters: for example, on a Linux x86
-   console they represent VGA code points.
+Lisp_Object
+font_otf_capability (struct font *font)
+{
+  OTF *otf;
+  Lisp_Object capability = Fcons (Qnil, Qnil);
+  int i;
 
-   It returns nil in the following cases:
+  otf = otf_open (font->props[FONT_FILE_INDEX]);
+  if (! otf)
+    return Qnil;
+  for (i = 0; i < 2; i++)
+    {
+      OTF_GSUB_GPOS *gsub_gpos;
+      Lisp_Object script_list = Qnil;
+      int j;
 
-   (1) The window system doesn't have a font for the character (thus
-   it is displayed by an empty box).
+      if (OTF_get_features (otf, i == 0) < 0)
+       continue;
+      gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
+      for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
+       {
+         OTF_Script *script = gsub_gpos->ScriptList.Script + j;
+         Lisp_Object langsys_list = Qnil;
+         Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
+         int k;
 
-   (2) The character code is invalid.
+         for (k = script->LangSysCount; k >= 0; k--)
+           {
+             OTF_LangSys *langsys;
+             Lisp_Object feature_list = Qnil;
+             Lisp_Object langsys_tag;
+             int l;
 
-   (3) If POSITION is not nil, and the current buffer is not displayed
-   in any window.
+             if (k == script->LangSysCount)
+               {
+                 langsys = &script->DefaultLangSys;
+                 langsys_tag = Qnil;
+               }
+             else
+               {
+                 langsys = script->LangSys + k;
+                 langsys_tag
+                   = otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
+               }
+             for (l = langsys->FeatureCount - 1; l >= 0; l--)
+               {
+                 OTF_Feature *feature
+                   = gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
+                 Lisp_Object feature_tag
+                   = otf_tag_symbol (feature->FeatureTag);
 
-   (4) For a text terminal, the terminal does not report glyph codes.
+                 feature_list = Fcons (feature_tag, feature_list);
+               }
+             langsys_list = Fcons (Fcons (langsys_tag, feature_list),
+                                   langsys_list);
+           }
+         script_list = Fcons (Fcons (script_tag, langsys_list),
+                              script_list);
+       }
 
-   In addition, the returned font name may not take into account of
-   such redisplay engine hooks as what used in jit-lock-mode if
-   POSITION is currently not visible.  */
+      if (i == 0)
+       XSETCAR (capability, script_list);
+      else
+       XSETCDR (capability, script_list);
+    }
 
+  return capability;
+}
 
-DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
-       doc: /* For internal use only.  */)
-  (Lisp_Object position, Lisp_Object ch)
+/* Parse OTF features in SPEC and write a proper features spec string
+   in FEATURES for the call of OTF_drive_gsub/gpos (of libotf).  It is
+   assured that the sufficient memory has already allocated for
+   FEATURES.  */
+
+static void
+generate_otf_features (Lisp_Object spec, char *features)
 {
-  ptrdiff_t pos, pos_byte, dummy;
-  int face_id;
-  int c;
-  struct frame *f;
+  Lisp_Object val;
+  char *p;
+  bool asterisk;
 
-  if (NILP (position))
-    {
-      CHECK_CHARACTER (ch);
-      c = XFIXNUM (ch);
-      f = XFRAME (selected_frame);
-      face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
-      pos = -1;
-    }
-  else
+  p = features;
+  *p = '\0';
+  for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
     {
-      Lisp_Object window;
-      struct window *w;
-
-      EMACS_INT fixed_pos = fix_position (position);
-      if (! (BEGV <= fixed_pos && fixed_pos < ZV))
-       args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
-      pos = fixed_pos;
-      pos_byte = CHAR_TO_BYTE (pos);
-      if (NILP (ch))
-       c = FETCH_CHAR (pos_byte);
+      val = XCAR (spec);
+      CHECK_SYMBOL (val);
+      if (p > features)
+       *p++ = ',';
+      if (SREF (SYMBOL_NAME (val), 0) == '*')
+       {
+         asterisk = 1;
+         *p++ = '*';
+       }
+      else if (! asterisk)
+       {
+         val = SYMBOL_NAME (val);
+         p += esprintf (p, "%s", SDATA (val));
+       }
       else
        {
-         CHECK_FIXNAT (ch);
-         c = XFIXNUM (ch);
+         val = SYMBOL_NAME (val);
+         p += esprintf (p, "~%s", SDATA (val));
        }
-      window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
-      if (NILP (window))
-       return Qnil;
-      w = XWINDOW (window);
-      f = XFRAME (w->frame);
-      face_id = face_at_buffer_position (w, pos, &dummy,
-                                         pos + 100, false, -1, 0);
     }
-  if (! CHAR_VALID_P (c))
-    return Qnil;
+  if (CONSP (spec))
+    error ("OTF spec too long");
+}
 
-  if (! FRAME_WINDOW_P (f))
-    return terminal_glyph_code (FRAME_TERMINAL (f), c);
+Lisp_Object
+font_otf_DeviceTable (OTF_DeviceTable *device_table)
+{
+  int len = device_table->StartSize - device_table->EndSize + 1;
 
-  /* We need the basic faces to be valid below, so recompute them if
-     some code just happened to clear the face cache.  */
-  if (FRAME_FACE_CACHE (f)->used == 0)
-    recompute_basic_faces (f);
+  return Fcons (make_fixnum (len),
+               make_unibyte_string (device_table->DeltaValue, len));
+}
 
-  face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
-  struct face *face = FACE_FROM_ID (f, face_id);
-  if (! face->font)
-    return Qnil;
-  unsigned code = face->font->driver->encode_char (face->font, c);
-  if (code == FONT_INVALID_CODE)
-    return Qnil;
-  Lisp_Object font_object;
-  XSETFONT (font_object, face->font);
-  return Fcons (font_object, INT_TO_INTEGER (code));
+Lisp_Object
+font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
+{
+  Lisp_Object val = make_nil_vector (8);
+
+  if (value_format & OTF_XPlacement)
+    ASET (val, 0, make_fixnum (value_record->XPlacement));
+  if (value_format & OTF_YPlacement)
+    ASET (val, 1, make_fixnum (value_record->YPlacement));
+  if (value_format & OTF_XAdvance)
+    ASET (val, 2, make_fixnum (value_record->XAdvance));
+  if (value_format & OTF_YAdvance)
+    ASET (val, 3, make_fixnum (value_record->YAdvance));
+  if (value_format & OTF_XPlaDevice)
+    ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
+  if (value_format & OTF_YPlaDevice)
+    ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
+  if (value_format & OTF_XAdvDevice)
+    ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
+  if (value_format & OTF_YAdvDevice)
+    ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
+  return val;
 }
 
-#if 0
+Lisp_Object
+font_otf_Anchor (OTF_Anchor *anchor)
+{
+  Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1);
+  ASET (val, 0, make_fixnum (anchor->XCoordinate));
+  ASET (val, 1, make_fixnum (anchor->YCoordinate));
+  if (anchor->AnchorFormat == 2)
+    ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint));
+  else
+    {
+      ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
+      ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
+    }
+  return val;
+}
+#endif /* HAVE_LIBOTF */
 
 DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
        doc: /* Apply OpenType features on glyph-string GSTRING-IN.
@@ -4902,6 +4904,7 @@ corresponding character.  */)
 }
 #endif /* 0 */
 
+
 #ifdef FONT_DEBUG
 
 DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,