#include "lisp.h"
#include "buffer.h"
#include "frame.h"
+#include "window.h"
#include "dispextern.h"
#include "charset.h"
#include "character.h"
Lisp_Object Qfontp;
+Lisp_Object Qopentype;
+
/* Important character set symbols. */
-Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp;
+Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip;
/* Like CHECK_FONT_SPEC but also validate properties of the font-spec,
and set X to the validated result. */
int i, j;
Lisp_Object dpi, spacing;
int avgwidth;
- char *f[XLFD_LAST_INDEX];
+ char *f[XLFD_LAST_INDEX + 1];
Lisp_Object val;
char *p;
}
else
{
- char *pbeg = p0;
-
if (memcmp (p0 + 1, "pixelsize=", 10) == 0)
prop = FONT_SIZE_INDEX;
else
{
ASET (font, prop, val);
}
- else if (prop > 0)
- font_put_extra (font, key, val);
else
- {
- /* Unknown attribute, keep it in name. */
- bcopy (pbeg, copy, p1 - pbeg);
- copy += p1 - pbeg;
- }
+ font_put_extra (font, key, val);
}
}
p0 = p1;
}
- if (name < copy)
- font_put_extra (font, QCname, make_unibyte_string (name, copy - name));
-
return 0;
}
int i, len = 1;
char *p;
Lisp_Object styles[3];
- char *style_names[3] = { "weight", "slant", "swidth" };
+ char *style_names[3] = { "weight", "slant", "width" };
val = AREF (font, FONT_FAMILY_INDEX);
if (SYMBOLP (val) && ! NILP (val))
}
val = AREF (font, FONT_FOUNDRY_INDEX);
- if (! NILP (val))
+ if (SYMBOLP (val) && ! NILP (val))
/* ":foundry=NAME" */
len += 9 + SBYTES (SYMBOL_NAME (val));
p += sprintf (p, ":foundry=%s",
SDATA (SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX))));
for (i = 0; i < 3; i++)
- if (! NILP (styles [i]))
+ if (SYMBOLP (styles[i]) && ! NILP (styles [i]))
p += sprintf (p, ":%s=%s", style_names[i],
SDATA (SYMBOL_NAME (styles [i])));
if (dpi >= 0)
Lisp_Object font;
{
if (name[0] == '-' || index (name, '*'))
- {
- if (font_parse_xlfd (name, font) == 0)
- return 0;
- font_put_extra (font, QCname, make_unibyte_string (name, strlen (name)));
- return -1;
- }
- font_put_extra (font, QCname, make_unibyte_string (name, strlen (name)));
+ return font_parse_xlfd (name, font);
return font_parse_fcname (name, font);
}
p1 = index (p0, '-');
if (p1)
{
- if (NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
+ if ((*p0 != '*' || p1 - p0 > 1)
+ && NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
ASET (spec, FONT_FOUNDRY_INDEX,
intern_downcase (p0, p1 - p0));
if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
}
}
+static Lisp_Object
+font_lispy_object (font)
+ struct font *font;
+{
+ Lisp_Object objlist = AREF (font->entity, FONT_OBJLIST_INDEX);
+
+ for (; ! NILP (objlist); objlist = XCDR (objlist))
+ {
+ struct Lisp_Save_Value *p = XSAVE_VALUE (XCAR (objlist));
+
+ if (font == (struct font *) p->pointer)
+ break;
+ }
+ xassert (! NILP (objlist));
+ return XCAR (objlist);
+}
+
+#define LGSTRING_HEADER_SIZE 6
+#define LGSTRING_GLYPH_SIZE 8
+
+static int
+check_gstring (gstring)
+ Lisp_Object gstring;
+{
+ Lisp_Object val;
+ int i, j;
+
+ CHECK_VECTOR (gstring);
+ val = AREF (gstring, 0);
+ CHECK_VECTOR (val);
+ if (ASIZE (val) < LGSTRING_HEADER_SIZE)
+ goto err;
+ CHECK_FONT_OBJECT (LGSTRING_FONT (gstring));
+ if (! NILP (LGSTRING_LBEARING (gstring)))
+ CHECK_NUMBER (LGSTRING_LBEARING (gstring));
+ if (! NILP (LGSTRING_RBEARING (gstring)))
+ CHECK_NUMBER (LGSTRING_RBEARING (gstring));
+ if (! NILP (LGSTRING_WIDTH (gstring)))
+ CHECK_NATNUM (LGSTRING_WIDTH (gstring));
+ if (! NILP (LGSTRING_ASCENT (gstring)))
+ CHECK_NUMBER (LGSTRING_ASCENT (gstring));
+ if (! NILP (LGSTRING_DESCENT (gstring)))
+ CHECK_NUMBER (LGSTRING_DESCENT(gstring));
+
+ for (i = 0; i < LGSTRING_LENGTH (gstring); i++)
+ {
+ val = LGSTRING_GLYPH (gstring, i);
+ CHECK_VECTOR (val);
+ if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
+ goto err;
+ if (NILP (LGLYPH_CHAR (val)))
+ break;
+ CHECK_NATNUM (LGLYPH_FROM (val));
+ CHECK_NATNUM (LGLYPH_TO (val));
+ CHECK_CHARACTER (LGLYPH_CHAR (val));
+ if (! NILP (LGLYPH_CODE (val)))
+ CHECK_NATNUM (LGLYPH_CODE (val));
+ if (! NILP (LGLYPH_WIDTH (val)))
+ CHECK_NATNUM (LGLYPH_WIDTH (val));
+ if (! NILP (LGLYPH_ADJUSTMENT (val)))
+ {
+ val = LGLYPH_ADJUSTMENT (val);
+ CHECK_VECTOR (val);
+ if (ASIZE (val) < 3)
+ goto err;
+ for (j = 0; j < 3; j++)
+ CHECK_NUMBER (AREF (val, j));
+ }
+ }
+ return i;
+ err:
+ error ("Invalid glyph-string format");
+ return -1;
+}
+
\f
/* OTF handler */
Lisp_Object langsys_tag;
int l;
- if (j == script->LangSysCount)
+ if (k == script->LangSysCount)
{
langsys = &script->DefaultLangSys;
langsys_tag = Qnil;
langsys_tag
= otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
}
- for (l = langsys->FeatureCount -1; l >= 0; l--)
+ for (l = langsys->FeatureCount - 1; l >= 0; l--)
{
OTF_Feature *feature
= gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
return capability;
}
-static int
-parse_gsub_gpos_spec (spec, script, langsys, features)
+static void
+parse_gsub_gpos_spec (spec, script, langsys, features, nbytes)
Lisp_Object spec;
- char **script, **langsys, **features;
+ char **script, **langsys, *features;
+ int nbytes;
{
Lisp_Object val;
- int len;
- char *p;
+ char *p, *pend;
int asterisk;
+ CHECK_CONS (spec);
val = XCAR (spec);
+ CHECK_SYMBOL (val);
*script = (char *) SDATA (SYMBOL_NAME (val));
spec = XCDR (spec);
+ CHECK_CONS (spec);
val = XCAR (spec);
+ CHECK_SYMBOL (val);
*langsys = NILP (val) ? NULL : (char *) SDATA (SYMBOL_NAME (val));
spec = XCDR (spec);
- len = XINT (Flength (spec));
- *features = p = malloc (6 * len);
- if (! p)
- return -1;
+ p = features, pend = p + nbytes - 1;
+ *p = '\0';
for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
{
val = XCAR (spec);
+ CHECK_SYMBOL (val);
+ if (p > features)
+ {
+ if (p >= pend)
+ break;
+ *p++ = ',';
+ }
if (SREF (SYMBOL_NAME (val), 0) == '*')
{
asterisk = 1;
- p += sprintf (p, ",*");
+ if (p >= pend)
+ break;
+ *p++ = '*';
}
else if (! asterisk)
- p += sprintf (p, ",%s", SDATA (SYMBOL_NAME (val)));
+ {
+ val = SYMBOL_NAME (val);
+ if (p + SBYTES (val) >= pend)
+ break;
+ p += sprintf (p, "%s", SDATA (val));
+ }
else
- p += sprintf (p, ",~%s", SDATA (SYMBOL_NAME (val)));
+ {
+ val = SYMBOL_NAME (val);
+ if (p + 1 + SBYTES (val)>= pend)
+ break;
+ p += sprintf (p, "~%s", SDATA (val));
+ }
}
- return 0;
+ if (CONSP (spec))
+ error ("OTF spec too long");
}
#define DEVICE_DELTA(table, size) \
(((size) >= (table).StartSize && (size) <= (table).EndSize) \
- ? (table).DeltaValue[(size) >= (table).StartSize] \
+ ? (table).DeltaValue[(size) - (table).StartSize] \
: 0)
void
}
}
+#define REPLACEMENT_CHARACTER 0xFFFD
/* Drive FONT's OTF GSUB features according to GSUB_SPEC. See the
comment of (sturct font_driver).otf_gsub. */
int
-font_otf_gsub (font, gsub_spec, gstring_in, from, to, gstring_out, idx)
+font_otf_gsub (font, gsub_spec, gstring_in, from, to, gstring_out, idx,
+ alternate_subst)
struct font *font;
Lisp_Object gsub_spec;
Lisp_Object gstring_in;
int from, to;
Lisp_Object gstring_out;
- int idx;
+ int idx, alternate_subst;
{
int len;
int i;
OTF *otf;
OTF_GlyphString otf_gstring;
OTF_Glyph *g;
- char *script, *langsys, *features;
+ char *script, *langsys, features[256];
+ int need_cmap;
+
+ parse_gsub_gpos_spec (gsub_spec, &script, &langsys, features, 256);
otf = otf_open (font->entity, font->file_name);
if (! otf)
return 0;
if (OTF_get_table (otf, "head") < 0)
return 0;
+ if (OTF_get_table (otf, "cmap") < 0)
+ return 0;
if (OTF_check_table (otf, "GSUB") < 0)
return 0;
- if (parse_gsub_gpos_spec (gsub_spec, &script, &langsys, &features) < 0)
- return 0;
len = to - from;
otf_gstring.size = otf_gstring.used = len;
otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len);
memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len);
- for (i = 0; i < len; i++)
+ for (i = 0, need_cmap = 0; i < len; i++)
{
Lisp_Object g = LGSTRING_GLYPH (gstring_in, from + i);
otf_gstring.glyphs[i].c = XINT (LGLYPH_CHAR (g));
- otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (g));
+ if (otf_gstring.glyphs[i].c == REPLACEMENT_CHARACTER)
+ otf_gstring.glyphs[i].c = 0;
+ if (NILP (LGLYPH_CODE (g)))
+ {
+ otf_gstring.glyphs[i].glyph_id = 0;
+ need_cmap = 1;
+ }
+ else
+ otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (g));
}
+ if (need_cmap)
+ OTF_drive_cmap (otf, &otf_gstring);
OTF_drive_gdef (otf, &otf_gstring);
- if (OTF_drive_gsub (otf, &otf_gstring, script, langsys, features) < 0)
+ if ((alternate_subst
+ ? OTF_drive_gsub_alternate (otf, &otf_gstring, script, langsys, features)
+ : OTF_drive_gsub (otf, &otf_gstring, script, langsys, features)) < 0)
{
free (otf_gstring.glyphs);
return 0;
glyph = LGSTRING_GLYPH (gstring_out, idx + i);
ASET (glyph, 0, min_idx);
ASET (glyph, 1, max_idx);
- LGLYPH_SET_CHAR (glyph, make_number (g->c));
+ if (g->c > 0)
+ LGLYPH_SET_CHAR (glyph, make_number (g->c));
+ else
+ LGLYPH_SET_CHAR (glyph, make_number (REPLACEMENT_CHARACTER));
LGLYPH_SET_CODE (glyph, make_number (g->glyph_id));
}
}
OTF *otf;
OTF_GlyphString otf_gstring;
OTF_Glyph *g;
- char *script, *langsys, *features;
+ char *script, *langsys, features[256];
+ int need_cmap;
Lisp_Object glyph;
int u, size;
Lisp_Object base, mark;
+ parse_gsub_gpos_spec (gpos_spec, &script, &langsys, features, 256);
+
otf = otf_open (font->entity, font->file_name);
if (! otf)
return 0;
if (OTF_get_table (otf, "head") < 0)
return 0;
+ if (OTF_get_table (otf, "cmap") < 0)
+ return 0;
if (OTF_check_table (otf, "GPOS") < 0)
return 0;
- if (parse_gsub_gpos_spec (gpos_spec, &script, &langsys, &features) < 0)
- return 0;
len = to - from;
otf_gstring.size = otf_gstring.used = len;
otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len);
memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len);
- for (i = 0; i < len; i++)
+ for (i = 0, need_cmap = 0; i < len; i++)
{
glyph = LGSTRING_GLYPH (gstring, from + i);
- otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (glyph));
+ otf_gstring.glyphs[i].c = XINT (LGLYPH_CHAR (glyph));
+ if (otf_gstring.glyphs[i].c == REPLACEMENT_CHARACTER)
+ otf_gstring.glyphs[i].c = 0;
+ if (NILP (LGLYPH_CODE (glyph)))
+ {
+ otf_gstring.glyphs[i].glyph_id = 0;
+ need_cmap = 1;
+ }
+ else
+ otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (glyph));
}
-
+ if (need_cmap)
+ OTF_drive_cmap (otf, &otf_gstring);
OTF_drive_gdef (otf, &otf_gstring);
if (OTF_drive_gpos (otf, &otf_gstring, script, langsys, features) < 0)
for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used; i++, g++)
{
Lisp_Object prev;
- int xoff = 0, yoff = 0, width_adjust = 0;
+ int xoff = 0, yoff = 0, width_adjust = 0;
if (! g->glyph_id)
continue;
width = font->driver->text_extents (font, &code, 1, NULL);
LGLYPH_SET_WIDTH (prev, make_number (width));
}
+ else
+ width = XINT (LGLYPH_WIDTH (prev));
xoff = XINT (LGLYPH_XOFF (prev)) + (base_x - width) - mark_x;
yoff = XINT (LGLYPH_YOFF (prev)) + mark_y - base_y;
}
}
+
+ if (xoff || yoff || width_adjust)
+ {
+ Lisp_Object adjustment = Fmake_vector (make_number (3), Qnil);
+
+ ASET (adjustment, 0, make_number (xoff));
+ ASET (adjustment, 1, make_number (yoff));
+ ASET (adjustment, 2, make_number (width_adjust));
+ LGLYPH_SET_ADJUSTMENT (glyph, adjustment);
+ }
+
if (g->GlyphClass == OTF_GlyphClass0)
base = mark = glyph;
else if (g->GlyphClass == OTF_GlyphClassMark)
mark = glyph;
else
base = glyph;
-
- LGLYPH_SET_XOFF (glyph, make_number (xoff));
- LGLYPH_SET_YOFF (glyph, make_number (yoff));
- LGLYPH_SET_WADJUST (glyph, make_number (width_adjust));
}
free (otf_gstring.glyphs);
- return 0;
+ return i;
}
#endif /* HAVE_LIBOTF */
\f
-/* glyph-string handler */
-
-/* GSTRING is a vector of this form:
- [ [FONT-OBJECT LBEARING RBEARING WITH ASCENT DESCENT] GLYPH ... ]
- and GLYPH is a vector of this form:
- [ FROM-IDX TO-IDX C CODE X-OFF Y-OFF WIDTH WADJUST ]
- where
- FROM-IDX and TO-IDX are used internally and should not be touched.
- C is a character of the glyph.
- CODE is a glyph-code of C in FONT-OBJECT.
- X-OFF and Y-OFF are offests to the base position for the glyph.
- WIDTH is a normal width of the glyph.
- WADJUST is an adjustment to the normal width of the glyph. */
+/* G-string (glyph string) handler */
+
+/* G-string is a vector of the form [HEADER GLYPH ...].
+ See the docstring of `font-make-gstring' for more detail. */
struct font *
font_prepare_composition (cmp)
for (i = 0; i < len; i++)
{
Lisp_Object g = LGSTRING_GLYPH (gstring, i);
- unsigned code = XINT (LGLYPH_CODE (g));
+ unsigned code;
struct font_metrics metrics;
+ if (NILP (LGLYPH_FROM (g)))
+ break;
+ code = XINT (LGLYPH_CODE (g));
font->driver->text_extents (font, &code, 1, &metrics);
LGLYPH_SET_WIDTH (g, make_number (metrics.width));
- metrics.lbearing += XINT (LGLYPH_XOFF (g));
- metrics.rbearing += XINT (LGLYPH_XOFF (g));
- metrics.ascent += XINT (LGLYPH_YOFF (g));
- metrics.descent += XINT (LGLYPH_YOFF (g));
+ metrics.lbearing += LGLYPH_XOFF (g);
+ metrics.rbearing += LGLYPH_XOFF (g);
+ metrics.ascent += LGLYPH_YOFF (g);
+ metrics.descent += LGLYPH_YOFF (g);
if (cmp->lbearing > cmp->pixel_width + metrics.lbearing)
cmp->lbearing = cmp->pixel_width + metrics.lbearing;
cmp->ascent = metrics.ascent;
if (cmp->descent < metrics.descent)
cmp->descent = metrics.descent;
- cmp->pixel_width += metrics.width + XINT (LGLYPH_WADJUST (g));
+ cmp->pixel_width += metrics.width + LGLYPH_WADJUST (g);
}
+ cmp->glyph_len = i;
LGSTRING_SET_LBEARING (gstring, make_number (cmp->lbearing));
LGSTRING_SET_RBEARING (gstring, make_number (cmp->rbearing));
LGSTRING_SET_WIDTH (gstring, make_number (cmp->pixel_width));
ftype = AREF (spec, FONT_TYPE_INDEX);
for (i = 0; driver_list; driver_list = driver_list->next)
- if (NILP (ftype) || EQ (driver_list->driver->type, ftype))
+ if (driver_list->on
+ && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
{
Lisp_Object cache = driver_list->driver->get_cache (frame);
Lisp_Object tail = alternate_familes;
return (i > 0 ? Fvconcat (i, vec) : null_vector);
}
+static Lisp_Object
+font_matching_entity (frame, spec)
+ Lisp_Object frame, spec;
+{
+ FRAME_PTR f = XFRAME (frame);
+ struct font_driver_list *driver_list = f->font_driver_list;
+ Lisp_Object ftype, size, entity;
+
+ ftype = AREF (spec, FONT_TYPE_INDEX);
+ size = AREF (spec, FONT_SIZE_INDEX);
+ if (FLOATP (size))
+ ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
+ entity = Qnil;
+ for (; driver_list; driver_list = driver_list->next)
+ if (driver_list->on
+ && (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
+ {
+ Lisp_Object cache = driver_list->driver->get_cache (frame);
+ Lisp_Object key;
+
+ xassert (CONSP (cache));
+ ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type);
+ key = Fcons (spec, Qnil);
+ entity = assoc_no_quit (key, XCDR (cache));
+ if (CONSP (entity))
+ entity = XCDR (entity);
+ else
+ {
+ entity = driver_list->driver->match (frame, spec);
+ if (! NILP (entity))
+ {
+ XSETCAR (key, Fcopy_sequence (spec));
+ XSETCDR (cache, Fcons (Fcons (key, entity), XCDR (cache)));
+ }
+ }
+ if (! NILP (entity))
+ break;
+ }
+ ASET (spec, FONT_TYPE_INDEX, ftype);
+ ASET (spec, FONT_SIZE_INDEX, size);
+ return entity;
+}
+
static int num_fonts;
static Lisp_Object
font = driver_list->driver->open (f, entity, pixel_size);
if (! font)
return Qnil;
+ font->scalable = XINT (size) == 0;
+
val = make_save_value (font, 1);
ASET (entity, FONT_OBJLIST_INDEX,
Fcons (val, AREF (entity, FONT_OBJLIST_INDEX)));
FRAME_PTR f;
Lisp_Object font_object;
{
- struct font *font;
- Lisp_Object objlist = AREF (font->entity, FONT_OBJLIST_INDEX);
+ struct font *font = XSAVE_VALUE (font_object)->pointer;
+ Lisp_Object objlist;
Lisp_Object tail, prev = Qnil;
+ XSAVE_VALUE (font_object)->integer--;
+ xassert (XSAVE_VALUE (font_object)->integer >= 0);
+ if (XSAVE_VALUE (font_object)->integer > 0)
+ return;
+
+ objlist = AREF (font->entity, FONT_OBJLIST_INDEX);
for (prev = Qnil, tail = objlist; CONSP (tail);
prev = tail, tail = XCDR (tail))
if (EQ (font_object, XCAR (tail)))
{
- struct Lisp_Save_Value *p = XSAVE_VALUE (font_object);
-
- xassert (p->integer > 0);
- p->integer--;
- if (p->integer == 0)
- {
- if (font->driver->close)
- font->driver->close (f, p->pointer);
- p->pointer = NULL;
- if (NILP (prev))
- ASET (font->entity, FONT_OBJLIST_INDEX, XCDR (objlist));
- else
- XSETCDR (prev, XCDR (objlist));
- }
- break;
+ if (font->driver->close)
+ font->driver->close (f, font);
+ XSAVE_VALUE (font_object)->pointer = NULL;
+ if (NILP (prev))
+ ASET (font->entity, FONT_OBJLIST_INDEX, XCDR (objlist));
+ else
+ XSETCDR (prev, XCDR (objlist));
+ return;
}
+ abort ();
}
int
char *name;
{
Lisp_Object args[2];
- Lisp_Object spec, prefer, size, entities;
+ Lisp_Object spec, prefer, size, entity, entity_list;
Lisp_Object frame;
int i;
int pixel_size;
if (NILP (AREF (spec, FONT_REGISTRY_INDEX)))
ASET (spec, FONT_REGISTRY_INDEX, Qiso8859_1);
- entities = Flist_fonts (spec, frame, make_number (1), prefer);
- return (NILP (entities)
+ entity_list = Flist_fonts (spec, frame, make_number (1), prefer);
+ if (NILP (entity_list))
+ entity = font_matching_entity (frame, spec);
+ else
+ entity = XCAR (entity_list);
+ return (NILP (entity)
? Qnil
- : font_open_entity (f, XCAR (entities), pixel_size));
+ : font_open_entity (f, entity, pixel_size));
}
/* Register font-driver DRIVER. This function is used in two ways.
- The first is with frame F non-NULL. In this case, DRIVER is
- registered to be used for drawing characters on F. All frame
- creaters (e.g. Fx_create_frame) must call this function at least
- once with an available font-driver.
+ The first is with frame F non-NULL. In this case, make DRIVER
+ available (but not yet activated) on F. All frame creaters
+ (e.g. Fx_create_frame) must call this function at least once with
+ an available font-driver.
The second is with frame F NULL. In this case, DRIVER is globally
registered in the variable `font_driver_list'. All font-driver
SDATA (SYMBOL_NAME (driver->type)));
for (prev = NULL, list = root; list; prev = list, list = list->next)
- if (list->driver->type == driver->type)
+ if (EQ (list->driver->type, driver->type))
error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
list = malloc (sizeof (struct font_driver_list));
+ list->on = 0;
list->driver = driver;
list->next = NULL;
if (prev)
}
}
+/* Make the frame F use font backends listed in NEW_BACKENDS (list of
+ symbols). If NEW_BACKENDS is nil, make F use all available font
+ drivers. If no backend is available, dont't alter
+ f->font_driver_list.
+
+ A caller must free all realized faces and clear all font caches if
+ any in advance. The return value is a list of font backends
+ actually made used for on F. */
+
+Lisp_Object
+font_update_drivers (f, new_drivers)
+ FRAME_PTR f;
+ Lisp_Object new_drivers;
+{
+ Lisp_Object active_drivers = Qnil;
+ struct font_driver_list *list;
+
+ /* At first check which font backends are available. */
+ for (list = f->font_driver_list; list; list = list->next)
+ if (NILP (new_drivers)
+ || ! NILP (Fmemq (list->driver->type, new_drivers)))
+ {
+ list->on = 2;
+ active_drivers = nconc2 (active_drivers,
+ Fcons (list->driver->type, Qnil));
+ }
+ /* If at least one backend is available, update all list->on. */
+ if (! NILP (active_drivers))
+ for (list = f->font_driver_list; list; list = list->next)
+ list->on = (list->on == 2);
+
+ return active_drivers;
+}
+
+
+Lisp_Object
+font_at (c, pos, face, w, object)
+ int c;
+ EMACS_INT pos;
+ struct face *face;
+ struct window *w;
+ Lisp_Object object;
+{
+ FRAME_PTR f;
+ int face_id;
+ int dummy;
+
+ f = XFRAME (w->frame);
+ if (! face)
+ {
+ if (STRINGP (object))
+ face_id = face_at_string_position (w, object, pos, 0, -1, -1, &dummy,
+ DEFAULT_FACE_ID, 0);
+ else
+ face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
+ pos + 100, 0);
+ face = FACE_FROM_ID (f, face_id);
+ }
+ face_id = FACE_FOR_CHAR (f, face, c, pos, object);
+ face = FACE_FROM_ID (f, face_id);
+ if (! face->font_info)
+ return Qnil;
+ return font_lispy_object ((struct font *) face->font_info);
+}
+
\f
/* Lisp API */
CHECK_STRING (val);
font_parse_name ((char *) SDATA (val), spec);
}
- else
- font_put_extra (spec, key, val);
+ font_put_extra (spec, key, val);
}
- }
+ }
CHECK_VALIDATE_FONT_SPEC (spec);
return spec;
}
DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
doc: /* Return the value of FONT's PROP property.
-FONT may be a font-spec or font-entity.
-If FONT is font-entity and PROP is :extra, always nil is returned. */)
+FONT is a font-spec, a font-entity, or a font-object. */)
(font, prop)
Lisp_Object font, prop;
{
enum font_property_index idx;
- CHECK_FONT (font);
+ if (FONT_OBJECT_P (font))
+ {
+ struct font *fontp = XSAVE_VALUE (font)->pointer;
+
+ if (EQ (prop, QCotf))
+ {
+#ifdef HAVE_LIBOTF
+ return font_otf_capability (fontp);
+#else /* not HAVE_LIBOTF */
+ return Qnil;
+#endif /* not HAVE_LIBOTF */
+ }
+ font = fontp->entity;
+ }
+ else
+ CHECK_FONT (font);
idx = get_font_prop_index (prop, 0);
if (idx < FONT_EXTRA_INDEX)
return AREF (font, idx);
struct font_driver_list *driver_list = f->font_driver_list;
for (; driver_list; driver_list = driver_list->next)
- {
- Lisp_Object cache = driver_list->driver->get_cache (frame);
- Lisp_Object tail, elt;
+ if (driver_list->on)
+ {
+ Lisp_Object cache = driver_list->driver->get_cache (frame);
+ Lisp_Object tail, elt;
- for (tail = XCDR (cache); CONSP (tail); tail = XCDR (tail))
- {
- elt = XCAR (tail);
- if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
- {
- Lisp_Object vec = XCDR (elt);
- int i;
-
- for (i = 0; i < ASIZE (vec); i++)
- {
- Lisp_Object entity = AREF (vec, i);
- Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
-
- for (; CONSP (objlist); objlist = XCDR (objlist))
- {
- Lisp_Object val = XCAR (objlist);
- struct Lisp_Save_Value *p = XSAVE_VALUE (val);
- struct font *font = p->pointer;
-
- xassert (font
- && driver_list->driver == font->driver);
- driver_list->driver->close (f, font);
- p->pointer = NULL;
- p->integer = 0;
- }
- if (driver_list->driver->free_entity)
- driver_list->driver->free_entity (entity);
- }
- }
- }
- XSETCDR (cache, Qnil);
- }
+ for (tail = XCDR (cache); CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
+ {
+ Lisp_Object vec = XCDR (elt);
+ int i;
+
+ for (i = 0; i < ASIZE (vec); i++)
+ {
+ Lisp_Object entity = AREF (vec, i);
+
+ if (EQ (driver_list->driver->type,
+ AREF (entity, FONT_TYPE_INDEX)))
+ {
+ Lisp_Object objlist
+ = AREF (entity, FONT_OBJLIST_INDEX);
+
+ for (; CONSP (objlist); objlist = XCDR (objlist))
+ {
+ Lisp_Object val = XCAR (objlist);
+ struct Lisp_Save_Value *p = XSAVE_VALUE (val);
+ struct font *font = p->pointer;
+
+ xassert (font && (driver_list->driver
+ == font->driver));
+ driver_list->driver->close (f, font);
+ p->pointer = NULL;
+ p->integer = 0;
+ }
+ if (driver_list->driver->free_entity)
+ driver_list->driver->free_entity (entity);
+ }
+ }
+ }
+ }
+ XSETCDR (cache, Qnil);
+ }
}
return Qnil;
}
DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
- doc: /* Return a newly created glyph-string for FONT-OBJECT with NUM glyphs.
-FONT-OBJECT may be nil if it is not yet known. */)
+ doc: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
+FONT-OBJECT may be nil if it is not yet known.
+
+G-string is sequence of glyphs of a specific font,
+and is a vector of this form:
+ [ HEADER GLYPH ... ]
+HEADER is a vector of this form:
+ [FONT-OBJECT LBEARING RBEARING WIDTH ASCENT DESCENT]
+where
+ FONT-OBJECT is a font-object for all glyphs in the G-string,
+ LBEARING thry DESCENT is the metrics (in pixels) of the whole G-string.
+GLYPH is a vector of this form:
+ [ FROM-IDX TO-IDX C CODE WIDTH [ [X-OFF Y-OFF WADJUST] | nil] ]
+where
+ FROM-IDX and TO-IDX are used internally and should not be touched.
+ C is the character of the glyph.
+ CODE is the glyph-code of C in FONT-OBJECT.
+ X-OFF and Y-OFF are offests to the base position for the glyph.
+ WIDTH is the normal width of the glyph.
+ WADJUST is the adjustment to the normal width of the glyph. */)
(font_object, num)
Lisp_Object font_object, num;
{
ASET (g, 0, font_object);
ASET (gstring, 0, g);
for (i = 1; i < len; i++)
- ASET (gstring, i, Fmake_vector (make_number (8), make_number (0)));
+ ASET (gstring, i, Fmake_vector (make_number (8), Qnil));
return gstring;
}
CHECK_VECTOR (gstring);
if (NILP (font_object))
- font_object = Faref (Faref (gstring, make_number (0)), make_number (0));
+ font_object = LGSTRING_FONT (gstring);
CHECK_FONT_GET_OBJECT (font_object, font);
if (STRINGP (object))
CHECK_NATNUM (end);
if (XINT (start) > XINT (end)
|| XINT (end) > ASIZE (object)
- || XINT (end) - XINT (start) >= XINT (Flength (gstring)))
+ || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
args_out_of_range (start, end);
len = XINT (end) - XINT (start);
code = font->driver->encode_char (font, c);
if (code > MOST_POSITIVE_FIXNUM)
error ("Glyph code 0x%X is too large", code);
- ASET (g, 0, make_number (i));
- ASET (g, 1, make_number (i + 1));
+ LGLYPH_SET_FROM (g, make_number (i));
+ LGLYPH_SET_TO (g, make_number (i + 1));
LGLYPH_SET_CHAR (g, make_number (c));
LGLYPH_SET_CODE (g, make_number (code));
}
if (! NILP (object))
Fset_buffer (object);
validate_region (&start, &end);
- if (XINT (end) - XINT (start) > len)
+ if (XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
args_out_of_range (start, end);
len = XINT (end) - XINT (start);
pos = XINT (start);
code = font->driver->encode_char (font, c);
if (code > MOST_POSITIVE_FIXNUM)
error ("Glyph code 0x%X is too large", code);
- ASET (g, 0, make_number (i));
- ASET (g, 1, make_number (i + 1));
+ LGLYPH_SET_FROM (g, make_number (i));
+ LGLYPH_SET_TO (g, make_number (i + 1));
LGLYPH_SET_CHAR (g, make_number (c));
LGLYPH_SET_CODE (g, make_number (code));
}
}
+ for (i = LGSTRING_LENGTH (gstring) - 1; i >= len; i--)
+ {
+ Lisp_Object g = LGSTRING_GLYPH (gstring, i);
+
+ LGLYPH_SET_FROM (g, Qnil);
+ }
return Qnil;
}
+DEFUN ("font-otf-gsub", Ffont_otf_gsub, Sfont_otf_gsub, 6, 6, 0,
+ doc: /* Apply OpenType "GSUB" features on glyph-string GSTRING-IN.
+FEATURE-SPEC specifies which featuress to apply in this format:
+ (SCRIPT LANGSYS FEATURE ...)
+where
+ SCRIPT is a symbol specifying a script tag of OpenType,
+ LANGSYS is a symbol specifying a langsys tag of OpenType,
+ FEATURE is a symbol specifying a feature tag of Opentype.
+
+If LANGYS is nil, the default langsys is selected.
+
+The features are applied in the order appeared in the list. FEATURE
+may be a symbol `*', in which case all available features not appeared
+in this list are applied, and the remaining FEATUREs are not ignored.
+For instance, (mlym nil vatu pstf * haln) means to apply vatu and pstf
+in this order, then to apply all available features other than vatu,
+pstf, and haln.
+
+The features are applied to the glyphs in the range FROM and TO of
+GSTRING-IN.
+
+If some of a feature is actually applicable, the resulting glyphs are
+produced in the glyph-string GSTRING-OUT from the index INDEX. In
+this case, the value is the number of produced glyphs.
+
+If no feature is applicable, no glyph is produced in GSTRING-OUT, and
+the value is 0.
+
+If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
+produced in GSTRING-OUT, and the value is nil.
+
+See the documentation of `font-make-gstring' for the format of
+glyph-string. */)
+ (feature_spec, gstring_in, from, to, gstring_out, index)
+ Lisp_Object feature_spec, gstring_in, from, to, gstring_out, index;
+{
+ Lisp_Object font_object = LGSTRING_FONT (gstring_in);
+ struct font *font = XSAVE_VALUE (font_object)->pointer;
+ int len, num;
+
+ CHECK_FONT_GET_OBJECT (font_object, font);
+ if (! font->driver->otf_gsub)
+ error ("Font backend %s can't drive OpenType GSUB table",
+ SDATA (SYMBOL_NAME (font->driver->type)));
+ CHECK_CONS (feature_spec);
+ len = check_gstring (gstring_in);
+ CHECK_VECTOR (gstring_out);
+ CHECK_NATNUM (from);
+ CHECK_NATNUM (to);
+ CHECK_NATNUM (index);
+
+ if (XINT (from) >= XINT (to) || XINT (to) > len)
+ args_out_of_range_3 (from, to, make_number (len));
+ if (XINT (index) >= ASIZE (gstring_out))
+ args_out_of_range (index, make_number (ASIZE (gstring_out)));
+ num = font->driver->otf_gsub (font, feature_spec,
+ gstring_in, XINT (from), XINT (to),
+ gstring_out, XINT (index), 0);
+ if (num < 0)
+ return Qnil;
+ return make_number (num);
+}
+
+
+DEFUN ("font-otf-gpos", Ffont_otf_gpos, Sfont_otf_gpos, 4, 4, 0,
+ doc: /* Apply OpenType "GPOS" features on glyph-string GSTRING.
+FEATURE-SPEC specifies which features to apply in this format:
+ (SCRIPT LANGSYS FEATURE ...)
+See the documentation of `font-otf-gsub' for more detail.
+
+The features are applied to the glyphs in the range FROM and TO of
+GSTRING. */)
+ (gpos_spec, gstring, from, to)
+ Lisp_Object gpos_spec, gstring, from, to;
+{
+ Lisp_Object font_object = LGSTRING_FONT (gstring);
+ struct font *font;
+ int len, num;
+
+ CHECK_FONT_GET_OBJECT (font_object, font);
+ if (! font->driver->otf_gpos)
+ error ("Font backend %s can't drive OpenType GPOS table",
+ SDATA (SYMBOL_NAME (font->driver->type)));
+ CHECK_CONS (gpos_spec);
+ len = check_gstring (gstring);
+ CHECK_NATNUM (from);
+ CHECK_NATNUM (to);
+
+ if (XINT (from) >= XINT (to) || XINT (to) > len)
+ args_out_of_range_3 (from, to, make_number (len));
+ num = font->driver->otf_gpos (font, gpos_spec,
+ gstring, XINT (from), XINT (to));
+ return (num <= 0 ? Qnil : Qt);
+}
+
+
+DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates,
+ 3, 3, 0,
+ doc: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
+FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
+in this format:
+ (SCRIPT LANGSYS FEATURE ...)
+See the documentation of `font-otf-gsub' for more detail.
+
+The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
+where GLYPH-ID is a glyph index of the font, and CHARACTER is a
+character code corresponding to the glyph or nil if there's no
+corresponding character. */)
+ (font_object, character, feature_spec)
+ Lisp_Object font_object, character, feature_spec;
+{
+ struct font *font;
+ Lisp_Object gstring_in, gstring_out, g;
+ Lisp_Object alternates;
+ int i, num;
+
+ CHECK_FONT_GET_OBJECT (font_object, font);
+ if (! font->driver->otf_gsub)
+ error ("Font backend %s can't drive OpenType GSUB table",
+ SDATA (SYMBOL_NAME (font->driver->type)));
+ CHECK_CHARACTER (character);
+ CHECK_CONS (feature_spec);
+
+ gstring_in = Ffont_make_gstring (font_object, make_number (1));
+ g = LGSTRING_GLYPH (gstring_in, 0);
+ LGLYPH_SET_CHAR (g, character);
+ gstring_out = Ffont_make_gstring (font_object, make_number (10));
+ while ((num = font->driver->otf_gsub (font, feature_spec, gstring_in, 0, 1,
+ gstring_out, 0, 1)) < 0)
+ gstring_out = Ffont_make_gstring (font_object,
+ make_number (ASIZE (gstring_out) * 2));
+ alternates = Qnil;
+ for (i = 0; i < num; i++)
+ {
+ Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
+ int c = XINT (LGLYPH_CHAR (g));
+ unsigned code = XUINT (LGLYPH_CODE (g));
+
+ alternates = Fcons (Fcons (make_number (code),
+ c > 0 ? make_number (c) : Qnil),
+ alternates);
+ }
+ return Fnreverse (alternates);
+}
+
#ifdef FONT_DEBUG
}
DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
- doc: /* Return information about FONT-OBJECT. */)
+ doc: /* Return information about FONT-OBJECT.
+The value is a vector:
+ [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
+ CAPABILITY ]
+
+NAME is a string of the font name (or nil if the font backend doesn't
+provide a name).
+
+FILENAME is a string of the font file (or nil if the font backend
+doesn't provide a file name).
+
+PIXEL-SIZE is a pixel size by which the font is opened.
+
+SIZE is a maximum advance width of the font in pixel.
+
+ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
+pixel.
+
+CAPABILITY is a list whose first element is a symbol representing the
+font format \(x, opentype, truetype, type1, pcf, or bdf) and the
+remaining elements describes a detail of the font capability.
+
+If the font is OpenType font, the form of the list is
+ \(opentype GSUB GPOS)
+where GSUB shows which "GSUB" features the font supports, and GPOS
+shows which "GPOS" features the font supports. Both GSUB and GPOS are
+lists of the format:
+ \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
+
+If the font is not OpenType font, currently the length of the form is
+one.
+
+SCRIPT is a symbol representing OpenType script tag.
+
+LANGSYS is a symbol representing OpenType langsys tag, or nil
+representing the default langsys.
+
+FEATURE is a symbol representing OpenType feature tag.
+
+If the font is not OpenType font, OTF-CAPABILITY is nil. */)
(font_object)
Lisp_Object font_object;
{
CHECK_FONT_GET_OBJECT (font_object, font);
val = Fmake_vector (make_number (9), Qnil);
- ASET (val, 0, Ffont_xlfd_name (font_object));
+ if (font->font.full_name)
+ ASET (val, 0, make_unibyte_string (font->font.full_name,
+ strlen (font->font.full_name)));
if (font->file_name)
ASET (val, 1, make_unibyte_string (font->file_name,
strlen (font->file_name)));
ASET (val, 6, make_number (font->font.space_width));
ASET (val, 7, make_number (font->font.average_width));
if (font->driver->otf_capability)
- ASET (val, 8, font->driver->otf_capability (font));
+ ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
+ else
+ ASET (val, 8, Fcons (font->format, Qnil));
return val;
}
return (font_match_p (spec, font) ? Qt : Qnil);
}
+DEFUN ("font-at", Ffont_at, Sfont_at, 1, 2, 0,
+ doc: /* Return a font-object for displaying a character at POSISTION.
+Optional second arg WINDOW, if non-nil, is a window displaying
+the current buffer. It defaults to the currently selected window. */)
+ (position, window)
+ Lisp_Object position, window;
+{
+ struct window *w;
+ EMACS_INT pos, pos_byte;
+ int c;
+
+ CHECK_NUMBER_COERCE_MARKER (position);
+ pos = XINT (position);
+ if (pos < BEGV || pos >= ZV)
+ args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
+ pos_byte = CHAR_TO_BYTE (pos);
+ c = FETCH_CHAR (pos_byte);
+ if (NILP (window))
+ window = selected_window;
+ CHECK_LIVE_WINDOW (window);
+ w = XWINDOW (selected_window);
+
+ return font_at (c, pos, NULL, w, Qnil);
+}
+
#if 0
DEFUN ("draw-string", Fdraw_string, Sdraw_string, 2, 2, 0,
doc: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
font_family_alist = Qnil;
DEFSYM (Qfontp, "fontp");
+ DEFSYM (Qopentype, "opentype");
DEFSYM (Qiso8859_1, "iso8859-1");
DEFSYM (Qiso10646_1, "iso10646-1");
DEFSYM (Qunicode_bmp, "unicode-bmp");
+ DEFSYM (Qunicode_sip, "unicode-sip");
DEFSYM (QCotf, ":otf");
DEFSYM (QClanguage, ":language");
defsubr (&Sinternal_set_font_style_table);
defsubr (&Sfont_make_gstring);
defsubr (&Sfont_fill_gstring);
+ defsubr (&Sfont_otf_gsub);
+ defsubr (&Sfont_otf_gpos);
+ defsubr (&Sfont_otf_alternates);
#ifdef FONT_DEBUG
defsubr (&Sopen_font);
defsubr (&Squery_font);
defsubr (&Sget_font_glyphs);
defsubr (&Sfont_match_p);
+ defsubr (&Sfont_at);
#if 0
defsubr (&Sdraw_string);
#endif