/* 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
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 ... ]
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.
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;
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));
XSETCAR (font_group, make_number (charset_ordered_list_tick));
}
+/* Return a font-group (actually a cons (-1 . FONT-GROUP-VECTOR)) for
+ character C in FONTSET. If C is -1, return a fallback font-group.
+ If C is not -1, the value may be Qt (FONTSET doesn't have a font
+ for C even in the fallback group, or 0 (a font for C may be found
+ only in the fallback group). */
+
static Lisp_Object
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)
else
font_group = FONTSET_FALLBACK (base_fontset);
if (NILP (font_group))
- return Qnil;
+ {
+ font_group = make_number (0);
+ if (c >= 0)
+ char_table_set_range (fontset, from, to, font_group);
+ return font_group;
+ }
font_group = Fcopy_sequence (font_group);
for (i = 0; i < ASIZE (font_group); i++)
if (! NILP (AREF (font_group, i)))
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 = 0, found_index;
+ FRAME_PTR f = (FRAMEP (FONTSET_FRAME (fontset)))
+ ? XFRAME (selected_frame) : XFRAME (FONTSET_FRAME (fontset));
+ Lisp_Object rfont_def;
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;
first. */
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;
+
+ rfont_def = AREF (vec, i);
+ if (NILP (rfont_def))
+ break;
+ repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
if (XINT (repertory) == id)
{
/* Find the first available font in the vector of RFONT-DEF. */
for (i = 0; i < ASIZE (vec); i++)
{
+ Lisp_Object font_def;
Lisp_Object font_entity, font_object;
- if (i == 0 && charset_matched >= 0)
+ found_index = i;
+ if (i == 0)
{
- /* Try the element matching with the charset ID at first. */
- elt = AREF (vec, charset_matched);
- charset_matched = -1;
- i--;
+ if (charset_matched > 0)
+ {
+ /* Try the element matching with the charset ID at first. */
+ found_index = charset_matched;
+ /* Make this negative so that we don't come here in the
+ next loop. */
+ charset_matched = - charset_matched;
+ /* We must try the first element in the next loop. */
+ i--;
+ }
+ }
+ else if (i == - charset_matched)
+ {
+ /* We have already tried this element and the followings
+ that have the same font specifications in the first
+ iteration. So, skip them all. */
+ rfont_def = AREF (vec, i);
+ font_def = RFONT_DEF_FONT_DEF (rfont_def);
+ for (; i + 1 < ASIZE (vec); i++)
+ {
+ rfont_def = AREF (vec, i + 1);
+ if (NILP (rfont_def))
+ break;
+ if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
+ break;
+ }
+ continue;
}
- else if (i != charset_matched)
- elt = AREF (vec, i);
- else
- continue;
- if (NILP (elt))
- /* This is a sign of not to try the other fonts. */
- return Qt;
- if (INTEGERP (RFONT_DEF_FACE (elt))
- && XINT (AREF (elt, 1)) < 0)
+ rfont_def = AREF (vec, found_index);
+ if (NILP (rfont_def))
+ {
+ if (i < 0)
+ continue;
+ /* This is a sign of not to try the other fonts. */
+ return Qt;
+ }
+ 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;
+ goto found;
-#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. */
-
- /* Try to find the different font maching with the current spec
- and support C. */
- font_def = RFONT_DEF_FONT_DEF (elt);
- for (i++; i < ASIZE (vec); i++)
+ /* Find a font already opened, maching with the current spec,
+ and supporting C. */
+ font_def = RFONT_DEF_FONT_DEF (rfont_def);
+ for (; found_index + 1 < ASIZE (vec); found_index++)
{
- if (! EQ (RFONT_DEF_FONT_DEF (AREF (vec, i)), font_def))
+ rfont_def = AREF (vec, found_index + 1);
+ if (NILP (rfont_def))
+ break;
+ 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 (rfont_def);
+ if (! NILP (font_object) && font_has_char (f, font_object, c))
+ {
+ found_index++;
+ goto found;
+ }
}
- /* 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++)
+ found_index++;
+ for (j = 0; j < found_index; 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));
+ XSETCDR (font_group, new_vec);
vec = new_vec;
- return rfont_def;
+ goto found;
}
- i--;
-#endif /* 0 */
+ if (i >= 0)
+ i = found_index;
}
FONTSET_SET (fontset, make_number (c), make_number (0));
return Qnil;
+
+ found:
+ if (fallback && found_index > 0)
+ {
+ /* The order of fonts in the fallback font-group is not that
+ important, and it is better to move the found font to the
+ first of the group so that the next try will find it
+ quickly. */
+ for (i = found_index; i > 0; i--)
+ ASET (vec, i, AREF (vec, i - 1));
+ ASET (vec, 0, rfont_def);
+ }
+ return rfont_def;
}
struct face *face;
int id;
{
- Lisp_Object rfont_def;
+ Lisp_Object rfont_def, default_rfont_def;
Lisp_Object base_fontset;
/* Try a font-group of FONTSET. */
+ FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil);
rfont_def = fontset_find_font (fontset, c, face, id, 0);
if (VECTORP (rfont_def))
return rfont_def;
- if (EQ (rfont_def, Qt))
- return Qnil;
+ if (NILP (rfont_def))
+ FONTSET_SET (fontset, make_number (c), make_number (0));
/* Try a font-group of the default fontset. */
base_fontset = FONTSET_BASE (fontset);
if (NILP (FONTSET_DEFAULT (fontset)))
FONTSET_DEFAULT (fontset)
= make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
- rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
- if (VECTORP (rfont_def))
- return rfont_def;
- if (EQ (rfont_def, Qt))
- return Qnil;
+ FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
+ default_rfont_def
+ = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
+ if (VECTORP (default_rfont_def))
+ return default_rfont_def;
+ if (NILP (default_rfont_def))
+ FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c),
+ make_number (0));
}
/* Try a fallback font-group of FONTSET. */
- rfont_def = fontset_find_font (fontset, c, face, id, 1);
- if (VECTORP (rfont_def))
- return rfont_def;
- if (EQ (rfont_def, Qt))
- return Qnil;
+ if (! EQ (rfont_def, Qt))
+ {
+ FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil);
+ rfont_def = fontset_find_font (fontset, c, face, id, 1);
+ if (VECTORP (rfont_def))
+ return rfont_def;
+ /* Remember that FONTSET has no font for C. */
+ FONTSET_SET (fontset, make_number (c), Qt);
+ }
- /* Try a fallback font-group of the default fontset . */
- if (! EQ (base_fontset, Vdefault_fontset))
+ /* Try a fallback font-group of the default fontset. */
+ if (! EQ (base_fontset, Vdefault_fontset)
+ && ! EQ (default_rfont_def, Qt))
{
+ FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil);
rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
if (VECTORP (rfont_def))
return rfont_def;
+ /* Remember that the default fontset has no font for C. */
+ FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
}
- /* Remeber that we have no font for C. */
- FONTSET_SET (fontset, make_number (c), Qt);
-
return Qnil;
}
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;
- }
-}
-
\f
/********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
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));
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_deferred_log ("font for", Fcons (make_number (c), charset), Qnil);
rfont_def = fontset_font (fontset, c, face, id);
if (VECTORP (rfont_def))
{
Lisp_Object object;
{
Lisp_Object fontset, rfont_def, charset;
- int face_id;
int id;
if (ASCII_CHAR_P (c))
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_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)
nstars++;
else if (*p0 == '['
|| *p0 == '.' || *p0 == '\\'
- || *p0 == '+' || *p0 == '^'
+ || *p0 == '+' || *p0 == '^'
|| *p0 == '$')
nescs++;
}
*p1++ = '.';
else if (*p0 == '['
|| *p0 == '.' || *p0 == '\\'
- || *p0 == '+' || *p0 == '^'
+ || *p0 == '+' || *p0 == '^'
|| *p0 == '$')
*p1++ = '\\', *p1++ = *p0;
else
/* 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);
}
}
-/* Return an ASCII font name generated from fontset name NAME and
- font-spec ASCII_SPEC. NAME is a string conforming to XLFD. */
+/* Callback function for map_charset_chars in Fset_fontset_font.
+ ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
-static INLINE Lisp_Object
-generate_ascii_font_name (name, ascii_spec)
- Lisp_Object name, ascii_spec;
-{
- Lisp_Object font_spec = Ffont_spec (0, NULL);
- int i;
- char xlfd[256];
-
- if (font_parse_xlfd ((char *) SDATA (name), font_spec) < 0)
- error ("Not an XLFD font name: %s", SDATA (name));
- for (i = FONT_FOUNDRY_INDEX; i < FONT_EXTRA_INDEX; i++)
- if (! NILP (AREF (ascii_spec, i)))
- ASET (font_spec, i, AREF (ascii_spec, i));
- i = font_unparse_xlfd (font_spec, 0, xlfd, 256);
- if (i < 0)
- error ("Not an XLFD font name: %s", SDATA (name));
- return make_unibyte_string (xlfd, i);
-}
+ 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.
-/* 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. 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).
* 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
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))
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;
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))
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",
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;
- map_charset_chars (set_fontset_font, Qnil, fontset, charset,
+ 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, 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. */
}
else
{
- fontset = FONTSET_FROM_ID (id);;
+ fontset = FONTSET_FROM_ID (id);
free_realized_fontsets (fontset);
Fset_char_table_range (fontset, Qt, Qnil);
}
(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;
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);
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
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));
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;
{
(*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
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 ...) ...). */
{
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
{
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)))
}
c = to + 1;
}
+ if (EQ (fontset, Vdefault_fontset))
+ break;
}
return tables[0];
DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
doc: /* Return a font name pattern for character CH in fontset NAME.
If NAME is t, find a pattern in the default fontset.
+If NAME is nil, find a pattern in the fontset of the selected frame.
The value has the form (FAMILY . REGISTRY), where FAMILY is a font
family name and REGISTRY is a font registry name. This is actually
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);
if (VECTORP (elt))
for (j = 0; j < ASIZE (elt); j++)
{
+ Lisp_Object family, registry;
+
val = AREF (elt, j);
+ if (NILP (val))
+ break;
repertory = AREF (val, 1);
if (INTEGERP (repertory))
{
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);
HCoop / bpt / emacs.git / blobdiff