From 00159c086c64147798a4c64bf5d9b94c7e8939de Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Sep 2022 09:35:10 +0300 Subject: [PATCH] ; 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 dcbcbc46be6..8f448d9bdc3 100644 --- a/src/font.c +++ b/src/font.c @@ -1822,296 +1822,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 - -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. */ @@ -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 + +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, -- 2.39.2