/* font.c -- "Font" primitives.
-Copyright (C) 2006-2013 Free Software Foundation, Inc.
+Copyright (C) 2006-2014 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
here. */
static struct font_driver_list *font_driver_list;
-\f
+#ifdef ENABLE_CHECKING
+
+/* Used to catch bogus pointers in font objects. */
+
+bool
+valid_font_driver (struct font_driver *drv)
+{
+ Lisp_Object tail, frame;
+ struct font_driver_list *fdl;
+
+ for (fdl = font_driver_list; fdl; fdl = fdl->next)
+ if (fdl->driver == drv)
+ return true;
+ FOR_EACH_FRAME (tail, frame)
+ for (fdl = XFRAME (frame)->font_driver_list; fdl; fdl = fdl->next)
+ if (fdl->driver == drv)
+ return true;
+ return false;
+}
+
+#endif /* ENABLE_CHECKING */
/* Creators of font-related Lisp object. */
= (struct font *) allocate_pseudovector (size, FONT_OBJECT_MAX, PVEC_FONT);
int i;
+ /* GC can happen before the driver is set up,
+ so avoid dangling pointer here (Bug#17771). */
+ font->driver = NULL;
XSETFONT (font_object, font);
if (! NILP (entity))
if (SYMBOLP (tem))
return tem;
- if (len == nchars || len != nbytes)
- tem = make_unibyte_string (str, len);
- else
- tem = make_multibyte_string (str, nchars, len);
+ tem = make_specified_string (str, nchars, len,
+ len != nchars && len == nbytes);
return Fintern (tem, obarray);
}
{ &QCotf, font_prop_validate_otf }
};
-/* Size (number of elements) of the above table. */
-#define FONT_PROPERTY_TABLE_SIZE \
- ((sizeof font_property_table) / (sizeof *font_property_table))
-
/* Return an index number of font property KEY or -1 if KEY is not an
already known property. */
{
int i;
- for (i = 0; i < FONT_PROPERTY_TABLE_SIZE; i++)
+ for (i = 0; i < ARRAYELTS (font_property_table); i++)
if (EQ (key, *font_property_table[i].key))
return i;
return -1;
where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
is a number frames sharing this cache, and FONT-CACHE-DATA is a
- cons (FONT-SPEC FONT-ENTITY ...). */
+ cons (FONT-SPEC . [FONT-ENTITY ...]). */
static void font_prepare_cache (struct frame *, struct font_driver *);
static void font_finish_cache (struct frame *, struct font_driver *);
font_clear_cache (struct frame *f, Lisp_Object cache, struct font_driver *driver)
{
Lisp_Object tail, elt;
- Lisp_Object tail2, entity;
+ Lisp_Object entity;
+ ptrdiff_t i;
/* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
{
elt = XCAR (tail);
- /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
+ /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
{
- for (tail2 = XCDR (elt); CONSP (tail2); tail2 = XCDR (tail2))
+ elt = XCDR (elt);
+ eassert (VECTORP (elt));
+ for (i = 0; i < ASIZE (elt); i++)
{
- entity = XCAR (tail2);
+ entity = AREF (elt, i);
if (FONT_ENTITY_P (entity)
&& EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
val = XCDR (val);
else
{
- Lisp_Object copy;
-
val = driver_list->driver->list (f, scratch_font_spec);
- if (NILP (val))
- val = zero_vector;
- else
- val = Fvconcat (1, &val);
- copy = copy_font_spec (scratch_font_spec);
- ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
- XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
+ if (!NILP (val))
+ {
+ Lisp_Object copy = copy_font_spec (scratch_font_spec);
+
+ val = Fvconcat (1, &val);
+ ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
+ XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
+ }
}
- if (ASIZE (val) > 0
+ if (VECTORP (val) && ASIZE (val) > 0
&& (need_filtering
|| ! NILP (Vface_ignored_fonts)))
val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size);
- if (ASIZE (val) > 0)
+ if (VECTORP (val) && ASIZE (val) > 0)
list = Fcons (val, list);
}
&& (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
{
Lisp_Object cache = font_get_cache (f, driver_list->driver);
- Lisp_Object copy;
ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
entity = assoc_no_quit (work, XCDR (cache));
if (CONSP (entity))
- entity = XCDR (entity);
+ entity = AREF (XCDR (entity), 0);
else
{
entity = driver_list->driver->match (f, work);
- copy = copy_font_spec (work);
- ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
- XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
+ if (!NILP (entity))
+ {
+ Lisp_Object copy = copy_font_spec (work);
+ Lisp_Object match = Fvector (1, &entity);
+
+ ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
+ XSETCDR (cache, Fcons (Fcons (copy, match), XCDR (cache)));
+ }
}
if (! NILP (entity))
break;
{
if (face->font->driver->done_face)
face->font->driver->done_face (f, face);
- face->extra = NULL;
}
LANGSYS is a symbol specifying a langsys tag of OpenType,
GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
-If LANGYS is nil, the default langsys is selected.
+If LANGSYS is nil, the default langsys is selected.
The features are applied in the order they appear in the list. The
symbol `*' means to apply all available features not present in this
if (NILP (string))
{
if (XBUFFER (w->contents) != current_buffer)
- error ("Specified window is not displaying the current buffer.");
+ error ("Specified window is not displaying the current buffer");
CHECK_NUMBER_COERCE_MARKER (position);
if (! (BEGV <= XINT (position) && XINT (position) < ZV))
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
}
#endif
+DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0,
+ doc: /* Return FRAME's font cache. Mainly used for debugging.
+If FRAME is omitted or nil, use the selected frame. */)
+ (Lisp_Object frame)
+{
+#ifdef HAVE_WINDOW_SYSTEM
+ struct frame *f = decode_live_frame (frame);
+
+ if (FRAME_WINDOW_P (f))
+ return FRAME_DISPLAY_INFO (f)->name_list_element;
+ else
+#endif
+ return Qnil;
+}
+
#endif /* FONT_DEBUG */
#ifdef HAVE_WINDOW_SYSTEM
#endif
\f
-#define BUILD_STYLE_TABLE(TBL) \
- build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
+#define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
static Lisp_Object
build_style_table (const struct table_entry *entry, int nelement)
void
syms_of_font (void)
{
+#include "font.x"
+
sort_shift_bits[FONT_TYPE_INDEX] = 0;
sort_shift_bits[FONT_SLANT_INDEX] = 2;
sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
#endif /* HAVE_LIBOTF */
#endif /* 0 */
- defsubr (&Sfontp);
- defsubr (&Sfont_spec);
- defsubr (&Sfont_get);
-#ifdef HAVE_WINDOW_SYSTEM
- defsubr (&Sfont_face_attributes);
-#endif
- defsubr (&Sfont_put);
- defsubr (&Slist_fonts);
- defsubr (&Sfont_family_list);
- defsubr (&Sfind_font);
- defsubr (&Sfont_xlfd_name);
- defsubr (&Sclear_font_cache);
- defsubr (&Sfont_shape_gstring);
- defsubr (&Sfont_variation_glyphs);
-#if 0
- defsubr (&Sfont_drive_otf);
- defsubr (&Sfont_otf_alternates);
-#endif /* 0 */
-
-#ifdef FONT_DEBUG
- defsubr (&Sopen_font);
- defsubr (&Sclose_font);
- defsubr (&Squery_font);
- defsubr (&Sfont_get_glyphs);
- defsubr (&Sfont_match_p);
- defsubr (&Sfont_at);
-#if 0
- defsubr (&Sdraw_string);
-#endif
-#endif /* FONT_DEBUG */
-#ifdef HAVE_WINDOW_SYSTEM
- defsubr (&Sfont_info);
-#endif
-
DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist,
doc: /*
Alist of fontname patterns vs the corresponding encoding and repertory info.
[NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
- XSYMBOL (intern_c_string ("font-weight-table"))->constant = 1;
+ SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-weight-table")), 1);
DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table,
doc: /* Vector of font slant symbols vs the corresponding numeric values.
See `font-weight-table' for the format of the vector. */);
Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
- XSYMBOL (intern_c_string ("font-slant-table"))->constant = 1;
+ SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-slant-table")), 1);
DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table,
doc: /* Alist of font width symbols vs the corresponding numeric values.
See `font-weight-table' for the format of the vector. */);
Vfont_width_table = BUILD_STYLE_TABLE (width_table);
- XSYMBOL (intern_c_string ("font-width-table"))->constant = 1;
+ SET_SYMBOL_CONSTANT (XSYMBOL (intern_c_string ("font-width-table")), 1);
staticpro (&font_style_table);
font_style_table = make_uninit_vector (3);
HCoop / bpt / emacs.git / blobdiff