X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/303d51903a88032596186ee8fb02f08a28f653f9..13a3f37497fe0d15a425627fdd0d3c1113a23519:/src/fontset.c diff --git a/src/fontset.c b/src/fontset.c index a343e27e51..8f3fcd3d17 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1,8 +1,8 @@ /* Fontset handler. - Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 + Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005, 2006, 2007, 2008 + 2005, 2006, 2007, 2008, 2009 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H14PRO021 Copyright (C) 2003, 2006 @@ -89,7 +89,8 @@ EXFUN (Fclear_face_cache, 1); An element of a base fontset is a vector of FONT-DEFs which itself is a vector [ FONT-SPEC ENCODING REPERTORY ]. - An element of a realized fontset is nil, t, or a vector of this form: + An element of a realized fontset is nil, t, 0, or a vector of this + form: [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ... ] @@ -107,6 +108,10 @@ EXFUN (Fclear_face_cache, 1); The value t means that no font is available for the corresponding range of characters. + The value 0 means that no font is available for the corresponding + range of characters in this fontset, but may be available in the + default fontset. + A fontset has 9 extra slots. @@ -175,7 +180,7 @@ extern Lisp_Object Qfont; static Lisp_Object Qfontset; static Lisp_Object Qfontset_info; static Lisp_Object Qprepend, Qappend; -static Lisp_Object Qlatin; +Lisp_Object Qlatin; /* Vector containing all fontsets. */ static Lisp_Object Vfontset_table; @@ -352,9 +357,8 @@ fontset_add (fontset, range, elt, add) int from1, to1; do { + from1 = from, to1 = to; args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1); - if (to < to1) - to1 = to; char_table_set_range (fontset, from, to1, NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args)); @@ -419,16 +423,16 @@ reorder_font_vector (font_group, font) if (! font_match_p (font_spec, font_object)) { - Lisp_Object repertory = FONT_DEF_REPERTORY (font_def); + Lisp_Object encoding = FONT_DEF_ENCODING (font_def); - if (! NILP (repertory)) + if (! NILP (encoding)) { Lisp_Object tail; for (tail = Vcharset_ordered_list; ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail); score += 0x100, tail = XCDR (tail)) - if (EQ (repertory, XCAR (tail))) + if (EQ (encoding, XCAR (tail))) break; } else @@ -460,7 +464,7 @@ fontset_get_font_group (Lisp_Object fontset, int c) { Lisp_Object font_group; Lisp_Object base_fontset; - int from, to, i; + int from = 0, to = MAX_CHAR, i; xassert (! BASE_FONTSET_P (fontset)); if (c >= 0) @@ -475,7 +479,11 @@ fontset_get_font_group (Lisp_Object fontset, int c) else font_group = FONTSET_FALLBACK (base_fontset); if (NILP (font_group)) - return Qnil; + { + if (c >= 0) + char_table_set_range (fontset, from, to, make_number (0)); + return Qnil; + } font_group = Fcopy_sequence (font_group); for (i = 0; i < ASIZE (font_group); i++) if (! NILP (AREF (font_group, i))) @@ -515,14 +523,14 @@ fontset_find_font (fontset, c, face, id, fallback) struct face *face; int id, fallback; { - Lisp_Object elt, vec, font_group; - int i; - FRAME_PTR f = XFRAME (FONTSET_FRAME (fontset)); - int charset_matched = -1; + Lisp_Object vec, font_group; + int i, charset_matched = -1; + FRAME_PTR f = (FRAMEP (FONTSET_FRAME (fontset))) + ? XFRAME (selected_frame) : XFRAME (FONTSET_FRAME (fontset)); font_group = fontset_get_font_group (fontset, fallback ? -1 : c); if (! CONSP (font_group)) - return Qnil; + return font_group; vec = XCDR (font_group); if (ASIZE (vec) == 0) return Qnil; @@ -539,8 +547,11 @@ fontset_find_font (fontset, c, face, id, fallback) for (i = 0; i < ASIZE (vec); i++) { Lisp_Object rfont_def = AREF (vec, i); - Lisp_Object repertory - = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def)); + Lisp_Object repertory; + + if (NILP (rfont_def)) + break; + repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def)); if (XINT (repertory) == id) { @@ -553,97 +564,111 @@ fontset_find_font (fontset, c, face, id, fallback) /* Find the first available font in the vector of RFONT-DEF. */ for (i = 0; i < ASIZE (vec); i++) { + Lisp_Object rfont_def, font_def; Lisp_Object font_entity, font_object; if (i == 0 && charset_matched >= 0) { /* Try the element matching with the charset ID at first. */ - elt = AREF (vec, charset_matched); + rfont_def = AREF (vec, charset_matched); charset_matched = -1; i--; } else if (i != charset_matched) - elt = AREF (vec, i); + rfont_def = AREF (vec, i); else continue; - if (NILP (elt)) + if (NILP (rfont_def)) /* This is a sign of not to try the other fonts. */ return Qt; - if (INTEGERP (RFONT_DEF_FACE (elt)) - && XINT (AREF (elt, 1)) < 0) + if (INTEGERP (RFONT_DEF_FACE (rfont_def)) + && XINT (RFONT_DEF_FACE (rfont_def)) < 0) /* We couldn't open this font last time. */ continue; - font_object = RFONT_DEF_OBJECT (elt); + font_object = RFONT_DEF_OBJECT (rfont_def); if (NILP (font_object)) { - Lisp_Object font_def = RFONT_DEF_FONT_DEF (elt); + font_def = RFONT_DEF_FONT_DEF (rfont_def); if (! face) /* We have not yet opened the font. */ return Qnil; + /* Find a font best-matching with the spec without checking + the support of the character C. That checking is costly, + and even without the checking, the found font supports C + in high possibility. */ font_entity = font_find_for_lface (f, face->lface, FONT_DEF_SPEC (font_def), -1); if (NILP (font_entity)) { /* Record that no font matches the spec. */ - RFONT_DEF_SET_FACE (elt, -1); + RFONT_DEF_SET_FACE (rfont_def, -1); continue; } font_object = font_open_for_lface (f, font_entity, face->lface, FONT_DEF_SPEC (font_def)); if (NILP (font_object)) { - /* Record that the font is unsable. */ - RFONT_DEF_SET_FACE (elt, -1); + /* Something strange happened, perhaps because of a + Font-backend problem. Too avoid crashing, record + that this spec is unsable. It may be better to find + another font of the same spec, but currently we don't + have such an API. */ + RFONT_DEF_SET_FACE (rfont_def, -1); continue; } - RFONT_DEF_SET_OBJECT (elt, font_object); + RFONT_DEF_SET_OBJECT (rfont_def, font_object); } if (font_has_char (f, font_object, c)) - return elt; - -#if 0 - /* The following code makes Emacs to find a font for C by fairly - exhausitive search. But, that takes long time especially for - X font backend. */ + return rfont_def; - /* Try to find the different font maching with the current spec - and support C. */ - font_def = RFONT_DEF_FONT_DEF (elt); + /* Find a font already opened, maching with the current spec, + and supporting C. */ + font_def = RFONT_DEF_FONT_DEF (rfont_def); for (i++; i < ASIZE (vec); i++) { - if (! EQ (RFONT_DEF_FONT_DEF (AREF (vec, i)), font_def)) + rfont_def = AREF (vec, i); + if (NILP (rfont_def)) + return Qt; + if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def)) break; - if (font_has_char (f, RFONT_DEF_OBJECT (AREF (vec, i)), c)) - return AREF (vec, i); + font_object = RFONT_DEF_OBJECT (AREF (vec, i)); + if (! NILP (font_object) && font_has_char (f, font_object, c)) + return rfont_def; } - /* Find an font-entity that support C. */ + + /* Find a font-entity with the current spec and supporting C. */ font_entity = font_find_for_lface (f, face->lface, FONT_DEF_SPEC (font_def), c); if (! NILP (font_entity)) { - Lisp_Object rfont_def, new_vec; + /* We found a font. Open it and insert a new element for + that font in VEC. */ + Lisp_Object new_vec; int j; font_object = font_open_for_lface (f, font_entity, face->lface, Qnil); + if (NILP (font_object)) + continue; RFONT_DEF_NEW (rfont_def, font_def); RFONT_DEF_SET_OBJECT (rfont_def, font_object); - RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (elt)); + RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def)); new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil); for (j = 0; j < i; j++) ASET (new_vec, j, AREF (vec, j)); ASET (new_vec, j, rfont_def); for (j++; j < ASIZE (new_vec); j++) ASET (new_vec, j, AREF (vec, j - 1)); - vec = new_vec; + XSETCDR (font_group, new_vec); return rfont_def; } + + /* No font of the current spec for C. Try the next spec. */ i--; -#endif /* 0 */ } FONTSET_SET (fontset, make_number (c), make_number (0)); @@ -666,7 +691,7 @@ fontset_font (fontset, c, face, id) if (VECTORP (rfont_def)) return rfont_def; if (EQ (rfont_def, Qt)) - return Qnil; + goto no_font; /* Try a font-group of the default fontset. */ base_fontset = FONTSET_BASE (fontset); @@ -679,7 +704,7 @@ fontset_font (fontset, c, face, id) if (VECTORP (rfont_def)) return rfont_def; if (EQ (rfont_def, Qt)) - return Qnil; + goto no_font; } /* Try a fallback font-group of FONTSET. */ @@ -687,7 +712,7 @@ fontset_font (fontset, c, face, id) if (VECTORP (rfont_def)) return rfont_def; if (EQ (rfont_def, Qt)) - return Qnil; + goto no_font; /* Try a fallback font-group of the default fontset . */ if (! EQ (base_fontset, Vdefault_fontset)) @@ -697,7 +722,8 @@ fontset_font (fontset, c, face, id) return rfont_def; } - /* Remeber that we have no font for C. */ + no_font: + /* Remember that we have no font for C. */ FONTSET_SET (fontset, make_number (c), Qt); return Qnil; @@ -744,23 +770,6 @@ make_fontset (frame, name, base) return fontset; } - -/* Set the ASCII font of the default fontset to FONTNAME if that is - not yet set. */ -void -set_default_ascii_font (fontname) - Lisp_Object fontname; -{ - if (! STRINGP (FONTSET_ASCII (Vdefault_fontset))) - { - int id = fs_query_fontset (fontname, 2); - - if (id >= 0) - fontname = FONTSET_ASCII (FONTSET_FROM_ID (id)); - FONTSET_ASCII (Vdefault_fontset)= fontname; - } -} - /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/ @@ -876,7 +885,11 @@ face_for_char (f, face, c, pos, object) int face_id; int id; - if (ASCII_CHAR_P (c)) + /* If face->fontset is negative (that happens when no font is found + for face), just return face->ascii_face because we can't do + anything. Perhaps, we should fix the callers to assure + that face->fontset is always valid. */ + if (ASCII_CHAR_P (c) || face->fontset < 0) return face->ascii_face->id; xassert (fontset_id_valid_p (face->fontset)); @@ -891,20 +904,20 @@ face_for_char (f, face, c, pos, object) else { charset = Fget_char_property (make_number (pos), Qcharset, object); - if (NILP (charset)) - id = -1; - else if (CHARSETP (charset)) + if (CHARSETP (charset)) { Lisp_Object val; - val = assoc_no_quit (charset, Vfont_encoding_charset_alist); + val = assq_no_quit (charset, Vfont_encoding_charset_alist); if (CONSP (val) && CHARSETP (XCDR (val))) charset = XCDR (val); id = XINT (CHARSET_SYMBOL_ID (charset)); } + else + id = -1; } - font_add_log ("finding a font for", Fcons (make_number (c), charset), Qnil); + font_deferred_log ("font for", Fcons (make_number (c), charset), Qnil); rfont_def = fontset_font (fontset, c, face, id); if (VECTORP (rfont_def)) { @@ -934,6 +947,56 @@ face_for_char (f, face, c, pos, object) } +Lisp_Object +font_for_char (face, c, pos, object) + struct face *face; + int c, pos; + Lisp_Object object; +{ + Lisp_Object fontset, rfont_def, charset; + int face_id; + int id; + + if (ASCII_CHAR_P (c)) + { + Lisp_Object font_object; + + XSETFONT (font_object, face->ascii_face->font); + return font_object; + } + + xassert (fontset_id_valid_p (face->fontset)); + fontset = FONTSET_FROM_ID (face->fontset); + xassert (!BASE_FONTSET_P (fontset)); + if (pos < 0) + { + id = -1; + charset = Qnil; + } + else + { + charset = Fget_char_property (make_number (pos), Qcharset, object); + if (CHARSETP (charset)) + { + Lisp_Object val; + + val = assq_no_quit (charset, Vfont_encoding_charset_alist); + if (CONSP (val) && CHARSETP (XCDR (val))) + charset = XCDR (val); + id = XINT (CHARSET_SYMBOL_ID (charset)); + } + else + id = -1; + } + + font_deferred_log ("font for", Fcons (make_number (c), charset), Qnil); + rfont_def = fontset_font (fontset, c, face, id); + return (VECTORP (rfont_def) + ? RFONT_DEF_OBJECT (rfont_def) + : Qnil); +} + + /* Make a realized fontset for ASCII face FACE on frame F from the base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the default fontset as the base. Value is the id of the new fontset. @@ -1000,7 +1063,7 @@ fontset_pattern_regexp (pattern) nstars++; else if (*p0 == '[' || *p0 == '.' || *p0 == '\\' - || *p0 == '+' || *p0 == '^' + || *p0 == '+' || *p0 == '^' || *p0 == '$') nescs++; } @@ -1028,7 +1091,7 @@ fontset_pattern_regexp (pattern) *p1++ = '.'; else if (*p0 == '[' || *p0 == '.' || *p0 == '\\' - || *p0 == '+' || *p0 == '^' + || *p0 == '+' || *p0 == '^' || *p0 == '$') *p1++ = '\\', *p1++ = *p0; else @@ -1217,25 +1280,39 @@ free_realized_fontsets (base) /* Check validity of NAME as a fontset name and return the corresponding fontset. If not valid, signal an error. - If NAME is t, return Vdefault_fontset. */ + + If NAME is t, return Vdefault_fontset. If NAME is nil, return the + fontset of *FRAME. + + Set *FRAME to the actual frame. */ static Lisp_Object -check_fontset_name (name) - Lisp_Object name; +check_fontset_name (name, frame) + Lisp_Object name, *frame; { int id; + if (NILP (*frame)) + *frame = selected_frame; + CHECK_LIVE_FRAME (*frame); + if (EQ (name, Qt)) return Vdefault_fontset; - - CHECK_STRING (name); - /* First try NAME as literal. */ - id = fs_query_fontset (name, 2); - if (id < 0) - /* For backward compatibility, try again NAME as pattern. */ - id = fs_query_fontset (name, 0); - if (id < 0) - error ("Fontset `%s' does not exist", SDATA (name)); + if (NILP (name)) + { + id = FRAME_FONTSET (XFRAME (*frame)); + } + else + { + CHECK_STRING (name); + /* First try NAME as literal. */ + id = fs_query_fontset (name, 2); + if (id < 0) + /* For backward compatibility, try again NAME as pattern. */ + id = fs_query_fontset (name, 0); + if (id < 0) + error ("Fontset `%s' does not exist", SDATA (name)); + } return FONTSET_FROM_ID (id); } @@ -1275,54 +1352,70 @@ generate_ascii_font_name (name, ascii_spec) return make_unibyte_string (xlfd, i); } -/* Variables referred in set_fontset_font. They are set before - map_charset_chars is called in Fset_fontset_font. */ -static Lisp_Object font_def_arg, add_arg; -static int from_arg, to_arg; +/* Callback function for map_charset_chars in Fset_fontset_font. + ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ]. + + In FONTSET, set FONT_DEF in a fashion specified by ADD for + characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE. + The consumed ranges are poped up from SCRIPT_RANGE_LIST, and the + new SCRIPT_RANGE_LIST is stored in ARG. -/* Callback function for map_charset_chars in Fset_fontset_font. In - FONTSET, set font_def_arg in a fashion specified by add_arg for - characters in RANGE while ignoring the range between from_arg and - to_arg. */ + If ASCII is nil, don't set FONT_DEF for ASCII characters. It is + assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that + case. */ static void -set_fontset_font (fontset, range) - Lisp_Object fontset, range; +set_fontset_font (arg, range) + Lisp_Object arg, range; { - if (from_arg < to_arg) - { - int from = XINT (XCAR (range)), to = XINT (XCDR (range)); + Lisp_Object fontset, font_def, add, ascii, script_range_list; + int from = XINT (XCAR (range)), to = XINT (XCDR (range)); - if (from < from_arg) - { - if (to > to_arg) - { - Lisp_Object range2; + fontset = AREF (arg, 0); + font_def = AREF (arg, 1); + add = AREF (arg, 2); + ascii = AREF (arg, 3); + script_range_list = AREF (arg, 4); - range2 = Fcons (make_number (to_arg), XCDR (range)); - FONTSET_ADD (fontset, range, font_def_arg, add_arg); - to = to_arg; - } - if (to > from_arg) - range = Fcons (XCAR (range), make_number (from_arg)); - } - else if (to <= to_arg) + if (NILP (ascii) && from < 0x80) + { + if (to < 0x80) return; - else - { - if (from < to_arg) - range = Fcons (make_number (to_arg), XCDR (range)); - } + from = 0x80; + range = Fcons (make_number (0x80), XCDR (range)); + } + +#define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list))) +#define SCRIPT_TO XINT (XCDR (XCAR (script_range_list))) +#define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list) + + for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ()) + FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add); + if (CONSP (script_range_list)) + { + if (SCRIPT_FROM < from) + range = Fcons (make_number (SCRIPT_FROM), XCDR (range)); + while (CONSP (script_range_list) && SCRIPT_TO <= to) + POP_SCRIPT_RANGE (); + if (CONSP (script_range_list) && SCRIPT_FROM <= to) + XSETCAR (XCAR (script_range_list), make_number (to + 1)); } - FONTSET_ADD (fontset, range, font_def_arg, add_arg); + + FONTSET_ADD (fontset, range, font_def, add); + ASET (arg, 4, script_range_list); } extern Lisp_Object QCfamily, QCregistry; +static void update_auto_fontset_alist P_ ((Lisp_Object, Lisp_Object)); + DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0, doc: /* Modify fontset NAME to use FONT-SPEC for TARGET characters. +NAME is a fontset name string, nil for the fontset of FRAME, or t for +the default fontset. + TARGET may be a cons; (FROM . TO), where FROM and TO are characters. In that case, use FONT-SPEC for all characters in the range FROM and TO (inclusive). @@ -1344,8 +1437,8 @@ FONT-SPEC may one of these: * A font name string. * nil, which explicitly specifies that there's no font for TARGET. -Optional 4th argument FRAME, if non-nil, is a frame. This argument is -kept for backward compatibility and has no meaning. +Optional 4th argument FRAME is a frame or nil for the selected frame +that is concerned in the case that NAME is nil. Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC to the font specifications for TARGET previously set. If it is @@ -1358,31 +1451,33 @@ appended. By default, FONT-SPEC overrides the previous settings. */) Lisp_Object font_def, registry, family; Lisp_Object range_list; struct charset *charset = NULL; + Lisp_Object fontname; + int ascii_changed = 0; - fontset = check_fontset_name (name); - - /* The arg FRAME is kept for backward compatibility. We only check - the validity. */ - if (!NILP (frame)) - CHECK_LIVE_FRAME (frame); + fontset = check_fontset_name (name, &frame); + fontname = Qnil; if (CONSP (font_spec)) { Lisp_Object spec = Ffont_spec (0, NULL); font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec); font_spec = spec; + fontname = Ffont_xlfd_name (font_spec, Qnil); } else if (STRINGP (font_spec)) { Lisp_Object args[2]; extern Lisp_Object QCname; + fontname = font_spec; args[0] = QCname; args[1] = font_spec; font_spec = Ffont_spec (2, args); } - else if (! NILP (font_spec) && ! FONT_SPEC_P (font_spec)) + else if (FONT_SPEC_P (font_spec)) + fontname = Ffont_xlfd_name (font_spec, Qnil); + else if (! NILP (font_spec)) Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec)); if (! NILP (font_spec)) @@ -1423,7 +1518,11 @@ appended. By default, FONT-SPEC overrides the previous settings. */) font_def = Qnil; if (CHARACTERP (target)) - range_list = Fcons (Fcons (target, target), Qnil); + { + if (XFASTINT (target) < 0x80) + error ("Can't set a font for partial ASCII range."); + range_list = Fcons (Fcons (target, target), Qnil); + } else if (CONSP (target)) { Lisp_Object from, to; @@ -1432,6 +1531,12 @@ appended. By default, FONT-SPEC overrides the previous settings. */) to = Fcdr (target); CHECK_CHARACTER (from); CHECK_CHARACTER (to); + if (XFASTINT (from) < 0x80) + { + if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F) + error ("Can't set a font for partial ASCII range."); + ascii_changed = 1; + } range_list = Fcons (target, Qnil); } else if (SYMBOLP (target) && !NILP (target)) @@ -1443,35 +1548,18 @@ appended. By default, FONT-SPEC overrides the previous settings. */) script_list = XCHAR_TABLE (Vchar_script_table)->extras[0]; if (! NILP (Fmemq (target, script_list))) { + if (EQ (target, Qlatin)) + ascii_changed = 1; val = Fcons (target, Qnil); map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table, val); - range_list = XCDR (val); - if (EQ (target, Qlatin) && NILP (FONTSET_ASCII (fontset))) - { - if (VECTORP (font_spec)) - val = generate_ascii_font_name (FONTSET_NAME (fontset), - font_spec); - else - val = font_spec; - FONTSET_ASCII (fontset) = val; - } + range_list = Fnreverse (XCDR (val)); } if (CHARSETP (target)) { - if (EQ (target, Qascii) && NILP (FONTSET_ASCII (fontset))) - { - if (VECTORP (font_spec)) - font_spec = generate_ascii_font_name (FONTSET_NAME (fontset), - font_spec); - FONTSET_ASCII (fontset) = font_spec; - range_list = Fcons (Fcons (make_number (0), make_number (127)), - Qnil); - } - else - { - CHECK_CHARSET_GET_CHARSET (target, charset); - } + CHECK_CHARSET_GET_CHARSET (target, charset); + if (charset->ascii_compatible_p) + ascii_changed = 1; } else if (NILP (range_list)) error ("Invalid script or charset name: %s", @@ -1482,24 +1570,68 @@ appended. By default, FONT-SPEC overrides the previous settings. */) else error ("Invalid target for setting a font"); + if (ascii_changed) + { + Lisp_Object val; + + if (NILP (font_spec)) + error ("Can't set ASCII font to nil"); + val = CHAR_TABLE_REF (fontset, 0); + if (! NILP (val) && EQ (add, Qappend)) + /* We are going to change just an additional font for ASCII. */ + ascii_changed = 0; + } if (charset) { - font_def_arg = font_def; - add_arg = add; - if (NILP (range_list)) - from_arg = to_arg = 0; - else - from_arg = XINT (XCAR (XCAR (range_list))), - to_arg = XINT (XCDR (XCAR (range_list))); + Lisp_Object arg; + + arg = Fmake_vector (make_number (5), Qnil); + ASET (arg, 0, fontset); + ASET (arg, 1, font_def); + ASET (arg, 2, add); + ASET (arg, 3, ascii_changed ? Qt : Qnil); + ASET (arg, 4, range_list); - map_charset_chars (set_fontset_font, Qnil, fontset, charset, + map_charset_chars (set_fontset_font, Qnil, arg, charset, CHARSET_MIN_CODE (charset), CHARSET_MAX_CODE (charset)); + range_list = AREF (arg, 4); } for (; CONSP (range_list); range_list = XCDR (range_list)) FONTSET_ADD (fontset, XCAR (range_list), font_def, add); + if (ascii_changed) + { + Lisp_Object tail, frame, alist; + int fontset_id = XINT (FONTSET_ID (fontset)); + + FONTSET_ASCII (fontset) = fontname; + name = FONTSET_NAME (fontset); + FOR_EACH_FRAME (tail, frame) + { + FRAME_PTR f = XFRAME (frame); + Lisp_Object font_object; + struct face *face; + + if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f)) + continue; + if (fontset_id != FRAME_FONTSET (f)) + continue; + face = FACE_FROM_ID (f, DEFAULT_FACE_ID); + if (face) + font_object = font_load_for_lface (f, face->lface, font_spec); + else + font_object = font_open_by_spec (f, font_spec); + if (! NILP (font_object)) + { + update_auto_fontset_alist (font_object, fontset); + alist = Fcons (Fcons (Qfont, Fcons (name, font_object)), Qnil); + Fmodify_frame_parameters (frame, alist); + } + } + } + /* Free all realized fontsets whose base is FONTSET. This way, the specified character(s) are surely redisplayed by a correct font. */ @@ -1557,7 +1689,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of } else { - fontset = FONTSET_FROM_ID (id);; + fontset = FONTSET_FROM_ID (id); free_realized_fontsets (fontset); Fset_char_table_range (fontset, Qt, Qnil); } @@ -1583,12 +1715,25 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of (FONT-SPEC . FONTSET-ID). */ static Lisp_Object auto_fontset_alist; +/* Number of automatically created fontsets. */ +static int num_auto_fontsets; + +/* Retun a fontset synthesized from FONT-OBJECT. This is called from + x_new_font when FONT-OBJECT is used for the default ASCII font of a + frame, and the returned fontset is used for the default fontset of + that frame. The fontset specifies a font of the same registry as + FONT-OBJECT for all characters in the repertory of the registry + (see Vfont_encoding_alist). If the repertory is not known, the + fontset specifies the font for all Latin characters assuming that a + user intends to use FONT-OBJECT for Latin characters. */ + int fontset_from_font (font_object) Lisp_Object font_object; { Lisp_Object font_name = font_get_name (font_object); Lisp_Object font_spec = Fcopy_font_spec (font_object); + Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX); Lisp_Object fontset_spec, alias, name, fontset; Lisp_Object val; int i; @@ -1596,14 +1741,13 @@ fontset_from_font (font_object) val = assoc_no_quit (font_spec, auto_fontset_alist); if (CONSP (val)) return XINT (FONTSET_ID (XCDR (val))); - if (NILP (auto_fontset_alist)) + if (num_auto_fontsets++ == 0) alias = intern ("fontset-startup"); else { char temp[32]; - int len = XINT (Flength (auto_fontset_alist)); - sprintf (temp, "fontset-auto%d", len); + sprintf (temp, "fontset-auto%d", num_auto_fontsets - 1); alias = intern (temp); } fontset_spec = Fcopy_font_spec (font_spec); @@ -1617,21 +1761,49 @@ fontset_from_font (font_object) alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX)); Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist); auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist); - FONTSET_ASCII (fontset) = font_name; - font_spec = Fcopy_font_spec (font_spec); - ASET (font_spec, FONT_REGISTRY_INDEX, Qiso10646_1); - for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++) - ASET (font_spec, i, Qnil); - Fset_fontset_font (name, Qlatin, font_spec, Qnil, Qnil); - Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil); + font_spec = Ffont_spec (0, NULL); + ASET (font_spec, FONT_REGISTRY_INDEX, registry); + { + Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry)); + + if (CONSP (target)) + target = XCDR (target); + if (! CHARSETP (target)) + target = Qlatin; + Fset_fontset_font (name, target, font_spec, Qnil, Qnil); + Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil); + } -#ifdef HAVE_NS - nsfont_make_fontset_for_font(name, font_object); -#endif + FONTSET_ASCII (fontset) = font_name; return XINT (FONTSET_ID (fontset)); } + +/* Update auto_fontset_alist for FONTSET. When an ASCII font of + FONTSET is changed, we delete an entry of FONTSET if any from + auto_fontset_alist so that FONTSET is not re-used by + fontset_from_font. */ + +static void +update_auto_fontset_alist (font_object, fontset) + Lisp_Object font_object, fontset; +{ + Lisp_Object prev, tail; + + for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail); + prev = tail, tail = XCDR (tail)) + if (EQ (fontset, XCDR (XCAR (tail)))) + { + if (NILP (prev)) + auto_fontset_alist = XCDR (tail); + else + XSETCDR (prev, XCDR (tail)); + break; + } +} + + /* Return a cons (FONT-OBJECT . GLYPH-CODE). FONT-OBJECT is the font for the character at POSITION in the current buffer. This is computed from all the text properties and overlays @@ -1702,7 +1874,8 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, return Qnil; w = XWINDOW (window); f = XFRAME (w->frame); - face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0); + face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, + pos + 100, 0, -1); charset = Fget_char_property (position, Qcharset, Qnil); if (CHARSETP (charset)) cs_id = XINT (CHARSET_SYMBOL_ID (charset)); @@ -1735,21 +1908,22 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0, doc: /* Return information about a fontset FONTSET on frame FRAME. -The value is a char-table whose elements have this form: - ((FONT-PATTERN OPENED-FONT ...) ...) +FONTSET is a fontset name string, nil for the fontset of FRAME, or t +for the default fontset. FRAME nil means the selected frame. -FONT-PATTERN is a vector: +The value is a char-table whose elements have this form: - [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ] + ((FONT OPENED-FONT ...) ...) -or a string of font name pattern. +FONT is a name of font specified for a range of characters. 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 above. */) +The char-table has one extra slot. If FONTSET is not the default +fontset, the value the extra slot is a char-table containing the +information about the derived fonts from the default fontset. The +format is the same as above. */) (fontset, frame) Lisp_Object fontset, frame; { @@ -1760,11 +1934,7 @@ fontset. The format is the same as above. */) (*check_window_system_func) (); - fontset = check_fontset_name (fontset); - - if (NILP (frame)) - frame = selected_frame; - CHECK_LIVE_FRAME (frame); + fontset = check_fontset_name (fontset, &frame); f = XFRAME (frame); /* Recode fontsets realized on FRAME from the base fontset FONTSET @@ -1792,10 +1962,13 @@ fontset. The format is the same as above. */) realized[1][j] = Qnil; tables[0] = Fmake_char_table (Qfontset_info, Qnil); - tables[1] = Fmake_char_table (Qnil, Qnil); - XCHAR_TABLE (tables[0])->extras[0] = tables[1]; fontsets[0] = fontset; - fontsets[1] = Vdefault_fontset; + if (!EQ (fontset, Vdefault_fontset)) + { + tables[1] = Fmake_char_table (Qnil, Qnil); + XCHAR_TABLE (tables[0])->extras[0] = tables[1]; + fontsets[1] = Vdefault_fontset; + } /* Accumulate information of the fontset in TABLE. The format of each element is ((FONT-SPEC OPENED-FONT ...) ...). */ @@ -1803,13 +1976,11 @@ fontset. The format is the same as above. */) { for (c = 0; c <= MAX_CHAR; ) { - int from, to; + int from = c, to = MAX_5_BYTE_CHAR; if (c <= MAX_5_BYTE_CHAR) { val = char_table_ref_and_range (fontsets[k], c, &from, &to); - if (to > MAX_5_BYTE_CHAR) - to = MAX_5_BYTE_CHAR; } else { @@ -1834,10 +2005,11 @@ fontset. The format is the same as above. */) val = FONTSET_REF (realized[k][i], c); else val = FONTSET_FALLBACK (realized[k][i]); - if (! VECTORP (val)) + if (! CONSP (val) || ! VECTORP (XCDR (val))) continue; - /* VAL: [int ? [FACE-ID FONT-DEF FONT-OBJECT int] ... ] */ - for (j = 2; j < ASIZE (val); j++) + /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ]) */ + val = XCDR (val); + for (j = 0; j < ASIZE (val); j++) { elt = AREF (val, j); if (FONT_OBJECT_P (RFONT_DEF_OBJECT (elt))) @@ -1868,6 +2040,8 @@ fontset. The format is the same as above. */) } c = to + 1; } + if (EQ (fontset, Vdefault_fontset)) + break; } return tables[0]; @@ -1891,8 +2065,10 @@ patterns. */) int c; Lisp_Object fontset, elt, list, repertory, val; int i, j; + Lisp_Object frame; - fontset = check_fontset_name (name); + frame = Qnil; + fontset = check_fontset_name (name, &frame); CHECK_CHARACTER (ch); c = XINT (ch); @@ -1904,6 +2080,8 @@ patterns. */) if (VECTORP (elt)) for (j = 0; j < ASIZE (elt); j++) { + Lisp_Object family, registry; + val = AREF (elt, j); repertory = AREF (val, 1); if (INTEGERP (repertory)) @@ -1919,7 +2097,14 @@ patterns. */) continue; } val = AREF (val, 0); - val = Fcons (AREF (val, 0), AREF (val, 5)); + /* VAL is a FONT-SPEC */ + family = AREF (val, FONT_FAMILY_INDEX); + if (! NILP (family)) + family = SYMBOL_NAME (family); + registry = AREF (val, FONT_REGISTRY_INDEX); + if (! NILP (registry)) + registry = SYMBOL_NAME (registry); + val = Fcons (family, registry); if (NILP (all)) return val; list = Fcons (val, list);