6040 lines
170 KiB
C
6040 lines
170 KiB
C
/* font.c -- "Font" primitives.
|
||
|
||
Copyright (C) 2006-2024 Free Software Foundation, Inc.
|
||
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
|
||
National Institute of Advanced Industrial Science and Technology (AIST)
|
||
Registration Number H13PRO009
|
||
|
||
This file is part of GNU Emacs.
|
||
|
||
GNU Emacs is free software: you can redistribute it and/or modify
|
||
it under the terms of the GNU General Public License as published by
|
||
the Free Software Foundation, either version 3 of the License, or (at
|
||
your option) any later version.
|
||
|
||
GNU Emacs is distributed in the hope that it will be useful,
|
||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
GNU General Public License for more details.
|
||
|
||
You should have received a copy of the GNU General Public License
|
||
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
||
|
||
#include <config.h>
|
||
#include <float.h>
|
||
#include <stdio.h>
|
||
#include <stdlib.h>
|
||
|
||
#include <c-ctype.h>
|
||
|
||
#include "lisp.h"
|
||
#include "character.h"
|
||
#include "buffer.h"
|
||
#include "frame.h"
|
||
#include "window.h"
|
||
#include "dispextern.h"
|
||
#include "charset.h"
|
||
#include "composite.h"
|
||
#include "fontset.h"
|
||
#include "font.h"
|
||
#include "termhooks.h"
|
||
#include "pdumper.h"
|
||
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
#include TERM_HEADER
|
||
#endif /* HAVE_WINDOW_SYSTEM */
|
||
|
||
#define DEFAULT_ENCODING Qiso8859_1
|
||
|
||
/* 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. */
|
||
const char *names[6];
|
||
};
|
||
|
||
/* The following tables should be in sync with 'custom-face-attributes'. */
|
||
|
||
/* Table of weight numeric values and their names. This table must be
|
||
sorted by numeric values in ascending order and the numeric values
|
||
must approximately match the weights in the font files. */
|
||
|
||
static const struct table_entry weight_table[] =
|
||
{
|
||
{ 0, { "thin" }},
|
||
{ 40, { "ultra-light", "ultralight", "extra-light", "extralight" }},
|
||
{ 50, { "light" }},
|
||
{ 55, { "semi-light", "semilight", "demilight" }},
|
||
{ 80, { "regular", "normal", "unspecified", "book" }},
|
||
{ 100, { "medium" }},
|
||
{ 180, { "semi-bold", "semibold", "demibold", "demi-bold", "demi" }},
|
||
{ 200, { "bold" }},
|
||
{ 205, { "extra-bold", "extrabold", "ultra-bold", "ultrabold" }},
|
||
{ 210, { "black", "heavy" }},
|
||
{ 250, { "ultra-heavy", "ultraheavy" }}
|
||
};
|
||
|
||
/* Table of slant numeric values and their names. This table must be
|
||
sorted by numeric values in ascending order. */
|
||
|
||
static const struct table_entry slant_table[] =
|
||
{
|
||
{ 0, { "reverse-oblique", "ro" }},
|
||
{ 10, { "reverse-italic", "ri" }},
|
||
{ 100, { "normal", "r", "unspecified" }},
|
||
{ 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 const 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", "unspecified" }},
|
||
{ 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
|
||
{ 125, { "expanded" }},
|
||
{ 150, { "extra-expanded", "extraexpanded" }},
|
||
{ 200, { "ultra-expanded", "ultraexpanded", "wide" }}
|
||
};
|
||
|
||
/* Alist of font registry symbols and the corresponding charset
|
||
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;
|
||
|
||
#ifdef ENABLE_CHECKING
|
||
|
||
/* Used to catch bogus pointers in font objects. */
|
||
|
||
bool
|
||
valid_font_driver (struct font_driver const *drv)
|
||
{
|
||
Lisp_Object tail, frame;
|
||
struct font_driver_list *fdl;
|
||
|
||
for (fdl = font_driver_list; fdl; fdl = fdl->next)
|
||
if (fdl->driver == drv)
|
||
return true;
|
||
FOR_EACH_FRAME (tail, frame)
|
||
for (fdl = XFRAME (frame)->font_driver_list; fdl; fdl = fdl->next)
|
||
if (fdl->driver == drv)
|
||
return true;
|
||
return false;
|
||
}
|
||
|
||
#endif /* ENABLE_CHECKING */
|
||
|
||
/* Creators of font-related Lisp object. */
|
||
|
||
static Lisp_Object
|
||
font_make_spec (void)
|
||
{
|
||
Lisp_Object font_spec;
|
||
struct font_spec *spec
|
||
= ((struct font_spec *)
|
||
allocate_pseudovector (VECSIZE (struct font_spec),
|
||
FONT_SPEC_MAX, FONT_SPEC_MAX, PVEC_FONT));
|
||
XSETFONT (font_spec, spec);
|
||
return font_spec;
|
||
}
|
||
|
||
Lisp_Object
|
||
font_make_entity (void)
|
||
{
|
||
Lisp_Object font_entity;
|
||
struct font_entity *entity
|
||
= ((struct font_entity *)
|
||
allocate_pseudovector (VECSIZE (struct font_entity),
|
||
FONT_ENTITY_MAX, FONT_ENTITY_MAX, PVEC_FONT));
|
||
XSETFONT (font_entity, entity);
|
||
|
||
#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
|
||
entity->is_android = false;
|
||
#endif
|
||
|
||
return font_entity;
|
||
}
|
||
|
||
#ifdef HAVE_ANDROID
|
||
|
||
Lisp_Object
|
||
font_make_entity_android (int size)
|
||
{
|
||
Lisp_Object font_entity;
|
||
struct font_entity *entity
|
||
= ((struct font_entity *)
|
||
allocate_pseudovector (size, FONT_ENTITY_MAX, FONT_ENTITY_MAX,
|
||
PVEC_FONT));
|
||
|
||
#if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
|
||
entity->is_android = true;
|
||
#endif
|
||
|
||
XSETFONT (font_entity, entity);
|
||
return font_entity;
|
||
}
|
||
|
||
#endif
|
||
|
||
/* 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 (int size, Lisp_Object entity, int pixelsize)
|
||
{
|
||
Lisp_Object font_object;
|
||
struct font *font
|
||
= (struct font *) allocate_pseudovector (size, FONT_OBJECT_MAX,
|
||
FONT_OBJECT_MAX, PVEC_FONT);
|
||
int i;
|
||
|
||
/* Poison the max_width, so we can detect when it hasn't been set. */
|
||
eassert (font->max_width = 1024 * 1024 * 1024);
|
||
|
||
/* GC can happen before the driver is set up,
|
||
so avoid dangling pointer here (Bug#17771). */
|
||
font->driver = NULL;
|
||
XSETFONT (font_object, font);
|
||
|
||
if (! NILP (entity))
|
||
{
|
||
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_alist (AREF (entity, FONT_EXTRA_INDEX));
|
||
}
|
||
if (size > 0)
|
||
font->props[FONT_SIZE_INDEX] = make_fixnum (pixelsize);
|
||
return font_object;
|
||
}
|
||
|
||
#if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
|
||
|
||
static int font_unparse_fcname (Lisp_Object, int, char *, int);
|
||
|
||
/* Like above, but also set `type', `name' and `fullname' properties
|
||
of font-object. */
|
||
|
||
Lisp_Object
|
||
font_build_object (int vectorsize, Lisp_Object type,
|
||
Lisp_Object entity, double pixelsize)
|
||
{
|
||
int len;
|
||
char name[256];
|
||
char *xlfd_name;
|
||
Lisp_Object font_object;
|
||
|
||
font_object = font_make_object (vectorsize, entity, pixelsize);
|
||
|
||
ASET (font_object, FONT_TYPE_INDEX, type);
|
||
xlfd_name = font_dynamic_unparse_xlfd (entity, pixelsize);
|
||
|
||
if (xlfd_name)
|
||
{
|
||
ASET (font_object, FONT_NAME_INDEX, build_string (xlfd_name));
|
||
xfree (xlfd_name);
|
||
}
|
||
|
||
len = font_unparse_fcname (entity, pixelsize, name, sizeof name);
|
||
if (len > 0)
|
||
ASET (font_object, FONT_FULLNAME_INDEX, make_string (name, len));
|
||
else
|
||
ASET (font_object, FONT_FULLNAME_INDEX,
|
||
AREF (font_object, FONT_NAME_INDEX));
|
||
return font_object;
|
||
}
|
||
|
||
#endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
|
||
|
||
static int font_pixel_size (struct frame *f, Lisp_Object);
|
||
static Lisp_Object font_open_entity (struct frame *, Lisp_Object, int);
|
||
static Lisp_Object font_matching_entity (struct frame *, Lisp_Object *,
|
||
Lisp_Object);
|
||
static unsigned font_encode_char (Lisp_Object, int);
|
||
|
||
/* Number of registered font drivers. */
|
||
static int num_font_drivers;
|
||
|
||
|
||
/* Return a Lispy value of a font property value at STR and LEN bytes.
|
||
If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
|
||
consist entirely of one or more digits, return a symbol interned
|
||
from STR. Otherwise, return an integer. */
|
||
|
||
Lisp_Object
|
||
font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
|
||
{
|
||
ptrdiff_t i, nbytes, nchars;
|
||
Lisp_Object tem, name, obarray;
|
||
|
||
if (len == 1 && *str == '*')
|
||
return Qnil;
|
||
if (!force_symbol && 0 < len && '0' <= *str && *str <= '9')
|
||
{
|
||
for (i = 1; i < len; i++)
|
||
if (! ('0' <= str[i] && str[i] <= '9'))
|
||
break;
|
||
if (i == len)
|
||
{
|
||
i = 0;
|
||
for (EMACS_INT n = 0;
|
||
(n += str[i++] - '0') <= MOST_POSITIVE_FIXNUM; )
|
||
{
|
||
if (i == len)
|
||
return make_fixnum (n);
|
||
if (ckd_mul (&n, n, 10))
|
||
break;
|
||
}
|
||
|
||
xsignal1 (Qoverflow_error, make_string (str, len));
|
||
}
|
||
}
|
||
|
||
/* This code is similar to intern function from lread.c. */
|
||
obarray = check_obarray (Vobarray);
|
||
parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
|
||
tem = oblookup (obarray, str,
|
||
(len == nchars || len != nbytes) ? len : nchars, len);
|
||
if (SYMBOLP (tem))
|
||
return tem;
|
||
name = make_specified_string (str, nchars, len,
|
||
len != nchars && len == nbytes);
|
||
return intern_driver (name, obarray, tem);
|
||
}
|
||
|
||
/* Return a pixel size of font-spec SPEC on frame F. */
|
||
|
||
static int
|
||
font_pixel_size (struct frame *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 val;
|
||
|
||
if (FIXNUMP (size))
|
||
return XFIXNUM (size);
|
||
if (NILP (size))
|
||
return 0;
|
||
if (FRAME_WINDOW_P (f))
|
||
{
|
||
eassert (FLOATP (size));
|
||
point_size = XFLOAT_DATA (size);
|
||
val = AREF (spec, FONT_DPI_INDEX);
|
||
if (FIXNUMP (val))
|
||
dpi = XFIXNUM (val);
|
||
else
|
||
dpi = FRAME_RES (f);
|
||
pixel_size = POINT_TO_PIXEL (point_size, dpi);
|
||
return pixel_size;
|
||
}
|
||
#endif
|
||
return 1;
|
||
}
|
||
|
||
|
||
/* Return a value of PROP's VAL (symbol or integer) to be stored in a
|
||
font vector. If VAL is not valid (i.e. not registered in
|
||
font_style_table), return -1 if NOERROR is zero, and return a
|
||
proper index if NOERROR is nonzero. In that case, register VAL in
|
||
font_style_table if VAL is a symbol, and return the closest index if
|
||
VAL is an integer. */
|
||
|
||
int
|
||
font_style_to_value (enum font_property_index prop, Lisp_Object val,
|
||
bool noerror)
|
||
{
|
||
Lisp_Object table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
|
||
int len;
|
||
|
||
CHECK_VECTOR (table);
|
||
len = ASIZE (table);
|
||
|
||
if (SYMBOLP (val))
|
||
{
|
||
int i, j;
|
||
char *s;
|
||
Lisp_Object elt;
|
||
|
||
/* At first try exact match. */
|
||
for (i = 0; i < len; i++)
|
||
{
|
||
CHECK_VECTOR (AREF (table, i));
|
||
for (j = 1; j < ASIZE (AREF (table, i)); j++)
|
||
if (EQ (val, AREF (AREF (table, i), j)))
|
||
{
|
||
CHECK_FIXNUM (AREF (AREF (table, i), 0));
|
||
return ((XFIXNUM (AREF (AREF (table, i), 0)) << 8)
|
||
| (i << 4) | (j - 1));
|
||
}
|
||
}
|
||
/* Try also with case-folding match. */
|
||
s = SSDATA (SYMBOL_NAME (val));
|
||
for (i = 0; i < len; i++)
|
||
for (j = 1; j < ASIZE (AREF (table, i)); j++)
|
||
{
|
||
elt = AREF (AREF (table, i), j);
|
||
if (xstrcasecmp (s, SSDATA (SYMBOL_NAME (elt))) == 0)
|
||
{
|
||
CHECK_FIXNUM (AREF (AREF (table, i), 0));
|
||
return ((XFIXNUM (AREF (AREF (table, i), 0)) << 8)
|
||
| (i << 4) | (j - 1));
|
||
}
|
||
}
|
||
if (! noerror)
|
||
return -1;
|
||
eassert (len < 255);
|
||
elt = make_vector (2, make_fixnum (100));
|
||
ASET (elt, 1, val);
|
||
ASET (font_style_table, prop - FONT_WEIGHT_INDEX,
|
||
CALLN (Fvconcat, table, make_vector (1, elt)));
|
||
return (100 << 8) | (i << 4);
|
||
}
|
||
else
|
||
{
|
||
int i, last_n;
|
||
EMACS_INT numeric = XFIXNUM (val);
|
||
|
||
for (i = 0, last_n = -1; i < len; i++)
|
||
{
|
||
int n;
|
||
|
||
CHECK_VECTOR (AREF (table, i));
|
||
CHECK_FIXNUM (AREF (AREF (table, i), 0));
|
||
n = XFIXNUM (AREF (AREF (table, i), 0));
|
||
if (numeric == n)
|
||
return (n << 8) | (i << 4);
|
||
if (numeric < n)
|
||
{
|
||
if (! noerror)
|
||
return -1;
|
||
return ((i == 0 || n - numeric < numeric - last_n)
|
||
? (n << 8) | (i << 4): (last_n << 8 | ((i - 1) << 4)));
|
||
}
|
||
last_n = n;
|
||
}
|
||
if (! noerror)
|
||
return -1;
|
||
return ((last_n << 8) | ((i - 1) << 4));
|
||
}
|
||
}
|
||
|
||
Lisp_Object
|
||
font_style_symbolic (Lisp_Object font, enum font_property_index prop,
|
||
bool for_face)
|
||
{
|
||
Lisp_Object val = AREF (font, prop);
|
||
Lisp_Object table, elt;
|
||
int i;
|
||
|
||
if (NILP (val))
|
||
return Qnil;
|
||
table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX);
|
||
CHECK_VECTOR (table);
|
||
i = XFIXNUM (val) & 0xFF;
|
||
eassert (((i >> 4) & 0xF) < ASIZE (table));
|
||
elt = AREF (table, ((i >> 4) & 0xF));
|
||
CHECK_VECTOR (elt);
|
||
eassert ((i & 0xF) + 1 < ASIZE (elt));
|
||
elt = (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
|
||
CHECK_SYMBOL (elt);
|
||
return elt;
|
||
}
|
||
|
||
/* 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 (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));
|
||
}
|
||
return Qnil;
|
||
}
|
||
|
||
/* 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 (Lisp_Object registry, struct charset **encoding, struct charset **repertory)
|
||
{
|
||
Lisp_Object val;
|
||
int encoding_id, repertory_id;
|
||
|
||
val = Fassoc_string (registry, font_charset_alist, Qt);
|
||
if (! NILP (val))
|
||
{
|
||
val = XCDR (val);
|
||
if (NILP (val))
|
||
return -1;
|
||
encoding_id = XFIXNUM (XCAR (val));
|
||
repertory_id = XFIXNUM (XCDR (val));
|
||
}
|
||
else
|
||
{
|
||
val = find_font_encoding (SYMBOL_NAME (registry));
|
||
if (SYMBOLP (val) && CHARSETP (val))
|
||
{
|
||
encoding_id = repertory_id = XFIXNUM (CHARSET_SYMBOL_ID (val));
|
||
}
|
||
else if (CONSP (val))
|
||
{
|
||
if (! CHARSETP (XCAR (val)))
|
||
goto invalid_entry;
|
||
encoding_id = XFIXNUM (CHARSET_SYMBOL_ID (XCAR (val)));
|
||
if (NILP (XCDR (val)))
|
||
repertory_id = -1;
|
||
else
|
||
{
|
||
if (! CHARSETP (XCDR (val)))
|
||
goto invalid_entry;
|
||
repertory_id = XFIXNUM (CHARSET_SYMBOL_ID (XCDR (val)));
|
||
}
|
||
}
|
||
else
|
||
goto invalid_entry;
|
||
val = Fcons (make_fixnum (encoding_id), make_fixnum (repertory_id));
|
||
font_charset_alist
|
||
= nconc2 (font_charset_alist, list1 (Fcons (registry, val)));
|
||
}
|
||
|
||
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, list1 (Fcons (registry, Qnil)));
|
||
return -1;
|
||
}
|
||
|
||
|
||
/* Font property value validators. See the comment of
|
||
font_property_table for the meaning of the arguments. */
|
||
|
||
static Lisp_Object font_prop_validate (int, Lisp_Object, Lisp_Object);
|
||
static Lisp_Object font_prop_validate_symbol (Lisp_Object, Lisp_Object);
|
||
static Lisp_Object font_prop_validate_style (Lisp_Object, Lisp_Object);
|
||
static Lisp_Object font_prop_validate_non_neg (Lisp_Object, Lisp_Object);
|
||
static Lisp_Object font_prop_validate_spacing (Lisp_Object, Lisp_Object);
|
||
static int get_font_prop_index (Lisp_Object);
|
||
|
||
static Lisp_Object
|
||
font_prop_validate_symbol (Lisp_Object prop, Lisp_Object val)
|
||
{
|
||
if (STRINGP (val))
|
||
val = Fintern (val, Qnil);
|
||
if (! SYMBOLP (val))
|
||
val = Qerror;
|
||
else if (EQ (prop, QCregistry))
|
||
val = Fintern (Fdowncase (SYMBOL_NAME (val)), Qnil);
|
||
return val;
|
||
}
|
||
|
||
|
||
static Lisp_Object
|
||
font_prop_validate_style (Lisp_Object style, Lisp_Object val)
|
||
{
|
||
enum font_property_index prop = (EQ (style, QCweight) ? FONT_WEIGHT_INDEX
|
||
: EQ (style, QCslant) ? FONT_SLANT_INDEX
|
||
: FONT_WIDTH_INDEX);
|
||
if (FIXNUMP (val))
|
||
{
|
||
EMACS_INT n = XFIXNUM (val);
|
||
CHECK_VECTOR (AREF (font_style_table, prop - FONT_WEIGHT_INDEX));
|
||
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 >> 4) & 0xF);
|
||
|
||
CHECK_VECTOR (elt);
|
||
if ((n & 0xF) + 1 >= ASIZE (elt))
|
||
val = Qerror;
|
||
else
|
||
{
|
||
CHECK_FIXNUM (AREF (elt, 0));
|
||
if (XFIXNUM (AREF (elt, 0)) != (n >> 8))
|
||
val = Qerror;
|
||
}
|
||
}
|
||
}
|
||
else if (SYMBOLP (val))
|
||
{
|
||
int n = font_style_to_value (prop, val, 0);
|
||
|
||
val = n >= 0 ? make_fixnum (n) : Qerror;
|
||
}
|
||
else
|
||
val = Qerror;
|
||
return val;
|
||
}
|
||
|
||
static Lisp_Object
|
||
font_prop_validate_non_neg (Lisp_Object prop, Lisp_Object val)
|
||
{
|
||
return (FIXNATP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0)
|
||
? val : Qerror);
|
||
}
|
||
|
||
static Lisp_Object
|
||
font_prop_validate_spacing (Lisp_Object prop, Lisp_Object val)
|
||
{
|
||
if (NILP (val) || (FIXNATP (val) && XFIXNUM (val) <= FONT_SPACING_CHARCELL))
|
||
return val;
|
||
if (SYMBOLP (val) && SBYTES (SYMBOL_NAME (val)) == 1)
|
||
{
|
||
char spacing = SDATA (SYMBOL_NAME (val))[0];
|
||
|
||
if (spacing == 'c' || spacing == 'C')
|
||
return make_fixnum (FONT_SPACING_CHARCELL);
|
||
if (spacing == 'm' || spacing == 'M')
|
||
return make_fixnum (FONT_SPACING_MONO);
|
||
if (spacing == 'p' || spacing == 'P')
|
||
return make_fixnum (FONT_SPACING_PROPORTIONAL);
|
||
if (spacing == 'd' || spacing == 'D')
|
||
return make_fixnum (FONT_SPACING_DUAL);
|
||
}
|
||
return Qerror;
|
||
}
|
||
|
||
static Lisp_Object
|
||
font_prop_validate_otf (Lisp_Object prop, Lisp_Object val)
|
||
{
|
||
Lisp_Object tail, tmp;
|
||
int i;
|
||
|
||
/* 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++)
|
||
{
|
||
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 val;
|
||
}
|
||
|
||
/* Structure of known font property keys and validator of the
|
||
values. */
|
||
static const struct
|
||
{
|
||
/* Index of the key symbol. */
|
||
int key;
|
||
/* 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 (*validator) (Lisp_Object prop, Lisp_Object val);
|
||
} font_property_table[] =
|
||
{ { SYMBOL_INDEX (QCtype), font_prop_validate_symbol },
|
||
{ SYMBOL_INDEX (QCfoundry), font_prop_validate_symbol },
|
||
{ SYMBOL_INDEX (QCfamily), font_prop_validate_symbol },
|
||
{ SYMBOL_INDEX (QCadstyle), font_prop_validate_symbol },
|
||
{ SYMBOL_INDEX (QCregistry), font_prop_validate_symbol },
|
||
{ SYMBOL_INDEX (QCweight), font_prop_validate_style },
|
||
{ SYMBOL_INDEX (QCslant), font_prop_validate_style },
|
||
{ SYMBOL_INDEX (QCwidth), font_prop_validate_style },
|
||
{ SYMBOL_INDEX (QCsize), font_prop_validate_non_neg },
|
||
{ SYMBOL_INDEX (QCdpi), font_prop_validate_non_neg },
|
||
{ SYMBOL_INDEX (QCspacing), font_prop_validate_spacing },
|
||
{ SYMBOL_INDEX (QCavgwidth), font_prop_validate_non_neg },
|
||
/* The order of the above entries must match with enum
|
||
font_property_index. */
|
||
{ SYMBOL_INDEX (QClang), font_prop_validate_symbol },
|
||
{ SYMBOL_INDEX (QCscript), font_prop_validate_symbol },
|
||
{ SYMBOL_INDEX (QCotf), font_prop_validate_otf }
|
||
};
|
||
|
||
/* Return an index number of font property KEY or -1 if KEY is not an
|
||
already known property. */
|
||
|
||
static int
|
||
get_font_prop_index (Lisp_Object key)
|
||
{
|
||
int i;
|
||
|
||
for (i = 0; i < ARRAYELTS (font_property_table); i++)
|
||
if (EQ (key, builtin_lisp_symbol (font_property_table[i].key)))
|
||
return i;
|
||
return -1;
|
||
}
|
||
|
||
/* Validate the font property. The property key is specified by the
|
||
symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
|
||
signal an error. The value is VAL or the regularized one. */
|
||
|
||
static Lisp_Object
|
||
font_prop_validate (int idx, Lisp_Object prop, Lisp_Object val)
|
||
{
|
||
Lisp_Object validated;
|
||
|
||
if (NILP (val))
|
||
return val;
|
||
if (NILP (prop))
|
||
prop = builtin_lisp_symbol (font_property_table[idx].key);
|
||
else
|
||
{
|
||
idx = get_font_prop_index (prop);
|
||
if (idx < 0)
|
||
return val;
|
||
}
|
||
validated = (font_property_table[idx].validator) (prop, val);
|
||
if (EQ (validated, Qerror))
|
||
signal_error ("invalid font property", Fcons (prop, val));
|
||
return validated;
|
||
}
|
||
|
||
|
||
/* Store VAL as a value of extra font property PROP in FONT while
|
||
keeping the sorting order. Don't check the validity of VAL. If
|
||
VAL is Qunbound, delete the slot for PROP from the list of extra
|
||
properties. */
|
||
|
||
Lisp_Object
|
||
font_put_extra (Lisp_Object font, Lisp_Object prop, Lisp_Object val)
|
||
{
|
||
Lisp_Object extra = AREF (font, FONT_EXTRA_INDEX);
|
||
Lisp_Object slot = (NILP (extra) ? Qnil : assq_no_quit (prop, extra));
|
||
|
||
if (NILP (slot))
|
||
{
|
||
Lisp_Object prev = Qnil;
|
||
|
||
if (BASE_EQ (val, Qunbound))
|
||
return val;
|
||
while (CONSP (extra)
|
||
&& NILP (Fstring_lessp (prop, XCAR (XCAR (extra)))))
|
||
prev = extra, extra = XCDR (extra);
|
||
|
||
if (NILP (prev))
|
||
ASET (font, FONT_EXTRA_INDEX, Fcons (Fcons (prop, val), extra));
|
||
else
|
||
XSETCDR (prev, Fcons (Fcons (prop, val), extra));
|
||
|
||
return val;
|
||
}
|
||
XSETCDR (slot, val);
|
||
if (BASE_EQ (val, Qunbound))
|
||
ASET (font, FONT_EXTRA_INDEX, Fdelq (slot, extra));
|
||
return val;
|
||
}
|
||
|
||
|
||
/* Font name parser and unparser. */
|
||
|
||
static int parse_matrix (const char *);
|
||
static int font_expand_wildcards (Lisp_Object *, int);
|
||
static int font_parse_name (char *, ptrdiff_t, Lisp_Object);
|
||
|
||
/* An enumerator for each field of an XLFD font name. */
|
||
enum xlfd_field_index
|
||
{
|
||
XLFD_FOUNDRY_INDEX,
|
||
XLFD_FAMILY_INDEX,
|
||
XLFD_WEIGHT_INDEX,
|
||
XLFD_SLANT_INDEX,
|
||
XLFD_SWIDTH_INDEX,
|
||
XLFD_ADSTYLE_INDEX,
|
||
XLFD_PIXEL_INDEX,
|
||
XLFD_POINT_INDEX,
|
||
XLFD_RESX_INDEX,
|
||
XLFD_RESY_INDEX,
|
||
XLFD_SPACING_INDEX,
|
||
XLFD_AVGWIDTH_INDEX,
|
||
XLFD_REGISTRY_INDEX,
|
||
XLFD_ENCODING_INDEX,
|
||
XLFD_LAST_INDEX
|
||
};
|
||
|
||
/* An enumerator for mask bit corresponding to each XLFD field. */
|
||
enum xlfd_field_mask
|
||
{
|
||
XLFD_FOUNDRY_MASK = 0x0001,
|
||
XLFD_FAMILY_MASK = 0x0002,
|
||
XLFD_WEIGHT_MASK = 0x0004,
|
||
XLFD_SLANT_MASK = 0x0008,
|
||
XLFD_SWIDTH_MASK = 0x0010,
|
||
XLFD_ADSTYLE_MASK = 0x0020,
|
||
XLFD_PIXEL_MASK = 0x0040,
|
||
XLFD_POINT_MASK = 0x0080,
|
||
XLFD_RESX_MASK = 0x0100,
|
||
XLFD_RESY_MASK = 0x0200,
|
||
XLFD_SPACING_MASK = 0x0400,
|
||
XLFD_AVGWIDTH_MASK = 0x0800,
|
||
XLFD_REGISTRY_MASK = 0x1000,
|
||
XLFD_ENCODING_MASK = 0x2000
|
||
};
|
||
|
||
|
||
/* Parse P pointing to the pixel/point size field of the form
|
||
`[A B C D]' which specifies a transformation matrix:
|
||
|
||
A B 0
|
||
C D 0
|
||
0 0 1
|
||
|
||
by which all glyphs of the font are transformed. The spec says
|
||
that scalar value N for the pixel/point size is equivalent to:
|
||
A = N * resx/resy, B = C = 0, D = N.
|
||
|
||
Return the scalar value N if the form is valid. Otherwise return
|
||
-1. */
|
||
|
||
static int
|
||
parse_matrix (const char *p)
|
||
{
|
||
double matrix[4];
|
||
char *end;
|
||
int i;
|
||
|
||
for (i = 0, p++; i < 4 && *p && *p != ']'; i++)
|
||
{
|
||
if (*p == '~')
|
||
matrix[i] = - strtod (p + 1, &end);
|
||
else
|
||
matrix[i] = strtod (p, &end);
|
||
p = end;
|
||
}
|
||
return (i == 4 ? (int) matrix[3] : -1);
|
||
}
|
||
|
||
/* Expand a wildcard field in FIELD (the first N fields are filled) to
|
||
multiple fields to fill in all 14 XLFD fields while restricting a
|
||
field position by its contents. */
|
||
|
||
static int
|
||
font_expand_wildcards (Lisp_Object *field, int n)
|
||
{
|
||
/* Copy of FIELD. */
|
||
Lisp_Object tmp[XLFD_LAST_INDEX];
|
||
/* Array of information about where this element can go. Nth
|
||
element is for Nth element of FIELD. */
|
||
struct {
|
||
/* Minimum possible field. */
|
||
int from;
|
||
/* Maximum possible field. */
|
||
int to;
|
||
/* Bit mask of possible field. Nth bit corresponds to Nth field. */
|
||
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_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_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
|
||
field. The value is shifted to left one bit by one in the
|
||
following loop. */
|
||
for (i = 0, range_mask = 0; i <= 14 - n; i++)
|
||
range_mask = (range_mask << 1) | 1;
|
||
|
||
/* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
|
||
position-based restriction for FIELD[I]. */
|
||
for (i = 0, range_from = 0, range_to = 14 - n; i < n;
|
||
i++, range_from++, range_to++, range_mask <<= 1)
|
||
{
|
||
Lisp_Object val = field[i];
|
||
|
||
tmp[i] = val;
|
||
if (NILP (val))
|
||
{
|
||
/* Wildcard. */
|
||
range[i].from = range_from;
|
||
range[i].to = range_to;
|
||
range[i].mask = range_mask;
|
||
}
|
||
else
|
||
{
|
||
/* The triplet FROM, TO, and MASK is a value-based
|
||
restriction for FIELD[I]. */
|
||
int from, to;
|
||
unsigned mask;
|
||
|
||
if (FIXNUMP (val))
|
||
{
|
||
EMACS_INT numeric = XFIXNUM (val);
|
||
|
||
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 (SBYTES (SYMBOL_NAME (val)) == 0)
|
||
from = XLFD_FOUNDRY_INDEX, to = XLFD_ADSTYLE_INDEX,
|
||
mask = XLFD_NULL_MASK;
|
||
else if (i == 0)
|
||
from = to = XLFD_FOUNDRY_INDEX, mask = XLFD_FOUNDRY_MASK;
|
||
else if (i + 1 == n)
|
||
{
|
||
Lisp_Object name = SYMBOL_NAME (val);
|
||
|
||
if (SDATA (name)[SBYTES (name) - 1] == '*')
|
||
from = XLFD_REGISTRY_INDEX, to = XLFD_ENCODING_INDEX,
|
||
mask = XLFD_REGENC_MASK;
|
||
else
|
||
from = to = XLFD_ENCODING_INDEX,
|
||
mask = XLFD_ENCODING_MASK;
|
||
}
|
||
else if (range_from <= XLFD_WEIGHT_INDEX
|
||
&& range_to >= XLFD_WEIGHT_INDEX
|
||
&& FONT_WEIGHT_NAME_NUMERIC (val) >= 0)
|
||
from = to = XLFD_WEIGHT_INDEX, mask = XLFD_WEIGHT_MASK;
|
||
else if (range_from <= XLFD_SLANT_INDEX
|
||
&& range_to >= XLFD_SLANT_INDEX
|
||
&& FONT_SLANT_NAME_NUMERIC (val) >= 0)
|
||
from = to = XLFD_SLANT_INDEX, mask = XLFD_SLANT_MASK;
|
||
else if (range_from <= XLFD_SWIDTH_INDEX
|
||
&& range_to >= XLFD_SWIDTH_INDEX
|
||
&& FONT_WIDTH_NAME_NUMERIC (val) >= 0)
|
||
from = to = XLFD_SWIDTH_INDEX, mask = XLFD_SWIDTH_MASK;
|
||
else
|
||
{
|
||
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,
|
||
mask = XLFD_SYMBOL_MASK;
|
||
}
|
||
|
||
/* Merge position-based and value-based restrictions. */
|
||
mask &= range_mask;
|
||
while (from < range_from)
|
||
mask &= ~(1 << from++);
|
||
while (from < 14 && ! (mask & (1 << from)))
|
||
from++;
|
||
while (to > range_to)
|
||
mask &= ~(1 << to--);
|
||
while (to >= 0 && ! (mask & (1 << to)))
|
||
to--;
|
||
if (from > to)
|
||
return -1;
|
||
range[i].from = from;
|
||
range[i].to = to;
|
||
range[i].mask = mask;
|
||
|
||
if (from > range_from || to < range_to)
|
||
{
|
||
/* 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;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
/* Decide all fields from restrictions in RANGE. */
|
||
for (i = j = 0; i < n ; i++)
|
||
{
|
||
if (j < range[i].from)
|
||
{
|
||
if (i == 0 || ! NILP (tmp[i - 1]))
|
||
/* None of TMP[X] corresponds to Jth field. */
|
||
return -1;
|
||
memclear (field + j, (range[i].from - j) * word_size);
|
||
j = range[i].from;
|
||
}
|
||
field[j++] = tmp[i];
|
||
}
|
||
if (! NILP (tmp[n - 1]) && j < XLFD_REGISTRY_INDEX)
|
||
return -1;
|
||
memclear (field + j, (XLFD_LAST_INDEX - j) * word_size);
|
||
if (FIXNUMP (field[XLFD_ENCODING_INDEX]))
|
||
field[XLFD_ENCODING_INDEX]
|
||
= Fintern (Fnumber_to_string (field[XLFD_ENCODING_INDEX]), Qnil);
|
||
return 0;
|
||
}
|
||
|
||
|
||
/* 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 NAME is successfully parsed, return 0. Otherwise return -1.
|
||
|
||
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. */
|
||
|
||
static int
|
||
font_parse_xlfd_1 (char *name, ptrdiff_t len, Lisp_Object font, int segments)
|
||
{
|
||
int i, j, n;
|
||
char *f[XLFD_LAST_INDEX + 1];
|
||
Lisp_Object val;
|
||
char *p;
|
||
|
||
/* Reject empty XLFDs. */
|
||
if (!len)
|
||
return -1;
|
||
|
||
/* Accept "*-.." as a fully specified XLFD. */
|
||
if (name[0] == '*' && (len == 1 || name[1] == '-'))
|
||
i = 1, f[XLFD_FOUNDRY_INDEX] = name;
|
||
else
|
||
i = 0;
|
||
|
||
/* Split into segments. */
|
||
for (p = name + i; *p; p++)
|
||
if (*p == '-')
|
||
{
|
||
/* If we have too many segments, then gather them up into the
|
||
FAMILY part of the name. This allows using fonts with
|
||
dashes in the FAMILY bit. */
|
||
if (segments > XLFD_LAST_INDEX && i == XLFD_WEIGHT_INDEX)
|
||
segments--;
|
||
else {
|
||
f[i++] = p + 1;
|
||
if (i == XLFD_LAST_INDEX)
|
||
break;
|
||
}
|
||
}
|
||
f[i] = name + len;
|
||
|
||
#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;
|
||
|
||
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_SYM (i);
|
||
if (! NILP (val))
|
||
{
|
||
if ((n = font_style_to_value (j, INTERN_FIELD_SYM (i), 0)) < 0)
|
||
return -1;
|
||
ASET (font, j, make_fixnum (n));
|
||
}
|
||
}
|
||
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],
|
||
1));
|
||
p = f[XLFD_PIXEL_INDEX];
|
||
if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0)
|
||
ASET (font, FONT_SIZE_INDEX, make_fixnum (pixel_size));
|
||
else
|
||
{
|
||
val = INTERN_FIELD (XLFD_PIXEL_INDEX);
|
||
if (FIXNUMP (val))
|
||
ASET (font, FONT_SIZE_INDEX, val);
|
||
else if (FONT_ENTITY_P (font))
|
||
return -1;
|
||
else
|
||
{
|
||
double point_size = -1;
|
||
|
||
eassert (FONT_SPEC_P (font));
|
||
p = f[XLFD_POINT_INDEX];
|
||
if (*p == '[')
|
||
point_size = parse_matrix (p);
|
||
else if (c_isdigit (*p))
|
||
point_size = atoi (p), point_size /= 10;
|
||
if (point_size >= 0)
|
||
ASET (font, FONT_SIZE_INDEX, make_float (point_size));
|
||
}
|
||
}
|
||
|
||
val = INTERN_FIELD (XLFD_RESY_INDEX);
|
||
if (! NILP (val) && ! FIXNUMP (val))
|
||
return -1;
|
||
ASET (font, FONT_DPI_INDEX, val);
|
||
val = INTERN_FIELD (XLFD_SPACING_INDEX);
|
||
if (! NILP (val))
|
||
{
|
||
val = font_prop_validate_spacing (QCspacing, val);
|
||
if (! FIXNUMP (val))
|
||
return -1;
|
||
ASET (font, FONT_SPACING_INDEX, val);
|
||
}
|
||
p = f[XLFD_AVGWIDTH_INDEX];
|
||
if (*p == '~')
|
||
p++;
|
||
val = font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p, 0);
|
||
if (! NILP (val) && ! FIXNUMP (val))
|
||
return -1;
|
||
ASET (font, FONT_AVGWIDTH_INDEX, val);
|
||
}
|
||
else
|
||
{
|
||
bool wild_card_found = 0;
|
||
Lisp_Object prop[XLFD_LAST_INDEX];
|
||
|
||
if (FONT_ENTITY_P (font))
|
||
return -1;
|
||
for (j = 0; j < i; j++)
|
||
{
|
||
if (*f[j] == '*')
|
||
{
|
||
if (f[j][1] && f[j][1] != '-')
|
||
return -1;
|
||
prop[j] = Qnil;
|
||
wild_card_found = 1;
|
||
}
|
||
else if (j + 1 < i)
|
||
prop[j] = INTERN_FIELD (j);
|
||
else
|
||
prop[j] = font_intern_prop (f[j], f[i] - f[j], 0);
|
||
}
|
||
if (! wild_card_found)
|
||
return -1;
|
||
if (font_expand_wildcards (prop, i) < 0)
|
||
return -1;
|
||
|
||
ASET (font, FONT_FOUNDRY_INDEX, prop[XLFD_FOUNDRY_INDEX]);
|
||
ASET (font, FONT_FAMILY_INDEX, prop[XLFD_FAMILY_INDEX]);
|
||
for (i = XLFD_WEIGHT_INDEX, j = FONT_WEIGHT_INDEX;
|
||
i <= XLFD_SWIDTH_INDEX; i++, j++)
|
||
if (! NILP (prop[i]))
|
||
{
|
||
if ((n = font_style_to_value (j, prop[i], 1)) < 0)
|
||
return -1;
|
||
ASET (font, j, make_fixnum (n));
|
||
}
|
||
ASET (font, FONT_ADSTYLE_INDEX, prop[XLFD_ADSTYLE_INDEX]);
|
||
val = prop[XLFD_REGISTRY_INDEX];
|
||
if (NILP (val))
|
||
{
|
||
val = prop[XLFD_ENCODING_INDEX];
|
||
if (! NILP (val))
|
||
{
|
||
AUTO_STRING (star_dash, "*-");
|
||
val = concat2 (star_dash, SYMBOL_NAME (val));
|
||
}
|
||
}
|
||
else if (NILP (prop[XLFD_ENCODING_INDEX]))
|
||
{
|
||
AUTO_STRING (dash_star, "-*");
|
||
val = concat2 (SYMBOL_NAME (val), dash_star);
|
||
}
|
||
else
|
||
{
|
||
AUTO_STRING (dash, "-");
|
||
val = concat3 (SYMBOL_NAME (val), dash,
|
||
SYMBOL_NAME (prop[XLFD_ENCODING_INDEX]));
|
||
}
|
||
if (! NILP (val))
|
||
ASET (font, FONT_REGISTRY_INDEX, Fintern (val, Qnil));
|
||
|
||
if (FIXNUMP (prop[XLFD_PIXEL_INDEX]))
|
||
ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]);
|
||
else if (FIXNUMP (prop[XLFD_POINT_INDEX]))
|
||
{
|
||
double point_size = XFIXNUM (prop[XLFD_POINT_INDEX]);
|
||
|
||
ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10));
|
||
}
|
||
|
||
if (FIXNUMP (prop[XLFD_RESX_INDEX]))
|
||
ASET (font, FONT_DPI_INDEX, prop[XLFD_RESY_INDEX]);
|
||
if (! NILP (prop[XLFD_SPACING_INDEX]))
|
||
{
|
||
val = font_prop_validate_spacing (QCspacing,
|
||
prop[XLFD_SPACING_INDEX]);
|
||
if (! FIXNUMP (val))
|
||
return -1;
|
||
ASET (font, FONT_SPACING_INDEX, val);
|
||
}
|
||
if (FIXNUMP (prop[XLFD_AVGWIDTH_INDEX]))
|
||
ASET (font, FONT_AVGWIDTH_INDEX, prop[XLFD_AVGWIDTH_INDEX]);
|
||
}
|
||
|
||
return 0;
|
||
}
|
||
|
||
int
|
||
font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
|
||
{
|
||
int found = font_parse_xlfd_1 (name, len, font, -1);
|
||
if (found > -1)
|
||
return found;
|
||
|
||
int segments = 0;
|
||
/* Count how many segments we have. */
|
||
for (char *p = name; *p; p++)
|
||
if (*p == '-')
|
||
segments++;
|
||
|
||
/* If we have a surplus of segments, then we try to parse again, in
|
||
case there's a font with dashes in the family name. */
|
||
if (segments > XLFD_LAST_INDEX)
|
||
return font_parse_xlfd_1 (name, len, font, segments);
|
||
else
|
||
return -1;
|
||
}
|
||
|
||
/* Return the XLFD name of FONT as a NULL terminated string, or NULL
|
||
if the font is invalid. If FONT is a scalable font, return
|
||
PIXEL_SIZE as the XLFD's pixel size in lieu of its
|
||
FONT_SIZE_INDEX. */
|
||
|
||
char *
|
||
font_dynamic_unparse_xlfd (Lisp_Object font, int pixel_size)
|
||
{
|
||
char *p;
|
||
const char *f[XLFD_REGISTRY_INDEX + 1];
|
||
Lisp_Object val;
|
||
int i, j;
|
||
char *name;
|
||
USE_SAFE_ALLOCA;
|
||
|
||
eassert (FONTP (font));
|
||
|
||
for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX;
|
||
i++, j++)
|
||
{
|
||
if (i == FONT_ADSTYLE_INDEX)
|
||
j = XLFD_ADSTYLE_INDEX;
|
||
else if (i == FONT_REGISTRY_INDEX)
|
||
j = XLFD_REGISTRY_INDEX;
|
||
val = AREF (font, i);
|
||
if (NILP (val))
|
||
{
|
||
if (j == XLFD_REGISTRY_INDEX)
|
||
f[j] = "*-*";
|
||
else
|
||
f[j] = "*";
|
||
}
|
||
else
|
||
{
|
||
if (SYMBOLP (val))
|
||
val = SYMBOL_NAME (val);
|
||
if (j == XLFD_REGISTRY_INDEX
|
||
&& ! strchr (SSDATA (val), '-'))
|
||
{
|
||
ptrdiff_t alloc = SBYTES (val) + 4;
|
||
|
||
/* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
|
||
f[j] = p = SAFE_ALLOCA (alloc);
|
||
sprintf (p, "%s%s-*", SDATA (val),
|
||
&"*"[SDATA (val)[SBYTES (val) - 1] == '*']);
|
||
}
|
||
else
|
||
f[j] = SSDATA (val);
|
||
}
|
||
}
|
||
|
||
for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX;
|
||
i++, j++)
|
||
{
|
||
val = font_style_symbolic (font, i, 0);
|
||
if (NILP (val))
|
||
f[j] = "*";
|
||
else
|
||
{
|
||
int c, k, l;
|
||
ptrdiff_t alloc;
|
||
|
||
val = SYMBOL_NAME (val);
|
||
alloc = SBYTES (val) + 1;
|
||
f[j] = p = SAFE_ALLOCA (alloc);
|
||
/* Copy the name while excluding '-', '?', ',', and '"'. */
|
||
for (k = l = 0; k < alloc; k++)
|
||
{
|
||
c = SREF (val, k);
|
||
if (c != '-' && c != '?' && c != ',' && c != '"')
|
||
p[l++] = c;
|
||
}
|
||
}
|
||
}
|
||
|
||
val = AREF (font, FONT_SIZE_INDEX);
|
||
eassert (NUMBERP (val) || NILP (val));
|
||
char font_size_index_buf[sizeof "-*"
|
||
+ max (INT_STRLEN_BOUND (EMACS_INT),
|
||
1 + DBL_MAX_10_EXP + 1)];
|
||
if (INTEGERP (val))
|
||
{
|
||
intmax_t v;
|
||
if (! (integer_to_intmax (val, &v) && 0 < v))
|
||
v = pixel_size;
|
||
if (v > 0)
|
||
{
|
||
f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
|
||
sprintf (p, "%"PRIdMAX"-*", v);
|
||
}
|
||
else
|
||
f[XLFD_PIXEL_INDEX] = "*-*";
|
||
}
|
||
else if (FLOATP (val))
|
||
{
|
||
double v = XFLOAT_DATA (val) * 10;
|
||
f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
|
||
sprintf (p, "*-%.0f", v);
|
||
}
|
||
else
|
||
f[XLFD_PIXEL_INDEX] = "*-*";
|
||
|
||
char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)];
|
||
if (FIXNUMP (AREF (font, FONT_DPI_INDEX)))
|
||
{
|
||
EMACS_INT v = XFIXNUM (AREF (font, FONT_DPI_INDEX));
|
||
f[XLFD_RESX_INDEX] = p = dpi_index_buf;
|
||
sprintf (p, "%"pI"d-%"pI"d", v, v);
|
||
}
|
||
else
|
||
f[XLFD_RESX_INDEX] = "*-*";
|
||
|
||
if (FIXNUMP (AREF (font, FONT_SPACING_INDEX)))
|
||
{
|
||
EMACS_INT spacing = XFIXNUM (AREF (font, FONT_SPACING_INDEX));
|
||
|
||
f[XLFD_SPACING_INDEX] = (spacing <= FONT_SPACING_PROPORTIONAL ? "p"
|
||
: spacing <= FONT_SPACING_DUAL ? "d"
|
||
: spacing <= FONT_SPACING_MONO ? "m"
|
||
: "c");
|
||
}
|
||
else
|
||
f[XLFD_SPACING_INDEX] = "*";
|
||
|
||
char avgwidth_index_buf[INT_BUFSIZE_BOUND (EMACS_INT)];
|
||
if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX)))
|
||
{
|
||
f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf;
|
||
sprintf (p, "%"pI"d", XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX)));
|
||
}
|
||
else
|
||
f[XLFD_AVGWIDTH_INDEX] = "*";
|
||
|
||
/* Allocate a buffer large enough to accommodate the entire
|
||
XLFD. */
|
||
|
||
name = xmalloc (strlen (f[XLFD_FOUNDRY_INDEX])
|
||
+ strlen (f[XLFD_FAMILY_INDEX])
|
||
+ strlen (f[XLFD_WEIGHT_INDEX])
|
||
+ strlen (f[XLFD_SLANT_INDEX])
|
||
+ strlen (f[XLFD_SWIDTH_INDEX])
|
||
+ strlen (f[XLFD_ADSTYLE_INDEX])
|
||
+ strlen (f[XLFD_PIXEL_INDEX])
|
||
+ strlen (f[XLFD_RESX_INDEX])
|
||
+ strlen (f[XLFD_SPACING_INDEX])
|
||
+ strlen (f[XLFD_AVGWIDTH_INDEX])
|
||
+ strlen (f[XLFD_REGISTRY_INDEX])
|
||
+ sizeof "-----------");
|
||
|
||
/* Return the XLFD. */
|
||
|
||
sprintf (name, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
|
||
f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
|
||
f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
|
||
f[XLFD_SWIDTH_INDEX], f[XLFD_ADSTYLE_INDEX],
|
||
f[XLFD_PIXEL_INDEX], f[XLFD_RESX_INDEX],
|
||
f[XLFD_SPACING_INDEX], f[XLFD_AVGWIDTH_INDEX],
|
||
f[XLFD_REGISTRY_INDEX]);
|
||
SAFE_FREE ();
|
||
return name;
|
||
}
|
||
|
||
/* Store XLFD 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. */
|
||
|
||
ptrdiff_t
|
||
font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes)
|
||
{
|
||
char *p;
|
||
const char *f[XLFD_REGISTRY_INDEX + 1];
|
||
Lisp_Object val;
|
||
int i, j, len;
|
||
|
||
eassert (FONTP (font));
|
||
|
||
for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX;
|
||
i++, j++)
|
||
{
|
||
if (i == FONT_ADSTYLE_INDEX)
|
||
j = XLFD_ADSTYLE_INDEX;
|
||
else if (i == FONT_REGISTRY_INDEX)
|
||
j = XLFD_REGISTRY_INDEX;
|
||
val = AREF (font, i);
|
||
if (NILP (val))
|
||
{
|
||
if (j == XLFD_REGISTRY_INDEX)
|
||
f[j] = "*-*";
|
||
else
|
||
f[j] = "*";
|
||
}
|
||
else
|
||
{
|
||
if (SYMBOLP (val))
|
||
val = SYMBOL_NAME (val);
|
||
if (j == XLFD_REGISTRY_INDEX
|
||
&& ! strchr (SSDATA (val), '-'))
|
||
{
|
||
/* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
|
||
ptrdiff_t alloc = SBYTES (val) + 4;
|
||
if (nbytes <= alloc)
|
||
return -1;
|
||
f[j] = p = alloca (alloc);
|
||
sprintf (p, "%s%s-*", SDATA (val),
|
||
&"*"[SDATA (val)[SBYTES (val) - 1] == '*']);
|
||
}
|
||
else
|
||
f[j] = SSDATA (val);
|
||
}
|
||
}
|
||
|
||
for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX;
|
||
i++, j++)
|
||
{
|
||
val = font_style_symbolic (font, i, 0);
|
||
if (NILP (val))
|
||
f[j] = "*";
|
||
else
|
||
{
|
||
int c, k, l;
|
||
ptrdiff_t alloc;
|
||
|
||
val = SYMBOL_NAME (val);
|
||
alloc = SBYTES (val) + 1;
|
||
if (nbytes <= alloc)
|
||
return -1;
|
||
f[j] = p = alloca (alloc);
|
||
/* Copy the name while excluding '-', '?', ',', and '"'. */
|
||
for (k = l = 0; k < alloc; k++)
|
||
{
|
||
c = SREF (val, k);
|
||
if (c != '-' && c != '?' && c != ',' && c != '"')
|
||
p[l++] = c;
|
||
}
|
||
}
|
||
}
|
||
|
||
val = AREF (font, FONT_SIZE_INDEX);
|
||
eassert (NUMBERP (val) || NILP (val));
|
||
char font_size_index_buf[sizeof "-*"
|
||
+ max (INT_STRLEN_BOUND (EMACS_INT),
|
||
1 + DBL_MAX_10_EXP + 1)];
|
||
if (INTEGERP (val))
|
||
{
|
||
intmax_t v;
|
||
if (! (integer_to_intmax (val, &v) && 0 < v))
|
||
v = pixel_size;
|
||
if (v > 0)
|
||
{
|
||
f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
|
||
sprintf (p, "%"PRIdMAX"-*", v);
|
||
}
|
||
else
|
||
f[XLFD_PIXEL_INDEX] = "*-*";
|
||
}
|
||
else if (FLOATP (val))
|
||
{
|
||
double v = XFLOAT_DATA (val) * 10;
|
||
f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
|
||
sprintf (p, "*-%.0f", v);
|
||
}
|
||
else
|
||
f[XLFD_PIXEL_INDEX] = "*-*";
|
||
|
||
char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)];
|
||
if (FIXNUMP (AREF (font, FONT_DPI_INDEX)))
|
||
{
|
||
EMACS_INT v = XFIXNUM (AREF (font, FONT_DPI_INDEX));
|
||
f[XLFD_RESX_INDEX] = p = dpi_index_buf;
|
||
sprintf (p, "%"pI"d-%"pI"d", v, v);
|
||
}
|
||
else
|
||
f[XLFD_RESX_INDEX] = "*-*";
|
||
|
||
if (FIXNUMP (AREF (font, FONT_SPACING_INDEX)))
|
||
{
|
||
EMACS_INT spacing = XFIXNUM (AREF (font, FONT_SPACING_INDEX));
|
||
|
||
f[XLFD_SPACING_INDEX] = (spacing <= FONT_SPACING_PROPORTIONAL ? "p"
|
||
: spacing <= FONT_SPACING_DUAL ? "d"
|
||
: spacing <= FONT_SPACING_MONO ? "m"
|
||
: "c");
|
||
}
|
||
else
|
||
f[XLFD_SPACING_INDEX] = "*";
|
||
|
||
char avgwidth_index_buf[INT_BUFSIZE_BOUND (EMACS_INT)];
|
||
if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX)))
|
||
{
|
||
f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf;
|
||
sprintf (p, "%"pI"d", XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX)));
|
||
}
|
||
else
|
||
f[XLFD_AVGWIDTH_INDEX] = "*";
|
||
|
||
len = snprintf (name, nbytes, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
|
||
f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
|
||
f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
|
||
f[XLFD_SWIDTH_INDEX], f[XLFD_ADSTYLE_INDEX],
|
||
f[XLFD_PIXEL_INDEX], f[XLFD_RESX_INDEX],
|
||
f[XLFD_SPACING_INDEX], f[XLFD_AVGWIDTH_INDEX],
|
||
f[XLFD_REGISTRY_INDEX]);
|
||
return len < nbytes ? len : -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. */
|
||
|
||
static int
|
||
font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font)
|
||
{
|
||
char *p, *q;
|
||
char *size_beg = NULL, *size_end = NULL;
|
||
char *props_beg = NULL, *family_end = NULL;
|
||
|
||
if (len == 0)
|
||
return -1;
|
||
|
||
for (p = name; *p; p++)
|
||
{
|
||
if (*p == '\\' && p[1])
|
||
p++;
|
||
else if (*p == ':')
|
||
{
|
||
props_beg = family_end = p;
|
||
break;
|
||
}
|
||
else if (*p == '-')
|
||
{
|
||
bool decimal = 0, size_found = 1;
|
||
for (q = p + 1; *q && *q != ':'; q++)
|
||
if (! c_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;
|
||
}
|
||
}
|
||
}
|
||
|
||
if (family_end)
|
||
{
|
||
Lisp_Object extra_props = Qnil;
|
||
|
||
/* A fontconfig name with size and/or property data. */
|
||
if (family_end > name)
|
||
{
|
||
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));
|
||
if (*size_end == ':' && size_end[1])
|
||
props_beg = size_end;
|
||
}
|
||
if (props_beg)
|
||
{
|
||
/* Now parse ":KEY=VAL" patterns. */
|
||
Lisp_Object val;
|
||
|
||
for (p = props_beg; *p; p = q)
|
||
{
|
||
for (q = p + 1; *q && *q != '=' && *q != ':'; q++);
|
||
if (*q != '=')
|
||
{
|
||
/* Must be an enumerated value. */
|
||
ptrdiff_t word_len;
|
||
p = p + 1;
|
||
word_len = q - p;
|
||
val = font_intern_prop (p, q - p, 1);
|
||
|
||
#define PROP_MATCH(STR) (word_len == strlen (STR) \
|
||
&& memcmp (p, STR, strlen (STR)) == 0)
|
||
|
||
if (PROP_MATCH ("thin")
|
||
|| PROP_MATCH ("ultra-light")
|
||
|| PROP_MATCH ("light")
|
||
|| PROP_MATCH ("semi-light")
|
||
|| PROP_MATCH ("book")
|
||
|| PROP_MATCH ("medium")
|
||
|| PROP_MATCH ("normal")
|
||
|| PROP_MATCH ("semibold")
|
||
|| PROP_MATCH ("demibold")
|
||
|| PROP_MATCH ("bold")
|
||
|| PROP_MATCH ("ultra-bold")
|
||
|| PROP_MATCH ("black")
|
||
|| PROP_MATCH ("heavy")
|
||
|| PROP_MATCH ("ultra-heavy"))
|
||
FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, val);
|
||
else if (PROP_MATCH ("roman")
|
||
|| PROP_MATCH ("italic")
|
||
|| PROP_MATCH ("oblique"))
|
||
FONT_SET_STYLE (font, FONT_SLANT_INDEX, val);
|
||
else if (PROP_MATCH ("charcell"))
|
||
ASET (font, FONT_SPACING_INDEX,
|
||
make_fixnum (FONT_SPACING_CHARCELL));
|
||
else if (PROP_MATCH ("mono"))
|
||
ASET (font, FONT_SPACING_INDEX,
|
||
make_fixnum (FONT_SPACING_MONO));
|
||
else if (PROP_MATCH ("proportional"))
|
||
ASET (font, FONT_SPACING_INDEX,
|
||
make_fixnum (FONT_SPACING_PROPORTIONAL));
|
||
#undef PROP_MATCH
|
||
}
|
||
else
|
||
{
|
||
/* KEY=VAL pairs */
|
||
Lisp_Object key UNINIT;
|
||
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);
|
||
|
||
if (prop >= FONT_FOUNDRY_INDEX
|
||
&& prop < FONT_EXTRA_INDEX)
|
||
ASET (font, prop, font_prop_validate (prop, Qnil, val));
|
||
else
|
||
{
|
||
extra_props = nconc2 (extra_props,
|
||
list1 (Fcons (key, val)));
|
||
}
|
||
}
|
||
p = q;
|
||
}
|
||
}
|
||
|
||
if (! NILP (extra_props))
|
||
{
|
||
struct font_driver_list *driver_list = font_driver_list;
|
||
for ( ; driver_list; driver_list = driver_list->next)
|
||
if (driver_list->driver->filter_properties)
|
||
(*driver_list->driver->filter_properties) (font, extra_props);
|
||
}
|
||
|
||
}
|
||
else
|
||
{
|
||
/* Either a fontconfig-style name with no size and property
|
||
data, or a GTK-style name. */
|
||
Lisp_Object weight = Qnil, slant = Qnil;
|
||
Lisp_Object width = Qnil, size = Qnil;
|
||
char *word_start;
|
||
ptrdiff_t word_len;
|
||
|
||
/* Scan backwards from the end, looking for a size. */
|
||
for (p = name + len - 1; p >= name; p--)
|
||
if (!c_isdigit (*p))
|
||
break;
|
||
|
||
if ((p < name + len - 1) && ((p + 1 == name) || *p == ' '))
|
||
/* Found a font size. */
|
||
size = make_float (strtod (p + 1, NULL));
|
||
else
|
||
p = name + len;
|
||
|
||
/* Now P points to the termination of the string, sans size.
|
||
Scan backwards, looking for font properties. */
|
||
for (; p > name; p = q)
|
||
{
|
||
for (q = p - 1; q >= name; q--)
|
||
{
|
||
if (q > name && *(q-1) == '\\')
|
||
--q; /* Skip quoting backslashes. */
|
||
else if (*q == ' ')
|
||
break;
|
||
}
|
||
|
||
word_start = q + 1;
|
||
word_len = p - word_start;
|
||
|
||
#define PROP_MATCH(STR) \
|
||
(word_len == strlen (STR) \
|
||
&& memcmp (word_start, STR, strlen (STR)) == 0)
|
||
#define PROP_SAVE(VAR, STR) \
|
||
(VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
|
||
|
||
if (PROP_MATCH ("Ultra-Light"))
|
||
PROP_SAVE (weight, "ultra-light");
|
||
else if (PROP_MATCH ("Light"))
|
||
PROP_SAVE (weight, "light");
|
||
else if (PROP_MATCH ("Book"))
|
||
PROP_SAVE (weight, "book");
|
||
else if (PROP_MATCH ("Medium"))
|
||
PROP_SAVE (weight, "medium");
|
||
else if (PROP_MATCH ("Semi-Bold"))
|
||
PROP_SAVE (weight, "semi-bold");
|
||
else if (PROP_MATCH ("Bold"))
|
||
PROP_SAVE (weight, "bold");
|
||
else if (PROP_MATCH ("Italic"))
|
||
PROP_SAVE (slant, "italic");
|
||
else if (PROP_MATCH ("Oblique"))
|
||
PROP_SAVE (slant, "oblique");
|
||
else if (PROP_MATCH ("Semi-Condensed"))
|
||
PROP_SAVE (width, "semi-condensed");
|
||
else if (PROP_MATCH ("Condensed"))
|
||
PROP_SAVE (width, "condensed");
|
||
/* An unknown word must be part of the font name. */
|
||
else
|
||
{
|
||
family_end = p;
|
||
break;
|
||
}
|
||
}
|
||
#undef PROP_MATCH
|
||
#undef PROP_SAVE
|
||
|
||
if (family_end)
|
||
ASET (font, FONT_FAMILY_INDEX,
|
||
font_intern_prop (name, family_end - name, 1));
|
||
if (!NILP (size))
|
||
ASET (font, FONT_SIZE_INDEX, size);
|
||
if (!NILP (weight))
|
||
FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, weight);
|
||
if (!NILP (slant))
|
||
FONT_SET_STYLE (font, FONT_SLANT_INDEX, slant);
|
||
if (!NILP (width))
|
||
FONT_SET_STYLE (font, FONT_WIDTH_INDEX, width);
|
||
}
|
||
|
||
return 0;
|
||
}
|
||
|
||
#if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
|
||
|
||
/* Store fontconfig's font name of FONT (font-spec or font-entity) in
|
||
NAME (NBYTES length), and return the name length. If
|
||
FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
|
||
Return a negative value on error. */
|
||
|
||
static int
|
||
font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes)
|
||
{
|
||
Lisp_Object family, foundry;
|
||
Lisp_Object val;
|
||
int point_size;
|
||
int i;
|
||
char *p;
|
||
char *lim;
|
||
Lisp_Object styles[3];
|
||
const char *style_names[3] = { "weight", "slant", "width" };
|
||
|
||
family = AREF (font, FONT_FAMILY_INDEX);
|
||
if (! NILP (family))
|
||
{
|
||
if (SYMBOLP (family))
|
||
family = SYMBOL_NAME (family);
|
||
else
|
||
family = Qnil;
|
||
}
|
||
|
||
val = AREF (font, FONT_SIZE_INDEX);
|
||
if (FIXNUMP (val))
|
||
{
|
||
if (XFIXNUM (val) != 0)
|
||
pixel_size = XFIXNUM (val);
|
||
point_size = -1;
|
||
}
|
||
else
|
||
{
|
||
eassert (FLOATP (val));
|
||
pixel_size = -1;
|
||
point_size = (int) XFLOAT_DATA (val);
|
||
}
|
||
|
||
foundry = AREF (font, FONT_FOUNDRY_INDEX);
|
||
if (! NILP (foundry))
|
||
{
|
||
if (SYMBOLP (foundry))
|
||
foundry = SYMBOL_NAME (foundry);
|
||
else
|
||
foundry = Qnil;
|
||
}
|
||
|
||
for (i = 0; i < 3; i++)
|
||
styles[i] = font_style_symbolic (font, FONT_WEIGHT_INDEX + i, 0);
|
||
|
||
p = name;
|
||
lim = name + nbytes;
|
||
if (! NILP (family))
|
||
{
|
||
int len = snprintf (p, lim - p, "%s", SSDATA (family));
|
||
if (! (0 <= len && len < lim - p))
|
||
return -1;
|
||
p += len;
|
||
}
|
||
if (point_size > 0)
|
||
{
|
||
int len = snprintf (p, lim - p, &"-%d"[p == name], point_size);
|
||
if (! (0 <= len && len < lim - p))
|
||
return -1;
|
||
p += len;
|
||
}
|
||
else if (pixel_size > 0)
|
||
{
|
||
int len = snprintf (p, lim - p, ":pixelsize=%d", pixel_size);
|
||
if (! (0 <= len && len < lim - p))
|
||
return -1;
|
||
p += len;
|
||
}
|
||
if (! NILP (AREF (font, FONT_FOUNDRY_INDEX)))
|
||
{
|
||
int len = snprintf (p, lim - p, ":foundry=%s",
|
||
SSDATA (SYMBOL_NAME (AREF (font,
|
||
FONT_FOUNDRY_INDEX))));
|
||
if (! (0 <= len && len < lim - p))
|
||
return -1;
|
||
p += len;
|
||
}
|
||
for (i = 0; i < 3; i++)
|
||
if (! NILP (styles[i]))
|
||
{
|
||
int len = snprintf (p, lim - p, ":%s=%s", style_names[i],
|
||
SSDATA (SYMBOL_NAME (styles[i])));
|
||
if (! (0 <= len && len < lim - p))
|
||
return -1;
|
||
p += len;
|
||
}
|
||
|
||
if (FIXNUMP (AREF (font, FONT_DPI_INDEX)))
|
||
{
|
||
int len = snprintf (p, lim - p, ":dpi=%"pI"d",
|
||
XFIXNUM (AREF (font, FONT_DPI_INDEX)));
|
||
if (! (0 <= len && len < lim - p))
|
||
return -1;
|
||
p += len;
|
||
}
|
||
|
||
if (FIXNUMP (AREF (font, FONT_SPACING_INDEX)))
|
||
{
|
||
int len = snprintf (p, lim - p, ":spacing=%"pI"d",
|
||
XFIXNUM (AREF (font, FONT_SPACING_INDEX)));
|
||
if (! (0 <= len && len < lim - p))
|
||
return -1;
|
||
p += len;
|
||
}
|
||
|
||
if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX)))
|
||
{
|
||
int len = snprintf (p, lim - p,
|
||
(XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX)) == 0
|
||
? ":scalable=true"
|
||
: ":scalable=false"));
|
||
if (! (0 <= len && len < lim - p))
|
||
return -1;
|
||
p += len;
|
||
}
|
||
|
||
return (p - name);
|
||
}
|
||
|
||
#endif
|
||
|
||
/* Parse NAME (null terminated) and store information in FONT
|
||
(font-spec or font-entity). If NAME is successfully parsed, return
|
||
0. Otherwise return -1. */
|
||
|
||
static int
|
||
font_parse_name (char *name, ptrdiff_t namelen, Lisp_Object font)
|
||
{
|
||
if (name[0] == '-' || strchr (name, '*') || strchr (name, '?'))
|
||
return font_parse_xlfd (name, namelen, font);
|
||
return font_parse_fcname (name, namelen, font);
|
||
}
|
||
|
||
|
||
/* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
|
||
"FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
|
||
part. */
|
||
|
||
void
|
||
font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Object font_spec)
|
||
{
|
||
ptrdiff_t len;
|
||
char *p0, *p1;
|
||
|
||
if (! NILP (family)
|
||
&& NILP (AREF (font_spec, FONT_FAMILY_INDEX)))
|
||
{
|
||
CHECK_STRING (family);
|
||
len = SBYTES (family);
|
||
p0 = SSDATA (family);
|
||
p1 = strchr (p0, '-');
|
||
if (p1)
|
||
{
|
||
if ((*p0 != '*' && p1 - p0 > 0)
|
||
&& NILP (AREF (font_spec, FONT_FOUNDRY_INDEX)))
|
||
Ffont_put (font_spec, QCfoundry, font_intern_prop (p0, p1 - p0, 1));
|
||
p1++;
|
||
len -= p1 - p0;
|
||
Ffont_put (font_spec, QCfamily, font_intern_prop (p1, len, 1));
|
||
}
|
||
else
|
||
ASET (font_spec, FONT_FAMILY_INDEX, Fintern (family, Qnil));
|
||
}
|
||
if (! NILP (registry))
|
||
{
|
||
/* Convert "XXX" and "XXX*" to "XXX*-*". */
|
||
CHECK_STRING (registry);
|
||
len = SBYTES (registry);
|
||
p0 = SSDATA (registry);
|
||
p1 = strchr (p0, '-');
|
||
if (! p1)
|
||
{
|
||
bool asterisk = len && p0[len - 1] == '*';
|
||
AUTO_STRING_WITH_LEN (extra, &"*-*"[asterisk], 3 - asterisk);
|
||
registry = concat2 (registry, extra);
|
||
}
|
||
registry = Fdowncase (registry);
|
||
ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil));
|
||
}
|
||
}
|
||
|
||
|
||
/* Font sorting. */
|
||
|
||
static double
|
||
font_rescale_ratio (Lisp_Object font_entity)
|
||
{
|
||
Lisp_Object tail, elt;
|
||
Lisp_Object name = Qnil;
|
||
|
||
for (tail = Vface_font_rescale_alist; CONSP (tail); tail = XCDR (tail))
|
||
{
|
||
elt = XCAR (tail);
|
||
if (FLOATP (XCDR (elt)))
|
||
{
|
||
if (STRINGP (XCAR (elt)))
|
||
{
|
||
if (NILP (name))
|
||
name = Ffont_xlfd_name (font_entity, Qnil, Qt);
|
||
|
||
/* N.B. that `name' is set to nil if the resulting XLFD
|
||
is too long. */
|
||
if (!NILP (name)
|
||
&& fast_string_match_ignore_case (XCAR (elt), name) >= 0)
|
||
return XFLOAT_DATA (XCDR (elt));
|
||
}
|
||
else if (FONT_SPEC_P (XCAR (elt)))
|
||
{
|
||
if (font_match_p (XCAR (elt), font_entity))
|
||
return XFLOAT_DATA (XCDR (elt));
|
||
}
|
||
}
|
||
}
|
||
return 1.0;
|
||
}
|
||
|
||
/* 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 lowest 2 bits of the score are used for driver type. The font
|
||
available by the most preferred font driver is 0.
|
||
|
||
The 4 7-bit fields 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
|
||
property in a score. Note that floats for FONT_TYPE_INDEX and
|
||
FONT_REGISTRY_INDEX are not used. */
|
||
static int sort_shift_bits[FONT_SIZE_INDEX + 1];
|
||
|
||
/* 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 (Lisp_Object entity, Lisp_Object *spec_prop)
|
||
{
|
||
unsigned score = 0;
|
||
int 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])
|
||
&& FIXNUMP (AREF (entity, i)))
|
||
{
|
||
EMACS_INT diff = ((XFIXNUM (AREF (entity, i)) >> 8)
|
||
- (XFIXNUM (spec_prop[i]) >> 8));
|
||
score |= min (eabs (diff), 127) << sort_shift_bits[i];
|
||
}
|
||
|
||
/* Score the size. Maximum difference is 127. */
|
||
if (! NILP (spec_prop[FONT_SIZE_INDEX])
|
||
&& XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0)
|
||
{
|
||
/* We use the higher 6-bit for the actual size difference. The
|
||
lowest bit is set if the DPI is different. */
|
||
EMACS_INT diff;
|
||
EMACS_INT pixel_size = XFIXNUM (spec_prop[FONT_SIZE_INDEX]);
|
||
EMACS_INT entity_size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX));
|
||
|
||
if (CONSP (Vface_font_rescale_alist))
|
||
pixel_size *= font_rescale_ratio (entity);
|
||
if (pixel_size * 2 < entity_size || entity_size * 2 < pixel_size)
|
||
/* This size is wrong by more than a factor 2: reject it! */
|
||
return 0xFFFFFFFF;
|
||
diff = eabs (pixel_size - entity_size) << 1;
|
||
if (! NILP (spec_prop[FONT_DPI_INDEX])
|
||
&& ! EQ (spec_prop[FONT_DPI_INDEX], AREF (entity, FONT_DPI_INDEX)))
|
||
diff |= 1;
|
||
if (! NILP (spec_prop[FONT_AVGWIDTH_INDEX])
|
||
&& ! EQ (spec_prop[FONT_AVGWIDTH_INDEX], AREF (entity, FONT_AVGWIDTH_INDEX)))
|
||
diff |= 1;
|
||
score |= min (diff, 127) << sort_shift_bits[FONT_SIZE_INDEX];
|
||
}
|
||
|
||
return score;
|
||
}
|
||
|
||
|
||
/* Concatenate all elements of LIST into one vector. LIST is a list
|
||
of font-entity vectors. */
|
||
|
||
static Lisp_Object
|
||
font_vconcat_entity_vectors (Lisp_Object list)
|
||
{
|
||
ptrdiff_t nargs = list_length (list);
|
||
Lisp_Object *args;
|
||
USE_SAFE_ALLOCA;
|
||
SAFE_ALLOCA_LISP (args, nargs);
|
||
|
||
for (ptrdiff_t i = 0; i < nargs; i++, list = XCDR (list))
|
||
args[i] = XCAR (list);
|
||
Lisp_Object result = Fvconcat (nargs, args);
|
||
SAFE_FREE ();
|
||
return result;
|
||
}
|
||
|
||
|
||
/* The structure for elements being sorted by qsort. */
|
||
struct font_sort_data
|
||
{
|
||
unsigned score;
|
||
int font_driver_preference;
|
||
Lisp_Object entity;
|
||
};
|
||
|
||
|
||
/* The comparison function for qsort. */
|
||
|
||
static int
|
||
font_compare (const void *d1, const void *d2)
|
||
{
|
||
const struct font_sort_data *data1 = d1;
|
||
const struct font_sort_data *data2 = d2;
|
||
|
||
if (data1->score < data2->score)
|
||
return -1;
|
||
else if (data1->score > data2->score)
|
||
return 1;
|
||
return (data1->font_driver_preference - data2->font_driver_preference);
|
||
}
|
||
|
||
|
||
/* Sort each font-entity vector in LIST 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 BEST-ONLY is nonzero, return the best matching entity (that
|
||
supports the character BEST-ONLY if BEST-ONLY is positive, or any
|
||
if BEST-ONLY is negative). Otherwise, return the sorted result as
|
||
a single vector of font-entities.
|
||
|
||
This function does no optimization for the case that the total
|
||
number of elements is 1. The caller should avoid calling this in
|
||
such a case. */
|
||
|
||
static Lisp_Object
|
||
font_sort_entities (Lisp_Object list, Lisp_Object prefer,
|
||
struct frame *f, int best_only)
|
||
{
|
||
Lisp_Object prefer_prop[FONT_SPEC_MAX];
|
||
int len, maxlen, i;
|
||
struct font_sort_data *data;
|
||
unsigned best_score;
|
||
Lisp_Object best_entity;
|
||
Lisp_Object tail;
|
||
Lisp_Object vec UNINIT;
|
||
USE_SAFE_ALLOCA;
|
||
|
||
for (i = FONT_WEIGHT_INDEX; i <= FONT_AVGWIDTH_INDEX; i++)
|
||
prefer_prop[i] = AREF (prefer, i);
|
||
if (FLOATP (prefer_prop[FONT_SIZE_INDEX]))
|
||
prefer_prop[FONT_SIZE_INDEX]
|
||
= make_fixnum (font_pixel_size (f, prefer));
|
||
|
||
if (NILP (XCDR (list)))
|
||
{
|
||
/* What we have to take care of is this single vector. */
|
||
vec = XCAR (list);
|
||
maxlen = ASIZE (vec);
|
||
}
|
||
else if (best_only)
|
||
{
|
||
/* We don't have to perform sort, so there's no need of creating
|
||
a single vector. But, we must find the length of the longest
|
||
vector. */
|
||
maxlen = 0;
|
||
for (tail = list; CONSP (tail); tail = XCDR (tail))
|
||
if (maxlen < ASIZE (XCAR (tail)))
|
||
maxlen = ASIZE (XCAR (tail));
|
||
}
|
||
else
|
||
{
|
||
/* We have to create a single vector to sort it. */
|
||
vec = font_vconcat_entity_vectors (list);
|
||
maxlen = ASIZE (vec);
|
||
}
|
||
|
||
data = SAFE_ALLOCA (maxlen * sizeof *data);
|
||
best_score = 0xFFFFFFFF;
|
||
best_entity = Qnil;
|
||
|
||
for (tail = list; CONSP (tail); tail = XCDR (tail))
|
||
{
|
||
int font_driver_preference = 0;
|
||
Lisp_Object current_font_driver;
|
||
|
||
if (best_only)
|
||
vec = XCAR (tail);
|
||
len = ASIZE (vec);
|
||
|
||
/* We are sure that the length of VEC > 0. */
|
||
current_font_driver = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
|
||
/* Score the elements. */
|
||
for (i = 0; i < len; i++)
|
||
{
|
||
data[i].entity = AREF (vec, i);
|
||
data[i].score
|
||
= ((best_only <= 0 || font_has_char (f, data[i].entity, best_only)
|
||
> 0)
|
||
? font_score (data[i].entity, prefer_prop)
|
||
: 0xFFFFFFFF);
|
||
if (best_only && best_score > data[i].score)
|
||
{
|
||
best_score = data[i].score;
|
||
best_entity = data[i].entity;
|
||
if (best_score == 0)
|
||
break;
|
||
}
|
||
if (! EQ (current_font_driver, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
|
||
{
|
||
current_font_driver = AREF (AREF (vec, i), FONT_TYPE_INDEX);
|
||
font_driver_preference++;
|
||
}
|
||
data[i].font_driver_preference = font_driver_preference;
|
||
}
|
||
|
||
/* Sort if necessary. */
|
||
if (! best_only)
|
||
{
|
||
qsort (data, len, sizeof *data, font_compare);
|
||
for (i = 0; i < len; i++)
|
||
ASET (vec, i, data[i].entity);
|
||
break;
|
||
}
|
||
else
|
||
vec = best_entity;
|
||
}
|
||
|
||
SAFE_FREE ();
|
||
|
||
FONT_ADD_LOG ("sort-by", prefer, vec);
|
||
return vec;
|
||
}
|
||
|
||
|
||
/* 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 (int *order)
|
||
{
|
||
int i, shift_bits;
|
||
|
||
for (i = 0, shift_bits = 23; i < 4; i++, shift_bits -= 7)
|
||
{
|
||
int xlfd_idx = order[i];
|
||
|
||
if (xlfd_idx == XLFD_WEIGHT_INDEX)
|
||
sort_shift_bits[FONT_WEIGHT_INDEX] = shift_bits;
|
||
else if (xlfd_idx == XLFD_SLANT_INDEX)
|
||
sort_shift_bits[FONT_SLANT_INDEX] = shift_bits;
|
||
else if (xlfd_idx == XLFD_SWIDTH_INDEX)
|
||
sort_shift_bits[FONT_WIDTH_INDEX] = shift_bits;
|
||
else
|
||
sort_shift_bits[FONT_SIZE_INDEX] = shift_bits;
|
||
}
|
||
}
|
||
|
||
static bool
|
||
font_check_otf_features (Lisp_Object script, Lisp_Object langsys,
|
||
Lisp_Object features, Lisp_Object table)
|
||
{
|
||
Lisp_Object val;
|
||
bool 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;
|
||
continue;
|
||
}
|
||
if (NILP (Fmemq (XCAR (features), table)) != negative)
|
||
return 0;
|
||
}
|
||
return 1;
|
||
}
|
||
|
||
/* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
|
||
|
||
static bool
|
||
font_check_otf (Lisp_Object spec, Lisp_Object otf_capability)
|
||
{
|
||
Lisp_Object script, langsys = Qnil, gsub = Qnil, gpos = Qnil;
|
||
|
||
script = XCAR (spec);
|
||
spec = XCDR (spec);
|
||
if (! NILP (spec))
|
||
{
|
||
langsys = XCAR (spec);
|
||
spec = XCDR (spec);
|
||
if (! NILP (spec))
|
||
{
|
||
gsub = XCAR (spec);
|
||
spec = XCDR (spec);
|
||
if (! NILP (spec))
|
||
gpos = XCAR (spec);
|
||
}
|
||
}
|
||
|
||
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 if FONT (font-entity or font-object) matches with the font
|
||
specification SPEC. */
|
||
|
||
bool
|
||
font_match_p (Lisp_Object spec, Lisp_Object font)
|
||
{
|
||
Lisp_Object prop[FONT_SPEC_MAX], *props;
|
||
Lisp_Object extra, font_extra;
|
||
int i;
|
||
|
||
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]))
|
||
{
|
||
for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++)
|
||
prop[i] = AREF (spec, i);
|
||
prop[FONT_SIZE_INDEX]
|
||
= make_fixnum (font_pixel_size (XFRAME (selected_frame), spec));
|
||
props = prop;
|
||
}
|
||
|
||
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 (CONSP (val2))
|
||
{
|
||
val2 = XCDR (val2);
|
||
if (CONSP (val2))
|
||
{
|
||
/* All characters in the list must be supported. */
|
||
for (; CONSP (val2); val2 = XCDR (val2))
|
||
{
|
||
if (! CHARACTERP (XCAR (val2)))
|
||
continue;
|
||
if (font_encode_char (font, XFIXNAT (XCAR (val2)))
|
||
== FONT_INVALID_CODE)
|
||
return 0;
|
||
}
|
||
}
|
||
else if (VECTORP (val2))
|
||
{
|
||
/* At most one character in the vector must be supported. */
|
||
for (i = 0; i < ASIZE (val2); i++)
|
||
{
|
||
if (! CHARACTERP (AREF (val2, i)))
|
||
continue;
|
||
if (font_encode_char (font, XFIXNAT (AREF (val2, i)))
|
||
!= FONT_INVALID_CODE)
|
||
break;
|
||
}
|
||
if (i == ASIZE (val2))
|
||
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;
|
||
}
|
||
|
||
|
||
/* Font cache
|
||
|
||
Each font backend has the callback function get_cache, and it
|
||
returns a cons cell of which cdr part can be freely used for
|
||
caching fonts. The cons cell may be shared by multiple frames
|
||
and/or multiple font drivers. So, we arrange the cdr part as this:
|
||
|
||
((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
|
||
|
||
where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
|
||
is a number frames sharing this cache, and FONT-CACHE-DATA is a
|
||
cons (FONT-SPEC . [FONT-ENTITY ...]). */
|
||
|
||
static void font_clear_cache (struct frame *, Lisp_Object,
|
||
struct font_driver const *);
|
||
|
||
static void
|
||
font_prepare_cache (struct frame *f, struct font_driver const *driver)
|
||
{
|
||
Lisp_Object cache, val;
|
||
|
||
cache = driver->get_cache (f);
|
||
val = XCDR (cache);
|
||
while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
|
||
val = XCDR (val);
|
||
if (NILP (val))
|
||
{
|
||
val = list2 (driver->type, make_fixnum (1));
|
||
XSETCDR (cache, Fcons (val, XCDR (cache)));
|
||
}
|
||
else
|
||
{
|
||
val = XCDR (XCAR (val));
|
||
XSETCAR (val, make_fixnum (XFIXNUM (XCAR (val)) + 1));
|
||
}
|
||
}
|
||
|
||
|
||
static void
|
||
font_finish_cache (struct frame *f, struct font_driver const *driver)
|
||
{
|
||
Lisp_Object cache, val, tmp;
|
||
|
||
|
||
cache = driver->get_cache (f);
|
||
val = XCDR (cache);
|
||
while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type))
|
||
cache = val, val = XCDR (val);
|
||
eassert (! NILP (val));
|
||
tmp = XCDR (XCAR (val));
|
||
XSETCAR (tmp, make_fixnum (XFIXNUM (XCAR (tmp)) - 1));
|
||
if (XFIXNUM (XCAR (tmp)) == 0)
|
||
{
|
||
font_clear_cache (f, XCAR (val), driver);
|
||
XSETCDR (cache, XCDR (val));
|
||
}
|
||
}
|
||
|
||
|
||
static Lisp_Object
|
||
font_get_cache (struct frame *f, struct font_driver const *driver)
|
||
{
|
||
Lisp_Object val = driver->get_cache (f);
|
||
Lisp_Object type = driver->type;
|
||
|
||
eassert (CONSP (val));
|
||
for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val));
|
||
eassert (CONSP (val));
|
||
/* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
|
||
val = XCDR (XCAR (val));
|
||
return val;
|
||
}
|
||
|
||
|
||
static void
|
||
font_clear_cache (struct frame *f, Lisp_Object cache,
|
||
struct font_driver const *driver)
|
||
{
|
||
Lisp_Object tail, elt;
|
||
Lisp_Object entity;
|
||
ptrdiff_t i;
|
||
|
||
/* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
|
||
for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
|
||
{
|
||
elt = XCAR (tail);
|
||
/* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
|
||
if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
|
||
{
|
||
elt = XCDR (elt);
|
||
eassert (VECTORP (elt));
|
||
for (i = 0; i < ASIZE (elt); i++)
|
||
{
|
||
entity = AREF (elt, i);
|
||
|
||
if (FONT_ENTITY_P (entity)
|
||
&& EQ (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 font *font = XFONT_OBJECT (val);
|
||
|
||
if (! NILP (AREF (val, FONT_TYPE_INDEX)))
|
||
{
|
||
eassert (font && driver == font->driver);
|
||
/* We are going to close the font, so make
|
||
sure we don't have any lgstrings lying
|
||
around in lgstring cache that reference
|
||
the font. */
|
||
composition_gstring_cache_clear_font (val);
|
||
driver->close_font (font);
|
||
}
|
||
}
|
||
if (driver->free_entity)
|
||
driver->free_entity (entity);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
XSETCDR (cache, Qnil);
|
||
}
|
||
|
||
|
||
/* Check whether NAME should be ignored based on Vface_ignored_fonts.
|
||
This is reused by xg_font_filter to apply the same checks to the
|
||
GTK font chooser. */
|
||
|
||
bool
|
||
font_is_ignored (const char *name, ptrdiff_t namelen)
|
||
{
|
||
Lisp_Object tail = Vface_ignored_fonts;
|
||
Lisp_Object regexp;
|
||
|
||
FOR_EACH_TAIL_SAFE (tail)
|
||
{
|
||
regexp = XCAR (tail);
|
||
if (STRINGP (regexp)
|
||
&& fast_c_string_match_ignore_case (regexp, name,
|
||
namelen) >= 0)
|
||
return true;
|
||
}
|
||
return false;
|
||
}
|
||
static Lisp_Object scratch_font_spec, scratch_font_prefer;
|
||
|
||
/* Check each font-entity in VEC, and return a list of font-entities
|
||
that satisfy these conditions:
|
||
(1) matches with SPEC and SIZE if SPEC is not nil, and
|
||
(2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
|
||
*/
|
||
|
||
static Lisp_Object
|
||
font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size)
|
||
{
|
||
Lisp_Object entity, val;
|
||
enum font_property_index prop;
|
||
ptrdiff_t i;
|
||
|
||
for (val = Qnil, i = ASIZE (vec) - 1; i >= 0; i--)
|
||
{
|
||
entity = AREF (vec, i);
|
||
if (! NILP (Vface_ignored_fonts))
|
||
{
|
||
char name[256], *xlfd;
|
||
ptrdiff_t namelen;
|
||
namelen = font_unparse_xlfd (entity, 0, name, 256);
|
||
|
||
if (namelen >= 0)
|
||
{
|
||
if (font_is_ignored (name, namelen))
|
||
continue;
|
||
}
|
||
else
|
||
{
|
||
/* The font family or foundry is too long for a 256
|
||
character xlfd to accommodate. */
|
||
|
||
xlfd = font_dynamic_unparse_xlfd (entity, 0);
|
||
|
||
if (xlfd && font_is_ignored (xlfd, sizeof (xlfd)))
|
||
{
|
||
xfree (xlfd);
|
||
continue;
|
||
}
|
||
|
||
xfree (xlfd);
|
||
}
|
||
}
|
||
if (NILP (spec))
|
||
{
|
||
val = Fcons (entity, val);
|
||
continue;
|
||
}
|
||
for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
|
||
{
|
||
if (FIXNUMP (AREF (spec, prop)))
|
||
{
|
||
if (!FIXNUMP (AREF (entity, prop)))
|
||
prop = FONT_SPEC_MAX;
|
||
else
|
||
{
|
||
int required = XFIXNUM (AREF (spec, prop)) >> 8;
|
||
int candidate = XFIXNUM (AREF (entity, prop)) >> 8;
|
||
|
||
if (candidate != required
|
||
#ifdef HAVE_NTGUI
|
||
/* A kludge for w32 font search, where listing a
|
||
family returns only 4 standard weights: regular,
|
||
italic, bold, bold-italic. For other values one
|
||
must specify the font, not just the family in the
|
||
:family attribute of the face. But specifying
|
||
:family in the face attributes looks for regular
|
||
weight, so if we require exact match, the
|
||
non-regular font will be rejected. So we relax
|
||
the accuracy of the match here, and let
|
||
font_sort_entities find the best match. */
|
||
&& (prop != FONT_WEIGHT_INDEX
|
||
|| eabs (candidate - required) > 100)
|
||
#endif
|
||
)
|
||
prop = FONT_SPEC_MAX;
|
||
}
|
||
}
|
||
}
|
||
if (prop < FONT_SPEC_MAX
|
||
&& size
|
||
&& XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0)
|
||
{
|
||
int diff = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) - size;
|
||
|
||
if (eabs (diff) > FONT_PIXEL_SIZE_QUANTUM)
|
||
prop = FONT_SPEC_MAX;
|
||
}
|
||
if (prop < FONT_SPEC_MAX
|
||
&& FIXNUMP (AREF (spec, FONT_DPI_INDEX))
|
||
&& FIXNUMP (AREF (entity, FONT_DPI_INDEX))
|
||
&& XFIXNUM (AREF (entity, FONT_DPI_INDEX)) != 0
|
||
&& ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX)))
|
||
prop = FONT_SPEC_MAX;
|
||
if (prop < FONT_SPEC_MAX
|
||
&& FIXNUMP (AREF (spec, FONT_AVGWIDTH_INDEX))
|
||
&& FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX))
|
||
&& XFIXNUM (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0
|
||
&& ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX),
|
||
AREF (entity, FONT_AVGWIDTH_INDEX)))
|
||
prop = FONT_SPEC_MAX;
|
||
if (prop < FONT_SPEC_MAX)
|
||
val = Fcons (entity, val);
|
||
}
|
||
return (Fvconcat (1, &val));
|
||
}
|
||
|
||
|
||
/* Return a list of vectors of font-entities matching with SPEC on
|
||
FRAME. Each elements in the list is a vector of entities from the
|
||
same font-driver. */
|
||
|
||
Lisp_Object
|
||
font_list_entities (struct frame *f, Lisp_Object spec)
|
||
{
|
||
struct font_driver_list *driver_list = f->font_driver_list;
|
||
Lisp_Object ftype, val;
|
||
Lisp_Object list = Qnil;
|
||
int size;
|
||
bool need_filtering = 0;
|
||
int i;
|
||
|
||
eassert (FONT_SPEC_P (spec));
|
||
|
||
if (FIXNUMP (AREF (spec, FONT_SIZE_INDEX)))
|
||
size = XFIXNUM (AREF (spec, FONT_SIZE_INDEX));
|
||
else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
|
||
size = font_pixel_size (f, spec);
|
||
else
|
||
size = 0;
|
||
|
||
ftype = AREF (spec, FONT_TYPE_INDEX);
|
||
for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++)
|
||
ASET (scratch_font_spec, i, AREF (spec, i));
|
||
for (i = FONT_WEIGHT_INDEX; i < FONT_EXTRA_INDEX; i++)
|
||
if (i != FONT_SPACING_INDEX)
|
||
{
|
||
ASET (scratch_font_spec, i, Qnil);
|
||
if (! NILP (AREF (spec, i)))
|
||
need_filtering = 1;
|
||
}
|
||
ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
|
||
ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
|
||
|
||
for (; driver_list; driver_list = driver_list->next)
|
||
if (driver_list->on
|
||
&& (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
|
||
{
|
||
Lisp_Object cache = font_get_cache (f, driver_list->driver);
|
||
|
||
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 copy;
|
||
|
||
val = (driver_list->driver->list) (f, scratch_font_spec);
|
||
/* We put zero_vector in the font-cache to indicate that
|
||
no fonts matching SPEC were found on the system.
|
||
Failure to have this indication in the font cache can
|
||
cause severe performance degradation in some rare
|
||
cases, see bug#21028. */
|
||
if (NILP (val))
|
||
val = zero_vector;
|
||
else
|
||
val = Fvconcat (1, &val);
|
||
copy = copy_font_spec (scratch_font_spec);
|
||
ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
|
||
XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
|
||
}
|
||
if (ASIZE (val) > 0
|
||
&& (need_filtering
|
||
|| ! NILP (Vface_ignored_fonts)))
|
||
val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size);
|
||
if (ASIZE (val) > 0)
|
||
{
|
||
list = Fcons (val, list);
|
||
/* Querying further backends can be very slow, so we only do
|
||
it if the user has explicitly requested it (Bug#43177). */
|
||
if (query_all_font_backends == false)
|
||
break;
|
||
}
|
||
}
|
||
|
||
list = Fnreverse (list);
|
||
FONT_ADD_LOG ("list", spec, list);
|
||
return list;
|
||
}
|
||
|
||
|
||
/* Return a font entity matching with SPEC on FRAME. ATTRS, if non
|
||
nil, is an array of face's attributes, which specifies preferred
|
||
font-related attributes. */
|
||
|
||
static Lisp_Object
|
||
font_matching_entity (struct frame *f, Lisp_Object *attrs, Lisp_Object spec)
|
||
{
|
||
struct font_driver_list *driver_list = f->font_driver_list;
|
||
Lisp_Object ftype, size, entity;
|
||
Lisp_Object work = copy_font_spec (spec);
|
||
|
||
ftype = AREF (spec, FONT_TYPE_INDEX);
|
||
size = AREF (spec, FONT_SIZE_INDEX);
|
||
|
||
if (FLOATP (size))
|
||
ASET (work, FONT_SIZE_INDEX, make_fixnum (font_pixel_size (f, spec)));
|
||
FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]);
|
||
FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]);
|
||
FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]);
|
||
|
||
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 = font_get_cache (f, driver_list->driver);
|
||
|
||
ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
|
||
entity = assoc_no_quit (work, XCDR (cache));
|
||
if (CONSP (entity))
|
||
entity = AREF (XCDR (entity), 0);
|
||
else
|
||
{
|
||
entity = driver_list->driver->match (f, work);
|
||
if (!NILP (entity))
|
||
{
|
||
Lisp_Object copy = copy_font_spec (work);
|
||
Lisp_Object match = Fvector (1, &entity);
|
||
|
||
ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
|
||
XSETCDR (cache, Fcons (Fcons (copy, match), XCDR (cache)));
|
||
}
|
||
}
|
||
if (! NILP (entity))
|
||
break;
|
||
}
|
||
FONT_ADD_LOG ("match", work, entity);
|
||
return entity;
|
||
}
|
||
|
||
|
||
/* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
|
||
opened font object. */
|
||
|
||
static Lisp_Object
|
||
font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size)
|
||
{
|
||
struct font_driver_list *driver_list;
|
||
Lisp_Object objlist, size, val, font_object;
|
||
struct font *font;
|
||
int height, psize;
|
||
|
||
eassert (FONT_ENTITY_P (entity));
|
||
size = AREF (entity, FONT_SIZE_INDEX);
|
||
if (XFIXNUM (size) != 0)
|
||
pixel_size = XFIXNUM (size);
|
||
|
||
val = AREF (entity, FONT_TYPE_INDEX);
|
||
for (driver_list = f->font_driver_list;
|
||
driver_list && ! EQ (driver_list->driver->type, val);
|
||
driver_list = driver_list->next);
|
||
if (! driver_list)
|
||
return Qnil;
|
||
|
||
for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
|
||
objlist = XCDR (objlist))
|
||
{
|
||
Lisp_Object fn = XCAR (objlist);
|
||
if (! NILP (AREF (fn, FONT_TYPE_INDEX))
|
||
&& XFONT_OBJECT (fn)->pixel_size == pixel_size)
|
||
{
|
||
if (driver_list->driver->cached_font_ok == NULL
|
||
|| driver_list->driver->cached_font_ok (f, fn, entity))
|
||
return fn;
|
||
}
|
||
}
|
||
|
||
/* We always open a font of manageable size; i.e non-zero average
|
||
width and height. */
|
||
for (psize = pixel_size; ; psize++)
|
||
{
|
||
font_object = driver_list->driver->open_font (f, entity, psize);
|
||
if (NILP (font_object))
|
||
return Qnil;
|
||
font = XFONT_OBJECT (font_object);
|
||
if (font->average_width > 0 && font->height > 0)
|
||
break;
|
||
/* Avoid an infinite loop. */
|
||
if (psize > pixel_size + 15)
|
||
return Qnil;
|
||
}
|
||
ASET (font_object, FONT_SIZE_INDEX, make_fixnum (pixel_size));
|
||
FONT_ADD_LOG ("open", entity, font_object);
|
||
ASET (entity, FONT_OBJLIST_INDEX,
|
||
Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX)));
|
||
|
||
font = XFONT_OBJECT (font_object);
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
int min_width = (font->min_width ? font->min_width
|
||
: font->average_width ? font->average_width
|
||
: font->space_width ? font->space_width
|
||
: 1);
|
||
#endif
|
||
|
||
int font_ascent, font_descent;
|
||
get_font_ascent_descent (font, &font_ascent, &font_descent);
|
||
height = font_ascent + font_descent;
|
||
if (height <= 0)
|
||
height = 1;
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
FRAME_DISPLAY_INFO (f)->n_fonts++;
|
||
if (FRAME_DISPLAY_INFO (f)->n_fonts == 1)
|
||
{
|
||
FRAME_SMALLEST_CHAR_WIDTH (f) = min_width;
|
||
FRAME_SMALLEST_FONT_HEIGHT (f) = height;
|
||
f->fonts_changed = 1;
|
||
}
|
||
else
|
||
{
|
||
if (FRAME_SMALLEST_CHAR_WIDTH (f) > min_width)
|
||
FRAME_SMALLEST_CHAR_WIDTH (f) = min_width, f->fonts_changed = 1;
|
||
if (FRAME_SMALLEST_FONT_HEIGHT (f) > height)
|
||
FRAME_SMALLEST_FONT_HEIGHT (f) = height, f->fonts_changed = 1;
|
||
}
|
||
#endif
|
||
|
||
return font_object;
|
||
}
|
||
|
||
|
||
/* Close FONT_OBJECT that is opened on frame F. */
|
||
|
||
static void
|
||
font_close_object (struct frame *f, Lisp_Object font_object)
|
||
{
|
||
struct font *font = XFONT_OBJECT (font_object);
|
||
|
||
if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
|
||
/* Already closed. */
|
||
return;
|
||
FONT_ADD_LOG ("close", font_object, Qnil);
|
||
font->driver->close_font (font);
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
eassert (FRAME_DISPLAY_INFO (f)->n_fonts);
|
||
FRAME_DISPLAY_INFO (f)->n_fonts--;
|
||
#endif
|
||
}
|
||
|
||
|
||
/* 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 (struct frame *f, Lisp_Object font, int c)
|
||
{
|
||
struct font *fontp;
|
||
|
||
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);
|
||
}
|
||
|
||
eassert (FONT_OBJECT_P (font));
|
||
fontp = XFONT_OBJECT (font);
|
||
if (fontp->driver->has_char)
|
||
{
|
||
int result = fontp->driver->has_char (font, 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. */
|
||
|
||
static unsigned
|
||
font_encode_char (Lisp_Object font_object, int c)
|
||
{
|
||
struct font *font;
|
||
|
||
eassert (FONT_OBJECT_P (font_object));
|
||
font = XFONT_OBJECT (font_object);
|
||
return font->driver->encode_char (font, c);
|
||
}
|
||
|
||
|
||
/* Return the name of FONT_OBJECT. */
|
||
|
||
Lisp_Object
|
||
font_get_name (Lisp_Object font_object)
|
||
{
|
||
eassert (FONT_OBJECT_P (font_object));
|
||
return AREF (font_object, FONT_NAME_INDEX);
|
||
}
|
||
|
||
|
||
/* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
|
||
could not be parsed by font_parse_name, return Qnil. */
|
||
|
||
Lisp_Object
|
||
font_spec_from_name (Lisp_Object font_name)
|
||
{
|
||
Lisp_Object spec = Ffont_spec (0, NULL);
|
||
|
||
CHECK_STRING (font_name);
|
||
if (font_parse_name (SSDATA (font_name), SBYTES (font_name), spec) == -1)
|
||
return Qnil;
|
||
font_put_extra (spec, QCname, font_name);
|
||
font_put_extra (spec, QCuser_spec, font_name);
|
||
return spec;
|
||
}
|
||
|
||
|
||
void
|
||
font_clear_prop (Lisp_Object *attrs, enum font_property_index prop)
|
||
{
|
||
Lisp_Object font = attrs[LFACE_FONT_INDEX];
|
||
|
||
if (! FONTP (font))
|
||
return;
|
||
|
||
if (! NILP (Ffont_get (font, QCname)))
|
||
{
|
||
font = copy_font_spec (font);
|
||
font_put_extra (font, QCname, Qunbound);
|
||
}
|
||
|
||
if (NILP (AREF (font, prop))
|
||
&& prop != FONT_FAMILY_INDEX
|
||
&& prop != FONT_FOUNDRY_INDEX
|
||
&& prop != FONT_WIDTH_INDEX
|
||
&& prop != FONT_SIZE_INDEX)
|
||
return;
|
||
if (EQ (font, attrs[LFACE_FONT_INDEX]))
|
||
font = copy_font_spec (font);
|
||
ASET (font, prop, Qnil);
|
||
if (prop == FONT_FAMILY_INDEX || prop == FONT_FOUNDRY_INDEX)
|
||
{
|
||
if (prop == FONT_FAMILY_INDEX)
|
||
{
|
||
ASET (font, FONT_FOUNDRY_INDEX, Qnil);
|
||
/* If we are setting the font family, we must also clear
|
||
FONT_WIDTH_INDEX to avoid rejecting families that lack
|
||
support for some widths. */
|
||
ASET (font, FONT_WIDTH_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);
|
||
ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
|
||
}
|
||
else if (prop == FONT_SIZE_INDEX)
|
||
{
|
||
ASET (font, FONT_DPI_INDEX, Qnil);
|
||
ASET (font, FONT_SPACING_INDEX, Qnil);
|
||
ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
|
||
}
|
||
else if (prop == FONT_WIDTH_INDEX)
|
||
ASET (font, FONT_AVGWIDTH_INDEX, Qnil);
|
||
attrs[LFACE_FONT_INDEX] = font;
|
||
}
|
||
|
||
/* Select a font from ENTITIES (list of one or more font-entity
|
||
vectors) that supports the character C (if non-negative) and is the
|
||
best match for ATTRS and PIXEL_SIZE. */
|
||
|
||
static Lisp_Object
|
||
font_select_entity (struct frame *f, Lisp_Object entities,
|
||
Lisp_Object *attrs, int pixel_size, int c)
|
||
{
|
||
Lisp_Object font_entity;
|
||
Lisp_Object prefer;
|
||
int i;
|
||
|
||
/* If we have a single candidate, return it if it supports C. */
|
||
if (NILP (XCDR (entities))
|
||
&& ASIZE (XCAR (entities)) == 1)
|
||
{
|
||
font_entity = AREF (XCAR (entities), 0);
|
||
if (c < 0 || font_has_char (f, font_entity, c) > 0)
|
||
return font_entity;
|
||
return Qnil;
|
||
}
|
||
|
||
/* If we have several candidates, find the best match by sorting
|
||
them by properties specified in ATTRS. Style attributes (weight,
|
||
slant, width, and size) are taken from the font spec in ATTRS (if
|
||
that is non-nil), or from ATTRS, or left as nil. */
|
||
prefer = scratch_font_prefer;
|
||
|
||
for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
|
||
ASET (prefer, i, Qnil);
|
||
if (FONTP (attrs[LFACE_FONT_INDEX]))
|
||
{
|
||
Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
|
||
|
||
for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++)
|
||
ASET (prefer, i, AREF (face_font, i));
|
||
}
|
||
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]);
|
||
ASET (prefer, FONT_SIZE_INDEX, make_fixnum (pixel_size));
|
||
|
||
return font_sort_entities (entities, prefer, f, c);
|
||
}
|
||
|
||
/* Return a font-entity that satisfies SPEC and is the best match for
|
||
face's font related attributes in ATTRS. C, if not negative, is a
|
||
character that the entity must support. */
|
||
|
||
Lisp_Object
|
||
font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int c)
|
||
{
|
||
Lisp_Object work;
|
||
Lisp_Object entities, val;
|
||
Lisp_Object foundry[3], *family, registry[3], adstyle[3];
|
||
int pixel_size;
|
||
int i, j, k, l;
|
||
USE_SAFE_ALLOCA;
|
||
|
||
/* Registry specification alternatives: from the most specific to
|
||
the least specific and finally an unspecified one. */
|
||
registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
|
||
if (NILP (registry[0]))
|
||
{
|
||
registry[0] = DEFAULT_ENCODING;
|
||
registry[1] = Qascii_0;
|
||
registry[2] = zero_vector;
|
||
}
|
||
else
|
||
registry[1] = zero_vector;
|
||
|
||
if (c >= 0 && ! NILP (AREF (spec, FONT_REGISTRY_INDEX)))
|
||
{
|
||
struct charset *encoding, *repertory;
|
||
|
||
if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
|
||
&encoding, &repertory) < 0)
|
||
return Qnil;
|
||
if (repertory
|
||
&& ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
|
||
return Qnil;
|
||
else if (c > encoding->max_char)
|
||
return Qnil;
|
||
}
|
||
|
||
work = copy_font_spec (spec);
|
||
ASET (work, FONT_TYPE_INDEX, AREF (spec, FONT_TYPE_INDEX));
|
||
pixel_size = font_pixel_size (f, spec);
|
||
if (pixel_size == 0 && FIXNUMP (attrs[LFACE_HEIGHT_INDEX]))
|
||
{
|
||
double pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]);
|
||
|
||
pixel_size = POINT_TO_PIXEL (pt / 10, FRAME_RES (f));
|
||
if (pixel_size < 1)
|
||
pixel_size = 1;
|
||
}
|
||
ASET (work, FONT_SIZE_INDEX, Qnil);
|
||
|
||
/* Foundry specification alternatives: from the most specific to the
|
||
least specific and finally an unspecified one. */
|
||
foundry[0] = AREF (work, FONT_FOUNDRY_INDEX);
|
||
if (! NILP (foundry[0]))
|
||
foundry[1] = zero_vector;
|
||
else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
|
||
{
|
||
val = attrs[LFACE_FOUNDRY_INDEX];
|
||
foundry[0] = font_intern_prop (SSDATA (val), SBYTES (val), 1);
|
||
foundry[1] = Qnil;
|
||
foundry[2] = zero_vector;
|
||
}
|
||
else
|
||
foundry[0] = Qnil, foundry[1] = zero_vector;
|
||
|
||
/* Additional style specification alternatives: from the most
|
||
specific to the least specific and finally an unspecified one. */
|
||
adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX);
|
||
if (! NILP (adstyle[0]))
|
||
adstyle[1] = zero_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] = zero_vector;
|
||
}
|
||
else
|
||
adstyle[0] = Qnil, adstyle[1] = zero_vector;
|
||
}
|
||
else
|
||
adstyle[0] = Qnil, adstyle[1] = zero_vector;
|
||
|
||
|
||
/* Family specification alternatives: from the most specific to
|
||
the least specific and finally an unspecified one. */
|
||
val = AREF (work, FONT_FAMILY_INDEX);
|
||
if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
|
||
{
|
||
val = attrs[LFACE_FAMILY_INDEX];
|
||
val = font_intern_prop (SSDATA (val), SBYTES (val), 1);
|
||
}
|
||
Lisp_Object familybuf[3];
|
||
if (NILP (val))
|
||
{
|
||
family = familybuf;
|
||
family[0] = Qnil;
|
||
family[1] = zero_vector; /* terminator. */
|
||
}
|
||
else
|
||
{
|
||
Lisp_Object alters
|
||
= Fassoc_string (val, Vface_alternative_font_family_alist, Qt);
|
||
|
||
if (! NILP (alters))
|
||
{
|
||
EMACS_INT alterslen = list_length (alters);
|
||
SAFE_ALLOCA_LISP (family, alterslen + 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] = zero_vector;
|
||
}
|
||
else
|
||
{
|
||
family = familybuf;
|
||
i = 0;
|
||
family[i++] = val;
|
||
if (NILP (AREF (spec, FONT_FAMILY_INDEX)))
|
||
family[i++] = Qnil;
|
||
family[i] = zero_vector;
|
||
}
|
||
}
|
||
|
||
/* Now look up suitable fonts, from the most specific spec to the
|
||
least specific spec. Accept the first one that matches. */
|
||
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]);
|
||
/* Produce the list of candidates for the spec in WORK. */
|
||
entities = font_list_entities (f, work);
|
||
if (! NILP (entities))
|
||
{
|
||
/* If there are several candidates, select the
|
||
best match for PIXEL_SIZE and attributes in ATTRS. */
|
||
val = font_select_entity (f, entities,
|
||
attrs, pixel_size, c);
|
||
if (! NILP (val))
|
||
{
|
||
SAFE_FREE ();
|
||
return val;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
SAFE_FREE ();
|
||
return Qnil;
|
||
}
|
||
|
||
|
||
Lisp_Object
|
||
font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Lisp_Object spec)
|
||
{
|
||
int size;
|
||
|
||
if (FIXNUMP (AREF (entity, FONT_SIZE_INDEX))
|
||
&& XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0)
|
||
size = XFIXNUM (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;
|
||
if (FIXNUMP (attrs[LFACE_HEIGHT_INDEX]))
|
||
pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]);
|
||
else
|
||
{
|
||
/* We need the default face to be valid below. */
|
||
if (FRAME_FACE_CACHE (f)->used == 0)
|
||
recompute_basic_faces (f);
|
||
|
||
struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID);
|
||
Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX];
|
||
eassert (FIXNUMP (height));
|
||
pt = XFIXNUM (height);
|
||
}
|
||
|
||
pt /= 10;
|
||
size = POINT_TO_PIXEL (pt, FRAME_RES (f));
|
||
#ifdef HAVE_NS
|
||
if (size == 0)
|
||
{
|
||
Lisp_Object ffsize = get_frame_param (f, Qfontsize);
|
||
size = (NUMBERP (ffsize)
|
||
? POINT_TO_PIXEL (XFLOATINT (ffsize), FRAME_RES (f))
|
||
: 0);
|
||
}
|
||
#endif
|
||
}
|
||
size *= font_rescale_ratio (entity);
|
||
}
|
||
|
||
return font_open_entity (f, entity, size);
|
||
}
|
||
|
||
|
||
/* Find a font that satisfies SPEC and is the best match for
|
||
face's attributes in ATTRS on FRAME, and return the opened
|
||
font-object. */
|
||
|
||
Lisp_Object
|
||
font_load_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec)
|
||
{
|
||
Lisp_Object entity, name;
|
||
|
||
entity = font_find_for_lface (f, attrs, spec, -1);
|
||
if (NILP (entity))
|
||
{
|
||
/* No font is listed for SPEC, but each font-backend may have
|
||
different criteria about "font matching". So, try it. */
|
||
entity = font_matching_entity (f, attrs, spec);
|
||
/* Perhaps the user asked for a font "Foobar-123", and we
|
||
interpreted "-123" as the size, whereas it really is part of
|
||
the name. So we reset the size to nil and the family name to
|
||
the entire "Foobar-123" thing, and try again with that. */
|
||
if (NILP (entity))
|
||
{
|
||
name = Ffont_get (spec, QCuser_spec);
|
||
if (STRINGP (name))
|
||
{
|
||
char *p = SSDATA (name), *q = strrchr (p, '-');
|
||
|
||
if (q != NULL && c_isdigit (q[1]))
|
||
{
|
||
char *tail;
|
||
double font_size = strtod (q + 1, &tail);
|
||
|
||
if (font_size > 0 && tail != q + 1)
|
||
{
|
||
Lisp_Object lsize = Ffont_get (spec, QCsize);
|
||
|
||
if ((FLOATP (lsize) && XFLOAT_DATA (lsize) == font_size)
|
||
|| (FIXNUMP (lsize) && XFIXNUM (lsize) == font_size))
|
||
{
|
||
ASET (spec, FONT_FAMILY_INDEX,
|
||
font_intern_prop (p, tail - p, 1));
|
||
ASET (spec, FONT_SIZE_INDEX, Qnil);
|
||
entity = font_matching_entity (f, attrs, spec);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
if (NILP (entity))
|
||
return Qnil;
|
||
}
|
||
/* Don't lose the original name that was put in initially. We need
|
||
it to re-apply the font when font parameters (like hinting or dpi) have
|
||
changed. */
|
||
entity = font_open_for_lface (f, entity, attrs, spec);
|
||
if (!NILP (entity))
|
||
{
|
||
name = Ffont_get (spec, QCuser_spec);
|
||
if (STRINGP (name)) font_put_extra (entity, QCuser_spec, name);
|
||
}
|
||
return entity;
|
||
}
|
||
|
||
|
||
/* Make FACE on frame F ready to use the font opened for FACE. */
|
||
|
||
void
|
||
font_prepare_for_face (struct frame *f, struct face *face)
|
||
{
|
||
if (face->font->driver->prepare_face)
|
||
face->font->driver->prepare_face (f, face);
|
||
}
|
||
|
||
|
||
/* Make FACE on frame F stop using the font opened for FACE. */
|
||
|
||
void
|
||
font_done_for_face (struct frame *f, struct face *face)
|
||
{
|
||
if (face->font->driver->done_face)
|
||
face->font->driver->done_face (f, face);
|
||
}
|
||
|
||
|
||
/* Open a font that is a match for font-spec SPEC on frame F. If no proper
|
||
font is found, return Qnil. */
|
||
|
||
Lisp_Object
|
||
font_open_by_spec (struct frame *f, Lisp_Object spec)
|
||
{
|
||
Lisp_Object attrs[LFACE_VECTOR_SIZE];
|
||
|
||
/* 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_fixnum (120);
|
||
#else
|
||
attrs[LFACE_HEIGHT_INDEX] = make_fixnum (0);
|
||
#endif
|
||
attrs[LFACE_FONT_INDEX] = Qnil;
|
||
|
||
return font_load_for_lface (f, attrs, spec);
|
||
}
|
||
|
||
|
||
/* Open a font that matches NAME on frame F. If no proper font is
|
||
found, return Qnil. */
|
||
|
||
Lisp_Object
|
||
font_open_by_name (struct frame *f, Lisp_Object name)
|
||
{
|
||
Lisp_Object spec = CALLN (Ffont_spec, QCname, name);
|
||
Lisp_Object ret = font_open_by_spec (f, spec);
|
||
/* Do not lose name originally put in. */
|
||
if (!NILP (ret))
|
||
font_put_extra (ret, QCuser_spec, name);
|
||
|
||
return ret;
|
||
}
|
||
|
||
|
||
/* Register font-driver DRIVER. This function is used in two ways.
|
||
|
||
The first is with frame F non-NULL. In this case, make DRIVER
|
||
available (but not yet activated) on F. All frame creators
|
||
(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
|
||
implementations must call this function in its
|
||
syms_of_XXXX_for_pdumper (e.g. syms_of_xfont_for_pdumper). */
|
||
|
||
void
|
||
register_font_driver (struct font_driver const *driver, struct frame *f)
|
||
{
|
||
struct font_driver_list *root = f ? f->font_driver_list : font_driver_list;
|
||
struct font_driver_list *prev, *list;
|
||
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
if (f && ! driver->draw)
|
||
error ("Unusable font driver for a frame: %s",
|
||
SDATA (SYMBOL_NAME (driver->type)));
|
||
#endif /* HAVE_WINDOW_SYSTEM */
|
||
|
||
for (prev = NULL, list = root; list; prev = list, list = list->next)
|
||
if (EQ (list->driver->type, driver->type))
|
||
error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
|
||
|
||
list = xmalloc (sizeof *list);
|
||
list->on = 0;
|
||
list->driver = driver;
|
||
list->next = NULL;
|
||
if (prev)
|
||
prev->next = list;
|
||
else if (f)
|
||
f->font_driver_list = list;
|
||
else
|
||
font_driver_list = list;
|
||
if (! f)
|
||
num_font_drivers++;
|
||
}
|
||
|
||
void
|
||
free_font_driver_list (struct frame *f)
|
||
{
|
||
struct font_driver_list *list, *next;
|
||
|
||
for (list = f->font_driver_list; list; list = next)
|
||
{
|
||
next = list->next;
|
||
xfree (list);
|
||
}
|
||
f->font_driver_list = NULL;
|
||
}
|
||
|
||
|
||
/* Make the frame F use font backends listed in NEW_DRIVERS (list of
|
||
symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
|
||
available font drivers that are not superseded by another driver.
|
||
(A font driver SYMBOL is superseded by the driver specified by
|
||
SYMBOL's 'font-driver-superseded-by property if it is a non-nil
|
||
symbol.) If NEW_DRIVERS is nil, finalize all drivers.
|
||
|
||
A caller must free all realized faces if any in advance. The
|
||
return value is a list of font backends actually made used on
|
||
F. */
|
||
|
||
Lisp_Object
|
||
font_update_drivers (struct frame *f, Lisp_Object new_drivers)
|
||
{
|
||
Lisp_Object active_drivers = Qnil, default_drivers = Qnil;
|
||
struct font_driver_list *list;
|
||
|
||
/* Collect all unsuperseded driver symbols into
|
||
`default_drivers'. */
|
||
Lisp_Object all_drivers = Qnil;
|
||
for (list = f->font_driver_list; list; list = list->next)
|
||
all_drivers = Fcons (list->driver->type, all_drivers);
|
||
for (Lisp_Object rest = all_drivers; CONSP (rest); rest = XCDR (rest))
|
||
{
|
||
Lisp_Object superseded_by
|
||
= Fget (XCAR (rest), Qfont_driver_superseded_by);
|
||
|
||
if (NILP (superseded_by)
|
||
|| NILP (Fmemq (superseded_by, all_drivers)))
|
||
default_drivers = Fcons (XCAR (rest), default_drivers);
|
||
}
|
||
|
||
if (EQ (new_drivers, Qt))
|
||
new_drivers = default_drivers;
|
||
|
||
/* At first, turn off non-requested drivers, and turn on requested
|
||
drivers. */
|
||
for (list = f->font_driver_list; list; list = list->next)
|
||
{
|
||
struct font_driver const *driver = list->driver;
|
||
if ((! 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;
|
||
else
|
||
{
|
||
/* Re-order the driver list according to new_drivers. */
|
||
struct font_driver_list **list_table, **next;
|
||
Lisp_Object tail;
|
||
int i;
|
||
USE_SAFE_ALLOCA;
|
||
|
||
SAFE_NALLOCA (list_table, 1, num_font_drivers + 1);
|
||
for (i = 0, tail = new_drivers; ! NILP (tail); tail = XCDR (tail))
|
||
{
|
||
for (list = f->font_driver_list; list; list = list->next)
|
||
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;
|
||
SAFE_FREE ();
|
||
|
||
if (! f->font_driver_list->on)
|
||
{ /* None of the drivers is enabled: enable them all.
|
||
Happens if you set the list of drivers to (xft x) in your .emacs
|
||
and then use it under w32 or ns. */
|
||
for (list = f->font_driver_list; list; list = list->next)
|
||
{
|
||
struct font_driver const *driver = list->driver;
|
||
eassert (! list->on);
|
||
if (NILP (Fmemq (driver->type, default_drivers)))
|
||
continue;
|
||
if (! driver->start_for_frame
|
||
|| driver->start_for_frame (f) == 0)
|
||
{
|
||
font_prepare_cache (f, driver);
|
||
list->on = 1;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
for (list = f->font_driver_list; list; list = list->next)
|
||
if (list->on)
|
||
active_drivers = nconc2 (active_drivers, list1 (list->driver->type));
|
||
return active_drivers;
|
||
}
|
||
|
||
#if (defined HAVE_XFT || defined HAVE_FREETYPE) && !defined USE_CAIRO
|
||
|
||
static void
|
||
fset_font_data (struct frame *f, Lisp_Object val)
|
||
{
|
||
f->font_data = val;
|
||
}
|
||
|
||
void
|
||
font_put_frame_data (struct frame *f, Lisp_Object driver, void *data)
|
||
{
|
||
Lisp_Object val = assq_no_quit (driver, f->font_data);
|
||
|
||
if (!data)
|
||
fset_font_data (f, Fdelq (val, f->font_data));
|
||
else
|
||
{
|
||
if (NILP (val))
|
||
fset_font_data (f, Fcons (Fcons (driver, make_mint_ptr (data)),
|
||
f->font_data));
|
||
else
|
||
XSETCDR (val, make_mint_ptr (data));
|
||
}
|
||
}
|
||
|
||
void *
|
||
font_get_frame_data (struct frame *f, Lisp_Object driver)
|
||
{
|
||
Lisp_Object val = assq_no_quit (driver, f->font_data);
|
||
|
||
return NILP (val) ? NULL : xmint_pointer (XCDR (val));
|
||
}
|
||
|
||
#endif /* (HAVE_XFT || HAVE_FREETYPE) && !USE_CAIRO */
|
||
|
||
/* Sets attributes on a font. Any properties that appear in ALIST and
|
||
BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
|
||
BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
|
||
arrays of strings. This function is intended for use by the font
|
||
drivers to implement their specific font_filter_properties. */
|
||
void
|
||
font_filter_properties (Lisp_Object font,
|
||
Lisp_Object alist,
|
||
const char *const boolean_properties[],
|
||
const char *const non_boolean_properties[])
|
||
{
|
||
Lisp_Object it;
|
||
int i;
|
||
|
||
/* Set boolean values to Qt or Qnil. */
|
||
for (i = 0; boolean_properties[i] != NULL; ++i)
|
||
for (it = alist; ! NILP (it); it = XCDR (it))
|
||
{
|
||
Lisp_Object key = XCAR (XCAR (it));
|
||
Lisp_Object val = XCDR (XCAR (it));
|
||
char *keystr = SSDATA (SYMBOL_NAME (key));
|
||
|
||
if (strcmp (boolean_properties[i], keystr) == 0)
|
||
{
|
||
const char *str = FIXNUMP (val) ? (XFIXNUM (val) ? "true" : "false")
|
||
: SYMBOLP (val) ? SSDATA (SYMBOL_NAME (val))
|
||
: "true";
|
||
|
||
if (strcmp ("false", str) == 0 || strcmp ("False", str) == 0
|
||
|| strcmp ("FALSE", str) == 0 || strcmp ("FcFalse", str) == 0
|
||
|| strcmp ("off", str) == 0 || strcmp ("OFF", str) == 0
|
||
|| strcmp ("Off", str) == 0)
|
||
val = Qnil;
|
||
else
|
||
val = Qt;
|
||
|
||
Ffont_put (font, key, val);
|
||
}
|
||
}
|
||
|
||
for (i = 0; non_boolean_properties[i] != NULL; ++i)
|
||
for (it = alist; ! NILP (it); it = XCDR (it))
|
||
{
|
||
Lisp_Object key = XCAR (XCAR (it));
|
||
Lisp_Object val = XCDR (XCAR (it));
|
||
char *keystr = SSDATA (SYMBOL_NAME (key));
|
||
if (strcmp (non_boolean_properties[i], keystr) == 0)
|
||
Ffont_put (font, key, val);
|
||
}
|
||
}
|
||
|
||
|
||
/* Return the font used to draw character C by FACE at buffer position
|
||
POS in window W. If STRING is non-nil, it is a string containing C
|
||
at index POS. If C is negative, get C from the current buffer or
|
||
STRING. */
|
||
|
||
static Lisp_Object
|
||
font_at (int c, ptrdiff_t pos, struct face *face, struct window *w,
|
||
Lisp_Object string)
|
||
{
|
||
struct frame *f;
|
||
bool multibyte;
|
||
Lisp_Object font_object;
|
||
|
||
multibyte = (NILP (string)
|
||
? ! NILP (BVAR (current_buffer, enable_multibyte_characters))
|
||
: STRING_MULTIBYTE (string));
|
||
if (c < 0)
|
||
{
|
||
if (NILP (string))
|
||
{
|
||
if (multibyte)
|
||
{
|
||
ptrdiff_t pos_byte = CHAR_TO_BYTE (pos);
|
||
|
||
c = FETCH_CHAR (pos_byte);
|
||
}
|
||
else
|
||
c = FETCH_BYTE (pos);
|
||
}
|
||
else
|
||
{
|
||
unsigned char *str;
|
||
|
||
multibyte = STRING_MULTIBYTE (string);
|
||
if (multibyte)
|
||
{
|
||
ptrdiff_t pos_byte = string_char_to_byte (string, pos);
|
||
|
||
str = SDATA (string) + pos_byte;
|
||
c = STRING_CHAR (str);
|
||
}
|
||
else
|
||
c = SDATA (string)[pos];
|
||
}
|
||
}
|
||
|
||
f = XFRAME (w->frame);
|
||
if (! FRAME_WINDOW_P (f))
|
||
return Qnil;
|
||
if (! face)
|
||
{
|
||
int face_id;
|
||
ptrdiff_t endptr;
|
||
|
||
if (STRINGP (string))
|
||
face_id = face_at_string_position (w, string, pos, 0, &endptr,
|
||
DEFAULT_FACE_ID, false, 0);
|
||
else
|
||
face_id = face_at_buffer_position (w, pos, &endptr,
|
||
pos + 100, false, -1, 0);
|
||
face = FACE_FROM_ID (f, face_id);
|
||
}
|
||
if (multibyte)
|
||
{
|
||
int face_id = FACE_FOR_CHAR (f, face, c, pos, string);
|
||
face = FACE_FROM_ID (f, face_id);
|
||
}
|
||
if (! face->font)
|
||
return Qnil;
|
||
|
||
XSETFONT (font_object, face->font);
|
||
return font_object;
|
||
}
|
||
|
||
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
|
||
/* Check if CH is a codepoint for which we should attempt to use the
|
||
emoji font, even if the codepoint itself has Emoji_Presentation =
|
||
No. Vauto_composition_emoji_eligible_codepoints is filled in for
|
||
us by admin/unidata/emoji-zwj.awk. */
|
||
static bool
|
||
codepoint_is_emoji_eligible (int ch)
|
||
{
|
||
if (EQ (CHAR_TABLE_REF (Vchar_script_table, ch), Qemoji))
|
||
return true;
|
||
|
||
if (! NILP (Fmemq (make_fixnum (ch),
|
||
Vauto_composition_emoji_eligible_codepoints)))
|
||
return true;
|
||
|
||
return false;
|
||
}
|
||
|
||
/* Check how many characters after character/byte position POS/POS_BYTE
|
||
(at most to *LIMIT) can be displayed by the same font in the window W.
|
||
FACE, if non-NULL, is the face selected for the character at POS.
|
||
If STRING is not nil, it is the string to check instead of the current
|
||
buffer. In that case, FACE must be not NULL.
|
||
|
||
CH is the character that actually caused the composition
|
||
process to start, it may be different from the character at POS.
|
||
|
||
The return value is the font-object for the character at POS.
|
||
*LIMIT is set to the position where that font can't be used.
|
||
|
||
It is assured that the current buffer (or STRING) is multibyte. */
|
||
|
||
Lisp_Object
|
||
font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit,
|
||
struct window *w, struct face *face, Lisp_Object string,
|
||
int ch)
|
||
{
|
||
ptrdiff_t ignore;
|
||
int c;
|
||
Lisp_Object font_object = Qnil;
|
||
struct frame *f = XFRAME (w->frame);
|
||
|
||
if (!face)
|
||
{
|
||
int face_id;
|
||
|
||
if (NILP (string))
|
||
face_id = face_at_buffer_position (w, pos, &ignore, *limit,
|
||
false, -1, 0);
|
||
else
|
||
{
|
||
face_id =
|
||
NILP (Vface_remapping_alist)
|
||
? DEFAULT_FACE_ID
|
||
: lookup_basic_face (w, f, DEFAULT_FACE_ID);
|
||
|
||
face_id = face_at_string_position (w, string, pos, 0, &ignore,
|
||
face_id, false, 0);
|
||
}
|
||
face = FACE_FROM_ID (f, face_id);
|
||
}
|
||
|
||
/* If the composition was triggered by an emoji, use a character
|
||
from 'script-representative-chars', rather than the first
|
||
character in the string, to determine the font to use. */
|
||
if (codepoint_is_emoji_eligible (ch))
|
||
{
|
||
Lisp_Object val = assq_no_quit (Qemoji, Vscript_representative_chars);
|
||
if (CONSP (val))
|
||
{
|
||
val = XCDR (val);
|
||
if (CONSP (val))
|
||
val = XCAR (val);
|
||
else if (VECTORP (val))
|
||
val = AREF (val, 0);
|
||
font_object = font_for_char (face, XFIXNAT (val), pos, string);
|
||
}
|
||
}
|
||
|
||
while (pos < *limit)
|
||
{
|
||
c = (NILP (string)
|
||
? fetch_char_advance_no_check (&pos, &pos_byte)
|
||
: fetch_string_char_advance_no_check (string, &pos, &pos_byte));
|
||
Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
|
||
if (FIXNUMP (category)
|
||
&& (XFIXNUM (category) == UNICODE_CATEGORY_Cf
|
||
|| CHAR_VARIATION_SELECTOR_P (c)))
|
||
continue;
|
||
if (NILP (font_object))
|
||
{
|
||
font_object = font_for_char (face, c, pos - 1, string);
|
||
if (NILP (font_object))
|
||
return Qnil;
|
||
continue;
|
||
}
|
||
if (font_encode_char (font_object, c) == FONT_INVALID_CODE)
|
||
*limit = pos - 1;
|
||
}
|
||
return font_object;
|
||
}
|
||
#endif
|
||
|
||
|
||
/* Lisp API. */
|
||
|
||
DEFUN ("fontp", Ffontp, Sfontp, 1, 2, 0,
|
||
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',
|
||
`font-object'. */)
|
||
(Lisp_Object object, Lisp_Object extra_type)
|
||
{
|
||
if (NILP (extra_type))
|
||
return (FONTP (object) ? Qt : Qnil);
|
||
if (EQ (extra_type, Qfont_spec))
|
||
return (FONT_SPEC_P (object) ? Qt : Qnil);
|
||
if (EQ (extra_type, Qfont_entity))
|
||
return (FONT_ENTITY_P (object) ? Qt : Qnil);
|
||
if (EQ (extra_type, Qfont_object))
|
||
return (FONT_OBJECT_P (object) ? Qt : Qnil);
|
||
wrong_type_argument (Qfont_extra_type, extra_type); ;
|
||
}
|
||
|
||
DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0,
|
||
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'.
|
||
|
||
`: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 pixels (if
|
||
VALUE is an integer), or in points (if VALUE is a float).
|
||
|
||
`:dpi'
|
||
|
||
VALUE must be a non-negative number that specifies the resolution
|
||
(dot per inch) for which the font is designed.
|
||
|
||
`:spacing'
|
||
|
||
VALUE specifies the spacing of the font: mono, proportional, charcell,
|
||
or dual. It can be either a number (0 for proportional, 90 for dual,
|
||
100 for mono, 110 for charcell) or a 1-letter symbol: `P', `D', `M',
|
||
or `C' (lower-case variants are also accepted).
|
||
|
||
`:avgwidth'
|
||
|
||
VALUE must be a non-negative integer specifying the average width of
|
||
the font in 1/10 pixel units.
|
||
|
||
`:name'
|
||
|
||
VALUE must be a string of XLFD-style or fontconfig-style font name.
|
||
|
||
`:script'
|
||
|
||
VALUE must be a symbol representing a script that the font must
|
||
support. It may be a symbol representing a subgroup of a script
|
||
listed in the variable `script-representative-chars'.
|
||
|
||
`:lang'
|
||
|
||
VALUE must be a symbol whose name is a two-letter ISO-639 language
|
||
name, e.g. `ja'. The value is matched against the "Additional Style"
|
||
field of the XLFD spec of a font, if it's non-empty, on X, and
|
||
against the codepages supported by the font on w32.
|
||
|
||
`:otf'
|
||
|
||
VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
|
||
required OpenType features.
|
||
|
||
SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
|
||
LANGSYS-TAG: OpenType language system tag symbol,
|
||
or nil for the default language system.
|
||
GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
|
||
GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
|
||
|
||
GSUB and GPOS may contain nil elements. In such a case, the font
|
||
must not have any of the remaining elements.
|
||
|
||
For instance, if the VALUE is `(thai nil nil (mark))', the font must
|
||
be an OpenType font whose GPOS table of `thai' script's default
|
||
language system must contain `mark' feature.
|
||
|
||
usage: (font-spec ARGS...) */)
|
||
(ptrdiff_t nargs, Lisp_Object *args)
|
||
{
|
||
Lisp_Object spec = font_make_spec ();
|
||
ptrdiff_t i;
|
||
|
||
for (i = 0; i < nargs; i += 2)
|
||
{
|
||
Lisp_Object key = args[i], val;
|
||
|
||
CHECK_SYMBOL (key);
|
||
if (i + 1 >= nargs)
|
||
error ("No value for key `%s'", SDATA (SYMBOL_NAME (key)));
|
||
val = args[i + 1];
|
||
|
||
if (EQ (key, QCname))
|
||
{
|
||
CHECK_STRING (val);
|
||
if (font_parse_name (SSDATA (val), SBYTES (val), spec) < 0)
|
||
error ("Invalid font name: %s", SSDATA (val));
|
||
font_put_extra (spec, key, val);
|
||
}
|
||
else
|
||
{
|
||
int idx = get_font_prop_index (key);
|
||
|
||
if (idx >= 0)
|
||
{
|
||
val = font_prop_validate (idx, Qnil, val);
|
||
if (idx < FONT_EXTRA_INDEX)
|
||
ASET (spec, idx, val);
|
||
else
|
||
font_put_extra (spec, key, val);
|
||
}
|
||
else
|
||
font_put_extra (spec, key, font_prop_validate (0, key, val));
|
||
}
|
||
}
|
||
return spec;
|
||
}
|
||
|
||
/* Return a copy of FONT as a font-spec. For the sake of speed, this code
|
||
relies on an internal stuff exposed from alloc.c and should be handled
|
||
with care. */
|
||
|
||
Lisp_Object
|
||
copy_font_spec (Lisp_Object font)
|
||
{
|
||
enum { font_spec_size = VECSIZE (struct font_spec) };
|
||
Lisp_Object new_spec, tail, *pcdr;
|
||
struct font_spec *spec;
|
||
|
||
CHECK_FONT (font);
|
||
|
||
/* Make an uninitialized font-spec object. */
|
||
spec = (struct font_spec *) allocate_vector (font_spec_size);
|
||
XSETPVECTYPESIZE (spec, PVEC_FONT, FONT_SPEC_MAX,
|
||
font_spec_size - FONT_SPEC_MAX);
|
||
|
||
spec->props[FONT_TYPE_INDEX] = spec->props[FONT_EXTRA_INDEX] = Qnil;
|
||
|
||
/* Copy basic properties FONT_FOUNDRY_INDEX..FONT_AVGWIDTH_INDEX. */
|
||
memcpy (spec->props + 1, XVECTOR (font)->contents + 1,
|
||
(FONT_EXTRA_INDEX - 1) * word_size);
|
||
|
||
/* Copy an alist of extra information but discard :font-entity property. */
|
||
pcdr = spec->props + FONT_EXTRA_INDEX;
|
||
for (tail = AREF (font, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
|
||
if (!EQ (XCAR (XCAR (tail)), QCfont_entity))
|
||
{
|
||
*pcdr = Fcons (Fcons (XCAR (XCAR (tail)), CDR (XCAR (tail))), Qnil);
|
||
pcdr = xcdr_addr (*pcdr);
|
||
}
|
||
|
||
XSETFONT (new_spec, spec);
|
||
return new_spec;
|
||
}
|
||
|
||
/* Merge font-specs FROM and TO, and return a new font-spec.
|
||
Every specified property in FROM overrides the corresponding
|
||
property in TO. */
|
||
Lisp_Object
|
||
merge_font_spec (Lisp_Object from, Lisp_Object to)
|
||
{
|
||
Lisp_Object extra, tail;
|
||
int i;
|
||
|
||
CHECK_FONT (from);
|
||
CHECK_FONT (to);
|
||
to = copy_font_spec (to);
|
||
for (i = 0; i < FONT_EXTRA_INDEX; i++)
|
||
ASET (to, i, AREF (from, i));
|
||
extra = AREF (to, FONT_EXTRA_INDEX);
|
||
for (tail = AREF (from, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
|
||
if (! EQ (XCAR (XCAR (tail)), Qfont_entity))
|
||
{
|
||
Lisp_Object slot = assq_no_quit (XCAR (XCAR (tail)), extra);
|
||
|
||
if (! NILP (slot))
|
||
XSETCDR (slot, XCDR (XCAR (tail)));
|
||
else
|
||
extra = Fcons (Fcons (XCAR (XCAR (tail)), XCDR (XCAR (tail))), extra);
|
||
}
|
||
ASET (to, FONT_EXTRA_INDEX, extra);
|
||
return to;
|
||
}
|
||
|
||
DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0,
|
||
doc: /* Return the value of FONT's property KEY.
|
||
FONT is a font-spec, a font-entity, or a font-object.
|
||
KEY can be any symbol, but these are reserved for specific meanings:
|
||
:foundry, :family, :adstyle, :registry, :weight, :slant, :width,
|
||
:size, :dpi, :spacing, :avgwidth, :script, :lang, :otf
|
||
See the documentation of `font-spec' for their meanings.
|
||
|
||
If FONT is a font-entity or a font-object, then values of
|
||
:script and :otf properties are different from those of a font-spec
|
||
as below:
|
||
|
||
The value of :script may be a list of scripts that are supported by
|
||
the font.
|
||
|
||
The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are
|
||
lists representing the OpenType features supported by the font, of
|
||
this form: ((SCRIPT (LANGSYS FEATURE ...) ...) ...), where
|
||
SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
|
||
Layout tags. See `otf-script-alist' for the OpenType script tags.
|
||
|
||
In addition to the keys listed above, the following keys are reserved
|
||
for the specific meanings as below:
|
||
|
||
The value of :type is a symbol that identifies the font backend to be
|
||
used, such as `ftcrhb' or `xfthb' on X , `harfbuzz' or `uniscribe' on
|
||
MS-Windows, `ns' on Cocoa/GNUstep, etc.
|
||
|
||
The value of :combining-capability is non-nil if the font-backend of
|
||
FONT supports rendering of combining characters for non-OTF fonts. */)
|
||
(Lisp_Object font, Lisp_Object key)
|
||
{
|
||
int idx;
|
||
Lisp_Object val;
|
||
|
||
CHECK_FONT (font);
|
||
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);
|
||
val = Fassq (key, AREF (font, FONT_EXTRA_INDEX));
|
||
if (NILP (val) && FONT_OBJECT_P (font))
|
||
{
|
||
struct font *fontp = XFONT_OBJECT (font);
|
||
|
||
if (EQ (key, QCotf))
|
||
{
|
||
if (fontp->driver->otf_capability)
|
||
val = fontp->driver->otf_capability (fontp);
|
||
else
|
||
val = Fcons (Qnil, Qnil);
|
||
}
|
||
else if (EQ (key, QCcombining_capability))
|
||
{
|
||
if (fontp->driver->combining_capability)
|
||
val = fontp->driver->combining_capability (fontp);
|
||
}
|
||
}
|
||
else
|
||
val = Fcdr (val);
|
||
return val;
|
||
}
|
||
|
||
#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. */)
|
||
(Lisp_Object font, Lisp_Object frame)
|
||
{
|
||
struct frame *f = decode_live_frame (frame);
|
||
Lisp_Object plist[10];
|
||
Lisp_Object val;
|
||
int n = 0;
|
||
|
||
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 (FIXNUMP (val))
|
||
{
|
||
Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX);
|
||
int dpi = FIXNUMP (font_dpi) ? XFIXNUM (font_dpi) : FRAME_RES (f);
|
||
plist[n++] = QCheight;
|
||
plist[n++] = make_fixnum (PIXEL_TO_POINT (XFIXNUM (val) * 10, dpi));
|
||
}
|
||
else if (FLOATP (val))
|
||
{
|
||
plist[n++] = QCheight;
|
||
plist[n++] = make_fixnum (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: give property KEY value VAL.
|
||
FONT is a font-spec, a font-entity, or a font-object.
|
||
|
||
If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
|
||
accepted by the function `font-spec' (which see), VAL must be what
|
||
allowed in `font-spec'.
|
||
|
||
If FONT is a font-entity or a font-object, KEY must not be the one
|
||
accepted by `font-spec'.
|
||
|
||
See also `font-get' for KEYs that have special meanings. */)
|
||
(Lisp_Object font, Lisp_Object prop, Lisp_Object val)
|
||
{
|
||
int idx;
|
||
|
||
idx = get_font_prop_index (prop);
|
||
if (idx >= 0 && idx < FONT_EXTRA_INDEX)
|
||
{
|
||
CHECK_FONT_SPEC (font);
|
||
ASET (font, idx, font_prop_validate (idx, Qnil, val));
|
||
}
|
||
else
|
||
{
|
||
if (EQ (prop, QCname)
|
||
|| EQ (prop, QCscript)
|
||
|| EQ (prop, QClang)
|
||
|| EQ (prop, QCotf))
|
||
CHECK_FONT_SPEC (font);
|
||
else
|
||
CHECK_FONT (font);
|
||
font_put_extra (font, prop, font_prop_validate (0, prop, val));
|
||
}
|
||
return val;
|
||
}
|
||
|
||
DEFUN ("list-fonts", Flist_fonts, Slist_fonts, 1, 4, 0,
|
||
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
|
||
control the order of the returned list. Fonts are sorted by
|
||
how close they are to PREFER. */)
|
||
(Lisp_Object font_spec, Lisp_Object frame, Lisp_Object num, Lisp_Object prefer)
|
||
{
|
||
struct frame *f = decode_live_frame (frame);
|
||
Lisp_Object vec, list;
|
||
EMACS_INT n = 0;
|
||
|
||
CHECK_FONT_SPEC (font_spec);
|
||
if (! NILP (num))
|
||
{
|
||
CHECK_FIXNUM (num);
|
||
n = XFIXNUM (num);
|
||
if (n <= 0)
|
||
return Qnil;
|
||
}
|
||
if (! NILP (prefer))
|
||
CHECK_FONT_SPEC (prefer);
|
||
|
||
list = font_list_entities (f, font_spec);
|
||
if (NILP (list))
|
||
return Qnil;
|
||
if (NILP (XCDR (list))
|
||
&& ASIZE (XCAR (list)) == 1)
|
||
return list1 (AREF (XCAR (list), 0));
|
||
|
||
if (! NILP (prefer))
|
||
vec = font_sort_entities (list, prefer, f, 0);
|
||
else
|
||
vec = font_vconcat_entity_vectors (list);
|
||
if (n == 0 || n >= ASIZE (vec))
|
||
list = CALLN (Fappend, vec, Qnil);
|
||
else
|
||
{
|
||
for (list = Qnil, n--; n >= 0; n--)
|
||
list = Fcons (AREF (vec, n), list);
|
||
}
|
||
return list;
|
||
}
|
||
|
||
DEFUN ("font-family-list", Ffont_family_list, Sfont_family_list, 0, 1, 0,
|
||
doc: /* List available font families on the current frame.
|
||
If FRAME is omitted or nil, the selected frame is used. */)
|
||
(Lisp_Object frame)
|
||
{
|
||
struct frame *f = decode_live_frame (frame);
|
||
struct font_driver_list *driver_list;
|
||
Lisp_Object list = Qnil;
|
||
|
||
for (driver_list = f->font_driver_list; driver_list;
|
||
driver_list = driver_list->next)
|
||
if (driver_list->driver->list_family)
|
||
{
|
||
Lisp_Object val = driver_list->driver->list_family (f);
|
||
Lisp_Object tail = list;
|
||
|
||
for (; CONSP (val); val = XCDR (val))
|
||
if (NILP (Fmemq (XCAR (val), tail))
|
||
&& SYMBOLP (XCAR (val)))
|
||
list = Fcons (SYMBOL_NAME (XCAR (val)), list);
|
||
}
|
||
return list;
|
||
}
|
||
|
||
DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0,
|
||
doc: /* Return a font-entity matching with FONT-SPEC on the current frame.
|
||
Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
|
||
(Lisp_Object font_spec, Lisp_Object frame)
|
||
{
|
||
Lisp_Object val = Flist_fonts (font_spec, frame, make_fixnum (1), Qnil);
|
||
|
||
if (CONSP (val))
|
||
val = XCAR (val);
|
||
return val;
|
||
}
|
||
|
||
DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 3, 0,
|
||
doc: /* Return XLFD name of FONT.
|
||
FONT is a font-spec, font-entity, or font-object.
|
||
|
||
If the name is too long to be represented as an XLFD (maximum 255
|
||
chars) and LONG_XLFDS is nil, return nil.
|
||
|
||
If the 2nd optional arg FOLD-WILDCARDS is non-nil,
|
||
the consecutive wildcards are folded into one. */)
|
||
(Lisp_Object font, Lisp_Object fold_wildcards, Lisp_Object long_xlfds)
|
||
{
|
||
char name_buffer[256], *name;
|
||
int namelen, pixel_size = 0;
|
||
Lisp_Object string;
|
||
|
||
CHECK_FONT (font);
|
||
|
||
if (FONT_OBJECT_P (font))
|
||
{
|
||
Lisp_Object font_name = AREF (font, FONT_NAME_INDEX);
|
||
|
||
if (STRINGP (font_name)
|
||
&& SDATA (font_name)[0] == '-')
|
||
{
|
||
if (NILP (fold_wildcards))
|
||
return font_name;
|
||
name = name_buffer;
|
||
lispstpcpy (name, font_name);
|
||
namelen = SBYTES (font_name);
|
||
goto done;
|
||
}
|
||
pixel_size = XFONT_OBJECT (font)->pixel_size;
|
||
}
|
||
|
||
if (NILP (long_xlfds))
|
||
{
|
||
name = name_buffer;
|
||
namelen = font_unparse_xlfd (font, pixel_size, name, 256);
|
||
if (namelen < 0)
|
||
return Qnil;
|
||
}
|
||
else
|
||
{
|
||
/* Dynamically allocate the XLFD. */
|
||
name = font_dynamic_unparse_xlfd (font, pixel_size);
|
||
|
||
if (!name)
|
||
return Qnil;
|
||
|
||
namelen = strlen (name);
|
||
}
|
||
|
||
done:
|
||
if (! NILP (fold_wildcards))
|
||
{
|
||
char *p0 = name, *p1;
|
||
|
||
while ((p1 = strstr (p0, "-*-*")))
|
||
{
|
||
memmove (p1, p1 + 2, (name + namelen + 1) - (p1 + 2));
|
||
namelen -= 2;
|
||
p0 = p1;
|
||
}
|
||
}
|
||
|
||
/* If NAME is dynamically allocated, free it. */
|
||
|
||
string = make_string (name, namelen);
|
||
|
||
if (name != name_buffer)
|
||
xfree (name);
|
||
|
||
return string;
|
||
}
|
||
|
||
void
|
||
clear_font_cache (struct frame *f)
|
||
{
|
||
struct font_driver_list *driver_list = f->font_driver_list;
|
||
|
||
for (; driver_list; driver_list = driver_list->next)
|
||
if (driver_list->on)
|
||
{
|
||
Lisp_Object val, tmp, cache = driver_list->driver->get_cache (f);
|
||
|
||
val = XCDR (cache);
|
||
while (eassert (CONSP (val)),
|
||
! EQ (XCAR (XCAR (val)), driver_list->driver->type))
|
||
val = XCDR (val);
|
||
tmp = XCDR (XCAR (val));
|
||
if (XFIXNUM (XCAR (tmp)) == 0)
|
||
{
|
||
font_clear_cache (f, XCAR (val), driver_list->driver);
|
||
XSETCDR (cache, XCDR (val));
|
||
}
|
||
}
|
||
}
|
||
|
||
DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0,
|
||
doc: /* Clear font cache of each frame. */)
|
||
(void)
|
||
{
|
||
Lisp_Object list, frame;
|
||
|
||
FOR_EACH_FRAME (list, frame)
|
||
clear_font_cache (XFRAME (frame));
|
||
|
||
return Qnil;
|
||
}
|
||
|
||
|
||
void
|
||
font_fill_lglyph_metrics (Lisp_Object glyph, struct font *font, unsigned int code)
|
||
{
|
||
struct font_metrics metrics;
|
||
|
||
LGLYPH_SET_CODE (glyph, code);
|
||
font->driver->text_extents (font, &code, 1, &metrics);
|
||
LGLYPH_SET_LBEARING (glyph, metrics.lbearing);
|
||
LGLYPH_SET_RBEARING (glyph, metrics.rbearing);
|
||
LGLYPH_SET_WIDTH (glyph, metrics.width);
|
||
LGLYPH_SET_ASCENT (glyph, metrics.ascent);
|
||
LGLYPH_SET_DESCENT (glyph, metrics.descent);
|
||
}
|
||
|
||
|
||
DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 2, 2, 0,
|
||
doc: /* Shape the glyph-string GSTRING subject to bidi DIRECTION.
|
||
Shaping means substituting glyphs and/or adjusting positions of glyphs
|
||
to get the correct visual image of character sequences set in the
|
||
header of the glyph-string.
|
||
|
||
DIRECTION should be produced by the UBA, the Unicode Bidirectional
|
||
Algorithm, and should be a symbol, either L2R or R2L. It can also
|
||
be nil if the bidi context is unknown.
|
||
|
||
If the shaping was successful, the value is GSTRING itself or a newly
|
||
created glyph-string. Otherwise, the value is nil.
|
||
|
||
See the documentation of `composition-get-gstring' for the format of
|
||
GSTRING. */)
|
||
(Lisp_Object gstring, Lisp_Object direction)
|
||
{
|
||
struct font *font;
|
||
Lisp_Object font_object, n, glyph;
|
||
ptrdiff_t i, from, to;
|
||
|
||
if (! composition_gstring_p (gstring))
|
||
signal_error ("Invalid glyph-string: ", gstring);
|
||
if (! NILP (LGSTRING_ID (gstring)))
|
||
return gstring;
|
||
Lisp_Object cached_gstring =
|
||
composition_gstring_lookup_cache (LGSTRING_HEADER (gstring));
|
||
if (! NILP (cached_gstring))
|
||
return cached_gstring;
|
||
font_object = LGSTRING_FONT (gstring);
|
||
CHECK_FONT_OBJECT (font_object);
|
||
font = XFONT_OBJECT (font_object);
|
||
if (! font->driver->shape)
|
||
return Qnil;
|
||
|
||
/* Try at most three times with larger gstring each time. */
|
||
for (i = 0; i < 3; i++)
|
||
{
|
||
n = font->driver->shape (gstring, direction);
|
||
if (FIXNUMP (n))
|
||
break;
|
||
gstring = larger_vector (gstring,
|
||
LGSTRING_GLYPH_LEN (gstring), -1);
|
||
}
|
||
if (i == 3 || XFIXNUM (n) == 0)
|
||
return Qnil;
|
||
if (XFIXNUM (n) < LGSTRING_GLYPH_LEN (gstring))
|
||
LGSTRING_SET_GLYPH (gstring, XFIXNUM (n), Qnil);
|
||
|
||
/* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
|
||
GLYPHS covers all characters (except for the last few ones) in
|
||
GSTRING. More formally, provided that NCHARS is the number of
|
||
characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
|
||
and TO_IDX of each glyph must satisfy these conditions:
|
||
|
||
GLYPHS[0].FROM_IDX == 0
|
||
GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
|
||
if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
|
||
;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
|
||
GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
|
||
else
|
||
;; Be sure to cover all characters.
|
||
GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
|
||
glyph = LGSTRING_GLYPH (gstring, 0);
|
||
from = LGLYPH_FROM (glyph);
|
||
to = LGLYPH_TO (glyph);
|
||
if (from != 0 || to < from)
|
||
goto shaper_error;
|
||
for (i = 1; i < LGSTRING_GLYPH_LEN (gstring); i++)
|
||
{
|
||
glyph = LGSTRING_GLYPH (gstring, i);
|
||
if (NILP (glyph))
|
||
break;
|
||
if (! (LGLYPH_FROM (glyph) <= LGLYPH_TO (glyph)
|
||
&& (LGLYPH_FROM (glyph) == from
|
||
? LGLYPH_TO (glyph) == to
|
||
: LGLYPH_FROM (glyph) == to + 1)))
|
||
goto shaper_error;
|
||
from = LGLYPH_FROM (glyph);
|
||
to = LGLYPH_TO (glyph);
|
||
}
|
||
composition_gstring_adjust_zero_width (gstring);
|
||
return composition_gstring_put_cache (gstring, XFIXNUM (n));
|
||
|
||
shaper_error:
|
||
return Qnil;
|
||
}
|
||
|
||
DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs,
|
||
2, 2, 0,
|
||
doc: /* Return a list of variation glyphs for CHARACTER in FONT-OBJECT.
|
||
Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
|
||
where
|
||
VARIATION-SELECTOR is a character code of variation selector
|
||
(#xFE00..#xFE0F or #xE0100..#xE01EF).
|
||
GLYPH-ID is a glyph code of the corresponding variation glyph, an integer. */)
|
||
(Lisp_Object font_object, Lisp_Object character)
|
||
{
|
||
unsigned variations[256];
|
||
struct font *font;
|
||
int i, n;
|
||
Lisp_Object val;
|
||
|
||
CHECK_FONT_OBJECT (font_object);
|
||
CHECK_CHARACTER (character);
|
||
font = XFONT_OBJECT (font_object);
|
||
if (! font->driver->get_variation_glyphs)
|
||
return Qnil;
|
||
n = font->driver->get_variation_glyphs (font, XFIXNUM (character), variations);
|
||
if (! n)
|
||
return Qnil;
|
||
val = Qnil;
|
||
for (i = 0; i < 255; i++)
|
||
if (variations[i])
|
||
{
|
||
int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
|
||
Lisp_Object code = INT_TO_INTEGER (variations[i]);
|
||
val = Fcons (Fcons (make_fixnum (vs), code), val);
|
||
}
|
||
return val;
|
||
}
|
||
|
||
/* Return a description of the font at POSITION in the current buffer.
|
||
If the 2nd optional arg CH is non-nil, it is a character to check
|
||
the font instead of the character at POSITION.
|
||
|
||
For a graphical display, return a cons (FONT-OBJECT . GLYPH-CODE).
|
||
FONT-OBJECT is the font for the character at POSITION in the current
|
||
buffer. This is computed from all the text properties and overlays
|
||
that apply to POSITION. POSITION may be nil, in which case,
|
||
FONT-SPEC is the font for displaying the character CH with the
|
||
default face. GLYPH-CODE is the glyph code in the font to use for
|
||
the character, it is a fixnum, if it is small enough, otherwise a
|
||
bignum.
|
||
|
||
For a text terminal, return a nonnegative integer glyph code for
|
||
the character, or a negative integer if the character is not
|
||
displayable. Terminal glyph codes are system-dependent integers
|
||
that represent displayable characters: for example, on a Linux x86
|
||
console they represent VGA code points.
|
||
|
||
It returns nil in the following cases:
|
||
|
||
(1) The window system doesn't have a font for the character (thus
|
||
it is displayed by an empty box).
|
||
|
||
(2) The character code is invalid.
|
||
|
||
(3) If POSITION is not nil, and the current buffer is not displayed
|
||
in any window.
|
||
|
||
(4) For a text terminal, the terminal does not report glyph codes.
|
||
|
||
In addition, the returned font name may not take into account of
|
||
such redisplay engine hooks as what used in jit-lock-mode if
|
||
POSITION is currently not visible. */
|
||
|
||
|
||
DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
|
||
doc: /* For internal use only. */)
|
||
(Lisp_Object position, Lisp_Object ch)
|
||
{
|
||
ptrdiff_t pos, pos_byte, dummy;
|
||
int face_id;
|
||
int c;
|
||
struct frame *f;
|
||
|
||
if (NILP (position))
|
||
{
|
||
CHECK_CHARACTER (ch);
|
||
c = XFIXNUM (ch);
|
||
f = XFRAME (selected_frame);
|
||
face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
|
||
pos = -1;
|
||
}
|
||
else
|
||
{
|
||
Lisp_Object window;
|
||
struct window *w;
|
||
|
||
EMACS_INT fixed_pos = fix_position (position);
|
||
if (! (BEGV <= fixed_pos && fixed_pos < ZV))
|
||
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
|
||
pos = fixed_pos;
|
||
pos_byte = CHAR_TO_BYTE (pos);
|
||
if (NILP (ch))
|
||
c = FETCH_CHAR (pos_byte);
|
||
else
|
||
{
|
||
CHECK_FIXNAT (ch);
|
||
c = XFIXNUM (ch);
|
||
}
|
||
window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
|
||
if (NILP (window))
|
||
return Qnil;
|
||
w = XWINDOW (window);
|
||
f = XFRAME (w->frame);
|
||
face_id = face_at_buffer_position (w, pos, &dummy,
|
||
pos + 100, false, -1, 0);
|
||
}
|
||
if (! CHAR_VALID_P (c))
|
||
return Qnil;
|
||
|
||
if (! FRAME_WINDOW_P (f))
|
||
return terminal_glyph_code (FRAME_TERMINAL (f), c);
|
||
|
||
/* We need the basic faces to be valid below, so recompute them if
|
||
some code just happened to clear the face cache. */
|
||
if (FRAME_FACE_CACHE (f)->used == 0)
|
||
recompute_basic_faces (f);
|
||
|
||
face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
|
||
struct face *face = FACE_FROM_ID (f, face_id);
|
||
if (! face->font)
|
||
return Qnil;
|
||
unsigned code = face->font->driver->encode_char (face->font, c);
|
||
if (code == FONT_INVALID_CODE)
|
||
return Qnil;
|
||
Lisp_Object font_object;
|
||
XSETFONT (font_object, face->font);
|
||
return Fcons (font_object, INT_TO_INTEGER (code));
|
||
}
|
||
|
||
|
||
/* This part (through the next ^L) is still experimental and not
|
||
tested much. We may drastically change codes. */
|
||
|
||
/* This code implements support for extracting OTF features of a font
|
||
and exposing them to Lisp, including application of those features
|
||
to arbitrary stretches of text. FIXME: it would be good to finish
|
||
this work and have this in Emacs. */
|
||
|
||
/* OTF handler. */
|
||
|
||
#if 0
|
||
|
||
#define LGSTRING_HEADER_SIZE 6
|
||
#define LGSTRING_GLYPH_SIZE 8
|
||
|
||
static int
|
||
check_gstring (Lisp_Object gstring)
|
||
{
|
||
Lisp_Object val;
|
||
ptrdiff_t i;
|
||
int 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_SLOT (gstring, LGSTRING_IX_LBEARING)))
|
||
CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING));
|
||
if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)))
|
||
CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING));
|
||
if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)))
|
||
CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH));
|
||
if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
|
||
CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
|
||
if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
|
||
CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
|
||
|
||
for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
|
||
{
|
||
val = LGSTRING_GLYPH (gstring, i);
|
||
CHECK_VECTOR (val);
|
||
if (ASIZE (val) < LGSTRING_GLYPH_SIZE)
|
||
goto err;
|
||
if (NILP (AREF (val, LGLYPH_IX_CHAR)))
|
||
break;
|
||
CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM));
|
||
CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO));
|
||
CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR));
|
||
if (!NILP (AREF (val, LGLYPH_IX_CODE)))
|
||
CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE));
|
||
if (!NILP (AREF (val, LGLYPH_IX_WIDTH)))
|
||
CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH));
|
||
if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT)))
|
||
{
|
||
val = AREF (val, LGLYPH_IX_ADJUSTMENT);
|
||
CHECK_VECTOR (val);
|
||
if (ASIZE (val) < 3)
|
||
goto err;
|
||
for (j = 0; j < 3; j++)
|
||
CHECK_FIXNUM (AREF (val, j));
|
||
}
|
||
}
|
||
return i;
|
||
err:
|
||
error ("Invalid glyph-string format");
|
||
return -1;
|
||
}
|
||
|
||
static void
|
||
check_otf_features (Lisp_Object otf_features)
|
||
{
|
||
Lisp_Object val;
|
||
|
||
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); CONSP (val); val = XCDR (val))
|
||
{
|
||
CHECK_SYMBOL (XCAR (val));
|
||
if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
|
||
error ("Invalid OTF GSUB feature: %s",
|
||
SDATA (SYMBOL_NAME (XCAR (val))));
|
||
}
|
||
otf_features = XCDR (otf_features);
|
||
for (val = Fcar (otf_features); CONSP (val); val = XCDR (val))
|
||
{
|
||
CHECK_SYMBOL (XCAR (val));
|
||
if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4)
|
||
error ("Invalid OTF GPOS feature: %s",
|
||
SDATA (SYMBOL_NAME (XCAR (val))));
|
||
}
|
||
}
|
||
|
||
#ifdef HAVE_LIBOTF
|
||
#include <otf.h>
|
||
|
||
Lisp_Object otf_list;
|
||
|
||
static Lisp_Object
|
||
otf_tag_symbol (OTF_Tag tag)
|
||
{
|
||
char name[5];
|
||
|
||
OTF_tag_name (tag, name);
|
||
return Fintern (make_unibyte_string (name, 4), Qnil);
|
||
}
|
||
|
||
static OTF *
|
||
otf_open (Lisp_Object file)
|
||
{
|
||
Lisp_Object val = Fassoc (file, otf_list, Qnil);
|
||
OTF *otf;
|
||
|
||
if (! NILP (val))
|
||
otf = xmint_pointer (XCDR (val));
|
||
else
|
||
{
|
||
otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL;
|
||
val = make_mint_ptr (otf);
|
||
otf_list = Fcons (Fcons (file, val), otf_list);
|
||
}
|
||
return otf;
|
||
}
|
||
|
||
|
||
/* Return a list describing which scripts/languages FONT supports by
|
||
which GSUB/GPOS features of OpenType tables. See the comment of
|
||
(struct font_driver).otf_capability. */
|
||
|
||
Lisp_Object
|
||
font_otf_capability (struct font *font)
|
||
{
|
||
OTF *otf;
|
||
Lisp_Object capability = Fcons (Qnil, Qnil);
|
||
int i;
|
||
|
||
otf = otf_open (font->props[FONT_FILE_INDEX]);
|
||
if (! otf)
|
||
return Qnil;
|
||
for (i = 0; i < 2; i++)
|
||
{
|
||
OTF_GSUB_GPOS *gsub_gpos;
|
||
Lisp_Object script_list = Qnil;
|
||
int j;
|
||
|
||
if (OTF_get_features (otf, i == 0) < 0)
|
||
continue;
|
||
gsub_gpos = i == 0 ? otf->gsub : otf->gpos;
|
||
for (j = gsub_gpos->ScriptList.ScriptCount - 1; j >= 0; j--)
|
||
{
|
||
OTF_Script *script = gsub_gpos->ScriptList.Script + j;
|
||
Lisp_Object langsys_list = Qnil;
|
||
Lisp_Object script_tag = otf_tag_symbol (script->ScriptTag);
|
||
int k;
|
||
|
||
for (k = script->LangSysCount; k >= 0; k--)
|
||
{
|
||
OTF_LangSys *langsys;
|
||
Lisp_Object feature_list = Qnil;
|
||
Lisp_Object langsys_tag;
|
||
int l;
|
||
|
||
if (k == script->LangSysCount)
|
||
{
|
||
langsys = &script->DefaultLangSys;
|
||
langsys_tag = Qnil;
|
||
}
|
||
else
|
||
{
|
||
langsys = script->LangSys + k;
|
||
langsys_tag
|
||
= otf_tag_symbol (script->LangSysRecord[k].LangSysTag);
|
||
}
|
||
for (l = langsys->FeatureCount - 1; l >= 0; l--)
|
||
{
|
||
OTF_Feature *feature
|
||
= gsub_gpos->FeatureList.Feature + langsys->FeatureIndex[l];
|
||
Lisp_Object feature_tag
|
||
= otf_tag_symbol (feature->FeatureTag);
|
||
|
||
feature_list = Fcons (feature_tag, feature_list);
|
||
}
|
||
langsys_list = Fcons (Fcons (langsys_tag, feature_list),
|
||
langsys_list);
|
||
}
|
||
script_list = Fcons (Fcons (script_tag, langsys_list),
|
||
script_list);
|
||
}
|
||
|
||
if (i == 0)
|
||
XSETCAR (capability, script_list);
|
||
else
|
||
XSETCDR (capability, script_list);
|
||
}
|
||
|
||
return capability;
|
||
}
|
||
|
||
/* 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 (Lisp_Object spec, char *features)
|
||
{
|
||
Lisp_Object val;
|
||
char *p;
|
||
bool asterisk;
|
||
|
||
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++ = '*';
|
||
}
|
||
else if (! asterisk)
|
||
{
|
||
val = SYMBOL_NAME (val);
|
||
p += esprintf (p, "%s", SDATA (val));
|
||
}
|
||
else
|
||
{
|
||
val = SYMBOL_NAME (val);
|
||
p += esprintf (p, "~%s", SDATA (val));
|
||
}
|
||
}
|
||
if (CONSP (spec))
|
||
error ("OTF spec too long");
|
||
}
|
||
|
||
Lisp_Object
|
||
font_otf_DeviceTable (OTF_DeviceTable *device_table)
|
||
{
|
||
int len = device_table->StartSize - device_table->EndSize + 1;
|
||
|
||
return Fcons (make_fixnum (len),
|
||
make_unibyte_string (device_table->DeltaValue, len));
|
||
}
|
||
|
||
Lisp_Object
|
||
font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record)
|
||
{
|
||
Lisp_Object val = make_nil_vector (8);
|
||
|
||
if (value_format & OTF_XPlacement)
|
||
ASET (val, 0, make_fixnum (value_record->XPlacement));
|
||
if (value_format & OTF_YPlacement)
|
||
ASET (val, 1, make_fixnum (value_record->YPlacement));
|
||
if (value_format & OTF_XAdvance)
|
||
ASET (val, 2, make_fixnum (value_record->XAdvance));
|
||
if (value_format & OTF_YAdvance)
|
||
ASET (val, 3, make_fixnum (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;
|
||
}
|
||
|
||
Lisp_Object
|
||
font_otf_Anchor (OTF_Anchor *anchor)
|
||
{
|
||
Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1);
|
||
ASET (val, 0, make_fixnum (anchor->XCoordinate));
|
||
ASET (val, 1, make_fixnum (anchor->YCoordinate));
|
||
if (anchor->AnchorFormat == 2)
|
||
ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint));
|
||
else
|
||
{
|
||
ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable));
|
||
ASET (val, 4, font_otf_DeviceTable (&anchor->f.f2.YDeviceTable));
|
||
}
|
||
return val;
|
||
}
|
||
#endif /* HAVE_LIBOTF */
|
||
|
||
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:
|
||
(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 LANGSYS is nil, the default langsys is selected.
|
||
|
||
The features are applied in the order they appear in the list. The
|
||
symbol `*' means to apply all available features not present in this
|
||
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 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 are
|
||
produced in GSTRING-OUT, and the value is nil.
|
||
|
||
See the documentation of `composition-get-gstring' for the format of
|
||
glyph-string. */)
|
||
(Lisp_Object otf_features, Lisp_Object gstring_in, Lisp_Object from, Lisp_Object to, Lisp_Object gstring_out, Lisp_Object 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_OBJECT (font_object);
|
||
font = XFONT_OBJECT (font_object);
|
||
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_FIXNAT (from);
|
||
CHECK_FIXNAT (to);
|
||
CHECK_FIXNAT (index);
|
||
|
||
if (XFIXNUM (from) >= XFIXNUM (to) || XFIXNUM (to) > len)
|
||
args_out_of_range_3 (from, to, make_fixnum (len));
|
||
if (XFIXNUM (index) >= ASIZE (gstring_out))
|
||
args_out_of_range (index, make_fixnum (ASIZE (gstring_out)));
|
||
num = font->driver->otf_drive (font, otf_features,
|
||
gstring_in, XFIXNUM (from), XFIXNUM (to),
|
||
gstring_out, XFIXNUM (index), 0);
|
||
if (num < 0)
|
||
return Qnil;
|
||
return make_fixnum (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.
|
||
OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
|
||
in this format:
|
||
(SCRIPT LANGSYS FEATURE ...)
|
||
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
|
||
character code corresponding to the glyph or nil if there's no
|
||
corresponding character. */)
|
||
(Lisp_Object font_object, Lisp_Object character, Lisp_Object otf_features)
|
||
{
|
||
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
|
||
Lisp_Object gstring_in, gstring_out, g;
|
||
Lisp_Object alternates;
|
||
int i, num;
|
||
|
||
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_fixnum (1));
|
||
g = LGSTRING_GLYPH (gstring_in, 0);
|
||
LGLYPH_SET_CHAR (g, XFIXNUM (character));
|
||
gstring_out = Ffont_make_gstring (font_object, make_fixnum (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_fixnum (ASIZE (gstring_out) * 2));
|
||
alternates = Qnil;
|
||
for (i = 0; i < num; i++)
|
||
{
|
||
Lisp_Object g = LGSTRING_GLYPH (gstring_out, i);
|
||
int c = LGLYPH_CHAR (g);
|
||
unsigned code = LGLYPH_CODE (g);
|
||
|
||
alternates = Fcons (Fcons (make_fixnum (code),
|
||
c > 0 ? make_fixnum (c) : Qnil),
|
||
alternates);
|
||
}
|
||
return Fnreverse (alternates);
|
||
}
|
||
#endif /* 0 */
|
||
|
||
|
||
#ifdef FONT_DEBUG
|
||
|
||
DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
|
||
doc: /* Open FONT-ENTITY. */)
|
||
(Lisp_Object font_entity, Lisp_Object size, Lisp_Object frame)
|
||
{
|
||
intmax_t isize;
|
||
struct frame *f = decode_live_frame (frame);
|
||
|
||
CHECK_FONT_ENTITY (font_entity);
|
||
|
||
if (NILP (size))
|
||
isize = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX));
|
||
else
|
||
{
|
||
CHECK_NUMBER (size);
|
||
if (FLOATP (size))
|
||
isize = POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES (f));
|
||
else if (! integer_to_intmax (size, &isize))
|
||
args_out_of_range (font_entity, size);
|
||
if (! (INT_MIN <= isize && isize <= INT_MAX))
|
||
args_out_of_range (font_entity, size);
|
||
if (isize == 0)
|
||
isize = 120;
|
||
}
|
||
return font_open_entity (f, font_entity, isize);
|
||
}
|
||
|
||
DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0,
|
||
doc: /* Close FONT-OBJECT. */)
|
||
(Lisp_Object font_object, Lisp_Object frame)
|
||
{
|
||
CHECK_FONT_OBJECT (font_object);
|
||
font_close_object (decode_live_frame (frame), font_object);
|
||
return Qnil;
|
||
}
|
||
|
||
DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
|
||
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 the font name, a string (or nil if the font backend doesn't
|
||
provide a name).
|
||
|
||
FILENAME is the font file name, a string (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 pixels.
|
||
|
||
ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
|
||
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 describe the details 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, CAPABILITY is nil. */)
|
||
(Lisp_Object font_object)
|
||
{
|
||
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
|
||
return CALLN (Fvector,
|
||
AREF (font_object, FONT_NAME_INDEX),
|
||
AREF (font_object, FONT_FILE_INDEX),
|
||
make_fixnum (font->pixel_size),
|
||
make_fixnum (font->max_width),
|
||
make_fixnum (font->ascent),
|
||
make_fixnum (font->descent),
|
||
make_fixnum (font->space_width),
|
||
make_fixnum (font->average_width),
|
||
(font->driver->otf_capability
|
||
? Fcons (Qopentype, font->driver->otf_capability (font))
|
||
: Qnil));
|
||
}
|
||
|
||
DEFUN ("font-has-char-p", Ffont_has_char_p, Sfont_has_char_p, 2, 3, 0,
|
||
doc:
|
||
/* Return non-nil if FONT on FRAME has a glyph for character CH.
|
||
FONT can be either a font-entity or a font-object. If it is
|
||
a font-entity and the result is nil, it means the font needs to be
|
||
opened (with `open-font') to check.
|
||
FRAME defaults to the selected frame if it is nil or omitted. */)
|
||
(Lisp_Object font, Lisp_Object ch, Lisp_Object frame)
|
||
{
|
||
struct frame *f;
|
||
CHECK_FONT (font);
|
||
CHECK_CHARACTER (ch);
|
||
|
||
if (NILP (frame))
|
||
f = XFRAME (selected_frame);
|
||
else
|
||
{
|
||
CHECK_FRAME (frame);
|
||
f = XFRAME (frame);
|
||
}
|
||
|
||
if (font_has_char (f, font, XFIXNAT (ch)) <= 0)
|
||
return Qnil;
|
||
else
|
||
return Qt;
|
||
}
|
||
|
||
DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0,
|
||
doc:
|
||
/* Return a vector of FONT-OBJECT's glyphs for the specified characters.
|
||
FROM and TO are positions (integers or markers) specifying a region
|
||
of the current buffer, and can be in either order. If the optional
|
||
fourth arg OBJECT is not nil, it is a string or a vector containing
|
||
the target characters between indices FROM and TO, which are treated
|
||
as in `substring'.
|
||
|
||
Each element is a vector containing information of a glyph in this format:
|
||
[FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
|
||
where
|
||
FROM is an index numbers of a character the glyph corresponds to.
|
||
TO is the same as FROM.
|
||
C is the character of the glyph.
|
||
CODE is the glyph-code of C in FONT-OBJECT.
|
||
WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
|
||
ADJUSTMENT is always nil.
|
||
|
||
If FONT-OBJECT doesn't have a glyph for a character, the corresponding
|
||
element is nil.
|
||
|
||
Also see `font-has-char-p', which is more efficient than this function
|
||
if you just want to check whether FONT-OBJECT has a glyph for a
|
||
character. */)
|
||
(Lisp_Object font_object, Lisp_Object from, Lisp_Object to,
|
||
Lisp_Object object)
|
||
{
|
||
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
|
||
ptrdiff_t len;
|
||
Lisp_Object *chars;
|
||
USE_SAFE_ALLOCA;
|
||
|
||
if (NILP (object))
|
||
{
|
||
ptrdiff_t charpos, bytepos;
|
||
|
||
validate_region (&from, &to);
|
||
if (EQ (from, to))
|
||
return Qnil;
|
||
len = XFIXNAT (to) - XFIXNAT (from);
|
||
SAFE_ALLOCA_LISP (chars, len);
|
||
charpos = XFIXNAT (from);
|
||
bytepos = CHAR_TO_BYTE (charpos);
|
||
for (ptrdiff_t i = 0; charpos < XFIXNAT (to); i++)
|
||
{
|
||
int c = fetch_char_advance (&charpos, &bytepos);
|
||
chars[i] = make_fixnum (c);
|
||
}
|
||
}
|
||
else if (STRINGP (object))
|
||
{
|
||
const unsigned char *p;
|
||
ptrdiff_t ifrom, ito;
|
||
|
||
validate_subarray (object, from, to, SCHARS (object), &ifrom, &ito);
|
||
if (ifrom == ito)
|
||
return Qnil;
|
||
len = ito - ifrom;
|
||
SAFE_ALLOCA_LISP (chars, len);
|
||
p = SDATA (object);
|
||
if (STRING_MULTIBYTE (object))
|
||
{
|
||
int c;
|
||
|
||
/* Skip IFROM characters from the beginning. */
|
||
for (ptrdiff_t i = 0; i < ifrom; i++)
|
||
p += BYTES_BY_CHAR_HEAD (*p);
|
||
|
||
/* Now fetch an interesting characters. */
|
||
for (ptrdiff_t i = 0; i < len; i++)
|
||
{
|
||
c = string_char_advance (&p);
|
||
chars[i] = make_fixnum (c);
|
||
}
|
||
}
|
||
else
|
||
for (ptrdiff_t i = 0; i < len; i++)
|
||
chars[i] = make_fixnum (p[ifrom + i]);
|
||
}
|
||
else if (VECTORP (object))
|
||
{
|
||
ptrdiff_t ifrom, ito;
|
||
|
||
validate_subarray (object, from, to, ASIZE (object), &ifrom, &ito);
|
||
if (ifrom == ito)
|
||
return Qnil;
|
||
len = ito - ifrom;
|
||
for (ptrdiff_t i = 0; i < len; i++)
|
||
{
|
||
Lisp_Object elt = AREF (object, ifrom + i);
|
||
CHECK_CHARACTER (elt);
|
||
}
|
||
chars = aref_addr (object, ifrom);
|
||
}
|
||
else
|
||
wrong_type_argument (Qarrayp, object);
|
||
|
||
Lisp_Object vec = make_nil_vector (len);
|
||
for (ptrdiff_t i = 0; i < len; i++)
|
||
{
|
||
Lisp_Object g;
|
||
int c = XFIXNAT (chars[i]);
|
||
unsigned code;
|
||
struct font_metrics metrics;
|
||
|
||
code = font->driver->encode_char (font, c);
|
||
if (code == FONT_INVALID_CODE)
|
||
{
|
||
ASET (vec, i, Qnil);
|
||
continue;
|
||
}
|
||
g = LGLYPH_NEW ();
|
||
LGLYPH_SET_FROM (g, i);
|
||
LGLYPH_SET_TO (g, i);
|
||
LGLYPH_SET_CHAR (g, c);
|
||
LGLYPH_SET_CODE (g, code);
|
||
font->driver->text_extents (font, &code, 1, &metrics);
|
||
LGLYPH_SET_WIDTH (g, metrics.width);
|
||
LGLYPH_SET_LBEARING (g, metrics.lbearing);
|
||
LGLYPH_SET_RBEARING (g, metrics.rbearing);
|
||
LGLYPH_SET_ASCENT (g, metrics.ascent);
|
||
LGLYPH_SET_DESCENT (g, metrics.descent);
|
||
ASET (vec, i, g);
|
||
}
|
||
if (! VECTORP (object))
|
||
SAFE_FREE ();
|
||
return vec;
|
||
}
|
||
|
||
DEFUN ("font-match-p", Ffont_match_p, Sfont_match_p, 2, 2, 0,
|
||
doc: /* Return t if and only if font-spec SPEC matches with FONT.
|
||
FONT is a font-spec, font-entity, or font-object. */)
|
||
(Lisp_Object spec, Lisp_Object font)
|
||
{
|
||
CHECK_FONT_SPEC (spec);
|
||
CHECK_FONT (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 POSITION.
|
||
Optional second arg WINDOW, if non-nil, is a window displaying
|
||
the current buffer. It defaults to the currently selected window.
|
||
Optional third arg STRING, if non-nil, is a string containing the target
|
||
character at index specified by POSITION. */)
|
||
(Lisp_Object position, Lisp_Object window, Lisp_Object string)
|
||
{
|
||
struct window *w = decode_live_window (window);
|
||
EMACS_INT pos;
|
||
|
||
if (NILP (string))
|
||
{
|
||
if (XBUFFER (w->contents) != current_buffer)
|
||
error ("Specified window is not displaying the current buffer");
|
||
pos = fix_position (position);
|
||
if (! (BEGV <= pos && pos < ZV))
|
||
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
|
||
}
|
||
else
|
||
{
|
||
CHECK_FIXNUM (position);
|
||
CHECK_STRING (string);
|
||
pos = XFIXNUM (position);
|
||
if (! (0 <= pos && pos < SCHARS (string)))
|
||
args_out_of_range (string, position);
|
||
}
|
||
|
||
return font_at (-1, pos, NULL, w, string);
|
||
}
|
||
|
||
#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.
|
||
The value is a number of glyphs drawn.
|
||
Type C-l to recover what previously shown. */)
|
||
(Lisp_Object font_object, Lisp_Object string)
|
||
{
|
||
Lisp_Object frame = selected_frame;
|
||
struct frame *f = XFRAME (frame);
|
||
struct font *font;
|
||
struct face *face;
|
||
int i, len, width;
|
||
unsigned *code;
|
||
|
||
CHECK_FONT_GET_OBJECT (font_object, font);
|
||
CHECK_STRING (string);
|
||
len = SCHARS (string);
|
||
code = alloca (sizeof (unsigned) * len);
|
||
for (i = 0; i < len; i++)
|
||
{
|
||
Lisp_Object ch = Faref (string, make_fixnum (i));
|
||
Lisp_Object val;
|
||
int c = XFIXNUM (ch);
|
||
|
||
code[i] = font->driver->encode_char (font, c);
|
||
if (code[i] == FONT_INVALID_CODE)
|
||
break;
|
||
}
|
||
face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
|
||
face->fontp = font;
|
||
if (font->driver->prepare_face)
|
||
font->driver->prepare_face (f, face);
|
||
width = font->driver->text_extents (font, code, i, NULL);
|
||
len = font->driver->draw_text (f, face, 0, font->ascent, code, i, width);
|
||
if (font->driver->done_face)
|
||
font->driver->done_face (f, face);
|
||
face->fontp = NULL;
|
||
return make_fixnum (len);
|
||
}
|
||
#endif
|
||
|
||
DEFUN ("frame-font-cache", Fframe_font_cache, Sframe_font_cache, 0, 1, 0,
|
||
doc: /* Return FRAME's font cache. Mainly used for debugging.
|
||
If FRAME is omitted or nil, use the selected frame. */)
|
||
(Lisp_Object frame)
|
||
{
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
struct frame *f = decode_live_frame (frame);
|
||
|
||
if (FRAME_WINDOW_P (f))
|
||
return FRAME_DISPLAY_INFO (f)->name_list_element;
|
||
else
|
||
#endif
|
||
return Qnil;
|
||
}
|
||
|
||
#endif /* FONT_DEBUG */
|
||
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
|
||
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 14 elements:
|
||
[ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE
|
||
DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
|
||
FILENAME CAPABILITY ]
|
||
where
|
||
OPENED-NAME is the name used for opening the font,
|
||
FULL-NAME is the full name of the font,
|
||
SIZE is the pixelsize of the font,
|
||
HEIGHT is the pixel-height of the font (i.e., ascent + descent),
|
||
BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
|
||
RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
|
||
how to compose characters,
|
||
MAX-WIDTH is the maximum advance width of the font,
|
||
ASCENT, DESCENT, SPACE-WIDTH, and AVERAGE-WIDTH are metrics of
|
||
the font in pixels,
|
||
FILENAME is the font file name, a string (or nil if the font backend
|
||
doesn't provide a file name).
|
||
CAPABILITY is a list whose first element is a symbol representing the
|
||
font format, one of `x', `opentype', `truetype', `type1', `pcf', or `bdf'.
|
||
The remaining elements describe the details of the font capabilities,
|
||
as follows:
|
||
|
||
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 form:
|
||
((SCRIPT (LANGSYS FEATURE ...) ...) ...)
|
||
|
||
where
|
||
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 an OpenType font, there are no elements
|
||
in CAPABILITY except the font format symbol.
|
||
|
||
If the named font cannot be opened and loaded, return nil. */)
|
||
(Lisp_Object name, Lisp_Object frame)
|
||
{
|
||
struct frame *f;
|
||
struct font *font;
|
||
Lisp_Object info;
|
||
Lisp_Object font_object;
|
||
|
||
if (! FONTP (name))
|
||
CHECK_STRING (name);
|
||
f = decode_window_system_frame (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, 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);
|
||
|
||
/* Sanity check to make sure we have initialized max_width. */
|
||
eassert (XFONT_OBJECT (font_object)->max_width < 1024 * 1024 * 1024);
|
||
|
||
info = CALLN (Fvector,
|
||
AREF (font_object, FONT_NAME_INDEX),
|
||
AREF (font_object, FONT_FULLNAME_INDEX),
|
||
make_fixnum (font->pixel_size),
|
||
make_fixnum (font->height),
|
||
make_fixnum (font->baseline_offset),
|
||
make_fixnum (font->relative_compose),
|
||
make_fixnum (font->default_ascent),
|
||
make_fixnum (font->max_width),
|
||
make_fixnum (font->ascent),
|
||
make_fixnum (font->descent),
|
||
make_fixnum (font->space_width),
|
||
make_fixnum (font->average_width),
|
||
AREF (font_object, FONT_FILE_INDEX),
|
||
(font->driver->otf_capability
|
||
? Fcons (Qopentype, font->driver->otf_capability (font))
|
||
: Qnil));
|
||
|
||
#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
|
||
|
||
|
||
#define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
|
||
|
||
static Lisp_Object
|
||
build_style_table (const struct table_entry *entry, int nelement)
|
||
{
|
||
Lisp_Object table = make_nil_vector (nelement);
|
||
for (int i = 0; i < nelement; i++)
|
||
{
|
||
int j;
|
||
for (j = 0; entry[i].names[j]; j++)
|
||
continue;
|
||
Lisp_Object elt = make_nil_vector (j + 1);
|
||
ASET (elt, 0, make_fixnum (entry[i].numeric));
|
||
for (j = 0; entry[i].names[j]; j++)
|
||
ASET (elt, j + 1, intern_c_string (entry[i].names[j]));
|
||
ASET (table, i, elt);
|
||
}
|
||
return table;
|
||
}
|
||
|
||
/* The deferred font-log data of the form [ACTION ARG RESULT].
|
||
If ACTION is not nil, that is added to the log when font_add_log is
|
||
called next time. At that time, ACTION is set back to nil. */
|
||
static Lisp_Object Vfont_log_deferred;
|
||
|
||
/* Prepend the font-related logging data in Vfont_log if it is not
|
||
t. ACTION describes a kind of font-related action (e.g. listing,
|
||
opening), ARG is the argument for the action, and RESULT is the
|
||
result of the action. */
|
||
void
|
||
font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
|
||
{
|
||
Lisp_Object val;
|
||
int i;
|
||
|
||
if (EQ (Vfont_log, Qt))
|
||
return;
|
||
if (STRINGP (AREF (Vfont_log_deferred, 0)))
|
||
{
|
||
char *str = SSDATA (AREF (Vfont_log_deferred, 0));
|
||
|
||
ASET (Vfont_log_deferred, 0, Qnil);
|
||
font_add_log (str, AREF (Vfont_log_deferred, 1),
|
||
AREF (Vfont_log_deferred, 2));
|
||
}
|
||
|
||
if (FONTP (arg))
|
||
{
|
||
Lisp_Object tail, elt;
|
||
AUTO_STRING (equal, "=");
|
||
|
||
val = Ffont_xlfd_name (arg, Qt, Qt);
|
||
for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
|
||
tail = XCDR (tail))
|
||
{
|
||
elt = XCAR (tail);
|
||
if (EQ (XCAR (elt), QCscript)
|
||
&& SYMBOLP (XCDR (elt)))
|
||
val = concat3 (val, SYMBOL_NAME (QCscript),
|
||
concat2 (equal, SYMBOL_NAME (XCDR (elt))));
|
||
else if (EQ (XCAR (elt), QClang)
|
||
&& SYMBOLP (XCDR (elt)))
|
||
val = concat3 (val, SYMBOL_NAME (QClang),
|
||
concat2 (equal, SYMBOL_NAME (XCDR (elt))));
|
||
else if (EQ (XCAR (elt), QCotf)
|
||
&& CONSP (XCDR (elt)) && SYMBOLP (XCAR (XCDR (elt))))
|
||
val = concat3 (val, SYMBOL_NAME (QCotf),
|
||
concat2 (equal, SYMBOL_NAME (XCAR (XCDR (elt)))));
|
||
}
|
||
arg = val;
|
||
}
|
||
|
||
if (CONSP (result)
|
||
&& VECTORP (XCAR (result))
|
||
&& ASIZE (XCAR (result)) > 0
|
||
&& FONTP (AREF (XCAR (result), 0)))
|
||
result = font_vconcat_entity_vectors (result);
|
||
if (FONTP (result))
|
||
{
|
||
val = Ffont_xlfd_name (result, Qt, Qt);
|
||
if (! FONT_SPEC_P (result))
|
||
{
|
||
AUTO_STRING (colon, ":");
|
||
val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
|
||
colon, val);
|
||
}
|
||
result = val;
|
||
}
|
||
else if (CONSP (result))
|
||
{
|
||
Lisp_Object tail;
|
||
result = Fcopy_sequence (result);
|
||
for (tail = result; CONSP (tail); tail = XCDR (tail))
|
||
{
|
||
val = XCAR (tail);
|
||
if (FONTP (val))
|
||
val = Ffont_xlfd_name (val, Qt, 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, Qt);
|
||
ASET (result, i, val);
|
||
}
|
||
}
|
||
Vfont_log = Fcons (list3 (intern (action), arg, result), Vfont_log);
|
||
}
|
||
|
||
/* Record a font-related logging data to be added to Vfont_log when
|
||
font_add_log is called next time. ACTION, ARG, RESULT are the same
|
||
as font_add_log. */
|
||
|
||
void
|
||
font_deferred_log (const char *action, Lisp_Object arg, Lisp_Object result)
|
||
{
|
||
if (EQ (Vfont_log, Qt))
|
||
return;
|
||
ASET (Vfont_log_deferred, 0, build_string (action));
|
||
ASET (Vfont_log_deferred, 1, arg);
|
||
ASET (Vfont_log_deferred, 2, result);
|
||
}
|
||
|
||
void
|
||
font_drop_xrender_surfaces (struct frame *f)
|
||
{
|
||
struct font_driver_list *list;
|
||
|
||
for (list = f->font_driver_list; list; list = list->next)
|
||
if (list->on && list->driver->drop_xrender_surfaces)
|
||
list->driver->drop_xrender_surfaces (f);
|
||
}
|
||
|
||
void
|
||
syms_of_font (void)
|
||
{
|
||
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. */
|
||
PDUMPER_REMEMBER_SCALAR (sort_shift_bits);
|
||
|
||
font_charset_alist = Qnil;
|
||
staticpro (&font_charset_alist);
|
||
|
||
DEFSYM (Qopentype, "opentype");
|
||
|
||
/* Currently used by hbfont.c, which has no syms_of_hbfont function
|
||
of its own. */
|
||
DEFSYM (Qcanonical_combining_class, "canonical-combining-class");
|
||
|
||
/* Important character set symbols. */
|
||
DEFSYM (Qascii_0, "ascii-0");
|
||
DEFSYM (Qiso8859_1, "iso8859-1");
|
||
DEFSYM (Qiso10646_1, "iso10646-1");
|
||
DEFSYM (Qunicode_bmp, "unicode-bmp");
|
||
DEFSYM (Qemoji, "emoji");
|
||
|
||
/* Symbols representing keys of font extra info. */
|
||
DEFSYM (QCotf, ":otf");
|
||
DEFSYM (QClang, ":lang");
|
||
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 (QCavgwidth, ":avgwidth");
|
||
DEFSYM (QCfont_entity, ":font-entity");
|
||
DEFSYM (QCcombining_capability, ":combining-capability");
|
||
|
||
/* Symbols representing values of font spacing property. */
|
||
DEFSYM (Qc, "c");
|
||
DEFSYM (Qm, "m");
|
||
DEFSYM (Qp, "p");
|
||
DEFSYM (Qd, "d");
|
||
|
||
/* Special ADSTYLE properties to avoid fonts used for Latin
|
||
characters; used in xfont.c and ftfont.c. */
|
||
DEFSYM (Qja, "ja");
|
||
DEFSYM (Qko, "ko");
|
||
|
||
DEFSYM (QCuser_spec, ":user-spec");
|
||
|
||
/* For shapers that need to know text directionality. */
|
||
DEFSYM (QL2R, "L2R");
|
||
DEFSYM (QR2L, "R2L");
|
||
|
||
DEFSYM (Qfont_extra_type, "font-extra-type");
|
||
DEFSYM (Qfont_driver_superseded_by, "font-driver-superseded-by");
|
||
|
||
scratch_font_spec = Ffont_spec (0, NULL);
|
||
staticpro (&scratch_font_spec);
|
||
scratch_font_prefer = Ffont_spec (0, NULL);
|
||
staticpro (&scratch_font_prefer);
|
||
|
||
Vfont_log_deferred = make_nil_vector (3);
|
||
staticpro (&Vfont_log_deferred);
|
||
|
||
#if 0
|
||
#ifdef HAVE_LIBOTF
|
||
staticpro (&otf_list);
|
||
otf_list = Qnil;
|
||
#endif /* HAVE_LIBOTF */
|
||
#endif /* 0 */
|
||
|
||
defsubr (&Sfontp);
|
||
defsubr (&Sfont_spec);
|
||
defsubr (&Sfont_get);
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
defsubr (&Sfont_face_attributes);
|
||
#endif
|
||
defsubr (&Sfont_put);
|
||
defsubr (&Slist_fonts);
|
||
defsubr (&Sfont_family_list);
|
||
defsubr (&Sfind_font);
|
||
defsubr (&Sfont_xlfd_name);
|
||
defsubr (&Sclear_font_cache);
|
||
defsubr (&Sfont_shape_gstring);
|
||
defsubr (&Sfont_variation_glyphs);
|
||
defsubr (&Sinternal_char_font);
|
||
#if 0
|
||
defsubr (&Sfont_drive_otf);
|
||
defsubr (&Sfont_otf_alternates);
|
||
#endif /* 0 */
|
||
|
||
#ifdef FONT_DEBUG
|
||
defsubr (&Sopen_font);
|
||
defsubr (&Sclose_font);
|
||
defsubr (&Squery_font);
|
||
defsubr (&Sfont_get_glyphs);
|
||
defsubr (&Sfont_has_char_p);
|
||
defsubr (&Sfont_match_p);
|
||
defsubr (&Sfont_at);
|
||
#if 0
|
||
defsubr (&Sdraw_string);
|
||
#endif
|
||
defsubr (&Sframe_font_cache);
|
||
#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 belonging 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;
|
||
|
||
/* FIXME: These 3 vars are not quite what they appear: setq on them
|
||
won't have any effect other than disconnect them from the style
|
||
table used by the font display code. So we make them read-only,
|
||
to avoid this confusing situation. */
|
||
|
||
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.
|
||
This variable cannot be set; trying to do so will signal an error. */);
|
||
Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
|
||
make_symbol_constant (intern_c_string ("font-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.
|
||
This variable cannot be set; trying to do so will signal an error. */);
|
||
Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
|
||
make_symbol_constant (intern_c_string ("font-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.
|
||
This variable cannot be set; trying to do so will signal an error. */);
|
||
Vfont_width_table = BUILD_STYLE_TABLE (width_table);
|
||
make_symbol_constant (intern_c_string ("font-width-table"));
|
||
|
||
staticpro (&font_style_table);
|
||
font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table,
|
||
Vfont_width_table);
|
||
|
||
DEFVAR_LISP ("font-log", Vfont_log, doc: /*
|
||
A list that logs font-related actions and results, for debugging.
|
||
The default value is t, which means to suppress logging.
|
||
Set it to nil to enable logging. If the environment variable
|
||
EMACS_FONT_LOG is set at startup, it defaults to nil. */);
|
||
Vfont_log = Qnil;
|
||
|
||
DEFVAR_BOOL ("inhibit-compacting-font-caches", inhibit_compacting_font_caches,
|
||
doc: /*
|
||
If non-nil, don't compact font caches during GC.
|
||
Some large fonts cause lots of consing and trigger GC. If they
|
||
are removed from the font caches, they will need to be opened
|
||
again during redisplay, which slows down redisplay. If you
|
||
see font-related delays in displaying some special characters,
|
||
and cannot switch to a smaller font for those characters, set
|
||
this variable non-nil.
|
||
Disabling compaction of font caches might enlarge the Emacs memory
|
||
footprint in sessions that use lots of different fonts. */);
|
||
|
||
#ifdef WINDOWSNT
|
||
/* Compacting font caches causes slow redisplay on Windows with many
|
||
large fonts, so we disable it by default. */
|
||
inhibit_compacting_font_caches = 1;
|
||
#else
|
||
inhibit_compacting_font_caches = 0;
|
||
#endif
|
||
|
||
DEFVAR_BOOL ("xft-ignore-color-fonts",
|
||
xft_ignore_color_fonts,
|
||
doc: /*
|
||
Non-nil means don't query fontconfig for color fonts, since they often
|
||
cause Xft crashes. Only has an effect in Xft builds. */);
|
||
xft_ignore_color_fonts = true;
|
||
|
||
DEFVAR_BOOL ("query-all-font-backends", query_all_font_backends,
|
||
doc: /*
|
||
If non-nil, attempt to query all available font backends.
|
||
By default Emacs will stop searching for a matching font at the first
|
||
match. */);
|
||
query_all_font_backends = false;
|
||
|
||
#ifdef HAVE_WINDOW_SYSTEM
|
||
#ifdef HAVE_FREETYPE
|
||
syms_of_ftfont ();
|
||
#ifdef HAVE_X_WINDOWS
|
||
syms_of_xfont ();
|
||
#ifdef USE_CAIRO
|
||
syms_of_ftcrfont ();
|
||
#else
|
||
#ifdef HAVE_XFT
|
||
syms_of_xftfont ();
|
||
#endif /* HAVE_XFT */
|
||
#endif /* not USE_CAIRO */
|
||
#else /* not HAVE_X_WINDOWS */
|
||
#ifdef USE_CAIRO
|
||
syms_of_ftcrfont ();
|
||
#endif
|
||
#endif /* not HAVE_X_WINDOWS */
|
||
#else /* not HAVE_FREETYPE */
|
||
#ifdef HAVE_X_WINDOWS
|
||
syms_of_xfont ();
|
||
#endif /* HAVE_X_WINDOWS */
|
||
#endif /* not HAVE_FREETYPE */
|
||
#ifdef HAVE_BDFFONT
|
||
syms_of_bdffont ();
|
||
#endif /* HAVE_BDFFONT */
|
||
#ifdef HAVE_NTGUI
|
||
syms_of_w32font ();
|
||
#endif /* HAVE_NTGUI */
|
||
#ifdef USE_BE_CAIRO
|
||
syms_of_ftcrfont ();
|
||
#endif
|
||
#endif /* HAVE_WINDOW_SYSTEM */
|
||
}
|
||
|
||
void
|
||
init_font (void)
|
||
{
|
||
Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
|
||
}
|