From 64d0cd9810af6bd0c378fc6bc666c76ddfa97e40 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 23 Apr 2019 13:29:42 -0700 Subject: Remove font.c code commented out for a decade * src/font.c (LSTRING_HEADER_SIZE, LSTRING_GLYPH_SIZE, check_gstring) (check_otf_features, otf_list, otf_tag_symbol, otf_open) (font_otf_capability, generate_otf_features) (font_otf_DeviceTable, font_otf_ValueRecord) (font_otf_Anchor, Ffont_drive_otf, Ffont_otf_alternates) (Fdraw_string, syms_of_font): Remove "experimental and not tested much" code that has been "#if 0"-ed out for more than a decade and which was getting in the way of maintenance. --- src/font.c | 465 ------------------------------------------------------------- 1 file changed, 465 deletions(-) diff --git a/src/font.c b/src/font.c index 5ca89c97dcf..e7686cf4bb3 100644 --- a/src/font.c +++ b/src/font.c @@ -1786,296 +1786,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. */ static double @@ -4612,126 +4322,6 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, return Fcons (font_object, INT_TO_INTEGER (code)); } -#if 0 - -DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0, - doc: /* Apply OpenType features on glyph-string GSTRING-IN. -OTF-FEATURES specifies which features to apply in this format: - (SCRIPT LANGSYS GSUB GPOS) -where - SCRIPT is a symbol specifying a script tag of OpenType, - LANGSYS is a symbol specifying a langsys tag of OpenType, - GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags. - -If LANGSYS is nil, the default langsys is selected. - -The features are applied in the order they appear in the list. The -symbol `*' means to apply all available features not present in this -list, and the remaining features are ignored. For instance, (vatu -pstf * haln) is to apply vatu and pstf in this order, then to apply -all available features other than vatu, pstf, and haln. - -The features are applied to the glyphs in the range FROM and TO of -the glyph-string GSTRING-IN. - -If some feature is actually applicable, the resulting glyphs are -produced in the glyph-string GSTRING-OUT from the index INDEX. In -this case, the value is the number of produced glyphs. - -If no feature is applicable, no glyph is produced in GSTRING-OUT, and -the value is 0. - -If GSTRING-OUT is too short to hold produced glyphs, no glyphs are -produced in GSTRING-OUT, and the value is nil. - -See the documentation of `composition-get-gstring' for the format of -glyph-string. */) - (Lisp_Object otf_features, Lisp_Object gstring_in, Lisp_Object from, Lisp_Object to, Lisp_Object gstring_out, Lisp_Object index) -{ - Lisp_Object font_object = LGSTRING_FONT (gstring_in); - Lisp_Object val; - struct font *font; - int len, num; - - check_otf_features (otf_features); - CHECK_FONT_OBJECT (font_object); - font = XFONT_OBJECT (font_object); - if (! font->driver->otf_drive) - error ("Font backend %s can't drive OpenType GSUB table", - SDATA (SYMBOL_NAME (font->driver->type))); - CHECK_CONS (otf_features); - CHECK_SYMBOL (XCAR (otf_features)); - val = XCDR (otf_features); - CHECK_SYMBOL (XCAR (val)); - val = XCDR (otf_features); - if (! NILP (val)) - CHECK_CONS (val); - len = check_gstring (gstring_in); - CHECK_VECTOR (gstring_out); - CHECK_FIXNAT (from); - CHECK_FIXNAT (to); - CHECK_FIXNAT (index); - - if (XFIXNUM (from) >= XFIXNUM (to) || XFIXNUM (to) > len) - args_out_of_range_3 (from, to, make_fixnum (len)); - if (XFIXNUM (index) >= ASIZE (gstring_out)) - args_out_of_range (index, make_fixnum (ASIZE (gstring_out))); - num = font->driver->otf_drive (font, otf_features, - gstring_in, XFIXNUM (from), XFIXNUM (to), - gstring_out, XFIXNUM (index), 0); - if (num < 0) - return Qnil; - return make_fixnum (num); -} - -DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates, - 3, 3, 0, - doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT. -OTF-FEATURES specifies which features of the font FONT-OBJECT to apply -in this format: - (SCRIPT LANGSYS FEATURE ...) -See the documentation of `font-drive-otf' for more detail. - -The value is a list of cons cells of the format (GLYPH-ID . CHARACTER), -where GLYPH-ID is a glyph index of the font, and CHARACTER is a -character code corresponding to the glyph or nil if there's no -corresponding character. */) - (Lisp_Object font_object, Lisp_Object character, Lisp_Object otf_features) -{ - struct font *font = CHECK_FONT_GET_OBJECT (font_object); - Lisp_Object gstring_in, gstring_out, g; - Lisp_Object alternates; - int i, num; - - if (! font->driver->otf_drive) - error ("Font backend %s can't drive OpenType GSUB table", - SDATA (SYMBOL_NAME (font->driver->type))); - CHECK_CHARACTER (character); - CHECK_CONS (otf_features); - - gstring_in = Ffont_make_gstring (font_object, make_fixnum (1)); - g = LGSTRING_GLYPH (gstring_in, 0); - LGLYPH_SET_CHAR (g, XFIXNUM (character)); - gstring_out = Ffont_make_gstring (font_object, make_fixnum (10)); - while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1, - gstring_out, 0, 1)) < 0) - gstring_out = Ffont_make_gstring (font_object, - make_fixnum (ASIZE (gstring_out) * 2)); - alternates = Qnil; - for (i = 0; i < num; i++) - { - Lisp_Object g = LGSTRING_GLYPH (gstring_out, i); - int c = LGLYPH_CHAR (g); - unsigned code = LGLYPH_CODE (g); - - alternates = Fcons (Fcons (make_fixnum (code), - c > 0 ? make_fixnum (c) : Qnil), - alternates); - } - return Fnreverse (alternates); -} -#endif /* 0 */ - #ifdef FONT_DEBUG DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, @@ -4996,47 +4586,6 @@ character at index specified by POSITION. */) return font_at (-1, XFIXNUM (position), NULL, w, string); } -#if 0 -DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0, - doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame. -The value is a number of glyphs drawn. -Type C-l to recover what previously shown. */) - (Lisp_Object font_object, Lisp_Object string) -{ - Lisp_Object frame = selected_frame; - struct frame *f = XFRAME (frame); - struct font *font; - struct face *face; - int i, len, width; - unsigned *code; - - CHECK_FONT_GET_OBJECT (font_object, font); - CHECK_STRING (string); - len = SCHARS (string); - code = alloca (sizeof (unsigned) * len); - for (i = 0; i < len; i++) - { - Lisp_Object ch = Faref (string, make_fixnum (i)); - Lisp_Object val; - int c = XFIXNUM (ch); - - code[i] = font->driver->encode_char (font, c); - if (code[i] == FONT_INVALID_CODE) - break; - } - face = FACE_FROM_ID (f, DEFAULT_FACE_ID); - face->fontp = font; - if (font->driver->prepare_face) - font->driver->prepare_face (f, face); - width = font->driver->text_extents (font, code, i, NULL); - len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width); - if (font->driver->done_face) - font->driver->done_face (f, face); - face->fontp = NULL; - return make_fixnum (len); -} -#endif - DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0, doc: /* Return FRAME's font cache. Mainly used for debugging. If FRAME is omitted or nil, use the selected frame. */) @@ -5359,13 +4908,6 @@ syms_of_font (void) Vfont_log_deferred = make_nil_vector (3); staticpro (&Vfont_log_deferred); -#if 0 -#ifdef HAVE_LIBOTF - staticpro (&otf_list); - otf_list = Qnil; -#endif /* HAVE_LIBOTF */ -#endif /* 0 */ - defsubr (&Sfontp); defsubr (&Sfont_spec); defsubr (&Sfont_get); @@ -5381,10 +4923,6 @@ syms_of_font (void) defsubr (&Sfont_shape_gstring); defsubr (&Sfont_variation_glyphs); defsubr (&Sinternal_char_font); -#if 0 - defsubr (&Sfont_drive_otf); - defsubr (&Sfont_otf_alternates); -#endif /* 0 */ #ifdef FONT_DEBUG defsubr (&Sopen_font); @@ -5393,9 +4931,6 @@ syms_of_font (void) defsubr (&Sfont_get_glyphs); defsubr (&Sfont_match_p); defsubr (&Sfont_at); -#if 0 - defsubr (&Sdraw_string); -#endif defsubr (&Sframe_font_cache); #endif /* FONT_DEBUG */ #ifdef HAVE_WINDOW_SYSTEM -- cgit v1.2.1