#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
+#ifdef HAVE_M17N_FLT
+#include <m17n-flt.h>
+#endif
#include "lisp.h"
#include "buffer.h"
#include "frame.h"
+#include "window.h"
#include "dispextern.h"
#include "charset.h"
#include "character.h"
#include "fontset.h"
#include "font.h"
+#ifndef FONT_DEBUG
#define FONT_DEBUG
+#endif
#ifdef FONT_DEBUG
#undef xassert
int enable_font_backend;
-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. */
/* Number of pt per inch (from the TeXbook). */
#define PT_PER_INCH 72.27
-/* Return a pixel size corresponding to POINT size (1/10 pt unit) on
- resolution RESY. */
-#define POINT_TO_PIXEL(POINT, RESY) ((POINT) * (RESY) / PT_PER_INCH / 10 + 0.5)
+/* Return a pixel size (integer) corresponding to POINT size (double)
+ on resolution DPI. */
+#define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5)
-#define PIXEL_TO_POINT(PIXEL, RESY) ((PIXEL) * PT_PER_INCH * 10 / (RESY) + 0.5)
+/* Return a point size (double) corresponding to POINT size (integer)
+ on resolution DPI. */
+#define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH * 10 / (DPI) + 0.5)
/* Special string of zero length. It is used to specify a NULL name
in a font properties (e.g. adstyle). We don't use the symbol of
Lisp_Object null_vector;
/* Vector of 3 elements. Each element is an alist for one of font
- style properties (weight, slant, width). The alist contains a
+ style properties (weight, slant, width). Each alist contains a
mapping between symbolic property values (e.g. `medium' for weight)
and numeric property values (e.g. 100). So, it looks like this:
[((thin . 0) ... (heavy . 210))
extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth, QCsize, QCname;
Lisp_Object QCfoundry, QCadstyle, QCregistry, QCextra;
/* Symbols representing keys of font extra info. */
-Lisp_Object QCotf, QClanguage, QCscript;
-
-/* List of all font drivers. All font-backends (XXXfont.c) call
- add_font_driver in syms_of_XXXfont to register the font-driver
+Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClanguage, QCscript;
+Lisp_Object QCantialias;
+/* Symbols representing values of font spacing property. */
+Lisp_Object Qc, Qm, Qp, Qd;
+
+/* Alist of font registry symbol and the corresponding charsets
+ information. The information is retrieved from
+ Vfont_encoding_alist on demand.
+
+ Eash element has the form:
+ (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
+ or
+ (REGISTRY . nil)
+
+ In the former form, ENCODING-CHARSET-ID is an ID of a charset that
+ encodes a character code to a glyph code of a font, and
+ REPERTORY-CHARSET-ID is an ID of a charset that tells if a
+ character is supported by a font.
+
+ The latter form means that the information for REGISTRY couldn't be
+ retrieved. */
+static Lisp_Object font_charset_alist;
+
+/* List of all font drivers. Each font-backend (XXXfont.c) calls
+ register_font_driver in syms_of_XXXfont to register its font-driver
here. */
static struct font_driver_list *font_driver_list;
+static int font_pixel_size P_ ((FRAME_PTR f, Lisp_Object));
static Lisp_Object prop_name_to_numeric P_ ((enum font_property_index,
Lisp_Object));
static Lisp_Object prop_numeric_to_name P_ ((enum font_property_index, int));
static Lisp_Object font_open_entity P_ ((FRAME_PTR, Lisp_Object, int));
+static void build_font_family_alist P_ ((void));
/* Number of registered font drivers. */
static int num_font_drivers;
+/* Return a pixel size of font-spec SPEC on frame F. */
+
+static int
+font_pixel_size (f, spec)
+ FRAME_PTR f;
+ Lisp_Object spec;
+{
+ Lisp_Object size = AREF (spec, FONT_SIZE_INDEX);
+ double point_size;
+ int pixel_size, dpi;
+ Lisp_Object extra, val;
+
+ if (INTEGERP (size))
+ return XINT (size);
+ if (NILP (size))
+ return 0;
+ point_size = XFLOAT_DATA (size);
+ extra = AREF (spec, FONT_EXTRA_INDEX);
+ val = assq_no_quit (QCdpi, extra);
+ if (CONSP (val))
+ {
+ if (INTEGERP (XCDR (val)))
+ dpi = XINT (XCDR (val));
+ else
+ dpi = XFLOAT_DATA (XCDR (val)) + 0.5;
+ }
+ else
+ dpi = f->resy;
+ pixel_size = POINT_TO_PIXEL (point_size, dpi);
+ return pixel_size;
+}
+
/* Return a numeric value corresponding to PROP's NAME (symbol). If
NAME is not registered in font_style_table, return Qnil. PROP must
be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
extern Lisp_Object Vface_alternative_font_family_alist;
+/* Setup font_family_alist of the form:
+ ((FAMILY-SYMBOL ALIAS-SYMBOL ...) ...)
+ from Vface_alternative_font_family_alist of the form:
+ ((FAMILY-STRING ALIAS-STRING ...) ...) */
+
static void
build_font_family_alist ()
{
}
}
-\f
-/* Font property validater. */
+extern Lisp_Object find_font_encoding P_ ((Lisp_Object));
-static Lisp_Object
-font_prop_validate_type (prop, val)
- enum font_property_index prop;
- Lisp_Object val;
+/* Return encoding charset and repertory charset for REGISTRY in
+ ENCODING and REPERTORY correspondingly. If correct information for
+ REGISTRY is available, return 0. Otherwise return -1. */
+
+int
+font_registry_charsets (registry, encoding, repertory)
+ Lisp_Object registry;
+ struct charset **encoding, **repertory;
{
- return (SYMBOLP (val) ? val : Qerror);
+ Lisp_Object val;
+ int encoding_id, repertory_id;
+
+ val = assq_no_quit (registry, font_charset_alist);
+ if (! NILP (val))
+ {
+ val = XCDR (val);
+ if (NILP (val))
+ return -1;
+ encoding_id = XINT (XCAR (val));
+ repertory_id = XINT (XCDR (val));
+ }
+ else
+ {
+ val = find_font_encoding (SYMBOL_NAME (registry));
+ if (SYMBOLP (val) && CHARSETP (val))
+ {
+ encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val));
+ }
+ else if (CONSP (val))
+ {
+ if (! CHARSETP (XCAR (val)))
+ goto invalid_entry;
+ encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val)));
+ if (NILP (XCDR (val)))
+ repertory_id = -1;
+ else
+ {
+ if (! CHARSETP (XCDR (val)))
+ goto invalid_entry;
+ repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val)));
+ }
+ }
+ else
+ goto invalid_entry;
+ val = Fcons (make_number (encoding_id), make_number (repertory_id));
+ font_charset_alist
+ = nconc2 (font_charset_alist, Fcons (Fcons (registry, val), Qnil));
+ }
+
+ if (encoding)
+ *encoding = CHARSET_FROM_ID (encoding_id);
+ if (repertory)
+ *repertory = repertory_id >= 0 ? CHARSET_FROM_ID (repertory_id) : NULL;
+ return 0;
+
+ invalid_entry:
+ font_charset_alist
+ = nconc2 (font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil));
+ return -1;
}
+\f
+/* Font property value validaters. See the comment of
+ font_property_table for the meaning of the arguments. */
+
+static Lisp_Object font_prop_validate_symbol P_ ((Lisp_Object, Lisp_Object));
+static Lisp_Object font_prop_validate_style P_ ((Lisp_Object, Lisp_Object));
+static Lisp_Object font_prop_validate_non_neg P_ ((Lisp_Object, Lisp_Object));
+static Lisp_Object font_prop_validate_spacing P_ ((Lisp_Object, Lisp_Object));
+static int get_font_prop_index P_ ((Lisp_Object, int));
+static Lisp_Object font_prop_validate P_ ((Lisp_Object));
+
static Lisp_Object
font_prop_validate_symbol (prop, val)
- enum font_property_index prop;
- Lisp_Object val;
+ Lisp_Object prop, val;
{
+ if (EQ (prop, QCotf))
+ return (SYMBOLP (val) ? val : Qerror);
if (STRINGP (val))
val = (SCHARS (val) == 0 ? null_string
: intern_downcase ((char *) SDATA (val), SBYTES (val)));
static Lisp_Object
font_prop_validate_style (prop, val)
- enum font_property_index prop;
- Lisp_Object val;
+ Lisp_Object prop, val;
{
if (! INTEGERP (val))
{
val = Qerror;
else
{
- val = prop_name_to_numeric (prop, val);
+ enum font_property_index prop_index
+ = (EQ (prop, QCweight) ? FONT_WEIGHT_INDEX
+ : EQ (prop, QCslant) ? FONT_SLANT_INDEX
+ : FONT_WIDTH_INDEX);
+
+ val = prop_name_to_numeric (prop_index, val);
if (NILP (val))
val = Qerror;
}
}
static Lisp_Object
-font_prop_validate_size (prop, val)
- enum font_property_index prop;
- Lisp_Object val;
+font_prop_validate_non_neg (prop, val)
+ Lisp_Object prop, val;
{
return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0)
? val : Qerror);
}
static Lisp_Object
-font_prop_validate_extra (prop, val)
- enum font_property_index prop;
- Lisp_Object val;
+font_prop_validate_spacing (prop, val)
+ Lisp_Object prop, val;
+{
+ if (NILP (val) || (NATNUMP (val) && XINT (val) <= FONT_SPACING_CHARCELL))
+ return val;
+ if (EQ (val, Qc))
+ return make_number (FONT_SPACING_CHARCELL);
+ if (EQ (val, Qm))
+ return make_number (FONT_SPACING_MONO);
+ if (EQ (val, Qp))
+ return make_number (FONT_SPACING_PROPORTIONAL);
+ return Qerror;
+}
+
+static Lisp_Object
+font_prop_validate_otf (prop, val)
+ Lisp_Object prop, val;
{
- Lisp_Object tail;
+ Lisp_Object tail, tmp;
+ int i;
- for (tail = val; CONSP (tail); tail = XCDR (tail))
+ /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
+ GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
+ GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
+ if (! CONSP (val))
+ return Qerror;
+ if (! SYMBOLP (XCAR (val)))
+ return Qerror;
+ tail = XCDR (val);
+ if (NILP (tail))
+ return val;
+ if (! CONSP (tail) || ! SYMBOLP (XCAR (val)))
+ return Qerror;
+ for (i = 0; i < 2; i++)
{
- Lisp_Object key = Fcar (XCAR (tail)), this_val = Fcdr (XCAR (tail));
-
- if (NILP (this_val))
- return Qnil;
- if (EQ (key, QClanguage))
- if (! SYMBOLP (this_val))
- {
- for (; CONSP (this_val); this_val = XCDR (this_val))
- if (! SYMBOLP (XCAR (this_val)))
- return Qerror;
- if (! NILP (this_val))
- return Qerror;
- }
- if (EQ (key, QCotf))
- if (! STRINGP (this_val))
+ tail = XCDR (tail);
+ if (NILP (tail))
+ return val;
+ if (! CONSP (tail))
+ return Qerror;
+ for (tmp = XCAR (tail); CONSP (tmp); tmp = XCDR (tmp))
+ if (! SYMBOLP (XCAR (tmp)))
return Qerror;
+ if (! NILP (tmp))
+ return Qerror;
}
- return (NILP (tail) ? val : Qerror);
+ return val;
}
-
+/* Structure of known font property keys and validater of the
+ values. */
struct
{
+ /* Pointer to the key symbol. */
Lisp_Object *key;
- Lisp_Object (*validater) P_ ((enum font_property_index prop,
- Lisp_Object val));
-} font_property_table[FONT_SPEC_MAX] =
- { { &QCtype, font_prop_validate_type },
+ /* Function to validate PROP's value VAL, or NULL if any value is
+ ok. The value is VAL or its regularized value if VAL is valid,
+ and Qerror if not. */
+ Lisp_Object (*validater) P_ ((Lisp_Object prop, Lisp_Object val));
+} font_property_table[] =
+ { { &QCtype, font_prop_validate_symbol },
{ &QCfoundry, font_prop_validate_symbol },
{ &QCfamily, font_prop_validate_symbol },
{ &QCadstyle, font_prop_validate_symbol },
{ &QCweight, font_prop_validate_style },
{ &QCslant, font_prop_validate_style },
{ &QCwidth, font_prop_validate_style },
- { &QCsize, font_prop_validate_size },
- { &QCextra, font_prop_validate_extra }
+ { &QCsize, font_prop_validate_non_neg },
+ { &QClanguage, font_prop_validate_symbol },
+ { &QCscript, font_prop_validate_symbol },
+ { &QCdpi, font_prop_validate_non_neg },
+ { &QCspacing, font_prop_validate_spacing },
+ { &QCscalable, NULL },
+ { &QCotf, font_prop_validate_otf },
+ { &QCantialias, font_prop_validate_symbol }
};
-static enum font_property_index
-check_font_prop_name (key)
+/* 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. Start searching font_property_table from
+ index FROM (which is 0 or FONT_EXTRA_INDEX). */
+
+static int
+get_font_prop_index (key, from)
Lisp_Object key;
+ int from;
{
- enum font_property_index i;
-
- for (i = FONT_TYPE_INDEX; i < FONT_SPEC_MAX; i++)
- if (EQ (key, *font_property_table[i].key))
- break;
- return i;
+ for (; from < FONT_PROPERTY_TABLE_SIZE; from++)
+ if (EQ (key, *font_property_table[from].key))
+ return from;
+ return -1;
}
+/* Validate font properties in SPEC (vector) while updating elements
+ to regularized values. Signal an error if an invalid property is
+ found. */
+
static Lisp_Object
font_prop_validate (spec)
Lisp_Object spec;
{
- enum font_property_index i;
- Lisp_Object val;
+ int i;
+ Lisp_Object prop, val, extra;
- for (i = FONT_TYPE_INDEX; i <= FONT_EXTRA_INDEX; i++)
+ for (i = FONT_TYPE_INDEX; i < FONT_EXTRA_INDEX; i++)
{
if (! NILP (AREF (spec, i)))
{
- val = (font_property_table[i].validater) (i, AREF (spec, i));
+ prop = *font_property_table[i].key;
+ val = (font_property_table[i].validater) (prop, AREF (spec, i));
if (EQ (val, Qerror))
- Fsignal (Qerror, list3 (build_string ("invalid font property"),
- *font_property_table[i].key,
- AREF (spec, i)));
+ Fsignal (Qfont, list2 (build_string ("invalid font property"),
+ Fcons (prop, AREF (spec, i))));
ASET (spec, i, val);
}
}
+ for (extra = AREF (spec, FONT_EXTRA_INDEX);
+ CONSP (extra); extra = XCDR (extra))
+ {
+ Lisp_Object elt = XCAR (extra);
+
+ prop = XCAR (elt);
+ i = get_font_prop_index (prop, FONT_EXTRA_INDEX);
+ if (i >= 0
+ && font_property_table[i].validater)
+ {
+ val = (font_property_table[i].validater) (prop, XCDR (elt));
+ if (EQ (val, Qerror))
+ Fsignal (Qfont, list2 (build_string ("invalid font property"),
+ elt));
+ XSETCDR (elt, val);
+ }
+ }
return spec;
}
+/* Store VAL as a value of extra font property PROP in FONT. */
+
+Lisp_Object
+font_put_extra (font, prop, val)
+ Lisp_Object font, prop, val;
+{
+ Lisp_Object extra = AREF (font, FONT_EXTRA_INDEX);
+ Lisp_Object slot = (NILP (extra) ? Qnil : assq_no_quit (prop, extra));
+
+ if (NILP (slot))
+ {
+ extra = Fcons (Fcons (prop, val), extra);
+ ASET (font, FONT_EXTRA_INDEX, extra);
+ return val;
+ }
+ XSETCDR (slot, val);
+ return val;
+}
+
\f
/* Font name parser and unparser */
-/* An enumerator for each field of an XLFD font name. */
+static Lisp_Object intern_font_field P_ ((char *, int));
+static int parse_matrix P_ ((char *));
+static int font_expand_wildcards P_ ((Lisp_Object *, int));
+static int font_parse_name P_ ((char *, Lisp_Object));
+/* An enumerator for each field of an XLFD font name. */
enum xlfd_field_index
{
XLFD_FOUNDRY_INDEX,
XLFD_LAST_INDEX
};
+/* An enumerator for mask bit corresponding to each XLFD field. */
enum xlfd_field_mask
{
XLFD_FOUNDRY_MASK = 0x0001,
};
-/* Return a Lispy value for string at STR and bytes LEN.
- If LEN == 0, return a null string.
- If the string is "*", return Qnil.
- It is assured that LEN < 256. */
+/* Return a Lispy value of a XLFD font field at STR and LEN bytes.
+ If LEN is zero, it returns `null_string'.
+ If STR is "*", it returns nil.
+ If all characters in STR are digits, it returns an integer.
+ Otherwise, it returns a symbol interned from downcased STR. */
static Lisp_Object
intern_font_field (str, len)
multiple fields to fill in all 14 XLFD fields while restring a
field position by its contents. */
-int
+static int
font_expand_wildcards (field, n)
Lisp_Object field[XLFD_LAST_INDEX];
int n;
int mask;
} range[XLFD_LAST_INDEX];
int i, j;
+ int range_from, range_to;
unsigned range_mask;
#define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
| XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
#define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
-#define XLFD_SMALLNUM_MASK (XLFD_PIXEL_MASK | XLFD_ENCODING_MASK)
#define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
- | XLFD_AVGWIDTH_MASK | XLFD_ENCODING_MASK)
+ | XLFD_AVGWIDTH_MASK)
#define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
/* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
for (i = 0, range_mask = 0; i <= 14 - n; i++)
range_mask = (range_mask << 1) | 1;
- for (i = 0; i < n; i++, range_mask <<= 1)
+ /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
+ position-based retriction for FIELD[I]. */
+ for (i = 0, range_from = 0, range_to = 14 - n; i < n;
+ i++, range_from++, range_to++, range_mask <<= 1)
{
- /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
- position-based retriction for FIELD[I]. */
- int range_from = i, range_to = 14 - n + i;
Lisp_Object val = field[i];
tmp[i] = val;
{
int numeric = XINT (val);
- if (numeric <= 48)
- from = XLFD_PIXEL_INDEX, to = XLFD_ENCODING_INDEX,
- mask = XLFD_SMALLNUM_MASK;
- else
- from = XLFD_POINT_INDEX, to = XLFD_ENCODING_INDEX,
+ if (i + 1 == n)
+ from = to = XLFD_ENCODING_INDEX,
+ mask = XLFD_ENCODING_MASK;
+ else if (numeric == 0)
+ from = XLFD_PIXEL_INDEX, to = XLFD_AVGWIDTH_INDEX,
+ mask = XLFD_PIXEL_MASK | XLFD_LARGENUM_MASK;
+ else if (numeric <= 48)
+ from = to = XLFD_PIXEL_INDEX,
+ mask = XLFD_PIXEL_MASK;
+ else
+ from = XLFD_POINT_INDEX, to = XLFD_AVGWIDTH_INDEX,
mask = XLFD_LARGENUM_MASK;
}
else if (EQ (val, null_string))
from = to = XLFD_ENCODING_INDEX,
mask = XLFD_ENCODING_MASK;
}
- else if (!NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX, val)))
+ else if (range_from <= XLFD_WEIGHT_INDEX
+ && range_to >= XLFD_WEIGHT_INDEX
+ && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX, val)))
from = to = XLFD_WEIGHT_INDEX, mask = XLFD_WEIGHT_MASK;
- else if (!NILP (prop_name_to_numeric (FONT_SLANT_INDEX, val)))
+ else if (range_from <= XLFD_SLANT_INDEX
+ && range_to >= XLFD_SLANT_INDEX
+ && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX, val)))
from = to = XLFD_SLANT_INDEX, mask = XLFD_SLANT_MASK;
- else if (!NILP (prop_name_to_numeric (FONT_WIDTH_INDEX, val)))
+ else if (range_from <= XLFD_SWIDTH_INDEX
+ && range_to >= XLFD_SWIDTH_INDEX
+ && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX, val)))
from = to = XLFD_SWIDTH_INDEX, mask = XLFD_SWIDTH_MASK;
else
{
- Lisp_Object name = SYMBOL_NAME (val);
-
- if (SBYTES (name) == 1
- && (SDATA (name)[0] == 'c'
- || SDATA (name)[0] == 'm'
- || SDATA (name)[0] == 'p'))
+ if (EQ (val, Qc) || EQ (val, Qm) || EQ (val, Qp) || EQ (val, Qd))
from = to = XLFD_SPACING_INDEX, mask = XLFD_SPACING_MASK;
else
from = XLFD_FOUNDRY_INDEX, to = XLFD_ENCODING_INDEX,
range[i].mask = mask;
if (from > range_from || to < range_to)
- /* The range is narrowed by value-based restrictions.
- Reflect it to the previous fields. */
- for (j = i - 1, from--, to--; j >= 0; j--, from--, to--)
- {
- /* Check FROM for non-wildcard field. */
- if (! NILP (tmp[j]) && range[j].from < from)
- {
- while (range[j].from < from)
- range[j].mask &= ~(1 << range[j].from++);
- while (from < 14 && ! (range[j].mask & (1 << from)))
- from++;
- range[j].from = from;
- }
- else
- from = range[j].from;
- if (range[j].to > to)
- {
- while (range[j].to > to)
- range[j].mask &= ~(1 << range[j].to--);
- while (to >= 0 && ! (range[j].mask & (1 << to)))
- to--;
- range[j].to = to;
- }
- else
- to = range[j].to;
- if (from > to)
- return -1;
- }
+ {
+ /* The range is narrowed by value-based restrictions.
+ Reflect it to the other fields. */
+
+ /* Following fields should be after FROM. */
+ range_from = from;
+ /* Preceding fields should be before TO. */
+ for (j = i - 1, from--, to--; j >= 0; j--, from--, to--)
+ {
+ /* Check FROM for non-wildcard field. */
+ if (! NILP (tmp[j]) && range[j].from < from)
+ {
+ while (range[j].from < from)
+ range[j].mask &= ~(1 << range[j].from++);
+ while (from < 14 && ! (range[j].mask & (1 << from)))
+ from++;
+ range[j].from = from;
+ }
+ else
+ from = range[j].from;
+ if (range[j].to > to)
+ {
+ while (range[j].to > to)
+ range[j].mask &= ~(1 << range[j].to--);
+ while (to >= 0 && ! (range[j].mask & (1 << to)))
+ to--;
+ range[j].to = to;
+ }
+ else
+ to = range[j].to;
+ if (from > to)
+ return -1;
+ }
+ }
}
}
return 0;
}
-/* Parse NAME (null terminated) as XLFD format, and store information
- in FONT (font-spec or font-entity). If NAME is successfully
- parsed, return 2 (non-scalable font), 1 (scalable vector font), or
- 0 (auto-scaled font). Otherwise return -1.
+/* Parse NAME (null terminated) as XLFD and store information in FONT
+ (font-spec or font-entity). Size property of FONT is set as
+ follows:
+ specified XLFD fields FONT property
+ --------------------- -------------
+ PIXEL_SIZE PIXEL_SIZE (Lisp integer)
+ POINT_SIZE and RESY calculated pixel size (Lisp integer)
+ POINT_SIZE POINT_SIZE/10 (Lisp float)
- If FONT is a font-entity, store RESY-SPACING-AVWIDTH information as
- a symbol in FONT_EXTRA_INDEX.
+ If NAME is successfully parsed, return 0. Otherwise return -1.
- If MERGE is nonzero, set a property of FONT only when it's nil. */
+ FONT is usually a font-spec, but when this function is called from
+ X font backend driver, it is a font-entity. In that case, NAME is
+ a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a
+ symbol RESX-RESY-SPACING-AVGWIDTH.
+*/
int
-font_parse_xlfd (name, font, merge)
+font_parse_xlfd (name, font)
char *name;
Lisp_Object font;
- int merge;
{
int len = strlen (name);
int i, j;
- int pixel_size, resy, avgwidth;
- double point_size;
- Lisp_Object f[XLFD_LAST_INDEX];
+ Lisp_Object dpi, spacing;
+ int avgwidth;
+ char *f[XLFD_LAST_INDEX + 1];
Lisp_Object val;
char *p;
if (len > 255)
/* Maximum XLFD name length is 255. */
return -1;
- i = (name[0] == '*' && name[1] == '-');
- for (p = name + 1; *p; p++)
- {
- if (*p == '-')
- {
- i++;
- if (i == XLFD_ENCODING_INDEX)
- break;
- }
- }
+ /* Accept "*-.." as a fully specified XLFD. */
+ if (name[0] == '*' && name[1] == '-')
+ i = 1, f[XLFD_FOUNDRY_INDEX] = name;
+ else
+ i = 0;
+ for (p = name + i; *p; p++)
+ if (*p == '-' && i < XLFD_LAST_INDEX)
+ f[i++] = p + 1;
+ f[i] = p;
- pixel_size = resy = avgwidth = -1;
- point_size = -1;
+ dpi = spacing = Qnil;
+ avgwidth = -1;
- if (i == XLFD_ENCODING_INDEX)
+ if (i == XLFD_LAST_INDEX)
{
+ int pixel_size;
+
/* Fully specified XLFD. */
- if (name[0] == '-')
- name++;
- for (i = 0, p = name; ; p++)
+ for (i = 0, j = FONT_FOUNDRY_INDEX; i < XLFD_WEIGHT_INDEX; i++, j++)
+ {
+ val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
+ if (! NILP (val))
+ ASET (font, j, val);
+ }
+ for (j = FONT_WEIGHT_INDEX; i < XLFD_ADSTYLE_INDEX; i++, j++)
{
- if (*p == '-')
+ val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
+ if (! NILP (val))
{
- if (i < XLFD_PIXEL_INDEX)
- f[i++] = intern_font_field (name, p - name);
- else if (i == XLFD_PIXEL_INDEX)
- {
- if (isdigit (*name))
- pixel_size = atoi (name);
- else if (*name == '[')
- pixel_size = parse_matrix (name);
- i++;
- }
- else if (i == XLFD_POINT_INDEX)
- {
- if (pixel_size < 0)
- {
- if (isdigit (*name))
- point_size = atoi (name);
- else if (*name == '[')
- point_size = parse_matrix (name);
- }
- i++;
- }
- else if (i == XLFD_RESX_INDEX)
- {
- /* Skip this field. */
- f[i++] = Qnil;
- }
- else if (i == XLFD_RESY_INDEX)
- {
- /* Stuff RESY, SPACING, and AVGWIDTH. */
- if (pixel_size < 0 && isdigit (*name))
- resy = atoi (name);
- for (p++; *p != '-'; p++);
- if (isdigit (p[1]))
- avgwidth = atoi (p + 1);
- else if (p[1] == '~' && isdigit (p[2]))
- avgwidth = atoi (p + 2);
- for (p++; *p != '-'; p++);
- if (FONT_ENTITY_P (font))
- f[i] = intern_font_field (name, p - name);
- else
- f[i] = Qnil;
- i = XLFD_REGISTRY_INDEX;
- }
+ Lisp_Object numeric = prop_name_to_numeric (j, val);
+
+ if (INTEGERP (numeric))
+ val = numeric;
+ ASET (font, j, val);
+ }
+ }
+ val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
+ if (! NILP (val))
+ ASET (font, FONT_ADSTYLE_INDEX, val);
+ i = XLFD_REGISTRY_INDEX;
+ val = intern_font_field (f[i], f[i + 2] - f[i]);
+ if (! NILP (val))
+ ASET (font, FONT_REGISTRY_INDEX, val);
+
+ p = f[XLFD_PIXEL_INDEX];
+ if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0)
+ ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
+ else
+ {
+ i = XLFD_PIXEL_INDEX;
+ val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
+ if (! NILP (val))
+ ASET (font, FONT_SIZE_INDEX, val);
+ else
+ {
+ double point_size = -1;
+
+ xassert (FONT_SPEC_P (font));
+ p = f[XLFD_POINT_INDEX];
+ if (*p == '[')
+ point_size = parse_matrix (p);
+ else if (isdigit (*p))
+ point_size = atoi (p), point_size /= 10;
+ if (point_size >= 0)
+ ASET (font, FONT_SIZE_INDEX, make_float (point_size));
else
{
- /* Stuff REGISTRY and ENCODING. */
- for (p++; *p; p++);
- f[i++] = intern_font_field (name, p - name);
- break;
+ i = XLFD_PIXEL_INDEX;
+ val = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
+ if (! NILP (val))
+ ASET (font, FONT_SIZE_INDEX, val);
}
- name = p + 1;
}
}
- xassert (i == XLFD_ENCODING_INDEX);
+
+ /* Parse RESX, RESY, SPACING, and AVGWIDTH. */
+ if (FONT_ENTITY_P (font))
+ {
+ i = XLFD_RESX_INDEX;
+ ASET (font, FONT_EXTRA_INDEX,
+ intern_font_field (f[i], f[XLFD_REGISTRY_INDEX] - 1 - f[i]));
+ return 0;
+ }
+
+ /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set
+ in FONT_EXTRA_INDEX later. */
+ i = XLFD_RESX_INDEX;
+ dpi = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
+ i = XLFD_SPACING_INDEX;
+ spacing = intern_font_field (f[i], f[i + 1] - 1 - f[i]);
+ p = f[XLFD_AVGWIDTH_INDEX];
+ if (*p == '~')
+ p++;
+ if (isdigit (*p))
+ avgwidth = atoi (p);
}
else
{
int wild_card_found = 0;
+ Lisp_Object prop[XLFD_LAST_INDEX];
- if (name[0] == '-')
- name++;
- for (i = 0, p = name; ; p++)
+ for (j = 0; j < i; j++)
{
- if (*p == '-' || ! *p)
+ if (*f[j] == '*')
{
- if (*name == '*')
- {
- if (name + 1 != p)
- return -1;
- f[i++] = Qnil;
- wild_card_found = 1;
- }
- else if (isdigit (*name))
- {
- f[i++] = make_number (atoi (name));
- /* Check if all chars in this field is number. */
- name++;
- while (isdigit (*name)) name++;
- if (name != p)
- return -1;
- }
- else if (p == name)
- f[i++] = null_string;
+ if (f[j][1] && f[j][1] != '-')
+ return -1;
+ prop[j] = Qnil;
+ wild_card_found = 1;
+ }
+ else if (isdigit (*f[j]))
+ {
+ for (p = f[j] + 1; isdigit (*p); p++);
+ if (*p && *p != '-')
+ prop[j] = intern_downcase (f[j], p - f[j]);
else
- {
- f[i++] = intern_downcase (name, p - name);
- }
- if (! *p)
- break;
- name = p + 1;
+ prop[j] = make_number (atoi (f[j]));
}
+ else if (j + 1 < i)
+ prop[j] = intern_font_field (f[j], f[j + 1] - 1 - f[j]);
+ else
+ prop[j] = intern_font_field (f[j], f[i] - f[j]);
}
if (! wild_card_found)
return -1;
- if (font_expand_wildcards (f, i) < 0)
+ if (font_expand_wildcards (prop, i) < 0)
return -1;
- if (! NILP (f[XLFD_PIXEL_INDEX]))
- pixel_size = XINT (f[XLFD_PIXEL_INDEX]);
- if (! NILP (f[XLFD_POINT_INDEX]))
- point_size = XINT (f[XLFD_POINT_INDEX]);
- if (! NILP (f[XLFD_RESY_INDEX]))
- resy = XINT (f[XLFD_RESY_INDEX]);
- if (! NILP (f[XLFD_AVGWIDTH_INDEX]))
- avgwidth = XINT (f[XLFD_AVGWIDTH_INDEX]);
- if (NILP (f[XLFD_REGISTRY_INDEX]))
+
+ for (i = 0, j = FONT_FOUNDRY_INDEX; i < XLFD_WEIGHT_INDEX; i++, j++)
+ if (! NILP (prop[i]))
+ ASET (font, j, prop[i]);
+ for (j = FONT_WEIGHT_INDEX; i < XLFD_ADSTYLE_INDEX; i++, j++)
+ if (! NILP (prop[i]))
+ ASET (font, j, prop[i]);
+ if (! NILP (prop[XLFD_ADSTYLE_INDEX]))
+ ASET (font, FONT_ADSTYLE_INDEX, prop[XLFD_ADSTYLE_INDEX]);
+ val = prop[XLFD_REGISTRY_INDEX];
+ if (NILP (val))
{
- if (! NILP (f[XLFD_ENCODING_INDEX]))
- f[XLFD_REGISTRY_INDEX]
- = Fintern (concat2 (build_string ("*-"),
- SYMBOL_NAME (f[XLFD_ENCODING_INDEX])), Qnil);
+ val = prop[XLFD_ENCODING_INDEX];
+ if (! NILP (val))
+ val = Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val)),
+ Qnil);
}
+ else if (NILP (prop[XLFD_ENCODING_INDEX]))
+ val = Fintern (concat2 (SYMBOL_NAME (val), build_string ("-*")),
+ Qnil);
else
+ val = Fintern (concat3 (SYMBOL_NAME (val), build_string ("-"),
+ SYMBOL_NAME (prop[XLFD_ENCODING_INDEX])),
+ Qnil);
+ if (! NILP (val))
+ ASET (font, FONT_REGISTRY_INDEX, val);
+
+ if (INTEGERP (prop[XLFD_PIXEL_INDEX]))
+ ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]);
+ else if (INTEGERP (prop[XLFD_POINT_INDEX]))
{
- if (! NILP (f[XLFD_ENCODING_INDEX]))
- f[XLFD_REGISTRY_INDEX]
- = Fintern (concat2 (SYMBOL_NAME (f[XLFD_REGISTRY_INDEX]),
- SYMBOL_NAME (f[XLFD_ENCODING_INDEX])), Qnil);
- }
- }
-
- if (! merge || NILP (AREF (font, FONT_FOUNDRY_INDEX)))
- ASET (font, FONT_FOUNDRY_INDEX, f[XLFD_FOUNDRY_INDEX]);
- if (! merge || NILP (AREF (font, FONT_FAMILY_INDEX)))
- ASET (font, FONT_FAMILY_INDEX, f[XLFD_FAMILY_INDEX]);
- if (! merge || NILP (AREF (font, FONT_ADSTYLE_INDEX)))
- ASET (font, FONT_ADSTYLE_INDEX, f[XLFD_ADSTYLE_INDEX]);
- if (! merge || NILP (AREF (font, FONT_REGISTRY_INDEX)))
- ASET (font, FONT_REGISTRY_INDEX, f[XLFD_REGISTRY_INDEX]);
-
- for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX;
- j <= XLFD_SWIDTH_INDEX; i++, j++)
- if (! merge || NILP (AREF (font, i)))
- {
- if (! INTEGERP (f[j]))
- {
- val = prop_name_to_numeric (i, f[j]);
- if (INTEGERP (val))
- f[j] = val;
- }
- ASET (font, i, f[j]);
- }
+ double point_size = XINT (prop[XLFD_POINT_INDEX]);
- if (pixel_size < 0 && FONT_ENTITY_P (font))
- return -1;
-
- if (! merge || NILP (AREF (font, FONT_SIZE_INDEX)))
- {
- if (pixel_size >= 0)
- ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
- else if (point_size >= 0)
- {
- if (resy > 0)
- {
- pixel_size = POINT_TO_PIXEL (point_size, resy);
- ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
- }
- else
- {
- ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10));
- }
+ ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10));
}
+
+ dpi = prop[XLFD_RESX_INDEX];
+ spacing = prop[XLFD_SPACING_INDEX];
+ if (INTEGERP (prop[XLFD_AVGWIDTH_INDEX]))
+ avgwidth = XINT (prop[XLFD_AVGWIDTH_INDEX]);
}
- if (FONT_ENTITY_P (font)
- && EQ (AREF (font, FONT_TYPE_INDEX), Qx))
- ASET (font, FONT_EXTRA_INDEX, f[XLFD_RESY_INDEX]);
+ if (! NILP (dpi))
+ font_put_extra (font, QCdpi, dpi);
+ if (! NILP (spacing))
+ font_put_extra (font, QCspacing, spacing);
+ if (avgwidth >= 0)
+ font_put_extra (font, QCscalable, avgwidth == 0 ? Qt : Qnil);
- return (avgwidth > 0 ? 2 : resy == 0);
+ return 0;
}
/* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
char *name;
int nbytes;
{
- char *f[XLFD_REGISTRY_INDEX + 1], *pixel_point;
- char work[256];
+ char *f[XLFD_REGISTRY_INDEX + 1];
Lisp_Object val;
int i, j, len = 0;
xassert (NUMBERP (val) || NILP (val));
if (INTEGERP (val))
{
+ f[XLFD_PIXEL_INDEX] = alloca (22);
i = XINT (val);
if (i > 0)
- len += sprintf (work, "%d", i) + 1;
+ len += sprintf (f[XLFD_PIXEL_INDEX], "%d-*", i) + 1;
else /* i == 0 */
- len += sprintf (work, "%d-*", pixel_size) + 1;
- pixel_point = work;
+ len += sprintf (f[XLFD_PIXEL_INDEX], "%d-*", pixel_size) + 1;
}
else if (FLOATP (val))
{
+ f[XLFD_PIXEL_INDEX] = alloca (12);
i = XFLOAT_DATA (val) * 10;
- len += sprintf (work, "*-%d", i) + 1;
- pixel_point = work;
+ len += sprintf (f[XLFD_PIXEL_INDEX], "*-%d", i) + 1;
}
else
- pixel_point = "*-*", len += 4;
+ f[XLFD_PIXEL_INDEX] = "*-*", len += 4;
+
+ val = AREF (font, FONT_EXTRA_INDEX);
if (FONT_ENTITY_P (font)
&& EQ (AREF (font, FONT_TYPE_INDEX), Qx))
{
- /* Setup names for RESY-SPACING-AVWIDTH. */
- val = AREF (font, FONT_EXTRA_INDEX);
+ /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
if (SYMBOLP (val) && ! NILP (val))
{
val = SYMBOL_NAME (val);
- f[XLFD_RESY_INDEX] = (char *) SDATA (val), len += SBYTES (val) + 1;
+ f[XLFD_RESX_INDEX] = (char *) SDATA (val), len += SBYTES (val) + 1;
}
else
- f[XLFD_RESY_INDEX] = "*-*-*", len += 6;
+ f[XLFD_RESX_INDEX] = "*-*-*-*", len += 6;
}
else
- f[XLFD_RESY_INDEX] = "*-*-*", len += 6;
+ {
+ Lisp_Object dpi = assq_no_quit (QCdpi, val);
+ Lisp_Object spacing = assq_no_quit (QCspacing, val);
+ Lisp_Object scalable = assq_no_quit (QCscalable, val);
+
+ if (CONSP (dpi) || CONSP (spacing) || CONSP (scalable))
+ {
+ char *str = alloca (24);
+ int this_len;
+
+ if (CONSP (dpi) && INTEGERP (XCDR (dpi)))
+ this_len = sprintf (str, "%d-%d",
+ XINT (XCDR (dpi)), XINT (XCDR (dpi)));
+ else
+ this_len = sprintf (str, "*-*");
+ if (CONSP (spacing) && ! NILP (XCDR (spacing)))
+ {
+ val = XCDR (spacing);
+ if (INTEGERP (val))
+ {
+ if (XINT (val) < FONT_SPACING_MONO)
+ val = Qp;
+ else if (XINT (val) < FONT_SPACING_CHARCELL)
+ val = Qm;
+ else
+ val = Qc;
+ }
+ xassert (SYMBOLP (val));
+ this_len += sprintf (str + this_len, "-%c",
+ SDATA (SYMBOL_NAME (val))[0]);
+ }
+ else
+ this_len += sprintf (str + this_len, "-*");
+ if (CONSP (scalable) && ! NILP (XCDR (spacing)))
+ this_len += sprintf (str + this_len, "-0");
+ else
+ this_len += sprintf (str + this_len, "-*");
+ f[XLFD_RESX_INDEX] = str;
+ len += this_len;
+ }
+ else
+ f[XLFD_RESX_INDEX] = "*-*-*-*", len += 8;
+ }
- len += 3; /* for "-*" of resx, and terminating '\0'. */
+ len++; /* for terminating '\0'. */
if (len >= nbytes)
return -1;
- return sprintf (name, "-%s-%s-%s-%s-%s-%s-%s-*-%s-%s",
+ return sprintf (name, "-%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],
f[XLFD_SWIDTH_INDEX],
- f[XLFD_ADSTYLE_INDEX], pixel_point,
- f[XLFD_RESY_INDEX], f[XLFD_REGISTRY_INDEX]);
+ f[XLFD_ADSTYLE_INDEX], f[XLFD_PIXEL_INDEX],
+ f[XLFD_RESX_INDEX], f[XLFD_REGISTRY_INDEX]);
}
-void
-font_merge_old_spec (name, family, registry, spec)
- Lisp_Object name, family, registry, spec;
+/* Parse NAME (null terminated) as Fonconfig's name format and store
+ information in FONT (font-spec or font-entity). If NAME is
+ successfully parsed, return 0. Otherwise return -1. */
+
+int
+font_parse_fcname (name, font)
+ char *name;
+ Lisp_Object font;
{
- if (STRINGP (name))
+ char *p0, *p1;
+ int len = strlen (name);
+ char *copy;
+
+ if (len == 0)
+ return -1;
+ /* It is assured that (name[0] && name[0] != '-'). */
+ if (name[0] == ':')
+ p0 = name;
+ else
{
- if (font_parse_xlfd ((char *) SDATA (name), spec, 1) < 0)
+ Lisp_Object family;
+ double point_size;
+
+ for (p0 = name + 1; *p0 && (*p0 != '-' && *p0 != ':'); p0++)
+ if (*p0 == '\\' && p0[1])
+ p0++;
+ family = intern_font_field (name, p0 - name);
+ if (*p0 == '-')
{
- Lisp_Object extra = Fcons (Fcons (QCname, name), Qnil);
-
- ASET (spec, FONT_EXTRA_INDEX, extra);
+ if (! isdigit (p0[1]))
+ return -1;
+ point_size = strtod (p0 + 1, &p1);
+ if (*p1 && *p1 != ':')
+ return -1;
+ ASET (font, FONT_SIZE_INDEX, make_float (point_size));
+ p0 = p1;
}
+ ASET (font, FONT_FAMILY_INDEX, family);
}
- else
+
+ len -= p0 - name;
+ copy = alloca (len + 1);
+ if (! copy)
+ return -1;
+ name = copy;
+
+ /* Now parse ":KEY=VAL" patterns. Store known keys and values in
+ extra, copy unknown ones to COPY. */
+ while (*p0)
{
- if (! NILP (family))
- {
- int len;
- char *p0, *p1;
+ Lisp_Object key, val;
+ int prop;
- xassert (STRINGP (family));
- len = SBYTES (family);
- p0 = (char *) SDATA (family);
- p1 = index (p0, '-');
- if (p1)
+ for (p1 = p0 + 1; *p1 && *p1 != '=' && *p1 != ':'; p1++);
+ if (*p1 != '=')
+ {
+ /* Must be an enumerated value. */
+ val = intern_font_field (p0 + 1, p1 - p0 - 1);
+ if (memcmp (p0 + 1, "light", 5) == 0
+ || memcmp (p0 + 1, "medium", 6) == 0
+ || memcmp (p0 + 1, "demibold", 8) == 0
+ || memcmp (p0 + 1, "bold", 4) == 0
+ || memcmp (p0 + 1, "black", 5) == 0)
{
- if (NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
- ASET (spec, FONT_FOUNDRY_INDEX,
- intern_downcase (p0, p1 - p0));
- if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
- ASET (spec, FONT_FAMILY_INDEX,
- intern_downcase (p1 + 1, len - (p1 + 1 - p0)));
+ ASET (font, FONT_WEIGHT_INDEX, val);
+ }
+ else if (memcmp (p0 + 1, "roman", 5) == 0
+ || memcmp (p0 + 1, "italic", 6) == 0
+ || memcmp (p0 + 1, "oblique", 7) == 0)
+ {
+ ASET (font, FONT_SLANT_INDEX, val);
+ }
+ else if (memcmp (p0 + 1, "charcell", 8) == 0
+ || memcmp (p0 + 1, "mono", 4) == 0
+ || memcmp (p0 + 1, "proportional", 12) == 0)
+ {
+ font_put_extra (font, QCspacing,
+ (p0[1] == 'c' ? Qc : p0[1] == 'm' ? Qm : Qp));
+ }
+ else
+ {
+ /* unknown key */
+ bcopy (p0, copy, p1 - p0);
+ copy += p1 - p0;
}
- else if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
- ASET (spec, FONT_FAMILY_INDEX, intern_downcase (p0, len));
}
- if (! NILP (registry)
- && NILP (AREF (spec, FONT_REGISTRY_INDEX)))
- ASET (spec, FONT_REGISTRY_INDEX,
- intern_downcase ((char *) SDATA (registry), SBYTES (registry)));
- }
-}
-
-\f
-/* OTF handler */
+ else
+ {
+ if (memcmp (p0 + 1, "pixelsize=", 10) == 0)
+ prop = FONT_SIZE_INDEX;
+ else
+ {
+ key = intern_font_field (p0, p1 - p0);
+ prop = get_font_prop_index (key, 0);
+ }
+ p0 = p1 + 1;
+ for (p1 = p0; *p1 && *p1 != ':'; p1++);
+ val = intern_font_field (p0, p1 - p0);
+ if (! NILP (val))
+ {
+ if (prop >= 0 && prop < FONT_EXTRA_INDEX)
+ {
+ ASET (font, prop, val);
+ }
+ else
+ font_put_extra (font, key, val);
+ }
+ }
+ p0 = p1;
+ }
-#ifdef HAVE_LIBOTF
-#include <otf.h>
+ return 0;
+}
-struct otf_list
+/* 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. */
+
+int
+font_unparse_fcname (font, pixel_size, name, nbytes)
+ Lisp_Object font;
+ int pixel_size;
+ char *name;
+ int nbytes;
{
- Lisp_Object entity;
- OTF *otf;
- struct otf_list *next;
-};
+ Lisp_Object val;
+ int point_size;
+ int dpi, spacing, scalable;
+ int i, len = 1;
+ char *p;
+ Lisp_Object styles[3];
+ char *style_names[3] = { "weight", "slant", "width" };
+
+ val = AREF (font, FONT_FAMILY_INDEX);
+ if (SYMBOLP (val) && ! NILP (val))
+ len += SBYTES (SYMBOL_NAME (val));
+
+ val = AREF (font, FONT_SIZE_INDEX);
+ if (INTEGERP (val))
+ {
+ if (XINT (val) != 0)
+ pixel_size = XINT (val);
+ point_size = -1;
+ len += 21; /* for ":pixelsize=NUM" */
+ }
+ else if (FLOATP (val))
+ {
+ pixel_size = -1;
+ point_size = (int) XFLOAT_DATA (val);
+ len += 11; /* for "-NUM" */
+ }
+
+ val = AREF (font, FONT_FOUNDRY_INDEX);
+ if (SYMBOLP (val) && ! NILP (val))
+ /* ":foundry=NAME" */
+ len += 9 + SBYTES (SYMBOL_NAME (val));
+
+ for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
+ {
+ val = AREF (font, i);
+ if (INTEGERP (val))
+ {
+ val = prop_numeric_to_name (i, XINT (val));
+ len += (strlen (style_names[i - FONT_WEIGHT_INDEX])
+ + 2 + SBYTES (SYMBOL_NAME (val))); /* :xxx=NAME */
+ }
+ styles[i - FONT_WEIGHT_INDEX] = val;
+ }
+
+ val = AREF (font, FONT_EXTRA_INDEX);
+ if (FONT_ENTITY_P (font)
+ && EQ (AREF (font, FONT_TYPE_INDEX), Qx))
+ {
+ char *p;
+
+ /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
+ p = (char *) SDATA (SYMBOL_NAME (val));
+ dpi = atoi (p);
+ for (p++; *p != '-'; p++); /* skip RESX */
+ for (p++; *p != '-'; p++); /* skip RESY */
+ spacing = (*p == 'c' ? FONT_SPACING_CHARCELL
+ : *p == 'm' ? FONT_SPACING_MONO
+ : FONT_SPACING_PROPORTIONAL);
+ for (p++; *p != '-'; p++); /* skip SPACING */
+ scalable = (atoi (p) == 0);
+ /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
+ len += 42;
+ }
+ else
+ {
+ Lisp_Object elt;
+
+ dpi = spacing = scalable = -1;
+ elt = assq_no_quit (QCdpi, val);
+ if (CONSP (elt))
+ dpi = XINT (XCDR (elt)), len += 15; /* for ":dpi=NUM" */
+ elt = assq_no_quit (QCspacing, val);
+ if (CONSP (elt))
+ spacing = XINT (XCDR (elt)), len += 12; /* for ":spacing=100" */
+ elt = assq_no_quit (QCscalable, val);
+ if (CONSP (elt))
+ scalable = ! NILP (XCDR (elt)), len += 15; /* for ":scalable=False" */
+ }
+
+ if (len > nbytes)
+ return -1;
+ p = name;
+ if (! NILP (AREF (font, FONT_FAMILY_INDEX)))
+ p += sprintf(p, "%s",
+ SDATA (SYMBOL_NAME (AREF (font, FONT_FAMILY_INDEX))));
+ if (point_size > 0)
+ {
+ if (p == name)
+ p += sprintf (p, "%d", point_size);
+ else
+ p += sprintf (p, "-%d", point_size);
+ }
+ else if (pixel_size > 0)
+ p += sprintf (p, ":pixelsize=%d", pixel_size);
+ if (SYMBOLP (AREF (font, FONT_FOUNDRY_INDEX))
+ && ! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
+ p += sprintf (p, ":foundry=%s",
+ SDATA (SYMBOL_NAME (AREF (font, FONT_FOUNDRY_INDEX))));
+ for (i = 0; i < 3; i++)
+ if (SYMBOLP (styles[i]) && ! NILP (styles [i]))
+ p += sprintf (p, ":%s=%s", style_names[i],
+ SDATA (SYMBOL_NAME (styles [i])));
+ if (dpi >= 0)
+ p += sprintf (p, ":dpi=%d", dpi);
+ if (spacing >= 0)
+ p += sprintf (p, ":spacing=%d", spacing);
+ if (scalable > 0)
+ p += sprintf (p, ":scalable=True");
+ else if (scalable == 0)
+ p += sprintf (p, ":scalable=False");
+ return (p - name);
+}
+
+/* Parse NAME (null terminated) and store information in FONT
+ (font-spec or font-entity). If NAME is successfully parsed, return
+ 0. Otherwise return -1.
+
+ If NAME is XLFD and FONT is a font-entity, store
+ RESX-RESY-SPACING-AVWIDTH information as a symbol in
+ FONT_EXTRA_INDEX. */
+
+static int
+font_parse_name (name, font)
+ char *name;
+ Lisp_Object font;
+{
+ if (name[0] == '-' || index (name, '*'))
+ return font_parse_xlfd (name, font);
+ return font_parse_fcname (name, font);
+}
+
+/* Merge old style font specification (either a font name NAME or a
+ combination of a family name FAMILY and a registry name REGISTRY
+ into the font specification SPEC. */
-static struct otf_list *otf_list;
+void
+font_merge_old_spec (name, family, registry, spec)
+ Lisp_Object name, family, registry, spec;
+{
+ if (STRINGP (name))
+ {
+ if (font_parse_xlfd ((char *) SDATA (name), spec) < 0)
+ {
+ Lisp_Object extra = Fcons (Fcons (QCname, name), Qnil);
+
+ ASET (spec, FONT_EXTRA_INDEX, extra);
+ }
+ }
+ else
+ {
+ if (! NILP (family))
+ {
+ int len;
+ char *p0, *p1;
+
+ xassert (STRINGP (family));
+ len = SBYTES (family);
+ p0 = (char *) SDATA (family);
+ p1 = index (p0, '-');
+ if (p1)
+ {
+ 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)))
+ ASET (spec, FONT_FAMILY_INDEX,
+ intern_downcase (p1 + 1, len - (p1 + 1 - p0)));
+ }
+ else if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
+ ASET (spec, FONT_FAMILY_INDEX, intern_downcase (p0, len));
+ }
+ if (! NILP (registry)
+ && NILP (AREF (spec, FONT_REGISTRY_INDEX)))
+ ASET (spec, FONT_REGISTRY_INDEX,
+ intern_downcase ((char *) SDATA (registry), SBYTES (registry)));
+ }
+}
+
+\f
+/* This part (through the next ^L) is still experimental and never
+ tested. We may drastically change codes. */
+
+/* OTF handler */
+
+#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;
+}
+
+static void
+check_otf_features (otf_features)
+ Lisp_Object otf_features;
+{
+ Lisp_Object val, elt;
+
+ CHECK_CONS (otf_features);
+ CHECK_SYMBOL (XCAR (otf_features));
+ otf_features = XCDR (otf_features);
+ CHECK_CONS (otf_features);
+ CHECK_SYMBOL (XCAR (otf_features));
+ otf_features = XCDR (otf_features);
+ for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
+ {
+ CHECK_SYMBOL (Fcar (val));
+ if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
+ error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val)));
+ }
+ otf_features = XCDR (otf_features);
+ for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val))
+ {
+ CHECK_SYMBOL (Fcar (val));
+ if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
+ error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val)));
+ }
+}
+
+#ifdef HAVE_LIBOTF
+#include <otf.h>
+
+Lisp_Object otf_list;
static Lisp_Object
otf_tag_symbol (tag)
Lisp_Object entity;
char *file;
{
- struct otf_list *list = otf_list;
-
- while (list && ! EQ (list->entity, entity))
- list = list->next;
- if (! list)
+ Lisp_Object val = Fassoc (entity, otf_list);
+ OTF *otf;
+
+ if (! NILP (val))
+ otf = XSAVE_VALUE (XCDR (val))->pointer;
+ else
{
- list = malloc (sizeof (struct otf_list));
- list->entity = entity;
- list->otf = file ? OTF_open (file) : NULL;
- list->next = otf_list;
- otf_list = list;
+ otf = file ? OTF_open (file) : NULL;
+ val = make_save_value (otf, 0);
+ otf_list = Fcons (Fcons (entity, val), otf_list);
}
- return list->otf;
+ return otf;
}
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)
+/* Parse OTF features in SPEC and write a proper features spec string
+ in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
+ assured that the sufficient memory has already allocated for
+ FEATURES. */
+
+static void
+generate_otf_features (spec, features)
Lisp_Object spec;
- char **script, **langsys, **features;
+ char *features;
{
Lisp_Object val;
- int len;
- char *p;
+ char *p, *pend;
int asterisk;
- val = XCAR (spec);
- *script = (char *) SDATA (SYMBOL_NAME (val));
- spec = XCDR (spec);
- val = XCAR (spec);
- *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;
+ *p = '\0';
for (asterisk = 0; CONSP (spec); spec = XCDR (spec))
{
val = XCAR (spec);
+ CHECK_SYMBOL (val);
+ if (p > features)
+ *p++ = ',';
if (SREF (SYMBOL_NAME (val), 0) == '*')
{
asterisk = 1;
- p += sprintf (p, ",*");
+ *p++ = '*';
}
else if (! asterisk)
- p += sprintf (p, ",%s", SDATA (SYMBOL_NAME (val)));
- else
- p += sprintf (p, ",~%s", SDATA (SYMBOL_NAME (val)));
- }
- return 0;
-}
-
-#define DEVICE_DELTA(table, size) \
- (((size) >= (table).StartSize && (size) <= (table).EndSize) \
- ? (table).DeltaValue[(size) >= (table).StartSize] \
- : 0)
-
-void
-adjust_anchor (struct font *font, OTF_Anchor *anchor,
- unsigned code, int size, int *x, int *y)
-{
- if (anchor->AnchorFormat == 2)
- {
- int x0, y0;
-
- if (font->driver->anchor_point (font, code, anchor->f.f1.AnchorPoint,
- &x0, &y0) >= 0)
- *x = x0, *y = y0;
- }
- else if (anchor->AnchorFormat == 3)
- {
- if (anchor->f.f2.XDeviceTable.offset)
- *x += DEVICE_DELTA (anchor->f.f2.XDeviceTable, size);
- if (anchor->f.f2.YDeviceTable.offset)
- *y += DEVICE_DELTA (anchor->f.f2.YDeviceTable, size);
- }
-}
-
-
-/* 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)
- struct font *font;
- Lisp_Object gsub_spec;
- Lisp_Object gstring_in;
- int from, to;
- Lisp_Object gstring_out;
- int idx;
-{
- int len;
- int i;
- OTF *otf;
- OTF_GlyphString otf_gstring;
- OTF_Glyph *g;
- char *script, *langsys, *features;
-
- otf = otf_open (font->entity, font->file_name);
- if (! otf)
- return 0;
- if (OTF_get_table (otf, "head") < 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++)
- {
- 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));
- }
-
- OTF_drive_gdef (otf, &otf_gstring);
- if (OTF_drive_gsub (otf, &otf_gstring, script, langsys, features) < 0)
- {
- free (otf_gstring.glyphs);
- return 0;
- }
- if (ASIZE (gstring_out) < idx + otf_gstring.used)
- {
- free (otf_gstring.glyphs);
- return -1;
- }
-
- for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used;)
- {
- int i0 = g->f.index.from, i1 = g->f.index.to;
- Lisp_Object glyph = LGSTRING_GLYPH (gstring_in, from + i0);
- Lisp_Object min_idx = AREF (glyph, 0);
- Lisp_Object max_idx = AREF (glyph, 1);
-
- if (i0 < i1)
{
- int min_idx_i = XINT (min_idx), max_idx_i = XINT (max_idx);
-
- for (i0++; i0 <= i1; i0++)
- {
- glyph = LGSTRING_GLYPH (gstring_in, from + i0);
- if (min_idx_i > XINT (AREF (glyph, 0)))
- min_idx_i = XINT (AREF (glyph, 0));
- if (max_idx_i < XINT (AREF (glyph, 1)))
- max_idx_i = XINT (AREF (glyph, 1));
- }
- min_idx = make_number (min_idx_i);
- max_idx = make_number (max_idx_i);
- i0 = g->f.index.from;
+ val = SYMBOL_NAME (val);
+ p += sprintf (p, "%s", SDATA (val));
}
- for (; i < otf_gstring.used && g->f.index.from == i0; i++, g++)
+ else
{
- 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));
- LGLYPH_SET_CODE (glyph, make_number (g->glyph_id));
+ val = SYMBOL_NAME (val);
+ p += sprintf (p, "~%s", SDATA (val));
}
}
-
- free (otf_gstring.glyphs);
- return i;
+ if (CONSP (spec))
+ error ("OTF spec too long");
}
-/* Drive FONT's OTF GPOS features according to GPOS_SPEC. See the
- comment of (sturct font_driver).otf_gpos. */
-int
-font_otf_gpos (font, gpos_spec, gstring, from, to)
- struct font *font;
- Lisp_Object gpos_spec;
- Lisp_Object gstring;
- int from, to;
+Lisp_Object
+font_otf_DeviceTable (device_table)
+ OTF_DeviceTable *device_table;
{
- int len;
- int i;
- OTF *otf;
- OTF_GlyphString otf_gstring;
- OTF_Glyph *g;
- char *script, *langsys, *features;
- Lisp_Object glyph;
- int u, size;
- Lisp_Object base, mark;
+ int len = device_table->StartSize - device_table->EndSize + 1;
- otf = otf_open (font->entity, font->file_name);
- if (! otf)
- return 0;
- if (OTF_get_table (otf, "head") < 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++)
- {
- glyph = LGSTRING_GLYPH (gstring, from + i);
- otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (glyph));
- }
+ return Fcons (make_number (len),
+ make_unibyte_string (device_table->DeltaValue, len));
+}
- OTF_drive_gdef (otf, &otf_gstring);
+Lisp_Object
+font_otf_ValueRecord (value_format, value_record)
+ int value_format;
+ OTF_ValueRecord *value_record;
+{
+ Lisp_Object val = Fmake_vector (make_number (8), Qnil);
+
+ if (value_format & OTF_XPlacement)
+ ASET (val, 0, value_record->XPlacement);
+ if (value_format & OTF_YPlacement)
+ ASET (val, 1, value_record->YPlacement);
+ if (value_format & OTF_XAdvance)
+ ASET (val, 2, value_record->XAdvance);
+ if (value_format & OTF_YAdvance)
+ ASET (val, 3, value_record->YAdvance);
+ if (value_format & OTF_XPlaDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice));
+ if (value_format & OTF_YPlaDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->YPlaDevice));
+ if (value_format & OTF_XAdvDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->XAdvDevice));
+ if (value_format & OTF_YAdvDevice)
+ ASET (val, 4, font_otf_DeviceTable (&value_record->YAdvDevice));
+ return val;
+}
- if (OTF_drive_gpos (otf, &otf_gstring, script, langsys, features) < 0)
- {
- free (otf_gstring.glyphs);
- return 0;
- }
+Lisp_Object
+font_otf_Anchor (anchor)
+ OTF_Anchor *anchor;
+{
+ Lisp_Object val;
- u = otf->head->unitsPerEm;
- size = font->pixel_size;
- base = mark = Qnil;
- for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used; i++, g++)
+ val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil);
+ ASET (val, 0, make_number (anchor->XCoordinate));
+ ASET (val, 1, make_number (anchor->YCoordinate));
+ if (anchor->AnchorFormat == 2)
+ ASET (val, 2, make_number (anchor->f.f1.AnchorPoint));
+ else
{
- Lisp_Object prev;
- int xoff = 0, yoff = 0, width_adjust = 0;
-
- if (! g->glyph_id)
- continue;
-
- glyph = LGSTRING_GLYPH (gstring, from + i);
- switch (g->positioning_type)
- {
- case 0:
- break;
- case 1: case 2:
- {
- int format = g->f.f1.format;
-
- if (format & OTF_XPlacement)
- xoff = g->f.f1.value->XPlacement * size / u;
- if (format & OTF_XPlaDevice)
- xoff += DEVICE_DELTA (g->f.f1.value->XPlaDevice, size);
- if (format & OTF_YPlacement)
- yoff = - (g->f.f1.value->YPlacement * size / u);
- if (format & OTF_YPlaDevice)
- yoff -= DEVICE_DELTA (g->f.f1.value->YPlaDevice, size);
- if (format & OTF_XAdvance)
- width_adjust += g->f.f1.value->XAdvance * size / u;
- if (format & OTF_XAdvDevice)
- width_adjust += DEVICE_DELTA (g->f.f1.value->XAdvDevice, size);
- }
- break;
- case 3:
- /* Not yet supported. */
- break;
- case 4: case 5:
- if (NILP (base))
- break;
- prev = base;
- goto label_adjust_anchor;
- default: /* i.e. case 6 */
- if (NILP (mark))
- break;
- prev = mark;
-
- label_adjust_anchor:
- {
- int base_x, base_y, mark_x, mark_y, width;
- unsigned code;
-
- base_x = g->f.f4.base_anchor->XCoordinate * size / u;
- base_y = g->f.f4.base_anchor->YCoordinate * size / u;
- mark_x = g->f.f4.mark_anchor->XCoordinate * size / u;
- mark_y = g->f.f4.mark_anchor->YCoordinate * size / u;
-
- code = XINT (LGLYPH_CODE (prev));
- if (g->f.f4.base_anchor->AnchorFormat != 1)
- adjust_anchor (font, g->f.f4.base_anchor,
- code, size, &base_x, &base_y);
- if (g->f.f4.mark_anchor->AnchorFormat != 1)
- adjust_anchor (font, g->f.f4.mark_anchor,
- code, size, &mark_x, &mark_y);
-
- if (NILP (LGLYPH_WIDTH (prev)))
- {
- width = font->driver->text_extents (font, &code, 1, NULL);
- LGLYPH_SET_WIDTH (prev, make_number (width));
- }
- xoff = XINT (LGLYPH_XOFF (prev)) + (base_x - width) - mark_x;
- yoff = XINT (LGLYPH_YOFF (prev)) + mark_y - base_y;
- }
- }
- 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));
+ ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
+ ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
}
-
- free (otf_gstring.glyphs);
- return 0;
+ return val;
}
#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)
+font_prepare_composition (cmp, f)
struct composition *cmp;
+ FRAME_PTR f;
{
Lisp_Object gstring
= AREF (XHASH_TABLE (composition_hash_table)->key_and_value,
cmp->hash_index * 2);
- struct font *font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer;
- int len = LGSTRING_LENGTH (gstring);
- int i;
- cmp->font = font;
- cmp->lbearing = cmp->rbearing = cmp->pixel_width = 0;
- cmp->ascent = font->ascent;
- cmp->descent = font->descent;
+ cmp->font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer;
+ cmp->glyph_len = LGSTRING_LENGTH (gstring);
+ cmp->pixel_width = LGSTRING_WIDTH (gstring);
+ cmp->lbearing = LGSTRING_LBEARING (gstring);
+ cmp->rbearing = LGSTRING_RBEARING (gstring);
+ cmp->ascent = LGSTRING_ASCENT (gstring);
+ cmp->descent = LGSTRING_DESCENT (gstring);
+ cmp->width = cmp->pixel_width / FRAME_COLUMN_WIDTH (f);
+ if (cmp->width == 0)
+ cmp->width = 1;
- for (i = 0; i < len; i++)
- {
- Lisp_Object g = LGSTRING_GLYPH (gstring, i);
- unsigned code = XINT (LGLYPH_CODE (g));
- struct font_metrics metrics;
-
- 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));
-
- if (cmp->lbearing > cmp->pixel_width + metrics.lbearing)
- cmp->lbearing = cmp->pixel_width + metrics.lbearing;
- if (cmp->rbearing < cmp->pixel_width + metrics.rbearing)
- cmp->rbearing = cmp->pixel_width + metrics.rbearing;
- if (cmp->ascent < metrics.ascent)
- cmp->ascent = metrics.ascent;
- if (cmp->descent < metrics.descent)
- cmp->descent = metrics.descent;
- cmp->pixel_width += metrics.width + XINT (LGLYPH_WADJUST (g));
- }
- 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));
- LGSTRING_SET_ASCENT (gstring, make_number (cmp->ascent));
- LGSTRING_SET_DESCENT (gstring, make_number (cmp->descent));
-
- return font;
+ return cmp->font;
}
int
\f
/* Font sorting */
-static unsigned font_score P_ ((Lisp_Object, Lisp_Object));
+static unsigned font_score P_ ((Lisp_Object, Lisp_Object *));
static int font_compare P_ ((const void *, const void *));
static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object));
font-spec. The score value is 32 bit (`unsigned'), and the smaller
the value is, the closer the font is to the font-spec.
- Each 1-bit in the highest 4 bits of the score is used for atomic
+ Each 1-bit of the highest 4 bits of the score is used for atomic
properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
Each 7-bit in the lowest 28 bits are used for numeric properties
property in a score. */
static int sort_shift_bits[FONT_SIZE_INDEX + 1];
-/* Score font-entity ENTITY against font-spec SPEC. The return value
- indicates how different ENTITY is compared with SPEC. */
+/* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
+ The return value indicates how different ENTITY is compared with
+ SPEC_PROP. */
static unsigned
-font_score (entity, spec)
- Lisp_Object entity, spec;
+font_score (entity, spec_prop)
+ Lisp_Object entity, *spec_prop;
{
unsigned score = 0;
int i;
- /* Score atomic fields. Maximum difference is 1. */
+ /* Score four atomic fields. Maximum difference is 1. */
for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
- {
- Lisp_Object val = AREF (spec, i);
+ if (! NILP (spec_prop[i])
+ && ! EQ (spec_prop[i], AREF (entity, i)))
+ score |= 1 << sort_shift_bits[i];
- if (! NILP (val)
- && ! EQ (val, AREF (entity, i)))
- score |= 1 << sort_shift_bits[i];
- }
-
- /* Score numeric fields. Maximum difference is 127. */
+ /* Score four numeric fields. Maximum difference is 127. */
for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
{
- Lisp_Object spec_val = AREF (spec, i);
Lisp_Object entity_val = AREF (entity, i);
- if (! NILP (spec_val) && ! EQ (spec_val, entity_val))
+ if (! NILP (spec_prop[i]) && ! EQ (spec_prop[i], entity_val))
{
if (! INTEGERP (entity_val))
score |= 127 << sort_shift_bits[i];
- else if (i < FONT_SIZE_INDEX
- || XINT (entity_val) != 0)
+ else
{
- int diff = XINT (entity_val) - XINT (spec_val);
+ int diff = XINT (entity_val) - XINT (spec_prop[i]);
if (diff < 0)
diff = - diff;
- score |= min (diff, 127) << sort_shift_bits[i];
+ if (i == FONT_SIZE_INDEX)
+ {
+ if (XINT (entity_val) > 0
+ && diff > FONT_PIXEL_SIZE_QUANTUM)
+ score |= min (diff, 127) << sort_shift_bits[i];
+ }
+ else
+ score |= min (diff, 127) << sort_shift_bits[i];
}
}
}
/* Sort font-entities in vector VEC by closeness to font-spec PREFER.
If PREFER specifies a point-size, calculate the corresponding
- pixel-size from the Y-resolution of FRAME before sorting. If SPEC
- is not nil, it is a font-spec to get the font-entities in VEC. */
+ pixel-size from QCdpi property of PREFER or from the Y-resolution
+ of FRAME before sorting. If SPEC is not nil, it is a font-spec to
+ get the font-entities in VEC. */
static Lisp_Object
font_sort_entites (vec, prefer, frame, spec)
Lisp_Object vec, prefer, frame, spec;
{
- Lisp_Object size;
+ Lisp_Object prefer_prop[FONT_SPEC_MAX];
int len, i;
struct font_sort_data *data;
- int prefer_is_copy = 0;
USE_SAFE_ALLOCA;
len = ASIZE (vec);
if (len <= 1)
return vec;
- size = AREF (spec, FONT_SIZE_INDEX);
- if (FLOATP (size))
- {
- double point_size = XFLOAT_DATA (size) * 10;
- int pixel_size = POINT_TO_PIXEL (point_size, XFRAME (frame)->resy);
-
- prefer = Fcopy_sequence (prefer);
- ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
- prefer_is_copy = 1;
- }
+ for (i = FONT_FOUNDRY_INDEX; i <= FONT_SIZE_INDEX; i++)
+ prefer_prop[i] = AREF (prefer, i);
if (! NILP (spec))
{
/* As it is assured that all fonts in VEC match with SPEC, we
should ignore properties specified in SPEC. So, set the
- corresponding properties in PREFER nil. */
+ corresponding properties in PREFER_PROP to nil. */
for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
- if (! NILP (AREF (spec, i)) && ! NILP (AREF (prefer, i)))
- break;
- if (i <= FONT_SIZE_INDEX)
- {
- if (! prefer_is_copy)
- prefer = Fcopy_sequence (prefer);
- for (; i <= FONT_SIZE_INDEX; i++)
- if (! NILP (AREF (spec, i)) && ! NILP (AREF (prefer, i)))
- ASET (prefer, i, Qnil);
- }
+ if (! NILP (AREF (spec, i)))
+ prefer_prop[i++] = Qnil;
}
+ if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
+ prefer_prop[FONT_SIZE_INDEX]
+ = make_number (font_pixel_size (XFRAME (frame), prefer));
+
/* Scoring and sorting. */
SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
for (i = 0; i < len; i++)
{
data[i].entity = AREF (vec, i);
- data[i].score = font_score (data[i].entity, prefer);
+ data[i].score = font_score (data[i].entity, prefer_prop);
}
qsort (data, len, sizeof *data, font_compare);
for (i = 0; i < len; i++)
\f
/* API of Font Service Layer. */
+/* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
+ sort_shift_bits. Finternal_set_font_selection_order calls this
+ function with font_sort_order after setting up it. */
+
void
font_update_sort_order (order)
int *order;
}
}
+
+/* Return weight property of FONT as symbol. */
+
Lisp_Object
font_symbolic_weight (font)
Lisp_Object font;
return weight;
}
+
+/* Return slant property of FONT as symbol. */
+
Lisp_Object
font_symbolic_slant (font)
Lisp_Object font;
return slant;
}
+
+/* Return width property of FONT as symbol. */
+
Lisp_Object
font_symbolic_width (font)
Lisp_Object font;
return width;
}
+
+/* Check if ENTITY matches with the font specification SPEC. */
+
+int
+font_match_p (spec, entity)
+ Lisp_Object spec, entity;
+{
+ int i;
+
+ for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
+ if (! NILP (AREF (spec, i))
+ && ! EQ (AREF (spec, i), AREF (entity, i)))
+ return 0;
+ if (INTEGERP (AREF (spec, FONT_SIZE_INDEX))
+ && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0
+ && (XINT (AREF (spec, FONT_SIZE_INDEX))
+ != XINT (AREF (entity, FONT_SIZE_INDEX))))
+ return 0;
+ return 1;
+}
+
+
+/* Return a lispy font object corresponding to FONT. */
+
Lisp_Object
font_find_object (font)
struct font *font;
static Lisp_Object scratch_font_spec, scratch_font_prefer;
+
/* Return a vector of font-entities matching with SPEC on frame F. */
static Lisp_Object
{
FRAME_PTR f = XFRAME (frame);
struct font_driver_list *driver_list = f->font_driver_list;
- Lisp_Object ftype, family, alternate_familes;
+ Lisp_Object ftype, family, size, alternate_familes;
Lisp_Object *vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
int i;
if (! NILP (alternate_familes))
alternate_familes = XCDR (alternate_familes);
}
+ size = AREF (spec, FONT_SIZE_INDEX);
+ if (FLOATP (size))
+ ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
+
xassert (ASIZE (spec) == FONT_SPEC_MAX);
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;
}
ASET (spec, FONT_TYPE_INDEX, ftype);
ASET (spec, FONT_FAMILY_INDEX, family);
+ ASET (spec, FONT_SIZE_INDEX, size);
return (i > 0 ? Fvconcat (i, vec) : null_vector);
}
+
+/* Return a font entity matching with SPEC on FRAME. */
+
+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;
+
+/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
+ opened font object. */
+
static Lisp_Object
font_open_entity (f, entity, pixel_size)
FRAME_PTR f;
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)));
return val;
}
+
+/* Close FONT_OBJECT that is opened on frame F. */
+
void
font_close_object (f, font_object)
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 ();
}
+
+/* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
+ FONT is a font-entity and it must be opened to check. */
+
int
-font_has_char (f, font_entity, c)
+font_has_char (f, font, c)
FRAME_PTR f;
- Lisp_Object font_entity;
+ Lisp_Object font;
int c;
{
- Lisp_Object type = AREF (font_entity, FONT_TYPE_INDEX);
- struct font_driver_list *driver_list;
+ struct font *fontp;
- for (driver_list = f->font_driver_list;
- driver_list && ! EQ (driver_list->driver->type, type);
- driver_list = driver_list->next);
- if (! driver_list)
- return -1;
- return driver_list->driver->has_char (font_entity, c);
+ if (FONT_ENTITY_P (font))
+ {
+ Lisp_Object type = AREF (font, FONT_TYPE_INDEX);
+ struct font_driver_list *driver_list;
+
+ for (driver_list = f->font_driver_list;
+ driver_list && ! EQ (driver_list->driver->type, type);
+ driver_list = driver_list->next);
+ if (! driver_list)
+ return 0;
+ if (! driver_list->driver->has_char)
+ return -1;
+ return driver_list->driver->has_char (font, c);
+ }
+
+ xassert (FONT_OBJECT_P (font));
+ fontp = XSAVE_VALUE (font)->pointer;
+
+ if (fontp->driver->has_char)
+ {
+ int result = fontp->driver->has_char (fontp->entity, c);
+
+ if (result >= 0)
+ return result;
+ }
+ return (fontp->driver->encode_char (fontp, c) != FONT_INVALID_CODE);
}
+
+/* Return the glyph ID of FONT_OBJECT for character C. */
+
unsigned
font_encode_char (font_object, c)
Lisp_Object font_object;
return font->driver->encode_char (font, c);
}
-char *
+
+/* Return the name of FONT_OBJECT. */
+
+Lisp_Object
font_get_name (font_object)
Lisp_Object font_object;
{
struct font *font = XSAVE_VALUE (font_object)->pointer;
+ char *name = (font->font.full_name ? font->font.full_name
+ : font->font.name ? font->font.name
+ : NULL);
- return (font->font.full_name ? font->font.full_name
- : font->file_name ? font->file_name
- : "");
+ return (name ? make_unibyte_string (name, strlen (name)) : null_string);
}
+
+/* Return the specification of FONT_OBJECT. */
+
+Lisp_Object
+font_get_spec (font_object)
+ Lisp_Object font_object;
+{
+ struct font *font = XSAVE_VALUE (font_object)->pointer;
+ Lisp_Object spec = Ffont_spec (0, NULL);
+ int i;
+
+ for (i = 0; i < FONT_SIZE_INDEX; i++)
+ ASET (spec, i, AREF (font->entity, i));
+ ASET (spec, FONT_SIZE_INDEX, make_number (font->pixel_size));
+ return spec;
+}
+
+
+/* Return the frame on which FONT exists. FONT is a font object or a
+ font entity. */
+
Lisp_Object
font_get_frame (font)
Lisp_Object font;
return AREF (font, FONT_FRAME_INDEX);
}
-extern Lisp_Object Qunspecified, Qignore_defface;
+
+/* Find a font entity best matching with LFACE. If SPEC is non-nil,
+ the font must exactly match with it. C, if not negative, is a
+ character that the entity must support. */
Lisp_Object
-font_find_for_lface (f, lface, spec)
+font_find_for_lface (f, lface, spec, c)
FRAME_PTR f;
Lisp_Object *lface;
Lisp_Object spec;
+ int c;
{
- Lisp_Object attrs[LFACE_FONT_INDEX + 1];
- Lisp_Object frame, val, entities;
+ Lisp_Object frame, entities;
int i;
- unsigned char try_unspecified[FONT_SPEC_MAX];
- for (i = 0; i <= LFACE_FONT_INDEX; i++)
+ XSETFRAME (frame, f);
+
+ if (NILP (spec))
{
- val = lface[i];
- if (EQ (val, Qunspecified) || EQ (val, Qignore_defface))
- val = Qnil;
- attrs[i] = val;
+ if (c >= 0x100)
+ return Qnil;
+ for (i = 0; i < FONT_SPEC_MAX; i++)
+ ASET (scratch_font_spec, i, Qnil);
+ ASET (scratch_font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
+
+ if (! NILP (lface[LFACE_FAMILY_INDEX]))
+ font_merge_old_spec (Qnil, lface[LFACE_FAMILY_INDEX], Qnil,
+ scratch_font_spec);
+ entities = font_list_entities (frame, scratch_font_spec);
+ while (ASIZE (entities) == 0)
+ {
+ /* Try without FOUNDRY or FAMILY. */
+ if (! NILP (AREF (scratch_font_spec, FONT_FOUNDRY_INDEX)))
+ {
+ ASET (scratch_font_spec, FONT_FOUNDRY_INDEX, Qnil);
+ entities = font_list_entities (frame, scratch_font_spec);
+ }
+ else if (! NILP (AREF (scratch_font_spec, FONT_FAMILY_INDEX)))
+ {
+ ASET (scratch_font_spec, FONT_FAMILY_INDEX, Qnil);
+ entities = font_list_entities (frame, scratch_font_spec);
+ }
+ else
+ break;
+ }
}
- if (NILP (spec))
- for (i = 0; i < FONT_SPEC_MAX; i++)
- ASET (scratch_font_spec, i, Qnil);
else
- for (i = 0; i < FONT_SPEC_MAX; i++)
- ASET (scratch_font_spec, i, AREF (spec, i));
-
- /* If SPEC doesn't specify a specific property, it can be tried with
- nil even if FACE specifies it. */
- for (i = FONT_FOUNDRY_INDEX; i <= FONT_SIZE_INDEX; i++)
- try_unspecified[i] = NILP (AREF (scratch_font_spec, i));
-
- if (NILP (spec) && STRINGP (attrs[LFACE_FONT_INDEX]))
- font_merge_old_spec (attrs[LFACE_FONT_INDEX], Qnil, Qnil,
- scratch_font_spec);
- if (NILP (AREF (scratch_font_spec, FONT_FAMILY_INDEX))
- && ! NILP (attrs[LFACE_FAMILY_INDEX]))
- font_merge_old_spec (Qnil, attrs[LFACE_FAMILY_INDEX], Qnil,
- scratch_font_spec);
- if (NILP (AREF (scratch_font_spec, FONT_REGISTRY_INDEX)))
{
- ASET (scratch_font_spec, FONT_REGISTRY_INDEX, intern ("iso8859-1"));
- try_unspecified[FONT_REGISTRY_INDEX] = 0;
- }
+ Lisp_Object registry = AREF (spec, FONT_REGISTRY_INDEX);
- for (i = FONT_FAMILY_INDEX; i <= FONT_SIZE_INDEX; i++)
- if (try_unspecified[i]
- && NILP (AREF (scratch_font_spec, i)))
- try_unspecified[i] = 0;
+ if (NILP (registry))
+ registry = Qiso8859_1;
- XSETFRAME (frame, f);
- entities = font_list_entities (frame, scratch_font_spec);
- while (ASIZE (entities) == 0)
- {
- if (try_unspecified[FONT_WEIGHT_INDEX]
- || try_unspecified[FONT_SLANT_INDEX]
- || try_unspecified[FONT_WIDTH_INDEX]
- || try_unspecified[FONT_SIZE_INDEX])
+ if (c >= 0)
{
- for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
+ struct charset *repertory;
+
+ if (font_registry_charsets (registry, NULL, &repertory) < 0)
+ return Qnil;
+ if (repertory)
{
- try_unspecified[i] = 0;
- ASET (scratch_font_spec, i, Qnil);
+ if (ENCODE_CHAR (repertory, c)
+ == CHARSET_INVALID_CODE (repertory))
+ return Qnil;
+ /* Any font of this registry support C. So, let's
+ suppress the further checking. */
+ c = -1;
}
- entities = font_list_entities (frame, scratch_font_spec);
- }
- else if (try_unspecified[FONT_FOUNDRY_INDEX])
- {
- try_unspecified[FONT_FOUNDRY_INDEX] = 0;
- ASET (scratch_font_spec, FONT_FOUNDRY_INDEX, Qnil);
- entities = font_list_entities (frame, scratch_font_spec);
- }
- else if (try_unspecified[FONT_FAMILY_INDEX])
- {
- try_unspecified[FONT_FAMILY_INDEX] = 0;
- ASET (scratch_font_spec, FONT_FAMILY_INDEX, Qnil);
- entities = font_list_entities (frame, scratch_font_spec);
+ else if (c > MAX_UNICODE_CHAR)
+ return Qnil;
}
- else
- return Qnil;
+ for (i = 0; i < FONT_SPEC_MAX; i++)
+ ASET (scratch_font_spec, i, AREF (spec, i));
+ ASET (scratch_font_spec, FONT_REGISTRY_INDEX, registry);
+ entities = font_list_entities (frame, scratch_font_spec);
}
+ if (ASIZE (entities) == 0)
+ return Qnil;
if (ASIZE (entities) > 1)
{
+ /* Sort fonts by properties specified in LFACE. */
Lisp_Object prefer = scratch_font_prefer;
+ double pt;
+
+ if (! NILP (lface[LFACE_FAMILY_INDEX]))
+ font_merge_old_spec (Qnil, lface[LFACE_FAMILY_INDEX], Qnil, prefer);
+ ASET (prefer, FONT_WEIGHT_INDEX,
+ font_prop_validate_style (QCweight, lface[LFACE_WEIGHT_INDEX]));
+ ASET (prefer, FONT_SLANT_INDEX,
+ font_prop_validate_style (QCslant, lface[LFACE_SLANT_INDEX]));
+ ASET (prefer, FONT_WIDTH_INDEX,
+ font_prop_validate_style (QCwidth, lface[LFACE_SWIDTH_INDEX]));
+ pt = XINT (lface[LFACE_HEIGHT_INDEX]);
+ ASET (prefer, FONT_SIZE_INDEX, make_float (pt / 10));
- for (i = 0; i < FONT_WEIGHT_INDEX; i++)
- ASET (prefer, i, Qnil);
- if (! NILP (attrs[LFACE_WEIGHT_INDEX]))
- ASET (prefer, FONT_WEIGHT_INDEX,
- font_prop_validate_style (FONT_WEIGHT_INDEX,
- attrs[LFACE_WEIGHT_INDEX]));
- if (! NILP (attrs[LFACE_SLANT_INDEX]))
- ASET (prefer, FONT_SLANT_INDEX,
- font_prop_validate_style (FONT_SLANT_INDEX,
- attrs[LFACE_SLANT_INDEX]));
- if (! NILP (attrs[LFACE_SWIDTH_INDEX]))
- ASET (prefer, FONT_WIDTH_INDEX,
- font_prop_validate_style (FONT_WIDTH_INDEX,
- attrs[LFACE_SWIDTH_INDEX]));
- if (! NILP (attrs[LFACE_HEIGHT_INDEX]))
- {
- int size;
-
- val = attrs[LFACE_HEIGHT_INDEX];
- size = POINT_TO_PIXEL (XINT (val), f->resy);
- ASET (prefer, FONT_SIZE_INDEX, make_number (size));
- }
font_sort_entites (entities, prefer, frame, spec);
}
- return AREF (entities, 0);
+ if (c < 0)
+ return AREF (entities, 0);
+ for (i = 0; i < ASIZE (entities); i++)
+ {
+ int result = font_has_char (f, AREF (entities, i), c);
+ Lisp_Object font_object;
+
+ if (result > 0)
+ return AREF (entities, i);
+ if (result <= 0)
+ continue;
+ font_object = font_open_for_lface (f, AREF (entities, i), lface, spec);
+ if (NILP (font_object))
+ continue;
+ result = font_has_char (f, font_object, c);
+ font_close_object (f, font_object);
+ if (result > 0)
+ return AREF (entities, i);
+ }
+ return Qnil;
}
+
Lisp_Object
-font_open_for_lface (f, lface, entity)
+font_open_for_lface (f, entity, lface, spec)
FRAME_PTR f;
- Lisp_Object *lface;
Lisp_Object entity;
+ Lisp_Object *lface;
+ Lisp_Object spec;
{
- int pt = XINT (lface[LFACE_HEIGHT_INDEX]);
- int size = POINT_TO_PIXEL (pt, f->resy);
+ int size;
+
+ if (FONT_SPEC_P (spec) && INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
+ size = XINT (AREF (spec, FONT_SIZE_INDEX));
+ else
+ {
+ double pt = XINT (lface[LFACE_HEIGHT_INDEX]);
+ pt /= 10;
+ size = POINT_TO_PIXEL (pt, f->resy);
+ }
return font_open_entity (f, entity, size);
}
+
+/* Load a font best matching with FACE's font-related properties into
+ FACE on frame F. If no proper font is found, record that FACE has
+ no font. */
+
void
font_load_for_face (f, face)
FRAME_PTR f;
struct face *face;
{
- Lisp_Object entity;
-
- face->font_info_id = -1;
- face->font_info = NULL;
- face->font = NULL;
- face->font_name = NULL;
+ Lisp_Object font_object = face->lface[LFACE_FONT_INDEX];
- entity = font_find_for_lface (f, face->lface, Qnil);
- if (! NILP (entity))
+ if (NILP (font_object))
{
- Lisp_Object font_object = font_open_for_lface (f, face->lface, entity);
+ Lisp_Object entity = font_find_for_lface (f, face->lface, Qnil, -1);
- if (! NILP (font_object))
- {
- struct font *font = XSAVE_VALUE (font_object)->pointer;
+ if (! NILP (entity))
+ font_object = font_open_for_lface (f, entity, face->lface, Qnil);
+ }
- face->font = font->font.font;
- face->font_info = (struct font_info *) font;
- face->font_info_id = 0;
- face->font_name = font->font.full_name;
- }
+ if (! NILP (font_object))
+ {
+ struct font *font = XSAVE_VALUE (font_object)->pointer;
+
+ face->font = font->font.font;
+ face->font_info = (struct font_info *) font;
+ face->font_info_id = 0;
+ face->font_name = font->font.full_name;
+ }
+ else
+ {
+ face->font = NULL;
+ face->font_info = NULL;
+ face->font_info_id = -1;
+ face->font_name = NULL;
+ add_to_log ("Unable to load font for a face%s", null_string, Qnil);
}
- if (! face->font)
- add_to_log ("Unable to load font for a face%s", null_string, Qnil);
}
+
+/* Make FACE on frame F ready to use the font opened for FACE. */
+
void
font_prepare_for_face (f, face)
FRAME_PTR f;
font->driver->prepare_face (f, face);
}
+
+/* Make FACE on frame F stop using the font opened for FACE. */
+
void
font_done_for_face (f, face)
FRAME_PTR f;
face->extra = NULL;
}
+
+/* Open a font best matching with NAME on frame F. If no proper font
+ is found, return Qnil. */
+
Lisp_Object
font_open_by_name (f, name)
FRAME_PTR f;
char *name;
{
- Lisp_Object spec = Ffont_spec (0, NULL);
+ Lisp_Object args[2];
+ Lisp_Object spec, prefer, size, entity, entity_list;
Lisp_Object frame;
- struct font_driver_list *dlist;
+ int i;
+ int pixel_size;
XSETFRAME (frame, f);
- ASET (spec, FONT_EXTRA_INDEX,
- Fcons (Fcons (QCname, make_unibyte_string (name, strlen (name))),
- Qnil));
- for (dlist = f->font_driver_list; dlist; dlist = dlist->next)
- if (dlist->driver->parse_name
- && dlist->driver->parse_name (f, name, spec) >= 0)
- {
- Lisp_Object entities = font_list_entities (frame, spec);
- Lisp_Object font_object;
- int pixel_size;
-
- if (ASIZE (entities) == 0)
- continue;
- pixel_size = XINT (AREF (AREF (entities, 0), FONT_SIZE_INDEX));
- if (pixel_size == 0 && INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
- pixel_size = XINT (AREF (spec, FONT_SIZE_INDEX));
- font_object = font_open_entity (f, AREF (entities, 0), pixel_size);
- if (! NILP (font_object))
- return font_object;
- }
- return Qnil;
+ args[0] = QCname;
+ args[1] = make_unibyte_string (name, strlen (name));
+ spec = Ffont_spec (2, args);
+ prefer = scratch_font_prefer;
+ for (i = FONT_WEIGHT_INDEX; i < FONT_SIZE_INDEX; i++)
+ if (NILP (AREF (spec, i)))
+ ASET (prefer, i, make_number (100));
+ size = AREF (spec, FONT_SIZE_INDEX);
+ if (NILP (size))
+ pixel_size = 0;
+ else if (INTEGERP (size))
+ pixel_size = XINT (size);
+ else /* FLOATP (size) */
+ {
+ double pt = XFLOAT_DATA (size);
+
+ pixel_size = POINT_TO_PIXEL (pt, f->resy);
+ size = make_number (pixel_size);
+ ASET (spec, FONT_SIZE_INDEX, size);
+ }
+ if (pixel_size == 0)
+ {
+ pixel_size = POINT_TO_PIXEL (12.0, f->resy);
+ size = make_number (pixel_size);
+ }
+ ASET (prefer, FONT_SIZE_INDEX, size);
+ if (NILP (AREF (spec, FONT_REGISTRY_INDEX)))
+ ASET (spec, FONT_REGISTRY_INDEX, Qiso8859_1);
+
+ 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, 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)
num_font_drivers++;
}
+
/* Free font-driver list on frame F. It doesn't free font-drivers
themselves. */
}
}
+
+/* Make the frame F use font backends listed in NEW_DRIVERS (list of
+ symbols, e.g. xft, x). If NEW_DRIVERS 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 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, finialize all font drivers for F. */
+ for (list = f->font_driver_list; list; list = list->next)
+ if (list->on)
+ {
+ if (list->driver->end_for_frame)
+ list->driver->end_for_frame (f);
+ list->on = 0;
+ }
+
+ /* Then start the requested drivers. */
+ for (list = f->font_driver_list; list; list = list->next)
+ if (NILP (new_drivers)
+ || ! NILP (Fmemq (list->driver->type, new_drivers)))
+ {
+ if (! list->driver->start_for_frame
+ || list->driver->start_for_frame (f) == 0);
+ {
+ list->on = 1;
+ active_drivers = nconc2 (active_drivers,
+ Fcons (list->driver->type, Qnil));
+ }
+ }
+
+ return active_drivers;
+}
+
+int
+font_put_frame_data (f, driver, data)
+ FRAME_PTR f;
+ struct font_driver *driver;
+ void *data;
+{
+ struct font_data_list *list, *prev;
+
+ 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;
+ free (list);
+ }
+ return 0;
+ }
+
+ if (! list)
+ {
+ list = malloc (sizeof (struct font_data_list));
+ if (! list)
+ return -1;
+ list->driver = driver;
+ list->next = f->font_data_list;
+ f->font_data_list = list;
+ }
+ list->data = data;
+ return 0;
+}
+
+
+void *
+font_get_frame_data (f, driver)
+ FRAME_PTR f;
+ struct font_driver *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;
+}
+
+
+/* Return the font used to draw character C by FACE at buffer position
+ POS in window W. If OBJECT is non-nil, it is a string containing C
+ at index POS. */
+
+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 (! FRAME_WINDOW_P (f))
+ return Qnil;
+ 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_find_object ((struct font *) face->font_info);
+}
+
\f
/* Lisp API */
DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0,
- doc: /* Return t if object is a font-spec or font-entity. */)
+ doc: /* Return t if OBJECT is a font-spec or font-entity.
+Return nil otherwise. */)
(object)
Lisp_Object object;
{
}
DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
- doc: /* Return a newly created font-spec with specified arguments as properties.
-usage: (font-spec &rest properties) */)
+ doc: /* Return a newly created font-spec with arguments as properties.
+
+ARGS must come in pairs KEY VALUE of font properties. KEY must be a
+valid font property name listed below:
+
+`:family', `:weight', `:slant', `:width'
+
+They are the same as face attributes of the same name. See
+`set-face-attribute.
+
+`:foundry'
+
+VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
+
+`:adstyle'
+
+VALUE must be a string or a symbol specifying the additional
+typographic style information of a font, e.g. ``sans''. Usually null.
+
+`:registry'
+
+VALUE must be a string or a symbol specifying the charset registry and
+encoding of a font, e.g. ``iso8859-1''.
+
+`:size'
+
+VALUE must be a non-negative integer or a floating point number
+specifying the font size. It specifies the font size in 1/10 pixels
+(if VALUE is an integer), or in points (if VALUE is a float).
+usage: (font-spec ARGS ...) */)
(nargs, args)
int nargs;
Lisp_Object *args;
{
Lisp_Object spec = Fmake_vector (make_number (FONT_SPEC_MAX), Qnil);
- Lisp_Object extra = Qnil;
int i;
for (i = 0; i < nargs; i += 2)
enum font_property_index prop;
Lisp_Object key = args[i], val = args[i + 1];
- prop = check_font_prop_name (key);
+ prop = get_font_prop_index (key, 0);
if (prop < FONT_EXTRA_INDEX)
- ASET (spec, prop, (font_property_table[prop].validater) (prop, val));
+ ASET (spec, prop, val);
else
{
if (EQ (key, QCname))
- font_parse_xlfd ((char *) SDATA (val), spec, 0);
- extra = Fcons (Fcons (key, val), extra);
+ {
+ CHECK_STRING (val);
+ font_parse_name ((char *) SDATA (val), spec);
+ }
+ font_put_extra (spec, key, val);
}
- }
- ASET (spec, FONT_EXTRA_INDEX, extra);
+ }
+ 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, prop)
- Lisp_Object font, prop;
+ doc: /* Return the value of FONT's property KEY.
+FONT is a font-spec, a font-entity, or a font-object. */)
+ (font, key)
+ Lisp_Object font, key;
{
enum font_property_index idx;
- CHECK_FONT (font);
- idx = check_font_prop_name (prop);
+ if (FONT_OBJECT_P (font))
+ {
+ struct font *fontp = XSAVE_VALUE (font)->pointer;
+
+ if (EQ (key, QCotf))
+ {
+ if (fontp->driver->otf_capability)
+ return fontp->driver->otf_capability (fontp);
+ else
+ return Qnil;
+ }
+ font = fontp->entity;
+ }
+ else
+ CHECK_FONT (font);
+ idx = get_font_prop_index (key, 0);
if (idx < FONT_EXTRA_INDEX)
return AREF (font, idx);
if (FONT_ENTITY_P (font))
return Qnil;
- return Fcdr (Fassoc (AREF (font, FONT_EXTRA_INDEX), prop));
+ return Fcdr (Fassoc (AREF (font, FONT_EXTRA_INDEX), key));
}
DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
- doc: /* Set one property of FONT-SPEC: give property PROP value VALUE. */)
+ doc: /* Set one property of FONT-SPEC: give property KEY value VALUE. */)
(font_spec, prop, val)
Lisp_Object font_spec, prop, val;
{
Lisp_Object extra, slot;
CHECK_FONT_SPEC (font_spec);
- idx = check_font_prop_name (prop);
+ idx = get_font_prop_index (prop, 0);
if (idx < FONT_EXTRA_INDEX)
return ASET (font_spec, idx, val);
extra = AREF (font_spec, FONT_EXTRA_INDEX);
doc: /* List available fonts matching FONT-SPEC on the current frame.
Optional 2nd argument FRAME specifies the target frame.
Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
-Optional 4th argument PREFER, if non-nil, is a font-spec to sort fonts
-by closeness to PREFER. */)
+Optional 4th argument PREFER, if non-nil, is a font-spec to
+control the order of the returned list. Fonts are sorted by
+how they are close to PREFER. */)
(font_spec, frame, num, prefer)
Lisp_Object font_spec, frame, num, prefer;
{
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;
return Qnil;
}
+/* The following three functions are still expremental. */
+
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 WIDTH LBEARING RBEARING ASCENT DESCENT]
+where
+ FONT-OBJECT is a font-object for all glyphs in the g-string,
+ WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
+GLYPH is a vector of this form:
+ [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
+ [ [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.
+ WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
+ X-OFF and Y-OFF are offests to the base position for 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 (10), 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)))
- args_out_of_range (start, end);
+ || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
+ args_out_of_range_3 (object, start, end);
len = XINT (end) - XINT (start);
p = SDATA (object) + string_char_to_byte (object, 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_CHAR (g, make_number (c));
- LGLYPH_SET_CODE (g, make_number (code));
+ LGLYPH_SET_FROM (g, i);
+ LGLYPH_SET_TO (g, i);
+ LGLYPH_SET_CHAR (g, c);
+ LGLYPH_SET_CODE (g, code);
}
}
else
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_CHAR (g, make_number (c));
- LGLYPH_SET_CODE (g, make_number (code));
+ LGLYPH_SET_FROM (g, i);
+ LGLYPH_SET_TO (g, i);
+ LGLYPH_SET_CHAR (g, c);
+ LGLYPH_SET_CODE (g, code);
}
}
+ for (i = LGSTRING_LENGTH (gstring) - 1; i >= len; i--)
+ LGSTRING_SET_GLYPH (gstring, i, Qnil);
return Qnil;
}
+DEFUN ("font-shape-text", Ffont_shape_text, Sfont_shape_text, 3, 4, 0,
+ doc: /* Shape text between FROM and TO by FONT-OBJECT.
+If optional 4th argument STRING is non-nil, it is a string to shape,
+and FROM and TO are indices to the string.
+The value is the end position of the shaped text. */)
+ (from, to, font_object, string)
+ Lisp_Object from, to, font_object, string;
+{
+ struct font *font;
+ struct font_metrics metrics;
+ EMACS_INT start, end;
+ Lisp_Object gstring, n;
+ int i;
+
+ if (NILP (string))
+ {
+ validate_region (&from, &to);
+ start = XFASTINT (from);
+ end = XFASTINT (to);
+ modify_region (current_buffer, start, end, 0);
+ }
+ else
+ {
+ CHECK_STRING (string);
+ start = XINT (from);
+ end = XINT (to);
+ if (start < 0 || start > end || end > SCHARS (string))
+ args_out_of_range_3 (string, from, to);
+ }
+
+ CHECK_FONT_GET_OBJECT (font_object, font);
+ if (! font->driver->shape)
+ return from;
+
+ gstring = Ffont_make_gstring (font_object, make_number (end - start));
+ Ffont_fill_gstring (gstring, font_object, from, to, string);
+ n = font->driver->shape (gstring);
+ if (NILP (n))
+ return Qnil;
+ for (i = 0; i < XINT (n);)
+ {
+ Lisp_Object gstr;
+ Lisp_Object g = LGSTRING_GLYPH (gstring, i);
+ EMACS_INT this_from = LGLYPH_FROM (g);
+ EMACS_INT this_to = LGLYPH_TO (g) + 1;
+ int j, k;
+
+ metrics.lbearing = LGLYPH_LBEARING (g);
+ metrics.rbearing = LGLYPH_RBEARING (g);
+ metrics.ascent = LGLYPH_ASCENT (g);
+ metrics.descent = LGLYPH_DESCENT (g);
+ if (NILP (LGLYPH_ADJUSTMENT (g)))
+ metrics.width = LGLYPH_WIDTH (g);
+ else
+ {
+ metrics.width = LGLYPH_WADJUST (g);
+ metrics.lbearing += LGLYPH_XOFF (g);
+ metrics.rbearing += LGLYPH_XOFF (g);
+ metrics.ascent -= LGLYPH_YOFF (g);
+ metrics.descent += LGLYPH_YOFF (g);
+ }
+ for (j = i + 1; j < XINT (n); j++)
+ {
+ int x;
+
+ g = LGSTRING_GLYPH (gstring, j);
+ if (this_from != LGLYPH_FROM (g))
+ break;
+ x = metrics.width + LGLYPH_LBEARING (g) + LGLYPH_XOFF (g);
+ if (metrics.lbearing > x)
+ metrics.lbearing = x;
+ x = metrics.width + LGLYPH_RBEARING (g) + LGLYPH_XOFF (g);
+ if (metrics.rbearing < x)
+ metrics.rbearing = x;
+ x = LGLYPH_ASCENT (g) - LGLYPH_YOFF (g);
+ if (metrics.ascent < x)
+ metrics.ascent = x;
+ x = LGLYPH_DESCENT (g) - LGLYPH_YOFF (g);
+ if (metrics.descent < x)
+ metrics.descent = x;
+ if (NILP (LGLYPH_ADJUSTMENT (g)))
+ metrics.width += LGLYPH_WIDTH (g);
+ else
+ metrics.width += LGLYPH_WADJUST (g);
+ }
+
+ gstr = Ffont_make_gstring (font_object, make_number (j - i));
+ LGSTRING_SET_WIDTH (gstr, metrics.width);
+ LGSTRING_SET_LBEARING (gstr, metrics.lbearing);
+ LGSTRING_SET_RBEARING (gstr, metrics.rbearing);
+ LGSTRING_SET_ASCENT (gstr, metrics.ascent);
+ LGSTRING_SET_DESCENT (gstr, metrics.descent);
+ for (k = i; i < j; i++)
+ LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i));
+ if (NILP (string))
+ Fcompose_region_internal (make_number (start + this_from),
+ make_number (start + this_to),
+ gstr, Qnil);
+ else
+ Fcompose_string_internal (string,
+ make_number (start + this_from),
+ make_number (start + this_to),
+ gstr, Qnil);
+ }
+
+ return make_number (start + XINT (n));
+}
+
+DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
+ doc: /* Apply OpenType features on glyph-string GSTRING-IN.
+OTF-SPEC specifies which featuress to apply in this format:
+ (SCRIPT LANGSYS GSUB GPOS)
+where
+ SCRIPT is a symbol specifying a script tag of OpenType,
+ 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.
+
+The features are applied in the order appeared in the list. The
+symbol `*' means to apply all available features not appeared in this
+list, and the remaining features are ignored. For instance, (vatu
+pstf * haln) is 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
+the glyph-string 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. */)
+ (otf_features, gstring_in, from, to, gstring_out, index)
+ Lisp_Object otf_features, gstring_in, from, to, gstring_out, index;
+{
+ Lisp_Object font_object = LGSTRING_FONT (gstring_in);
+ Lisp_Object val;
+ struct font *font;
+ int len, num;
+
+ check_otf_features (otf_features);
+ CHECK_FONT_GET_OBJECT (font_object, font);
+ if (! font->driver->otf_drive)
+ error ("Font backend %s can't drive OpenType GSUB table",
+ SDATA (SYMBOL_NAME (font->driver->type)));
+ CHECK_CONS (otf_features);
+ CHECK_SYMBOL (XCAR (otf_features));
+ val = XCDR (otf_features);
+ CHECK_SYMBOL (XCAR (val));
+ val = XCDR (otf_features);
+ if (! NILP (val))
+ CHECK_CONS (val);
+ 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_drive (font, otf_features,
+ gstring_in, XINT (from), XINT (to),
+ gstring_out, XINT (index), 0);
+ if (num < 0)
+ return Qnil;
+ return make_number (num);
+}
+
+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, otf_features)
+ Lisp_Object font_object, character, otf_features;
+{
+ 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_drive)
+ error ("Font backend %s can't drive OpenType GSUB table",
+ SDATA (SYMBOL_NAME (font->driver->type)));
+ CHECK_CHARACTER (character);
+ CHECK_CONS (otf_features);
+
+ 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_drive (font, otf_features, 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
CHECK_LIVE_FRAME (frame);
isize = XINT (size);
+ if (isize == 0)
+ isize = 120;
if (isize < 0)
isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
}
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 vec;
}
+DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
+ doc: /* Return t iff font-spec SPEC matches with FONT.
+FONT is a font-spec, font-entity, or font-object. */)
+ (spec, font)
+ Lisp_Object spec, font;
+{
+ CHECK_FONT_SPEC (spec);
+ if (FONT_OBJECT_P (font))
+ font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity;
+ else if (! FONT_ENTITY_P (font))
+ CHECK_FONT_SPEC (font);
+
+ return (font_match_p (spec, font) ? Qt : Qnil);
+}
+
+DEFUN ("font-at", Ffont_at, Sfont_at, 1, 3, 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, string)
+ Lisp_Object position, window, string;
+{
+ struct window *w;
+ EMACS_INT pos, pos_byte;
+ int c;
+
+ if (NILP (string))
+ {
+ 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);
+ }
+ else
+ {
+ EMACS_INT len;
+ unsigned char *str;
+
+ CHECK_NUMBER (position);
+ CHECK_STRING (string);
+ pos = XINT (position);
+ if (pos < 0 || pos >= SCHARS (string))
+ args_out_of_range (string, position);
+ pos_byte = string_char_to_byte (string, pos);
+ str = SDATA (string) + pos_byte;
+ len = SBYTES (string) - pos_byte;
+ c = STRING_CHAR (str, eln);
+ }
+ 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.
sort_shift_bits[FONT_FOUNDRY_INDEX] = 29;
sort_shift_bits[FONT_FAMILY_INDEX] = 30;
sort_shift_bits[FONT_REGISTRY_INDEX] = 31;
- /* Note that sort_shift_bits[FONT_SLANT_TYPE] is never used. */
+ /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
staticpro (&font_style_table);
font_style_table = Fmake_vector (make_number (3), Qnil);
staticpro (&font_family_alist);
font_family_alist = Qnil;
- DEFSYM (Qfontp, "fontp");
+ staticpro (&font_charset_alist);
+ font_charset_alist = Qnil;
+
+ 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");
DEFSYM (QCscript, ":script");
+ DEFSYM (QCantialias, ":antialias");
DEFSYM (QCfoundry, ":foundry");
DEFSYM (QCadstyle, ":adstyle");
DEFSYM (QCregistry, ":registry");
+ DEFSYM (QCspacing, ":spacing");
+ DEFSYM (QCdpi, ":dpi");
+ DEFSYM (QCscalable, ":scalable");
DEFSYM (QCextra, ":extra");
+ DEFSYM (Qc, "c");
+ DEFSYM (Qm, "m");
+ DEFSYM (Qp, "p");
+ DEFSYM (Qd, "d");
+
staticpro (&null_string);
null_string = build_string ("");
staticpro (&null_vector);
staticpro (&scratch_font_prefer);
scratch_font_prefer = Ffont_spec (0, NULL);
+#ifdef HAVE_LIBOTF
+ staticpro (&otf_list);
+ otf_list = Qnil;
+#endif
+
defsubr (&Sfontp);
defsubr (&Sfont_spec);
defsubr (&Sfont_get);
defsubr (&Sinternal_set_font_style_table);
defsubr (&Sfont_make_gstring);
defsubr (&Sfont_fill_gstring);
+ defsubr (&Sfont_shape_text);
+ defsubr (&Sfont_drive_otf);
+ defsubr (&Sfont_otf_alternates);
#ifdef FONT_DEBUG
defsubr (&Sopen_font);
defsubr (&Sclose_font);
defsubr (&Squery_font);
defsubr (&Sget_font_glyphs);
+ defsubr (&Sfont_match_p);
+ defsubr (&Sfont_at);
#if 0
defsubr (&Sdraw_string);
#endif
#endif /* FONT_DEBUG */
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
#ifdef HAVE_FREETYPE
- syms_of_ftfont ();
+ syms_of_ftfont ();
#ifdef HAVE_X_WINDOWS
- syms_of_xfont ();
- syms_of_ftxfont ();
+ syms_of_xfont ();
+ syms_of_ftxfont ();
#ifdef HAVE_XFT
- syms_of_xftfont ();
+ syms_of_xftfont ();
#endif /* HAVE_XFT */
#endif /* HAVE_X_WINDOWS */
#else /* not HAVE_FREETYPE */
#ifdef HAVE_X_WINDOWS
- syms_of_xfont ();
+ syms_of_xfont ();
#endif /* HAVE_X_WINDOWS */
#endif /* not HAVE_FREETYPE */
#ifdef HAVE_BDFFONT
- syms_of_bdffont ();
+ syms_of_bdffont ();
#endif /* HAVE_BDFFONT */
#ifdef WINDOWSNT
- syms_of_w32font ();
+ syms_of_w32font ();
#endif /* WINDOWSNT */
#ifdef MAC_OS
- syms_of_atmfont ();
+ syms_of_atmfont ();
#endif /* MAC_OS */
+ }
+#endif /* USE_FONT_BACKEND */
}
/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846