/* 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
/* #define FONTSET_DEBUG */
#include <config.h>
-
-#ifdef FONTSET_DEBUG
#include <stdio.h>
-#endif
#include "lisp.h"
#include "blockinput.h"
#ifdef WINDOWSNT
#include "w32term.h"
#endif
-#ifdef MAC_OS
-#include "macterm.h"
+#ifdef HAVE_NS
+#include "nsterm.h"
#endif
#include "termhooks.h"
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;
Lisp_Object));
static Lisp_Object fontset_find_font P_ ((Lisp_Object, int, struct face *,
int, int));
-static void reorder_font_vector P_ ((Lisp_Object, Lisp_Object));
+static void reorder_font_vector P_ ((Lisp_Object, struct font *));
static Lisp_Object fontset_font P_ ((Lisp_Object, int, struct face *, int));
static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
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));
fontset_compare_rfontdef (val1, val2)
const void *val1, *val2;
{
- return (RFONT_DEF_SCORE (*(Lisp_Object *) val2)
- - RFONT_DEF_SCORE (*(Lisp_Object *) val1));
+ return (RFONT_DEF_SCORE (*(Lisp_Object *) val1)
+ - RFONT_DEF_SCORE (*(Lisp_Object *) val2));
}
/* Update FONT-GROUP which has this form:
extern Lisp_Object Fassoc_string ();
static void
-reorder_font_vector (font_group, preferred_family)
+reorder_font_vector (font_group, font)
Lisp_Object font_group;
- Lisp_Object preferred_family;
+ struct font *font;
{
+ Lisp_Object vec, font_object;
int size;
int i;
int score_changed = 0;
- size = ASIZE (font_group);
- /* Exclude the tailing nil elements from the reordering. */
- while (NILP (AREF (font_group, size - 1))) size--;
- size -= 2;
+ if (font)
+ XSETFONT (font_object, font);
+ else
+ font_object = Qnil;
+
+ vec = XCDR (font_group);
+ size = ASIZE (vec);
+ /* Exclude the tailing nil element from the reordering. */
+ if (NILP (AREF (vec, size - 1)))
+ size--;
for (i = 0; i < size; i++)
{
- Lisp_Object rfont_def = AREF (font_group, i + 2);
+ Lisp_Object rfont_def = AREF (vec, i);
Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def);
Lisp_Object font_spec = FONT_DEF_SPEC (font_def);
- Lisp_Object lang = Ffont_get (font_spec, QClang);
- Lisp_Object family = AREF (font_spec, FONT_FAMILY_INDEX);
- Lisp_Object repertory = FONT_DEF_REPERTORY (font_def);
- int score = 0;
+ int score = RFONT_DEF_SCORE (rfont_def) & 0xFF;
- if (! NILP (repertory))
+ if (! font_match_p (font_spec, font_object))
{
- Lisp_Object tail;
+ Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
- for (score = 0xFFFF, tail = Vcharset_ordered_list;
- ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
- score--, tail = XCDR (tail))
- if (EQ (repertory, XCAR (tail)))
- break;
- if (EQ (tail, Vcharset_non_preferred_head))
- score = 0;
- }
- else if (! NILP (lang))
- {
- if (EQ (lang, Vcurrent_iso639_language))
- score = 0xFFFF;
- else if (CONSP (Vcurrent_iso639_language))
- score = ! NILP (Fmemq (lang, Vcurrent_iso639_language));
- }
+ if (! NILP (encoding))
+ {
+ Lisp_Object tail;
- if (! NILP (preferred_family) && ! NILP (family))
- {
- if (fast_string_match_ignore_case (preferred_family,
- SYMBOL_NAME (family)) < 0)
- score |= 0x10000;
+ for (tail = Vcharset_ordered_list;
+ ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
+ score += 0x100, tail = XCDR (tail))
+ if (EQ (encoding, XCAR (tail)))
+ break;
+ }
+ else
+ {
+ Lisp_Object lang = Ffont_get (font_spec, QClang);
+
+ if (! NILP (lang)
+ && ! EQ (lang, Vcurrent_iso639_language)
+ && (! CONSP (Vcurrent_iso639_language)
+ || NILP (Fmemq (lang, Vcurrent_iso639_language))))
+ score |= 0x100;
+ }
}
if (RFONT_DEF_SCORE (rfont_def) != score)
{
}
if (score_changed)
- qsort (XVECTOR (font_group)->contents + 2, size, sizeof (Lisp_Object),
+ qsort (XVECTOR (vec)->contents, size, sizeof (Lisp_Object),
fontset_compare_rfontdef);
+ XSETCAR (font_group, make_number (charset_ordered_list_tick));
+}
+
+static Lisp_Object
+fontset_get_font_group (Lisp_Object fontset, int c)
+{
+ Lisp_Object font_group;
+ Lisp_Object base_fontset;
+ int from = 0, to = MAX_CHAR, i;
- ASET (font_group, 0, make_number (charset_ordered_list_tick));
+ xassert (! BASE_FONTSET_P (fontset));
+ if (c >= 0)
+ font_group = CHAR_TABLE_REF (fontset, c);
+ else
+ font_group = FONTSET_FALLBACK (fontset);
+ if (! NILP (font_group))
+ return font_group;
+ base_fontset = FONTSET_BASE (fontset);
+ if (c >= 0)
+ font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
+ else
+ font_group = FONTSET_FALLBACK (base_fontset);
+ if (NILP (font_group))
+ {
+ 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)))
+ {
+ Lisp_Object rfont_def;
+
+ RFONT_DEF_NEW (rfont_def, AREF (font_group, i));
+ /* Remember the original order. */
+ RFONT_DEF_SET_SCORE (rfont_def, i);
+ ASET (font_group, i, rfont_def);
+ }
+ font_group = Fcons (make_number (-1), font_group);
+ if (c >= 0)
+ char_table_set_range (fontset, from, to, font_group);
+ else
+ FONTSET_FALLBACK (fontset) = font_group;
+ return font_group;
}
/* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
struct face *face;
int id, fallback;
{
- Lisp_Object base_fontset, elt, vec;
- int i, from, to;
- FRAME_PTR f = XFRAME (FONTSET_FRAME (fontset));
-
- base_fontset = FONTSET_BASE (fontset);
- if (! fallback)
- vec = CHAR_TABLE_REF (fontset, c);
- else
- vec = FONTSET_FALLBACK (fontset);
+ 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 font_group;
+ vec = XCDR (font_group);
+ if (ASIZE (vec) == 0)
+ return Qnil;
- if (NILP (vec))
+ if (ASIZE (vec) > 1)
{
- Lisp_Object range;
-
- /* We have not yet decided a font for C. */
- if (! face)
- return Qnil;
- if (! fallback)
- {
- elt = char_table_ref_and_range (base_fontset, c, &from, &to);
- range = Fcons (make_number (from), make_number (to));
- }
- else
- {
- elt = FONTSET_FALLBACK (base_fontset);
- }
- if (NILP (elt))
- {
- /* This fontset doesn't specify any font for C. */
- vec = make_number (0);
- }
- else if (ASIZE (elt) == 1 && NILP (AREF (elt, 0)))
- {
- /* Explicitly specified no font. */
- vec = Qt;
- }
- else
- {
- /* Build a font-group vector [ -1 nil RFONT-DEF0 RFONT-DEF1 ... ],
- where the first -1 is to force reordering of RFONT-DEFs. */
- int size = ASIZE (elt);
- int j;
+ if (XINT (XCAR (font_group)) != charset_ordered_list_tick)
+ /* We have just created the font-group,
+ or the charset priorities were changed. */
+ reorder_font_vector (font_group, face->ascii_face->font);
+ if (id >= 0)
+ /* Find a spec matching with the charset ID to try at
+ first. */
+ for (i = 0; i < ASIZE (vec); i++)
+ {
+ Lisp_Object rfont_def = AREF (vec, i);
+ Lisp_Object repertory;
+
+ if (NILP (rfont_def))
+ break;
+ repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
- vec = Fmake_vector (make_number (size + 2), Qnil);
- ASET (vec, 0, make_number (-1));
- for (i = j = 0; i < size; i++)
- if (! NILP (AREF (elt, i)))
+ if (XINT (repertory) == id)
{
- Lisp_Object rfont_def;
-
- RFONT_DEF_NEW (rfont_def, AREF (elt, i));
- ASET (vec, j + 2, rfont_def);
- j++;
- }
- }
- /* Then store it in the fontset. */
- if (! fallback)
- FONTSET_SET (fontset, range, vec);
- else
- FONTSET_FALLBACK (fontset) = vec;
-
- }
- if (! VECTORP (vec))
- return (EQ (vec, Qt) ? Qt : Qnil);
-
- if (ASIZE (vec) > 4 /* multiple RFONT-DEFs */
- && XINT (AREF (vec, 0)) != charset_ordered_list_tick)
- /* We have just created VEC,
- or the charset priorities were changed. */
- reorder_font_vector (vec, face->lface[LFACE_FAMILY_INDEX]);
- i = 2;
- if (id >= 0)
- {
- elt = AREF (vec, 1);
- if (! NILP (elt)
- && EQ (make_number (id), RFONT_DEF_REPERTORY (elt)))
- i = 1;
- else
- {
- for (; i < ASIZE (vec); i++)
- {
- elt = AREF (vec, i);
- if (! NILP (elt)
- && EQ (make_number (id), RFONT_DEF_REPERTORY (elt)))
+ charset_matched = i;
break;
- }
- if (i < ASIZE (vec))
- {
- ASET (vec, 1, elt);
- i = 1;
- }
- else
- {
- ASET (vec, 1, Qnil);
- i = 2;
- }
- }
+ }
+ }
}
/* Find the first available font in the vector of RFONT-DEF. */
- for (; i < ASIZE (vec); i++)
+ for (i = 0; i < ASIZE (vec); i++)
{
+ Lisp_Object rfont_def, font_def;
Lisp_Object font_entity, font_object;
- elt = AREF (vec, i);
- if (NILP (elt))
- /* This is the sign of not to try fallback fonts. */
- return Qt;
- if (id >= 0 && i > 1 && EQ (AREF (vec, 1), elt))
- /* This is already checked. */
+ if (i == 0 && charset_matched >= 0)
+ {
+ /* Try the element matching with the charset ID at first. */
+ rfont_def = AREF (vec, charset_matched);
+ charset_matched = -1;
+ i--;
+ }
+ else if (i != charset_matched)
+ rfont_def = AREF (vec, i);
+ else
continue;
- if (INTEGERP (RFONT_DEF_FACE (elt))
- && XINT (AREF (elt, 1)) < 0)
+
+ if (NILP (rfont_def))
+ /* 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;
-
-#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));
Lisp_Object rfont_def;
Lisp_Object base_fontset;
- /* Try a font-group for C. */
+ /* Try a font-group of FONTSET. */
rfont_def = fontset_find_font (fontset, c, face, id, 0);
if (VECTORP (rfont_def))
return rfont_def;
if (EQ (rfont_def, Qt))
- return Qnil;
- /* Try a fallback font-group. */
- rfont_def = fontset_find_font (fontset, c, face, id, 1);
- 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);
- if (EQ (base_fontset, Vdefault_fontset))
- return Qnil;
+ if (! EQ (base_fontset, Vdefault_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))
+ goto no_font;
+ }
- /* Try a font-group for C of the default 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);
+ /* 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))
+ goto no_font;
+
/* Try a fallback font-group of the default fontset . */
- rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
- if (! VECTORP (rfont_def))
- /* Remeber that we have no font for C. */
- FONTSET_SET (fontset, make_number (c), Qt);
+ if (! EQ (base_fontset, Vdefault_fontset))
+ {
+ rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
+ if (VECTORP (rfont_def))
+ return rfont_def;
+ }
+
+ no_font:
+ /* Remember that we have no font for C. */
+ FONTSET_SET (fontset, make_number (c), Qt);
- return rfont_def;
+ return Qnil;
}
/* Return a newly created fontset with NAME. If BASE is nil, make a
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 c, pos;
Lisp_Object object;
{
- Lisp_Object fontset, rfont_def;
+ Lisp_Object fontset, rfont_def, charset;
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));
fontset = FONTSET_FROM_ID (face->fontset);
xassert (!BASE_FONTSET_P (fontset));
+
if (pos < 0)
- id = -1;
+ {
+ id = -1;
+ charset = Qnil;
+ }
else
{
- Lisp_Object charset;
-
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));
}
- }
- if (id < 0)
- {
- struct font *font = face->ascii_face->font;
-
- if (font && font->driver->encode_char (font, c) != FONT_INVALID_CODE)
- return face->ascii_face->id;
- font = face->font;
- if (font && font->driver->encode_char (font, c) != FONT_INVALID_CODE)
- return face->id;
+ 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
+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.
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 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 ].
-/* 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. */
+ 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.
+
+ 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;
+
+ 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. */
}
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);
+ 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);
+ }
+
FONTSET_ASCII (fontset) = font_name;
- font_spec = Fcopy_font_spec (font_spec);
- ASET (font_spec, FONT_FOUNDRY_INDEX, Qnil);
- ASET (font_spec, FONT_ADSTYLE_INDEX, Qnil);
- for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
- ASET (font_spec, i, Qnil);
- Fset_fontset_font (name, Qlatin, font_spec, Qnil, Qnil);
- font_spec = Fcopy_font_spec (font_spec);
- ASET (font_spec, FONT_REGISTRY_INDEX, Qiso10646_1);
- Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
+
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];
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);
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