# HG changeset patch # User Kenichi Handa # Date 1042182823 0 # Node ID 9a305cf426889e6d0ed34e8198daeedbc74de751 # Parent e4ea90e23f57bac2b744ec29ff6c96982768360c Give 8 extra slots to fontset objects. (Qfontset_info): New variable. (syms_of_fontset): Defsym it. (FONTSET_FALLBACK): New macro. (fontset_face): Try also the default fontset. (make_fontset): Realize a fallback fontset from the default fontset. (generate_ascii_font_name): Moved from xfaces.c. Rewritten by using split_font_name_into_vector and build_font_name_from_vector. (Fset_fontset_font): Access the elements of font_spec by enum FONT_SPEC_INDEX. If font_spec is a string, extract the registry name by using split_font_name_into_vector. (Fnew_fontset): If no ASCII font is specified in FONTLIST, generate a proper font name from the fontset name. Update Vfontset_alias_alist. (n_auto_fontsets): New variable. (new_fontset_from_font_name): New function. (Ffont_info): Store the information about fonts generated from the default fontset in the first extra slot of the returned char-table. diff -r e4ea90e23f57 -r 9a305cf42688 src/fontset.c --- a/src/fontset.c Fri Jan 10 06:55:55 2003 +0000 +++ b/src/fontset.c Fri Jan 10 07:13:43 2003 +0000 @@ -113,7 +113,7 @@ range of characters. - A fontset has 5 extra slots. + A fontset has 8 extra slots. The 1st slot: the ID number of the fontset @@ -122,7 +122,7 @@ realized: nil The 3rd slot: - base: nli + base: nil realized: the base fontset The 4th slot: @@ -143,6 +143,10 @@ realized: Alist of font index vs the corresponding repertory char-table. + The 8th slot: + base: nil + realized: If the base is not the default fontset, a fontset + realized from the default fontset, else nil. All fontsets are recorded in the vector Vfontset_table. @@ -169,7 +173,8 @@ /********** VARIABLES and FUNCTION PROTOTYPES **********/ extern Lisp_Object Qfont; -Lisp_Object Qfontset; +static Lisp_Object Qfontset; +static Lisp_Object Qfontset_info; static Lisp_Object Qprepend, Qappend; /* Vector containing all fontsets. */ @@ -271,6 +276,7 @@ #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3] #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5] #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6] +#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[7] /* Return the element of FONTSET for the character C. If FONTSET is a @@ -483,23 +489,24 @@ int c; struct face *face; { - Lisp_Object elt, vec; + Lisp_Object base_fontset, elt, vec; int i, from, to; int font_idx; FRAME_PTR f = XFRAME (FONTSET_FRAME (fontset)); + base_fontset = FONTSET_BASE (fontset); elt = CHAR_TABLE_REF (fontset, c); if (EQ (elt, Qt)) - goto font_not_found; + goto try_default; + if (NILP (elt)) { /* We have not yet decided a face for C. */ - Lisp_Object base_fontset, range; + Lisp_Object range; if (! face) return -1; - base_fontset = FONTSET_BASE (fontset); elt = FONTSET_REF_AND_RANGE (base_fontset, c, from, to); range = Fcons (make_number (from), make_number (to)); if (NILP (elt)) @@ -507,7 +514,7 @@ /* Record that we have no font for characters of this range. */ FONTSET_SET (fontset, range, Qt); - goto font_not_found; + goto try_default; } elt = Fcopy_sequence (elt); /* Now ELT is a vector of FONT-DEFs. We at first change it to @@ -556,7 +563,7 @@ = CHARSET_FROM_ID (XINT (AREF (font_def, 2))); if (! CHAR_CHARSET_P (c, charset)) - /* This fond can't display C. */ + /* This font can't display C. */ continue; } else @@ -609,6 +616,10 @@ return XINT (AREF (elt, 0)); } + try_default: + if (! EQ (base_fontset, Vdefault_fontset)) + return fontset_face (FONTSET_FALLBACK (fontset), c, face); + font_not_found: /* We have tried all the fonts for C, but none of them can be opened nor can display C. */ @@ -672,6 +683,8 @@ ASET (Vfontset_table, id, fontset); next_fontset_id = id + 1; + if (! NILP (base) && ! EQ (base, Vdefault_fontset)) + FONTSET_FALLBACK (fontset) = make_fontset (frame, Qnil, Vdefault_fontset); return fontset; } @@ -1130,6 +1143,28 @@ } +/* Return an ASCII font name generated from fontset name NAME and + ASCII font specification ASCII_SPEC. NAME is a string conforming + to XLFD. ASCII_SPEC is a vector: + [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */ + +static INLINE Lisp_Object +generate_ascii_font_name (name, ascii_spec) + Lisp_Object name, ascii_spec; +{ + Lisp_Object vec; + int i; + + vec = split_font_name_into_vector (name); + for (i = FONT_SPEC_FAMILY_INDEX; i <= FONT_SPEC_ADSTYLE_INDEX; i++) + if (! NILP (AREF (ascii_spec, i))) + ASET (vec, 1 + i, AREF (ascii_spec, i)); + if (! NILP (AREF (ascii_spec, FONT_SPEC_REGISTRY_INDEX))) + ASET (vec, 12, AREF (ascii_spec, FONT_SPEC_REGISTRY_INDEX)); + return build_font_name_from_vector (vec); +} + + DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0, doc: /* Modify fontset NAME to use FONT-SPEC for CHARACTER. @@ -1180,21 +1215,21 @@ { int j; - if (ASIZE (font_spec) != 6) - args_out_of_range (make_number (6), + if (ASIZE (font_spec) != FONT_SPEC_MAX_INDEX) + args_out_of_range (make_number (FONT_SPEC_MAX_INDEX), make_number (ASIZE (font_spec))); font_spec = Fcopy_sequence (font_spec); - for (j = 0; j < 5; j++) + for (j = 0; j < FONT_SPEC_MAX_INDEX - 1; j++) if (! NILP (AREF (font_spec, j))) { CHECK_STRING (AREF (font_spec, j)); ASET (font_spec, j, Fdowncase (AREF (font_spec, j))); } /* REGISTRY should not be omitted. */ - CHECK_STRING (AREF (font_spec, 5)); - registry = Fdowncase (AREF (font_spec, 5)); - ASET (font_spec, 5, registry); + CHECK_STRING (AREF (font_spec, FONT_SPEC_REGISTRY_INDEX)); + registry = Fdowncase (AREF (font_spec, FONT_SPEC_REGISTRY_INDEX)); + ASET (font_spec, FONT_SPEC_REGISTRY_INDEX, registry); } else if (CONSP (font_spec)) @@ -1211,17 +1246,22 @@ } CHECK_STRING (registry); registry = Fdowncase (registry); - font_spec = Fmake_vector (make_number (6), Qnil); - ASET (font_spec, 0, family); - ASET (font_spec, 5, registry); + font_spec = Fmake_vector (make_number (FONT_SPEC_MAX_INDEX), Qnil); + ASET (font_spec, FONT_SPEC_FAMILY_INDEX, family); + ASET (font_spec, FONT_SPEC_REGISTRY_INDEX, registry); } else { CHECK_STRING (font_spec); font_spec = Fdowncase (font_spec); - registry = font_name_registry (font_spec); + registry = split_font_name_into_vector (font_spec); if (NILP (registry)) error ("No XLFD: %s", XSTRING (font_spec)->data); + if (NILP (AREF (registry, 12)) + || NILP (AREF (registry, 13))) + error ("Registry must be specified"); + registry = concat2 (concat2 (AREF (registry, 12), build_string ("-")), + AREF (registry, 13)); } if (STRINGP (font_spec)) @@ -1278,7 +1318,7 @@ range_list); if (EQ (character, Qascii)) { - if (! STRINGP (font_spec)) + if (VECTORP (font_spec)) font_spec = generate_ascii_font_name (FONTSET_NAME (fontset), font_spec); FONTSET_ASCII (fontset) = font_spec; @@ -1306,10 +1346,12 @@ doc: /* Create a new fontset NAME from font information in FONTLIST. FONTLIST is an alist of scripts vs the corresponding font specification list. -Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where -a character of SCRIPT is displayed by a font that matches FONT-SPEC. +Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a +character of SCRIPT is displayed by a font that matches one of +FONT-SPEC. -SCRIPT is a symbol that appears in the variable `script-alist'. +SCRIPT is a symbol that appears in the first extra slot of the +char-table `char-script-table'. FONT-SPEC is a vector, a cons, or a string. See the documentation of `set-fontset-font' for the meaning. */) @@ -1323,14 +1365,24 @@ CHECK_STRING (name); CHECK_LIST (fontlist); - /* Check if an ASCII font is specified in FONTLIST. */ - val = Fcar (Fcdr (Fassq (Qascii, fontlist))); - if (NILP (val)) - error ("No ascii font specified"); - id = fs_query_fontset (name, 0); if (id < 0) - fontset = make_fontset (Qnil, Fdowncase (name), Qnil); + { + name = Fdowncase (name); + val = split_font_name_into_vector (name); + if (NILP (val)) + error ("Fontset name must be in XLFD format"); + if (strcmp (XSTRING (AREF (val, 12))->data, "fontset")) + error ("Registry field of fontset name must be \"fontset\""); + Vfontset_alias_alist + = Fcons (Fcons (name, + concat2 (concat2 (AREF (val, 12), build_string ("-")), + AREF (val, 13))), + Vfontset_alias_alist); + ASET (val, 12, build_string ("iso8859-1")); + fontset = make_fontset (Qnil, name, Qnil); + FONTSET_ASCII (fontset) = build_font_name_from_vector (val); + } else { fontset = FONTSET_FROM_ID (id);; @@ -1344,15 +1396,51 @@ elt = Fcar (fontlist); script = Fcar (elt); - elt = Fcdr (elt); - Fset_fontset_font (name, script, Fcar (elt), Qnil, Qnil); for (elt = Fcdr (elt); ! NILP (elt); elt = Fcdr (elt)) - Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend); + Fset_fontset_font (name, script, Fcar (elt), Qnil, Qappend); } return name; } +/* Number of fontsets created from a fontname automatically. */ +static int n_auto_fontsets; + +int +new_fontset_from_font_name (Lisp_Object fontname) +{ + Lisp_Object name; + Lisp_Object vec; + + fontname = Fdowncase (fontname); + vec = split_font_name_into_vector (fontname); + if ( NILP (vec)) + vec = Fmake_vector (make_number (14), build_string ("")); + ASET (vec, 12, build_string ("fontset")); + if (n_auto_fontsets == 0) + { + ASET (vec, 13, build_string ("startup")); + name = build_font_name_from_vector (vec); + n_auto_fontsets++; + } + else + { + char temp[20]; + + do { + sprintf (temp, "auto%d", n_auto_fontsets); + ASET (vec, 13, build_string (temp)); + name = build_font_name_from_vector (vec); + n_auto_fontsets++; + } while (fs_query_fontset (name, 0) >= 0); + } + name = Fnew_fontset (name, + Fcons (Fcons (Qascii, Fcons (fontname, Qnil)), Qnil)); + Vfontset_alias_alist = Fcons (Fcons (name, fontname), Vfontset_alias_alist); + return fs_query_fontset (name, 0); +} + + DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0, doc: /* Return information about a font named NAME on frame FRAME. If FRAME is omitted or nil, use the selected frame. @@ -1465,7 +1553,11 @@ or a string of font name pattern. -OPENED-FONT is a name of a font actually opened. */) +OPENED-FONT is a name of a font actually opened. + +The char-table has one extra slot. The value is a char-table +containing the information about the derived fonts from the default +fontset. The format is the same as abobe. */) (fontset, frame) Lisp_Object fontset, frame; { @@ -1473,6 +1565,7 @@ Lisp_Object table, val, elt; Lisp_Object *realized; int n_realized = 0; + int fallback; int c, i, j; (*check_window_system_func) (); @@ -1498,57 +1591,77 @@ } - table = Fmake_char_table (Qnil, Qnil); + table = Fmake_char_table (Qfontset_info, Qnil); + XCHAR_TABLE (table)->extras[0] = Fmake_char_table (Qnil, Qnil); /* Accumulate information of the fontset in TABLE. The format of each element is ((FONT-SPEC OPENED-FONT ...) ...). */ - for (c = 0; c <= MAX_CHAR; ) + for (fallback = 0; fallback <= 1; fallback++) { - int from, to; - - val = FONTSET_REF_AND_RANGE (fontset, c, from, to); - if (VECTORP (val)) + Lisp_Object this_fontset, this_table; + + if (! fallback) + { + this_fontset = fontset; + this_table = table; + } + else { - Lisp_Object alist; + this_fontset = Vdefault_fontset; + this_table = XCHAR_TABLE (table)->extras[0]; + for (i = 0; i < n_realized; i++) + realized[i] = FONTSET_FALLBACK (realized[i]); + } + for (c = 0; c <= MAX_5_BYTE_CHAR; ) + { + int from, to; - /* At first, set ALIST to ((FONT-SPEC) ...). */ - for (alist = Qnil, i = 0; i < ASIZE (val); i++) - alist = Fcons (Fcons (AREF (AREF (val, i), 0), Qnil), alist); - alist = Fnreverse (alist); - - /* Then store opend font names to cdr of each elements. */ - for (i = 0; i < n_realized; i++) + val = char_table_ref_and_range (this_fontset, c, &from, &to); + if (VECTORP (val)) { - val = FONTSET_REF (realized[i], c); - if (NILP (val)) - continue; - val = XCDR (val); - /* Now VAL is [[FACE-ID FONT-INDEX FONT-DEF] ...]. - If a font of an element is already opened, - FONT-INDEX of the element is integer. */ - for (j = 0; j < ASIZE (val); j++) - if (INTEGERP (AREF (AREF (val, j), 0))) - { - Lisp_Object font_idx; + Lisp_Object alist; + + /* At first, set ALIST to ((FONT-SPEC) ...). */ + for (alist = Qnil, i = 0; i < ASIZE (val); i++) + alist = Fcons (Fcons (AREF (AREF (val, i), 0), Qnil), alist); + alist = Fnreverse (alist); - font_idx = AREF (AREF (val, j), 1); - elt = Fassq (AREF (AREF (AREF (val, j), 2), 0), alist); - if (CONSP (elt) - && NILP (Fmemq (font_idx, XCDR(elt)))) - nconc2 (elt, Fcons (font_idx, Qnil)); + /* Then store opend font names to cdr of each elements. */ + for (i = 0; i < n_realized; i++) + { + if (NILP (realized[i])) + continue; + val = FONTSET_REF (realized[i], c); + if (NILP (val)) + continue; + val = XCDR (val); + /* Now VAL is [[FACE-ID FONT-INDEX FONT-DEF] ...]. + If a font of an element is already opened, + FONT-INDEX of the element is integer. */ + for (j = 0; j < ASIZE (val); j++) + if (INTEGERP (AREF (AREF (val, j), 0))) + { + Lisp_Object font_idx; + + font_idx = AREF (AREF (val, j), 1); + elt = Fassq (AREF (AREF (AREF (val, j), 2), 0), alist); + if (CONSP (elt) + && NILP (Fmemq (font_idx, XCDR(elt)))) + nconc2 (elt, Fcons (font_idx, Qnil)); + } + } + for (val = alist; CONSP (val); val = XCDR (val)) + for (elt = XCDR (XCAR (val)); CONSP (elt); elt = XCDR (elt)) + { + struct font_info *font_info + = (*get_font_info_func) (f, XINT (XCAR (elt))); + XSETCAR (elt, build_string (font_info->full_name)); } + + /* Store ALIST in TBL for characters C..TO. */ + char_table_set_range (this_table, c, to, alist); } - for (val = alist; CONSP (val); val = XCDR (val)) - for (elt = XCDR (XCAR (val)); CONSP (elt); elt = XCDR (elt)) - { - struct font_info *font_info - = (*get_font_info_func) (f, XINT (XCAR (elt))); - XSETCAR (elt, build_string (font_info->full_name)); - } - - /* Store ALIST in TABLE for characters C..TO. */ - char_table_set_range (table, c, to, alist); + c = to + 1; } - c = to + 1; } return table; @@ -1599,7 +1712,9 @@ abort (); DEFSYM (Qfontset, "fontset"); - Fput (Qfontset, Qchar_table_extra_slots, make_number (7)); + Fput (Qfontset, Qchar_table_extra_slots, make_number (8)); + DEFSYM (Qfontset_info, "fontset-info"); + Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1)); DEFSYM (Qprepend, "prepend"); DEFSYM (Qappend, "append");