/* Fontset handler.
Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
Licensed to the Free Software Foundation.
+ Copyright (C) 2001, 2002
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
#endif
#include "lisp.h"
+#include "blockinput.h"
+#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "ccl.h"
+#include "keyboard.h"
#include "frame.h"
#include "dispextern.h"
#include "fontset.h"
#define INLINE
#endif
+EXFUN (Fclear_face_cache, 1);
/* FONTSET
A fontset is a collection of font related information to give
- similar appearance (style, size, etc) of characters. There are two
- kinds of fontsets; base and realized. A base fontset is created by
- new-fontset from Emacs Lisp explicitly. A realized fontset is
+ similar appearance (style, etc) of characters. There are two kinds
+ of fontsets; base and realized. A base fontset is created by
+ `new-fontset' from Emacs Lisp explicitly. A realized fontset is
created implicitly when a face is realized for ASCII characters. A
- face is also realized for multibyte characters based on an ASCII
- face. All of the multibyte faces based on the same ASCII face
- share the same realized fontset.
+ 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.
-
- An element of a base fontset is:
- (INDEX . FONTNAME) or
- (INDEX . (FOUNDRY . REGISTRY ))
- FONTNAME is a font name pattern for the corresponding character.
- FOUNDRY and REGISTRY are respectively foundy and regisry fields of
- a font name for the corresponding character. INDEX specifies for
- which character (or generic character) the element is defined. It
- may be different from an index to access this element. For
- instance, if a fontset defines some font for all characters of
- charset `japanese-jisx0208', INDEX is the generic character of this
- charset. REGISTRY is the
-
- An element of a realized fontset is FACE-ID which is a face to use
- for displaying the correspnding character.
-
- All single byte charaters (ASCII and 8bit-unibyte) share the same
- element in a fontset. The element is stored in `defalt' slot of
- the fontset. And this slot is never used as a default value of
- multibyte characters. That means that the first 256 elements of a
- fontset set is always nil (as this is not efficient, we may
- implement a fontset in a different way in the future).
-
- To access or set each element, use macros FONTSET_REF and
- FONTSET_SET respectively for efficiency.
-
- A fontset has 3 extra slots.
+ A fontset object is implemented by a char-table whose default value
+ and parent are always nil.
+
+ An element of a base fontset is a font specification of the form:
+ [ FAMILY WEIGHT SLANT SWIDTH REGISTRY ] (vector of size 5)
+ or
+ FONT-NAME (strig)
+
+ FAMILY and REGISTRY are strings.
+
+ WEIGHT, SLANT, and SWIDTH must be symbols that set-face-attribute
+ accepts as attribute values for :weight, :slant, :swidth
+ respectively.
+
+
+ A fontset has 7 extra slots.
The 1st slot is an ID number of the fontset.
- The 2nd slot is a name of the fontset. This is nil for a realized
- face.
+ The 2nd slot is a name of the fontset in a base fontset, and nil in
+ a realized fontset.
- The 3rd slot is a frame that the fontset belongs to. This is nil
- for a default face.
+ The 3rd slot is nil in a base fontset, and a base fontset in a
+ realized fontset.
- A parent of a base fontset is nil. A parent of a realized fontset
- is a base fontset.
+ The 4th slot is a frame that the fontset belongs to. This is nil
+ in a base fontset.
- All fontsets (except for the default fontset described below) are
- recorded in Vfontset_table.
+ The 5th slot is a cons of 0 and fontname for ASCII characters in a
+ base fontset, and nil in a realized face.
+
+ The 6th slot is an alist of a charset vs. the corresponding font
+ specification.
+
+ The 7th slot is an alist of a font specification vs. the
+ corresponding face ID. In a base fontset, the face IDs are all
+ nil.
+
+ All fontsets are recorded in Vfontset_table.
DEFAULT FONTSET
- There's a special fontset named `default fontset' which defines a
- default fontname that contains only REGISTRY field for each
- character. When a base fontset doesn't specify a font for a
- specific character, the corresponding value in the default fontset
- is used. The format is the same as a base fontset.
+ There's a special fontset named `default fontset' which defines the
+ default font specifications. When a base fontset doesn't specify a
+ font for a specific character, the corresponding value in the
+ default fontset is used. The format is the same as a base fontset.
- The parent of realized fontsets created for faces that have no
- fontset is the default fontset.
+ The parent of a realized fontset created for such a face that has
+ no fontset is the default fontset.
These structures are hidden from the other codes than this file.
The other codes handle fontsets only by their ID numbers. They
- usually use variable name `fontset' for IDs. But, in this file, we
- always use varialbe name `id' for IDs, and name `fontset' for the
- actual fontset objects.
+ usually use the variable name `fontset' for IDs. But, in this
+ file, we always use varialbe name `id' for IDs, and name `fontset'
+ for the actual fontset objects (i.e. char-table objects).
*/
/* Vector containing all fontsets. */
static Lisp_Object Vfontset_table;
-/* Next possibly free fontset ID. Usually this keeps the mininum
+/* Next possibly free fontset ID. Usually this keeps the minimum
fontset ID not yet used. */
static int next_fontset_id;
/* The default fontset. This gives default FAMILY and REGISTRY of
- font for each characters. */
+ font for each character. */
static Lisp_Object Vdefault_fontset;
Lisp_Object Vfont_encoding_alist;
Lisp_Object Vignore_relative_composition;
Lisp_Object Valternate_fontname_alist;
Lisp_Object Vfontset_alias_alist;
-Lisp_Object Vhighlight_wrong_size_font;
-Lisp_Object Vclip_large_size_font;
Lisp_Object Vvertical_centering_font_regexp;
/* The following six are declarations of callback functions depending
/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
struct font_info *(*get_font_info_func) P_ ((FRAME_PTR f, int font_idx));
-/* Return a list of font names which matches PATTERN. See the document of
- `x-list-fonts' for more detail. */
+/* Return a list of font names which matches PATTERN. See the documentation
+ of `x-list-fonts' for more details. */
Lisp_Object (*list_fonts_func) P_ ((struct frame *f,
Lisp_Object pattern,
int size,
/* To find a CCL program, fs_load_font calls this function.
The argument is a pointer to the struct font_info.
- This function set the memer `encoder' of the structure. */
+ This function set the member `encoder' of the structure. */
void (*find_ccl_program_func) P_ ((struct font_info *));
/* Check if any window system is used now. */
/* Prototype declarations for static functions. */
-static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
-static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
static int fontset_id_valid_p P_ ((int));
static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
-static Lisp_Object font_family_registry P_ ((Lisp_Object));
\f
/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
-/* Macros for Lisp vector. */
-#define AREF(V, IDX) XVECTOR (V)->contents[IDX]
-#define ASIZE(V) XVECTOR (V)->size
-
/* Return the fontset with ID. No check of ID's validness. */
#define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
-/* Macros to access extra, default, and parent slots, of fontset. */
+/* Macros to access special values of FONTSET. */
#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
+
+/* Macros to access special values of (base) FONTSET. */
#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
-#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
-#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->defalt
-#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
+#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
-#define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
+#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_CHARSET_ALIST(fontset) XCHAR_TABLE (fontset)->extras[5]
+#define FONTSET_FACE_ALIST(fontset) XCHAR_TABLE (fontset)->extras[6]
/* Return the element of FONTSET (char-table) at index C (character). */
-#define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
+#define FONTSET_REF(fontset, c, etl) ((elt) = fontset_ref ((fontset), (c)))
-static INLINE Lisp_Object
+static Lisp_Object
fontset_ref (fontset, c)
Lisp_Object fontset;
int c;
{
- int charset, c1, c2;
- Lisp_Object elt, defalt;
- int i;
+ Lisp_Object elt;
- if (SINGLE_BYTE_CHAR_P (c))
- return FONTSET_ASCII (fontset);
-
- SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
- elt = XCHAR_TABLE (fontset)->contents[charset + 128];
- if (!SUB_CHAR_TABLE_P (elt))
- return elt;
- defalt = XCHAR_TABLE (elt)->defalt;
- if (c1 < 32
- || (elt = XCHAR_TABLE (elt)->contents[c1],
- NILP (elt)))
- return defalt;
- if (!SUB_CHAR_TABLE_P (elt))
- return elt;
- defalt = XCHAR_TABLE (elt)->defalt;
- if (c2 < 32
- || (elt = XCHAR_TABLE (elt)->contents[c2],
- NILP (elt)))
- return defalt;
+ while (1)
+ {
+ elt = CHAR_TABLE_REF (fontset, c);
+ if (NILP (elt) && ASCII_CHAR_P (c))
+ elt = FONTSET_ASCII (fontset);
+ if (NILP (elt))
+ {
+ Lisp_Object tail;
+ struct charset *charset;
+
+ for (tail = FONTSET_CHARSET_ALIST (fontset);
+ CONSP (tail); tail = XCDR (tail))
+ {
+ charset = CHARSET_FROM_ID (XCAR (XCAR (tail)));
+ if (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset))
+ {
+ elt = XCDR (XCAR (tail));
+ break;
+ }
+ }
+ }
+ if (! NILP (elt) || EQ (fontset, Vdefault_fontset))
+ break;
+ fontset = Vdefault_fontset;
+ }
return elt;
}
-#define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
-
-static INLINE Lisp_Object
-fontset_ref_via_base (fontset, c)
- Lisp_Object fontset;
- int *c;
-{
- int charset, c1, c2;
- Lisp_Object elt;
- int i;
+/* Set the element of FONTSET at index IDX to the value ELT. IDX may
+ be a character or a charset. */
- if (SINGLE_BYTE_CHAR_P (*c))
- return FONTSET_ASCII (fontset);
+#define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
- elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
- if (NILP (elt))
- return Qnil;
+static void
+fontset_set (fontset, idx, elt)
+ Lisp_Object fontset, idx, elt;
+{
+ if (SYMBOLP (idx))
+ {
+ Lisp_Object id, slot, tail;
+
+ id = make_number (CHARSET_SYMBOL_ID (idx));
+ if (id == charset_ascii)
+ Fset_char_table_range (fontset,
+ Fcons (make_number (0), make_number (127)),
+ elt);
+ else
+ {
+ slot = Fassq (id, FONTSET_CHARSET_ALIST (fontset));
+ if (CONSP (slot))
+ XCDR (slot) = elt;
+ else if (CONSP (FONTSET_CHARSET_ALIST (fontset)))
+ {
+ for (tail = FONTSET_CHARSET_ALIST (fontset);
+ CONSP (XCDR (tail)); tail = XCDR (tail));
+ XCDR (tail) = Fcons (Fcons (id, elt), Qnil);
+ }
+ else
+ FONTSET_CHARSET_ALIST (fontset) = Fcons (Fcons (id, elt), Qnil);
+ }
+ }
+ else
+ {
+ int from = XINT (XCAR (idx));
+ int to = XINT (XCDR (idx));
- *c = XINT (XCAR (elt));
- SPLIT_NON_ASCII_CHAR (*c, charset, c1, c2);
- elt = XCHAR_TABLE (fontset)->contents[charset + 128];
- if (c1 < 32)
- return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
- if (!SUB_CHAR_TABLE_P (elt))
- return Qnil;
- elt = XCHAR_TABLE (elt)->contents[c1];
- if (c2 < 32)
- return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
- if (!SUB_CHAR_TABLE_P (elt))
- return Qnil;
- elt = XCHAR_TABLE (elt)->contents[c2];
- return elt;
+ if (from == to)
+ CHAR_TABLE_SET (fontset, from, elt);
+ else
+ Fset_char_table_range (fontset, idx, elt);
+ }
}
-/* Store into the element of FONTSET at index C the value NEWETL. */
-#define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
+/* Return a face registerd in the realized fontset FONTSET for the
+ character C. Return -1 if a face ID is not yet set. */
-static void
-fontset_set (fontset, c, newelt)
+static struct face *
+fontset_face (fontset, c)
Lisp_Object fontset;
int c;
- Lisp_Object newelt;
{
- int charset, code[3];
- Lisp_Object *elt, tmp;
- int i, j;
+ Lisp_Object base, elt;
+ int id;
+ struct face *face;
- if (SINGLE_BYTE_CHAR_P (c))
- {
- FONTSET_ASCII (fontset) = newelt;
- return;
- }
+ base = FONTSET_BASE (fontset);
+ FONTSET_REF (base, c, elt);
- SPLIT_NON_ASCII_CHAR (c, charset, code[0], code[1]);
- code[2] = 0; /* anchor */
- elt = &XCHAR_TABLE (fontset)->contents[charset + 128];
- for (i = 0; code[i] > 0; i++)
- {
- if (!SUB_CHAR_TABLE_P (*elt))
- *elt = make_sub_char_table (*elt);
- elt = &XCHAR_TABLE (*elt)->contents[code[i]];
- }
- if (SUB_CHAR_TABLE_P (*elt))
- XCHAR_TABLE (*elt)->defalt = newelt;
- else
- *elt = newelt;
+ if (NILP (elt))
+ return NULL;
+
+ elt = Fassoc (elt, FONTSET_FACE_ALIST (fontset));
+ if (! CONSP (elt))
+ return NULL;
+ id = XINT (XCDR (elt));
+ face = FACE_FROM_ID (XFRAME (FONTSET_FRAME (fontset)), id);
+ return face;
}
/* Return a newly created fontset with NAME. If BASE is nil, make a
- base fontset. Otherwise make a realized fontset whose parent is
+ base fontset. Otherwise make a realized fontset whose base is
BASE. */
static Lisp_Object
make_fontset (frame, name, base)
Lisp_Object frame, name, base;
{
- Lisp_Object fontset, elt, base_elt;
+ Lisp_Object fontset;
int size = ASIZE (Vfontset_table);
int id = next_fontset_id;
- int i, j;
/* Find a free slot in Vfontset_table. Usually, next_fontset_id is
the next available fontset ID. So it is expected that this loop
terminates quickly. In addition, as the last element of
- Vfotnset_table is always nil, we don't have to check the range of
+ Vfontset_table is always nil, we don't have to check the range of
id. */
while (!NILP (AREF (Vfontset_table, id))) id++;
if (id + 1 == size)
{
Lisp_Object tem;
- int i;
+ int i;
- tem = Fmake_vector (make_number (size + 8), Qnil);
+ tem = Fmake_vector (make_number (size + 32), Qnil);
for (i = 0; i < size; i++)
AREF (tem, i) = AREF (Vfontset_table, i);
Vfontset_table = tem;
}
- if (NILP (base))
- fontset = Fcopy_sequence (Vdefault_fontset);
- else
- fontset = Fmake_char_table (Qfontset, Qnil);
+ fontset = Fmake_char_table (Qfontset, Qnil);
FONTSET_ID (fontset) = make_number (id);
- FONTSET_NAME (fontset) = name;
- FONTSET_FRAME (fontset) = frame;
- FONTSET_BASE (fontset) = base;
+ if (NILP (base))
+ {
+ FONTSET_NAME (fontset) = name;
+ }
+ else
+ {
+ FONTSET_NAME (fontset) = Qnil;
+ FONTSET_FRAME (fontset) = frame;
+ FONTSET_BASE (fontset) = base;
+ }
- AREF (Vfontset_table, id) = fontset;
+ ASET (Vfontset_table, id, fontset);
next_fontset_id = id + 1;
return fontset;
}
-/* Return 1 if ID is a valid fontset id, else return 0. */
-
-static INLINE int
-fontset_id_valid_p (id)
- int id;
-{
- return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
-}
-
-
-/* Extract `family' and `registry' string from FONTNAME and set in
- *FAMILY and *REGISTRY respectively. Actually, `family' may also
- contain `foundry', `registry' may also contain `encoding' of
- FONTNAME. */
-
-static Lisp_Object
-font_family_registry (fontname)
- Lisp_Object fontname;
-{
- Lisp_Object family, registry;
- char *p = XSTRING (fontname)->data;
- char *sep[15];
- int i = 0;
-
- while (*p && i < 15) if (*p++ == '-') sep[i++] = p;
- if (i != 14)
- return fontname;
-
- family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
- registry = make_unibyte_string (sep[12], p - sep[12]);
- return Fcons (family, registry);
-}
-
\f
-/********** INTERFACES TO xfaces.c and dispextern.h **********/
+/********** INTERFACES TO xfaces.c and dispextern.h **********/
/* Return name of the fontset with ID. */
int id;
{
Lisp_Object fontset;
+
fontset = FONTSET_FROM_ID (id);
return FONTSET_NAME (fontset);
}
fontset_ascii (id)
int id;
{
- Lisp_Object fontset, elt;
+ Lisp_Object fontset;
+
fontset= FONTSET_FROM_ID (id);
- elt = FONTSET_ASCII (fontset);
- return XCDR (elt);
+ return FONTSET_ASCII (fontset);
}
-/* Free fontset of FACE. Called from free_realized_face. */
+/* Free fontset of FACE defined on frame F. Called from
+ free_realized_face. */
void
free_face_fontset (f, face)
FRAME_PTR f;
struct face *face;
{
- if (fontset_id_valid_p (face->fontset))
- {
- AREF (Vfontset_table, face->fontset) = Qnil;
- if (face->fontset < next_fontset_id)
- next_fontset_id = face->fontset;
- }
+ AREF (Vfontset_table, face->fontset) = Qnil;
+ if (face->fontset < next_fontset_id)
+ next_fontset_id = face->fontset;
}
/* Return 1 iff FACE is suitable for displaying character C.
Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
- when C is not a single byte character.. */
+ when C is not an ASCII character. */
int
face_suitable_for_char_p (face, c)
struct face *face;
int c;
{
- Lisp_Object fontset, elt;
-
- if (SINGLE_BYTE_CHAR_P (c))
- return (face == face->ascii_face);
+ Lisp_Object fontset;
- xassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
- xassert (!BASE_FONTSET_P (fontset));
-
- elt = FONTSET_REF_VIA_BASE (fontset, c);
- return (!NILP (elt) && face->id == XFASTINT (elt));
+ return (face == fontset_face (fontset, c));
}
/* Return ID of face suitable for displaying character C on frame F.
The selection of face is done based on the fontset of FACE. FACE
- should already have been realized for ASCII characters. Called
- from the macro FACE_FOR_CHAR when C is not a single byte character. */
+ must be reazlied for ASCII characters in advance. Called from the
+ macro FACE_FOR_CHAR when C is not an ASCII character. */
int
face_for_char (f, face, c)
struct face *face;
int c;
{
- Lisp_Object fontset, elt;
- int face_id;
+ Lisp_Object fontset;
+ struct face *new_face;
xassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
xassert (!BASE_FONTSET_P (fontset));
- elt = FONTSET_REF_VIA_BASE (fontset, c);
- if (!NILP (elt))
- return XINT (elt);
+ new_face = fontset_face (fontset, c);
+ if (new_face)
+ return new_face->id;
/* No face is recorded for C in the fontset of FACE. Make a new
realized face for C that has the same fontset. */
- face_id = lookup_face (f, face->lface, c, face);
-
- /* Record the face ID in FONTSET at the same index as the
- information in the base fontset. */
- FONTSET_SET (fontset, c, make_number (face_id));
- return face_id;
+ return lookup_face (f, face->lface, c, face);
}
FRAME_PTR f;
int base_fontset_id;
{
- Lisp_Object base_fontset, fontset, name, frame;
+ Lisp_Object base_fontset, fontset, frame;
XSETFRAME (frame, f);
if (base_fontset_id >= 0)
base_fontset = Vdefault_fontset;
fontset = make_fontset (frame, Qnil, base_fontset);
- return FONTSET_ID (fontset);
+ return XINT (FONTSET_ID (fontset));
}
-/* Return the font name pattern for C that is recorded in the fontset
- with ID. A font is opened by that pattern to get the fullname. If
- the fullname conform to XLFD, extract foundry-family field and
- registry-encoding field, and return the cons of them. Otherwise
- return the fullname. If ID is -1, or the fontset doesn't contain
- information about C, get the registry and encoding of C from the
- default fontset. Called from choose_face_font. */
+/* Return FONT-SPEC recorded in the fontset of FACE for character C.
+ If FACE is null, or the fontset doesn't contain information about
+ C, get the font name pattern from the default fontset. Called from
+ choose_face_font. */
Lisp_Object
-fontset_font_pattern (f, id, c)
+fontset_font_pattern (f, face, c)
FRAME_PTR f;
- int id, c;
+ struct face *face;
+ int c;
{
- Lisp_Object fontset, elt;
- struct font_info *fontp;
- Lisp_Object family_registry;
-
- elt = Qnil;
- if (fontset_id_valid_p (id))
+ Lisp_Object fontset, base, elt;
+ int id = face ? face->fontset : -1;
+
+ if (id >= 0)
{
fontset = FONTSET_FROM_ID (id);
xassert (!BASE_FONTSET_P (fontset));
- fontset = FONTSET_BASE (fontset);
- elt = FONTSET_REF (fontset, c);
+ base = FONTSET_BASE (fontset);
}
else
- elt = FONTSET_REF (Vdefault_fontset, c);
-
- if (!CONSP (elt))
- return Qnil;
- if (CONSP (XCDR (elt)))
- return XCDR (elt);
-
- /* The fontset specifies only a font name pattern (not cons of
- family and registry). Try to open a font by that pattern and get
- a registry from the full name of the opened font. We ignore
- family name here because it should be wild card in the fontset
- specification. */
- elt = XCDR (elt);
- xassert (STRINGP (elt));
- fontp = FS_LOAD_FONT (f, c, XSTRING (elt)->data, -1);
- if (!fontp)
- return Qnil;
+ {
+ base = Vdefault_fontset;
+ }
- family_registry = font_family_registry (build_string (fontp->full_name));
- if (!CONSP (family_registry))
- return family_registry;
- XCAR (family_registry) = Qnil;
- return family_registry;
+ FONTSET_REF (base, c, elt);
+ if (face && ! NILP (elt))
+ {
+ Lisp_Object slot;
+
+ slot = Fassoc (elt, FONTSET_FACE_ALIST (fontset));
+ if (CONSP (slot))
+ XSETCDR (slot, make_number (face->id));
+ FONTSET_FACE_ALIST (fontset)
+ = Fcons (Fcons (elt, make_number (face->id)),
+ FONTSET_FACE_ALIST (fontset));
+ }
+ return elt;
}
-/* Load a font named FONTNAME to display character C on frame F.
- Return a pointer to the struct font_info of the loaded font. If
- loading fails, return NULL. If FACE is non-zero and a fontset is
- assigned to it, record FACE->id in the fontset for C. If FONTNAME
- is NULL, the name is taken from the fontset of FACE or what
- specified by ID. */
+#if defined(WINDOWSNT) && defined (_MSC_VER)
+#pragma optimize("", off)
+#endif
+
+/* Load a font named FONTNAME on frame F. Return a pointer to the
+ struct font_info of the loaded font. If loading fails, return
+ NULL. */
struct font_info *
-fs_load_font (f, c, fontname, id, face)
+fs_load_font (f, fontname)
FRAME_PTR f;
- int c;
char *fontname;
- int id;
- struct face *face;
{
- Lisp_Object fontset;
- Lisp_Object list, elt;
- int font_idx;
- int size = 0;
+ Lisp_Object tail, elt;
struct font_info *fontp;
- int charset = CHAR_CHARSET (c);
-
- if (face)
- id = face->fontset;
- if (id < 0)
- fontset = Qnil;
- else
- fontset = FONTSET_FROM_ID (id);
-
- if (!NILP (fontset)
- && !BASE_FONTSET_P (fontset))
- {
- elt = FONTSET_REF_VIA_BASE (fontset, c);
- if (!NILP (elt))
- {
- /* A suitable face for C is already recorded, which means
- that a proper font is already loaded. */
- int face_id = XINT (elt);
-
- xassert (face_id == face->id);
- face = FACE_FROM_ID (f, face_id);
- return (*get_font_info_func) (f, face->font_info_id);
- }
-
- if (!fontname && charset == CHARSET_ASCII)
- {
- elt = FONTSET_ASCII (fontset);
- fontname = XSTRING (XCDR (elt))->data;
- }
- }
if (!fontname)
/* No way to get fontname. */
return 0;
- fontp = (*load_font_func) (f, fontname, size);
+ fontp = (*load_font_func) (f, fontname, 0);
if (!fontp)
- return 0;
+ return NULL;
+ fontname = fontp->full_name;
/* Fill in members (charset, vertical_centering, encoding, etc) of
font_info structure that are not set by (*load_font_func). */
- fontp->charset = charset;
-
- fontp->vertical_centering
- = (STRINGP (Vvertical_centering_font_regexp)
- && (fast_c_string_match_ignore_case
- (Vvertical_centering_font_regexp, fontp->full_name) >= 0));
-
- if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
+ for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))
{
- /* The font itself tells which code points to be used. Use this
- encoding for all other charsets. */
- int i;
-
- fontp->encoding[0] = fontp->encoding[1];
- for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
- fontp->encoding[i] = fontp->encoding[1];
- }
- else
- {
- /* The font itself doesn't have information about encoding. */
- int i;
-
- /* At first, set 1 (means 0xA0..0xFF) as the default. */
- fontp->encoding[0] = 1;
- for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
- fontp->encoding[i] = 1;
- /* Then override them by a specification in Vfont_encoding_alist. */
- for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))
+ elt = XCAR (tail);
+ if (STRINGP (XCAR (elt)) && CHARSETP (XCDR (elt))
+ && fast_c_string_match_ignore_case (XCAR (elt), fontname) >= 0)
{
- elt = XCAR (list);
- if (CONSP (elt)
- && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
- && (fast_c_string_match_ignore_case (XCAR (elt), fontname)
- >= 0))
- {
- Lisp_Object tmp;
-
- for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))
- if (CONSP (XCAR (tmp))
- && ((i = get_charset_id (XCAR (XCAR (tmp))))
- >= 0)
- && INTEGERP (XCDR (XCAR (tmp)))
- && XFASTINT (XCDR (XCAR (tmp))) < 4)
- fontp->encoding[i]
- = XFASTINT (XCDR (XCAR (tmp)));
- }
+ fontp->charset = CHARSET_SYMBOL_ID (XCDR (elt));
+ break;
}
}
+ if (! CONSP (tail))
+ return NULL;
- fontp->font_encoder = (struct ccl_program *) 0;
+ fontp->vertical_centering
+ = (STRINGP (Vvertical_centering_font_regexp)
+ && (fast_c_string_match_ignore_case
+ (Vvertical_centering_font_regexp, fontname) >= 0));
+
+ fontp->font_encoder = NULL;
if (find_ccl_program_func)
(*find_ccl_program_func) (fontp);
return fontp;
}
+#if defined(WINDOWSNT) && defined (_MSC_VER)
+#pragma optimize("", on)
+#endif
+
\f
/* Cache data used by fontset_pattern_regexp. The car part is a
pattern string containing at least one wild card, the cdr part is
|| strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
{
/* We must at first update the cached data. */
- char *regex = (char *) alloca (XSTRING (pattern)->size * 2);
+ char *regex = (char *) alloca (XSTRING (pattern)->size * 2 + 3);
char *p0, *p1 = regex;
/* Convert "*" to ".*", "?" to ".". */
Lisp_Object name;
int regexpp;
{
- Lisp_Object fontset, tem;
+ Lisp_Object tem;
int i;
name = Fdowncase (name);
DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
- "Return the name of a fontset that matches PATTERN.\n\
-The value is nil if there is no matching fontset.\n\
-PATTERN can contain `*' or `?' as a wildcard\n\
-just as X font name matching algorithm allows.\n\
-If REGEXPP is non-nil, PATTERN is a regular expression.")
- (pattern, regexpp)
+ doc: /* Return the name of a fontset that matches PATTERN.
+The value is nil if there is no matching fontset.
+PATTERN can contain `*' or `?' as a wildcard
+just as X font name matching algorithm allows.
+If REGEXPP is non-nil, PATTERN is a regular expression. */)
+ (pattern, regexpp)
Lisp_Object pattern, regexpp;
{
Lisp_Object fontset;
(*check_window_system_func) ();
- CHECK_STRING (pattern, 0);
+ CHECK_STRING (pattern);
if (XSTRING (pattern)->size == 0)
return Qnil;
return FONTSET_NAME (fontset);
}
-/* Return a list of base fontset names matching PATTERN on frame F.
- If SIZE is not 0, it is the size (maximum bound width) of fontsets
- to be listed. */
+/* Return a list of base fontset names matching PATTERN on frame F. */
Lisp_Object
list_fontsets (f, pattern, size)
Lisp_Object pattern;
int size;
{
- Lisp_Object frame, regexp, val, tail;
+ Lisp_Object frame, regexp, val;
int id;
XSETFRAME (frame, f);
: strcmp (XSTRING (pattern)->data, name))
continue;
- if (size)
- {
- struct font_info *fontp;
- fontp = FS_LOAD_FONT (f, 0, NULL, id);
- if (!fontp || size != fontp->size)
- continue;
- }
val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
}
return val;
}
-DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
- "Create a new fontset NAME that contains font information in FONTLIST.\n\
-FONTLIST is an alist of charsets vs corresponding font name patterns.")
- (name, fontlist)
- Lisp_Object name, fontlist;
-{
- Lisp_Object fontset, elements, ascii_font;
- Lisp_Object tem, tail, elt;
-
- (*check_window_system_func) ();
-
- CHECK_STRING (name, 0);
- CHECK_LIST (fontlist, 1);
-
- name = Fdowncase (name);
- tem = Fquery_fontset (name, Qnil);
- if (!NILP (tem))
- error ("Fontset `%s' matches the existing fontset `%s'",
- XSTRING (name)->data, XSTRING (tem)->data);
-
- /* Check the validity of FONTLIST while creating a template for
- fontset elements. */
- elements = ascii_font = Qnil;
- for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object family, registry;
- int c, charset;
-
- tem = XCAR (tail);
- if (!CONSP (tem)
- || (charset = get_charset_id (XCAR (tem))) < 0
- || !STRINGP (XCDR (tem)))
- error ("Elements of fontlist must be a cons of charset and font name");
-
- tem = Fdowncase (XCDR (tem));
- if (charset == CHARSET_ASCII)
- ascii_font = tem;
- else
- {
- c = MAKE_CHAR (charset, 0, 0);
- elements = Fcons (Fcons (make_number (c), tem), elements);
- }
- }
-
- if (NILP (ascii_font))
- error ("No ASCII font in the fontlist");
-
- fontset = make_fontset (Qnil, name, Qnil);
- FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);
- for (; CONSP (elements); elements = XCDR (elements))
- {
- elt = XCAR (elements);
- tem = Fcons (XCAR (elt), font_family_registry (XCDR (elt)));
- FONTSET_SET (fontset, XINT (XCAR (elt)), tem);
- }
-
- return Qnil;
-}
-
-/* Clear all elements of FONTSET for multibyte characters. */
+/* Free all realized fontsets whose base fontset is BASE. */
static void
-clear_fontset_elements (fontset)
- Lisp_Object fontset;
+free_realized_fontsets (base)
+ Lisp_Object base;
{
- int i;
-
- for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- XCHAR_TABLE (fontset)->contents[i] = Qnil;
-}
-
+#if 0
+ int id;
-/* Return 1 iff REGISTRY is a valid string as the font registry and
- encoding. It is valid if it doesn't start with `-' and the number
- of `-' in the string is at most 1. */
+ /* For the moment, this doesn't work because free_realized_face
+ doesn't remove FACE from a cache. Until we find a solution, we
+ suppress this code, and simply use Fclear_face_cache even though
+ that is not efficient. */
+ BLOCK_INPUT;
+ for (id = 0; id < ASIZE (Vfontset_table); id++)
+ {
+ Lisp_Object this = AREF (Vfontset_table, id);
-static int
-check_registry_encoding (registry)
- Lisp_Object registry;
-{
- unsigned char *str = XSTRING (registry)->data;
- unsigned char *p = str;
- int i;
+ if (EQ (FONTSET_BASE (this), base))
+ {
+ Lisp_Object tail;
- if (!*p || *p++ == '-')
- return 0;
- for (i = 0; *p; p++)
- if (*p == '-') i++;
- return (i < 2);
+ for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
+ tail = XCDR (tail))
+ {
+ 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);
+ }
+ }
+ }
+ UNBLOCK_INPUT;
+#else /* not 0 */
+ Fclear_face_cache (Qt);
+#endif /* not 0 */
}
if (EQ (name, Qt))
return Vdefault_fontset;
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
id = fs_query_fontset (name, 0);
if (id < 0)
error ("Fontset `%s' does not exist", XSTRING (name)->data);
}
DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
- "Modify fontset NAME to use FONTNAME for character CHAR.\n\
-\n\
-CHAR may be a cons; (FROM . TO), where FROM and TO are\n\
-non-generic characters. In that case, use FONTNAME\n\
-for all characters in the range FROM and TO (inclusive).\n\
-\n\
-If NAME is t, an entry in the default fontset is modified.\n\
-In that case, FONTNAME should be a registry and encoding name\n\
-of a font for CHAR.")
- (name, ch, fontname, frame)
- Lisp_Object name, ch, fontname, frame;
+ doc: /* Modify fontset NAME to use FONT-SPEC for characters of CHARSETS.
+
+CHARSET 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).
+
+FONT-SPEC is be a vector; [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ]
+
+FONT-SPEC may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
+name of a font, REGSITRY is a registry name of a font.
+
+FONT-SPEC may be a font name string. */)
+ (name, charset, font_spec, frame)
+ Lisp_Object name, charset, font_spec, frame;
{
- Lisp_Object fontset, elt;
- Lisp_Object realized;
- int from, to;
- int id;
+ Lisp_Object fontset;
+ Lisp_Object family, registry;
fontset = check_fontset_name (name);
- if (CONSP (ch))
+ if (VECTORP (font_spec))
{
- /* CH should be (FROM . TO) where FROM and TO are non-generic
- characters. */
- CHECK_NUMBER (XCAR (ch), 1);
- CHECK_NUMBER (XCDR (ch), 1);
- from = XINT (XCAR (ch));
- to = XINT (XCDR (ch));
- if (!char_valid_p (from, 0) || !char_valid_p (to, 0))
- error ("Character range should be by non-generic characters.");
- if (!NILP (name)
- && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))
- error ("Can't change font for a single byte character");
- }
- else
- {
- CHECK_NUMBER (ch, 1);
- from = XINT (ch);
- to = from;
+ int i;
+ Lisp_Object val;
+
+ font_spec = Fcopy_sequence (font_spec);
+ for (i = 0; i < 5; i++)
+ {
+ val = Faref (font_spec, make_number (i));
+ if (! NILP (val))
+ {
+ CHECK_STRING (val);
+ ASET (font_spec, i, Fdowncase (val));
+ }
+ }
+ val = Faref (font_spec, make_number (5));
+ CHECK_STRING (val);
+ ASET (font_spec, 5, Fdowncase (val));
}
- if (!char_valid_p (from, 1))
- invalid_character (from);
- if (SINGLE_BYTE_CHAR_P (from))
- error ("Can't change font for a single byte character");
- if (from < to)
+ else if (STRINGP (font_spec))
+ font_spec = Fdowncase (font_spec);
+ else if (CONSP (font_spec))
{
- if (!char_valid_p (to, 1))
- invalid_character (to);
- if (SINGLE_BYTE_CHAR_P (to))
- error ("Can't change font for a single byte character");
+ CHECK_CONS (font_spec);
+ family = XCAR (font_spec);
+ registry = XCDR (font_spec);
+ font_spec = Fmake_vector (make_number (6), Qnil);
+ if (!NILP (family))
+ {
+ CHECK_STRING (family);
+ ASET (font_spec, 0, Fdowncase (family));
+ }
+ CHECK_STRING (registry);
+ ASET (font_spec, 5, Fdowncase (registry));
}
- CHECK_STRING (fontname, 2);
- fontname = Fdowncase (fontname);
- if (fontset == Vdefault_fontset)
+ if (SYMBOLP (charset))
{
- if (!check_registry_encoding (fontname))
- error ("Invalid registry and encoding name: %s",
- XSTRING (fontname)->data);
- elt = Fcons (make_number (from), Fcons (Qnil, fontname));
+ CHECK_CHARSET (charset);
}
else
- elt = Fcons (make_number (from), font_family_registry (fontname));
+ {
+ Lisp_Object from, to;
+
+ /* CHARSET should be (FROM . TO). */
+ from = Fcar (charset);
+ to = Fcdr (charset);
+ CHECK_CHARACTER (from);
+ CHECK_CHARACTER (to);
+ }
/* The arg FRAME is kept for backward compatibility. We only check
the validity. */
if (!NILP (frame))
- CHECK_LIVE_FRAME (frame, 3);
+ CHECK_LIVE_FRAME (frame);
- for (; from <= to; from++)
- FONTSET_SET (fontset, from, elt);
- Foptimize_char_table (fontset);
+ FONTSET_SET (fontset, charset, font_spec);
- /* If there's a realized fontset REALIZED whose parent is FONTSET,
- clear all the elements of REALIZED and free all multibyte faces
- whose fontset is REALIZED. This way, the specified character(s)
- are surely redisplayed by a correct font. */
- for (id = 0; id < ASIZE (Vfontset_table); id++)
- {
- realized = AREF (Vfontset_table, id);
- if (!NILP (realized)
- && !BASE_FONTSET_P (realized)
- && EQ (FONTSET_BASE (realized), fontset))
- {
- FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
- clear_fontset_elements (realized);
- free_realized_multibyte_face (f, id);
- }
- }
+ /* Free all realized fontsets whose base is FONTSET. This way, the
+ specified character(s) are surely redisplayed by a correct
+ font. */
+ free_realized_fontsets (fontset);
return Qnil;
}
+
+DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
+ doc: /* Create a new fontset NAME from font information in FONTLIST.
+
+FONTLIST is an alist of charsets vs corresponding font specifications.
+Each element of FONTLIST has the form (CHARSET . FONT-SPEC), where
+a character of CHARSET is displayed by a font that matches FONT-SPEC.
+
+FONT-SPEC is a vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ], where
+FAMILY is a string specifying the font family,
+WEIGHT is a string specifying the weight of the font,
+SLANT is a string specifying the slant of the font,
+WIDTH is a string specifying the width of the font,
+ADSTYLE is a string specifying the adstyle of the font,
+REGISTRY is a string specifying the charset-registry of the font.
+
+See also the documentation of `set-face-attribute' for the detail of
+these vector elements.
+
+FONT-SPEC may be a font name (string). */)
+ (name, fontlist)
+ Lisp_Object name, fontlist;
+{
+ Lisp_Object fontset, ascii_font;
+ Lisp_Object tem, tail;
+
+ CHECK_STRING (name);
+ CHECK_LIST (fontlist);
+
+ name = Fdowncase (name);
+ tem = Fquery_fontset (name, Qnil);
+ if (! NILP (tem))
+ free_realized_fontsets (tem);
+
+ fontset = make_fontset (Qnil, name, Qnil);
+
+ /* Check the validity of FONTLIST. */
+ ascii_font = Fcdr (Fassq (Qascii, fontlist));
+ if (NILP (ascii_font))
+ error ("No ascii font specified");
+ if (! STRINGP (ascii_font))
+ ascii_font = generate_ascii_font (name, ascii_font);
+
+ fontlist = Fcopy_sequence (fontlist);
+ for (tail = fontlist; ! NILP (tail); tail = Fcdr (tail))
+ Fset_fontset_font (name, Fcar (Fcar (tail)), Fcdr (Fcar (tail)), Qnil);
+
+ FONTSET_ASCII (fontset) = ascii_font;
+
+ return name;
+}
+
+
DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
- "Return information about a font named NAME on frame FRAME.\n\
-If FRAME is omitted or nil, use the selected frame.\n\
-The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
- HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,\n\
-where\n\
- OPENED-NAME is the name used for opening the font,\n\
- FULL-NAME is the full name of the font,\n\
- SIZE is the maximum bound width of the font,\n\
- HEIGHT is the height of the font,\n\
- BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
- RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling\n\
- how to compose characters.\n\
-If the named font is not yet loaded, return nil.")
- (name, frame)
+ doc: /* Return information about a font named NAME on frame FRAME.
+If FRAME is omitted or nil, use the selected frame.
+The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
+ HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
+where
+ OPENED-NAME is the name used for opening the font,
+ FULL-NAME is the full name of the font,
+ SIZE is the maximum bound width of the font,
+ HEIGHT is the height of the font,
+ BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
+ RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
+ how to compose characters.
+If the named font is not yet loaded, return nil. */)
+ (name, frame)
Lisp_Object name, frame;
{
FRAME_PTR f;
(*check_window_system_func) ();
- CHECK_STRING (name, 0);
+ CHECK_STRING (name);
name = Fdowncase (name);
if (NILP (frame))
frame = selected_frame;
- CHECK_LIVE_FRAME (frame, 1);
+ CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
if (!query_font_func)
return info;
}
+
+/* Return 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:
+
+ (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.
+
+ 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,
+ doc: /* For internal use only. */)
+ (position)
+ Lisp_Object position;
+{
+ int pos, pos_byte, dummy;
+ int face_id;
+ int c;
+ Lisp_Object window;
+ struct window *w;
+ struct frame *f;
+ struct face *face;
+
+ 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))
+ 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 = FACE_FROM_ID (f, face_id);
+ return (face->font && face->font_name
+ ? build_string (face->font_name)
+ : Qnil);
+}
+
+
+#if 0 /* unused */
+/* Called from Ffontset_info via map_char_table on each leaf of
+ fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
+ ARG)' and FONT-INFOs have this form:
+ (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
+ The current leaf is indexed by CHARACTER and has value ELT. This
+ function add the information of the current leaf to ARG by
+ appending a new element or modifying the last element.. */
+
+static void
+accumulate_font_info (arg, character, elt)
+ Lisp_Object arg, character, elt;
+{
+ Lisp_Object last, last_char, last_elt;
+
+ if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
+ FONTSET_REF (Vdefault_fontset, XINT (character), elt);
+ if (!CONSP (elt))
+ return;
+ last = XCAR (arg);
+ last_char = XCAR (XCAR (last));
+ last_elt = XCAR (XCDR (XCAR (last)));
+ elt = XCDR (elt);
+ if (!NILP (Fequal (elt, last_elt)))
+ {
+ struct charset *this_charset = CHAR_CHARSET (XINT (character));
+
+ if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */
+ {
+ if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
+ {
+ XSETCDR (last_char, character);
+ return;
+ }
+ }
+ else if (XINT (last_char) == XINT (character))
+ return;
+ else if (this_charset == CHAR_CHARSET (XINT (last_char)))
+ {
+ XSETCAR (XCAR (last), Fcons (last_char, character));
+ return;
+ }
+ }
+ XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil));
+ XSETCAR (arg, XCDR (last));
+}
+#endif /* 0 */
+
DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
- "Return information about a fontset named NAME on frame FRAME.\n\
-If FRAME is omitted or nil, use the selected frame.\n\
-The returned value is a vector of SIZE, HEIGHT, and FONT-LIST,\n\
-where\n\
- SIZE is the maximum bound width of ASCII font of the fontset,\n\
- HEIGHT is the height of the ASCII font in the fontset, and\n\
- FONT-LIST is an alist of the format:\n\
- (CHARSET REQUESTED-FONT-NAME LOADED-FONT-NAME).\n\
-LOADED-FONT-NAME t means the font is not yet loaded, nil means the\n\
-loading failed.")
- (name, frame)
+ doc: /* Return information about a fontset named NAME on frame FRAME.
+The value is a vector:
+ [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],
+where,
+ SIZE is the maximum bound width of ASCII font in the fontset,
+ HEIGHT is the maximum bound height of ASCII font in the fontset,
+ CHARSET-OR-RANGE is a charset or a cons of two characters specifying
+ the range of characters.
+ FONT-SPEC is a fontname pattern string or a vector
+ [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].
+ See the documentation of `new-fontset' for the meanings those elements.
+ OPENEDs are names of fonts actually opened.
+If the ASCII font is not yet opened, SIZE and HEIGHT are 0.
+If FRAME is omitted, it defaults to the currently selected frame. */)
+ (name, frame)
Lisp_Object name, frame;
{
+ Lisp_Object fontset;
FRAME_PTR f;
- Lisp_Object fontset, realized;
- Lisp_Object info, val, loaded, requested;
+ Lisp_Object val, tail, elt;
+ Lisp_Object *realized;
+ struct font_info *fontp = NULL;
+ int n_realized = 0;
int i;
-
+
(*check_window_system_func) ();
fontset = check_fontset_name (name);
if (NILP (frame))
frame = selected_frame;
- CHECK_LIVE_FRAME (frame, 1);
+ CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
- info = Fmake_vector (make_number (3), Qnil);
-
+ /* Recode realized fontsets whose base is FONTSET in the table
+ `realized'. */
+ realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
+ * ASIZE (Vfontset_table));
for (i = 0; i < ASIZE (Vfontset_table); i++)
{
- realized = FONTSET_FROM_ID (i);
- if (!NILP (realized)
- && EQ (FONTSET_FRAME (realized), frame)
- && EQ (FONTSET_BASE (realized), fontset)
- && INTEGERP (FONTSET_ASCII (realized)))
- break;
+ elt = FONTSET_FROM_ID (i);
+ if (!NILP (elt)
+ && EQ (FONTSET_BASE (elt), fontset))
+ realized[n_realized++] = elt;
}
- if (NILP (realized))
- return Qnil;
+ /* Accumulate information of the fontset in VAL. The format is
+ (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
+ FONT-SPEC). See the comment for accumulate_font_info for the
+ detail. */
+ val = Fcons (Fcons (Qascii, Fcons (FONTSET_ASCII (fontset), Qnil)), Qnil);
+ val = Fcons (val, val);
+ for (i = 128; i <= MAX_CHAR; )
+ {
+ Lisp_Object elt;
+ int from, to;
- XVECTOR (info)->contents[0] = Qnil;
- XVECTOR (info)->contents[1] = Qnil;
- loaded = Qnil;
+ elt = char_table_ref_and_range (fontset, i, &from, &to);
+ if (! NILP (elt))
+ {
+ elt = Fcons (Fcons (make_number (from), make_number (to)),
+ Fcons (elt, Qnil));
+ XSETCDR (XCAR (val), Fcons (elt, Qnil));
+ XSETCAR (val, XCDR (XCAR (val)));
+ }
+ i = to + 1;
+ }
- val = Fcons (Fcons (CHARSET_SYMBOL (CHARSET_ASCII),
- Fcons (FONTSET_ASCII (fontset),
- Fcons (loaded, Qnil))),
- Qnil);
- for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
+ for (tail = FONTSET_CHARSET_ALIST (fontset);
+ CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object elt;
- elt = XCHAR_TABLE (fontset)->contents[i + 128];
+ elt = XCAR (tail);
+ elt = Fcons ((INTEGERP (XCAR (elt))
+ ? CHARSET_NAME (CHARSET_FROM_ID (XCAR (elt)))
+ : XCAR (elt)),
+ Fcons (XCDR (elt), Qnil));
+ XSETCDR (XCAR (val), Fcons (elt, Qnil));
+ XSETCAR (val, XCDR (XCAR (val)));
+ }
+
+ val = XCDR (val);
- if (VECTORP (elt))
+ /* If fonts are opened for FONT-SPEC, append the names of the fonts to
+ FONT-SPEC. */
+ for (tail = val; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ for (i = 0; i < n_realized; i++)
{
- int face_id;
- struct face *face;
+ Lisp_Object face_list, fontname;
- if (INTEGERP (AREF (elt, 2))
- && (face_id = XINT (AREF (elt, 2)),
- face = FACE_FROM_ID (f, face_id)))
+ for (face_list = FONTSET_FACE_ALIST (realized[i]);
+ CONSP (face_list); face_list = XCDR (face_list))
{
- struct font_info *fontp;
- fontp = (*get_font_info_func) (f, face->font_info_id);
- requested = build_string (fontp->name);
- loaded = (fontp->full_name
- ? build_string (fontp->full_name)
- : Qnil);
+ int face_id = XINT (XCDR (XCAR (face_list)));
+ struct face *face = FACE_FROM_ID (f, face_id);
+
+ if (face->font && face->font_name)
+ {
+ fontname = build_string (face->font_name);
+ if (NILP (Fmember (fontname, XCDR (XCDR (elt)))))
+ XSETCDR (XCDR (elt), Fcons (fontname, XCDR (XCDR (elt))));
+ }
}
- else
- {
- char *str;
- int family_len = 0, registry_len = 0;
-
- if (STRINGP (AREF (elt, 0)))
- family_len = STRING_BYTES (XSTRING (AREF (elt, 0)));
- if (STRINGP (AREF (elt, 1)))
- registry_len = STRING_BYTES (XSTRING (AREF (elt, 1)));
- str = (char *) alloca (1 + family_len + 3 + registry_len + 1);
- str[0] = '-';
- str[1] = 0;
- if (family_len)
- strcat (str, XSTRING (AREF (elt, 0))->data);
- strcat (str, "-*-");
- if (registry_len)
- strcat (str, XSTRING (AREF (elt, 1))->data);
- requested = build_string (str);
- loaded = Qnil;
- }
- val = Fcons (Fcons (CHARSET_SYMBOL (i),
- Fcons (requested, Fcons (loaded, Qnil))),
- val);
}
}
- XVECTOR (info)->contents[2] = val;
- return info;
+
+ elt = XCDR (XCDR (XCAR (val)));
+ if (CONSP (elt))
+ fontp = (*query_font_func) (f, XSTRING (XCAR (elt))->data);
+ val = Fmake_vector (make_number (3), val);
+ AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0);
+ AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0);
+ return val;
}
DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
- "Return a font name pattern for character CH in fontset NAME.\n\
-If NAME is t, find a font name pattern in the default fontset.")
- (name, ch)
+ 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;
{
- int c, id;
+ int c;
Lisp_Object fontset, elt;
fontset = check_fontset_name (name);
- CHECK_NUMBER (ch, 1);
+ CHECK_CHARACTER (ch);
c = XINT (ch);
- if (!char_valid_p (c, 1))
- invalid_character (c);
-
- elt = FONTSET_REF (fontset, c);
- if (CONSP (elt))
- elt = XCDR (elt);
-
+ FONTSET_REF (fontset, c, elt);
return elt;
}
-
DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
- "Return a list of all defined fontset names.")
- ()
+ doc: /* Return a list of all defined fontset names. */)
+ ()
{
Lisp_Object fontset, list;
int i;
&& BASE_FONTSET_P (fontset))
list = Fcons (FONTSET_NAME (fontset), list);
}
+
return list;
}
void
syms_of_fontset ()
{
- int i;
-
if (!load_font_func)
/* Window system initializer should have set proper functions. */
abort ();
Qfontset = intern ("fontset");
staticpro (&Qfontset);
- Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
+ Fput (Qfontset, Qchar_table_extra_slots, make_number (7));
Vcached_fontset_data = Qnil;
staticpro (&Vcached_fontset_data);
Vfontset_table = Fmake_vector (make_number (32), Qnil);
staticpro (&Vfontset_table);
- next_fontset_id = 0;
Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
staticpro (&Vdefault_fontset);
- FONTSET_ASCII (Vdefault_fontset)
- = Fcons (make_number (0), Fcons (Qnil, build_string ("iso8859-1")));
+ 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;
DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
- "Alist of fontname patterns vs corresponding encoding info.\n\
-Each element looks like (REGEXP . ENCODING-INFO),\n\
- where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
-ENCODING is one of the following integer values:\n\
- 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
- 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
- 2: code points 0x20A0..0x7FFF are used,\n\
- 3: code points 0xA020..0xFF7F are used.");
+ doc: /* Alist of fontname patterns vs corresponding encoding info.
+Each element looks like (REGEXP . CHARSET), where CHARSET is an
+Emacs charset symbol. */);
Vfont_encoding_alist = Qnil;
DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
- "Char table of characters whose ascent values should be ignored.\n\
-If an entry for a character is non-nil, the ascent value of the glyph\n\
-is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.\n\
-\n\
-This affects how a composite character which contains\n\
-such a character is displayed on screen.");
+ doc: /* Char table of characters whose ascent values should be ignored.
+If an entry for a character is non-nil, the ascent value of the glyph
+is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
+
+This affects how a composite character which contains
+such a character is displayed on screen. */);
Vuse_default_ascent = Qnil;
DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
- "Char table of characters which is not composed relatively.\n\
-If an entry for a character is non-nil, a composition sequence\n\
-which contains that character is displayed so that\n\
-the glyph of that character is put without considering\n\
-an ascent and descent value of a previous character.");
+ doc: /* Char table of characters which is not composed relatively.
+If an entry for a character is non-nil, a composition sequence
+which contains that character is displayed so that
+the glyph of that character is put without considering
+an ascent and descent value of a previous character. */);
Vignore_relative_composition = Qnil;
DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
- "Alist of fontname vs list of the alternate fontnames.\n\
-When a specified font name is not found, the corresponding\n\
-alternate fontnames (if any) are tried instead.");
+ doc: /* Alist of fontname vs list of the alternate fontnames.
+When a specified font name is not found, the corresponding
+alternate fontnames (if any) are tried instead. */);
Valternate_fontname_alist = Qnil;
DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
- "Alist of fontset names vs the aliases.");
- Vfontset_alias_alist = Qnil;
-
- DEFVAR_LISP ("highlight-wrong-size-font", &Vhighlight_wrong_size_font,
- "*Non-nil means highlight characters shown in wrong size fonts somehow.\n\
-The way to highlight them depends on window system on which Emacs runs.\n\
-On X11, a rectangle is shown around each such character.");
- Vhighlight_wrong_size_font = Qnil;
-
- DEFVAR_LISP ("clip-large-size-font", &Vclip_large_size_font,
- "*Non-nil means characters shown in overlarge fonts are clipped.\n\
-The height of clipping area is the same as that of an ASCII character.\n\
-The width of the area is the same as that of an ASCII character,\n\
-or twice as wide, depending on the character set's column-width.\n\
-\n\
-If the only font you have for a specific character set is too large,\n\
-and clipping these characters makes them hard to read,\n\
-you can set this variable to nil to display the characters without clipping.\n\
-The drawback is that you will get some garbage left on your screen.");
- Vclip_large_size_font = Qt;
+ doc: /* Alist of fontset names vs the aliases. */);
+ Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
+ build_string ("fontset-default")),
+ Qnil);
DEFVAR_LISP ("vertical-centering-font-regexp",
&Vvertical_centering_font_regexp,
- "*Regexp matching font names that require vertical centering on display.\n\
-When a character is displayed with such fonts, the character is displayed\n\
-at the vertival center of lines.");
+ doc: /* *Regexp matching font names that require vertical centering on display.
+When a character is displayed with such fonts, the character is displayed
+at the vertical center of lines. */);
Vvertical_centering_font_regexp = Qnil;
defsubr (&Squery_fontset);
defsubr (&Snew_fontset);
defsubr (&Sset_fontset_font);
defsubr (&Sfont_info);
+ defsubr (&Sinternal_char_font);
defsubr (&Sfontset_info);
defsubr (&Sfontset_font);
defsubr (&Sfontset_list);
HCoop / bpt / emacs.git / blobdiff