X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f73891b012ed8fc4c3769ea7d8814bc9cf260b38..1701724c31e96a930fa6f1de03f9f2f858826641:/src/font.c diff --git a/src/font.c b/src/font.c index b1bdd10d51..43af7345c3 100644 --- a/src/font.c +++ b/src/font.c @@ -25,6 +25,9 @@ Boston, MA 02110-1301, USA. */ #include #include #include +#ifdef HAVE_M17N_FLT +#include +#endif #include "lisp.h" #include "buffer.h" @@ -50,7 +53,7 @@ Boston, MA 02110-1301, USA. */ int enable_font_backend; -Lisp_Object Qfontp; +Lisp_Object Qopentype; /* Important character set symbols. */ Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip; @@ -86,7 +89,7 @@ Lisp_Object null_string; Lisp_Object null_vector; /* Vector of 3 elements. Each element is an alist for one of font - style properties (weight, slant, width). The alist contains a + style properties (weight, slant, width). Each alist contains a mapping between symbolic property values (e.g. `medium' for weight) and numeric property values (e.g. 100). So, it looks like this: [((thin . 0) ... (heavy . 210)) @@ -105,11 +108,30 @@ extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth, QCsize, QCname; Lisp_Object QCfoundry, QCadstyle, QCregistry, QCextra; /* Symbols representing keys of font extra info. */ Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClanguage, QCscript; +Lisp_Object QCantialias; /* Symbols representing values of font spacing property. */ Lisp_Object Qc, Qm, Qp, Qd; -/* List of all font drivers. All font-backends (XXXfont.c) call - add_font_driver in syms_of_XXXfont to register the font-driver +/* Alist of font registry symbol and the corresponding charsets + information. The information is retrieved from + Vfont_encoding_alist on demand. + + Eash element has the form: + (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID)) + or + (REGISTRY . nil) + + In the former form, ENCODING-CHARSET-ID is an ID of a charset that + encodes a character code to a glyph code of a font, and + REPERTORY-CHARSET-ID is an ID of a charset that tells if a + character is supported by a font. + + The latter form means that the information for REGISTRY couldn't be + retrieved. */ +static Lisp_Object font_charset_alist; + +/* List of all font drivers. Each font-backend (XXXfont.c) calls + register_font_driver in syms_of_XXXfont to register its font-driver here. */ static struct font_driver_list *font_driver_list; @@ -141,7 +163,7 @@ font_pixel_size (f, spec) return 0; point_size = XFLOAT_DATA (size); extra = AREF (spec, FONT_EXTRA_INDEX); - val = assq_no_quit (extra, QCdpi); + val = assq_no_quit (QCdpi, extra); if (CONSP (val)) { if (INTEGERP (XCDR (val))) @@ -230,6 +252,11 @@ intern_downcase (str, len) extern Lisp_Object Vface_alternative_font_family_alist; +/* Setup font_family_alist of the form: + ((FAMILY-SYMBOL ALIAS-SYMBOL ...) ...) + from Vface_alternative_font_family_alist of the form: + ((FAMILY-STRING ALIAS-STRING ...) ...) */ + static void build_font_family_alist () { @@ -245,24 +272,82 @@ build_font_family_alist () } } +extern Lisp_Object find_font_encoding P_ ((Lisp_Object)); + +/* Return encoding charset and repertory charset for REGISTRY in + ENCODING and REPERTORY correspondingly. If correct information for + REGISTRY is available, return 0. Otherwise return -1. */ + +int +font_registry_charsets (registry, encoding, repertory) + Lisp_Object registry; + struct charset **encoding, **repertory; +{ + Lisp_Object val; + int encoding_id, repertory_id; + + val = assq_no_quit (registry, font_charset_alist); + if (! NILP (val)) + { + val = XCDR (val); + if (NILP (val)) + return -1; + encoding_id = XINT (XCAR (val)); + repertory_id = XINT (XCDR (val)); + } + else + { + val = find_font_encoding (SYMBOL_NAME (registry)); + if (SYMBOLP (val) && CHARSETP (val)) + { + encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val)); + } + else if (CONSP (val)) + { + if (! CHARSETP (XCAR (val))) + goto invalid_entry; + encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val))); + if (NILP (XCDR (val))) + repertory_id = -1; + else + { + if (! CHARSETP (XCDR (val))) + goto invalid_entry; + repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val))); + } + } + else + goto invalid_entry; + val = Fcons (make_number (encoding_id), make_number (repertory_id)); + font_charset_alist + = nconc2 (font_charset_alist, Fcons (Fcons (registry, val), Qnil)); + } + + if (encoding) + *encoding = CHARSET_FROM_ID (encoding_id); + if (repertory) + *repertory = repertory_id >= 0 ? CHARSET_FROM_ID (repertory_id) : NULL; + return 0; + + invalid_entry: + font_charset_alist + = nconc2 (font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil)); + return -1; +} + -/* Font property validater. */ - -static Lisp_Object font_prop_validate_symbol P_ ((enum font_property_index, - Lisp_Object, Lisp_Object)); -static Lisp_Object font_prop_validate_style P_ ((enum font_property_index, - Lisp_Object, Lisp_Object)); -static Lisp_Object font_prop_validate_non_neg P_ ((enum font_property_index, - Lisp_Object, Lisp_Object)); -static Lisp_Object font_prop_validate_spacing P_ ((enum font_property_index, - Lisp_Object, Lisp_Object)); +/* Font property value validaters. See the comment of + font_property_table for the meaning of the arguments. */ + +static Lisp_Object font_prop_validate_symbol P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object font_prop_validate_style P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object font_prop_validate_non_neg P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object font_prop_validate_spacing P_ ((Lisp_Object, Lisp_Object)); static int get_font_prop_index P_ ((Lisp_Object, int)); static Lisp_Object font_prop_validate P_ ((Lisp_Object)); -static Lisp_Object font_put_extra P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); static Lisp_Object -font_prop_validate_symbol (prop_index, prop, val) - enum font_property_index prop_index; +font_prop_validate_symbol (prop, val) Lisp_Object prop, val; { if (EQ (prop, QCotf)) @@ -281,8 +366,7 @@ font_prop_validate_symbol (prop_index, prop, val) } static Lisp_Object -font_prop_validate_style (prop_index, prop, val) - enum font_property_index prop_index; +font_prop_validate_style (prop, val) Lisp_Object prop, val; { if (! INTEGERP (val)) @@ -293,6 +377,11 @@ font_prop_validate_style (prop_index, prop, val) val = Qerror; else { + enum font_property_index prop_index + = (EQ (prop, QCweight) ? FONT_WEIGHT_INDEX + : EQ (prop, QCslant) ? FONT_SLANT_INDEX + : FONT_WIDTH_INDEX); + val = prop_name_to_numeric (prop_index, val); if (NILP (val)) val = Qerror; @@ -302,8 +391,7 @@ font_prop_validate_style (prop_index, prop, val) } static Lisp_Object -font_prop_validate_non_neg (prop_index, prop, val) - enum font_property_index prop_index; +font_prop_validate_non_neg (prop, val) Lisp_Object prop, val; { return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0) @@ -311,8 +399,7 @@ font_prop_validate_non_neg (prop_index, prop, val) } static Lisp_Object -font_prop_validate_spacing (prop_index, prop, val) - enum font_property_index prop_index; +font_prop_validate_spacing (prop, val) Lisp_Object prop, val; { if (NILP (val) || (NATNUMP (val) && XINT (val) <= FONT_SPACING_CHARCELL)) @@ -326,15 +413,51 @@ font_prop_validate_spacing (prop_index, prop, val) return Qerror; } +static Lisp_Object +font_prop_validate_otf (prop, val) + Lisp_Object prop, val; +{ + Lisp_Object tail, tmp; + int i; + + /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]]) + GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil + GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */ + if (! CONSP (val)) + return Qerror; + if (! SYMBOLP (XCAR (val))) + return Qerror; + tail = XCDR (val); + if (NILP (tail)) + return val; + if (! CONSP (tail) || ! SYMBOLP (XCAR (val))) + return Qerror; + for (i = 0; i < 2; i++) + { + tail = XCDR (tail); + if (NILP (tail)) + return val; + if (! CONSP (tail)) + return Qerror; + for (tmp = XCAR (tail); CONSP (tmp); tmp = XCDR (tmp)) + if (! SYMBOLP (XCAR (tmp))) + return Qerror; + if (! NILP (tmp)) + return Qerror; + } + return val; +} + /* Structure of known font property keys and validater of the values. */ struct { /* Pointer to the key symbol. */ Lisp_Object *key; - /* Function to validate the value VAL, or NULL if any value is ok. */ - Lisp_Object (*validater) P_ ((enum font_property_index prop_index, - Lisp_Object prop, Lisp_Object val)); + /* Function to validate PROP's value VAL, or NULL if any value is + ok. The value is VAL or its regularized value if VAL is valid, + and Qerror if not. */ + Lisp_Object (*validater) P_ ((Lisp_Object prop, Lisp_Object val)); } font_property_table[] = { { &QCtype, font_prop_validate_symbol }, { &QCfoundry, font_prop_validate_symbol }, @@ -350,12 +473,18 @@ struct { &QCdpi, font_prop_validate_non_neg }, { &QCspacing, font_prop_validate_spacing }, { &QCscalable, NULL }, - { &QCotf, font_prop_validate_symbol } + { &QCotf, font_prop_validate_otf }, + { &QCantialias, font_prop_validate_symbol } }; +/* Size (number of elements) of the above table. */ #define FONT_PROPERTY_TABLE_SIZE \ ((sizeof font_property_table) / (sizeof *font_property_table)) +/* Return an index number of font property KEY or -1 if KEY is not an + already known property. Start searching font_property_table from + index FROM (which is 0 or FONT_EXTRA_INDEX). */ + static int get_font_prop_index (key, from) Lisp_Object key; @@ -367,6 +496,10 @@ get_font_prop_index (key, from) return -1; } +/* Validate font properties in SPEC (vector) while updating elements + to regularized values. Signal an error if an invalid property is + found. */ + static Lisp_Object font_prop_validate (spec) Lisp_Object spec; @@ -379,7 +512,7 @@ font_prop_validate (spec) if (! NILP (AREF (spec, i))) { prop = *font_property_table[i].key; - val = (font_property_table[i].validater) (i, prop, AREF (spec, i)); + val = (font_property_table[i].validater) (prop, AREF (spec, i)); if (EQ (val, Qerror)) Fsignal (Qfont, list2 (build_string ("invalid font property"), Fcons (prop, AREF (spec, i)))); @@ -396,7 +529,7 @@ font_prop_validate (spec) if (i >= 0 && font_property_table[i].validater) { - val = (font_property_table[i].validater) (i, prop, XCDR (elt)); + val = (font_property_table[i].validater) (prop, XCDR (elt)); if (EQ (val, Qerror)) Fsignal (Qfont, list2 (build_string ("invalid font property"), elt)); @@ -406,7 +539,9 @@ font_prop_validate (spec) return spec; } -static Lisp_Object +/* Store VAL as a value of extra font property PROP in FONT. */ + +Lisp_Object font_put_extra (font, prop, val) Lisp_Object font, prop, val; { @@ -749,7 +884,7 @@ font_parse_xlfd (name, font) int i, j; Lisp_Object dpi, spacing; int avgwidth; - char *f[XLFD_LAST_INDEX]; + char *f[XLFD_LAST_INDEX + 1]; Lisp_Object val; char *p; @@ -1356,6 +1491,10 @@ font_parse_name (name, font) return font_parse_fcname (name, font); } +/* Merge old style font specification (either a font name NAME or a + combination of a family name FAMILY and a registry name REGISTRY + into the font specification SPEC. */ + void font_merge_old_spec (name, family, registry, spec) Lisp_Object name, family, registry, spec; @@ -1400,22 +1539,11 @@ font_merge_old_spec (name, family, registry, spec) } } -static Lisp_Object -font_lispy_object (font) - struct font *font; -{ - Lisp_Object objlist = AREF (font->entity, FONT_OBJLIST_INDEX); - - for (; ! NILP (objlist); objlist = XCDR (objlist)) - { - struct Lisp_Save_Value *p = XSAVE_VALUE (XCAR (objlist)); + +/* This part (through the next ^L) is still experimental and never + tested. We may drastically change codes. */ - if (font == (struct font *) p->pointer) - break; - } - xassert (! NILP (objlist)); - return XCAR (objlist); -} +/* OTF handler */ #define LGSTRING_HEADER_SIZE 6 #define LGSTRING_GLYPH_SIZE 8 @@ -1475,20 +1603,37 @@ check_gstring (gstring) return -1; } - -/* OTF handler */ +static void +check_otf_features (otf_features) + Lisp_Object otf_features; +{ + Lisp_Object val, elt; + + 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); ! NILP (val); val = Fcdr (val)) + { + CHECK_SYMBOL (Fcar (val)); + if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) + error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val))); + } + otf_features = XCDR (otf_features); + for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val)) + { + CHECK_SYMBOL (Fcar (val)); + if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) + error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val))); + } +} #ifdef HAVE_LIBOTF #include -struct otf_list -{ - Lisp_Object entity; - OTF *otf; - struct otf_list *next; -}; - -static struct otf_list *otf_list; +Lisp_Object otf_list; static Lisp_Object otf_tag_symbol (tag) @@ -1505,19 +1650,18 @@ otf_open (entity, file) Lisp_Object entity; char *file; { - struct otf_list *list = otf_list; - - while (list && ! EQ (list->entity, entity)) - list = list->next; - if (! list) + Lisp_Object val = Fassoc (entity, otf_list); + OTF *otf; + + if (! NILP (val)) + otf = XSAVE_VALUE (XCDR (val))->pointer; + else { - list = malloc (sizeof (struct otf_list)); - list->entity = entity; - list->otf = file ? OTF_open (file) : NULL; - list->next = otf_list; - otf_list = list; + otf = file ? OTF_open (file) : NULL; + val = make_save_value (otf, 0); + otf_list = Fcons (Fcons (entity, val), otf_list); } - return list->otf; + return otf; } @@ -1595,58 +1739,41 @@ font_otf_capability (font) 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 -parse_gsub_gpos_spec (spec, script, langsys, features, nbytes) +generate_otf_features (spec, features) Lisp_Object spec; - char **script, **langsys, *features; - int nbytes; + char *features; { Lisp_Object val; char *p, *pend; int asterisk; - CHECK_CONS (spec); - val = XCAR (spec); - CHECK_SYMBOL (val); - *script = (char *) SDATA (SYMBOL_NAME (val)); - spec = XCDR (spec); - CHECK_CONS (spec); - val = XCAR (spec); - CHECK_SYMBOL (val); - *langsys = NILP (val) ? NULL : (char *) SDATA (SYMBOL_NAME (val)); - spec = XCDR (spec); - - p = features, pend = p + nbytes - 1; + p = features; *p = '\0'; for (asterisk = 0; CONSP (spec); spec = XCDR (spec)) { val = XCAR (spec); CHECK_SYMBOL (val); if (p > features) - { - if (p >= pend) - break; - *p++ = ','; - } + *p++ = ','; if (SREF (SYMBOL_NAME (val), 0) == '*') { asterisk = 1; - if (p >= pend) - break; *p++ = '*'; } else if (! asterisk) { val = SYMBOL_NAME (val); - if (p + SBYTES (val) >= pend) - break; p += sprintf (p, "%s", SDATA (val)); } else { val = SYMBOL_NAME (val); - if (p + 1 + SBYTES (val)>= pend) - break; p += sprintf (p, "~%s", SDATA (val)); } } @@ -1654,359 +1781,90 @@ parse_gsub_gpos_spec (spec, script, langsys, features, nbytes) error ("OTF spec too long"); } -#define DEVICE_DELTA(table, size) \ - (((size) >= (table).StartSize && (size) <= (table).EndSize) \ - ? (table).DeltaValue[(size) - (table).StartSize] \ - : 0) -void -adjust_anchor (struct font *font, OTF_Anchor *anchor, - unsigned code, int size, int *x, int *y) +Lisp_Object +font_otf_DeviceTable (device_table) + OTF_DeviceTable *device_table; { - if (anchor->AnchorFormat == 2) - { - int x0, y0; + int len = device_table->StartSize - device_table->EndSize + 1; - if (font->driver->anchor_point (font, code, anchor->f.f1.AnchorPoint, - &x0, &y0) >= 0) - *x = x0, *y = y0; - } - else if (anchor->AnchorFormat == 3) - { - if (anchor->f.f2.XDeviceTable.offset) - *x += DEVICE_DELTA (anchor->f.f2.XDeviceTable, size); - if (anchor->f.f2.YDeviceTable.offset) - *y += DEVICE_DELTA (anchor->f.f2.YDeviceTable, size); - } + return Fcons (make_number (len), + make_unibyte_string (device_table->DeltaValue, len)); } -#define REPLACEMENT_CHARACTER 0xFFFD - -/* Drive FONT's OTF GSUB features according to GSUB_SPEC. See the - comment of (sturct font_driver).otf_gsub. */ - -int -font_otf_gsub (font, gsub_spec, gstring_in, from, to, gstring_out, idx, - alternate_subst) - struct font *font; - Lisp_Object gsub_spec; - Lisp_Object gstring_in; - int from, to; - Lisp_Object gstring_out; - int idx, alternate_subst; -{ - int len; - int i; - OTF *otf; - OTF_GlyphString otf_gstring; - OTF_Glyph *g; - char *script, *langsys, features[256]; - int need_cmap; - - parse_gsub_gpos_spec (gsub_spec, &script, &langsys, features, 256); - - otf = otf_open (font->entity, font->file_name); - if (! otf) - return 0; - if (OTF_get_table (otf, "head") < 0) - return 0; - if (OTF_get_table (otf, "cmap") < 0) - return 0; - if (OTF_check_table (otf, "GSUB") < 0) - return 0; - len = to - from; - otf_gstring.size = otf_gstring.used = len; - otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len); - memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len); - for (i = 0, need_cmap = 0; i < len; i++) - { - Lisp_Object g = LGSTRING_GLYPH (gstring_in, from + i); - - otf_gstring.glyphs[i].c = XINT (LGLYPH_CHAR (g)); - if (otf_gstring.glyphs[i].c == REPLACEMENT_CHARACTER) - otf_gstring.glyphs[i].c = 0; - if (NILP (LGLYPH_CODE (g))) - { - otf_gstring.glyphs[i].glyph_id = 0; - need_cmap = 1; - } - else - otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (g)); - } - - if (need_cmap) - OTF_drive_cmap (otf, &otf_gstring); - OTF_drive_gdef (otf, &otf_gstring); - if ((alternate_subst - ? OTF_drive_gsub_alternate (otf, &otf_gstring, script, langsys, features) - : OTF_drive_gsub (otf, &otf_gstring, script, langsys, features)) < 0) - { - free (otf_gstring.glyphs); - return 0; - } - if (ASIZE (gstring_out) < idx + otf_gstring.used) - { - free (otf_gstring.glyphs); - return -1; - } - - for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used;) - { - int i0 = g->f.index.from, i1 = g->f.index.to; - Lisp_Object glyph = LGSTRING_GLYPH (gstring_in, from + i0); - Lisp_Object min_idx = AREF (glyph, 0); - Lisp_Object max_idx = AREF (glyph, 1); - - if (i0 < i1) - { - int min_idx_i = XINT (min_idx), max_idx_i = XINT (max_idx); - - for (i0++; i0 <= i1; i0++) - { - glyph = LGSTRING_GLYPH (gstring_in, from + i0); - if (min_idx_i > XINT (AREF (glyph, 0))) - min_idx_i = XINT (AREF (glyph, 0)); - if (max_idx_i < XINT (AREF (glyph, 1))) - max_idx_i = XINT (AREF (glyph, 1)); - } - min_idx = make_number (min_idx_i); - max_idx = make_number (max_idx_i); - i0 = g->f.index.from; - } - for (; i < otf_gstring.used && g->f.index.from == i0; i++, g++) - { - glyph = LGSTRING_GLYPH (gstring_out, idx + i); - ASET (glyph, 0, min_idx); - ASET (glyph, 1, max_idx); - if (g->c > 0) - LGLYPH_SET_CHAR (glyph, make_number (g->c)); - else - LGLYPH_SET_CHAR (glyph, make_number (REPLACEMENT_CHARACTER)); - LGLYPH_SET_CODE (glyph, make_number (g->glyph_id)); - } - } - - free (otf_gstring.glyphs); - return i; +Lisp_Object +font_otf_ValueRecord (value_format, value_record) + int value_format; + OTF_ValueRecord *value_record; +{ + Lisp_Object val = Fmake_vector (make_number (8), Qnil); + + if (value_format & OTF_XPlacement) + ASET (val, 0, value_record->XPlacement); + if (value_format & OTF_YPlacement) + ASET (val, 1, value_record->YPlacement); + if (value_format & OTF_XAdvance) + ASET (val, 2, value_record->XAdvance); + if (value_format & OTF_YAdvance) + ASET (val, 3, 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; } -/* Drive FONT's OTF GPOS features according to GPOS_SPEC. See the - comment of (sturct font_driver).otf_gpos. */ - -int -font_otf_gpos (font, gpos_spec, gstring, from, to) - struct font *font; - Lisp_Object gpos_spec; - Lisp_Object gstring; - int from, to; +Lisp_Object +font_otf_Anchor (anchor) + OTF_Anchor *anchor; { - int len; - int i; - OTF *otf; - OTF_GlyphString otf_gstring; - OTF_Glyph *g; - char *script, *langsys, features[256]; - int need_cmap; - Lisp_Object glyph; - int u, size; - Lisp_Object base, mark; - - parse_gsub_gpos_spec (gpos_spec, &script, &langsys, features, 256); - - otf = otf_open (font->entity, font->file_name); - if (! otf) - return 0; - if (OTF_get_table (otf, "head") < 0) - return 0; - if (OTF_get_table (otf, "cmap") < 0) - return 0; - if (OTF_check_table (otf, "GPOS") < 0) - return 0; - len = to - from; - otf_gstring.size = otf_gstring.used = len; - otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len); - memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len); - for (i = 0, need_cmap = 0; i < len; i++) - { - glyph = LGSTRING_GLYPH (gstring, from + i); - otf_gstring.glyphs[i].c = XINT (LGLYPH_CHAR (glyph)); - if (otf_gstring.glyphs[i].c == REPLACEMENT_CHARACTER) - otf_gstring.glyphs[i].c = 0; - if (NILP (LGLYPH_CODE (glyph))) - { - otf_gstring.glyphs[i].glyph_id = 0; - need_cmap = 1; - } - else - otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (glyph)); - } - if (need_cmap) - OTF_drive_cmap (otf, &otf_gstring); - OTF_drive_gdef (otf, &otf_gstring); + Lisp_Object val; - if (OTF_drive_gpos (otf, &otf_gstring, script, langsys, features) < 0) + val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil); + ASET (val, 0, make_number (anchor->XCoordinate)); + ASET (val, 1, make_number (anchor->YCoordinate)); + if (anchor->AnchorFormat == 2) + ASET (val, 2, make_number (anchor->f.f1.AnchorPoint)); + else { - free (otf_gstring.glyphs); - return 0; + ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable)); + ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable)); } - - u = otf->head->unitsPerEm; - size = font->pixel_size; - base = mark = Qnil; - for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used; i++, g++) - { - Lisp_Object prev; - int xoff = 0, yoff = 0, width_adjust = 0; - - if (! g->glyph_id) - continue; - - glyph = LGSTRING_GLYPH (gstring, from + i); - switch (g->positioning_type) - { - case 0: - break; - case 1: case 2: - { - int format = g->f.f1.format; - - if (format & OTF_XPlacement) - xoff = g->f.f1.value->XPlacement * size / u; - if (format & OTF_XPlaDevice) - xoff += DEVICE_DELTA (g->f.f1.value->XPlaDevice, size); - if (format & OTF_YPlacement) - yoff = - (g->f.f1.value->YPlacement * size / u); - if (format & OTF_YPlaDevice) - yoff -= DEVICE_DELTA (g->f.f1.value->YPlaDevice, size); - if (format & OTF_XAdvance) - width_adjust += g->f.f1.value->XAdvance * size / u; - if (format & OTF_XAdvDevice) - width_adjust += DEVICE_DELTA (g->f.f1.value->XAdvDevice, size); - } - break; - case 3: - /* Not yet supported. */ - break; - case 4: case 5: - if (NILP (base)) - break; - prev = base; - goto label_adjust_anchor; - default: /* i.e. case 6 */ - if (NILP (mark)) - break; - prev = mark; - - label_adjust_anchor: - { - int base_x, base_y, mark_x, mark_y, width; - unsigned code; - - base_x = g->f.f4.base_anchor->XCoordinate * size / u; - base_y = g->f.f4.base_anchor->YCoordinate * size / u; - mark_x = g->f.f4.mark_anchor->XCoordinate * size / u; - mark_y = g->f.f4.mark_anchor->YCoordinate * size / u; - - code = XINT (LGLYPH_CODE (prev)); - if (g->f.f4.base_anchor->AnchorFormat != 1) - adjust_anchor (font, g->f.f4.base_anchor, - code, size, &base_x, &base_y); - if (g->f.f4.mark_anchor->AnchorFormat != 1) - adjust_anchor (font, g->f.f4.mark_anchor, - code, size, &mark_x, &mark_y); - - if (NILP (LGLYPH_WIDTH (prev))) - { - width = font->driver->text_extents (font, &code, 1, NULL); - LGLYPH_SET_WIDTH (prev, make_number (width)); - } - else - width = XINT (LGLYPH_WIDTH (prev)); - xoff = XINT (LGLYPH_XOFF (prev)) + (base_x - width) - mark_x; - yoff = XINT (LGLYPH_YOFF (prev)) + mark_y - base_y; - } - } - - if (xoff || yoff || width_adjust) - { - Lisp_Object adjustment = Fmake_vector (make_number (3), Qnil); - - ASET (adjustment, 0, make_number (xoff)); - ASET (adjustment, 1, make_number (yoff)); - ASET (adjustment, 2, make_number (width_adjust)); - LGLYPH_SET_ADJUSTMENT (glyph, adjustment); - } - - if (g->GlyphClass == OTF_GlyphClass0) - base = mark = glyph; - else if (g->GlyphClass == OTF_GlyphClassMark) - mark = glyph; - else - base = glyph; - } - - free (otf_gstring.glyphs); - return i; + return val; } #endif /* HAVE_LIBOTF */ - /* 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) +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); - struct font *font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer; - int len = LGSTRING_LENGTH (gstring); - int i; - - cmp->font = font; - cmp->lbearing = cmp->rbearing = cmp->pixel_width = 0; - cmp->ascent = font->ascent; - cmp->descent = font->descent; - for (i = 0; i < len; i++) - { - Lisp_Object g = LGSTRING_GLYPH (gstring, i); - unsigned code; - struct font_metrics metrics; + cmp->font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer; + 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; - if (NILP (LGLYPH_FROM (g))) - break; - code = XINT (LGLYPH_CODE (g)); - font->driver->text_extents (font, &code, 1, &metrics); - LGLYPH_SET_WIDTH (g, make_number (metrics.width)); - metrics.lbearing += LGLYPH_XOFF (g); - metrics.rbearing += LGLYPH_XOFF (g); - metrics.ascent += LGLYPH_YOFF (g); - metrics.descent += LGLYPH_YOFF (g); - - if (cmp->lbearing > cmp->pixel_width + metrics.lbearing) - cmp->lbearing = cmp->pixel_width + metrics.lbearing; - if (cmp->rbearing < cmp->pixel_width + metrics.rbearing) - cmp->rbearing = cmp->pixel_width + metrics.rbearing; - if (cmp->ascent < metrics.ascent) - cmp->ascent = metrics.ascent; - if (cmp->descent < metrics.descent) - cmp->descent = metrics.descent; - cmp->pixel_width += metrics.width + LGLYPH_WADJUST (g); - } - cmp->glyph_len = i; - LGSTRING_SET_LBEARING (gstring, make_number (cmp->lbearing)); - LGSTRING_SET_RBEARING (gstring, make_number (cmp->rbearing)); - LGSTRING_SET_WIDTH (gstring, make_number (cmp->pixel_width)); - LGSTRING_SET_ASCENT (gstring, make_number (cmp->ascent)); - LGSTRING_SET_DESCENT (gstring, make_number (cmp->descent)); - - return font; + return cmp->font; } int @@ -2078,7 +1936,7 @@ static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object, font-spec. The score value is 32 bit (`unsigned'), and the smaller the value is, the closer the font is to the font-spec. - Each 1-bit in the highest 4 bits of the score is used for atomic + Each 1-bit of the highest 4 bits of the score is used for atomic properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY. Each 7-bit in the lowest 28 bits are used for numeric properties @@ -2208,6 +2066,10 @@ font_sort_entites (vec, prefer, frame, spec) /* API of Font Service Layer. */ +/* Reflect ORDER (see the variable font_sort_order in xfaces.c) to + sort_shift_bits. Finternal_set_font_selection_order calls this + function with font_sort_order after setting up it. */ + void font_update_sort_order (order) int *order; @@ -2229,6 +2091,9 @@ font_update_sort_order (order) } } + +/* Return weight property of FONT as symbol. */ + Lisp_Object font_symbolic_weight (font) Lisp_Object font; @@ -2240,6 +2105,9 @@ font_symbolic_weight (font) return weight; } + +/* Return slant property of FONT as symbol. */ + Lisp_Object font_symbolic_slant (font) Lisp_Object font; @@ -2251,6 +2119,9 @@ font_symbolic_slant (font) return slant; } + +/* Return width property of FONT as symbol. */ + Lisp_Object font_symbolic_width (font) Lisp_Object font; @@ -2262,6 +2133,9 @@ font_symbolic_width (font) return width; } + +/* Check if ENTITY matches with the font specification SPEC. */ + int font_match_p (spec, entity) Lisp_Object spec, entity; @@ -2280,6 +2154,9 @@ font_match_p (spec, entity) return 1; } + +/* Return a lispy font object corresponding to FONT. */ + Lisp_Object font_find_object (font) struct font *font; @@ -2300,6 +2177,7 @@ font_find_object (font) static Lisp_Object scratch_font_spec, scratch_font_prefer; + /* Return a vector of font-entities matching with SPEC on frame F. */ static Lisp_Object @@ -2375,6 +2253,9 @@ font_list_entities (frame, spec) return (i > 0 ? Fvconcat (i, vec) : null_vector); } + +/* Return a font entity matching with SPEC on FRAME. */ + static Lisp_Object font_matching_entity (frame, spec) Lisp_Object frame, spec; @@ -2420,6 +2301,10 @@ font_matching_entity (frame, spec) static int num_fonts; + +/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the + opened font object. */ + static Lisp_Object font_open_entity (f, entity, pixel_size) FRAME_PTR f; @@ -2466,6 +2351,9 @@ font_open_entity (f, entity, pixel_size) return val; } + +/* Close FONT_OBJECT that is opened on frame F. */ + void font_close_object (f, font_object) FRAME_PTR f; @@ -2497,6 +2385,10 @@ font_close_object (f, font_object) abort (); } + +/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if + FONT is a font-entity and it must be opened to check. */ + int font_has_char (f, font, c) FRAME_PTR f; @@ -2533,6 +2425,9 @@ font_has_char (f, font, c) return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE); } + +/* Return the glyph ID of FONT_OBJECT for character C. */ + unsigned font_encode_char (font_object, c) Lisp_Object font_object; @@ -2543,6 +2438,9 @@ font_encode_char (font_object, c) return font->driver->encode_char (font, c); } + +/* Return the name of FONT_OBJECT. */ + Lisp_Object font_get_name (font_object) Lisp_Object font_object; @@ -2555,6 +2453,9 @@ font_get_name (font_object) return (name ? make_unibyte_string (name, strlen (name)) : null_string); } + +/* Return the specification of FONT_OBJECT. */ + Lisp_Object font_get_spec (font_object) Lisp_Object font_object; @@ -2569,6 +2470,10 @@ font_get_spec (font_object) return spec; } + +/* Return the frame on which FONT exists. FONT is a font object or a + font entity. */ + Lisp_Object font_get_frame (font) Lisp_Object font; @@ -2579,14 +2484,17 @@ font_get_frame (font) return AREF (font, FONT_FRAME_INDEX); } + /* Find a font entity best matching with LFACE. If SPEC is non-nil, - the font must exactly match with it. */ + the font must exactly match with it. C, if not negative, is a + character that the entity must support. */ Lisp_Object -font_find_for_lface (f, lface, spec) +font_find_for_lface (f, lface, spec, c) FRAME_PTR f; Lisp_Object *lface; Lisp_Object spec; + int c; { Lisp_Object frame, entities; int i; @@ -2595,6 +2503,8 @@ font_find_for_lface (f, lface, spec) if (NILP (spec)) { + if (c >= 0x100) + return Qnil; for (i = 0; i < FONT_SPEC_MAX; i++) ASET (scratch_font_spec, i, Qnil); ASET (scratch_font_spec, FONT_REGISTRY_INDEX, Qiso8859_1); @@ -2622,10 +2532,32 @@ font_find_for_lface (f, lface, spec) } else { + Lisp_Object registry = AREF (spec, FONT_REGISTRY_INDEX); + + if (NILP (registry)) + registry = Qiso8859_1; + + if (c >= 0) + { + struct charset *repertory; + + if (font_registry_charsets (registry, NULL, &repertory) < 0) + return Qnil; + if (repertory) + { + if (ENCODE_CHAR (repertory, c) + == CHARSET_INVALID_CODE (repertory)) + return Qnil; + /* Any font of this registry support C. So, let's + suppress the further checking. */ + c = -1; + } + else if (c > MAX_UNICODE_CHAR) + return Qnil; + } for (i = 0; i < FONT_SPEC_MAX; i++) ASET (scratch_font_spec, i, AREF (spec, i)); - if (NILP (AREF (spec, FONT_REGISTRY_INDEX))) - ASET (scratch_font_spec, FONT_REGISTRY_INDEX, Qiso8859_1); + ASET (scratch_font_spec, FONT_REGISTRY_INDEX, registry); entities = font_list_entities (frame, scratch_font_spec); } @@ -2640,37 +2572,66 @@ font_find_for_lface (f, lface, spec) if (! NILP (lface[LFACE_FAMILY_INDEX])) font_merge_old_spec (Qnil, lface[LFACE_FAMILY_INDEX], Qnil, prefer); ASET (prefer, FONT_WEIGHT_INDEX, - font_prop_validate_style (FONT_WEIGHT_INDEX, QCweight, - lface[LFACE_WEIGHT_INDEX])); + font_prop_validate_style (QCweight, lface[LFACE_WEIGHT_INDEX])); ASET (prefer, FONT_SLANT_INDEX, - font_prop_validate_style (FONT_SLANT_INDEX, QCslant, - lface[LFACE_SLANT_INDEX])); + font_prop_validate_style (QCslant, lface[LFACE_SLANT_INDEX])); ASET (prefer, FONT_WIDTH_INDEX, - font_prop_validate_style (FONT_WIDTH_INDEX, QCwidth, - lface[LFACE_SWIDTH_INDEX])); + font_prop_validate_style (QCwidth, lface[LFACE_SWIDTH_INDEX])); pt = XINT (lface[LFACE_HEIGHT_INDEX]); ASET (prefer, FONT_SIZE_INDEX, make_float (pt / 10)); font_sort_entites (entities, prefer, frame, spec); } - return AREF (entities, 0); + if (c < 0) + return AREF (entities, 0); + for (i = 0; i < ASIZE (entities); i++) + { + int result = font_has_char (f, AREF (entities, i), c); + Lisp_Object font_object; + + if (result > 0) + return AREF (entities, i); + if (result <= 0) + continue; + font_object = font_open_for_lface (f, AREF (entities, i), lface, spec); + if (NILP (font_object)) + continue; + result = font_has_char (f, font_object, c); + font_close_object (f, font_object); + if (result > 0) + return AREF (entities, i); + } + return Qnil; } + Lisp_Object -font_open_for_lface (f, lface, entity) +font_open_for_lface (f, entity, lface, spec) FRAME_PTR f; - Lisp_Object *lface; Lisp_Object entity; + Lisp_Object *lface; + Lisp_Object spec; { - double pt = XINT (lface[LFACE_HEIGHT_INDEX]); int size; - pt /= 10; - size = POINT_TO_PIXEL (pt, f->resy); + if (FONT_SPEC_P (spec) && INTEGERP (AREF (spec, FONT_SIZE_INDEX))) + size = XINT (AREF (spec, FONT_SIZE_INDEX)); + else + { + double pt = XINT (lface[LFACE_HEIGHT_INDEX]); + + pt /= 10; + size = POINT_TO_PIXEL (pt, f->resy); + } return font_open_entity (f, entity, size); } + +/* Load a font best matching with FACE's font-related properties into + FACE on frame F. If no proper font is found, record that FACE has + no font. */ + void font_load_for_face (f, face) FRAME_PTR f; @@ -2680,10 +2641,10 @@ font_load_for_face (f, face) if (NILP (font_object)) { - Lisp_Object entity = font_find_for_lface (f, face->lface, Qnil); + Lisp_Object entity = font_find_for_lface (f, face->lface, Qnil, -1); if (! NILP (entity)) - font_object = font_open_for_lface (f, face->lface, entity); + font_object = font_open_for_lface (f, entity, face->lface, Qnil); } if (! NILP (font_object)) @@ -2705,6 +2666,9 @@ font_load_for_face (f, face) } } + +/* Make FACE on frame F ready to use the font opened for FACE. */ + void font_prepare_for_face (f, face) FRAME_PTR f; @@ -2716,6 +2680,9 @@ font_prepare_for_face (f, face) font->driver->prepare_face (f, face); } + +/* Make FACE on frame F stop using the font opened for FACE. */ + void font_done_for_face (f, face) FRAME_PTR f; @@ -2728,6 +2695,10 @@ font_done_for_face (f, face) face->extra = NULL; } + +/* Open a font best matching with NAME on frame F. If no proper font + is found, return Qnil. */ + Lisp_Object font_open_by_name (f, name) FRAME_PTR f; @@ -2806,7 +2777,7 @@ register_font_driver (driver, f) SDATA (SYMBOL_NAME (driver->type))); for (prev = NULL, list = root; list; prev = list, list = list->next) - if (list->driver->type == driver->type) + if (EQ (list->driver->type, driver->type)) error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type))); list = malloc (sizeof (struct font_driver_list)); @@ -2822,6 +2793,7 @@ register_font_driver (driver, f) num_font_drivers++; } + /* Free font-driver list on frame F. It doesn't free font-drivers themselves. */ @@ -2838,14 +2810,15 @@ free_font_driver_list (f) } } -/* Make the frame F use font backends listed in NEW_BACKENDS (list of - symbols). If NEW_BACKENDS is nil, make F use all available font - drivers. If no backend is available, dont't alter - f->font_driver_list. + +/* Make the frame F use font backends listed in NEW_DRIVERS (list of + symbols, e.g. xft, x). If NEW_DRIVERS is nil, make F use all + available font drivers. If no backend is available, dont't alter + F->font_driver_list. A caller must free all realized faces and clear all font caches if any in advance. The return value is a list of font backends - actually made used for on F. */ + actually made used on F. */ Lisp_Object font_update_drivers (f, new_drivers) @@ -2855,23 +2828,90 @@ font_update_drivers (f, new_drivers) Lisp_Object active_drivers = Qnil; struct font_driver_list *list; - /* At first check which font backends are available. */ + /* At first, finialize all font drivers for F. */ + for (list = f->font_driver_list; list; list = list->next) + if (list->on) + { + if (list->driver->end_for_frame) + list->driver->end_for_frame (f); + list->on = 0; + } + + /* Then start the requested drivers. */ for (list = f->font_driver_list; list; list = list->next) if (NILP (new_drivers) || ! NILP (Fmemq (list->driver->type, new_drivers))) { - list->on = 2; - active_drivers = nconc2 (active_drivers, - Fcons (list->driver->type, Qnil)); + if (! list->driver->start_for_frame + || list->driver->start_for_frame (f) == 0); + { + list->on = 1; + active_drivers = nconc2 (active_drivers, + Fcons (list->driver->type, Qnil)); + } } - /* If at least one backend is available, update all list->on. */ - if (! NILP (active_drivers)) - for (list = f->font_driver_list; list; list = list->next) - list->on = (list->on == 2); return active_drivers; } +int +font_put_frame_data (f, driver, data) + FRAME_PTR f; + struct font_driver *driver; + void *data; +{ + struct font_data_list *list, *prev; + + for (prev = NULL, list = f->font_data_list; list; + prev = list, list = list->next) + if (list->driver == driver) + break; + if (! data) + { + if (list) + { + if (prev) + prev->next = list->next; + else + f->font_data_list = list->next; + free (list); + } + return 0; + } + + if (! list) + { + list = malloc (sizeof (struct font_data_list)); + if (! list) + return -1; + list->driver = driver; + list->next = f->font_data_list; + f->font_data_list = list; + } + list->data = data; + return 0; +} + + +void * +font_get_frame_data (f, driver) + FRAME_PTR f; + struct font_driver *driver; +{ + struct font_data_list *list; + + for (list = f->font_data_list; list; list = list->next) + if (list->driver == driver) + break; + if (! list) + return NULL; + return list->data; +} + + +/* Return the font used to draw character C by FACE at buffer position + POS in window W. If OBJECT is non-nil, it is a string containing C + at index POS. */ Lisp_Object font_at (c, pos, face, w, object) @@ -2886,6 +2926,8 @@ font_at (c, pos, face, w, object) int dummy; f = XFRAME (w->frame); + if (! FRAME_WINDOW_P (f)) + return Qnil; if (! face) { if (STRINGP (object)) @@ -2900,14 +2942,15 @@ font_at (c, pos, face, w, object) face = FACE_FROM_ID (f, face_id); if (! face->font_info) return Qnil; - return font_lispy_object ((struct font *) face->font_info); + return font_find_object ((struct font *) face->font_info); } /* Lisp API */ DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0, - doc: /* Return t if object is a font-spec or font-entity. */) + doc: /* Return t if OBJECT is a font-spec or font-entity. +Return nil otherwise. */) (object) Lisp_Object object; { @@ -2915,8 +2958,36 @@ DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0, } DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0, - doc: /* Return a newly created font-spec with specified arguments as properties. -usage: (font-spec &rest properties) */) + doc: /* Return a newly created font-spec with arguments as properties. + +ARGS must come in pairs KEY VALUE of font properties. KEY must be a +valid font property name listed below: + +`:family', `:weight', `:slant', `:width' + +They are the same as face attributes of the same name. See +`set-face-attribute. + +`:foundry' + +VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''. + +`:adstyle' + +VALUE must be a string or a symbol specifying the additional +typographic style information of a font, e.g. ``sans''. Usually null. + +`:registry' + +VALUE must be a string or a symbol specifying the charset registry and +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 1/10 pixels +(if VALUE is an integer), or in points (if VALUE is a float). +usage: (font-spec ARGS ...) */) (nargs, args) int nargs; Lisp_Object *args; @@ -2948,10 +3019,10 @@ usage: (font-spec &rest properties) */) DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0, - doc: /* Return the value of FONT's PROP property. + doc: /* Return the value of FONT's property KEY. FONT is a font-spec, a font-entity, or a font-object. */) - (font, prop) - Lisp_Object font, prop; + (font, key) + Lisp_Object font, key; { enum font_property_index idx; @@ -2959,29 +3030,28 @@ FONT is a font-spec, a font-entity, or a font-object. */) { struct font *fontp = XSAVE_VALUE (font)->pointer; - if (EQ (prop, QCotf)) + if (EQ (key, QCotf)) { -#ifdef HAVE_LIBOTF - return font_otf_capability (fontp); -#else /* not HAVE_LIBOTF */ - return Qnil; -#endif /* not HAVE_LIBOTF */ + if (fontp->driver->otf_capability) + return fontp->driver->otf_capability (fontp); + else + return Qnil; } font = fontp->entity; } else CHECK_FONT (font); - idx = get_font_prop_index (prop, 0); + idx = get_font_prop_index (key, 0); if (idx < FONT_EXTRA_INDEX) return AREF (font, idx); if (FONT_ENTITY_P (font)) return Qnil; - return Fcdr (Fassoc (AREF (font, FONT_EXTRA_INDEX), prop)); + return Fcdr (Fassoc (AREF (font, FONT_EXTRA_INDEX), key)); } DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0, - doc: /* Set one property of FONT-SPEC: give property PROP value VALUE. */) + doc: /* Set one property of FONT-SPEC: give property KEY value VALUE. */) (font_spec, prop, val) Lisp_Object font_spec, prop, val; { @@ -3005,8 +3075,9 @@ DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0, doc: /* List available fonts matching FONT-SPEC on the current frame. Optional 2nd argument FRAME specifies the target frame. Optional 3rd argument NUM, if non-nil, limits the number of returned fonts. -Optional 4th argument PREFER, if non-nil, is a font-spec -to which closeness fonts are sorted. */) +Optional 4th argument PREFER, if non-nil, is a font-spec to +control the order of the returned list. Fonts are sorted by +how they are close to PREFER. */) (font_spec, frame, num, prefer) Lisp_Object font_spec, frame, num, prefer; { @@ -3223,6 +3294,8 @@ sorted by numeric values. */) return Qnil; } +/* The following three functions are still expremental. */ + 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. @@ -3231,18 +3304,19 @@ 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 LBEARING RBEARING WIDTH ASCENT DESCENT] + [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT] where - FONT-OBJECT is a font-object for all glyphs in the G-string, - LBEARING thry DESCENT is the metrics (in pixels) of the whole G-string. + FONT-OBJECT is a font-object for all glyphs in the g-string, + WIDTH thry 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 [ [X-OFF Y-OFF WADJUST] | nil] ] + [ 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 thry DESCENT are the metrics (in pixels) of the glyph. X-OFF and Y-OFF are offests to the base position for the glyph. - WIDTH is the normal width of the glyph. WADJUST is the adjustment to the normal width of the glyph. */) (font_object, num) Lisp_Object font_object, num; @@ -3261,7 +3335,7 @@ where ASET (g, 0, font_object); ASET (gstring, 0, g); for (i = 1; i < len; i++) - ASET (gstring, i, Fmake_vector (make_number (8), Qnil)); + ASET (gstring, i, Fmake_vector (make_number (10), Qnil)); return gstring; } @@ -3292,7 +3366,7 @@ FONT-OBJECT may be nil if GSTRING already already contains one. */) if (XINT (start) > XINT (end) || XINT (end) > ASIZE (object) || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring)) - args_out_of_range (start, end); + args_out_of_range_3 (object, start, end); len = XINT (end) - XINT (start); p = SDATA (object) + string_char_to_byte (object, XINT (start)); @@ -3304,10 +3378,10 @@ FONT-OBJECT may be nil if GSTRING already already contains one. */) code = font->driver->encode_char (font, c); if (code > MOST_POSITIVE_FIXNUM) error ("Glyph code 0x%X is too large", code); - LGLYPH_SET_FROM (g, make_number (i)); - LGLYPH_SET_TO (g, make_number (i + 1)); - LGLYPH_SET_CHAR (g, make_number (c)); - LGLYPH_SET_CODE (g, make_number (code)); + LGLYPH_SET_FROM (g, i); + LGLYPH_SET_TO (g, i); + LGLYPH_SET_CHAR (g, c); + LGLYPH_SET_CODE (g, code); } } else @@ -3330,41 +3404,144 @@ FONT-OBJECT may be nil if GSTRING already already contains one. */) code = font->driver->encode_char (font, c); if (code > MOST_POSITIVE_FIXNUM) error ("Glyph code 0x%X is too large", code); - LGLYPH_SET_FROM (g, make_number (i)); - LGLYPH_SET_TO (g, make_number (i + 1)); - LGLYPH_SET_CHAR (g, make_number (c)); - LGLYPH_SET_CODE (g, make_number (code)); + 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) - 1; i >= len; i--) + LGSTRING_SET_GLYPH (gstring, i, Qnil); + return Qnil; +} + +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 shaped text. */) + (from, to, font_object, string) + Lisp_Object from, to, font_object, string; +{ + struct font *font; + struct font_metrics metrics; + EMACS_INT start, end; + Lisp_Object gstring, n; + int i; + + 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); + } + + CHECK_FONT_GET_OBJECT (font_object, font); + if (! font->driver->shape) + return from; + + gstring = Ffont_make_gstring (font_object, make_number (end - start)); + Ffont_fill_gstring (gstring, font_object, from, to, string); + n = font->driver->shape (gstring); + if (NILP (n)) + return Qnil; + for (i = 0; i < XINT (n);) + { + 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; + + 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); + 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); + } + for (j = i + 1; j < XINT (n); j++) + { + int x; + + g = LGSTRING_GLYPH (gstring, j); + if (this_from != LGLYPH_FROM (g)) + break; + 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); + } - LGLYPH_SET_FROM (g, Qnil); + 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++) + LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i)); + if (NILP (string)) + Fcompose_region_internal (make_number (start + this_from), + make_number (start + this_to), + gstr, Qnil); + else + Fcompose_string_internal (string, + make_number (start + this_from), + make_number (start + this_to), + gstr, Qnil); } - return Qnil; + + return make_number (start + XINT (n)); } -DEFUN ("font-otf-gsub", Ffont_otf_gsub, Sfont_otf_gsub, 6, 6, 0, - doc: /* Apply OpenType "GSUB" features on glyph-string GSTRING-IN. -FEATURE-SPEC specifies which featuress to apply in this format: - (SCRIPT LANGSYS FEATURE ...) +DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0, + doc: /* Apply OpenType features on glyph-string GSTRING-IN. +OTF-SPEC specifies which featuress 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, - FEATURE is a symbol specifying a feature tag of Opentype. + GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags. If LANGYS is nil, the default langsys is selected. -The features are applied in the order appeared in the list. FEATURE -may be a symbol `*', in which case all available features not appeared -in this list are applied, and the remaining FEATUREs are not ignored. -For instance, (mlym nil vatu pstf * haln) means to apply vatu and pstf -in this order, then to apply all available features other than vatu, -pstf, and haln. +The features are applied in the order appeared in the list. The +symbol `*' means to apply all available features not appeared 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 -GSTRING-IN. +the glyph-string GSTRING-IN. If some of a feature is actually applicable, the resulting glyphs are produced in the glyph-string GSTRING-OUT from the index INDEX. In @@ -3378,18 +3555,26 @@ produced in GSTRING-OUT, and the value is nil. See the documentation of `font-make-gstring' for the format of glyph-string. */) - (feature_spec, gstring_in, from, to, gstring_out, index) - Lisp_Object feature_spec, gstring_in, from, to, gstring_out, index; + (otf_features, gstring_in, from, to, gstring_out, index) + Lisp_Object otf_features, gstring_in, from, to, gstring_out, index; { Lisp_Object font_object = LGSTRING_FONT (gstring_in); - struct font *font = XSAVE_VALUE (font_object)->pointer; + Lisp_Object val; + struct font *font; int len, num; + check_otf_features (otf_features); CHECK_FONT_GET_OBJECT (font_object, font); - if (! font->driver->otf_gsub) + if (! font->driver->otf_drive) error ("Font backend %s can't drive OpenType GSUB table", SDATA (SYMBOL_NAME (font->driver->type))); - CHECK_CONS (feature_spec); + 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_NATNUM (from); @@ -3400,47 +3585,14 @@ glyph-string. */) args_out_of_range_3 (from, to, make_number (len)); if (XINT (index) >= ASIZE (gstring_out)) args_out_of_range (index, make_number (ASIZE (gstring_out))); - num = font->driver->otf_gsub (font, feature_spec, - gstring_in, XINT (from), XINT (to), - gstring_out, XINT (index), 0); + num = font->driver->otf_drive (font, otf_features, + gstring_in, XINT (from), XINT (to), + gstring_out, XINT (index), 0); if (num < 0) return Qnil; return make_number (num); } - -DEFUN ("font-otf-gpos", Ffont_otf_gpos, Sfont_otf_gpos, 4, 4, 0, - doc: /* Apply OpenType "GPOS" features on glyph-string GSTRING. -FEATURE-SPEC specifies which features to apply in this format: - (SCRIPT LANGSYS FEATURE ...) -See the documentation of `font-otf-gsub' for more detail. - -The features are applied to the glyphs in the range FROM and TO of -GSTRING. */) - (gpos_spec, gstring, from, to) - Lisp_Object gpos_spec, gstring, from, to; -{ - Lisp_Object font_object = LGSTRING_FONT (gstring); - struct font *font; - int len, num; - - CHECK_FONT_GET_OBJECT (font_object, font); - if (! font->driver->otf_gpos) - error ("Font backend %s can't drive OpenType GPOS table", - SDATA (SYMBOL_NAME (font->driver->type))); - CHECK_CONS (gpos_spec); - len = check_gstring (gstring); - CHECK_NATNUM (from); - CHECK_NATNUM (to); - - if (XINT (from) >= XINT (to) || XINT (to) > len) - args_out_of_range_3 (from, to, make_number (len)); - num = font->driver->otf_gpos (font, gpos_spec, - gstring, XINT (from), XINT (to)); - return (num <= 0 ? Qnil : Qt); -} - - 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. @@ -3453,8 +3605,8 @@ 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. */) - (font_object, character, feature_spec) - Lisp_Object font_object, character, feature_spec; + (font_object, character, otf_features) + Lisp_Object font_object, character, otf_features; { struct font *font; Lisp_Object gstring_in, gstring_out, g; @@ -3462,18 +3614,18 @@ corresponding character. */) int i, num; CHECK_FONT_GET_OBJECT (font_object, font); - if (! font->driver->otf_gsub) + 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 (feature_spec); + CHECK_CONS (otf_features); gstring_in = Ffont_make_gstring (font_object, make_number (1)); g = LGSTRING_GLYPH (gstring_in, 0); LGLYPH_SET_CHAR (g, character); gstring_out = Ffont_make_gstring (font_object, make_number (10)); - while ((num = font->driver->otf_gsub (font, feature_spec, gstring_in, 0, 1, - gstring_out, 0, 1)) < 0) + 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_number (ASIZE (gstring_out) * 2)); alternates = Qnil; @@ -3511,6 +3663,8 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, CHECK_LIVE_FRAME (frame); isize = XINT (size); + if (isize == 0) + isize = 120; if (isize < 0) isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy); @@ -3534,7 +3688,7 @@ DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0, doc: /* Return information about FONT-OBJECT. The value is a vector: [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH - OTF-CAPABILITY ] + CAPABILITY ] NAME is a string of the font name (or nil if the font backend doesn't provide a name). @@ -3549,10 +3703,19 @@ SIZE is a maximum advance width of the font in pixel. ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in pixel. -OTF-CAPABILITY is a cons (GSUB . GPOS), where GSUB shows which "GSUB" -features the font supports, and GPOS shows which "GPOS" features the -font supports. Both GSUB and GPOS are lists of the format: - ((SCRIPT (LANGSYS FEATURE ...) ...) ...) +CAPABILITY is a list whose first element is a symbol representing the +font format \(x, opentype, truetype, type1, pcf, or bdf) and the +remaining elements describes a detail of the font capability. + +If the font is OpenType font, the form of the list is + \(opentype GSUB GPOS) +where GSUB shows which "GSUB" features the font supports, and GPOS +shows which "GPOS" features the font supports. Both GSUB and GPOS are +lists of the format: + \((SCRIPT (LANGSYS FEATURE ...) ...) ...) + +If the font is not OpenType font, currently the length of the form is +one. SCRIPT is a symbol representing OpenType script tag. @@ -3584,7 +3747,9 @@ If the font is not OpenType font, OTF-CAPABILITY is nil. */) ASET (val, 6, make_number (font->font.space_width)); ASET (val, 7, make_number (font->font.average_width)); if (font->driver->otf_capability) - ASET (val, 8, font->driver->otf_capability (font)); + ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font))); + else + ASET (val, 8, Fcons (font->format, Qnil)); return val; } @@ -3645,23 +3810,41 @@ FONT is a font-spec, font-entity, or font-object. */) return (font_match_p (spec, font) ? Qt : Qnil); } -DEFUN ("font-at", Ffont_at, Sfont_at, 1, 2, 0, +DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 0, doc: /* Return a font-object for displaying a character at POSISTION. Optional second arg WINDOW, if non-nil, is a window displaying the current buffer. It defaults to the currently selected window. */) - (position, window) - Lisp_Object position, window; + (position, window, string) + Lisp_Object position, window, string; { struct window *w; EMACS_INT pos, pos_byte; int c; - CHECK_NUMBER_COERCE_MARKER (position); - pos = XINT (position); - if (pos < BEGV || pos >= ZV) - args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); - pos_byte = CHAR_TO_BYTE (pos); - c = FETCH_CHAR (pos_byte); + if (NILP (string)) + { + CHECK_NUMBER_COERCE_MARKER (position); + pos = XINT (position); + if (pos < BEGV || pos >= ZV) + args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); + pos_byte = CHAR_TO_BYTE (pos); + c = FETCH_CHAR (pos_byte); + } + else + { + EMACS_INT len; + unsigned char *str; + + CHECK_NUMBER (position); + CHECK_STRING (string); + pos = XINT (position); + if (pos < 0 || pos >= SCHARS (string)) + args_out_of_range (string, position); + pos_byte = string_char_to_byte (string, pos); + str = SDATA (string) + pos_byte; + len = SBYTES (string) - pos_byte; + c = STRING_CHAR (str, eln); + } if (NILP (window)) window = selected_window; CHECK_LIVE_WINDOW (window); @@ -3742,7 +3925,10 @@ syms_of_font () staticpro (&font_family_alist); font_family_alist = Qnil; - DEFSYM (Qfontp, "fontp"); + staticpro (&font_charset_alist); + font_charset_alist = Qnil; + + DEFSYM (Qopentype, "opentype"); DEFSYM (Qiso8859_1, "iso8859-1"); DEFSYM (Qiso10646_1, "iso10646-1"); @@ -3752,6 +3938,7 @@ syms_of_font () DEFSYM (QCotf, ":otf"); DEFSYM (QClanguage, ":language"); DEFSYM (QCscript, ":script"); + DEFSYM (QCantialias, ":antialias"); DEFSYM (QCfoundry, ":foundry"); DEFSYM (QCadstyle, ":adstyle"); @@ -3776,6 +3963,11 @@ syms_of_font () staticpro (&scratch_font_prefer); scratch_font_prefer = Ffont_spec (0, NULL); +#ifdef HAVE_LIBOTF + staticpro (&otf_list); + otf_list = Qnil; +#endif + defsubr (&Sfontp); defsubr (&Sfont_spec); defsubr (&Sfont_get); @@ -3788,8 +3980,8 @@ syms_of_font () defsubr (&Sinternal_set_font_style_table); defsubr (&Sfont_make_gstring); defsubr (&Sfont_fill_gstring); - defsubr (&Sfont_otf_gsub); - defsubr (&Sfont_otf_gpos); + defsubr (&Sfont_shape_text); + defsubr (&Sfont_drive_otf); defsubr (&Sfont_otf_alternates); #ifdef FONT_DEBUG @@ -3804,29 +3996,34 @@ syms_of_font () #endif #endif /* FONT_DEBUG */ +#ifdef USE_FONT_BACKEND + if (enable_font_backend) + { #ifdef HAVE_FREETYPE - syms_of_ftfont (); + syms_of_ftfont (); #ifdef HAVE_X_WINDOWS - syms_of_xfont (); - syms_of_ftxfont (); + syms_of_xfont (); + syms_of_ftxfont (); #ifdef HAVE_XFT - syms_of_xftfont (); + syms_of_xftfont (); #endif /* HAVE_XFT */ #endif /* HAVE_X_WINDOWS */ #else /* not HAVE_FREETYPE */ #ifdef HAVE_X_WINDOWS - syms_of_xfont (); + syms_of_xfont (); #endif /* HAVE_X_WINDOWS */ #endif /* not HAVE_FREETYPE */ #ifdef HAVE_BDFFONT - syms_of_bdffont (); + syms_of_bdffont (); #endif /* HAVE_BDFFONT */ #ifdef WINDOWSNT - syms_of_w32font (); + syms_of_w32font (); #endif /* WINDOWSNT */ #ifdef MAC_OS - syms_of_atmfont (); + syms_of_atmfont (); #endif /* MAC_OS */ + } +#endif /* USE_FONT_BACKEND */ } /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846