/* 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
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
+#ifndef MAX
+# define MAX(a, b) ((a) > (b) ? (a) : (b))
+#endif
+
Lisp_Object Qopentype;
/* Important character set strings. */
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))
return font_object;
}
-\f
+#if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
+
+static int font_unparse_fcname (Lisp_Object, int, char *, int);
+
+/* Like above, but also set `type', `name' and `fullname' properties
+ of font-object. */
+
+Lisp_Object
+font_build_object (int vectorsize, Lisp_Object type,
+ Lisp_Object entity, double pixelsize)
+{
+ int len;
+ char name[256];
+ Lisp_Object font_object = font_make_object (vectorsize, entity, pixelsize);
+
+ ASET (font_object, FONT_TYPE_INDEX, type);
+ len = font_unparse_xlfd (entity, pixelsize, name, sizeof name);
+ if (len > 0)
+ ASET (font_object, FONT_NAME_INDEX, make_string (name, len));
+ len = font_unparse_fcname (entity, pixelsize, name, sizeof name);
+ if (len > 0)
+ ASET (font_object, FONT_FULLNAME_INDEX, make_string (name, len));
+ else
+ ASET (font_object, FONT_FULLNAME_INDEX,
+ AREF (font_object, FONT_NAME_INDEX));
+ return font_object;
+}
+
+#endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
static int font_pixel_size (struct frame *f, Lisp_Object);
static Lisp_Object font_open_entity (struct frame *, Lisp_Object, int);
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;
val = AREF (font, FONT_SIZE_INDEX);
eassert (NUMBERP (val) || NILP (val));
+ char font_size_index_buf[sizeof "-*"
+ + MAX (INT_STRLEN_BOUND (EMACS_INT),
+ 1 + DBL_MAX_10_EXP + 1)];
if (INTEGERP (val))
{
EMACS_INT v = XINT (val);
v = pixel_size;
if (v > 0)
{
- f[XLFD_PIXEL_INDEX] = p =
- alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT));
+ f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
sprintf (p, "%"pI"d-*", v);
}
else
else if (FLOATP (val))
{
double v = XFLOAT_DATA (val) * 10;
- f[XLFD_PIXEL_INDEX] = p = alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP + 1);
+ f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
sprintf (p, "*-%.0f", v);
}
else
f[XLFD_PIXEL_INDEX] = "*-*";
+ char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)];
if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
{
EMACS_INT v = XINT (AREF (font, FONT_DPI_INDEX));
- f[XLFD_RESX_INDEX] = p =
- alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT));
+ f[XLFD_RESX_INDEX] = p = dpi_index_buf;
sprintf (p, "%"pI"d-%"pI"d", v, v);
}
else
f[XLFD_RESX_INDEX] = "*-*";
+
if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
{
EMACS_INT spacing = XINT (AREF (font, FONT_SPACING_INDEX));
}
else
f[XLFD_SPACING_INDEX] = "*";
+
+ char avgwidth_index_buf[INT_BUFSIZE_BOUND (EMACS_INT)];
if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
{
- f[XLFD_AVGWIDTH_INDEX] = p = alloca (INT_BUFSIZE_BOUND (EMACS_INT));
+ f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf;
sprintf (p, "%"pI"d", XINT (AREF (font, FONT_AVGWIDTH_INDEX)));
}
else
f[XLFD_AVGWIDTH_INDEX] = "*";
+
len = snprintf (name, nbytes, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
return 0;
}
+#if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
+
/* Store fontconfig's font name of FONT (font-spec or font-entity) in
NAME (NBYTES length), and return the name length. If
- FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
+ FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
+ Return a negative value on error. */
-int
+static int
font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
{
Lisp_Object family, foundry;
return (p - name);
}
+#endif
+
/* Parse NAME (null terminated) and store information in FONT
(font-spec or font-entity). If NAME is successfully parsed, return
0. Otherwise return -1. */
lowest bit is set if the DPI is different. */
EMACS_INT diff;
EMACS_INT pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]);
+ EMACS_INT entity_size = XINT (AREF (entity, FONT_SIZE_INDEX));
if (CONSP (Vface_font_rescale_alist))
pixel_size *= font_rescale_ratio (entity);
- diff = eabs (pixel_size - XINT (AREF (entity, FONT_SIZE_INDEX))) << 1;
+ if (pixel_size * 2 < entity_size || entity_size * 2 < pixel_size)
+ /* This size is wrong by more than a factor 2: reject it! */
+ return 0xFFFFFFFF;
+ diff = eabs (pixel_size - entity_size) << 1;
if (! NILP (spec_prop[FONT_DPI_INDEX])
&& ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
diff |= 1;
static Lisp_Object
font_vconcat_entity_vectors (Lisp_Object list)
{
- int nargs = XINT (Flength (list));
- Lisp_Object *args = alloca (word_size * nargs);
- int i;
+ EMACS_INT nargs = XFASTINT (Flength (list));
+ Lisp_Object *args;
+ USE_SAFE_ALLOCA;
+ SAFE_ALLOCA_LISP (args, nargs);
+ ptrdiff_t i;
for (i = 0; i < nargs; i++, list = XCDR (list))
args[i] = XCAR (list);
- return Fvconcat (nargs, args);
+ Lisp_Object result = Fvconcat (nargs, args);
+ SAFE_FREE ();
+ return result;
}
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)))
if (! NILP (AREF (val, FONT_TYPE_INDEX)))
{
eassert (font && driver == font->driver);
- driver->close (f, font);
+ driver->close (font);
}
}
if (driver->free_entity)
ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
- for (i = 0; driver_list; driver_list = driver_list->next)
+ for (; driver_list; driver_list = driver_list->next)
if (driver_list->on
&& (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
{
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;
/* Already closed. */
return;
FONT_ADD_LOG ("close", font_object, Qnil);
- font->driver->close (f, font);
+ font->driver->close (font);
#ifdef HAVE_WINDOW_SYSTEM
eassert (FRAME_DISPLAY_INFO (f)->n_fonts);
FRAME_DISPLAY_INFO (f)->n_fonts--;
val = attrs[LFACE_FAMILY_INDEX];
val = font_intern_prop (SSDATA (val), SBYTES (val), 1);
}
+ Lisp_Object familybuf[3];
if (NILP (val))
{
- family = alloca ((sizeof family[0]) * 2);
+ family = familybuf;
family[0] = Qnil;
family[1] = zero_vector; /* terminator. */
}
}
else
{
- family = alloca ((sizeof family[0]) * 3);
+ family = familybuf;
i = 0;
family[i++] = val;
if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
val = font_select_entity (f, entities,
attrs, pixel_size, c);
if (! NILP (val))
- return val;
+ {
+ SAFE_FREE ();
+ return val;
+ }
}
}
}
{
if (face->font->driver->done_face)
face->font->driver->done_face (f, face);
- face->extra = NULL;
}
struct font_driver_list **list_table, **next;
Lisp_Object tail;
int i;
+ USE_SAFE_ALLOCA;
- list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
+ SAFE_NALLOCA (list_table, 1, num_font_drivers + 1);
for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
{
for (list = f->font_driver_list; list; list = list->next)
next = &(*next)->next;
}
*next = NULL;
+ SAFE_FREE ();
if (! f->font_driver_list->on)
{ /* None of the drivers is enabled: enable them all.
return active_drivers;
}
-int
-font_put_frame_data (struct frame *f, struct font_driver *driver, void *data)
+#if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
+
+static void
+fset_font_data (struct frame *f, Lisp_Object val)
{
- struct font_data_list *list, *prev;
+ f->font_data = val;
+}
- for (prev = NULL, list = f->font_data_list; list;
- prev = list, list = list->next)
- if (list->driver == driver)
- break;
- if (! data)
- {
- if (list)
- {
- if (prev)
- prev->next = list->next;
- else
- f->font_data_list = list->next;
- xfree (list);
- }
- return 0;
- }
+void
+font_put_frame_data (struct frame *f, Lisp_Object driver, void *data)
+{
+ Lisp_Object val = assq_no_quit (driver, f->font_data);
- if (! list)
+ if (!data)
+ fset_font_data (f, Fdelq (val, f->font_data));
+ else
{
- list = xmalloc (sizeof *list);
- list->driver = driver;
- list->next = f->font_data_list;
- f->font_data_list = list;
+ if (NILP (val))
+ fset_font_data (f, Fcons (Fcons (driver, make_save_ptr (data)),
+ f->font_data));
+ else
+ XSETCDR (val, make_save_ptr (data));
}
- list->data = data;
- return 0;
}
-
void *
-font_get_frame_data (struct frame *f, struct font_driver *driver)
+font_get_frame_data (struct frame *f, Lisp_Object driver)
{
- struct font_data_list *list;
-
- for (list = f->font_data_list; list; list = list->next)
- if (list->driver == driver)
- break;
- if (! list)
- return NULL;
- return list->data;
+ Lisp_Object val = assq_no_quit (driver, f->font_data);
+
+ return NILP (val) ? NULL : XSAVE_POINTER (XCDR (val), 0);
}
+#endif /* HAVE_XFT || HAVE_FREETYPE */
/* Sets attributes on a font. Any properties that appear in ALIST and
BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
ptrdiff_t endptr;
if (STRINGP (string))
- face_id = face_at_string_position (w, string, pos, 0, -1, -1, &endptr,
+ face_id = face_at_string_position (w, string, pos, 0, &endptr,
DEFAULT_FACE_ID, 0);
else
- face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
+ face_id = face_at_buffer_position (w, pos, &endptr,
pos + 100, 0, -1);
face = FACE_FROM_ID (f, face_id);
}
{
int face_id;
- face_id = face_at_buffer_position (w, pos, 0, 0, &ignore,
+ face_id = face_at_buffer_position (w, pos, &ignore,
*limit, 0, -1);
face = FACE_FROM_ID (XFRAME (w->frame), face_id);
}
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)
#if 0
defsubr (&Sdraw_string);
#endif
+ defsubr (&Sframe_font_cache);
#endif /* FONT_DEBUG */
#ifdef HAVE_WINDOW_SYSTEM
defsubr (&Sfont_info);
#ifdef HAVE_NTGUI
syms_of_w32font ();
#endif /* HAVE_NTGUI */
-#ifdef HAVE_NS
- syms_of_nsfont ();
- syms_of_macfont ();
-#endif /* HAVE_NS */
#endif /* HAVE_WINDOW_SYSTEM */
}