#include <config.h>
#include <stdio.h>
#include <stdlib.h>
-#include <strings.h>
#include <ctype.h>
#ifdef HAVE_M17N_FLT
#include <m17n-flt.h>
#include "w32term.h"
#endif /* HAVE_NTGUI */
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif /* HAVE_NS */
+
#ifdef MAC_OS
#include "macterm.h"
#endif /* MAC_OS */
-#ifndef FONT_DEBUG
-#define FONT_DEBUG
-#endif
-
-#ifdef FONT_DEBUG
-#undef xassert
-#define xassert(X) do {if (!(X)) abort ();} while (0)
-#else
-#define xassert(X) (void) 0
-#endif
-
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
+
+#ifdef HAVE_NS
+extern Lisp_Object Qfontsize;
+#endif
Lisp_Object Qopentype;
/* Important character set strings. */
-Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip;
+Lisp_Object Qascii_0, Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip;
+
+#ifdef HAVE_NS
+#define DEFAULT_ENCODING Qiso10646_1
+#else
+#define DEFAULT_ENCODING Qiso8859_1
+#endif
/* Special vector of zero length. This is repeatedly used by (struct
font_driver *)->list when a specified font is not found. */
static Lisp_Object null_vector;
-/* Vector of 3 elements. Each element is a vector for one of font
- style properties (weight, slant, width). The vector contains a
- mapping between symbolic property values (e.g. `medium' for weight)
- and numeric property values (e.g. 100). So, it looks like this:
- [[(ultra-light . 20) ... (black . 210)]
- [(reverse-oblique . 0) ... (oblique . 210)]
- [(ultra-contains . 50) ... (wide . 200)]] */
+static Lisp_Object Vfont_weight_table, Vfont_slant_table, Vfont_width_table;
+
+/* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
static Lisp_Object font_style_table;
+/* Structure used for tables mapping weight, slant, and width numeric
+ values and their names. */
+
+struct table_entry
+{
+ int numeric;
+ /* The first one is a valid name as a face attribute.
+ The second one (if any) is a typical name in XLFD field. */
+ char *names[5];
+ Lisp_Object *symbols;
+};
+
+/* Table of weight numeric values and their names. This table must be
+ sorted by numeric values in ascending order. */
+
+static struct table_entry weight_table[] =
+{
+ { 0, { "thin" }},
+ { 20, { "ultra-light", "ultralight" }},
+ { 40, { "extra-light", "extralight" }},
+ { 50, { "light" }},
+ { 75, { "semi-light", "semilight", "demilight", "book" }},
+ { 100, { "normal", "medium", "regular" }},
+ { 180, { "semi-bold", "semibold", "demibold", "demi" }},
+ { 200, { "bold" }},
+ { 205, { "extra-bold", "extrabold" }},
+ { 210, { "ultra-bold", "ultrabold", "black" }}
+};
+
+/* Table of slant numeric values and their names. This table must be
+ sorted by numeric values in ascending order. */
+
+static struct table_entry slant_table[] =
+{
+ { 0, { "reverse-oblique", "ro" }},
+ { 10, { "reverse-italic", "ri" }},
+ { 100, { "normal", "r" }},
+ { 200, { "italic" ,"i", "ot" }},
+ { 210, { "oblique", "o" }}
+};
+
+/* Table of width numeric values and their names. This table must be
+ sorted by numeric values in ascending order. */
+
+static struct table_entry width_table[] =
+{
+ { 50, { "ultra-condensed", "ultracondensed" }},
+ { 63, { "extra-condensed", "extracondensed" }},
+ { 75, { "condensed", "compressed", "narrow" }},
+ { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
+ { 100, { "normal", "medium", "regular" }},
+ { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
+ { 125, { "expanded" }},
+ { 150, { "extra-expanded", "extraexpanded" }},
+ { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
+};
+
extern Lisp_Object Qnormal;
/* Symbols representing keys of normal font properties. */
-extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth, QCsize, QCname;
+extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth;
+extern Lisp_Object QCheight, QCsize, QCname;
+
Lisp_Object QCfoundry, QCadstyle, QCregistry;
/* Symbols representing keys of font extra info. */
Lisp_Object QCspacing, QCdpi, QCscalable, QCotf, QClang, QCscript, QCavgwidth;
/* Symbols representing values of font spacing property. */
Lisp_Object Qc, Qm, Qp, Qd;
+Lisp_Object Vfont_encoding_alist;
+
/* Alist of font registry symbol and the corresponding charsets
information. The information is retrieved from
Vfont_encoding_alist on demand.
return font_entity;
}
+/* Create a font-object whose structure size is SIZE. If ENTITY is
+ not nil, copy properties from ENTITY to the font-object. If
+ PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
Lisp_Object
-font_make_object (size)
+font_make_object (size, entity, pixelsize)
int size;
+ Lisp_Object entity;
+ int pixelsize;
{
Lisp_Object font_object;
struct font *font
= (struct font *) allocate_pseudovector (size, FONT_OBJECT_MAX, PVEC_FONT);
+ int i;
+
XSETFONT (font_object, font);
+ if (! NILP (entity))
+ {
+ for (i = 1; i < FONT_SPEC_MAX; i++)
+ font->props[i] = AREF (entity, i);
+ if (! NILP (AREF (entity, FONT_EXTRA_INDEX)))
+ font->props[FONT_EXTRA_INDEX]
+ = Fcopy_sequence (AREF (entity, FONT_EXTRA_INDEX));
+ }
+ if (size > 0)
+ font->props[FONT_SIZE_INDEX] = make_number (pixelsize);
return font_object;
}
/* Return a Lispy value of a font property value at STR and LEN bytes.
If STR is "*", it returns nil.
- If all characters in STR are digits, it returns an integer.
- Otherwise, it returns a symbol interned from STR. */
+ If FORCE_SYMBOL is zero and all characters in STR are digits, it
+ returns an integer. Otherwise, it returns a symbol interned from
+ STR. */
Lisp_Object
-font_intern_prop (str, len)
+font_intern_prop (str, len, force_symbol)
char *str;
int len;
+ int force_symbol;
{
int i;
- Lisp_Object tem, string;
+ Lisp_Object tem;
Lisp_Object obarray;
if (len == 1 && *str == '*')
return Qnil;
- if (len >=1 && isdigit (*str))
+ if (!force_symbol && len >=1 && isdigit (*str))
{
for (i = 1; i < len; i++)
if (! isdigit (str[i]))
FRAME_PTR f;
Lisp_Object spec;
{
+#ifdef HAVE_WINDOW_SYSTEM
Lisp_Object size = AREF (spec, FONT_SIZE_INDEX);
double point_size;
int dpi, pixel_size;
- Lisp_Object extra, val;
+ Lisp_Object val;
if (INTEGERP (size))
return XINT (size);
if (NILP (size))
- return 0; xassert (FLOATP (size));
+ return 0;
+ font_assert (FLOATP (size));
point_size = XFLOAT_DATA (size);
val = AREF (spec, FONT_DPI_INDEX);
if (INTEGERP (val))
- dpi = XINT (XCDR (val));
+ dpi = XINT (val);
else
dpi = f->resy;
pixel_size = POINT_TO_PIXEL (point_size, dpi);
return pixel_size;
+#else
+ return 1;
+#endif
}
{
Lisp_Object table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
int len = ASIZE (table);
- int i;
+ int i, j;
if (SYMBOLP (val))
{
- char *s;
+ unsigned char *s;
Lisp_Object args[2], elt;
/* At first try exact match. */
for (i = 0; i < len; i++)
- if (EQ (val, XCAR (AREF (table, i))))
- return (XINT (XCDR (AREF (table, i))) << 8) | i;
+ for (j = 1; j < ASIZE (AREF (table, i)); j++)
+ if (EQ (val, AREF (AREF (table, i), j)))
+ return ((XINT (AREF (AREF (table, i), 0)) << 8)
+ | (i << 4) | (j - 1));
/* Try also with case-folding match. */
s = SDATA (SYMBOL_NAME (val));
for (i = 0; i < len; i++)
- {
- elt = XCAR (AREF (table, i));
- if (strcasecmp (s, (char *) SDATA (SYMBOL_NAME (elt))) == 0)
- return i;
- }
+ for (j = 1; j < ASIZE (AREF (table, i)); j++)
+ {
+ elt = AREF (AREF (table, i), j);
+ if (xstrcasecmp (s, SDATA (SYMBOL_NAME (elt))) == 0)
+ return ((XINT (AREF (AREF (table, i), 0)) << 8)
+ | (i << 4) | (j - 1));
+ }
if (! noerror)
return -1;
if (len == 255)
abort ();
+ elt = Fmake_vector (make_number (2), make_number (255));
+ ASET (elt, 1, val);
args[0] = table;
- args[1] = Fmake_vector (make_number (1), Fcons (val, make_number (255)));
+ args[1] = Fmake_vector (make_number (1), elt);
ASET (font_style_table, prop - FONT_WEIGHT_INDEX, Fvconcat (2, args));
- return (255 << 8) | i;
+ return (255 << 8) | (i << 4);
}
else
{
- int last_i, i, last_n;
+ int i, last_n;
int numeric = XINT (val);
- for (i = 1, last_i = last_n = -1; i < len;)
+ for (i = 0, last_n = -1; i < len; i++)
{
- int n = XINT (XCDR (AREF (table, i)));
+ int n = XINT (AREF (AREF (table, i), 0));
if (numeric == n)
- return (n << 8) | i;
+ return (n << 8) | (i << 4);
if (numeric < n)
{
if (! noerror)
return -1;
- return ((last_i < 0 || n - numeric < numeric - last_n)
- ? (n << 8) | i : (last_n << 8 | last_i));
+ return ((i == 0 || n - numeric < numeric - last_n)
+ ? (n << 8) | (i << 4): (last_n << 8 | ((i - 1) << 4)));
}
- last_i = i;
last_n = n;
- for (i++; i < len && n == XINT (XCDR (AREF (table, i + 1))); i++);
}
if (! noerror)
return -1;
- return (last_n << 8) | last_i;
+ return ((last_n << 8) | ((i - 1) << 4));
}
}
int for_face;
{
Lisp_Object val = AREF (font, prop);
- Lisp_Object table;
- int i, numeric;
+ Lisp_Object table, elt;
+ int i;
if (NILP (val))
return Qnil;
table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
- if (! for_face)
- return XCAR (AREF (table, XINT (val) & 0xFF));
- numeric = XINT (val) >> 8;
- for (i = 0; i < ASIZE (table); i++)
- if (XINT (XCDR (AREF (table, i))) == numeric)
- return XCAR (AREF (table, i));
- abort ();
- return Qnil;
+ i = XINT (val) & 0xFF;
+ font_assert (((i >> 4) & 0xF) < ASIZE (table));
+ elt = AREF (table, ((i >> 4) & 0xF));
+ font_assert ((i & 0xF) + 1 < ASIZE (elt));
+ return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
}
extern Lisp_Object Vface_alternative_font_family_alist;
extern Lisp_Object find_font_encoding P_ ((Lisp_Object));
+/* Return ENCODING or a cons of ENCODING and REPERTORY of the font
+ FONTNAME. ENCODING is a charset symbol that specifies the encoding
+ of the font. REPERTORY is a charset symbol or nil. */
+
+Lisp_Object
+find_font_encoding (fontname)
+ Lisp_Object fontname;
+{
+ Lisp_Object tail, elt;
+
+ for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ if (CONSP (elt)
+ && STRINGP (XCAR (elt))
+ && fast_string_match_ignore_case (XCAR (elt), fontname) >= 0
+ && (SYMBOLP (XCDR (elt))
+ ? CHARSETP (XCDR (elt))
+ : CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt)))))
+ return (XCDR (elt));
+ }
+ /* We don't know the encoding of this font. Let's assume `ascii'. */
+ return Qascii;
+}
+
/* 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. */
if (INTEGERP (val))
{
n = XINT (val);
- if ((n & 0xFF)
+ if (((n >> 4) & 0xF)
>= ASIZE (AREF (font_style_table, prop - FONT_WEIGHT_INDEX)))
val = Qerror;
else
{
- Lisp_Object elt = AREF (AREF (font_style_table, prop - FONT_WEIGHT_INDEX), n & 0xFF);
- if (XINT (XCDR (elt)) != (n >> 8))
+ Lisp_Object elt = AREF (AREF (font_style_table, prop - FONT_WEIGHT_INDEX), (n >> 4) & 0xF);
+
+ if ((n & 0xF) + 1 >= ASIZE (elt))
+ val = Qerror;
+ else if (XINT (AREF (elt, 0)) != (n >> 8))
val = Qerror;
}
}
{
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);
- if (EQ (val, Qd))
- return make_number (FONT_SPACING_DUAL);
+ if (SYMBOLP (val) && SBYTES (SYMBOL_NAME (val)) == 1)
+ {
+ char spacing = SDATA (SYMBOL_NAME (val))[0];
+
+ if (spacing == 'c' || spacing == 'C')
+ return make_number (FONT_SPACING_CHARCELL);
+ if (spacing == 'm' || spacing == 'M')
+ return make_number (FONT_SPACING_MONO);
+ if (spacing == 'p' || spacing == 'P')
+ return make_number (FONT_SPACING_PROPORTIONAL);
+ if (spacing == 'd' || spacing == 'D')
+ return make_number (FONT_SPACING_DUAL);
+ }
return Qerror;
}
}
f[i] = name + len;
-#define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N])
+#define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
+#define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
if (i == XLFD_LAST_INDEX)
{
/* Fully specified XLFD. */
int pixel_size;
- int spacing_char;
- ASET (font, FONT_FOUNDRY_INDEX, INTERN_FIELD (XLFD_FOUNDRY_INDEX));
- ASET (font, FONT_FAMILY_INDEX, INTERN_FIELD (XLFD_FAMILY_INDEX));
+ ASET (font, FONT_FOUNDRY_INDEX, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX));
+ ASET (font, FONT_FAMILY_INDEX, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX));
for (i = XLFD_WEIGHT_INDEX, j = FONT_WEIGHT_INDEX;
i <= XLFD_SWIDTH_INDEX; i++, j++)
{
- val = INTERN_FIELD (i);
+ val = INTERN_FIELD_SYM (i);
if (! NILP (val))
{
- if ((n = font_style_to_value (j, INTERN_FIELD (i), 0)) < 0)
+ if ((n = font_style_to_value (j, INTERN_FIELD_SYM (i), 0)) < 0)
return -1;
ASET (font, j, make_number (n));
}
}
- ASET (font, FONT_ADSTYLE_INDEX, INTERN_FIELD (XLFD_ADSTYLE_INDEX));
+ ASET (font, FONT_ADSTYLE_INDEX, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX));
if (strcmp (f[XLFD_REGISTRY_INDEX], "*-*") == 0)
ASET (font, FONT_REGISTRY_INDEX, Qnil);
else
ASET (font, FONT_REGISTRY_INDEX,
font_intern_prop (f[XLFD_REGISTRY_INDEX],
- f[XLFD_LAST_INDEX] - f[XLFD_REGISTRY_INDEX]));
+ f[XLFD_LAST_INDEX] - f[XLFD_REGISTRY_INDEX],
+ 1));
p = f[XLFD_PIXEL_INDEX];
if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0)
ASET (font, FONT_SIZE_INDEX, make_number (pixel_size));
{
double point_size = -1;
- xassert (FONT_SPEC_P (font));
+ font_assert (FONT_SPEC_P (font));
p = f[XLFD_POINT_INDEX];
if (*p == '[')
point_size = parse_matrix (p);
if (*p == '~')
p++;
ASET (font, FONT_AVGWIDTH_INDEX,
- font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p));
+ font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p, 0));
}
else
{
else if (j + 1 < i)
prop[j] = INTERN_FIELD (j);
else
- prop[j] = font_intern_prop (f[j], f[i] - f[j]);
+ prop[j] = font_intern_prop (f[j], f[i] - f[j], 0);
}
if (! wild_card_found)
return -1;
Lisp_Object val;
int i, j, len = 0;
- xassert (FONTP (font));
+ font_assert (FONTP (font));
for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX;
i++, j++)
}
val = AREF (font, FONT_SIZE_INDEX);
- xassert (NUMBERP (val) || NILP (val));
+ font_assert (NUMBERP (val) || NILP (val));
if (INTEGERP (val))
{
i = XINT (val);
f[XLFD_REGISTRY_INDEX]);
}
-/* 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. */
+/* Parse NAME (null terminated) and store information in FONT
+ (font-spec or font-entity). NAME is supplied in either the
+ Fontconfig or GTK font name format. If NAME is successfully
+ parsed, return 0. Otherwise return -1.
+
+ The fontconfig format is
+
+ FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
+
+ The GTK format is
+
+ FAMILY [PROPS...] [SIZE]
+
+ This function tries to guess which format it is. */
int
font_parse_fcname (name, font)
char *name;
Lisp_Object font;
{
- char *p0, *p1;
+ char *p, *q;
+ char *size_beg = NULL, *size_end = NULL;
+ char *props_beg = NULL, *family_end = NULL;
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
+
+ for (p = name; *p; p++)
{
- Lisp_Object family;
- double point_size;
+ if (*p == '\\' && p[1])
+ p++;
+ else if (*p == ':')
+ {
+ props_beg = family_end = p;
+ break;
+ }
+ else if (*p == '-')
+ {
+ int decimal = 0, size_found = 1;
+ for (q = p + 1; *q && *q != ':'; q++)
+ if (! isdigit(*q))
+ {
+ if (*q != '.' || decimal)
+ {
+ size_found = 0;
+ break;
+ }
+ decimal = 1;
+ }
+ if (size_found)
+ {
+ family_end = p;
+ size_beg = p + 1;
+ size_end = q;
+ break;
+ }
+ }
+ }
- for (p0 = name + 1; *p0 && (*p0 != '-' && *p0 != ':'); p0++)
- if (*p0 == '\\' && p0[1])
- p0++;
- family = font_intern_prop (name, p0 - name);
- if (*p0 == '-')
+ if (family_end)
+ {
+ /* A fontconfig name with size and/or property data. */
+ if (family_end > name)
{
- if (! isdigit (p0[1]))
- return -1;
- point_size = strtod (p0 + 1, &p1);
- if (*p1 && *p1 != ':')
- return -1;
+ Lisp_Object family;
+ family = font_intern_prop (name, family_end - name, 1);
+ ASET (font, FONT_FAMILY_INDEX, family);
+ }
+ if (size_beg)
+ {
+ double point_size = strtod (size_beg, &size_end);
ASET (font, FONT_SIZE_INDEX, make_float (point_size));
- p0 = p1;
+ if (*size_end == ':' && size_end[1])
+ props_beg = size_end;
}
- ASET (font, FONT_FAMILY_INDEX, family);
- }
+ if (props_beg)
+ {
+ /* Now parse ":KEY=VAL" patterns. */
+ Lisp_Object val;
- len -= p0 - name;
- copy = alloca (len + 1);
- if (! copy)
- return -1;
- name = copy;
+ for (p = props_beg; *p; p = q)
+ {
+ for (q = p + 1; *q && *q != '=' && *q != ':'; q++);
+ if (*q != '=')
+ {
+ /* Must be an enumerated value. */
+ int word_len;
+ p = p + 1;
+ word_len = q - p;
+ val = font_intern_prop (p, q - p, 1);
+
+#define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
+
+ if (PROP_MATCH ("light", 5)
+ || PROP_MATCH ("medium", 6)
+ || PROP_MATCH ("demibold", 8)
+ || PROP_MATCH ("bold", 4)
+ || PROP_MATCH ("black", 5))
+ FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, val);
+ else if (PROP_MATCH ("roman", 5)
+ || PROP_MATCH ("italic", 6)
+ || PROP_MATCH ("oblique", 7))
+ FONT_SET_STYLE (font, FONT_SLANT_INDEX, val);
+ else if (PROP_MATCH ("charcell", 8))
+ ASET (font, FONT_SPACING_INDEX,
+ make_number (FONT_SPACING_CHARCELL));
+ else if (PROP_MATCH ("mono", 4))
+ ASET (font, FONT_SPACING_INDEX,
+ make_number (FONT_SPACING_MONO));
+ else if (PROP_MATCH ("proportional", 12))
+ ASET (font, FONT_SPACING_INDEX,
+ make_number (FONT_SPACING_PROPORTIONAL));
+#undef PROP_MATCH
+ }
+ else
+ {
+ /* KEY=VAL pairs */
+ Lisp_Object key;
+ int prop;
+
+ if (q - p == 10 && memcmp (p + 1, "pixelsize", 9) == 0)
+ prop = FONT_SIZE_INDEX;
+ else
+ {
+ key = font_intern_prop (p, q - p, 1);
+ prop = get_font_prop_index (key);
+ }
+
+ p = q + 1;
+ for (q = p; *q && *q != ':'; q++);
+ val = font_intern_prop (p, q - p, 0);
- /* Now parse ":KEY=VAL" patterns. Store known keys and values in
- extra, copy unknown ones to COPY. It is stored in extra slot by
- the key QCfc_unknown_spec. */
- while (*p0)
+ if (prop >= FONT_FOUNDRY_INDEX
+ && prop < FONT_EXTRA_INDEX)
+ ASET (font, prop, font_prop_validate (prop, Qnil, val));
+ else
+ Ffont_put (font, key, val);
+ }
+ p = q;
+ }
+ }
+ }
+ else
{
- Lisp_Object key, val;
- int prop;
+ /* Either a fontconfig-style name with no size and property
+ data, or a GTK-style name. */
+ Lisp_Object prop;
+ int word_len, prop_found = 0;
- for (p1 = p0 + 1; *p1 && *p1 != '=' && *p1 != ':'; p1++);
- if (*p1 != '=')
+ for (p = name; *p; p = *q ? q + 1 : q)
{
- /* Must be an enumerated value. */
- val = font_intern_prop (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)
- FONT_SET_STYLE (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)
- FONT_SET_STYLE (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)
+ if (isdigit (*p))
{
- int spacing = (p0[1] == 'c' ? FONT_SPACING_CHARCELL
- : p0[1] == 'm' ? FONT_SPACING_MONO
- : FONT_SPACING_PROPORTIONAL);
- ASET (font, FONT_SPACING_INDEX, make_number (spacing));
- }
- else
+ int size_found = 1;
+
+ for (q = p + 1; *q && *q != ' '; q++)
+ if (! isdigit (*q))
+ {
+ size_found = 0;
+ break;
+ }
+ if (size_found)
+ {
+ double point_size = strtod (p, &q);
+ ASET (font, FONT_SIZE_INDEX, make_float (point_size));
+ continue;
+ }
+ }
+
+ for (q = p + 1; *q && *q != ' '; q++)
+ if (*q == '\\' && q[1])
+ q++;
+ word_len = q - p;
+
+#define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
+
+ if (PROP_MATCH ("Ultra-Light", 11))
{
- /* unknown key */
- bcopy (p0, copy, p1 - p0);
- copy += p1 - p0;
+ prop_found = 1;
+ prop = font_intern_prop ("ultra-light", 11, 1);
+ FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
}
- }
- else
- {
- if (memcmp (p0 + 1, "pixelsize=", 10) == 0)
- prop = FONT_SIZE_INDEX;
- else
+ else if (PROP_MATCH ("Light", 5))
{
- key = font_intern_prop (p0, p1 - p0);
- prop = get_font_prop_index (key);
+ prop_found = 1;
+ prop = font_intern_prop ("light", 5, 1);
+ FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
}
- p0 = p1 + 1;
- for (p1 = p0; *p1 && *p1 != ':'; p1++);
- val = font_intern_prop (p0, p1 - p0);
- if (! NILP (val))
+ else if (PROP_MATCH ("Semi-Bold", 9))
{
- if (prop >= FONT_FOUNDRY_INDEX && prop < FONT_EXTRA_INDEX)
- ASET (font, prop, font_prop_validate (prop, Qnil, val));
- else if (prop >= 0)
- Ffont_put (font, key, val);
- else
- bcopy (p0 - 1, copy, p1 - p0 + 1);
- copy += p1 - p0 + 1;
+ prop_found = 1;
+ prop = font_intern_prop ("semi-bold", 9, 1);
+ FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
+ }
+ else if (PROP_MATCH ("Bold", 4))
+ {
+ prop_found = 1;
+ prop = font_intern_prop ("bold", 4, 1);
+ FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, prop);
}
+ else if (PROP_MATCH ("Italic", 6))
+ {
+ prop_found = 1;
+ prop = font_intern_prop ("italic", 4, 1);
+ FONT_SET_STYLE (font, FONT_SLANT_INDEX, prop);
+ }
+ else if (PROP_MATCH ("Oblique", 7))
+ {
+ prop_found = 1;
+ prop = font_intern_prop ("oblique", 7, 1);
+ FONT_SET_STYLE (font, FONT_SLANT_INDEX, prop);
+ }
+ else {
+ if (prop_found)
+ return -1; /* Unknown property in GTK-style font name. */
+ family_end = q;
+ }
+ }
+#undef PROP_MATCH
+
+ if (family_end)
+ {
+ Lisp_Object family;
+ family = font_intern_prop (name, family_end - name, 1);
+ ASET (font, FONT_FAMILY_INDEX, family);
}
- p0 = p1;
}
- if (name != copy)
- font_put_extra (font, QCfc_unknown_spec,
- make_unibyte_string (name, copy - name));
return 0;
}
char *name;
int nbytes;
{
+ Lisp_Object family, foundry;
Lisp_Object tail, val;
int point_size;
- int dpi, spacing, avgwidth;
+ int dpi;
int i, len = 1;
char *p;
Lisp_Object styles[3];
char *style_names[3] = { "weight", "slant", "width" };
char work[256];
- val = AREF (font, FONT_FAMILY_INDEX);
- if (STRINGP (val))
- len += SBYTES (val);
+ family = AREF (font, FONT_FAMILY_INDEX);
+ if (! NILP (family))
+ {
+ if (SYMBOLP (family))
+ {
+ family = SYMBOL_NAME (family);
+ len += SBYTES (family);
+ }
+ else
+ family = Qnil;
+ }
val = AREF (font, FONT_SIZE_INDEX);
if (INTEGERP (val))
len += 11; /* for "-NUM" */
}
- val = AREF (font, FONT_FOUNDRY_INDEX);
- if (STRINGP (val))
- /* ":foundry=NAME" */
- len += 9 + SBYTES (val);
+ foundry = AREF (font, FONT_FOUNDRY_INDEX);
+ if (! NILP (foundry))
+ {
+ if (SYMBOLP (foundry))
+ {
+ foundry = SYMBOL_NAME (foundry);
+ len += 9 + SBYTES (foundry); /* ":foundry=NAME" */
+ }
+ else
+ foundry = Qnil;
+ }
for (i = 0; i < 3; i++)
{
- int this_len;
-
styles[i] = font_style_symbolic (font, FONT_WEIGHT_INDEX + i, 0);
if (! NILP (styles[i]))
len += sprintf (work, ":%s=%s", style_names[i],
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 (! NILP (family))
+ p += sprintf (p, "%s", SDATA (family));
if (point_size > 0)
{
if (p == name)
return (p - name);
}
+/* Store GTK-style font name of FONT (font-spec or font-entity) in
+ NAME (NBYTES length), and return the name length. F is the frame
+ on which the font is displayed; it is used to calculate the point
+ size. */
+
+int
+font_unparse_gtkname (font, f, name, nbytes)
+ Lisp_Object font;
+ struct frame *f;
+ char *name;
+ int nbytes;
+{
+ char *p;
+ int len = 1;
+ Lisp_Object family, weight, slant, size;
+ int point_size = -1;
+
+ family = AREF (font, FONT_FAMILY_INDEX);
+ if (! NILP (family))
+ {
+ if (! SYMBOLP (family))
+ return -1;
+ family = SYMBOL_NAME (family);
+ len += SBYTES (family);
+ }
+
+ weight = font_style_symbolic (font, FONT_WEIGHT_INDEX, 0);
+ if (EQ (weight, Qnormal))
+ weight = Qnil;
+ else if (! NILP (weight))
+ {
+ weight = SYMBOL_NAME (weight);
+ len += SBYTES (weight);
+ }
+
+ slant = font_style_symbolic (font, FONT_SLANT_INDEX, 0);
+ if (EQ (slant, Qnormal))
+ slant = Qnil;
+ else if (! NILP (slant))
+ {
+ slant = SYMBOL_NAME (slant);
+ len += SBYTES (slant);
+ }
+
+ size = AREF (font, FONT_SIZE_INDEX);
+ /* Convert pixel size to point size. */
+ if (INTEGERP (size))
+ {
+ Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
+ int dpi = 75;
+ if (INTEGERP (font_dpi))
+ dpi = XINT (font_dpi);
+ else if (f)
+ dpi = f->resy;
+ point_size = PIXEL_TO_POINT (XINT (size), dpi);
+ len += 11;
+ }
+ else if (FLOATP (size))
+ {
+ point_size = (int) XFLOAT_DATA (size);
+ len += 11;
+ }
+
+ if (len > nbytes)
+ return -1;
+
+ p = name + sprintf (name, "%s", SDATA (family));
+
+ if (! NILP (weight))
+ {
+ char *q = p;
+ p += sprintf (p, " %s", SDATA (weight));
+ q[1] = toupper (q[1]);
+ }
+
+ if (! NILP (slant))
+ {
+ char *q = p;
+ p += sprintf (p, " %s", SDATA (slant));
+ q[1] = toupper (q[1]);
+ }
+
+ if (point_size > 0)
+ p += sprintf (p, " %d", point_size);
+
+ 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. */
int len;
char *p0, *p1;
- if (! NILP (family))
+ if (! NILP (family)
+ && NILP (AREF (font_spec, FONT_FAMILY_INDEX)))
{
CHECK_STRING (family);
len = SBYTES (family);
p1 = index (p0, '-');
if (p1)
{
- if (*p0 != '*' || p1 - p0 > 1)
- ASET (font_spec, FONT_FOUNDRY_INDEX,
- font_intern_prop (p0, p1 - p0));
+ if ((*p0 != '*' || p1 - p0 > 1)
+ && NILP (AREF (font_spec, FONT_FOUNDRY_INDEX)))
+ Ffont_put (font_spec, QCfoundry, font_intern_prop (p0, p1 - p0, 1));
p1++;
len -= p1 - p0;
- ASET (font_spec, FONT_FAMILY_INDEX, font_intern_prop (p1, len));
+ Ffont_put (font_spec, QCfamily, font_intern_prop (p1, len, 1));
}
else
ASET (font_spec, FONT_FAMILY_INDEX, Fintern (family, Qnil));
/* OTF handler */
+#if 0
+
#define LGSTRING_HEADER_SIZE 6
#define LGSTRING_GLYPH_SIZE 8
error ("OTF spec too long");
}
-
Lisp_Object
font_otf_DeviceTable (device_table)
OTF_DeviceTable *device_table;
}
return val;
}
-
#endif /* HAVE_LIBOTF */
+#endif /* 0 */
/* G-string (glyph string) handler */
\f
/* Font sorting */
-static unsigned font_score P_ ((Lisp_Object, 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,
- int));
+ Lisp_Object, int));
/* We sort fonts by scoring each of them against a specified
font-spec. The score value is 32 bit (`unsigned'), and the smaller
the value is, the closer the font is to the font-spec.
- The highest 2 bits of the score is used for FAMILY. The exact
- match is 0, match with one of face-font-family-alternatives is
- nonzero.
-
- The next 2 bits of the score is used for the atomic properties
- FOUNDRY and ADSTYLE respectively.
+ The lowest 2 bits of the score is used for driver type. The font
+ available by the most preferred font driver is 0.
- Each 7-bit in the lower 28 bits are used for numeric properties
+ Each 7-bit in the higher 28 bits are used for numeric properties
WEIGHT, SLANT, WIDTH, and SIZE. */
/* How many bits to shift to store the difference value of each font
/* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
The return value indicates how different ENTITY is compared with
- SPEC_PROP.
-
- ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
- alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
+ SPEC_PROP. */
static unsigned
-font_score (entity, spec_prop, alternate_families)
+font_score (entity, spec_prop)
Lisp_Object entity, *spec_prop;
- Lisp_Object alternate_families;
{
unsigned score = 0;
int i;
- /* Score three atomic fields. Maximum difference is 1 (family is 3). */
- for (i = FONT_FOUNDRY_INDEX; i <= FONT_ADSTYLE_INDEX; i++)
- if (i != FONT_REGISTRY_INDEX
- && ! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i]))
- {
- Lisp_Object entity_str = SYMBOL_NAME (AREF (entity, i));
- Lisp_Object spec_str = SYMBOL_NAME (spec_prop[i]);
-
- if (strcasecmp (SDATA (spec_str), SDATA (entity_str)))
- {
- if (i == FONT_FAMILY_INDEX && CONSP (alternate_families))
- {
- int j;
-
- for (j = 1; CONSP (alternate_families);
- j++, alternate_families = XCDR (alternate_families))
- {
- spec_str = XCAR (alternate_families);
- if (strcasecmp (SDATA (spec_str), SDATA (entity_str)) == 0)
- break;
-
- }
- if (j > 3)
- j = 3;
- score |= j << sort_shift_bits[i];
- }
- else
- score |= 1 << sort_shift_bits[i];
- }
- }
-
/* Score three style numeric fields. Maximum difference is 127. */
for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++)
if (! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i]))
if (diff < 0)
diff = - diff;
- /* This is to prefer the exact symbol style. */
- diff++;
- score |= min (diff, 127) << sort_shift_bits[i];
+ if (diff > 0)
+ score |= min (diff, 127) << sort_shift_bits[i];
}
/* Score the size. Maximum difference is 127. */
i = FONT_SIZE_INDEX;
- if (! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i])
- && XINT (AREF (entity, i)) > 0)
+ if (! NILP (spec_prop[i]) && XINT (AREF (entity, i)) > 0)
{
/* We use the higher 6-bit for the actual size difference. The
lowest bit is set if the DPI is different. */
if (diff < 0)
diff = - diff;
- diff << 1;
+ diff <<= 1;
if (! NILP (spec_prop[FONT_DPI_INDEX])
&& ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
diff |= 1;
/* Sort font-entities in vector VEC by closeness to font-spec PREFER.
If PREFER specifies a point-size, calculate the corresponding
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.
+ of FRAME before sorting.
If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
return the sorted VEC. */
static Lisp_Object
-font_sort_entites (vec, prefer, frame, spec, best_only)
- Lisp_Object vec, prefer, frame, spec;
+font_sort_entites (vec, prefer, frame, best_only)
+ Lisp_Object vec, prefer, frame;
int best_only;
{
Lisp_Object prefer_prop[FONT_SPEC_MAX];
int len, i;
struct font_sort_data *data;
- Lisp_Object alternate_families = Qnil;
unsigned best_score;
- Lisp_Object best_entity;
+ Lisp_Object best_entity, driver_type;
+ int driver_order;
+ struct frame *f = XFRAME (frame);
+ struct font_driver_list *list;
USE_SAFE_ALLOCA;
len = ASIZE (vec);
if (len <= 1)
return best_only ? AREF (vec, 0) : vec;
- for (i = FONT_FOUNDRY_INDEX; i <= FONT_DPI_INDEX; i++)
+ for (i = FONT_WEIGHT_INDEX; i <= FONT_DPI_INDEX; i++)
prefer_prop[i] = AREF (prefer, i);
-
- if (! NILP (spec))
- {
- /* A font driver may return a font that has a property value
- different from the value specified in SPEC if the driver
- thinks they are the same. That happens, for instance, such a
- generic family name as "serif" is specified. So, to ignore
- such a difference, for all properties specified in SPEC, set
- the corresponding properties in PREFER_PROP to nil. */
- for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
- 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));
- if (! NILP (prefer_prop[FONT_FAMILY_INDEX]))
- {
- alternate_families
- = Fassoc_string (prefer_prop[FONT_FAMILY_INDEX],
- Vface_alternative_font_family_alist, Qt);
- if (CONSP (alternate_families))
- alternate_families = XCDR (alternate_families);
- }
/* Scoring and sorting. */
SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
best_score = 0xFFFFFFFF;
- best_entity = Qnil;
+ /* We are sure that the length of VEC > 1. */
+ driver_type = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
+ for (driver_order = 0, list = f->font_driver_list; list;
+ driver_order++, list = list->next)
+ if (EQ (driver_type, list->driver->type))
+ break;
+ best_entity = data[0].entity = AREF (vec, 0);
+ best_score = data[0].score
+ = font_score (data[0].entity, prefer_prop) | driver_order;
for (i = 0; i < len; i++)
{
+ if (!EQ (driver_type, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
+ for (driver_order = 0, list = f->font_driver_list; list;
+ driver_order++, list = list->next)
+ if (EQ (driver_type, list->driver->type))
+ break;
data[i].entity = AREF (vec, i);
- data[i].score = font_score (data[i].entity, prefer_prop,
- alternate_families);
+ data[i].score = font_score (data[i].entity, prefer_prop) | driver_order;
if (best_only && best_score > data[i].score)
{
best_score = data[i].score;
break;
}
}
- if (NILP (best_entity))
+ if (! best_only)
{
qsort (data, len, sizeof *data, font_compare);
for (i = 0; i < len; i++)
vec = best_entity;
SAFE_FREE ();
+ font_add_log ("sort-by", prefer, vec);
return vec;
}
{
int i, shift_bits;
- for (i = 0, shift_bits = 21; i < 4; i++, shift_bits -= 7)
+ for (i = 0, shift_bits = 23; i < 4; i++, shift_bits -= 7)
{
int xlfd_idx = order[i];
}
}
+static int
+font_check_otf_features (script, langsys, features, table)
+ Lisp_Object script, langsys, features, table;
+{
+ Lisp_Object val;
+ int negative;
+
+ table = assq_no_quit (script, table);
+ if (NILP (table))
+ return 0;
+ table = XCDR (table);
+ if (! NILP (langsys))
+ {
+ table = assq_no_quit (langsys, table);
+ if (NILP (table))
+ return 0;
+ }
+ else
+ {
+ val = assq_no_quit (Qnil, table);
+ if (NILP (val))
+ table = XCAR (table);
+ else
+ table = val;
+ }
+ table = XCDR (table);
+ for (negative = 0; CONSP (features); features = XCDR (features))
+ {
+ if (NILP (XCAR (features)))
+ negative = 1;
+ if (NILP (Fmemq (XCAR (features), table)) != negative)
+ return 0;
+ }
+ return 1;
+}
-/* Check if ENTITY matches with the font specification SPEC. */
+/* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
-int
-font_match_p (spec, entity)
- Lisp_Object spec, entity;
+static int
+font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
{
- Lisp_Object prefer_prop[FONT_SPEC_MAX];
- Lisp_Object alternate_families = Qnil;
- int prefer_style[3];
- int i;
+ Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
- for (i = FONT_FOUNDRY_INDEX; i <= FONT_SIZE_INDEX; i++)
- prefer_prop[i] = AREF (spec, i);
- if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
- prefer_prop[FONT_SIZE_INDEX]
- = make_number (font_pixel_size (XFRAME (selected_frame), spec));
- if (! NILP (prefer_prop[FONT_FAMILY_INDEX]))
+ script = XCAR (spec);
+ spec = XCDR (spec);
+ if (! NILP (spec))
{
- alternate_families
- = Fassoc_string (prefer_prop[FONT_FAMILY_INDEX],
- Vface_alternative_font_family_alist, Qt);
- if (CONSP (alternate_families))
- alternate_families = XCDR (alternate_families);
+ langsys = XCAR (spec);
+ spec = XCDR (spec);
+ if (! NILP (spec))
+ {
+ gsub = XCAR (spec);
+ spec = XCDR (spec);
+ if (! NILP (spec))
+ gpos = XCAR (spec);
+ }
}
- return (font_score (entity, prefer_prop, alternate_families) == 0);
+ if (! NILP (gsub) && ! font_check_otf_features (script, langsys, gsub,
+ XCAR (otf_capability)))
+ return 0;
+ if (! NILP (gpos) && ! font_check_otf_features (script, langsys, gpos,
+ XCDR (otf_capability)))
+ return 0;
+ return 1;
}
-/* CHeck a lispy font object corresponding to FONT. */
+
+/* Check if FONT (font-entity or font-object) matches with the font
+ specification SPEC. */
int
-font_check_object (font)
- struct font *font;
+font_match_p (spec, font)
+ Lisp_Object spec, font;
{
- Lisp_Object tail, elt;
+ Lisp_Object prop[FONT_SPEC_MAX], *props;
+ Lisp_Object extra, font_extra;
+ int i;
- for (tail = font->props[FONT_OBJLIST_INDEX]; CONSP (tail);
- tail = XCDR (tail))
+ for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
+ if (! NILP (AREF (spec, i))
+ && ! NILP (AREF (font, i))
+ && ! EQ (AREF (spec, i), AREF (font, i)))
+ return 0;
+ props = XFONT_SPEC (spec)->props;
+ if (FLOATP (props[FONT_SIZE_INDEX]))
{
- elt = XCAR (tail);
- if (font == XFONT_OBJECT (elt))
- return 1;
+ for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
+ prop[i] = AREF (spec, i);
+ prop[FONT_SIZE_INDEX]
+ = make_number (font_pixel_size (XFRAME (selected_frame), spec));
+ props = prop;
}
- return 0;
-}
+ if (font_score (font, props) > 0)
+ return 0;
+ extra = AREF (spec, FONT_EXTRA_INDEX);
+ font_extra = AREF (font, FONT_EXTRA_INDEX);
+ for (; CONSP (extra); extra = XCDR (extra))
+ {
+ Lisp_Object key = XCAR (XCAR (extra));
+ Lisp_Object val = XCDR (XCAR (extra)), val2;
+
+ if (EQ (key, QClang))
+ {
+ val2 = assq_no_quit (key, font_extra);
+ if (NILP (val2))
+ return 0;
+ val2 = XCDR (val2);
+ if (CONSP (val))
+ {
+ if (! CONSP (val2))
+ return 0;
+ while (CONSP (val))
+ if (NILP (Fmemq (val, val2)))
+ return 0;
+ }
+ else
+ if (CONSP (val2)
+ ? NILP (Fmemq (val, XCDR (val2)))
+ : ! EQ (val, val2))
+ return 0;
+ }
+ else if (EQ (key, QCscript))
+ {
+ val2 = assq_no_quit (val, Vscript_representative_chars);
+ if (! NILP (val2))
+ for (val2 = XCDR (val2); CONSP (val2); val2 = XCDR (val2))
+ if (font_encode_char (font, XINT (XCAR (val2)))
+ == FONT_INVALID_CODE)
+ return 0;
+ }
+ else if (EQ (key, QCotf))
+ {
+ struct font *fontp;
+
+ if (! FONT_OBJECT_P (font))
+ return 0;
+ fontp = XFONT_OBJECT (font);
+ if (! fontp->driver->otf_capability)
+ return 0;
+ val2 = fontp->driver->otf_capability (fontp);
+ if (NILP (val2) || ! font_check_otf (val, val2))
+ return 0;
+ }
+ }
+
+ return 1;
+}
\f
+
/* Font cache
Each font backend has the callback function get_cache, and it
val = XCDR (cache);
while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
cache = val, val = XCDR (val);
- xassert (! NILP (val));
+ font_assert (! NILP (val));
tmp = XCDR (XCAR (val));
XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1));
if (XINT (XCAR (tmp)) == 0)
Lisp_Object val = driver->get_cache (f);
Lisp_Object type = driver->type;
- xassert (CONSP (val));
+ font_assert (CONSP (val));
for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
- xassert (CONSP (val));
+ font_assert (CONSP (val));
/* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
val = XCDR (XCAR (val));
return val;
Lisp_Object val = XCAR (objlist);
struct font *font = XFONT_OBJECT (val);
- xassert (font && driver == font->driver);
- driver->close (f, font);
- num_fonts--;
+ if (! NILP (AREF (val, FONT_TYPE_INDEX)))
+ {
+ font_assert (font && driver == font->driver);
+ driver->close (f, font);
+ num_fonts--;
+ }
}
if (driver->free_entity)
driver->free_entity (entity);
Lisp_Object list, spec;
int size;
{
- Lisp_Object entity, prev, tail;
+ Lisp_Object entity, val;
enum font_property_index prop;
- for (tail = list, prev = Qnil; CONSP (tail); )
+ for (val = Qnil; CONSP (list); list = XCDR (list))
{
- entity = XCAR (tail);
+ entity = XCAR (list);
for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
if (INTEGERP (AREF (spec, prop))
&& ((XINT (AREF (spec, prop)) >> 8)
!= (XINT (AREF (entity, prop)) >> 8)))
prop = FONT_SPEC_MAX;
- if (prop++ <= FONT_SIZE_INDEX
+ if (prop < FONT_SPEC_MAX
&& size
&& XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
{
prop = FONT_SPEC_MAX;
}
if (prop < FONT_SPEC_MAX
- && INTEGERP (AREF (spec, FONT_SPACING_INDEX))
- && ! EQ (AREF (spec, FONT_SPACING_INDEX),
- AREF (entity, FONT_SPACING_INDEX)))
+ && INTEGERP (AREF (spec, FONT_DPI_INDEX))
+ && INTEGERP (AREF (entity, FONT_DPI_INDEX))
+ && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
+ prop = FONT_SPEC_MAX;
+ if (prop < FONT_SPEC_MAX
+ && INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX))
+ && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
+ && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
+ AREF (entity, FONT_AVGWIDTH_INDEX)))
prop = FONT_SPEC_MAX;
if (prop < FONT_SPEC_MAX)
- prev = tail, tail = XCDR (tail);
- else if (NILP (prev))
- list = tail = XCDR (tail);
- else
- tail = XCDR (tail), XSETCDR (prev, tail);
+ val = Fcons (entity, val);
}
- return list;
+ return val;
}
{
FRAME_PTR f = XFRAME (frame);
struct font_driver_list *driver_list = f->font_driver_list;
- Lisp_Object ftype, family, alternate_familes;
+ Lisp_Object ftype, val;
Lisp_Object *vec;
int size;
int need_filtering = 0;
- int n_family = 1;
int i;
- xassert (FONT_SPEC_P (spec));
-
- family = AREF (spec, FONT_FAMILY_INDEX);
- if (NILP (family))
- alternate_familes = Qnil;
- else
- {
- alternate_familes = Fassoc_string (family,
- Vface_alternative_font_family_alist,
- Qt);
- if (! NILP (alternate_familes))
- alternate_familes = XCDR (alternate_familes);
- n_family += XINT (Flength (alternate_familes));
- }
+ font_assert (FONT_SPEC_P (spec));
if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
size = XINT (AREF (spec, FONT_SIZE_INDEX));
size = 0;
ftype = AREF (spec, FONT_TYPE_INDEX);
- for (i = 1; i <= FONT_REGISTRY_INDEX; i++)
+ for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
ASET (scratch_font_spec, i, AREF (spec, i));
- for (; i < FONT_EXTRA_INDEX; i++)
+ for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
{
ASET (scratch_font_spec, i, Qnil);
if (! NILP (AREF (spec, i)))
need_filtering = 1;
+ if (i == FONT_DPI_INDEX)
+ /* Skip FONT_SPACING_INDEX */
+ i++;
}
+ ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
- vec = alloca (sizeof (Lisp_Object) * num_font_drivers * n_family);
+ vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
if (! vec)
return null_vector;
&& (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
{
Lisp_Object cache = font_get_cache (f, driver_list->driver);
- Lisp_Object tail = alternate_familes;
- while (1)
+ ASET (scratch_font_spec, FONT_TYPE_INDEX, driver_list->driver->type);
+ val = assoc_no_quit (scratch_font_spec, XCDR (cache));
+ if (CONSP (val))
+ val = XCDR (val);
+ else
{
- Lisp_Object val = assoc_no_quit (scratch_font_spec, XCDR (cache));
+ Lisp_Object copy;
- if (CONSP (val))
- val = XCDR (val);
- else
- {
- Lisp_Object copy;
-
- val = driver_list->driver->list (frame, scratch_font_spec);
- if (! NILP (val) && need_filtering)
- val = font_delete_unmatched (val, spec, size);
- copy = Fcopy_font_spec (scratch_font_spec);
- XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
- }
- if (! NILP (val))
- {
- vec[i++] = val;
- break;
- }
- if (NILP (tail))
- break;
- ASET (scratch_font_spec, FONT_FAMILY_INDEX,
- Fintern (XCAR (tail), Qnil));
- tail = XCDR (tail);
+ val = driver_list->driver->list (frame, scratch_font_spec);
+ copy = Fcopy_font_spec (scratch_font_spec);
+ ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
+ XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
}
+ if (! NILP (val) && need_filtering)
+ val = font_delete_unmatched (val, spec, size);
+ if (! NILP (val))
+ vec[i++] = val;
}
- return (i > 0 ? Fvconcat (i, vec) : null_vector);
+ val = (i > 0 ? Fvconcat (i, vec) : null_vector);
+ font_add_log ("list", spec, val);
+ return (val);
}
}
ASET (spec, FONT_TYPE_INDEX, ftype);
ASET (spec, FONT_SIZE_INDEX, size);
+ font_add_log ("match", spec, entity);
return entity;
}
struct font_driver_list *driver_list;
Lisp_Object objlist, size, val, font_object;
struct font *font;
- int min_width;
+ int min_width, height;
- xassert (FONT_ENTITY_P (entity));
+ font_assert (FONT_ENTITY_P (entity));
size = AREF (entity, FONT_SIZE_INDEX);
if (XINT (size) != 0)
pixel_size = XINT (size);
for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
objlist = XCDR (objlist))
- if (XFONT_OBJECT (XCAR (objlist))->pixel_size == pixel_size)
+ if (! NILP (AREF (XCAR (objlist), FONT_TYPE_INDEX))
+ && XFONT_OBJECT (XCAR (objlist))->pixel_size == pixel_size)
return XCAR (objlist);
val = AREF (entity, FONT_TYPE_INDEX);
return Qnil;
font_object = driver_list->driver->open (f, entity, pixel_size);
+ font_add_log ("open", entity, font_object);
if (NILP (font_object))
return Qnil;
ASET (entity, FONT_OBJLIST_INDEX,
Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
- ASET (font_object, FONT_OBJLIST_INDEX, AREF (entity, FONT_OBJLIST_INDEX));
+ ASET (font_object, FONT_OBJLIST_INDEX, Qnil);
num_fonts++;
font = XFONT_OBJECT (font_object);
: font->average_width ? font->average_width
: font->space_width ? font->space_width
: 1);
+ height = (font->height ? font->height : 1);
+#ifdef HAVE_WINDOW_SYSTEM
FRAME_X_DISPLAY_INFO (f)->n_fonts++;
if (FRAME_X_DISPLAY_INFO (f)->n_fonts == 1)
{
FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
- FRAME_SMALLEST_FONT_HEIGHT (f) = font->height;
+ FRAME_SMALLEST_FONT_HEIGHT (f) = height;
fonts_changed_p = 1;
}
else
{
if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, fonts_changed_p = 1;
- if (FRAME_SMALLEST_FONT_HEIGHT (f) > font->height)
- FRAME_SMALLEST_FONT_HEIGHT (f) = font->height, fonts_changed_p = 1;
+ if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
+ FRAME_SMALLEST_FONT_HEIGHT (f) = height, fonts_changed_p = 1;
}
+#endif
return font_object;
}
Lisp_Object font_object;
{
struct font *font = XFONT_OBJECT (font_object);
- Lisp_Object objlist;
- Lisp_Object tail, prev = Qnil;
- objlist = AREF (font_object, FONT_OBJLIST_INDEX);
- for (prev = Qnil, tail = objlist; CONSP (tail);
- prev = tail, tail = XCDR (tail))
- if (EQ (font_object, XCAR (tail)))
- {
- xassert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
- font->driver->close (f, font);
- FRAME_X_DISPLAY_INFO (f)->n_fonts--;
- if (NILP (prev))
- ASET (font_object, FONT_OBJLIST_INDEX, XCDR (objlist));
- else
- XSETCDR (prev, XCDR (objlist));
- num_fonts--;
- return;
- }
- abort ();
+ if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
+ /* Already closed. */
+ return;
+ font_add_log ("close", font_object, Qnil);
+ font->driver->close (f, font);
+#ifdef HAVE_WINDOW_SYSTEM
+ font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
+ FRAME_X_DISPLAY_INFO (f)->n_fonts--;
+#endif
+ num_fonts--;
}
return driver_list->driver->has_char (font, c);
}
- xassert (FONT_OBJECT_P (font));
+ font_assert (FONT_OBJECT_P (font));
fontp = XFONT_OBJECT (font);
if (fontp->driver->has_char)
{
{
struct font *font;
- xassert (FONT_OBJECT_P (font_object));
+ font_assert (FONT_OBJECT_P (font_object));
font = XFONT_OBJECT (font_object);
return font->driver->encode_char (font, c);
}
font_get_name (font_object)
Lisp_Object font_object;
{
- Lisp_Object name;
-
- xassert (FONT_OBJECT_P (font_object));
+ font_assert (FONT_OBJECT_P (font_object));
return AREF (font_object, FONT_NAME_INDEX);
}
enum font_property_index prop;
{
Lisp_Object font = attrs[LFACE_FONT_INDEX];
- Lisp_Object extra, prev;
if (! FONTP (font))
return;
if (NILP (AREF (font, prop))
- && prop != FONT_FAMILY_INDEX && prop != FONT_FAMILY_INDEX)
+ && prop != FONT_FAMILY_INDEX && prop != FONT_FOUNDRY_INDEX
+ && prop != FONT_SIZE_INDEX)
return;
font = Fcopy_font_spec (font);
ASET (font, prop, Qnil);
- if (prop == FONT_FAMILY_INDEX)
+ if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
{
- ASET (font, FONT_FOUNDRY_INDEX, Qnil);
+ if (prop == FONT_FAMILY_INDEX)
+ ASET (font, FONT_FOUNDRY_INDEX, Qnil);
ASET (font, FONT_ADSTYLE_INDEX, Qnil);
+ ASET (font, FONT_REGISTRY_INDEX, Qnil);
ASET (font, FONT_SIZE_INDEX, Qnil);
ASET (font, FONT_DPI_INDEX, Qnil);
ASET (font, FONT_SPACING_INDEX, Qnil);
FRAME_PTR f;
Lisp_Object *attrs;
{
- Lisp_Object spec, val;
- int n;
+ Lisp_Object spec;
spec = attrs[LFACE_FONT_INDEX];
if (! FONT_SPEC_P (spec))
return;
- if (! NILP (AREF (spec, FONT_FOUNDRY_INDEX))
- || ! NILP (AREF (spec, FONT_FAMILY_INDEX)))
- {
- Lisp_Object family;
-
- if (NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
- family = AREF (spec, FONT_FAMILY_INDEX);
- else if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
- family = concat2 (SYMBOL_NAME (AREF (spec, FONT_FOUNDRY_INDEX)),
- build_string ("-*"));
- else
- family = concat3 (SYMBOL_NAME (AREF (spec, FONT_FOUNDRY_INDEX)),
- build_string ("-"),
- SYMBOL_NAME (AREF (spec, FONT_FAMILY_INDEX)));
- attrs[LFACE_FAMILY_INDEX] = family;
- }
+ if (! NILP (AREF (spec, FONT_FOUNDRY_INDEX)))
+ attrs[LFACE_FOUNDRY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FOUNDRY_INDEX));
+ if (! NILP (AREF (spec, FONT_FAMILY_INDEX)))
+ attrs[LFACE_FAMILY_INDEX] = SYMBOL_NAME (AREF (spec, FONT_FAMILY_INDEX));
if (! NILP (AREF (spec, FONT_WEIGHT_INDEX)))
attrs[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (spec);
if (! NILP (AREF (spec, FONT_SLANT_INDEX)))
Lisp_Object spec;
int c;
{
+ Lisp_Object work;
Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
- Lisp_Object size;
- int i, result;
+ Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
+ int pixel_size;
+ int i, j, k, l, result;
+
+ registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
+ if (NILP (registry[0]))
+ {
+ registry[0] = DEFAULT_ENCODING;
+ registry[1] = Qascii_0;
+ registry[2] = null_vector;
+ }
+ else
+ registry[1] = null_vector;
- if (c >= 0)
+ if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
{
- Lisp_Object registry = AREF (spec, FONT_REGISTRY_INDEX);
struct charset *encoding, *repertory;
- if (font_registry_charsets (registry, &encoding, &repertory) < 0)
+ if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
+ &encoding, &repertory) < 0)
return Qnil;
if (repertory)
{
return Qnil;
}
+ work = Fcopy_font_spec (spec);
XSETFRAME (frame, f);
size = AREF (spec, FONT_SIZE_INDEX);
- ASET (spec, FONT_SIZE_INDEX, Qnil);
- entities = font_list_entities (frame, spec);
- ASET (spec, FONT_SIZE_INDEX, size);
- if (ASIZE (entities) == 0)
- return Qnil;
+ pixel_size = font_pixel_size (f, spec);
+ if (pixel_size == 0)
+ {
+ double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
+
+ pixel_size = POINT_TO_PIXEL (pt / 10, f->resy);
+ }
+ ASET (work, FONT_SIZE_INDEX, Qnil);
+ foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
+ if (! NILP (foundry[0]))
+ foundry[1] = null_vector;
+ else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
+ {
+ foundry[0] = font_intern_prop (SDATA (attrs[LFACE_FOUNDRY_INDEX]),
+ SBYTES (attrs[LFACE_FOUNDRY_INDEX]), 1);
+ foundry[1] = Qnil;
+ foundry[2] = null_vector;
+ }
+ else
+ foundry[0] = Qnil, foundry[1] = null_vector;
+
+ adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
+ if (! NILP (adstyle[0]))
+ adstyle[1] = null_vector;
+ else if (FONTP (attrs[LFACE_FONT_INDEX]))
+ {
+ Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
+
+ if (! NILP (AREF (face_font, FONT_ADSTYLE_INDEX)))
+ {
+ adstyle[0] = AREF (face_font, FONT_ADSTYLE_INDEX);
+ adstyle[1] = Qnil;
+ adstyle[2] = null_vector;
+ }
+ else
+ adstyle[0] = Qnil, adstyle[1] = null_vector;
+ }
+ else
+ adstyle[0] = Qnil, adstyle[1] = null_vector;
+
+
+ val = AREF (work, FONT_FAMILY_INDEX);
+ if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
+ val = font_intern_prop (SDATA (attrs[LFACE_FAMILY_INDEX]),
+ SBYTES (attrs[LFACE_FAMILY_INDEX]), 1);
+ if (NILP (val))
+ {
+ family = alloca ((sizeof family[0]) * 2);
+ family[0] = Qnil;
+ family[1] = null_vector; /* terminator. */
+ }
+ else
+ {
+ Lisp_Object alters
+ = Fassoc_string (val, Vface_alternative_font_family_alist, Qt);
+
+ if (! NILP (alters))
+ {
+ family = alloca ((sizeof family[0]) * (XINT (Flength (alters)) + 2));
+ for (i = 0; CONSP (alters); i++, alters = XCDR (alters))
+ family[i] = XCAR (alters);
+ if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
+ family[i++] = Qnil;
+ family[i] = null_vector;
+ }
+ else
+ {
+ family = alloca ((sizeof family[0]) * 3);
+ i = 0;
+ family[i++] = val;
+ if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
+ family[i++] = Qnil;
+ family[i] = null_vector;
+ }
+ }
+
+ for (i = 0; SYMBOLP (family[i]); i++)
+ {
+ ASET (work, FONT_FAMILY_INDEX, family[i]);
+ for (j = 0; SYMBOLP (foundry[j]); j++)
+ {
+ ASET (work, FONT_FOUNDRY_INDEX, foundry[j]);
+ for (k = 0; SYMBOLP (registry[k]); k++)
+ {
+ ASET (work, FONT_REGISTRY_INDEX, registry[k]);
+ for (l = 0; SYMBOLP (adstyle[l]); l++)
+ {
+ ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
+ entities = font_list_entities (frame, work);
+ if (ASIZE (entities) > 0)
+ goto found;
+ }
+ }
+ }
+ }
+ return Qnil;
+ found:
if (ASIZE (entities) == 1)
{
if (c < 0)
{
/* Sort fonts by properties specified in LFACE. */
Lisp_Object prefer = scratch_font_prefer;
- double pt;
+
for (i = 0; i < FONT_EXTRA_INDEX; i++)
- ASET (prefer, i, AREF (spec, i));
+ ASET (prefer, i, AREF (work, i));
if (FONTP (attrs[LFACE_FONT_INDEX]))
{
Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
if (NILP (AREF (prefer, i)))
ASET (prefer, i, AREF (face_font, i));
}
- if (NILP (AREF (prefer, FONT_FAMILY_INDEX)))
- font_parse_family_registry (attrs[LFACE_FAMILY_INDEX], Qnil, prefer);
if (NILP (AREF (prefer, FONT_WEIGHT_INDEX)))
FONT_SET_STYLE (prefer, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
if (NILP (AREF (prefer, FONT_SLANT_INDEX)))
FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
if (NILP (AREF (prefer, FONT_WIDTH_INDEX)))
FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
- if (INTEGERP (size))
- ASET (prefer, FONT_SIZE_INDEX, size);
- else if (FLOATP (size))
- ASET (prefer, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
- else
- {
- double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
- int pixel_size = POINT_TO_PIXEL (pt / 10, f->resy);
- ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
- }
- ASET (spec, FONT_SIZE_INDEX, Qnil);
- entities = font_sort_entites (entities, prefer, frame, spec, c < 0);
- ASET (spec, FONT_SIZE_INDEX, size);
+ ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size));
+ entities = font_sort_entites (entities, prefer, frame, c < 0);
}
if (c < 0)
return entities;
{
int size;
- if (FONT_SPEC_P (spec) && INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
- size = XINT (AREF (spec, FONT_SIZE_INDEX));
+ if (INTEGERP (AREF (entity, FONT_SIZE_INDEX))
+ && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
+ size = XINT (AREF (entity, FONT_SIZE_INDEX));
+ else if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX)))
+ size = font_pixel_size (f, spec);
else
{
double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
pt /= 10;
size = POINT_TO_PIXEL (pt, f->resy);
+#ifdef HAVE_NS
+ if (size == 0)
+ {
+ Lisp_Object ffsize = get_frame_param(f, Qfontsize);
+ size = NUMBERP (ffsize) ? POINT_TO_PIXEL (XINT (ffsize), f->resy) : 0;
+ }
+#endif
}
return font_open_entity (f, entity, size);
}
char *name;
{
Lisp_Object args[2];
- Lisp_Object spec, prefer, size, entity, entity_list;
- Lisp_Object frame;
- int i;
- int pixel_size;
-
- XSETFRAME (frame, f);
+ Lisp_Object spec, attrs[LFACE_VECTOR_SIZE];
args[0] = QCname;
args[1] = make_unibyte_string (name, strlen (name));
spec = Ffont_spec (2, args);
- prefer = scratch_font_prefer;
- for (i = 0; i < FONT_SPEC_MAX; i++)
- {
- ASET (prefer, i, AREF (spec, i));
- if (NILP (AREF (prefer, i))
- && i >= FONT_WEIGHT_INDEX && i <= FONT_WIDTH_INDEX)
- FONT_SET_STYLE (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);
- }
- if (pixel_size == 0)
- ASET (spec, FONT_SIZE_INDEX, Qnil);
- }
- 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);
+ /* We set up the default font-related attributes of a face to prefer
+ a moderate font. */
+ attrs[LFACE_FAMILY_INDEX] = attrs[LFACE_FOUNDRY_INDEX] = Qnil;
+ attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX]
+ = attrs[LFACE_SLANT_INDEX] = Qnormal;
+#ifndef HAVE_NS
+ attrs[LFACE_HEIGHT_INDEX] = make_number (120);
+#else
+ attrs[LFACE_HEIGHT_INDEX] = make_number (0);
+#endif
+ attrs[LFACE_FONT_INDEX] = Qnil;
- entity_list = Flist_fonts (spec, frame, make_number (1), prefer);
- if (NILP (entity_list))
- entity = font_matching_entity (f, NULL, spec);
- else
- entity = XCAR (entity_list);
- return (NILP (entity)
- ? Qnil
- : font_open_entity (f, entity, pixel_size));
+ return font_load_for_lface (f, attrs, spec);
}
f->font_driver_list = list;
else
font_driver_list = list;
- num_font_drivers++;
-}
-
-
-/* Free font-driver list on frame F. It doesn't free font-drivers
- themselves. */
-
-void
-free_font_driver_list (f)
- FRAME_PTR f;
-{
- while (f->font_driver_list)
- {
- struct font_driver_list *next = f->font_driver_list->next;
-
- free (f->font_driver_list);
- f->font_driver_list = next;
- }
+ if (! f)
+ num_font_drivers++;
}
Lisp_Object new_drivers;
{
Lisp_Object active_drivers = Qnil;
+ struct font_driver *driver;
struct font_driver_list *list;
+ /* At first, turn off non-requested drivers, and turn on requested
+ drivers. */
for (list = f->font_driver_list; list; list = list->next)
- if (list->on)
- {
- if (! EQ (new_drivers, Qt)
- && NILP (Fmemq (list->driver->type, new_drivers)))
- {
- if (list->driver->end_for_frame)
- list->driver->end_for_frame (f);
- font_finish_cache (f, list->driver);
- list->on = 0;
- }
- }
- else
- {
- if (EQ (new_drivers, Qt)
- || ! NILP (Fmemq (list->driver->type, new_drivers)))
- {
- if (! list->driver->start_for_frame
- || list->driver->start_for_frame (f) == 0)
- {
- font_prepare_cache (f, list->driver);
- list->on = 1;
- active_drivers = nconc2 (active_drivers,
- Fcons (list->driver->type, Qnil));
- }
- }
- }
+ {
+ driver = list->driver;
+ if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers)))
+ != list->on)
+ {
+ if (list->on)
+ {
+ if (driver->end_for_frame)
+ driver->end_for_frame (f);
+ font_finish_cache (f, driver);
+ list->on = 0;
+ }
+ else
+ {
+ if (! driver->start_for_frame
+ || driver->start_for_frame (f) == 0)
+ {
+ font_prepare_cache (f, driver);
+ list->on = 1;
+ }
+ }
+ }
+ }
+
+ if (NILP (new_drivers))
+ return Qnil;
+
+ if (! EQ (new_drivers, Qt))
+ {
+ /* Re-order the driver list according to new_drivers. */
+ struct font_driver_list **list_table, **next;
+ Lisp_Object tail;
+ int i;
+
+ list_table = alloca (sizeof list_table[0] * (num_font_drivers + 1));
+ for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
+ {
+ for (list = f->font_driver_list; list; list = list->next)
+ if (list->on && EQ (list->driver->type, XCAR (tail)))
+ break;
+ if (list)
+ list_table[i++] = list;
+ }
+ for (list = f->font_driver_list; list; list = list->next)
+ if (! list->on)
+ list_table[i] = list;
+ list_table[i] = NULL;
+
+ next = &f->font_driver_list;
+ for (i = 0; list_table[i]; i++)
+ {
+ *next = list_table[i];
+ next = &(*next)->next;
+ }
+ *next = NULL;
+ }
+ for (list = f->font_driver_list; list; list = list->next)
+ if (list->on)
+ active_drivers = nconc2 (active_drivers,
+ Fcons (list->driver->type, Qnil));
return active_drivers;
}
if (! face->font)
return Qnil;
- xassert (font_check_object ((struct font *) face->font));
XSETFONT (font_object, face->font);
return font_object;
}
displayed by the same font. FACE is the face selected for the
character as POS on frame F. STRING, if not nil, is the string to
check instead of the current buffer.
-
+
The return value is the position of the character that is displayed
by the differnt font than that of the character as POS. */
doc: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
Return nil otherwise.
Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
-which kind of font it is. It must be one of `font-spec', `font-entity'
+which kind of font it is. It must be one of `font-spec', `font-entity',
`font-object'. */)
(object, extra_type)
Lisp_Object object, extra_type;
VALUE must be a non-negative integer or a floating point number
specifying the font size. It specifies the font size in pixels
(if VALUE is an integer), or in points (if VALUE is a float).
+
+`:name'
+
+VALUE must be a string of XLFD-style or fontconfig-style font name.
usage: (font-spec ARGS ...) */)
(nargs, args)
int nargs;
font_parse_name ((char *) SDATA (val), spec);
font_put_extra (spec, key, val);
}
- else if (EQ (key, QCfamily))
- {
- CHECK_STRING (val);
- font_parse_family_registry (val, Qnil, spec);
- }
else
{
int idx = get_font_prop_index (key);
(font)
Lisp_Object font;
{
- Lisp_Object new_spec, tail, extra;
+ Lisp_Object new_spec, tail, prev, extra;
int i;
CHECK_FONT (font);
new_spec = font_make_spec ();
for (i = 1; i < FONT_EXTRA_INDEX; i++)
ASET (new_spec, i, AREF (font, i));
- extra = Qnil;
- for (tail = AREF (font, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
- {
- if (! EQ (XCAR (XCAR (tail)), QCfont_entity))
- extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
- }
+ extra = Fcopy_sequence (AREF (font, FONT_EXTRA_INDEX));
+ /* We must remove :font-entity property. */
+ for (prev = Qnil, tail = extra; CONSP (tail); prev = tail, tail = XCDR (tail))
+ if (EQ (XCAR (XCAR (tail)), QCfont_entity))
+ {
+ if (NILP (prev))
+ extra = XCDR (extra);
+ else
+ XSETCDR (prev, XCDR (tail));
+ break;
+ }
ASET (new_spec, FONT_EXTRA_INDEX, extra);
return new_spec;
}
CHECK_SYMBOL (key);
idx = get_font_prop_index (key);
+ if (idx >= FONT_WEIGHT_INDEX && idx <= FONT_WIDTH_INDEX)
+ return font_style_symbolic (font, idx, 0);
if (idx >= 0 && idx < FONT_EXTRA_INDEX)
return AREF (font, idx);
return Fcdr (Fassq (key, AREF (font, FONT_EXTRA_INDEX)));
}
+#ifdef HAVE_WINDOW_SYSTEM
+
+DEFUN ("font-face-attributes", Ffont_face_attributes, Sfont_face_attributes, 1, 2, 0,
+ doc: /* Return a plist of face attributes generated by FONT.
+FONT is a font name, a font-spec, a font-entity, or a font-object.
+The return value is a list of the form
+
+\(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
+
+where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
+compatible with `set-face-attribute'. Some of these key-attribute pairs
+may be omitted from the list if they are not specified by FONT.
+
+The optional argument FRAME specifies the frame that the face attributes
+are to be displayed on. If omitted, the selected frame is used. */)
+ (font, frame)
+ Lisp_Object font, frame;
+{
+ struct frame *f;
+ Lisp_Object plist[10];
+ Lisp_Object val;
+ int n = 0;
+
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
+ f = XFRAME (frame);
+
+ if (STRINGP (font))
+ {
+ int fontset = fs_query_fontset (font, 0);
+ Lisp_Object name = font;
+ if (fontset >= 0)
+ font = fontset_ascii (fontset);
+ font = font_spec_from_name (name);
+ if (! FONTP (font))
+ signal_error ("Invalid font name", name);
+ }
+ else if (! FONTP (font))
+ signal_error ("Invalid font object", font);
+
+ val = AREF (font, FONT_FAMILY_INDEX);
+ if (! NILP (val))
+ {
+ plist[n++] = QCfamily;
+ plist[n++] = SYMBOL_NAME (val);
+ }
+
+ val = AREF (font, FONT_SIZE_INDEX);
+ if (INTEGERP (val))
+ {
+ Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
+ int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : f->resy;
+ plist[n++] = QCheight;
+ plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi));
+ }
+ else if (FLOATP (val))
+ {
+ plist[n++] = QCheight;
+ plist[n++] = make_number (10 * (int) XFLOAT_DATA (val));
+ }
+
+ val = FONT_WEIGHT_FOR_FACE (font);
+ if (! NILP (val))
+ {
+ plist[n++] = QCweight;
+ plist[n++] = val;
+ }
+
+ val = FONT_SLANT_FOR_FACE (font);
+ if (! NILP (val))
+ {
+ plist[n++] = QCslant;
+ plist[n++] = val;
+ }
+
+ val = FONT_WIDTH_FOR_FACE (font);
+ if (! NILP (val))
+ {
+ plist[n++] = QCwidth;
+ plist[n++] = val;
+ }
+
+ return Flist (n, plist);
+}
+
+#endif
DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0,
doc: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
Lisp_Object font_spec, prop, val;
{
int idx;
- Lisp_Object extra, slot;
CHECK_FONT_SPEC (font_spec);
idx = get_font_prop_index (prop);
if (idx >= 0 && idx < FONT_EXTRA_INDEX)
- {
- if (idx == FONT_FAMILY_INDEX
- && STRINGP (val))
- font_parse_family_registry (val, Qnil, font_spec);
- else
- ASET (font_spec, idx, font_prop_validate (idx, Qnil, val));
- }
+ ASET (font_spec, idx, font_prop_validate (idx, Qnil, val));
else
font_put_extra (font_spec, prop, font_prop_validate (0, prop, val));
return val;
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
control the order of the returned list. Fonts are sorted by
-how they are close to PREFER. */)
+how close they are to PREFER. */)
(font_spec, frame, num, prefer)
Lisp_Object font_spec, frame, num, prefer;
{
return Fcons (AREF (vec, 0), Qnil);
if (! NILP (prefer))
- vec = font_sort_entites (vec, prefer, frame, font_spec, 0);
+ vec = font_sort_entites (vec, prefer, frame, 0);
list = tail = Fcons (AREF (vec, 0), Qnil);
if (n == 0 || n > len)
DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
doc: /* List available font families on the current frame.
-Optional argument FRAME specifies the target frame. */)
+Optional argument FRAME, if non-nil, specifies the target frame. */)
(frame)
Lisp_Object frame;
{
return val;
}
-DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 1, 0,
+DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
doc: /* Return XLFD name of FONT.
FONT is a font-spec, font-entity, or font-object.
-If the name is too long for XLFD (maximum 255 chars), return nil. */)
- (font)
- Lisp_Object font;
+If the name is too long for XLFD (maximum 255 chars), return nil.
+If the 2nd optional arg FOLD-WILDCARDS is non-nil,
+the consecutive wildcards are folded to one. */)
+ (font, fold_wildcards)
+ Lisp_Object font, fold_wildcards;
{
char name[256];
int pixel_size = 0;
if (STRINGP (font_name)
&& SDATA (font_name)[0] == '-')
- return font_name;
+ {
+ if (NILP (fold_wildcards))
+ return font_name;
+ strcpy (name, (char *) SDATA (font_name));
+ goto done;
+ }
pixel_size = XFONT_OBJECT (font)->pixel_size;
}
if (font_unparse_xlfd (font, pixel_size, name, 256) < 0)
return Qnil;
+ done:
+ if (! NILP (fold_wildcards))
+ {
+ char *p0 = name, *p1;
+
+ while ((p1 = strstr (p0, "-*-*")))
+ {
+ strcpy (p1, p1 + 2);
+ p0 = p1;
+ }
+ }
+
return build_string (name);
}
while (! NILP (val)
&& ! EQ (XCAR (XCAR (val)), driver_list->driver->type))
val = XCDR (val);
- xassert (! NILP (val));
+ font_assert (! NILP (val));
val = XCDR (XCAR (val));
if (XINT (XCAR (val)) == 0)
{
return Qnil;
}
-DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table,
- Sinternal_set_font_style_table, 3, 3, 0,
- doc: /* Setup font style table from WEIGHT, SLANT, and WIDTH tables.
-WEIGHT, SLANT, WIDTH must be `font-weight-table', `font-slant-table',
-`font-width-table' respectivly.
-This function is called after those tables are initialized. */)
- (weight, slant, width)
- Lisp_Object weight, slant, width;
-{
- Lisp_Object tables[3];
- int i;
-
- tables[0] = weight, tables[1] = slant, tables[2] = width;
-
- font_style_table = Fmake_vector (make_number (3), Qnil);
- /* In the following loop, we don't use XCAR and XCDR until assuring
- the argument is a cons cell so that the error in the tables can
- be detected. */
- for (i = 0; i < 3; i++)
- {
- Lisp_Object tail, elt, list, val;
-
- for (tail = tables[i], list = Qnil; CONSP (tail); tail = XCDR (tail))
- {
- int numeric = -1;
-
- elt = Fcar (tail);
- CHECK_SYMBOL (Fcar (elt));
- val = Fcons (XCAR (elt), Qnil);
- elt = XCDR (elt);
- CHECK_NATNUM (Fcar (elt));
- if (numeric >= XINT (XCAR (elt)))
- error ("Numeric values not unique nor sorted in %s",
- (i == 0 ? "font-weight-table"
- : i == 1 ? "font-slant-table"
- : "font-width-table"));
- numeric = XINT (XCAR (elt));
- XSETCDR (val, XCAR (elt));
- list = Fcons (val, list);
- for (elt = XCDR (elt); CONSP (elt); elt = XCDR (elt))
- {
- val = XCAR (elt);
- CHECK_SYMBOL (val);
- list = Fcons (Fcons (XCAR (elt), make_number (numeric)), list);
- }
- }
- list = Fnreverse (list);
- ASET (font_style_table, i, Fvconcat (1, &list));
- }
-
- return Qnil;
-}
-
-/* The following three functions are still expremental. */
+/* The following three functions are still experimental. */
DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
doc: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
[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.
+ WIDTH thru 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] ]
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.
+ WIDTH thru 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)
START and END specify the region to extract characters.
If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
where to extract characters.
-FONT-OBJECT may be nil if GSTRING already already contains one. */)
+FONT-OBJECT may be nil if GSTRING already contains one. */)
(gstring, font_object, start, end, object)
Lisp_Object gstring, font_object, start, end, object;
{
return to;
}
+#if 0
+
DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
doc: /* Apply OpenType features on glyph-string GSTRING-IN.
OTF-FEATURES specifies which features to apply in this format:
OTF-FEATURES 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.
+See the documentation of `font-drive-otf' 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
}
return Fnreverse (alternates);
}
-
+#endif /* 0 */
#ifdef FONT_DEBUG
PIXEL-SIZE is a pixel size by which the font is opened.
-SIZE is a maximum advance width of the font in pixel.
+SIZE is a maximum advance width of the font in pixels.
ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
-pixel.
+pixels.
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.
+remaining elements describe the details of the font capability.
If the font is OpenType font, the form of the list is
\(opentype GSUB GPOS)
#endif /* FONT_DEBUG */
+#ifdef HAVE_WINDOW_SYSTEM
+
+DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
+ doc: /* Return information about a font named NAME on frame FRAME.
+If FRAME is omitted or nil, use the selected frame.
+The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
+ HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
+where
+ OPENED-NAME is the name used for opening the font,
+ FULL-NAME is the full name of the font,
+ SIZE is the maximum bound width of the font,
+ HEIGHT is the height of the font,
+ BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
+ RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
+ how to compose characters.
+If the named font is not yet loaded, return nil. */)
+ (name, frame)
+ Lisp_Object name, frame;
+{
+ FRAME_PTR f;
+ struct font *font;
+ Lisp_Object info;
+ Lisp_Object font_object;
+
+ (*check_window_system_func) ();
+
+ if (! FONTP (name))
+ CHECK_STRING (name);
+ if (NILP (frame))
+ frame = selected_frame;
+ CHECK_LIVE_FRAME (frame);
+ f = XFRAME (frame);
+
+ if (STRINGP (name))
+ {
+ int fontset = fs_query_fontset (name, 0);
+
+ if (fontset >= 0)
+ name = fontset_ascii (fontset);
+ font_object = font_open_by_name (f, (char *) SDATA (name));
+ }
+ else if (FONT_OBJECT_P (name))
+ font_object = name;
+ else if (FONT_ENTITY_P (name))
+ font_object = font_open_entity (f, name, 0);
+ else
+ {
+ struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ Lisp_Object entity = font_matching_entity (f, face->lface, name);
+
+ font_object = ! NILP (entity) ? font_open_entity (f, entity, 0) : Qnil;
+ }
+ if (NILP (font_object))
+ return Qnil;
+ font = XFONT_OBJECT (font_object);
+
+ info = Fmake_vector (make_number (7), Qnil);
+ XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
+ XVECTOR (info)->contents[1] = AREF (font_object, FONT_NAME_INDEX);
+ XVECTOR (info)->contents[2] = make_number (font->pixel_size);
+ XVECTOR (info)->contents[3] = make_number (font->height);
+ XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
+ XVECTOR (info)->contents[5] = make_number (font->relative_compose);
+ XVECTOR (info)->contents[6] = make_number (font->default_ascent);
+
+#if 0
+ /* As font_object is still in FONT_OBJLIST of the entity, we can't
+ close it now. Perhaps, we should manage font-objects
+ by `reference-count'. */
+ font_close_object (f, font_object);
+#endif
+ return info;
+}
+#endif
+
\f
+#define BUILD_STYLE_TABLE(TBL) \
+ build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
+
+static Lisp_Object
+build_style_table (entry, nelement)
+ struct table_entry *entry;
+ int nelement;
+{
+ int i, j;
+ Lisp_Object table, elt;
+
+ table = Fmake_vector (make_number (nelement), Qnil);
+ for (i = 0; i < nelement; i++)
+ {
+ for (j = 0; entry[i].names[j]; j++);
+ elt = Fmake_vector (make_number (j + 1), Qnil);
+ ASET (elt, 0, make_number (entry[i].numeric));
+ for (j = 0; entry[i].names[j]; j++)
+ ASET (elt, j + 1, intern (entry[i].names[j]));
+ ASET (table, i, elt);
+ }
+ return table;
+}
+
+static Lisp_Object Vfont_log;
+static int font_log_env_checked;
+
+void
+font_add_log (action, arg, result)
+ char *action;
+ Lisp_Object arg, result;
+{
+ Lisp_Object tail, val;
+ int i;
+
+ if (! font_log_env_checked)
+ {
+ Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
+ font_log_env_checked = 1;
+ }
+ if (EQ (Vfont_log, Qt))
+ return;
+ if (FONTP (arg))
+ arg = Ffont_xlfd_name (arg, Qt);
+ if (FONTP (result))
+ {
+ val = Ffont_xlfd_name (result, Qt);
+ if (! FONT_SPEC_P (result))
+ val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
+ build_string (":"), val);
+ result = val;
+ }
+ else if (CONSP (result))
+ {
+ result = Fcopy_sequence (result);
+ for (tail = result; CONSP (tail); tail = XCDR (tail))
+ {
+ val = XCAR (tail);
+ if (FONTP (val))
+ val = Ffont_xlfd_name (val, Qt);
+ XSETCAR (tail, val);
+ }
+ }
+ else if (VECTORP (result))
+ {
+ result = Fcopy_sequence (result);
+ for (i = 0; i < ASIZE (result); i++)
+ {
+ val = AREF (result, i);
+ if (FONTP (val))
+ val = Ffont_xlfd_name (val, Qt);
+ ASET (result, i, val);
+ }
+ }
+ Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
+}
+
extern void syms_of_ftfont P_ (());
extern void syms_of_xfont P_ (());
extern void syms_of_xftfont P_ (());
extern void syms_of_bdffont P_ (());
extern void syms_of_w32font P_ (());
extern void syms_of_atmfont P_ (());
+extern void syms_of_nsfont P_ (());
void
syms_of_font ()
{
- sort_shift_bits[FONT_SLANT_INDEX] = 0;
- sort_shift_bits[FONT_WEIGHT_INDEX] = 7;
- sort_shift_bits[FONT_SIZE_INDEX] = 14;
- sort_shift_bits[FONT_WIDTH_INDEX] = 21;
- sort_shift_bits[FONT_ADSTYLE_INDEX] = 28;
- sort_shift_bits[FONT_FOUNDRY_INDEX] = 29;
- sort_shift_bits[FONT_FAMILY_INDEX] = 30;
- /* Note that sort_shift_bits[FONT_SORT_TYPE] and
- sort_shift_bits[FONT_SORT_REGISTRY] are never used. */
-
- staticpro (&font_style_table);
- font_style_table = Fmake_vector (make_number (3), Qnil);
+ sort_shift_bits[FONT_TYPE_INDEX] = 0;
+ sort_shift_bits[FONT_SLANT_INDEX] = 2;
+ sort_shift_bits[FONT_WEIGHT_INDEX] = 9;
+ sort_shift_bits[FONT_SIZE_INDEX] = 16;
+ sort_shift_bits[FONT_WIDTH_INDEX] = 23;
+ /* Note that the other elements in sort_shift_bits are not used. */
staticpro (&font_charset_alist);
font_charset_alist = Qnil;
DEFSYM (Qopentype, "opentype");
+ DEFSYM (Qascii_0, "ascii-0");
DEFSYM (Qiso8859_1, "iso8859-1");
DEFSYM (Qiso10646_1, "iso10646-1");
DEFSYM (Qunicode_bmp, "unicode-bmp");
staticpro (&scratch_font_prefer);
scratch_font_prefer = Ffont_spec (0, NULL);
+#if 0
#ifdef HAVE_LIBOTF
staticpro (&otf_list);
otf_list = Qnil;
-#endif
+#endif /* HAVE_LIBOTF */
+#endif /* 0 */
defsubr (&Sfontp);
defsubr (&Sfont_spec);
defsubr (&Sfont_get);
+#ifdef HAVE_WINDOW_SYSTEM
+ defsubr (&Sfont_face_attributes);
+#endif
defsubr (&Sfont_put);
defsubr (&Slist_fonts);
defsubr (&Sfont_family_list);
defsubr (&Sfind_font);
defsubr (&Sfont_xlfd_name);
defsubr (&Sclear_font_cache);
- defsubr (&Sinternal_set_font_style_table);
defsubr (&Sfont_make_gstring);
defsubr (&Sfont_fill_gstring);
defsubr (&Sfont_shape_text);
+#if 0
defsubr (&Sfont_drive_otf);
defsubr (&Sfont_otf_alternates);
+#endif /* 0 */
#ifdef FONT_DEBUG
defsubr (&Sopen_font);
defsubr (&Sdraw_string);
#endif
#endif /* FONT_DEBUG */
+#ifdef HAVE_WINDOW_SYSTEM
+ defsubr (&Sfont_info);
+#endif
+
+ DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
+ doc: /*
+Alist of fontname patterns vs the corresponding encoding and repertory info.
+Each element looks like (REGEXP . (ENCODING . REPERTORY)),
+where ENCODING is a charset or a char-table,
+and REPERTORY is a charset, a char-table, or nil.
+
+If ENCODING and REPERTORY are the same, the element can have the form
+\(REGEXP . ENCODING).
+
+ENCODING is for converting a character to a glyph code of the font.
+If ENCODING is a charset, encoding a character by the charset gives
+the corresponding glyph code. If ENCODING is a char-table, looking up
+the table by a character gives the corresponding glyph code.
+
+REPERTORY specifies a repertory of characters supported by the font.
+If REPERTORY is a charset, all characters beloging to the charset are
+supported. If REPERTORY is a char-table, all characters who have a
+non-nil value in the table are supported. If REPERTORY is nil, Emacs
+gets the repertory information by an opened font and ENCODING. */);
+ Vfont_encoding_alist = Qnil;
+
+ DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table,
+ doc: /* Vector of valid font weight values.
+Each element has the form:
+ [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
+NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
+ Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
+
+ DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table,
+ doc: /* Vector of font slant symbols vs the corresponding numeric values.
+See `font-weight-table' for the format of the vector. */);
+ Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
+
+ DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table,
+ doc: /* Alist of font width symbols vs the corresponding numeric values.
+See `font-weight-table' for the format of the vector. */);
+ Vfont_width_table = BUILD_STYLE_TABLE (width_table);
+ staticpro (&font_style_table);
+ font_style_table = Fmake_vector (make_number (3), Qnil);
+ ASET (font_style_table, 0, Vfont_weight_table);
+ ASET (font_style_table, 1, Vfont_slant_table);
+ ASET (font_style_table, 2, Vfont_width_table);
+
+ DEFVAR_LISP ("font-log", &Vfont_log, doc: /*
+*Logging list of font related actions and results.
+The value t means to suppress the logging.
+The initial value is set to nil if the environment variable
+EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
+ Vfont_log = Qnil;
+
+#ifdef HAVE_WINDOW_SYSTEM
#ifdef HAVE_FREETYPE
syms_of_ftfont ();
#ifdef HAVE_X_WINDOWS
#ifdef WINDOWSNT
syms_of_w32font ();
#endif /* WINDOWSNT */
+#ifdef HAVE_NS
+ syms_of_nsfont ();
+#endif /* HAVE_NS */
#ifdef MAC_OS
syms_of_atmfont ();
#endif /* MAC_OS */
+#endif /* HAVE_WINDOW_SYSTEM */
}
/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846