/* Fontset handler.
+ Copyright (C) 2004 Free Software Foundation, Inc.
Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
- Licensed to the Free Software Foundation.
- Copyright (C) 2001, 2002
+ Licensed to the Free Software Foundation.
+ Copyright (C) 2003
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
#include "keyboard.h"
#include "frame.h"
#include "dispextern.h"
+#include "intervals.h"
#include "fontset.h"
#include "window.h"
+#ifdef HAVE_X_WINDOWS
+#include "xterm.h"
+#endif
+#ifdef WINDOWSNT
+#include "w32term.h"
+#endif
+#ifdef MAC_OS
+#include "macterm.h"
+#endif
-#ifdef FONTSET_DEBUG
#undef xassert
+#ifdef FONTSET_DEBUG
#define xassert(X) do {if (!(X)) abort ();} while (0)
#undef INLINE
#define INLINE
-#endif
+#else /* not FONTSET_DEBUG */
+#define xassert(X) (void) 0
+#endif /* not FONTSET_DEBUG */
EXFUN (Fclear_face_cache, 1);
characters. A face is also realized for non-ASCII characters based
on an ASCII face. All of non-ASCII faces based on the same ASCII
face share the same realized fontset.
-
+
A fontset object is implemented by a char-table whose default value
and parent are always nil.
where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
FONT-NAME are strings.
- ENCODING is a charset ID or a char-table that can convert
- characters to glyph codes of the corresponding font.
+ Note: Currently WEIGHT through ADSTYLE are ignored.
+
+ ENCODING is a charset ID that can convert characters to glyph codes
+ of the corresponding font.
- REPERTORY is a charset ID or nil. If REPERTORY is a charset ID,
- the repertory of the charset exactly matches with that of the font.
- If REPERTORY is nil, we consult with the font itself to get the
- repertory.
+ REPERTORY is a charset ID, a char-table, or nil. If REPERTORY is a
+ charset ID, the repertory of the charset exactly matches with that
+ of the font. If REPERTORY is a char-table, all characters who have
+ a non-nil value in the table are supported. If REPERTORY is nil,
+ we consult with the font itself to get the repertory.
ENCODING and REPERTORY are extracted from the variable
- Vfont_encoding_alist by using a font name generated form FONT-SPEC
- (if it is a vector) or FONT-NAME as a key.
+ Vfont_encoding_alist by using a font name generated from FONT-SPEC
+ (if it is a vector) or FONT-NAME as a matching target.
An element of a realized fontset is nil or t, or has this form:
- ( CHARSET-PRIORITY-LIST-TICK . FONT-VECTOR )
+ [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID
+ PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ...].
- FONT-VECTOR is a vector whose elements have this form:
+ RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
- [ FACE-ID FONT-INDEX FONT-DEF ]
+ [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ]
- FONT-VECTOR is automatically reordered by the current charset
+ RFONT-DEFn is automatically reordered by the current charset
priority list.
- The value nil means that we have not yet generated FONT-VECTOR from
- the base of the fontset.
+ The value nil means that we have not yet generated the above vector
+ from the base of the fontset.
The value t means that no font is available for the corresponding
range of characters.
- A fontset has 5 extra slots.
+ A fontset has 9 extra slots.
The 1st slot: the ID number of the fontset
realized: nil
The 3rd slot:
- base: nli
+ base: nil
realized: the base fontset
The 4th slot:
realized: Alist of font index vs the corresponding repertory
char-table.
+ The 8th slot:
+ base: nil
+ realized: If the base is not the default fontset, a fontset
+ realized from the default fontset, else nil.
+
+ The 9th slot:
+ base: Same as element value (but for fallback fonts).
+ realized: Likewise.
All fontsets are recorded in the vector Vfontset_table.
/********** VARIABLES and FUNCTION PROTOTYPES **********/
extern Lisp_Object Qfont;
-Lisp_Object Qfontset;
+static Lisp_Object Qfontset;
+static Lisp_Object Qfontset_info;
static Lisp_Object Qprepend, Qappend;
/* Vector containing all fontsets. */
/* Prototype declarations for static functions. */
static Lisp_Object fontset_add P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object));
+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));
static void accumulate_script_ranges P_ ((Lisp_Object, Lisp_Object,
Lisp_Object));
-static Lisp_Object find_font_encoding P_ ((char *));
+static Lisp_Object find_font_encoding P_ ((Lisp_Object));
+
+static void set_fontset_font P_ ((Lisp_Object, Lisp_Object));
#ifdef FONTSET_DEBUG
#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
-#define BASE_FONTSET_P(fontset) STRINGP (FONTSET_NAME (fontset))
-
/* Macros to access special values of (realized) FONTSET. */
#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
#define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
+#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
+
+/* For both base and realized fontset. */
+#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
+
+#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
/* Return the element of FONTSET for the character C. If FONTSET is a
/* Modify the elements of FONTSET for characters in RANGE by replacing
- with ELT or adding ETL. RANGE is a cons (FROM . TO), where FROM
+ with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
and TO are character codes specifying a range. If ADD is nil,
replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
append ELT. */
-#define FONTSET_ADD(fontset, range, elt, add) \
- (NILP (add) \
- ? Fset_char_table_range ((fontset), (range), \
- Fmake_vector (make_number (1), (elt))) \
+#define FONTSET_ADD(fontset, range, elt, add) \
+ (NILP (add) \
+ ? (NILP (range) \
+ ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
+ : Fset_char_table_range ((fontset), (range), \
+ Fmake_vector (make_number (1), (elt)))) \
: fontset_add ((fontset), (range), (elt), (add)))
static Lisp_Object
fontset_add (fontset, range, elt, add)
Lisp_Object fontset, range, elt, add;
{
- int from, to, from1, to1;
- Lisp_Object elt1;
-
- from = XINT (XCAR (range));
- to = XINT (XCDR (range));
- do {
- elt1 = char_table_ref_and_range (fontset, from, &from1, &to1);
- if (NILP (elt1))
- elt1 = Fmake_vector (make_number (1), elt);
- else
- {
- int i, i0 = 1, i1 = ASIZE (elt1) + 1;
- Lisp_Object new;
-
- new = Fmake_vector (make_number (i1), elt);
- if (EQ (add, Qappend))
- i0--, i1--;
- for (i = 0; i0 < i1; i++, i0++)
- ASET (new, i0, AREF (elt1, i));
- elt1 = new;
- }
- char_table_set_range (fontset, from, to1, elt1);
- from = to1 + 1;
- } while (from < to);
+ Lisp_Object args[2];
+ int idx = (EQ (add, Qappend) ? 0 : 1);
+
+ args[1 - idx] = Fmake_vector (make_number (1), elt);
+
+ if (CONSP (range))
+ {
+ int from = XINT (XCAR (range));
+ int to = XINT (XCDR (range));
+ int from1, to1;
+
+ do {
+ 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));
+ from = to1 + 1;
+ } while (from < to);
+ }
+ else
+ {
+ args[idx] = FONTSET_FALLBACK (fontset);
+ FONTSET_FALLBACK (fontset)
+ = NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args);
+ }
return Qnil;
}
/* Update FONTSET_ELEMENT which has this form:
- ( CHARSET-PRIORITY-LIST-TICK . FONT-VECTOR).
- Reorder FONT-VECTOR according to the current order of charset
- (Vcharset_ordered_list), and update CHARSET-PRIORITY-LIST-TICK to
+ [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-RFONT-DEF
+ RFONT-DEF0 RFONT-DEF1 ...].
+ Reorder RFONT-DEFs according to the current order of charset
+ (Vcharset_ordered_list), and update CHARSET-ORDERED-LIST-TICK to
the latest value. */
static void
reorder_font_vector (fontset_element)
Lisp_Object fontset_element;
{
- Lisp_Object vec, list, *new_vec;
+ Lisp_Object list, *new_vec;
+ Lisp_Object font_def;
int size;
int *charset_id_table;
int i, idx;
- XSETCAR (fontset_element, make_number (charset_ordered_list_tick));
- vec = XCDR (fontset_element);
- size = ASIZE (vec);
- if (size < 2)
- /* No need of reordering VEC. */
+ ASET (fontset_element, 0, make_number (charset_ordered_list_tick));
+ size = ASIZE (fontset_element) - 3;
+ if (size <= 1)
+ /* No need to reorder VEC. */
return;
charset_id_table = (int *) alloca (sizeof (int) * size);
new_vec = (Lisp_Object *) alloca (sizeof (Lisp_Object) * size);
- /* At first, extract ENCODING (a chaset ID) from VEC. VEC has this
- form:
- [[FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] ...] */
+
+ /* At first, extract ENCODING (a chaset ID) from each FONT-DEF.
+ FONT-DEF has this form:
+ [FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] */
for (i = 0; i < size; i++)
- charset_id_table[i] = XINT (AREF (AREF (AREF (vec, i), 2), 1));
+ {
+ font_def = AREF (fontset_element, i + 3);
+ charset_id_table[i] = XINT (AREF (AREF (font_def, 2), 1));
+ }
- /* Then, store the elements of VEC in NEW_VEC in the correct
- order. */
- idx = 0;
- for (list = Vcharset_ordered_list; CONSP (list); list = XCDR (list))
+ /* Then, store FONT-DEFs in NEW_VEC in the correct order. */
+ for (idx = 0, list = Vcharset_ordered_list;
+ idx < size && CONSP (list); list = XCDR (list))
{
for (i = 0; i < size; i++)
if (charset_id_table[i] == XINT (XCAR (list)))
- new_vec[idx++] = AREF (vec, i);
- if (idx == size)
- break;
+ new_vec[idx++] = AREF (fontset_element, i + 3);
}
- /* At last, update VEC. */
+ /* At last, update FONT-DEFs. */
for (i = 0; i < size; i++)
- ASET (vec, i, new_vec[i]);
+ ASET (fontset_element, i + 3, new_vec[i]);
}
{
char *font_name;
struct font_info *font_info;
+ int charset;
- font_name = choose_face_font (f, face->lface, AREF (font_def, 0));
- if (! (font_info = fs_load_font (f, font_name, XINT (AREF (font_def, 1)))))
+ font_name = choose_face_font (f, face->lface, AREF (font_def, 0), NULL);
+ charset = XINT (AREF (font_def, 1));
+ if (! (font_info = fs_load_font (f, font_name, charset)))
return -1;
if (NILP (AREF (font_def, 2))
repertory = (*get_font_repertory_func) (f, font_info);
FONTSET_REPERTORY (fontset)
= Fcons (Fcons (make_number (font_info->font_idx), repertory),
- FONTSET_REPERTORY (fontset));
+ FONTSET_REPERTORY (fontset));
}
return font_info->font_idx;
}
-/* Return a face ID registerd in the realized fontset FONTSET for the
- character C. If FACE is NULL, return -1 if a face is not yet
- set. Otherwise, realize a proper face from FACE and return it. */
+/* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
+ character C. If the corresponding font is not yet opened, open it
+ (if FACE is not NULL) or return Qnil (if FACE is NULL).
+ If no proper font is found for C, return Qnil. */
-static int
-fontset_face (fontset, c, face)
+static Lisp_Object
+fontset_font (fontset, c, face, id)
Lisp_Object fontset;
int c;
struct face *face;
+ int id;
{
- Lisp_Object elt, vec;
+ Lisp_Object base_fontset, elt, vec;
int i, from, to;
int font_idx;
FRAME_PTR f = XFRAME (FONTSET_FRAME (fontset));
- elt = CHAR_TABLE_REF (fontset, c);
+ base_fontset = FONTSET_BASE (fontset);
+ vec = CHAR_TABLE_REF (fontset, c);
+ if (EQ (vec, Qt))
+ goto try_fallback;
- if (EQ (elt, Qt))
- goto font_not_found;
- if (NILP (elt))
+ if (NILP (vec))
{
/* We have not yet decided a face for C. */
- Lisp_Object base_fontset, range;
+ Lisp_Object range;
if (! face)
- return -1;
- base_fontset = FONTSET_BASE (fontset);
+ return Qnil;
elt = FONTSET_REF_AND_RANGE (base_fontset, c, from, to);
range = Fcons (make_number (from), make_number (to));
if (NILP (elt))
{
/* Record that we have no font for characters of this
range. */
- FONTSET_SET (fontset, range, Qt);
- goto font_not_found;
+ vec = Qt;
+ FONTSET_SET (fontset, range, vec);
+ goto try_fallback;
}
- elt = Fcopy_sequence (elt);
- /* Now ELT is a vector of FONT-DEFs. We at first change it to
- FONT-VECTOR, a vector of [ nil nil FONT-DEF ]. */
+ /* Build a vector [ -1 -1 nil NEW-ELT0 NEW-ELT1 NEW-ELT2 ... ],
+ where the first -1 is to force reordering of NEW-ELTn,
+ NEW-ETLn is [nil nil AREF (elt, n) nil]. */
+ vec = Fmake_vector (make_number (ASIZE (elt) + 3), make_number (-1));
+ ASET (vec, 2, Qnil);
for (i = 0; i < ASIZE (elt); i++)
{
Lisp_Object tmp;
- tmp = Fmake_vector (make_number (3), Qnil);
+ tmp = Fmake_vector (make_number (4), Qnil);
ASET (tmp, 2, AREF (elt, i));
- ASET (elt, i, tmp);
+ ASET (vec, 3 + i, tmp);
}
- /* Then store (-1 . FONT-VECTOR) in the fontset. -1 is to force
- reordering of FONT-VECTOR. */
- elt = Fcons (make_number (-1), elt);
- FONTSET_SET (fontset, range, elt);
+ /* Then store it in the fontset. */
+ FONTSET_SET (fontset, range, vec);
}
- if (XINT (XCAR (elt)) != charset_ordered_list_tick)
+ retry:
+ if (XINT (AREF (vec, 0)) != charset_ordered_list_tick)
/* The priority of charsets is changed after we selected a face
for C last time. */
- reorder_font_vector (elt);
+ reorder_font_vector (vec);
+
+ if (id < 0)
+ i = 3;
+ else if (id == XFASTINT (AREF (vec, 1)))
+ i = 2;
+ else
+ {
+ ASET (vec, 1, make_number (id));
+ for (i = 3; i < ASIZE (vec); i++)
+ if (id == XFASTINT (AREF (AREF (AREF (vec, i), 2), 1)))
+ break;
+ if (i < ASIZE (vec))
+ {
+ ASET (vec, 2, AREF (vec, i));
+ i = 2;
+ }
+ else
+ {
+ ASET (vec, 2, Qnil);
+ i = 3;
+ }
+ }
- vec = XCDR (elt);
- /* Find the first available font in the font vector VEC. */
- for (i = 0; i < ASIZE (vec); i++)
+ /* Find the first available font in the vector of RFONT-DEF. */
+ for (; i < ASIZE (vec); i++)
{
Lisp_Object font_def;
elt = AREF (vec, i);
- /* ELT == [ FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ] ] */
- font_def = AREF (elt, 2);
+ if (NILP (elt))
+ continue;
+ /* ELT == [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ] */
if (INTEGERP (AREF (elt, 1)) && XINT (AREF (elt, 1)) < 0)
/* We couldn't open this font last time. */
continue;
- if (!face && (NILP (AREF (elt, 1)) || NILP (AREF (elt, 0))))
- /* We have not yet opened the font, or we have not yet made a
- realized face for the font. */
- return -1;
+ if (!face && NILP (AREF (elt, 1)))
+ /* We have not yet opened the font. */
+ return Qnil;
+ font_def = AREF (elt, 2);
+ /* FONT_DEF == [ FONT-SPEC ENCODING REPERTORY ] */
if (INTEGERP (AREF (font_def, 2)))
{
/* The repertory is specified by charset ID. */
= CHARSET_FROM_ID (XINT (AREF (font_def, 2)));
if (! CHAR_CHARSET_P (c, charset))
- /* This fond can't display C. */
+ /* This font can't display C. */
+ continue;
+ }
+ else if (CHAR_TABLE_P (AREF (font_def, 2)))
+ {
+ /* The repertory is specified by a char table. */
+ if (NILP (CHAR_TABLE_REF (AREF (font_def, 2), c)))
+ /* This font can't display C. */
continue;
}
else
/* We have not yet opened a font matching this spec.
Open the best matching font now and register the
repertory. */
+ struct font_info *font_info;
+
font_idx = load_font_get_repertory (f, face, font_def, fontset);
ASET (elt, 1, make_number (font_idx));
if (font_idx < 0)
/* This means that we couldn't find a font matching
FONT_DEF. */
continue;
+ font_info = (*get_font_info_func) (f, font_idx);
+ ASET (elt, 3, build_string (font_info->full_name));
}
slot = Fassq (AREF (elt, 1), FONTSET_REPERTORY (fontset));
- if (! CONSP (slot))
- abort ();
+ xassert (CONSP (slot));
if (NILP (CHAR_TABLE_REF (XCDR (slot), c)))
- /* This fond can't display C. */
+ /* This font can't display C. */
continue;
}
/* Now we have decided to use this font spec to display C. */
- if (INTEGERP (AREF (elt, 1)))
- font_idx = XINT (AREF (elt, 1));
- else
+ if (! INTEGERP (AREF (elt, 1)))
{
/* But not yet opened the best matching font. */
+ struct font_info *font_info;
+
font_idx = load_font_get_repertory (f, face, font_def, fontset);
ASET (elt, 1, make_number (font_idx));
if (font_idx < 0)
+ /* Can't open it. Try the other one. */
continue;
+ font_info = (*get_font_info_func) (f, font_idx);
+ ASET (elt, 3, build_string (font_info->full_name));
}
/* Now we have the opened font. */
- if (NILP (AREF (elt, 0)))
+ return elt;
+ }
+
+ try_fallback:
+ if (! EQ (vec, FONTSET_FALLBACK (fontset)))
+ {
+ vec = FONTSET_FALLBACK (fontset);
+ if (VECTORP (vec))
+ goto retry;
+ if (EQ (vec, Qt))
+ goto try_default;
+ elt = FONTSET_FALLBACK (base_fontset);
+ if (! NILP (elt))
{
- /* But not yet made a realized face that uses this font. */
- int face_id = lookup_non_ascii_face (f, font_idx, face);
+ vec = Fmake_vector (make_number (ASIZE (elt) + 3), make_number (-1));
+ ASET (vec, 2, Qnil);
+ for (i = 0; i < ASIZE (elt); i++)
+ {
+ Lisp_Object tmp;
- ASET (elt, 0, make_number (face_id));
+ tmp = Fmake_vector (make_number (4), Qnil);
+ ASET (tmp, 2, AREF (elt, i));
+ ASET (vec, 3 + i, tmp);
+ }
+ FONTSET_FALLBACK (fontset) = vec;
+ goto retry;
}
-
- /* Ok, this face can display C. */
- return XINT (AREF (elt, 0));
+ /* Record that this fontset has no fallback fonts. */
+ FONTSET_FALLBACK (fontset) = Qt;
}
- font_not_found:
- /* We have tried all the fonts for C, but none of them can be opened
- nor can display C. */
- if (NILP (FONTSET_NOFONT_FACE (fontset)))
+ /* Try the default fontset. */
+ try_default:
+ if (! EQ (base_fontset, Vdefault_fontset))
{
- int face_id;
-
- if (! face)
- return -1;
- face_id = lookup_non_ascii_face (f, -1, face);
- FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
+ if (NILP (FONTSET_DEFAULT (fontset)))
+ FONTSET_DEFAULT (fontset)
+ = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
+ return fontset_font (FONTSET_DEFAULT (fontset), c, face, id);
}
- return XINT (FONTSET_NOFONT_FACE (fontset));
+ return Qnil;
}
}
+/* 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 (! CONSP (FONTSET_ASCII (Vdefault_fontset)))
+ {
+ int id = fs_query_fontset (fontname, 2);
+
+ if (id >= 0)
+ fontname = XCDR (FONTSET_ASCII (FONTSET_FROM_ID (id)));
+ FONTSET_ASCII (Vdefault_fontset)
+ = Fcons (make_number (0), fontname);
+ }
+}
+
\f
/********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
FRAME_PTR f;
struct face *face;
{
+ Lisp_Object fontset;
+
+ fontset = AREF (Vfontset_table, face->fontset);
+ xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
+ xassert (f == XFRAME (FONTSET_FRAME (fontset)));
ASET (Vfontset_table, face->fontset, Qnil);
if (face->fontset < next_fontset_id)
next_fontset_id = face->fontset;
+ if (! NILP (FONTSET_DEFAULT (fontset)))
+ {
+ int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
+
+ fontset = AREF (Vfontset_table, id);
+ xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
+ xassert (f == XFRAME (FONTSET_FRAME (fontset)));
+ ASET (Vfontset_table, id, Qnil);
+ if (id < next_fontset_id)
+ next_fontset_id = face->fontset;
+ }
}
struct face *face;
int c;
{
- Lisp_Object fontset;
+ Lisp_Object fontset, rfont_def;
fontset = FONTSET_FROM_ID (face->fontset);
- return (face->id == fontset_face (fontset, c, NULL));
+ rfont_def = fontset_font (fontset, c, NULL, -1);
+ return (VECTORP (rfont_def)
+ && INTEGERP (AREF (rfont_def, 0))
+ && face->id == XINT (AREF (rfont_def, 0)));
}
the macro FACE_FOR_CHAR. */
int
-face_for_char (f, face, c)
+face_for_char (f, face, c, pos, object)
FRAME_PTR f;
struct face *face;
- int c;
+ int c, pos;
+ Lisp_Object object;
{
- Lisp_Object fontset;
+ Lisp_Object fontset, charset, rfont_def;
+ int face_id;
+ int id;
if (ASCII_CHAR_P (c))
return face->ascii_face->id;
xassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
xassert (!BASE_FONTSET_P (fontset));
- return fontset_face (fontset, c, face);
+ if (pos < 0)
+ id = -1;
+ else
+ {
+ charset = Fget_char_property (make_number (pos), Qcharset, object);
+ if (NILP (charset))
+ id = -1;
+ else if (CHARSETP (charset))
+ id = XINT (CHARSET_SYMBOL_ID (charset));
+ }
+ rfont_def = fontset_font (fontset, c, face, id);
+ if (VECTORP (rfont_def))
+ {
+ if (NILP (AREF (rfont_def, 0)))
+ {
+ /* We have not yet made a realized face that uses this font. */
+ int font_idx = XINT (AREF (rfont_def, 1));
+
+ face_id = lookup_non_ascii_face (f, font_idx, face);
+ ASET (rfont_def, 0, make_number (face_id));
+ }
+ return XINT (AREF (rfont_def, 0));
+ }
+
+ if (NILP (FONTSET_NOFONT_FACE (fontset)))
+ {
+ face_id = lookup_non_ascii_face (f, -1, face);
+ FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
+ }
+ return XINT (FONTSET_NOFONT_FACE (fontset));
}
fontset = make_fontset (frame, Qnil, base_fontset);
{
- Lisp_Object elt;
+ Lisp_Object elt, rfont_def;
elt = FONTSET_REF (base_fontset, 0);
- elt = Fmake_vector (make_number (3), AREF (elt, 0));
- ASET (elt, 0, make_number (face->id));
- ASET (elt, 1, make_number (face->font_info_id));
- elt = Fcons (make_number (charset_ordered_list_tick),
- Fmake_vector (make_number (1), elt));
+ xassert (VECTORP (elt) && ASIZE (elt) > 0);
+ rfont_def = Fmake_vector (make_number (4), Qnil);
+ ASET (rfont_def, 0, make_number (face->id));
+ ASET (rfont_def, 1, make_number (face->font_info_id));
+ ASET (rfont_def, 2, AREF (elt, 0));
+ ASET (rfont_def, 3, build_string (face->font_name));
+ elt = Fmake_vector (make_number (4), Qnil);
+ ASET (elt, 0, make_number (charset_ordered_list_tick));
+ ASET (elt, 1, make_number (charset_ascii));
+ ASET (elt, 2, rfont_def);
+ ASET (elt, 3, rfont_def);
char_table_set_range (fontset, 0, 127, elt);
}
return XINT (FONTSET_ID (fontset));
int charset;
{
struct font_info *fontp;
+ Lisp_Object fullname;
if (!fontname)
/* No way to get fontname. */
return fontp;
fontname = fontp->full_name;
+ fullname = build_string (fontp->full_name);
if (charset < 0)
{
Lisp_Object charset_symbol;
- charset_symbol = find_font_encoding (fontname);
+ charset_symbol = find_font_encoding (fullname);
if (CONSP (charset_symbol))
charset_symbol = XCAR (charset_symbol);
charset = XINT (CHARSET_SYMBOL_ID (charset_symbol));
{
fontp->vertical_centering
= (STRINGP (Vvertical_centering_font_regexp)
- && (fast_c_string_match_ignore_case
- (Vvertical_centering_font_regexp, fontname) >= 0));
+ && (fast_string_match_ignore_case
+ (Vvertical_centering_font_regexp, fullname) >= 0));
if (find_ccl_program_func)
(*find_ccl_program_func) (fontp);
static Lisp_Object
find_font_encoding (fontname)
- char *fontname;
+ Lisp_Object fontname;
{
Lisp_Object tail, elt;
elt = XCAR (tail);
if (CONSP (elt)
&& STRINGP (XCAR (elt))
- && fast_c_string_match_ignore_case (XCAR (elt), fontname) >= 0
+ && fast_string_match_ignore_case (XCAR (elt), fontname) >= 0
&& (SYMBOLP (XCDR (elt))
? CHARSETP (XCDR (elt))
: CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt)))))
return (XCDR (elt));
}
- /* We don't know the encoding of this font. Let's assume Unicode
- encoding. */
- return Qunicode;
+ /* We don't know the encoding of this font. Let's assume `ascii'. */
+ return Qascii;
}
the corresponding regular expression. */
static Lisp_Object Vcached_fontset_data;
-#define CACHED_FONTSET_NAME (XSTRING (XCAR (Vcached_fontset_data))->data)
+#define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
#define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
/* If fontset name PATTERN contains any wild card, return regular
fontset_pattern_regexp (pattern)
Lisp_Object pattern;
{
- if (!index (XSTRING (pattern)->data, '*')
- && !index (XSTRING (pattern)->data, '?'))
+ if (!index (SDATA (pattern), '*')
+ && !index (SDATA (pattern), '?'))
/* PATTERN does not contain any wild cards. */
return Qnil;
if (!CONSP (Vcached_fontset_data)
- || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
+ || strcmp (SDATA (pattern), CACHED_FONTSET_NAME))
{
/* We must at first update the cached data. */
- char *regex = (char *) alloca (XSTRING (pattern)->size * 2 + 3);
- char *p0, *p1 = regex;
+ unsigned char *regex, *p0, *p1;
+ int ndashes = 0, nstars = 0;
+
+ for (p0 = SDATA (pattern); *p0; p0++)
+ {
+ if (*p0 == '-')
+ ndashes++;
+ else if (*p0 == '*')
+ nstars++;
+ }
+
+ /* If PATTERN is not full XLFD we conert "*" to ".*". Otherwise
+ we convert "*" to "[^-]*" which is much faster in regular
+ expression matching. */
+ if (ndashes < 14)
+ p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 1);
+ else
+ p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 1);
- /* Convert "*" to ".*", "?" to ".". */
*p1++ = '^';
- for (p0 = (char *) XSTRING (pattern)->data; *p0; p0++)
+ for (p0 = SDATA (pattern); *p0; p0++)
{
if (*p0 == '*')
{
- *p1++ = '.';
+ if (ndashes < 14)
+ *p1++ = '.';
+ else
+ *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
*p1++ = '*';
}
else if (*p0 == '?')
*p1++ = '$';
*p1++ = 0;
- Vcached_fontset_data = Fcons (build_string (XSTRING (pattern)->data),
+ Vcached_fontset_data = Fcons (build_string (SDATA (pattern)),
build_string (regex));
}
}
/* Return ID of the base fontset named NAME. If there's no such
- fontset, return -1. */
+ fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
+ 0: pattern containing '*' and '?' as wildcards
+ 1: regular expression
+ 2: literal fontset name
+*/
int
-fs_query_fontset (name, regexpp)
+fs_query_fontset (name, name_pattern)
Lisp_Object name;
- int regexpp;
+ int name_pattern;
{
Lisp_Object tem;
int i;
name = Fdowncase (name);
- if (!regexpp)
+ if (name_pattern != 1)
{
tem = Frassoc (name, Vfontset_alias_alist);
+ if (NILP (tem))
+ tem = Fassoc (name, Vfontset_alias_alist);
if (CONSP (tem) && STRINGP (XCAR (tem)))
name = XCAR (tem);
- else
+ else if (name_pattern == 0)
{
tem = fontset_pattern_regexp (name);
if (STRINGP (tem))
{
name = tem;
- regexpp = 1;
+ name_pattern = 1;
}
}
}
for (i = 0; i < ASIZE (Vfontset_table); i++)
{
- Lisp_Object fontset;
- unsigned char *this_name;
+ Lisp_Object fontset, this_name;
fontset = FONTSET_FROM_ID (i);
if (NILP (fontset)
|| !BASE_FONTSET_P (fontset))
continue;
- this_name = XSTRING (FONTSET_NAME (fontset))->data;
- if (regexpp
- ? fast_c_string_match_ignore_case (name, this_name) >= 0
- : !strcmp (XSTRING (name)->data, this_name))
+ this_name = FONTSET_NAME (fontset);
+ if (name_pattern == 1
+ ? fast_string_match (name, this_name) >= 0
+ : !strcmp (SDATA (name), SDATA (this_name)))
return i;
}
return -1;
CHECK_STRING (pattern);
- if (XSTRING (pattern)->size == 0)
+ if (SCHARS (pattern) == 0)
return Qnil;
id = fs_query_fontset (pattern, !NILP (regexpp));
for (id = 0; id < ASIZE (Vfontset_table); id++)
{
- Lisp_Object fontset;
- unsigned char *name;
+ Lisp_Object fontset, name;
fontset = FONTSET_FROM_ID (id);
if (NILP (fontset)
|| !BASE_FONTSET_P (fontset)
|| !EQ (frame, FONTSET_FRAME (fontset)))
continue;
- name = XSTRING (FONTSET_NAME (fontset))->data;
+ name = FONTSET_NAME (fontset);
if (STRINGP (regexp)
- ? (fast_c_string_match_ignore_case (regexp, name) < 0)
- : strcmp (XSTRING (pattern)->data, name))
+ ? (fast_string_match (regexp, name) < 0)
+ : strcmp (SDATA (pattern), SDATA (name)))
continue;
val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
}
-/* Free all realized fontsets whose base fontset is BASE. */
+/* Free all realized fontsets whose base fontset is BASE. */
static void
free_realized_fontsets (base)
FRAME_PTR f = XFRAME (FONTSET_FRAME (this));
int face_id = XINT (XCDR (XCAR (tail)));
struct face *face = FACE_FROM_ID (f, face_id);
-
+
/* Face THIS itself is also freed by the following call. */
free_realized_face (f, face);
}
return Vdefault_fontset;
CHECK_STRING (name);
- id = fs_query_fontset (name, 0);
+ /* 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", XSTRING (name)->data);
+ error ("Fontset `%s' does not exist", SDATA (name));
return FONTSET_FROM_ID (id);
}
}
+/* Return an ASCII font name generated from fontset name NAME and
+ ASCII font specification ASCII_SPEC. NAME is a string conforming
+ to XLFD. ASCII_SPEC is a vector:
+ [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
+
+static INLINE Lisp_Object
+generate_ascii_font_name (name, ascii_spec)
+ Lisp_Object name, ascii_spec;
+{
+ Lisp_Object vec;
+ int i;
+
+ vec = split_font_name_into_vector (name);
+ for (i = FONT_SPEC_FAMILY_INDEX; i <= FONT_SPEC_ADSTYLE_INDEX; i++)
+ if (! NILP (AREF (ascii_spec, i)))
+ ASET (vec, 1 + i, AREF (ascii_spec, i));
+ if (! NILP (AREF (ascii_spec, FONT_SPEC_REGISTRY_INDEX)))
+ ASET (vec, 12, AREF (ascii_spec, FONT_SPEC_REGISTRY_INDEX));
+ return build_font_name_from_vector (vec);
+}
+
+/* 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. */
+
+static void
+set_fontset_font (fontset, range)
+ Lisp_Object fontset, range;
+{
+ if (from_arg < to_arg)
+ {
+ int from = XINT (XCAR (range)), to = XINT (XCDR (range));
+
+ if (from < from_arg)
+ {
+ if (to > to_arg)
+ {
+ Lisp_Object range2;
+
+ 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)
+ return;
+ else
+ {
+ if (from < to_arg)
+ range = Fcons (make_number (to_arg), XCDR (range));
+ }
+ }
+ FONTSET_ADD (fontset, range, font_def_arg, add_arg);
+}
+
+
DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
- doc: /*
-Modify fontset NAME to use FONT-SPEC for CHARACTER.
+ doc: /*
+Modify fontset NAME to use FONT-SPEC for TARGET characters.
+
+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).
-CHARACTER 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).
+TARGET may be a script name symbol. In that case, use FONT-SPEC for
+all characters that belong to the script.
-CHARACTER may be a script name symbol. In that case, use FONT-SPEC
-for all characters that belong to the script.
+TARGET may be a charset. In that case, use FONT-SPEC for all
+characters in the charset.
-CHARACTER may be a charset which has a :code-offset attribute and the
-attribute value is greater than the maximum Unicode character
-\(#x10FFFF). In that case, use FONT-SPEC for all characters in the
-charset.
+TARGET may be nil. In that case, use FONT-SPEC for any characters for
+that no FONT-SPEC is specified.
-FONT-SPEC may be:
- * A vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].
- See the documentation of `set-face-attribute' for the detail of
- these vector elements;
+FONT-SPEC may one of these:
* A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
- REGISTRY is a font registry name;
+ REGISTRY is a font registry name. FAMILY may contains foundry
+ name, and REGISTRY may contains encoding name.
* A font name string.
Optional 4th argument FRAME, if non-nil, is a frame. This argument is
kept for backward compatibility and has no meaning.
Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
-to the font specifications for RANGE previously set. If it is
+to the font specifications for TARGET previously set. If it is
`prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
appended. By default, FONT-SPEC overrides the previous settings. */)
- (name, character, font_spec, frame, add)
- Lisp_Object name, character, font_spec, frame, add;
+ (name, target, font_spec, frame, add)
+ Lisp_Object name, target, font_spec, frame, add;
{
Lisp_Object fontset;
- Lisp_Object font_def, registry;
+ Lisp_Object font_def, registry, family;
Lisp_Object encoding, repertory;
Lisp_Object range_list;
+ struct charset *charset = NULL;
fontset = check_fontset_name (name);
if (VECTORP (font_spec))
{
+ /* FONT_SPEC should have this form:
+ [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ]
+ This is a feature not yet documented because WEIGHT thru
+ ADSTYLE are ignored for the moment. */
int j;
- if (ASIZE (font_spec) != 6)
- args_out_of_range (make_number (6),
+ if (ASIZE (font_spec) != FONT_SPEC_MAX_INDEX)
+ args_out_of_range (make_number (FONT_SPEC_MAX_INDEX),
make_number (ASIZE (font_spec)));
font_spec = Fcopy_sequence (font_spec);
- for (j = 0; j < 5; j++)
+ for (j = 0; j < FONT_SPEC_MAX_INDEX - 1; j++)
if (! NILP (AREF (font_spec, j)))
{
CHECK_STRING (AREF (font_spec, j));
ASET (font_spec, j, Fdowncase (AREF (font_spec, j)));
}
+ family = AREF (font_spec, FONT_SPEC_FAMILY_INDEX);
/* REGISTRY should not be omitted. */
- CHECK_STRING (AREF (font_spec, 5));
- registry = Fdowncase (AREF (font_spec, 5));
- ASET (font_spec, 5, registry);
-
+ CHECK_STRING (AREF (font_spec, FONT_SPEC_REGISTRY_INDEX));
+ registry = AREF (font_spec, FONT_SPEC_REGISTRY_INDEX);
}
else if (CONSP (font_spec))
{
- Lisp_Object family;
-
family = XCAR (font_spec);
registry = XCDR (font_spec);
}
CHECK_STRING (registry);
registry = Fdowncase (registry);
- font_spec = Fmake_vector (make_number (6), Qnil);
- ASET (font_spec, 0, family);
- ASET (font_spec, 5, registry);
+ font_spec = Fmake_vector (make_number (FONT_SPEC_MAX_INDEX), Qnil);
+ ASET (font_spec, FONT_SPEC_FAMILY_INDEX, family);
+ ASET (font_spec, FONT_SPEC_REGISTRY_INDEX, registry);
}
else
{
CHECK_STRING (font_spec);
font_spec = Fdowncase (font_spec);
- registry = font_name_registry (font_spec);
- if (NILP (registry))
- error ("No XLFD: %s", XSTRING (font_spec)->data);
}
if (STRINGP (font_spec))
- encoding = find_font_encoding ((char *) XSTRING (font_spec)->data);
+ encoding = find_font_encoding (font_spec);
else
- encoding = find_font_encoding ((char *) XSTRING (registry)->data);
+ encoding = find_font_encoding (concat2 (family, registry));
if (SYMBOLP (encoding))
- encoding = repertory = CHARSET_SYMBOL_ID (encoding);
+ {
+ CHECK_CHARSET (encoding);
+ encoding = repertory = CHARSET_SYMBOL_ID (encoding);
+ }
else
{
repertory = XCDR (encoding);
- encoding = CHARSET_SYMBOL_ID (XCAR (encoding));
+ encoding = XCAR (encoding);
+ CHECK_CHARSET (encoding);
+ encoding = CHARSET_SYMBOL_ID (encoding);
+ if (! NILP (repertory) && SYMBOLP (repertory))
+ {
+ CHECK_CHARSET (repertory);
+ repertory = CHARSET_SYMBOL_ID (repertory);
+ }
}
font_def = Fmake_vector (make_number (3), font_spec);
ASET (font_def, 1, encoding);
ASET (font_def, 2, repertory);
- if (CHARACTERP (character))
- range_list = Fcons (Fcons (character, character), Qnil);
- else if (CONSP (character))
+ if (CHARACTERP (target))
+ range_list = Fcons (Fcons (target, target), Qnil);
+ else if (CONSP (target))
{
Lisp_Object from, to;
- from = Fcar (character);
- to = Fcdr (character);
+ from = Fcar (target);
+ to = Fcdr (target);
CHECK_CHARACTER (from);
CHECK_CHARACTER (to);
- range_list = Fcons (character, Qnil);
+ range_list = Fcons (target, Qnil);
}
- else
+ else if (SYMBOLP (target) && !NILP (target))
{
Lisp_Object script_list;
Lisp_Object val;
- CHECK_SYMBOL (character);
range_list = Qnil;
script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
- if (! NILP (Fmemq (character, script_list)))
+ if (! NILP (Fmemq (target, script_list)))
{
- val = Fcons (character, Qnil);
+ val = Fcons (target, Qnil);
map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
- val, 0, NULL);
- range_list = XCDR (val);
+ val);
+ range_list = XCDR (val);
}
- else if (CHARSETP (character))
+ if (CHARSETP (target))
{
- struct charset *charset;
-
- CHECK_CHARSET_GET_CHARSET (character, charset);
- if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET)
- range_list
- = Fcons (Fcons (make_number (CHARSET_MIN_CHAR (charset)),
- make_number (CHARSET_MAX_CHAR (charset))),
- range_list);
- if (EQ (character, Qascii))
+ if (EQ (target, Qascii))
{
- if (! STRINGP (font_spec))
+ if (VECTORP (font_spec))
font_spec = generate_ascii_font_name (FONTSET_NAME (fontset),
font_spec);
FONTSET_ASCII (fontset) = font_spec;
+ range_list = Fcons (Fcons (make_number (0), make_number (127)),
+ Qnil);
+ }
+ else
+ {
+ CHECK_CHARSET_GET_CHARSET (target, charset);
}
}
-
- if (NILP (range_list))
+ else if (NILP (range_list))
error ("Invalid script or charset name: %s",
- XSYMBOL (character)->name->data);
+ SDATA (SYMBOL_NAME (target)));
}
+ else if (NILP (target))
+ range_list = Fcons (Qnil, Qnil);
+ else
+ error ("Invalid target for setting a font");
+
+ 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)));
+
+ map_charset_chars (set_fontset_font, Qnil, fontset, charset,
+ CHARSET_MIN_CODE (charset),
+ CHARSET_MAX_CODE (charset));
+ }
for (; CONSP (range_list); range_list = XCDR (range_list))
FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
doc: /* Create a new fontset NAME from font information in FONTLIST.
FONTLIST is an alist of scripts vs the corresponding font specification list.
-Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where
-a character of SCRIPT is displayed by a font that matches FONT-SPEC.
+Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
+character of SCRIPT is displayed by a font that matches one of
+FONT-SPEC.
-SCRIPT is a symbol that appears in the variable `script-alist'.
+SCRIPT is a symbol that appears in the first extra slot of the
+char-table `char-script-table'.
FONT-SPEC is a vector, a cons, or a string. See the documentation of
`set-fontset-font' for the meaning. */)
CHECK_STRING (name);
CHECK_LIST (fontlist);
- /* Check if an ASCII font is specified in FONTLIST. */
- val = Fcar (Fcdr (Fassq (Qascii, fontlist)));
- if (NILP (val))
- error ("No ascii font specified");
-
id = fs_query_fontset (name, 0);
if (id < 0)
- fontset = make_fontset (Qnil, Fdowncase (name), Qnil);
+ {
+ name = Fdowncase (name);
+ val = split_font_name_into_vector (name);
+ if (NILP (val) || NILP (AREF (val, 12)) || NILP (AREF (val, 13)))
+ error ("Fontset name must be in XLFD format");
+ if (strcmp (SDATA (AREF (val, 12)), "fontset"))
+ error ("Registry field of fontset name must be \"fontset\"");
+ Vfontset_alias_alist
+ = Fcons (Fcons (name,
+ concat2 (concat2 (AREF (val, 12), build_string ("-")),
+ AREF (val, 13))),
+ Vfontset_alias_alist);
+ ASET (val, 12, build_string ("iso8859-1"));
+ fontset = make_fontset (Qnil, name, Qnil);
+ FONTSET_ASCII (fontset) = build_font_name_from_vector (val);
+ }
else
{
fontset = FONTSET_FROM_ID (id);;
elt = Fcar (fontlist);
script = Fcar (elt);
elt = Fcdr (elt);
- Fset_fontset_font (name, script, Fcar (elt), Qnil, Qnil);
- for (elt = Fcdr (elt); ! NILP (elt); elt = Fcdr (elt))
- Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
+ if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
+ for (; CONSP (elt); elt = XCDR (elt))
+ Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
+ else
+ Fset_fontset_font (name, script, elt, Qnil, Qappend);
}
return name;
}
+/* Alist of automatically created fontsets. Each element is a cons
+ (FONTNAME . FONTSET-ID). */
+static Lisp_Object auto_fontset_alist;
+
+int
+new_fontset_from_font_name (Lisp_Object fontname)
+{
+ Lisp_Object val;
+ Lisp_Object name;
+ Lisp_Object vec;
+ int id;
+
+ fontname = Fdowncase (fontname);
+ val = Fassoc (fontname, auto_fontset_alist);
+ if (CONSP (val))
+ return XINT (XCDR (val));
+
+ vec = split_font_name_into_vector (fontname);
+ if ( NILP (vec))
+ vec = Fmake_vector (make_number (14), build_string (""));
+ ASET (vec, 12, build_string ("fontset"));
+ if (NILP (auto_fontset_alist))
+ {
+ ASET (vec, 13, build_string ("startup"));
+ name = build_font_name_from_vector (vec);
+ }
+ else
+ {
+ char temp[20];
+ int len = XINT (Flength (auto_fontset_alist));
+
+ sprintf (temp, "auto%d", len);
+ ASET (vec, 13, build_string (temp));
+ name = build_font_name_from_vector (vec);
+ }
+ name = Fnew_fontset (name, list2 (list2 (Qascii, fontname),
+ list2 (Fcons (make_number (0),
+ make_number (MAX_CHAR)),
+ fontname)));
+ id = fs_query_fontset (name, 0);
+ auto_fontset_alist
+ = Fcons (Fcons (fontname, make_number (id)), auto_fontset_alist);
+ return id;
+}
+
+
DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
doc: /* Return information about a font named NAME on frame FRAME.
If FRAME is omitted or nil, use the selected frame.
if (!query_font_func)
error ("Font query function is not supported");
- fontp = (*query_font_func) (f, XSTRING (name)->data);
+ fontp = (*query_font_func) (f, SDATA (name));
if (!fontp)
return Qnil;
}
-/* Return the font name for the character at POSITION in the current
+/* Return a cons (FONT-NAME . GLYPH-CODE).
+ FONT-NAME is the font name for the character at POSITION in the current
buffer. This is computed from all the text properties and overlays
- that apply to POSITION. It returns nil in the following cases:
+ that apply to POSITION. POSTION may be nil, in which case,
+ FONT-NAME is the font name for display the character CH with the
+ default face.
+
+ GLYPH-CODE is the glyph code in the font to use for the character.
+
+ If the 2nd optional arg CH is non-nil, it is a character to check
+ the font instead of the character at POSITION.
+
+ It returns nil in the following cases:
(1) The window system doesn't have a font for the character (thus
it is displayed by an empty box).
(2) The character code is invalid.
- (3) The current buffer is not displayed in any window.
+ (3) If POSITION is not nil, and the current buffer is not displayed
+ in any window.
In addition, the returned font name may not take into account of
such redisplay engine hooks as what used in jit-lock-mode if
POSITION is currently not visible. */
-DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 1, 0,
+DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
doc: /* For internal use only. */)
- (position)
- Lisp_Object position;
+ (position, ch)
+ Lisp_Object position, ch;
{
int pos, pos_byte, dummy;
int face_id;
int c;
- Lisp_Object window;
- struct window *w;
struct frame *f;
struct face *face;
+ Lisp_Object charset, rfont_def;
+ int id;
- CHECK_NUMBER_COERCE_MARKER (position);
- pos = XINT (position);
- if (pos < BEGV || pos >= ZV)
- args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
- pos_byte = CHAR_TO_BYTE (pos);
- c = FETCH_CHAR (pos_byte);
- window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
- if (NILP (window))
+ if (NILP (position))
+ {
+ CHECK_CHARACTER (ch);
+ c = XINT (ch);
+ f = XFRAME (selected_frame);
+ face_id = DEFAULT_FACE_ID;
+ pos = -1;
+ }
+ else
+ {
+ Lisp_Object window;
+ struct window *w;
+
+ CHECK_NUMBER_COERCE_MARKER (position);
+ pos = XINT (position);
+ if (pos < BEGV || pos >= ZV)
+ args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
+ pos_byte = CHAR_TO_BYTE (pos);
+ if (NILP (ch))
+ c = FETCH_CHAR (pos_byte);
+ else
+ {
+ CHECK_NATNUM (ch);
+ c = XINT (ch);
+ }
+ window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
+ if (NILP (window))
+ return Qnil;
+ w = XWINDOW (window);
+ f = XFRAME (w->frame);
+ face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
+ }
+ if (! CHAR_VALID_P (c, 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_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
+ face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
face = FACE_FROM_ID (f, face_id);
- return (face->font && face->font_name
- ? build_string (face->font_name)
- : Qnil);
+ charset = Fget_char_property (position, Qcharset, Qnil);
+ if (CHARSETP (charset))
+ id = XINT (CHARSET_SYMBOL_ID (charset));
+ else
+ id = -1;
+ rfont_def = fontset_font (FONTSET_FROM_ID (face->fontset), c, face, id);
+ if (VECTORP (rfont_def) && STRINGP (AREF (rfont_def, 3)))
+ {
+ Lisp_Object font_def;
+ struct font_info *fontp;
+ struct charset *charset;
+ XChar2b char2b;
+ int code;
+
+ font_def = AREF (rfont_def, 2);
+ charset = CHARSET_FROM_ID (XINT (AREF (font_def, 1)));
+ code = ENCODE_CHAR (charset, c);
+ if (code == CHARSET_INVALID_CODE (charset))
+ return (Fcons (AREF (rfont_def, 3), Qnil));
+ STORE_XCHAR2B (&char2b, ((code >> 8) & 0xFF), (code & 0xFF));
+ fontp = (*get_font_info_func) (f, XINT (AREF (rfont_def, 1)));
+ rif->encode_char (c, &char2b, fontp, charset, NULL);
+ code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b);
+ return (Fcons (AREF (rfont_def, 3), make_number (code)));
+ }
+ return Qnil;
}
or a string of font name pattern.
-OPENED-FONT is a name of a font actually opened. */)
+OPENED-FONT is a name of a font actually opened.
+
+The char-table has one extra slot. The value is a char-table
+containing the information about the derived fonts from the default
+fontset. The format is the same as abobe. */)
(fontset, frame)
Lisp_Object fontset, frame;
{
FRAME_PTR f;
- Lisp_Object table, val, elt;
- Lisp_Object *realized;
- int n_realized = 0;
- int c, i, j;
+ Lisp_Object *realized[2], fontsets[2], tables[2];
+ Lisp_Object val, elt;
+ int c, i, j, k;
(*check_window_system_func) ();
/* Recode fontsets realized on FRAME from the base fontset FONTSET
in the table `realized'. */
- realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
- * ASIZE (Vfontset_table));
- for (i = 0; i < ASIZE (Vfontset_table); i++)
+ realized[0] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
+ * ASIZE (Vfontset_table));
+ for (i = j = 0; i < ASIZE (Vfontset_table); i++)
{
elt = FONTSET_FROM_ID (i);
if (!NILP (elt)
&& EQ (FONTSET_BASE (elt), fontset)
&& EQ (FONTSET_FRAME (elt), frame))
- realized[n_realized++] = elt;
+ realized[0][j++] = elt;
+ }
+ realized[0][j] = Qnil;
+
+ realized[1] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
+ * ASIZE (Vfontset_table));
+ for (i = j = 0; ! NILP (realized[0][i]); i++)
+ {
+ elt = FONTSET_DEFAULT (realized[0][i]);
+ if (! NILP (elt))
+ realized[1][j++] = elt;
}
+ 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;
- table = Fmake_char_table (Qnil, Qnil);
/* Accumulate information of the fontset in TABLE. The format of
each element is ((FONT-SPEC OPENED-FONT ...) ...). */
- for (c = 0; c <= MAX_CHAR; )
+ for (k = 0; k <= 1; k++)
{
- int from, to;
-
- val = FONTSET_REF_AND_RANGE (fontset, c, from, to);
- if (VECTORP (val))
+ for (c = 0; c <= MAX_CHAR; )
{
- Lisp_Object alist;
-
- /* At first, set ALIST to ((FONT-SPEC) ...). */
- for (alist = Qnil, i = 0; i < ASIZE (val); i++)
- alist = Fcons (Fcons (AREF (AREF (val, i), 0), Qnil), alist);
- alist = Fnreverse (alist);
+ int from, to;
- /* Then store opend font names to cdr of each elements. */
- for (i = 0; i < n_realized; i++)
+ if (c <= MAX_5_BYTE_CHAR)
{
- val = FONTSET_REF (realized[i], c);
- if (NILP (val))
- continue;
- val = XCDR (val);
- /* Now VAL is [[FACE-ID FONT-INDEX FONT-DEF] ...].
- If a font of an element is already opened,
- FONT-INDEX of the element is integer. */
- for (j = 0; j < ASIZE (val); j++)
- if (INTEGERP (AREF (AREF (val, j), 0)))
+ 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_FALLBACK (fontsets[k]);
+ to = MAX_CHAR;
+ }
+ if (VECTORP (val))
+ {
+ Lisp_Object alist;
+
+ /* At first, set ALIST to ((FONT-SPEC) ...). */
+ for (alist = Qnil, i = 0; i < ASIZE (val); i++)
+ alist = Fcons (Fcons (AREF (AREF (val, i), 0), Qnil), alist);
+ alist = Fnreverse (alist);
+
+ /* Then store opend font names to cdr of each elements. */
+ for (i = 0; ! NILP (realized[k][i]); i++)
+ {
+ if (c <= MAX_5_BYTE_CHAR)
+ val = FONTSET_REF (realized[k][i], c);
+ else
+ val = FONTSET_FALLBACK (realized[k][i]);
+ if (! VECTORP (val))
+ continue;
+ /* VAL is [int int ?
+ [FACE-ID FONT-INDEX FONT-DEF FONT-NAME] ...].
+ If a font of an element is already opened,
+ FONT-NAME is the name of a opened font. */
+ for (j = 3; j < ASIZE (val); j++)
+ if (STRINGP (AREF (AREF (val, j), 3)))
+ {
+ Lisp_Object font_idx;
+
+ font_idx = AREF (AREF (val, j), 1);
+ elt = Fassq (AREF (AREF (AREF (val, j), 2), 0), alist);
+ if (CONSP (elt)
+ && NILP (Fmemq (font_idx, XCDR(elt))))
+ nconc2 (elt, Fcons (font_idx, Qnil));
+ }
+ }
+ for (val = alist; CONSP (val); val = XCDR (val))
+ for (elt = XCDR (XCAR (val)); CONSP (elt); elt = XCDR (elt))
{
- Lisp_Object font_idx;
-
- font_idx = AREF (AREF (val, j), 1);
- elt = Fassq (AREF (AREF (AREF (val, j), 2), 0), alist);
- if (CONSP (elt)
- && NILP (Fmemq (font_idx, XCDR(elt))))
- nconc2 (elt, Fcons (font_idx, Qnil));
+ struct font_info *font_info
+ = (*get_font_info_func) (f, XINT (XCAR (elt)));
+ XSETCAR (elt, build_string (font_info->full_name));
}
+
+ /* Store ALIST in TBL for characters C..TO. */
+ if (c <= MAX_5_BYTE_CHAR)
+ char_table_set_range (tables[k], c, to, alist);
+ else
+ XCHAR_TABLE (tables[k])->defalt = alist;
}
- for (val = alist; CONSP (val); val = XCDR (val))
- for (elt = XCDR (XCAR (val)); CONSP (elt); elt = XCDR (elt))
- {
- struct font_info *font_info
- = (*get_font_info_func) (f, XINT (XCAR (elt)));
- XSETCAR (elt, build_string (font_info->full_name));
- }
-
- /* Store ALIST in TABLE for characters C..TO. */
- char_table_set_range (table, c, to, alist);
+ c = to + 1;
}
- c = to + 1;
}
- return table;
+ return tables[0];
}
-DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 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 font name pattern in the default fontset. */)
- (name, ch)
- Lisp_Object name, ch;
+If NAME is t, find a pattern in the default fontset.
+
+The value has the form (FAMILY . REGISTRY), where FAMILY is a font
+family name and REGISTRY is a font registry name. This is actually
+the first font name pattern for CH in the fontset or in the default
+fontset.
+
+If the 2nd optional arg ALL is non-nil, return a list of all font name
+patterns. */)
+ (name, ch, all)
+ Lisp_Object name, ch, all;
{
int c;
- Lisp_Object fontset, elt;
+ Lisp_Object fontset, elt, list, repertory, val;
+ int i, j;
fontset = check_fontset_name (name);
CHECK_CHARACTER (ch);
c = XINT (ch);
- elt = FONTSET_REF (fontset, c);
- return Fcopy_sequence (elt);
+ list = Qnil;
+ while (1)
+ {
+ for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
+ i++, elt = FONTSET_FALLBACK (fontset))
+ if (VECTORP (elt))
+ for (j = 0; j < ASIZE (elt); j++)
+ {
+ val = AREF (elt, j);
+ repertory = AREF (val, 1);
+ if (INTEGERP (repertory))
+ {
+ struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
+
+ if (! CHAR_CHARSET_P (c, charset))
+ continue;
+ }
+ else if (CHAR_TABLE_P (repertory))
+ {
+ if (NILP (CHAR_TABLE_REF (repertory, c)))
+ continue;
+ }
+ val = AREF (val, 0);
+ val = Fcons (AREF (val, 0), AREF (val, 5));
+ if (NILP (all))
+ return val;
+ list = Fcons (val, list);
+ }
+ if (EQ (fontset, Vdefault_fontset))
+ break;
+ fontset = Vdefault_fontset;
+ }
+ return (Fnreverse (list));
}
DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
return list;
}
+
+#ifdef FONTSET_DEBUG
+
+Lisp_Object
+dump_fontset (fontset)
+ Lisp_Object fontset;
+{
+ Lisp_Object vec;
+
+ vec = Fmake_vector (make_number (3), Qnil);
+ ASET (vec, 0, FONTSET_ID (fontset));
+
+ if (BASE_FONTSET_P (fontset))
+ {
+ ASET (vec, 1, FONTSET_NAME (fontset));
+ }
+ else
+ {
+ Lisp_Object frame;
+
+ frame = FONTSET_FRAME (fontset);
+ if (FRAMEP (frame))
+ {
+ FRAME_PTR f = XFRAME (frame);
+
+ if (FRAME_LIVE_P (f))
+ ASET (vec, 1, f->name);
+ else
+ ASET (vec, 1, Qt);
+ }
+ if (!NILP (FONTSET_DEFAULT (fontset)))
+ ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
+ }
+ return vec;
+}
+
+DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
+ doc: /* Return a brief summary of all fontsets for debug use. */)
+ ()
+{
+ Lisp_Object val;
+ int i;
+
+ for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
+ if (! NILP (AREF (Vfontset_table, i)))
+ val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
+ return (Fnreverse (val));
+}
+#endif /* FONTSET_DEBUG */
+
void
syms_of_fontset ()
{
abort ();
DEFSYM (Qfontset, "fontset");
- Fput (Qfontset, Qchar_table_extra_slots, make_number (7));
+ Fput (Qfontset, Qchar_table_extra_slots, make_number (9));
+ DEFSYM (Qfontset_info, "fontset-info");
+ Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
DEFSYM (Qprepend, "prepend");
DEFSYM (Qappend, "append");
FONTSET_ID (Vdefault_fontset) = make_number (0);
FONTSET_NAME (Vdefault_fontset)
= build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
- {
- Lisp_Object default_ascii_font;
-
-#if defined (macintosh)
- default_ascii_font
- = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
-#elif defined (WINDOWSNT)
- default_ascii_font
- = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
-#else
- default_ascii_font
- = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
-#endif
- FONTSET_ASCII (Vdefault_fontset) = default_ascii_font;
- }
AREF (Vfontset_table, 0) = Vdefault_fontset;
next_fontset_id = 1;
+ auto_fontset_alist = Qnil;
+ staticpro (&auto_fontset_alist);
+
DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
doc: /*
Alist of fontname patterns vs the corresponding encoding and repertory info.
Each element looks like (REGEXP . (ENCODING . REPERTORY)),
where ENCODING is a charset or a char-table,
-and REPERTORY is a charset, a char-table, or nil.
+and REPERTORY is a charset, a char-table, or nil.
ENCODING is for converting a character to a glyph code of the font.
If ENCODING is a charset, encoding a character by the charset gives
defsubr (&Sfontset_info);
defsubr (&Sfontset_font);
defsubr (&Sfontset_list);
+#ifdef FONTSET_DEBUG
+ defsubr (&Sfontset_list_all);
+#endif
}
+
+/* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
+ (do not change this comment) */