# HG changeset patch # User Kenichi Handa # Date 1211422761 0 # Node ID 686d116f748d92784aac87795c9f3346a568e95f # Parent 7880ee7959318b5290ea557139bd5194fcef6ae4 Checking of FONT_DEBUG is moved to font.h. All calls of xassert are changed to font_assert. Many unused variables deleted. (Vfont_weight_table, Vfont_slant_table, Vfont_width_table): New variables. (struct table_entry): Moved from xfaces.c and modified. (weight_table, slant_table, width_table): Moved from xfaces.c and contents adjusted for the change of struct table_entry. (font_style_to_value, font_style_symbolic): Adjuted for the format change of font_style_table. (font_parse_family_registry): Don't overwrite existing foundry and family of font_spec. (font_score): Fix calculation of diff for sizes. (font_sort_entites): Call font_add_log. (font_delete_unmatched): Return a newly created list. (font_list_entities): Fix previous change. Call font_add_log. (font_matching_entity, font_open_entity, font_close_entity): Call font_add_log. (Ffont_xlfd_name): New arg FOLD-WILDCARDS. (Finternal_set_font_style_table): Deleted. (BUILD_STYLE_TABLE): New macro. (build_style_table): New function. (Vfont_log, font_log_env_checked): New variables. (font_add_log): New function. (syms_of_font): Delete defsubr Sinternal_set_font_style_table. Declare Lisp variables "font-weight-table", "font-slant-table", "font-width-table", and "font-log". Initialize font_style_table. diff -r 7880ee795931 -r 686d116f748d src/font.c --- a/src/font.c Thu May 22 02:05:44 2008 +0000 +++ b/src/font.c Thu May 22 02:19:21 2008 +0000 @@ -51,17 +51,6 @@ #include "macterm.h" #endif /* MAC_OS */ -#ifndef FONT_DEBUG -#define FONT_DEBUG -#endif - -#ifdef FONT_DEBUG -#undef xassert -#define xassert(X) do {if (!(X)) abort ();} while (0) -#else -#define xassert(X) (void) 0 -#endif - Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; Lisp_Object Qopentype; @@ -73,15 +62,68 @@ font_driver *)->list when a specified font is not found. */ static Lisp_Object null_vector; -/* Vector of 3 elements. Each element is a vector for one of font - style properties (weight, slant, width). The vector contains a - mapping between symbolic property values (e.g. `medium' for weight) - and numeric property values (e.g. 100). So, it looks like this: - [[(ultra-light . 20) ... (black . 210)] - [(reverse-oblique . 0) ... (oblique . 210)] - [(ultra-contains . 50) ... (wide . 200)]] */ +static Lisp_Object Vfont_weight_table, Vfont_slant_table, Vfont_width_table; + +/* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */ static Lisp_Object font_style_table; +/* Structure used for tables mapping weight, slant, and width numeric + values and their names. */ + +struct table_entry +{ + int numeric; + /* The first one is a valid name as a face attribute. + The second one (if any) is a typical name in XLFD field. */ + char *names[5]; + Lisp_Object *symbols; +}; + +/* Table of weight numeric values and their names. This table must be + sorted by numeric values in ascending order. */ + +static struct table_entry weight_table[] = +{ + { 0, { "thin" }}, + { 20, { "ultra-light", "ultralight" }}, + { 40, { "extra-light", "extralight" }}, + { 50, { "light" }}, + { 75, { "semi-light", "semilight", "demilight", "book" }}, + { 100, { "normal", "medium", "regular" }}, + { 180, { "semi-bold", "semibold", "demibold", "demi" }}, + { 200, { "bold" }}, + { 205, { "extra-bold", "extrabold" }}, + { 210, { "ultra-bold", "ultrabold", "black" }} +}; + +/* Table of slant numeric values and their names. This table must be + sorted by numeric values in ascending order. */ + +static struct table_entry slant_table[] = +{ + { 0, { "reverse-oblique", "ro" }}, + { 10, { "reverse-italic", "ri" }}, + { 100, { "normal", "r" }}, + { 200, { "italic" ,"i", "ot" }}, + { 210, { "oblique", "o" }} +}; + +/* Table of width numeric values and their names. This table must be + sorted by numeric values in ascending order. */ + +static struct table_entry width_table[] = +{ + { 50, { "ultra-condensed", "ultracondensed" }}, + { 63, { "extra-condensed", "extracondensed" }}, + { 75, { "condensed", "compressed", "narrow" }}, + { 87, { "semi-condensed", "semicondensed", "demicondensed" }}, + { 100, { "normal", "medium", "regular" }}, + { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }}, + { 125, { "expanded" }}, + { 150, { "extra-expanded", "extraexpanded" }}, + { 200, { "ultra-expanded", "ultraexpanded", "wide" }} +}; + extern Lisp_Object Qnormal; /* Symbols representing keys of normal font properties. */ @@ -180,7 +222,7 @@ int len; { int i; - Lisp_Object tem, string; + Lisp_Object tem; Lisp_Object obarray; if (len == 1 && *str == '*') @@ -215,13 +257,13 @@ Lisp_Object size = AREF (spec, FONT_SIZE_INDEX); double point_size; int dpi, pixel_size; - Lisp_Object extra, val; + Lisp_Object val; if (INTEGERP (size)) return XINT (size); if (NILP (size)) return 0; - xassert (FLOATP (size)); + font_assert (FLOATP (size)); point_size = XFLOAT_DATA (size); val = AREF (spec, FONT_DPI_INDEX); if (INTEGERP (val)) @@ -251,7 +293,7 @@ { Lisp_Object table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX); int len = ASIZE (table); - int i; + int i, j; if (SYMBOLP (val)) { @@ -260,50 +302,54 @@ /* At first try exact match. */ for (i = 0; i < len; i++) - if (EQ (val, XCAR (AREF (table, i)))) - return (XINT (XCDR (AREF (table, i))) << 8) | i; + for (j = 1; j < ASIZE (AREF (table, i)); j++) + if (EQ (val, AREF (AREF (table, i), j))) + return ((XINT (AREF (AREF (table, i), 0)) << 8) + | (i << 4) | (j - 1)); /* Try also with case-folding match. */ - s = SDATA (SYMBOL_NAME (val)); + s = (char *) SDATA (SYMBOL_NAME (val)); for (i = 0; i < len; i++) - { - elt = XCAR (AREF (table, i)); - if (strcasecmp (s, (char *) SDATA (SYMBOL_NAME (elt))) == 0) - return i; - } + for (j = 1; j < ASIZE (AREF (table, i)); j++) + { + elt = AREF (AREF (table, i), j); + if (strcasecmp (s, (char *) SDATA (SYMBOL_NAME (elt))) == 0) + return ((XINT (AREF (AREF (table, i), 0)) << 8) + | (i << 4) | (j - 1)); + } if (! noerror) return -1; if (len == 255) abort (); + elt = Fmake_vector (make_number (2), make_number (255)); + ASET (elt, 1, val); args[0] = table; - args[1] = Fmake_vector (make_number (1), Fcons (val, make_number (255))); + args[1] = Fmake_vector (make_number (1), elt); ASET (font_style_table, prop - FONT_WEIGHT_INDEX, Fvconcat (2, args)); - return (255 << 8) | i; + return (255 << 8) | (i << 4); } else { - int last_i, i, last_n; + int i, last_n; int numeric = XINT (val); - for (i = 1, last_i = last_n = -1; i < len;) + for (i = 0, last_n = -1; i < len; i++) { - int n = XINT (XCDR (AREF (table, i))); + int n = XINT (AREF (AREF (table, i), 0)); if (numeric == n) - return (n << 8) | i; + return (n << 8) | (i << 4); if (numeric < n) { if (! noerror) return -1; - return ((last_i < 0 || n - numeric < numeric - last_n) - ? (n << 8) | i : (last_n << 8 | last_i)); + return ((i == 0 || n - numeric < numeric - last_n) + ? (n << 8) | (i << 4): (last_n << 8 | ((i - 1) << 4))); } - last_i = i; last_n = n; - for (i++; i < len && n == XINT (XCDR (AREF (table, i + 1))); i++); } if (! noerror) return -1; - return (last_n << 8) | last_i; + return ((last_n << 8) | ((i - 1) << 4)); } } @@ -314,20 +360,17 @@ int for_face; { Lisp_Object val = AREF (font, prop); - Lisp_Object table; - int i, numeric; + Lisp_Object table, elt; + int i; if (NILP (val)) return Qnil; table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX); - if (! for_face) - return XCAR (AREF (table, XINT (val) & 0xFF)); - numeric = XINT (val) >> 8; - for (i = 0; i < ASIZE (table); i++) - if (XINT (XCDR (AREF (table, i))) == numeric) - return XCAR (AREF (table, i)); - abort (); - return Qnil; + i = XINT (val) & 0xFF; + font_assert (((i >> 4) & 0xF) < ASIZE (table)); + elt = AREF (table, ((i >> 4) & 0xF)); + font_assert ((i & 0xF) + 1 < ASIZE (elt)); + return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1)); } extern Lisp_Object Vface_alternative_font_family_alist; @@ -996,7 +1039,6 @@ { /* Fully specified XLFD. */ int pixel_size; - int spacing_char; ASET (font, FONT_FOUNDRY_INDEX, INTERN_FIELD (XLFD_FOUNDRY_INDEX)); ASET (font, FONT_FAMILY_INDEX, INTERN_FIELD (XLFD_FAMILY_INDEX)); @@ -1030,7 +1072,7 @@ { double point_size = -1; - xassert (FONT_SPEC_P (font)); + font_assert (FONT_SPEC_P (font)); p = f[XLFD_POINT_INDEX]; if (*p == '[') point_size = parse_matrix (p); @@ -1149,7 +1191,7 @@ Lisp_Object val; int i, j, len = 0; - xassert (FONTP (font)); + font_assert (FONTP (font)); for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++, j++) @@ -1206,7 +1248,7 @@ } val = AREF (font, FONT_SIZE_INDEX); - xassert (NUMBERP (val) || NILP (val)); + font_assert (NUMBERP (val) || NILP (val)); if (INTEGERP (val)) { i = XINT (val); @@ -1400,7 +1442,7 @@ { Lisp_Object tail, val; int point_size; - int dpi, spacing, avgwidth; + int dpi; int i, len = 1; char *p; Lisp_Object styles[3]; @@ -1433,8 +1475,6 @@ for (i = 0; i < 3; i++) { - int this_len; - styles[i] = font_style_symbolic (font, FONT_WEIGHT_INDEX + i, 0); if (! NILP (styles[i])) len += sprintf (work, ":%s=%s", style_names[i], @@ -1521,7 +1561,8 @@ int len; char *p0, *p1; - if (! NILP (family)) + if (! NILP (family) + && NILP (AREF (font_spec, FONT_FAMILY_INDEX))) { CHECK_STRING (family); len = SBYTES (family); @@ -1529,7 +1570,8 @@ p1 = index (p0, '-'); if (p1) { - if (*p0 != '*' || p1 - p0 > 1) + if ((*p0 != '*' || p1 - p0 > 1) + && NILP (AREF (font_spec, FONT_FOUNDRY_INDEX))) ASET (font_spec, FONT_FOUNDRY_INDEX, font_intern_prop (p0, p1 - p0)); p1++; @@ -1936,7 +1978,7 @@ Lisp_Object entity_str = SYMBOL_NAME (AREF (entity, i)); Lisp_Object spec_str = SYMBOL_NAME (spec_prop[i]); - if (strcasecmp (SDATA (spec_str), SDATA (entity_str))) + if (strcasecmp ((char *) SDATA (spec_str), (char *) SDATA (entity_str))) { if (i == FONT_FAMILY_INDEX && CONSP (alternate_families)) { @@ -1946,7 +1988,8 @@ j++, alternate_families = XCDR (alternate_families)) { spec_str = XCAR (alternate_families); - if (strcasecmp (SDATA (spec_str), SDATA (entity_str)) == 0) + if (strcasecmp ((char *) SDATA (spec_str), + (char *) SDATA (entity_str)) == 0) break; } @@ -1983,7 +2026,7 @@ if (diff < 0) diff = - diff; - diff << 1; + diff <<= 1; if (! NILP (spec_prop[FONT_DPI_INDEX]) && ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX))) diff |= 1; @@ -2093,6 +2136,7 @@ vec = best_entity; SAFE_FREE (); + font_add_log ("sort-by", prefer, vec); return vec; } @@ -2133,7 +2177,6 @@ { Lisp_Object prefer_prop[FONT_SPEC_MAX]; Lisp_Object alternate_families = Qnil; - int prefer_style[3]; int i; for (i = FONT_FOUNDRY_INDEX; i <= FONT_SIZE_INDEX; i++) @@ -2229,7 +2272,7 @@ val = XCDR (cache); while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type)) cache = val, val = XCDR (val); - xassert (! NILP (val)); + font_assert (! NILP (val)); tmp = XCDR (XCAR (val)); XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1)); if (XINT (XCAR (tmp)) == 0) @@ -2248,9 +2291,9 @@ Lisp_Object val = driver->get_cache (f); Lisp_Object type = driver->type; - xassert (CONSP (val)); + font_assert (CONSP (val)); for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val)); - xassert (CONSP (val)); + font_assert (CONSP (val)); /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */ val = XCDR (XCAR (val)); return val; @@ -2288,7 +2331,7 @@ Lisp_Object val = XCAR (objlist); struct font *font = XFONT_OBJECT (val); - xassert (font && driver == font->driver); + font_assert (font && driver == font->driver); driver->close (f, font); num_fonts--; } @@ -2309,12 +2352,12 @@ Lisp_Object list, spec; int size; { - Lisp_Object entity, prev, tail; + Lisp_Object entity, val; enum font_property_index prop; - for (tail = list, prev = Qnil; CONSP (tail); ) + for (val = Qnil; CONSP (list); list = XCDR (list)) { - entity = XCAR (tail); + entity = XCAR (list); for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++) if (INTEGERP (AREF (spec, prop)) && ((XINT (AREF (spec, prop)) >> 8) @@ -2337,13 +2380,9 @@ AREF (entity, FONT_SPACING_INDEX))) prop = FONT_SPEC_MAX; if (prop < FONT_SPEC_MAX) - prev = tail, tail = XCDR (tail); - else if (NILP (prev)) - list = tail = XCDR (tail); - else - tail = XCDR (tail), XSETCDR (prev, tail); + val = Fcons (entity, val); } - return list; + return val; } @@ -2355,14 +2394,14 @@ { FRAME_PTR f = XFRAME (frame); struct font_driver_list *driver_list = f->font_driver_list; - Lisp_Object ftype, family, alternate_familes; + Lisp_Object ftype, family, alternate_familes, val; Lisp_Object *vec; int size; int need_filtering = 0; int n_family = 1; int i; - xassert (FONT_SPEC_P (spec)); + font_assert (FONT_SPEC_P (spec)); family = AREF (spec, FONT_FAMILY_INDEX); if (NILP (family)) @@ -2408,8 +2447,7 @@ while (1) { - Lisp_Object val = assoc_no_quit (scratch_font_spec, XCDR (cache)); - + val = assoc_no_quit (scratch_font_spec, XCDR (cache)); if (CONSP (val)) val = XCDR (val); else @@ -2417,11 +2455,11 @@ Lisp_Object copy; val = driver_list->driver->list (frame, scratch_font_spec); - if (! NILP (val) && need_filtering) - val = font_delete_unmatched (val, spec, size); copy = Fcopy_font_spec (scratch_font_spec); XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache))); } + if (! NILP (val) && need_filtering) + val = font_delete_unmatched (val, spec, size); if (! NILP (val)) { vec[i++] = val; @@ -2435,7 +2473,9 @@ } } - return (i > 0 ? Fvconcat (i, vec) : null_vector); + val = (i > 0 ? Fvconcat (i, vec) : null_vector); + font_add_log ("list", spec, val); + return (val); } @@ -2481,6 +2521,7 @@ } ASET (spec, FONT_TYPE_INDEX, ftype); ASET (spec, FONT_SIZE_INDEX, size); + font_add_log ("match", spec, entity); return entity; } @@ -2499,7 +2540,7 @@ struct font *font; int min_width; - xassert (FONT_ENTITY_P (entity)); + font_assert (FONT_ENTITY_P (entity)); size = AREF (entity, FONT_SIZE_INDEX); if (XINT (size) != 0) pixel_size = XINT (size); @@ -2517,6 +2558,7 @@ return Qnil; font_object = driver_list->driver->open (f, entity, pixel_size); + font_add_log ("open", entity, font_object); if (NILP (font_object)) return Qnil; ASET (entity, FONT_OBJLIST_INDEX, @@ -2566,9 +2608,10 @@ prev = tail, tail = XCDR (tail)) if (EQ (font_object, XCAR (tail))) { + font_add_log ("close", font_object, Qnil); font->driver->close (f, font); #ifdef HAVE_WINDOW_SYSTEM - xassert (FRAME_X_DISPLAY_INFO (f)->n_fonts); + font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts); FRAME_X_DISPLAY_INFO (f)->n_fonts--; #endif if (NILP (prev)) @@ -2608,7 +2651,7 @@ return driver_list->driver->has_char (font, c); } - xassert (FONT_OBJECT_P (font)); + font_assert (FONT_OBJECT_P (font)); fontp = XFONT_OBJECT (font); if (fontp->driver->has_char) { @@ -2630,7 +2673,7 @@ { struct font *font; - xassert (FONT_OBJECT_P (font_object)); + font_assert (FONT_OBJECT_P (font_object)); font = XFONT_OBJECT (font_object); return font->driver->encode_char (font, c); } @@ -2642,9 +2685,7 @@ font_get_name (font_object) Lisp_Object font_object; { - Lisp_Object name; - - xassert (FONT_OBJECT_P (font_object)); + font_assert (FONT_OBJECT_P (font_object)); return AREF (font_object, FONT_NAME_INDEX); } @@ -2683,7 +2724,6 @@ enum font_property_index prop; { Lisp_Object font = attrs[LFACE_FONT_INDEX]; - Lisp_Object extra, prev; if (! FONTP (font)) return; @@ -2715,8 +2755,7 @@ FRAME_PTR f; Lisp_Object *attrs; { - Lisp_Object spec, val; - int n; + Lisp_Object spec; spec = attrs[LFACE_FONT_INDEX]; if (! FONT_SPEC_P (spec)) @@ -2816,7 +2855,7 @@ { /* Sort fonts by properties specified in LFACE. */ Lisp_Object prefer = scratch_font_prefer; - double pt; + for (i = 0; i < FONT_EXTRA_INDEX; i++) ASET (prefer, i, AREF (spec, i)); if (FONTP (attrs[LFACE_FONT_INDEX])) @@ -3252,7 +3291,7 @@ if (! face->font) return Qnil; - xassert (font_check_object ((struct font *) face->font)); + font_assert (font_check_object ((struct font *) face->font)); XSETFONT (font_object, face->font); return font_object; } @@ -3490,7 +3529,6 @@ Lisp_Object font_spec, prop, val; { int idx; - Lisp_Object extra, slot; CHECK_FONT_SPEC (font_spec); idx = get_font_prop_index (prop); @@ -3605,12 +3643,14 @@ return val; } -DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 1, 0, +DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0, doc: /* Return XLFD name of FONT. FONT is a font-spec, font-entity, or font-object. -If the name is too long for XLFD (maximum 255 chars), return nil. */) - (font) - Lisp_Object font; +If the name is too long for XLFD (maximum 255 chars), return nil. +If the 2nd optional arg FOLD-WILDCARDS is non-nil, +the consecutive wildcards are folded to one. */) + (font, fold_wildcards) + Lisp_Object font, fold_wildcards; { char name[256]; int pixel_size = 0; @@ -3623,11 +3663,28 @@ if (STRINGP (font_name) && SDATA (font_name)[0] == '-') - return font_name; + { + if (NILP (fold_wildcards)) + return font_name; + strcpy (name, (char *) SDATA (font_name)); + goto done; + } pixel_size = XFONT_OBJECT (font)->pixel_size; } if (font_unparse_xlfd (font, pixel_size, name, 256) < 0) return Qnil; + done: + if (! NILP (fold_wildcards)) + { + char *p0 = name, *p1; + + while ((p1 = strstr (p0, "-*-*"))) + { + strcpy (p1, p1 + 2); + p0 = p1; + } + } + return build_string (name); } @@ -3652,7 +3709,7 @@ while (! NILP (val) && ! EQ (XCAR (XCAR (val)), driver_list->driver->type)) val = XCDR (val); - xassert (! NILP (val)); + font_assert (! NILP (val)); val = XCDR (XCAR (val)); if (XINT (XCAR (val)) == 0) { @@ -3665,60 +3722,7 @@ return Qnil; } -DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table, - Sinternal_set_font_style_table, 3, 3, 0, - doc: /* Setup font style table from WEIGHT, SLANT, and WIDTH tables. -WEIGHT, SLANT, WIDTH must be `font-weight-table', `font-slant-table', -`font-width-table' respectivly. -This function is called after those tables are initialized. */) - (weight, slant, width) - Lisp_Object weight, slant, width; -{ - Lisp_Object tables[3]; - int i; - - tables[0] = weight, tables[1] = slant, tables[2] = width; - - font_style_table = Fmake_vector (make_number (3), Qnil); - /* In the following loop, we don't use XCAR and XCDR until assuring - the argument is a cons cell so that the error in the tables can - be detected. */ - for (i = 0; i < 3; i++) - { - Lisp_Object tail, elt, list, val; - - for (tail = tables[i], list = Qnil; CONSP (tail); tail = XCDR (tail)) - { - int numeric = -1; - - elt = Fcar (tail); - CHECK_SYMBOL (Fcar (elt)); - val = Fcons (XCAR (elt), Qnil); - elt = XCDR (elt); - CHECK_NATNUM (Fcar (elt)); - if (numeric >= XINT (XCAR (elt))) - error ("Numeric values not unique nor sorted in %s", - (i == 0 ? "font-weight-table" - : i == 1 ? "font-slant-table" - : "font-width-table")); - numeric = XINT (XCAR (elt)); - XSETCDR (val, XCAR (elt)); - list = Fcons (val, list); - for (elt = XCDR (elt); CONSP (elt); elt = XCDR (elt)) - { - val = XCAR (elt); - CHECK_SYMBOL (val); - list = Fcons (Fcons (XCAR (elt), make_number (numeric)), list); - } - } - list = Fnreverse (list); - ASET (font_style_table, i, Fvconcat (1, &list)); - } - - return Qnil; -} - -/* The following three functions are still experimental. */ +/* 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. @@ -4347,6 +4351,77 @@ #endif /* FONT_DEBUG */ +#define BUILD_STYLE_TABLE(TBL) \ + build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry)) + +static Lisp_Object +build_style_table (entry, nelement) + struct table_entry *entry; + int nelement; +{ + int i, j; + Lisp_Object table, elt; + + table = Fmake_vector (make_number (nelement), Qnil); + for (i = 0; i < nelement; i++) + { + for (j = 0; entry[i].names[j]; j++); + elt = Fmake_vector (make_number (j + 1), Qnil); + ASET (elt, 0, make_number (entry[i].numeric)); + for (j = 0; entry[i].names[j]; j++) + ASET (elt, j + 1, intern (entry[i].names[j])); + ASET (table, i, elt); + } + return table; +} + +static Lisp_Object Vfont_log; +static int font_log_env_checked; + +void +font_add_log (action, arg, result) + char *action; + Lisp_Object arg, result; +{ + Lisp_Object tail, val; + int i; + + if (! font_log_env_checked) + { + Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt; + font_log_env_checked = 1; + } + if (EQ (Vfont_log, Qt)) + return; + if (FONTP (arg)) + arg = Ffont_xlfd_name (arg, Qt); + if (FONTP (result)) + result = Ffont_xlfd_name (result, Qt); + else if (CONSP (result)) + { + result = Fcopy_sequence (result); + for (tail = result; CONSP (tail); tail = XCDR (tail)) + { + val = XCAR (tail); + if (FONTP (val)) + val = Ffont_xlfd_name (val, Qt); + XSETCAR (tail, val); + } + } + else if (VECTORP (result)) + { + result = Fcopy_sequence (result); + for (i = 0; i < ASIZE (result); i++) + { + val = AREF (result, i); + if (FONTP (val)) + val = Ffont_xlfd_name (val, Qt); + ASET (result, i, val); + } + } + Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log); +} + extern void syms_of_ftfont P_ (()); extern void syms_of_xfont P_ (()); extern void syms_of_xftfont P_ (()); @@ -4368,9 +4443,6 @@ /* Note that sort_shift_bits[FONT_SORT_TYPE] and sort_shift_bits[FONT_SORT_REGISTRY] are never used. */ - staticpro (&font_style_table); - font_style_table = Fmake_vector (make_number (3), Qnil); - staticpro (&font_charset_alist); font_charset_alist = Qnil; @@ -4427,7 +4499,6 @@ defsubr (&Sfind_font); defsubr (&Sfont_xlfd_name); defsubr (&Sclear_font_cache); - defsubr (&Sinternal_set_font_style_table); defsubr (&Sfont_make_gstring); defsubr (&Sfont_fill_gstring); defsubr (&Sfont_shape_text); @@ -4468,6 +4539,36 @@ gets the repertory information by an opened font and ENCODING. */); Vfont_encoding_alist = Qnil; + DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table, + doc: /* Vector of valid font weight values. +Each element has the form: + [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...] +NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symobls. */); + Vfont_weight_table = BUILD_STYLE_TABLE (weight_table); + + DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table, + doc: /* Vector of font slant symbols vs the corresponding numeric values. +See `font-weight_table' for the format of the vector. */); + Vfont_slant_table = BUILD_STYLE_TABLE (slant_table); + + DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table, + doc: /* Alist of font width symbols vs the corresponding numeric values. +See `font-weight_table' for the format of the vector. */); + Vfont_width_table = BUILD_STYLE_TABLE (width_table); + + staticpro (&font_style_table); + font_style_table = Fmake_vector (make_number (3), Qnil); + ASET (font_style_table, 0, Vfont_weight_table); + ASET (font_style_table, 1, Vfont_slant_table); + ASET (font_style_table, 2, Vfont_width_table); + + DEFVAR_LISP ("font-log", &Vfont_log, doc: /* +*Logging list of font related actions and results. +The value t means to suppress the logging. +The initial value is set to nil if the environment variable +EMACS_FONT_LOG is set. Otherwise, it is set to t. */); + Vfont_log = Qnil; + #ifdef HAVE_WINDOW_SYSTEM #ifdef HAVE_FREETYPE syms_of_ftfont ();