/* Fontset handler.
- Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003, 2006
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* #define FONTSET_DEBUG */
#include <config.h>
-
-#ifdef FONTSET_DEBUG
#include <stdio.h>
-#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 "intervals.h"
#include "fontset.h"
#include "window.h"
#ifdef HAVE_X_WINDOWS
#ifdef WINDOWSNT
#include "w32term.h"
#endif
-#ifdef MAC_OS
-#include "macterm.h"
+#ifdef HAVE_NS
+#include "nsterm.h"
#endif
#include "termhooks.h"
-#ifdef FONTSET_DEBUG
+#include "font.h"
+
#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);
/* 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
- 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.
+ similar appearance (style, etc) of characters. A fontset has two
+ roles. One is to use for the frame parameter `font' as if it is an
+ ASCII font. In that case, Emacs uses the font specified for
+ `ascii' script for the frame's default font.
+
+ Another role, the more important one, is to provide information
+ about which font to use for each non-ASCII character.
+
+ 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 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.
+
+ An element of a base fontset is a vector of FONT-DEFs which itself
+ is a vector [ FONT-SPEC ENCODING REPERTORY ].
+
+ An element of a realized fontset is nil, t, or a vector of this form:
+
+ [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
+ RFONT-DEF0 RFONT-DEF1 ... ]
+
+ RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
+
+ [ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
+
+ RFONT-DEFn are automatically reordered by the current charset
+ priority list.
+
+ 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 object is implemented by a char-table.
+ A fontset has 9 extra slots.
- 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 foundry and registry 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
+ The 1st slot: the ID number of the fontset
- An element of a realized fontset is FACE-ID which is a face to use
- for displaying the corresponding character.
+ The 2nd slot:
+ base: the name of the fontset
+ realized: nil
- All single byte characters (ASCII and 8bit-unibyte) share the same
- element in a fontset. The element is stored in the first element
- of the fontset.
+ The 3rd slot:
+ base: nil
+ realized: the base fontset
- To access or set each element, use macros FONTSET_REF and
- FONTSET_SET respectively for efficiency.
+ The 4th slot:
+ base: nil
+ realized: the frame that the fontset belongs to
- A fontset has 3 extra slots.
+ The 5th slot:
+ base: the font name for ASCII characters
+ realized: nil
- The 1st slot is an ID number of the fontset.
+ The 6th slot:
+ base: nil
+ realized: the ID number of a face to use for characters that
+ has no font in a realized fontset.
- The 2nd slot is a name of the fontset. This is nil for a realized
- face.
+ The 7th slot:
+ base: nil
+ realized: Alist of font index vs the corresponding repertory
+ char-table.
- The 3rd slot is a frame that the fontset belongs to. This is nil
- for a default face.
+ The 8th slot:
+ base: nil
+ realized: If the base is not the default fontset, a fontset
+ realized from the default fontset, else nil.
- A parent of a base fontset is nil. A parent of a realized fontset
- is a base fontset.
+ The 9th slot:
+ base: Same as element value (but for fallback fonts).
+ realized: Likewise.
- All fontsets are recorded in Vfontset_table.
+ All fontsets are recorded in the vector Vfontset_table.
DEFAULT FONTSET
- There's a special fontset named `default fontset' which defines a
- default fontname pattern. 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 base 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 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 variable 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 an actual fontset object, i.e., char-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;
+static Lisp_Object Qlatin;
/* Vector containing all fontsets. */
static Lisp_Object Vfontset_table;
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;
-/* Alist of font specifications. It override the font specification
- in the default fontset. */
-static Lisp_Object Voverriding_fontspec_alist;
-
-Lisp_Object Vfont_encoding_alist;
+Lisp_Object Vfont_encoding_charset_alist;
Lisp_Object Vuse_default_ascent;
Lisp_Object Vignore_relative_composition;
Lisp_Object Valternate_fontname_alist;
Lisp_Object Vfontset_alias_alist;
Lisp_Object Vvertical_centering_font_regexp;
+Lisp_Object Votf_script_alist;
-/* The following six are declarations of callback functions depending
- on window system. See the comments in src/fontset.h for more
- detail. */
-
-/* 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));
+/* Check if any window system is used now. */
+void (*check_window_system_func) P_ ((void));
-/* 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,
- int maxnames));
-/* Load a font named NAME for frame F and return a pointer to the
- information of the loaded font. If loading is failed, return 0. */
-struct font_info *(*load_font_func) P_ ((FRAME_PTR f, char *name, int));
+/* Prototype declarations for static functions. */
+static Lisp_Object fontset_add P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object));
+static Lisp_Object fontset_find_font P_ ((Lisp_Object, int, struct face *,
+ int, int));
+static void reorder_font_vector P_ ((Lisp_Object, struct font *));
+static Lisp_Object fontset_font P_ ((Lisp_Object, int, struct face *, int));
+static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
+static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
+static void accumulate_script_ranges P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object));
+Lisp_Object find_font_encoding P_ ((Lisp_Object));
-/* Return a pointer to struct font_info of a font named NAME for frame F. */
-struct font_info *(*query_font_func) P_ ((FRAME_PTR f, char *name));
+static void set_fontset_font P_ ((Lisp_Object, Lisp_Object));
-/* Additional function for setting fontset or changing fontset
- contents of frame F. */
-void (*set_frame_fontset_func) P_ ((FRAME_PTR f, Lisp_Object arg,
- Lisp_Object oldval));
+#ifdef FONTSET_DEBUG
-/* 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 member `encoder' of the structure. */
-void (*find_ccl_program_func) P_ ((struct font_info *));
+/* Return 1 if ID is a valid fontset id, else return 0. */
-/* Check if any window system is used now. */
-void (*check_window_system_func) P_ ((void));
+static int
+fontset_id_valid_p (id)
+ int id;
+{
+ return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
+}
+#endif
-/* Prototype declarations for static functions. */
-static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
-static Lisp_Object lookup_overriding_fontspec 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, int));
-static Lisp_Object regularize_fontname P_ ((Lisp_Object));
\f
/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
/* Macros to access special values of FONTSET. */
#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
-#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)->contents[0]
-#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
-
-#define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
-
-/* Return the element of FONTSET (char-table) at index C (character). */
-
-#define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
+/* Macros to access special values of (base) FONTSET. */
+#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
+#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
+#define FONTSET_SPEC(fontset) XCHAR_TABLE (fontset)->extras[5]
+
+/* 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_OBJLIST(fontset) XCHAR_TABLE (fontset)->extras[4]
+#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)))
+
+
+/* Macros for FONT-DEF and RFONT-DEF of fontset. */
+#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
+ do { \
+ (font_def) = Fmake_vector (make_number (3), (font_spec)); \
+ ASET ((font_def), 1, encoding); \
+ ASET ((font_def), 2, repertory); \
+ } while (0)
+
+#define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
+#define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
+#define FONT_DEF_REPERTORY(font_def) AREF (font_def, 2)
+
+#define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
+#define RFONT_DEF_SET_FACE(rfont_def, face_id) \
+ ASET ((rfont_def), 0, make_number (face_id))
+#define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
+#define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
+#define RFONT_DEF_REPERTORY(rfont_def) FONT_DEF_REPERTORY (AREF (rfont_def, 1))
+#define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
+#define RFONT_DEF_SET_OBJECT(rfont_def, object) \
+ ASET ((rfont_def), 2, (object))
+#define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3))
+#define RFONT_DEF_SET_SCORE(rfont_def, score) \
+ ASET ((rfont_def), 3, make_number (score))
+#define RFONT_DEF_NEW(rfont_def, font_def) \
+ do { \
+ (rfont_def) = Fmake_vector (make_number (4), Qnil); \
+ ASET ((rfont_def), 1, (font_def)); \
+ RFONT_DEF_SET_SCORE ((rfont_def), 0); \
+ } while (0)
+
+
+/* Return the element of FONTSET for the character C. If FONTSET is a
+ base fontset other then the default fontset and FONTSET doesn't
+ contain information for C, return the information in the default
+ fontset. */
+
+#define FONTSET_REF(fontset, c) \
+ (EQ (fontset, Vdefault_fontset) \
+ ? CHAR_TABLE_REF (fontset, c) \
+ : fontset_ref ((fontset), (c)))
static Lisp_Object
fontset_ref (fontset, c)
Lisp_Object fontset;
int c;
{
- int charset, c1, c2;
- Lisp_Object elt, defalt;
-
- if (SINGLE_BYTE_CHAR_P (c))
- return FONTSET_ASCII (fontset);
-
- SPLIT_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;
+ Lisp_Object elt;
+
+ elt = CHAR_TABLE_REF (fontset, c);
+ if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
+ /* Don't check Vdefault_fontset for a realized fontset. */
+ && NILP (FONTSET_BASE (fontset)))
+ elt = CHAR_TABLE_REF (Vdefault_fontset, c);
return elt;
}
+/* Set elements of FONTSET for characters in RANGE to the value ELT.
+ RANGE is a cons (FROM . TO), where FROM and TO are character codes
+ specifying a range. */
+
+#define FONTSET_SET(fontset, range, elt) \
+ Fset_char_table_range ((fontset), (range), (elt))
+
+
+/* Modify the elements of FONTSET for characters in RANGE by replacing
+ 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) \
+ ? (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
-lookup_overriding_fontspec (frame, c)
- Lisp_Object frame;
- int c;
+fontset_add (fontset, range, elt, add)
+ Lisp_Object fontset, range, elt, add;
{
- Lisp_Object tail;
+ 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 {
+ from1 = from, to1 = to;
+ args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1);
+ 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;
+}
+
+static int
+fontset_compare_rfontdef (val1, val2)
+ const void *val1, *val2;
+{
+ return (RFONT_DEF_SCORE (*(Lisp_Object *) val1)
+ - RFONT_DEF_SCORE (*(Lisp_Object *) val2));
+}
+
+/* Update FONT-GROUP which has this form:
+ [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
+ RFONT-DEF0 RFONT-DEF1 ... ]
+ Reorder RFONT-DEFs according to the current language, and update
+ CHARSET-ORDERED-LIST-TICK.
+
+ If PREFERRED_FAMILY is not nil, that family has the higher priority
+ if the encoding charsets or languages in font-specs are the same. */
+
+extern Lisp_Object Fassoc_string ();
+
+static void
+reorder_font_vector (font_group, font)
+ Lisp_Object font_group;
+ struct font *font;
+{
+ Lisp_Object vec, font_object;
+ int size;
+ int i;
+ int score_changed = 0;
+
+ if (font)
+ XSETFONT (font_object, font);
+ else
+ font_object = Qnil;
+
+ vec = XCDR (font_group);
+ size = ASIZE (vec);
+ /* Exclude the tailing nil element from the reordering. */
+ if (NILP (AREF (vec, size - 1)))
+ size--;
- for (tail = Voverriding_fontspec_alist; CONSP (tail); tail = XCDR (tail))
+ for (i = 0; i < size; i++)
{
- Lisp_Object val, target, elt;
-
- val = XCAR (tail);
- target = XCAR (val);
- val = XCDR (val);
- /* Now VAL is (NO-FRAME-LIST OK-FRAME-LIST CHAR FONTNAME). */
- if (NILP (Fmemq (frame, XCAR (val)))
- && (CHAR_TABLE_P (target)
- ? ! NILP (CHAR_TABLE_REF (target, c))
- : XINT (target) == CHAR_CHARSET (c)))
+ Lisp_Object rfont_def = AREF (vec, i);
+ Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def);
+ Lisp_Object font_spec = FONT_DEF_SPEC (font_def);
+ int score = RFONT_DEF_SCORE (rfont_def) & 0xFF;
+
+ if (! font_match_p (font_spec, font_object))
{
- val = XCDR (val);
- elt = XCDR (val);
- if (NILP (Fmemq (frame, XCAR (val))))
+ Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
+
+ if (! NILP (encoding))
{
- if (! face_font_available_p (XFRAME (frame), XCDR (elt)))
- {
- val = XCDR (XCAR (tail));
- XSETCAR (val, Fcons (frame, XCAR (val)));
- continue;
- }
- XSETCAR (val, Fcons (frame, XCAR (val)));
+ Lisp_Object tail;
+
+ for (tail = Vcharset_ordered_list;
+ ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
+ score += 0x100, tail = XCDR (tail))
+ if (EQ (encoding, XCAR (tail)))
+ break;
}
- if (NILP (XCAR (elt)))
- XSETCAR (elt, make_number (c));
- return elt;
+ else
+ {
+ Lisp_Object lang = Ffont_get (font_spec, QClang);
+
+ if (! NILP (lang)
+ && ! EQ (lang, Vcurrent_iso639_language)
+ && (! CONSP (Vcurrent_iso639_language)
+ || NILP (Fmemq (lang, Vcurrent_iso639_language))))
+ score |= 0x100;
+ }
+ }
+ if (RFONT_DEF_SCORE (rfont_def) != score)
+ {
+ RFONT_DEF_SET_SCORE (rfont_def, score);
+ score_changed = 1;
}
}
- return Qnil;
-}
-#define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
+ if (score_changed)
+ qsort (XVECTOR (vec)->contents, size, sizeof (Lisp_Object),
+ fontset_compare_rfontdef);
+ XSETCAR (font_group, make_number (charset_ordered_list_tick));
+}
static Lisp_Object
-fontset_ref_via_base (fontset, c)
- Lisp_Object fontset;
- int *c;
+fontset_get_font_group (Lisp_Object fontset, int c)
{
- int charset, c1, c2;
- Lisp_Object elt;
+ Lisp_Object font_group;
+ Lisp_Object base_fontset;
+ int from = 0, to = MAX_CHAR, i;
- if (SINGLE_BYTE_CHAR_P (*c))
- return FONTSET_ASCII (fontset);
-
- elt = Qnil;
- if (! EQ (FONTSET_BASE (fontset), Vdefault_fontset))
- elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
- if (NILP (elt))
- elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c);
- if (NILP (elt))
- elt = FONTSET_REF (Vdefault_fontset, *c);
- if (NILP (elt))
+ xassert (! BASE_FONTSET_P (fontset));
+ if (c >= 0)
+ font_group = CHAR_TABLE_REF (fontset, c);
+ else
+ font_group = FONTSET_FALLBACK (fontset);
+ if (! NILP (font_group))
+ return font_group;
+ base_fontset = FONTSET_BASE (fontset);
+ if (c >= 0)
+ font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
+ else
+ font_group = FONTSET_FALLBACK (base_fontset);
+ if (NILP (font_group))
return Qnil;
+ font_group = Fcopy_sequence (font_group);
+ for (i = 0; i < ASIZE (font_group); i++)
+ if (! NILP (AREF (font_group, i)))
+ {
+ Lisp_Object rfont_def;
- *c = XINT (XCAR (elt));
- SPLIT_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;
+ RFONT_DEF_NEW (rfont_def, AREF (font_group, i));
+ /* Remember the original order. */
+ RFONT_DEF_SET_SCORE (rfont_def, i);
+ ASET (font_group, i, rfont_def);
+ }
+ font_group = Fcons (make_number (-1), font_group);
+ if (c >= 0)
+ char_table_set_range (fontset, from, to, font_group);
+ else
+ FONTSET_FALLBACK (fontset) = font_group;
+ return font_group;
}
+/* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
+ character C. If no font is found, return Qnil if there's a
+ possibility that the default fontset or the fallback font groups
+ have a proper font, and return Qt if not.
-/* Store into the element of FONTSET at index C the value NEWELT. */
-#define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
+ If a font is found but is not yet opened, open it (if FACE is not
+ NULL) or return Qnil (if FACE is NULL).
-static void
-fontset_set (fontset, c, newelt)
+ ID is a charset-id that must be preferred, or -1 meaning no
+ preference.
+
+ If FALLBACK is nonzero, search only fallback fonts. */
+
+static Lisp_Object
+fontset_find_font (fontset, c, face, id, fallback)
Lisp_Object fontset;
int c;
- Lisp_Object newelt;
+ struct face *face;
+ int id, fallback;
{
- int charset, code[3];
- Lisp_Object *elt;
- int i;
+ Lisp_Object elt, vec, font_group;
+ int i, charset_matched = -1;
+ FRAME_PTR f = (FRAMEP (FONTSET_FRAME (fontset)))
+ ? XFRAME (selected_frame) : XFRAME (FONTSET_FRAME (fontset));
- if (SINGLE_BYTE_CHAR_P (c))
+ font_group = fontset_get_font_group (fontset, fallback ? -1 : c);
+ if (! CONSP (font_group))
+ return Qnil;
+ vec = XCDR (font_group);
+ if (ASIZE (vec) == 0)
+ return Qnil;
+
+ if (ASIZE (vec) > 1)
{
- FONTSET_ASCII (fontset) = newelt;
- return;
+ if (XINT (XCAR (font_group)) != charset_ordered_list_tick)
+ /* We have just created the font-group,
+ or the charset priorities were changed. */
+ reorder_font_vector (font_group, face->ascii_face->font);
+ if (id >= 0)
+ /* Find a spec matching with the charset ID to try at
+ first. */
+ for (i = 0; i < ASIZE (vec); i++)
+ {
+ Lisp_Object rfont_def = AREF (vec, i);
+ Lisp_Object repertory
+ = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
+
+ if (XINT (repertory) == id)
+ {
+ charset_matched = i;
+ break;
+ }
+ }
}
- SPLIT_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++)
+ /* Find the first available font in the vector of RFONT-DEF. */
+ for (i = 0; i < ASIZE (vec); i++)
{
- if (!SUB_CHAR_TABLE_P (*elt))
+ Lisp_Object font_entity, font_object;
+
+ if (i == 0 && charset_matched >= 0)
+ {
+ /* Try the element matching with the charset ID at first. */
+ elt = AREF (vec, charset_matched);
+ charset_matched = -1;
+ i--;
+ }
+ else if (i != charset_matched)
+ elt = AREF (vec, i);
+ else
+ continue;
+
+ if (NILP (elt))
+ /* This is a sign of not to try the other fonts. */
+ return Qt;
+ if (INTEGERP (RFONT_DEF_FACE (elt))
+ && XINT (AREF (elt, 1)) < 0)
+ /* We couldn't open this font last time. */
+ continue;
+
+ font_object = RFONT_DEF_OBJECT (elt);
+ if (NILP (font_object))
+ {
+ Lisp_Object font_def = RFONT_DEF_FONT_DEF (elt);
+
+ if (! face)
+ /* We have not yet opened the font. */
+ return Qnil;
+ font_entity = font_find_for_lface (f, face->lface,
+ FONT_DEF_SPEC (font_def), -1);
+ if (NILP (font_entity))
+ {
+ /* Record that no font matches the spec. */
+ RFONT_DEF_SET_FACE (elt, -1);
+ continue;
+ }
+ font_object = font_open_for_lface (f, font_entity, face->lface,
+ FONT_DEF_SPEC (font_def));
+ if (NILP (font_object))
+ {
+ /* Record that the font is unsable. */
+ RFONT_DEF_SET_FACE (elt, -1);
+ continue;
+ }
+ RFONT_DEF_SET_OBJECT (elt, font_object);
+ }
+
+ if (font_has_char (f, font_object, c))
+ return elt;
+
+#if 0
+ /* The following code makes Emacs to find a font for C by fairly
+ exhausitive search. But, that takes long time especially for
+ X font backend. */
+
+ /* Try to find the different font maching with the current spec
+ and support C. */
+ font_def = RFONT_DEF_FONT_DEF (elt);
+ for (i++; i < ASIZE (vec); i++)
+ {
+ if (! EQ (RFONT_DEF_FONT_DEF (AREF (vec, i)), font_def))
+ break;
+ if (font_has_char (f, RFONT_DEF_OBJECT (AREF (vec, i)), c))
+ return AREF (vec, i);
+ }
+ /* Find an font-entity that support C. */
+ font_entity = font_find_for_lface (f, face->lface,
+ FONT_DEF_SPEC (font_def), c);
+ if (! NILP (font_entity))
{
- Lisp_Object val = *elt;
- *elt = make_sub_char_table (Qnil);
- XCHAR_TABLE (*elt)->defalt = val;
+ Lisp_Object rfont_def, new_vec;
+ int j;
+
+ font_object = font_open_for_lface (f, font_entity, face->lface,
+ Qnil);
+ RFONT_DEF_NEW (rfont_def, font_def);
+ RFONT_DEF_SET_OBJECT (rfont_def, font_object);
+ RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (elt));
+ new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil);
+ for (j = 0; j < i; j++)
+ ASET (new_vec, j, AREF (vec, j));
+ ASET (new_vec, j, rfont_def);
+ for (j++; j < ASIZE (new_vec); j++)
+ ASET (new_vec, j, AREF (vec, j - 1));
+ vec = new_vec;
+ return rfont_def;
}
- elt = &XCHAR_TABLE (*elt)->contents[code[i]];
+ i--;
+#endif /* 0 */
}
- if (SUB_CHAR_TABLE_P (*elt))
- XCHAR_TABLE (*elt)->defalt = newelt;
- else
- *elt = newelt;
+
+ FONTSET_SET (fontset, make_number (c), make_number (0));
+ return Qnil;
}
+static Lisp_Object
+fontset_font (fontset, c, face, id)
+ Lisp_Object fontset;
+ int c;
+ struct face *face;
+ int id;
+{
+ Lisp_Object rfont_def;
+ Lisp_Object base_fontset;
+
+ /* Try a font-group of FONTSET. */
+ rfont_def = fontset_find_font (fontset, c, face, id, 0);
+ if (VECTORP (rfont_def))
+ return rfont_def;
+ if (EQ (rfont_def, Qt))
+ return Qnil;
+
+ /* Try a font-group of the default fontset. */
+ base_fontset = FONTSET_BASE (fontset);
+ if (! EQ (base_fontset, Vdefault_fontset))
+ {
+ if (NILP (FONTSET_DEFAULT (fontset)))
+ FONTSET_DEFAULT (fontset)
+ = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
+ rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
+ if (VECTORP (rfont_def))
+ return rfont_def;
+ if (EQ (rfont_def, Qt))
+ return Qnil;
+ }
+
+ /* Try a fallback font-group of FONTSET. */
+ rfont_def = fontset_find_font (fontset, c, face, id, 1);
+ if (VECTORP (rfont_def))
+ return rfont_def;
+ if (EQ (rfont_def, Qt))
+ return Qnil;
+
+ /* Try a fallback font-group of the default fontset . */
+ if (! EQ (base_fontset, Vdefault_fontset))
+ {
+ rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
+ if (VECTORP (rfont_def))
+ return rfont_def;
+ }
+
+ /* Remeber that we have no font for C. */
+ FONTSET_SET (fontset, make_number (c), Qt);
+
+ return Qnil;
+}
+
/* 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
while (!NILP (AREF (Vfontset_table, id))) id++;
if (id + 1 == size)
- Vfontset_table = larger_vector (Vfontset_table, size + 8, Qnil);
+ Vfontset_table = larger_vector (Vfontset_table, size + 32, 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 a cons of
- them. Actually, `family' may also contain `foundry', `registry'
- may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't
- conform to XLFD nor explicitely specifies the other fields
- (i.e. not using wildcard `*'), return FONTNAME. If FORCE is
- nonzero, specifications of the other fields are ignored, and return
- a cons as far as FONTNAME conform to XLFD. */
-
-static Lisp_Object
-font_family_registry (fontname, force)
+/* 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;
- int force;
{
- Lisp_Object family, registry;
- const char *p = SDATA (fontname);
- const char *sep[15];
- int i = 0;
-
- while (*p && i < 15)
- if (*p++ == '-')
- {
- if (!force && i >= 2 && i <= 11 && *p != '*' && p[1] != '-')
- return fontname;
- sep[i++] = p;
- }
- if (i != 14)
- return fontname;
+ if (! STRINGP (FONTSET_ASCII (Vdefault_fontset)))
+ {
+ int id = fs_query_fontset (fontname, 2);
- family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
- registry = make_unibyte_string (sep[12], p - sep[12]);
- return Fcons (family, registry);
+ if (id >= 0)
+ fontname = FONTSET_ASCII (FONTSET_FROM_ID (id));
+ FONTSET_ASCII (Vdefault_fontset)= fontname;
+ }
}
\f
-/********** INTERFACES TO xfaces.c and dispextern.h **********/
+/********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
-/* Return name of the fontset with ID. */
+/* Return the name of the fontset who has ID. */
Lisp_Object
fontset_name (id)
int id;
{
Lisp_Object fontset;
+
fontset = FONTSET_FROM_ID (id);
return FONTSET_NAME (fontset);
}
-/* Return ASCII font name of the fontset with ID. */
+/* Return the ASCII font name of the fontset who has ID. */
Lisp_Object
fontset_ascii (id)
int id;
{
Lisp_Object fontset, elt;
+
fontset= FONTSET_FROM_ID (id);
elt = FONTSET_ASCII (fontset);
- return XCDR (elt);
+ if (CONSP (elt))
+ elt = XCAR (elt);
+ return elt;
}
+void
+free_realized_fontset (f, fontset)
+ FRAME_PTR f;
+ Lisp_Object fontset;
+{
+ Lisp_Object tail;
+
+ return;
+ for (tail = FONTSET_OBJLIST (fontset); CONSP (tail); tail = XCDR (tail))
+ {
+ xassert (FONT_OBJECT_P (XCAR (tail)));
+ font_close_object (f, XCAR (tail));
+ }
+}
-/* 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))
+ Lisp_Object fontset;
+
+ fontset = FONTSET_FROM_ID (face->fontset);
+ if (NILP (fontset))
+ return;
+ xassert (! BASE_FONTSET_P (fontset));
+ xassert (f == XFRAME (FONTSET_FRAME (fontset)));
+ free_realized_fontset (f, fontset);
+ ASET (Vfontset_table, face->fontset, Qnil);
+ if (face->fontset < next_fontset_id)
+ next_fontset_id = face->fontset;
+ if (! NILP (FONTSET_DEFAULT (fontset)))
{
- AREF (Vfontset_table, face->fontset) = Qnil;
- if (face->fontset < next_fontset_id)
+ 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)));
+ free_realized_fontset (f, fontset);
+ ASET (Vfontset_table, id, Qnil);
+ if (id < next_fontset_id)
next_fontset_id = face->fontset;
}
+ face->fontset = -1;
}
/* Return 1 if 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, rfont_def;
- 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));
+ rfont_def = fontset_font (fontset, c, NULL, -1);
+ return (VECTORP (rfont_def)
+ && INTEGERP (RFONT_DEF_FACE (rfont_def))
+ && face->id == XINT (RFONT_DEF_FACE (rfont_def)));
}
/* 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. */
+ FACE must be reazlied for ASCII characters in advance. Called from
+ 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, elt;
+ Lisp_Object fontset, rfont_def, charset;
int face_id;
+ int id;
+
+ /* If face->fontset is negative (that happens when no font is found
+ for face), just return face->ascii_face because we can't do
+ anything. Perhaps, we should fix the callers to assure
+ that face->fontset is always valid. */
+ if (ASCII_CHAR_P (c) || face->fontset < 0)
+ return face->ascii_face->id;
xassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
xassert (!BASE_FONTSET_P (fontset));
- elt = FONTSET_REF_VIA_BASE (fontset, c);
- if (!NILP (elt))
- return XINT (elt);
-
- /* 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;
-}
-
-
-/* Make a realized fontset for ASCII face FACE on frame F from the
- base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
- default fontset as the base. Value is the id of the new fontset.
- Called from realize_x_face. */
-
-int
-make_fontset_for_ascii_face (f, base_fontset_id)
- FRAME_PTR f;
- int base_fontset_id;
-{
- Lisp_Object base_fontset, fontset, frame;
-
- XSETFRAME (frame, f);
- if (base_fontset_id >= 0)
+ if (pos < 0)
{
- base_fontset = FONTSET_FROM_ID (base_fontset_id);
- if (!BASE_FONTSET_P (base_fontset))
- base_fontset = FONTSET_BASE (base_fontset);
- xassert (BASE_FONTSET_P (base_fontset));
+ id = -1;
+ charset = Qnil;
}
else
- base_fontset = Vdefault_fontset;
-
- fontset = make_fontset (frame, Qnil, base_fontset);
- return XINT (FONTSET_ID (fontset));
-}
-
-
-/* Return the font name pattern for C that is recorded in the fontset
- with ID. If a font name pattern is specified (instead of a cons of
- family and registry), check if a font can be opened by that pattern
- to get the fullname. If a font is opened, return that name.
- Otherwise, return nil. 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. */
-
-Lisp_Object
-fontset_font_pattern (f, id, c)
- FRAME_PTR f;
- int id, c;
-{
- Lisp_Object fontset, elt;
- struct font_info *fontp;
-
- elt = Qnil;
- if (fontset_id_valid_p (id))
{
- fontset = FONTSET_FROM_ID (id);
- xassert (!BASE_FONTSET_P (fontset));
- fontset = FONTSET_BASE (fontset);
- if (! EQ (fontset, Vdefault_fontset))
- elt = FONTSET_REF (fontset, c);
- }
- if (NILP (elt))
- {
- Lisp_Object frame;
+ charset = Fget_char_property (make_number (pos), Qcharset, object);
+ if (CHARSETP (charset))
+ {
+ Lisp_Object val;
- XSETFRAME (frame, f);
- elt = lookup_overriding_fontspec (frame, c);
+ val = assoc_no_quit (charset, Vfont_encoding_charset_alist);
+ if (CONSP (val) && CHARSETP (XCDR (val)))
+ charset = XCDR (val);
+ id = XINT (CHARSET_SYMBOL_ID (charset));
+ }
+ else
+ id = -1;
}
- if (NILP (elt))
- 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). If a font can be opened by that pattern,
- return the name of opened font. Otherwise return nil. The
- exception is a font for single byte characters. In that case, we
- return a cons of FAMILY and REGISTRY extracted from the opened
- font name. */
- elt = XCDR (elt);
- xassert (STRINGP (elt));
- fontp = FS_LOAD_FONT (f, c, SDATA (elt), -1);
- if (!fontp)
- return Qnil;
-
- return font_family_registry (build_string (fontp->full_name),
- SINGLE_BYTE_CHAR_P (c));
-}
-
-
-#if defined(WINDOWSNT) && defined (_MSC_VER)
-#pragma optimize("", off)
-#endif
-
-/* 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. */
-
-struct font_info *
-fs_load_font (f, c, fontname, id, face)
- FRAME_PTR f;
- int c;
- char *fontname;
- int id;
- struct face *face;
-{
- Lisp_Object fontset;
- Lisp_Object list, elt, fullname;
- int size = 0;
- 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))
+ font_deferred_log ("font for", Fcons (make_number (c), charset), Qnil);
+ rfont_def = fontset_font (fontset, c, face, id);
+ if (VECTORP (rfont_def))
{
- elt = FONTSET_REF_VIA_BASE (fontset, c);
- if (!NILP (elt))
+ if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
+ face_id = XINT (RFONT_DEF_FACE (rfont_def));
+ else
{
- /* A suitable face for C is already recorded, which means
- that a proper font is already loaded. */
- int face_id = XINT (elt);
+ Lisp_Object font_object;
- xassert (face_id == face->id);
- face = FACE_FROM_ID (f, face_id);
- return (*get_font_info_func) (f, face->font_info_id);
+ font_object = RFONT_DEF_OBJECT (rfont_def);
+ face_id = face_for_font (f, font_object, face);
+ RFONT_DEF_SET_FACE (rfont_def, face_id);
}
-
- if (!fontname && charset == CHARSET_ASCII)
+ }
+ else
+ {
+ if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
+ face_id = XINT (FONTSET_NOFONT_FACE (fontset));
+ else
{
- elt = FONTSET_ASCII (fontset);
- fontname = SDATA (XCDR (elt));
+ face_id = face_for_font (f, Qnil, face);
+ FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
}
}
+ xassert (face_id >= 0);
+ return face_id;
+}
- if (!fontname)
- /* No way to get fontname. */
- return 0;
- fontp = (*load_font_func) (f, fontname, size);
- if (!fontp)
- return 0;
+Lisp_Object
+font_for_char (face, c, pos, object)
+ struct face *face;
+ int c, pos;
+ Lisp_Object object;
+{
+ Lisp_Object fontset, rfont_def, charset;
+ int face_id;
+ int id;
- /* Fill in members (charset, vertical_centering, encoding, etc) of
- font_info structure that are not set by (*load_font_func). */
- fontp->charset = charset;
+ if (ASCII_CHAR_P (c))
+ {
+ Lisp_Object font_object;
- fullname = build_string (fontp->full_name);
- fontp->vertical_centering
- = (STRINGP (Vvertical_centering_font_regexp)
- && (fast_string_match_ignore_case
- (Vvertical_centering_font_regexp, fullname) >= 0));
+ XSETFONT (font_object, face->ascii_face->font);
+ return font_object;
+ }
- if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
+ xassert (fontset_id_valid_p (face->fontset));
+ fontset = FONTSET_FROM_ID (face->fontset);
+ xassert (!BASE_FONTSET_P (fontset));
+ if (pos < 0)
{
- /* 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];
+ id = -1;
+ charset = Qnil;
}
else
{
- /* The font itself doesn't have information about encoding. */
- int i;
-
- /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
- others is 1 (i.e. 0x80..0xFF). */
- fontp->encoding[0] = 0;
- 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))
+ charset = Fget_char_property (make_number (pos), Qcharset, object);
+ if (CHARSETP (charset))
{
- elt = XCAR (list);
- if (CONSP (elt)
- && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
- && (fast_string_match_ignore_case (XCAR (elt), fullname) >= 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)));
- }
+ Lisp_Object val;
+
+ val = assoc_no_quit (charset, Vfont_encoding_charset_alist);
+ if (CONSP (val) && CHARSETP (XCDR (val)))
+ charset = XCDR (val);
+ id = XINT (CHARSET_SYMBOL_ID (charset));
}
+ else
+ id = -1;
}
- if (! fontp->font_encoder && find_ccl_program_func)
- (*find_ccl_program_func) (fontp);
-
- /* If we loaded a font for a face that has fontset, record the face
- ID in the fontset for C. */
- if (face
- && !NILP (fontset)
- && !BASE_FONTSET_P (fontset))
- FONTSET_SET (fontset, c, make_number (face->id));
- return fontp;
+ font_deferred_log ("font for", Fcons (make_number (c), charset), Qnil);
+ rfont_def = fontset_font (fontset, c, face, id);
+ return (VECTORP (rfont_def)
+ ? RFONT_DEF_OBJECT (rfont_def)
+ : Qnil);
}
-#if defined(WINDOWSNT) && defined (_MSC_VER)
-#pragma optimize("", on)
-#endif
-/* 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;
+/* Make a realized fontset for ASCII face FACE on frame F from the
+ base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
+ default fontset as the base. Value is the id of the new fontset.
+ Called from realize_x_face. */
+
+int
+make_fontset_for_ascii_face (f, base_fontset_id, face)
+ FRAME_PTR f;
+ int base_fontset_id;
+ struct face *face;
{
- if (! CONSP (FONTSET_ASCII (Vdefault_fontset)))
- {
- int id = fs_query_fontset (fontname, 2);
+ Lisp_Object base_fontset, fontset, frame;
- if (id >= 0)
- fontname = XCDR (FONTSET_ASCII (FONTSET_FROM_ID (id)));
- FONTSET_ASCII (Vdefault_fontset)
- = Fcons (make_number (0), fontname);
+ XSETFRAME (frame, f);
+ if (base_fontset_id >= 0)
+ {
+ base_fontset = FONTSET_FROM_ID (base_fontset_id);
+ if (!BASE_FONTSET_P (base_fontset))
+ base_fontset = FONTSET_BASE (base_fontset);
+ if (! BASE_FONTSET_P (base_fontset))
+ abort ();
}
+ else
+ base_fontset = Vdefault_fontset;
+
+ fontset = make_fontset (frame, Qnil, base_fontset);
+ return XINT (FONTSET_ID (fontset));
}
\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
the corresponding regular expression. */
static Lisp_Object Vcached_fontset_data;
-#define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
+#define CACHED_FONTSET_NAME ((char *) 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 (SDATA (pattern), '*')
- && !index (SDATA (pattern), '?'))
+ if (!index ((char *) SDATA (pattern), '*')
+ && !index ((char *) SDATA (pattern), '?'))
/* PATTERN does not contain any wild cards. */
return Qnil;
if (!CONSP (Vcached_fontset_data)
- || strcmp (SDATA (pattern), CACHED_FONTSET_NAME))
+ || strcmp ((char *) SDATA (pattern), CACHED_FONTSET_NAME))
{
/* We must at first update the cached data. */
unsigned char *regex, *p0, *p1;
- int ndashes = 0, nstars = 0;
+ int ndashes = 0, nstars = 0, nescs = 0;
for (p0 = SDATA (pattern); *p0; p0++)
{
ndashes++;
else if (*p0 == '*')
nstars++;
+ else if (*p0 == '['
+ || *p0 == '.' || *p0 == '\\'
+ || *p0 == '+' || *p0 == '^'
+ || *p0 == '$')
+ nescs++;
}
/* 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);
+ p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
else
- p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 1);
+ p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
*p1++ = '^';
for (p0 = SDATA (pattern); *p0; p0++)
}
else if (*p0 == '?')
*p1++ = '.';
+ else if (*p0 == '['
+ || *p0 == '.' || *p0 == '\\'
+ || *p0 == '+' || *p0 == '^'
+ || *p0 == '$')
+ *p1++ = '\\', *p1++ = *p0;
else
*p1++ = *p0;
}
*p1++ = '$';
*p1++ = 0;
- Vcached_fontset_data = Fcons (build_string (SDATA (pattern)),
- build_string (regex));
+ Vcached_fontset_data = Fcons (build_string ((char *) SDATA (pattern)),
+ build_string ((char *) regex));
}
return CACHED_FONTSET_REGEX;
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 if (name_pattern == 0)
this_name = FONTSET_NAME (fontset);
if (name_pattern == 1
- ? fast_string_match (name, this_name) >= 0
- : !strcmp (SDATA (name), SDATA (this_name)))
+ ? fast_string_match_ignore_case (name, this_name) >= 0
+ : !xstrcasecmp (SDATA (name), SDATA (this_name)))
return i;
}
return -1;
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)
continue;
name = FONTSET_NAME (fontset);
- if (!NILP (regexp)
+ if (STRINGP (regexp)
? (fast_string_match (regexp, name) < 0)
- : strcmp (SDATA (pattern), SDATA (name)))
+ : strcmp ((char *) SDATA (pattern), (char *) SDATA (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,
- doc: /* Create a new fontset NAME that contains font information in FONTLIST.
-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;
- int id;
- (*check_window_system_func) ();
+/* Free all realized fontsets whose base fontset is BASE. */
- CHECK_STRING (name);
- CHECK_LIST (fontlist);
+static void
+free_realized_fontsets (base)
+ Lisp_Object base;
+{
+ int id;
- name = Fdowncase (name);
- id = fs_query_fontset (name, 2);
- if (id >= 0)
+#if 0
+ /* 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++)
{
- fontset = FONTSET_FROM_ID (id);
- tem = FONTSET_NAME (fontset);
- error ("Fontset `%s' matches the existing fontset `%s'",
- SDATA (name), SDATA (tem));
- }
+ Lisp_Object this = AREF (Vfontset_table, id);
- /* Check the validity of FONTLIST while creating a template for
- fontset elements. */
- elements = ascii_font = Qnil;
- for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
- {
- int c, charset;
+ if (EQ (FONTSET_BASE (this), base))
+ {
+ Lisp_Object tail;
- tem = XCAR (tail);
- if (!CONSP (tem)
- || (charset = get_charset_id (XCAR (tem))) < 0
- || (!STRINGP (XCDR (tem)) && !CONSP (XCDR (tem))))
- error ("Elements of fontlist must be a cons of charset and font name pattern");
+ 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);
- tem = XCDR (tem);
- if (STRINGP (tem))
- tem = Fdowncase (tem);
- else
- tem = Fcons (Fdowncase (Fcar (tem)), Fdowncase (Fcdr (tem)));
- if (charset == CHARSET_ASCII)
- ascii_font = tem;
- else
- {
- c = MAKE_CHAR (charset, 0, 0);
- elements = Fcons (Fcons (make_number (c), tem), elements);
+ /* Face THIS itself is also freed by the following call. */
+ free_realized_face (f, face);
+ }
}
}
-
- 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))
+ UNBLOCK_INPUT;
+#else /* not 0 */
+ /* But, we don't have to call Fclear_face_cache if no fontset has
+ been realized from BASE. */
+ for (id = 0; id < ASIZE (Vfontset_table); id++)
{
- elt = XCAR (elements);
- tem = XCDR (elt);
- if (STRINGP (tem))
- tem = font_family_registry (tem, 0);
- tem = Fcons (XCAR (elt), tem);
- FONTSET_SET (fontset, XINT (XCAR (elt)), tem);
- }
-
- return Qnil;
-}
-
-
-/* Clear all elements of FONTSET for multibyte characters. */
-
-static void
-clear_fontset_elements (fontset)
- Lisp_Object fontset;
-{
- int i;
+ Lisp_Object this = AREF (Vfontset_table, id);
- for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- XCHAR_TABLE (fontset)->contents[i] = Qnil;
+ if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
+ {
+ Fclear_face_cache (Qt);
+ break;
+ }
+ }
+#endif /* not 0 */
}
/* Check validity of NAME as a fontset name and return the
corresponding fontset. If not valid, signal an error.
- If NAME is nil, return Vdefault_fontset. */
+ If NAME is t, return Vdefault_fontset. */
static Lisp_Object
check_fontset_name (name)
{
int id;
- if (EQ (name, Qnil))
+ if (EQ (name, Qt))
return Vdefault_fontset;
CHECK_STRING (name);
return FONTSET_FROM_ID (id);
}
-/* Downcase FONTNAME or car and cdr of FONTNAME. If FONTNAME is a
- string, maybe change FONTNAME to (FAMILY . REGISTRY). */
+static void
+accumulate_script_ranges (arg, range, val)
+ Lisp_Object arg, range, val;
+{
+ if (EQ (XCAR (arg), val))
+ {
+ if (CONSP (range))
+ XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
+ else
+ XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
+ }
+}
+
-static Lisp_Object
-regularize_fontname (Lisp_Object fontname)
+/* Return an ASCII font name generated from fontset name NAME and
+ font-spec ASCII_SPEC. NAME is a string conforming to XLFD. */
+
+static INLINE Lisp_Object
+generate_ascii_font_name (name, ascii_spec)
+ Lisp_Object name, ascii_spec;
{
- Lisp_Object family, registry;
+ Lisp_Object font_spec = Ffont_spec (0, NULL);
+ int i;
+ char xlfd[256];
+
+ if (font_parse_xlfd ((char *) SDATA (name), font_spec) < 0)
+ error ("Not an XLFD font name: %s", SDATA (name));
+ for (i = FONT_FOUNDRY_INDEX; i < FONT_EXTRA_INDEX; i++)
+ if (! NILP (AREF (ascii_spec, i)))
+ ASET (font_spec, i, AREF (ascii_spec, i));
+ i = font_unparse_xlfd (font_spec, 0, xlfd, 256);
+ if (i < 0)
+ error ("Not an XLFD font name: %s", SDATA (name));
+ return make_unibyte_string (xlfd, i);
+}
- if (STRINGP (fontname))
- return font_family_registry (Fdowncase (fontname), 0);
+/* 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;
- CHECK_CONS (fontname);
- family = XCAR (fontname);
- registry = XCDR (fontname);
- if (!NILP (family))
- {
- CHECK_STRING (family);
- family = Fdowncase (family);
- }
- if (!NILP (registry))
+/* 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)
{
- CHECK_STRING (registry);
- registry = Fdowncase (registry);
+ 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));
+ }
}
- return Fcons (family, registry);
+ FONTSET_ADD (fontset, range, font_def_arg, add_arg);
}
-DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
- doc: /* Modify fontset NAME to use FONTNAME for CHARACTER.
+extern Lisp_Object QCfamily, QCregistry;
+
+DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
+ 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).
+
+TARGET may be a script name symbol. In that case, use FONT-SPEC for
+all characters that belong to the script.
-If NAME is nil, modify the default fontset.
-CHARACTER may be a cons; (FROM . TO), where FROM and TO are
-non-generic characters. In that case, use FONTNAME
-for all characters in the range FROM and TO (inclusive).
-CHARACTER may be a charset. In that case, use FONTNAME
-for all character in the charsets.
+TARGET may be a charset. In that case, use FONT-SPEC for all
+characters in the charset.
-FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
-name of a font, REGISTRY is a registry name of a font. */)
- (name, character, fontname, frame)
- Lisp_Object name, character, fontname, frame;
+TARGET may be nil. In that case, use FONT-SPEC for any characters for
+that no FONT-SPEC is specified.
+
+FONT-SPEC may one of these:
+ * A font-spec object made by the function `font-spec' (which see).
+ * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
+ REGISTRY is a font registry name. FAMILY may contain foundry
+ name, and REGISTRY may contain encoding name.
+ * A font name string.
+ * nil, which explicitly specifies that there's no font for TARGET.
+
+Optional 4th argument FRAME, if non-nil, is a frame. This argument is
+kept for backward compatibility and has no meaning.
+
+Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
+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, target, font_spec, frame, add)
+ Lisp_Object name, target, font_spec, frame, add;
{
- Lisp_Object fontset, elt;
- Lisp_Object realized;
- int from, to;
- int id;
+ Lisp_Object fontset;
+ Lisp_Object font_def, registry, family;
+ Lisp_Object range_list;
+ struct charset *charset = NULL;
fontset = check_fontset_name (name);
- if (CONSP (character))
+ /* The arg FRAME is kept for backward compatibility. We only check
+ the validity. */
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame);
+
+ if (CONSP (font_spec))
{
- /* CH should be (FROM . TO) where FROM and TO are non-generic
- characters. */
- CHECK_NUMBER_CAR (character);
- CHECK_NUMBER_CDR (character);
- from = XINT (XCAR (character));
- to = XINT (XCDR (character));
- 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");
+ Lisp_Object spec = Ffont_spec (0, NULL);
+
+ font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
+ font_spec = spec;
}
- else if (SYMBOLP (character))
+ else if (STRINGP (font_spec))
{
- elt = Fget (character, Qcharset);
- if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0)))
- error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character)));
- from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0);
- to = from;
+ Lisp_Object args[2];
+ extern Lisp_Object QCname;
+
+ args[0] = QCname;
+ args[1] = font_spec;
+ font_spec = Ffont_spec (2, args);
}
- else
+ else if (! NILP (font_spec) && ! FONT_SPEC_P (font_spec))
+ Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
+
+ if (! NILP (font_spec))
{
- CHECK_NUMBER (character);
- from = XINT (character);
- to = from;
+ Lisp_Object encoding, repertory;
+
+ family = AREF (font_spec, FONT_FAMILY_INDEX);
+ if (! NILP (family) )
+ family = SYMBOL_NAME (family);
+ registry = AREF (font_spec, FONT_REGISTRY_INDEX);
+ if (! NILP (registry))
+ registry = Fdowncase (SYMBOL_NAME (registry));
+ encoding = find_font_encoding (concat3 (family, build_string ("-"),
+ registry));
+ if (NILP (encoding))
+ encoding = Qascii;
+
+ if (SYMBOLP (encoding))
+ {
+ CHECK_CHARSET (encoding);
+ encoding = repertory = CHARSET_SYMBOL_ID (encoding);
+ }
+ else
+ {
+ repertory = XCDR (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_NEW (font_def, font_spec, encoding, repertory);
}
- 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
+ font_def = Qnil;
+
+ if (CHARACTERP (target))
+ range_list = Fcons (Fcons (target, target), Qnil);
+ else if (CONSP (target))
{
- 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");
+ Lisp_Object from, to;
+
+ from = Fcar (target);
+ to = Fcdr (target);
+ CHECK_CHARACTER (from);
+ CHECK_CHARACTER (to);
+ range_list = Fcons (target, Qnil);
}
+ else if (SYMBOLP (target) && !NILP (target))
+ {
+ Lisp_Object script_list;
+ Lisp_Object val;
- /* The arg FRAME is kept for backward compatibility. We only check
- the validity. */
- if (!NILP (frame))
- CHECK_LIVE_FRAME (frame);
+ range_list = Qnil;
+ script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
+ if (! NILP (Fmemq (target, script_list)))
+ {
+ val = Fcons (target, Qnil);
+ map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
+ val);
+ range_list = XCDR (val);
+ if (EQ (target, Qlatin) && NILP (FONTSET_ASCII (fontset)))
+ {
+ if (VECTORP (font_spec))
+ val = generate_ascii_font_name (FONTSET_NAME (fontset),
+ font_spec);
+ else
+ val = font_spec;
+ FONTSET_ASCII (fontset) = val;
+ }
+ }
+ if (CHARSETP (target))
+ {
+ if (EQ (target, Qascii) && NILP (FONTSET_ASCII (fontset)))
+ {
+ if (VECTORP (font_spec))
+ font_spec = generate_ascii_font_name (FONTSET_NAME (fontset),
+ font_spec);
+ FONTSET_ASCII (fontset) = font_spec;
+ range_list = Fcons (Fcons (make_number (0), make_number (127)),
+ Qnil);
+ }
+ else
+ {
+ CHECK_CHARSET_GET_CHARSET (target, charset);
+ }
+ }
+ else if (NILP (range_list))
+ error ("Invalid script or charset name: %s",
+ SDATA (SYMBOL_NAME (target)));
+ }
+ else if (NILP (target))
+ range_list = Fcons (Qnil, Qnil);
+ else
+ error ("Invalid target for setting a font");
- elt = Fcons (make_number (from), regularize_fontname (fontname));
- for (; from <= to; from++)
- FONTSET_SET (fontset, from, elt);
- Foptimize_char_table (fontset);
- /* 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++)
+ if (charset)
{
- 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);
- }
+ 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);
+
+ /* 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 ("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.
-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;
- struct font_info *fontp;
- Lisp_Object info;
- (*check_window_system_func) ();
+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 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 one of
+FONT-SPEC.
+
+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. */)
+ (name, fontlist)
+ Lisp_Object name, fontlist;
+{
+ Lisp_Object fontset;
+ int id;
CHECK_STRING (name);
+ CHECK_LIST (fontlist);
+
name = Fdowncase (name);
- if (NILP (frame))
- frame = selected_frame;
- CHECK_LIVE_FRAME (frame);
- f = XFRAME (frame);
+ id = fs_query_fontset (name, 0);
+ if (id < 0)
+ {
+ Lisp_Object font_spec = Ffont_spec (0, NULL);
+ Lisp_Object short_name;
+ char xlfd[256];
+ int len;
+
+ if (font_parse_xlfd ((char *) SDATA (name), font_spec) < 0)
+ error ("Fontset name must be in XLFD format");
+ short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
+ if (strncmp ((char *) SDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
+ || SBYTES (SYMBOL_NAME (short_name)) < 9)
+ error ("Registry field of fontset name must be \"fontset-*\"");
+ Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
+ Vfontset_alias_alist);
+ ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
+ fontset = make_fontset (Qnil, name, Qnil);
+ len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
+ if (len < 0)
+ error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
+ FONTSET_ASCII (fontset) = make_unibyte_string (xlfd, len);
+ }
+ else
+ {
+ fontset = FONTSET_FROM_ID (id);;
+ free_realized_fontsets (fontset);
+ Fset_char_table_range (fontset, Qt, Qnil);
+ }
+
+ for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
+ {
+ Lisp_Object elt, script;
+
+ elt = Fcar (fontlist);
+ script = Fcar (elt);
+ elt = Fcdr (elt);
+ 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;
+}
- if (!query_font_func)
- error ("Font query function is not supported");
- fontp = (*query_font_func) (f, SDATA (name));
- if (!fontp)
- return Qnil;
+/* Alist of automatically created fontsets. Each element is a cons
+ (FONT-SPEC . FONTSET-ID). */
+static Lisp_Object auto_fontset_alist;
- info = Fmake_vector (make_number (7), Qnil);
+int
+fontset_from_font (font_object)
+ Lisp_Object font_object;
+{
+ Lisp_Object font_name = font_get_name (font_object);
+ Lisp_Object font_spec = Fcopy_font_spec (font_object);
+ Lisp_Object fontset_spec, alias, name, fontset;
+ Lisp_Object val;
+ int i;
- XVECTOR (info)->contents[0] = build_string (fontp->name);
- XVECTOR (info)->contents[1] = build_string (fontp->full_name);
- XVECTOR (info)->contents[2] = make_number (fontp->size);
- XVECTOR (info)->contents[3] = make_number (fontp->height);
- XVECTOR (info)->contents[4] = make_number (fontp->baseline_offset);
- XVECTOR (info)->contents[5] = make_number (fontp->relative_compose);
- XVECTOR (info)->contents[6] = make_number (fontp->default_ascent);
+ val = assoc_no_quit (font_spec, auto_fontset_alist);
+ if (CONSP (val))
+ return XINT (FONTSET_ID (XCDR (val)));
+ if (NILP (auto_fontset_alist))
+ alias = intern ("fontset-startup");
+ else
+ {
+ char temp[32];
+ int len = XINT (Flength (auto_fontset_alist));
- return info;
-}
+ sprintf (temp, "fontset-auto%d", len);
+ alias = intern (temp);
+ }
+ fontset_spec = Fcopy_font_spec (font_spec);
+ ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
+ name = Ffont_xlfd_name (fontset_spec, Qnil);
+ if (NILP (name))
+ abort ();
+ fontset = make_fontset (Qnil, name, Qnil);
+ Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
+ Vfontset_alias_alist);
+ alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
+ Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
+ auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
+ FONTSET_ASCII (fontset) = font_name;
+ font_spec = Fcopy_font_spec (font_spec);
+ ASET (font_spec, FONT_REGISTRY_INDEX, Qiso10646_1);
+ for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
+ ASET (font_spec, i, Qnil);
+ Fset_fontset_font (name, Qlatin, font_spec, Qnil, Qnil);
+ Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
+
+#ifdef HAVE_NS
+ nsfont_make_fontset_for_font(name, font_object);
+#endif
+ return XINT (FONTSET_ID (fontset));
+}
-/* Return a cons (FONT-NAME . GLYPH-CODE).
- FONT-NAME is the font name for the character at POSITION in the current
+/* Return a cons (FONT-OBJECT . GLYPH-CODE).
+ FONT-OBJECT is the font for the character at POSITION in the current
buffer. This is computed from all the text properties and overlays
that apply to POSITION. POSTION may be nil, in which case,
- FONT-NAME is the font name for display the character CH with the
+ FONT-SPEC is the font for displaying the character CH with the
default face.
GLYPH-CODE is the glyph code in the font to use for the character.
(position, ch)
Lisp_Object position, ch;
{
- int pos, pos_byte, dummy;
+ EMACS_INT pos, pos_byte, dummy;
int face_id;
- int c, code;
+ int c;
struct frame *f;
struct face *face;
+ int cs_id;
if (NILP (position))
{
- CHECK_NATNUM (ch);
+ CHECK_CHARACTER (ch);
c = XINT (ch);
f = XFRAME (selected_frame);
- face_id = DEFAULT_FACE_ID;
+ face_id = lookup_basic_face (f, DEFAULT_FACE_ID);
+ pos = -1;
+ cs_id = -1;
}
else
{
- Lisp_Object window;
+ Lisp_Object window, charset;
struct window *w;
CHECK_NUMBER_COERCE_MARKER (position);
w = XWINDOW (window);
f = XFRAME (w->frame);
face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
+ charset = Fget_char_property (position, Qcharset, Qnil);
+ if (CHARSETP (charset))
+ cs_id = XINT (CHARSET_SYMBOL_ID (charset));
+ else
+ cs_id = -1;
}
if (! CHAR_VALID_P (c, 0))
return Qnil;
- 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);
- if (! face->font || ! face->font_name)
- return Qnil;
+ if (face->font)
+ {
+ unsigned code = face->font->driver->encode_char (face->font, c);
+ Lisp_Object font_object;
+ /* Assignment to EMACS_INT stops GCC whining about limited range
+ of data type. */
+ EMACS_INT cod = code;
- {
- struct font_info *fontp = (*get_font_info_func) (f, face->font_info_id);
- XChar2b char2b;
- int c1, c2, charset;
-
- SPLIT_CHAR (c, charset, c1, c2);
- if (c2 > 0)
- STORE_XCHAR2B (&char2b, c1, c2);
- else
- STORE_XCHAR2B (&char2b, 0, c1);
- FRAME_RIF (f)->encode_char (c, &char2b, fontp, NULL);
- code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b);
- }
- return Fcons (build_string (face->font_name), make_number (code));
+ if (code == FONT_INVALID_CODE)
+ return Qnil;
+ XSETFONT (font_object, face->font);
+ if (cod <= MOST_POSITIVE_FIXNUM)
+ return Fcons (font_object, make_number (code));
+ return Fcons (font_object, Fcons (make_number (code >> 16),
+ make_number (code & 0xFFFF)));
+ }
+ return Qnil;
}
-/* Called from Ffontset_info via map_char_table on each leaf of
- fontset. ARG is a copy of the default fontset. The current leaf
- is indexed by CHARACTER and has value ELT. This function override
- the copy by ELT if ELT is not nil. */
-
-static void
-override_font_info (fontset, character, elt)
- Lisp_Object fontset, character, elt;
-{
- if (! NILP (elt))
- Faset (fontset, character, elt);
-}
+DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
+ doc: /* Return information about a fontset FONTSET on frame FRAME.
+The value is a char-table whose elements have this form:
-/* 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. */
+ ((FONT-PATTERN OPENED-FONT ...) ...)
-static void
-accumulate_font_info (arg, character, elt)
- Lisp_Object arg, character, elt;
-{
- Lisp_Object last, last_char, last_elt;
+FONT-PATTERN is a vector:
- if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
- elt = FONTSET_REF (Vdefault_fontset, XINT (character));
- 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)))
- {
- int this_charset = CHAR_CHARSET (XINT (character));
+ [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
- 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));
-}
+or a string of font name pattern.
+OPENED-FONT is a name of a font actually opened.
-DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
- doc: /* Return information about a fontset named NAME on frame FRAME.
-If NAME is nil, return information about the default fontset.
-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, a character (may be a generic character)
- or a cons of two characters specifying the range of characters.
- FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),
- where FAMILY is a `FAMILY' field of a XLFD font name,
- REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.
- FAMILY may contain a `FOUNDRY' field at the head.
- REGISTRY may contain a `CHARSET_ENCODING' field at the tail.
- 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;
+The char-table has one extra slot. The value is a char-table
+containing the information about the derived fonts from the default
+fontset. The format is the same as above. */)
+ (fontset, frame)
+ Lisp_Object fontset, frame;
{
- Lisp_Object fontset;
FRAME_PTR f;
- int indices[3];
- Lisp_Object val, tail, elt;
- Lisp_Object *realized;
- struct font_info *fontp = NULL;
- int n_realized = 0;
- int i;
+ Lisp_Object *realized[2], fontsets[2], tables[2];
+ Lisp_Object val, elt;
+ int c, i, j, k;
(*check_window_system_func) ();
- fontset = check_fontset_name (name);
+ fontset = check_fontset_name (fontset);
if (NILP (frame))
frame = selected_frame;
CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
- /* 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++)
+ /* Recode fontsets realized on FRAME from the base fontset FONTSET
+ in the table `realized'. */
+ 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))
- realized[n_realized++] = elt;
+ && EQ (FONTSET_BASE (elt), fontset)
+ && EQ (FONTSET_FRAME (elt), frame))
+ realized[0][j++] = elt;
}
+ realized[0][j] = Qnil;
- if (! EQ (fontset, Vdefault_fontset))
+ realized[1] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
+ * ASIZE (Vfontset_table));
+ for (i = j = 0; ! NILP (realized[0][i]); i++)
{
- /* Merge FONTSET onto the default fontset. */
- val = Fcopy_sequence (Vdefault_fontset);
- map_char_table (override_font_info, Qnil, fontset, fontset, val, 0, indices);
- fontset = val;
+ 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;
- /* 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 (make_number (0),
- Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
- Qnil);
- val = Fcons (val, val);
- map_char_table (accumulate_font_info, Qnil, fontset, fontset, val, 0, indices);
- val = XCDR (val);
-
- /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
- character for a charset, replace it with the charset symbol. If
- fonts are opened for FONT-SPEC, append the names of the fonts to
- FONT-SPEC. */
- for (tail = val; CONSP (tail); tail = XCDR (tail))
+ /* Accumulate information of the fontset in TABLE. The format of
+ each element is ((FONT-SPEC OPENED-FONT ...) ...). */
+ for (k = 0; k <= 1; k++)
{
- int c;
- elt = XCAR (tail);
- if (INTEGERP (XCAR (elt)))
- {
- int charset, c1, c2;
- c = XINT (XCAR (elt));
- SPLIT_CHAR (c, charset, c1, c2);
- if (c1 == 0)
- XSETCAR (elt, CHARSET_SYMBOL (charset));
- }
- else
- c = XINT (XCAR (XCAR (elt)));
- for (i = 0; i < n_realized; i++)
+ for (c = 0; c <= MAX_CHAR; )
{
- Lisp_Object face_id, font;
- struct face *face;
+ int from = c, to = MAX_5_BYTE_CHAR;
- face_id = FONTSET_REF_VIA_BASE (realized[i], c);
- if (INTEGERP (face_id))
+ if (c <= MAX_5_BYTE_CHAR)
+ {
+ val = char_table_ref_and_range (fontsets[k], c, &from, &to);
+ }
+ else
{
- face = FACE_FROM_ID (f, XINT (face_id));
- if (face && face->font && face->font_name)
+ 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++)
+ if (! NILP (AREF (val, i)))
+ alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
+ alist);
+ alist = Fnreverse (alist);
+
+ /* Then store opened 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: [int ? [FACE-ID FONT-DEF FONT-OBJECT int] ... ] */
+ for (j = 2; j < ASIZE (val); j++)
+ {
+ elt = AREF (val, j);
+ if (FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
+ {
+ Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
+ Lisp_Object slot, name;
+
+ slot = Fassq (RFONT_DEF_SPEC (elt), alist);
+ name = AREF (font_object, FONT_NAME_INDEX);
+ if (NILP (Fmember (name, XCDR (slot))))
+ nconc2 (slot, Fcons (name, Qnil));
+ }
+ }
+ }
+
+ /* 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;
+
+ /* At last, change each elements to font names. */
+ for (; CONSP (alist); alist = XCDR (alist))
{
- font = build_string (face->font_name);
- if (NILP (Fmember (font, XCDR (XCDR (elt)))))
- XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt))));
+ elt = XCAR (alist);
+ XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
}
}
+ c = to + 1;
}
}
- elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val)));
- if (CONSP (elt))
- {
- elt = XCAR (elt);
- fontp = (*query_font_func) (f, SDATA (elt));
- }
- 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;
+ 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 nil, 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_NUMBER (ch);
+ 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);
+ 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));
- return elt;
+ 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;
}
-DEFUN ("set-overriding-fontspec-internal", Fset_overriding_fontspec_internal,
- Sset_overriding_fontspec_internal, 1, 1, 0,
- doc: /* Internal use only.
-
-FONTLIST is an alist of TARGET vs FONTNAME, where TARGET is a charset
-or a char-table, FONTNAME have the same meanings as in
-`set-fontset-font'.
-It overrides the font specifications for each TARGET in the default
-fontset by the corresponding FONTNAME.
-
-If TARGET is a charset, targets are all characters in the charset. If
-TARGET is a char-table, targets are characters whose value is non-nil
-in the table.
+#ifdef FONTSET_DEBUG
-It is intended that this function is called only from
-`set-language-environment'. */)
- (fontlist)
- Lisp_Object fontlist;
+Lisp_Object
+dump_fontset (fontset)
+ Lisp_Object fontset;
{
- Lisp_Object tail;
+ Lisp_Object vec;
+
+ vec = Fmake_vector (make_number (3), Qnil);
+ ASET (vec, 0, FONTSET_ID (fontset));
- fontlist = Fcopy_sequence (fontlist);
- /* Now FONTLIST is ((TARGET . FONTNAME) ...). Reform it to ((TARGET
- nil nil nil FONTSPEC) ...), where TARGET is a charset-id or a
- char-table. */
- for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
+ if (BASE_FONTSET_P (fontset))
{
- Lisp_Object elt, target;
+ ASET (vec, 1, FONTSET_NAME (fontset));
+ }
+ else
+ {
+ Lisp_Object frame;
- elt = XCAR (tail);
- target = Fcar (elt);
- elt = Fcons (Qnil, regularize_fontname (Fcdr (elt)));
- if (! CHAR_TABLE_P (target))
+ frame = FONTSET_FRAME (fontset);
+ if (FRAMEP (frame))
{
- int charset, c;
-
- CHECK_SYMBOL (target);
- charset = get_charset_id (target);
- if (charset < 0)
- error ("Invalid charset %s", SDATA (SYMBOL_NAME (target)));
- target = make_number (charset);
- c = MAKE_CHAR (charset, 0, 0);
- XSETCAR (elt, make_number (c));
+ FRAME_PTR f = XFRAME (frame);
+
+ if (FRAME_LIVE_P (f))
+ ASET (vec, 1,
+ Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), f->name));
+ else
+ ASET (vec, 1,
+ Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
}
- elt = Fcons (target, Fcons (Qnil, Fcons (Qnil, elt)));
- XSETCAR (tail, elt);
+ if (!NILP (FONTSET_DEFAULT (fontset)))
+ ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
}
- if (! NILP (Fequal (fontlist, Voverriding_fontspec_alist)))
- return Qnil;
- Voverriding_fontspec_alist = fontlist;
- clear_face_cache (0);
- ++windows_or_buffers_changed;
- return Qnil;
+ 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 ()
{
- if (!load_font_func)
- /* Window system initializer should have set proper functions. */
- abort ();
+ DEFSYM (Qfontset, "fontset");
+ Fput (Qfontset, Qchar_table_extra_slots, make_number (9));
+ DEFSYM (Qfontset_info, "fontset-info");
+ Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
- Qfontset = intern ("fontset");
- staticpro (&Qfontset);
- Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
+ DEFSYM (Qprepend, "prepend");
+ DEFSYM (Qappend, "append");
+ DEFSYM (Qlatin, "latin");
Vcached_fontset_data = Qnil;
staticpro (&Vcached_fontset_data);
FONTSET_ID (Vdefault_fontset) = make_number (0);
FONTSET_NAME (Vdefault_fontset)
= build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
- AREF (Vfontset_table, 0) = Vdefault_fontset;
+ ASET (Vfontset_table, 0, Vdefault_fontset);
next_fontset_id = 1;
- Voverriding_fontspec_alist = Qnil;
- staticpro (&Voverriding_fontspec_alist);
-
- DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
- doc: /* Alist of fontname patterns vs corresponding encoding info.
-Each element looks like (REGEXP . ENCODING-INFO),
- where ENCODING-INFO is an alist of CHARSET vs ENCODING.
-ENCODING is one of the following integer values:
- 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,
- 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,
- 2: code points 0x20A0..0x7FFF are used,
- 3: code points 0xA020..0xFF7F are used. */);
- Vfont_encoding_alist = Qnil;
- Vfont_encoding_alist
- = Fcons (Fcons (build_string ("JISX0201"),
- Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)),
- Qnil)),
- Vfont_encoding_alist);
- Vfont_encoding_alist
- = Fcons (Fcons (build_string ("ISO8859-1"),
- Fcons (Fcons (intern ("ascii"), make_number (0)),
- Qnil)),
- Vfont_encoding_alist);
+ auto_fontset_alist = Qnil;
+ staticpro (&auto_fontset_alist);
+
+ DEFVAR_LISP ("font-encoding-charset-alist", &Vfont_encoding_charset_alist,
+ doc: /*
+Alist of charsets vs the charsets to determine the preferred font encoding.
+Each element looks like (CHARSET . ENCODING-CHARSET),
+where ENCODING-CHARSET is a charset registered in the variable
+`font-encoding-alist' as ENCODING.
+
+When a text has a property `charset' and the value is CHARSET, a font
+whose encoding corresponds to ENCODING-CHARSET is preferred. */);
+ Vfont_encoding_charset_alist = Qnil;
DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
- doc: /* Char table of characters whose ascent values should be ignored.
+ 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.
+is assumed to be 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,
- doc: /* Char table of characters which is not composed relatively.
+ doc: /*
+Char table of characters which are 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
at the vertical center of lines. */);
Vvertical_centering_font_regexp = Qnil;
+ DEFVAR_LISP ("otf-script-alist", &Votf_script_alist,
+ doc: /* Alist of OpenType script tags vs the corresponding script names. */);
+ Votf_script_alist = 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);
- defsubr (&Sset_overriding_fontspec_internal);
+#ifdef FONTSET_DEBUG
+ defsubr (&Sfontset_list_all);
+#endif
}
/* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537