/* font.c -- "Font" primitives.
- Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
- Copyright (C) 2006, 2007, 2008
+ Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+ Copyright (C) 2006, 2007, 2008, 2009
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
-#ifdef HAVE_M17N_FLT
-#include <m17n-flt.h>
-#endif
+#include <setjmp.h>
#include "lisp.h"
#include "buffer.h"
#include "nsterm.h"
#endif /* HAVE_NS */
-Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
-
#ifdef HAVE_NS
extern Lisp_Object Qfontsize;
#endif
/* Important character set strings. */
Lisp_Object Qascii_0, Qiso8859_1, Qiso10646_1, Qunicode_bmp, Qunicode_sip;
-#ifdef HAVE_NS
-#define DEFAULT_ENCODING Qiso10646_1
-#else
#define DEFAULT_ENCODING Qiso8859_1
-#endif
+
+/* Unicode category `Cf'. */
+static Lisp_Object QCf;
/* Special vector of zero length. This is repeatedly used by (struct
font_driver *)->list when a specified font is not found. */
int numeric;
/* The first one is a valid name as a face attribute.
The second one (if any) is a typical name in XLFD field. */
- char *names[5];
- Lisp_Object *symbols;
+ const char *names[5];
};
/* Table of weight numeric values and their names. This table must be
sorted by numeric values in ascending order. */
-static struct table_entry weight_table[] =
+static const struct table_entry weight_table[] =
{
{ 0, { "thin" }},
{ 20, { "ultra-light", "ultralight" }},
{ 40, { "extra-light", "extralight" }},
{ 50, { "light" }},
{ 75, { "semi-light", "semilight", "demilight", "book" }},
- { 100, { "normal", "medium", "regular" }},
+ { 100, { "normal", "medium", "regular", "unspecified" }},
{ 180, { "semi-bold", "semibold", "demibold", "demi" }},
{ 200, { "bold" }},
{ 205, { "extra-bold", "extrabold" }},
/* Table of slant numeric values and their names. This table must be
sorted by numeric values in ascending order. */
-static struct table_entry slant_table[] =
+static const struct table_entry slant_table[] =
{
{ 0, { "reverse-oblique", "ro" }},
{ 10, { "reverse-italic", "ri" }},
- { 100, { "normal", "r" }},
+ { 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 struct table_entry width_table[] =
+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" }},
+ { 100, { "normal", "medium", "regular", "unspecified" }},
{ 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
{ 125, { "expanded" }},
{ 150, { "extra-expanded", "extraexpanded" }},
Lisp_Object QCantialias, QCfont_entity, QCfc_unknown_spec;
/* Symbols representing values of font spacing property. */
Lisp_Object Qc, Qm, Qp, Qd;
+/* Special ADSTYLE properties to avoid fonts used for Latin
+ characters; used in xfont.c and ftfont.c. */
+Lisp_Object Qja, Qko;
Lisp_Object Vfont_encoding_alist;
int i;
Lisp_Object tem;
Lisp_Object obarray;
+ int nbytes, nchars;
if (len == 1 && *str == '*')
return Qnil;
return make_number (atoi (str));
}
- /* The following code is copied from the function intern (in lread.c). */
+ /* The following code is copied from the function intern (in
+ lread.c), and modified to suite our purpose. */
obarray = Vobarray;
if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
obarray = check_obarray (obarray);
- tem = oblookup (obarray, str, len, len);
+ parse_str_as_multibyte ((unsigned char *) str, len, &nchars, &nbytes);
+ if (len == nchars || len != nbytes)
+ /* CONTENTS contains no multibyte sequences or contains an invalid
+ multibyte sequence. We'll make a unibyte string. */
+ tem = oblookup (obarray, str, len, len);
+ else
+ tem = oblookup (obarray, str, nchars, len);
if (SYMBOLP (tem))
return tem;
- return Fintern (make_unibyte_string (str, len), obarray);
+ if (len == nchars || len != nbytes)
+ tem = make_unibyte_string (str, len);
+ else
+ tem = make_multibyte_string (str, nchars, len);
+ return Fintern (tem, obarray);
}
/* Return a pixel size of font-spec SPEC on frame F. */
return -1;
if (len == 255)
abort ();
- elt = Fmake_vector (make_number (2), make_number (255));
+ elt = Fmake_vector (make_number (2), make_number (100));
ASET (elt, 1, val);
args[0] = table;
args[1] = Fmake_vector (make_number (1), elt);
ASET (font_style_table, prop - FONT_WEIGHT_INDEX, Fvconcat (2, args));
- return (255 << 8) | (i << 4);
+ return (100 << 8) | (i << 4);
}
else
{
font_assert (((i >> 4) & 0xF) < ASIZE (table));
elt = AREF (table, ((i >> 4) & 0xF));
font_assert ((i & 0xF) + 1 < ASIZE (elt));
- return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
+ return (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1));
}
extern Lisp_Object Vface_alternative_font_family_alist;
: CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt)))))
return (XCDR (elt));
}
- /* We don't know the encoding of this font. Let's assume `ascii'. */
- return Qascii;
+ return Qnil;
}
/* Return encoding charset and repertory charset for REGISTRY in
return val;
}
XSETCDR (slot, val);
+ if (NILP (val))
+ ASET (font, FONT_EXTRA_INDEX, Fdelq (slot, extra));
return val;
}
Lisp_Object val;
char *p;
- if (len > 255)
+ if (len > 255 || !len)
/* Maximum XLFD name length is 255. */
return -1;
/* Accept "*-.." as a fully specified XLFD. */
- if (name[0] == '*' && name[1] == '-')
+ if (name[0] == '*' && (len == 1 || name[1] == '-'))
i = 1, f[XLFD_FOUNDRY_INDEX] = name;
else
i = 0;
}
}
- ASET (font, FONT_DPI_INDEX, INTERN_FIELD (XLFD_RESY_INDEX));
+ val = INTERN_FIELD (XLFD_RESY_INDEX);
+ if (! NILP (val) && ! INTEGERP (val))
+ return -1;
+ ASET (font, FONT_DPI_INDEX, val);
val = INTERN_FIELD (XLFD_SPACING_INDEX);
if (! NILP (val))
{
p = f[XLFD_AVGWIDTH_INDEX];
if (*p == '~')
p++;
- ASET (font, FONT_AVGWIDTH_INDEX,
- font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p, 0));
+ val = font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p, 0);
+ if (! NILP (val) && ! INTEGERP (val))
+ return -1;
+ ASET (font, FONT_AVGWIDTH_INDEX, val);
}
else
{
if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
{
f[XLFD_AVGWIDTH_INDEX] = alloca (11);
- len += sprintf (f[XLFD_AVGWIDTH_INDEX],
- "%d", XINT (AREF (font, FONT_AVGWIDTH_INDEX))) + 1;
+ len += sprintf (f[XLFD_AVGWIDTH_INDEX], "%ld",
+ (long) XINT (AREF (font, FONT_AVGWIDTH_INDEX))) + 1;
}
else
f[XLFD_AVGWIDTH_INDEX] = "*", len += 2;
if (family_end)
{
+ Lisp_Object extra_props = Qnil;
+
/* A fontconfig name with size and/or property data. */
if (family_end > name)
{
if (prop >= FONT_FOUNDRY_INDEX
&& prop < FONT_EXTRA_INDEX)
- ASET (font, prop, font_prop_validate (prop, Qnil, val));
- else
- Ffont_put (font, key, val);
+ ASET (font, prop, font_prop_validate (prop, Qnil, val));
+ else
+ {
+ extra_props = nconc2 (extra_props,
+ Fcons (Fcons (key, val), Qnil));
+ }
}
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
{
Lisp_Object family, foundry;
Lisp_Object tail, val;
int point_size;
- int dpi;
int i, len = 1;
char *p;
Lisp_Object styles[3];
}
if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
- len += sprintf (work, ":dpi=%d", dpi);
+ len += sprintf (work, ":dpi=%ld", (long)XINT (AREF (font, FONT_DPI_INDEX)));
if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
len += strlen (":spacing=100");
if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
if (STRINGP (val))
len += SBYTES (val);
else if (INTEGERP (val))
- len += sprintf (work, "%d", XINT (val));
+ len += sprintf (work, "%ld", (long) XINT (val));
else if (SYMBOLP (val))
len += (NILP (val) ? 5 : 4); /* for "false" or "true" */
}
p += sprintf (p, ":%s=%s", style_names[i],
SDATA (SYMBOL_NAME (styles[i])));
if (INTEGERP (AREF (font, FONT_DPI_INDEX)))
- p += sprintf (p, ":dpi=%d", XINT (AREF (font, FONT_DPI_INDEX)));
+ p += sprintf (p, ":dpi=%ld", (long) XINT (AREF (font, FONT_DPI_INDEX)));
if (INTEGERP (AREF (font, FONT_SPACING_INDEX)))
- p += sprintf (p, ":spacing=%d", XINT (AREF (font, FONT_SPACING_INDEX)));
+ p += sprintf (p, ":spacing=%ld",
+ (long) XINT (AREF (font, FONT_SPACING_INDEX)));
if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX)))
{
if (XINT (AREF (font, FONT_AVGWIDTH_INDEX)) == 0)
char *name;
Lisp_Object font;
{
- if (name[0] == '-' || index (name, '*'))
+ if (name[0] == '-' || index (name, '*') || index (name, '?'))
return font_parse_xlfd (name, font);
return font_parse_fcname (name, font);
}
p1 = index (p0, '-');
if (p1)
{
- if ((*p0 != '*' || p1 - p0 > 1)
+ 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++;
if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)))
CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT));
- for (i = 0; i < LGSTRING_LENGTH (gstring); i++)
+ for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
{
val = LGSTRING_GLYPH (gstring, i);
CHECK_VECTOR (val);
#endif /* HAVE_LIBOTF */
#endif /* 0 */
-/* G-string (glyph string) handler */
-
-/* G-string is a vector of the form [HEADER GLYPH ...].
- See the docstring of `font-make-gstring' for more detail. */
-
-struct font *
-font_prepare_composition (cmp, f)
- struct composition *cmp;
- FRAME_PTR f;
-{
- Lisp_Object gstring
- = AREF (XHASH_TABLE (composition_hash_table)->key_and_value,
- cmp->hash_index * 2);
-
- cmp->font = XFONT_OBJECT (LGSTRING_FONT (gstring));
- cmp->glyph_len = LGSTRING_LENGTH (gstring);
- cmp->pixel_width = LGSTRING_WIDTH (gstring);
- cmp->lbearing = LGSTRING_LBEARING (gstring);
- cmp->rbearing = LGSTRING_RBEARING (gstring);
- cmp->ascent = LGSTRING_ASCENT (gstring);
- cmp->descent = LGSTRING_DESCENT (gstring);
- cmp->width = cmp->pixel_width / FRAME_COLUMN_WIDTH (f);
- if (cmp->width == 0)
- cmp->width = 1;
-
- return cmp->font;
-}
-
\f
/* Font sorting */
static unsigned font_score P_ ((Lisp_Object, Lisp_Object *));
static int font_compare P_ ((const void *, const void *));
-static Lisp_Object font_sort_entites P_ ((Lisp_Object, Lisp_Object,
+static Lisp_Object font_sort_entities P_ ((Lisp_Object, Lisp_Object,
Lisp_Object, int));
+/* Return a rescaling ratio of FONT_ENTITY. */
+extern Lisp_Object Vface_font_rescale_alist;
+
+static double
+font_rescale_ratio (font_entity)
+ 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);
+ if (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.
/* Score the size. Maximum difference is 127. */
i = FONT_SIZE_INDEX;
- if (! NILP (spec_prop[i]) && XINT (AREF (entity, i)) > 0)
+ if (! NILP (spec_prop[FONT_SIZE_INDEX])
+ && XINT (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. */
- int diff = XINT (spec_prop[i]) - XINT (AREF (entity, i));
+ int diff;
+ int pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]);
+ if (CONSP (Vface_font_rescale_alist))
+ pixel_size *= font_rescale_ratio (entity);
+ diff = pixel_size - XINT (AREF (entity, FONT_SIZE_INDEX));
if (diff < 0)
diff = - diff;
diff <<= 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];
}
}
-/* The comparison function for qsort. */
+/* Concatenate all elements of LIST into one vector. LIST is a list
+ of font-entity vectors. */
-static int
-font_compare (d1, d2)
- const void *d1, *d2;
+static Lisp_Object
+font_vconcat_entity_vectors (Lisp_Object list)
{
- return (*(unsigned *) d1 - *(unsigned *) d2);
+ int nargs = XINT (Flength (list));
+ Lisp_Object *args = alloca (sizeof (Lisp_Object) * nargs);
+ int i;
+
+ for (i = 0; i < nargs; i++, list = XCDR (list))
+ args[i] = XCAR (list);
+ return Fvconcat (nargs, args);
}
struct font_sort_data
{
unsigned score;
+ int font_driver_preference;
Lisp_Object entity;
};
-/* Sort font-entities in vector VEC by closeness to font-spec PREFER.
+/* The comparison function for qsort. */
+
+static int
+font_compare (d1, d2)
+ const void *d1, *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. Otherwise,
- return the sorted VEC. */
+ 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_entites (vec, prefer, frame, best_only)
- Lisp_Object vec, prefer, frame;
+font_sort_entities (list, prefer, frame, best_only)
+ Lisp_Object list, prefer, frame;
int best_only;
{
Lisp_Object prefer_prop[FONT_SPEC_MAX];
- int len, i;
+ int len, maxlen, i;
struct font_sort_data *data;
unsigned best_score;
- Lisp_Object best_entity, driver_type;
- int driver_order;
+ Lisp_Object best_entity;
struct frame *f = XFRAME (frame);
- struct font_driver_list *list;
+ Lisp_Object tail, vec;
USE_SAFE_ALLOCA;
- len = ASIZE (vec);
- if (len <= 1)
- return best_only ? AREF (vec, 0) : vec;
-
- for (i = FONT_WEIGHT_INDEX; i <= FONT_DPI_INDEX; i++)
+ 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_number (font_pixel_size (XFRAME (frame), prefer));
- /* Scoring and sorting. */
- SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len);
- best_score = 0xFFFFFFFF;
- /* We are sure that the length of VEC > 1. */
- driver_type = AREF (AREF (vec, 0), FONT_TYPE_INDEX);
- for (driver_order = 0, list = f->font_driver_list; list;
- driver_order++, list = list->next)
- if (EQ (driver_type, list->driver->type))
- break;
- best_entity = data[0].entity = AREF (vec, 0);
- best_score = data[0].score
- = font_score (data[0].entity, prefer_prop) | driver_order;
- for (i = 0; i < len; i++)
+ if (NILP (XCDR (list)))
{
- if (!EQ (driver_type, AREF (AREF (vec, i), FONT_TYPE_INDEX)))
- for (driver_order = 0, list = f->font_driver_list; list;
- driver_order++, list = list->next)
- if (EQ (driver_type, list->driver->type))
- break;
- data[i].entity = AREF (vec, i);
- data[i].score = font_score (data[i].entity, prefer_prop) | driver_order;
- if (best_only && best_score > data[i].score)
- {
- best_score = data[i].score;
- best_entity = data[i].entity;
- if (best_score == 0)
- break;
- }
+ /* What we have to take care of is this single vector. */
+ vec = XCAR (list);
+ maxlen = ASIZE (vec);
}
- if (! best_only)
+ else if (best_only)
{
- qsort (data, len, sizeof *data, font_compare);
- for (i = 0; i < len; i++)
- ASET (vec, i, data[i].entity);
+ /* 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
- vec = best_entity;
+ {
+ /* We have to create a single vector to sort it. */
+ vec = font_vconcat_entity_vectors (list);
+ maxlen = ASIZE (vec);
+ }
+
+ SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * maxlen);
+ 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);
+ FONT_ADD_LOG ("sort-by", prefer, vec);
return vec;
}
for (negative = 0; CONSP (features); features = XCDR (features))
{
if (NILP (XCAR (features)))
- negative = 1;
+ {
+ negative = 1;
+ continue;
+ }
if (NILP (Fmemq (XCAR (features), table)) != negative)
return 0;
}
else if (EQ (key, QCscript))
{
val2 = assq_no_quit (val, Vscript_representative_chars);
- if (! NILP (val2))
- for (val2 = XCDR (val2); CONSP (val2); val2 = XCDR (val2))
- if (font_encode_char (font, XINT (XCAR (val2)))
- == FONT_INVALID_CODE)
- return 0;
+ if (CONSP (val2))
+ {
+ val2 = XCDR (val2);
+ if (CONSP (val2))
+ {
+ /* All characters in the list must be supported. */
+ for (; CONSP (val2); val2 = XCDR (val2))
+ {
+ if (! NATNUMP (XCAR (val2)))
+ continue;
+ if (font_encode_char (font, XFASTINT (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 (! NATNUMP (AREF (val2, i)))
+ continue;
+ if (font_encode_char (font, XFASTINT (AREF (val2, i)))
+ != FONT_INVALID_CODE)
+ break;
+ }
+ if (i == ASIZE (val2))
+ return 0;
+ }
+ }
}
else if (EQ (key, QCotf))
{
struct font_driver *driver;
{
Lisp_Object tail, elt;
+ Lisp_Object tail2, entity;
/* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
for (tail = XCDR (XCDR (cache)); CONSP (tail); tail = XCDR (tail))
{
elt = XCAR (tail);
- if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)) && VECTORP (XCDR (elt)))
+ /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
+ if (CONSP (elt) && FONT_SPEC_P (XCAR (elt)))
{
- Lisp_Object vec = XCDR (elt);
- int i;
-
- for (i = 0; i < ASIZE (vec); i++)
+ for (tail2 = XCDR (elt); CONSP (tail2); tail2 = XCDR (tail2))
{
- Lisp_Object entity = AREF (vec, i);
+ entity = XCAR (tail2);
- if (EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
+ if (FONT_ENTITY_P (entity)
+ && EQ (driver->type, AREF (entity, FONT_TYPE_INDEX)))
{
Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX);
static Lisp_Object scratch_font_spec, scratch_font_prefer;
Lisp_Object
-font_delete_unmatched (list, spec, size)
- Lisp_Object list, spec;
+font_delete_unmatched (vec, spec, size)
+ Lisp_Object vec, spec;
int size;
{
Lisp_Object entity, val;
enum font_property_index prop;
+ int i;
- for (val = Qnil; CONSP (list); list = XCDR (list))
+ for (val = Qnil, i = ASIZE (vec) - 1; i >= 0; i--)
{
- entity = XCAR (list);
+ entity = AREF (vec, i);
for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++)
if (INTEGERP (AREF (spec, prop))
&& ((XINT (AREF (spec, prop)) >> 8)
if (prop < FONT_SPEC_MAX
&& INTEGERP (AREF (spec, FONT_DPI_INDEX))
&& INTEGERP (AREF (entity, FONT_DPI_INDEX))
+ && XINT (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
&& INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX))
&& INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
+ && XINT (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 val;
+ return (Fvconcat (1, &val));
}
-/* Return a vector of font-entities matching with SPEC on FRAME. */
+/* Return a list of vectors of font-entities matching with SPEC on
+ FRAME. The elements of the list are in the same of order of
+ font-drivers. */
Lisp_Object
font_list_entities (frame, spec)
FRAME_PTR f = XFRAME (frame);
struct font_driver_list *driver_list = f->font_driver_list;
Lisp_Object ftype, val;
- Lisp_Object *vec;
+ Lisp_Object list = Qnil;
int size;
int need_filtering = 0;
int i;
ASET (scratch_font_spec, FONT_SPACING_INDEX, AREF (spec, FONT_SPACING_INDEX));
ASET (scratch_font_spec, FONT_EXTRA_INDEX, AREF (spec, FONT_EXTRA_INDEX));
- vec = alloca (sizeof (Lisp_Object) * num_font_drivers);
- if (! vec)
- return null_vector;
-
for (i = 0; driver_list; driver_list = driver_list->next)
if (driver_list->on
&& (NILP (ftype) || EQ (driver_list->driver->type, ftype)))
Lisp_Object copy;
val = driver_list->driver->list (frame, scratch_font_spec);
+ if (NILP (val))
+ val = null_vector;
+ else
+ val = Fvconcat (1, &val);
copy = Fcopy_font_spec (scratch_font_spec);
ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
XSETCDR (cache, Fcons (Fcons (copy, val), XCDR (cache)));
}
- if (! NILP (val) && need_filtering)
+ if (ASIZE (val) > 0 && need_filtering)
val = font_delete_unmatched (val, spec, size);
- if (! NILP (val))
- vec[i++] = val;
+ if (ASIZE (val) > 0)
+ list = Fcons (val, list);
}
- val = (i > 0 ? Fvconcat (i, vec) : null_vector);
- font_add_log ("list", spec, val);
- return (val);
+ list = Fnreverse (list);
+ FONT_ADD_LOG ("list", spec, list);
+ return list;
}
struct font_driver_list *driver_list = f->font_driver_list;
Lisp_Object ftype, size, entity;
Lisp_Object frame;
+ Lisp_Object work = Fcopy_font_spec (spec);
XSETFRAME (frame, f);
ftype = AREF (spec, FONT_TYPE_INDEX);
size = AREF (spec, FONT_SIZE_INDEX);
+
if (FLOATP (size))
- ASET (spec, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec)));
+ ASET (work, FONT_SIZE_INDEX, make_number (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
Lisp_Object cache = font_get_cache (f, driver_list->driver);
Lisp_Object copy;
- ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type);
- entity = assoc_no_quit (spec, XCDR (cache));
+ ASET (work, FONT_TYPE_INDEX, driver_list->driver->type);
+ entity = assoc_no_quit (work, XCDR (cache));
if (CONSP (entity))
entity = XCDR (entity);
else
{
- entity = driver_list->driver->match (frame, spec);
- copy = Fcopy_font_spec (spec);
+ entity = driver_list->driver->match (frame, work);
+ copy = Fcopy_font_spec (work);
ASET (copy, FONT_TYPE_INDEX, driver_list->driver->type);
XSETCDR (cache, Fcons (Fcons (copy, entity), XCDR (cache)));
}
if (! NILP (entity))
break;
}
- ASET (spec, FONT_TYPE_INDEX, ftype);
- ASET (spec, FONT_SIZE_INDEX, size);
- font_add_log ("match", spec, entity);
+ FONT_ADD_LOG ("match", work, entity);
return entity;
}
Lisp_Object objlist, size, val, font_object;
struct font *font;
int min_width, height;
+ int scaled_pixel_size;
font_assert (FONT_ENTITY_P (entity));
size = AREF (entity, FONT_SIZE_INDEX);
if (XINT (size) != 0)
- pixel_size = XINT (size);
+ scaled_pixel_size = pixel_size = XINT (size);
+ else if (CONSP (Vface_font_rescale_alist))
+ scaled_pixel_size = pixel_size * font_rescale_ratio (entity);
+#if 0
+ /* This doesn't work if you have changed hinting or any other parameter.
+ We need to make a new object in every case to be sure. */
for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
objlist = XCDR (objlist))
if (! NILP (AREF (XCAR (objlist), FONT_TYPE_INDEX))
&& XFONT_OBJECT (XCAR (objlist))->pixel_size == pixel_size)
return XCAR (objlist);
+#endif
val = AREF (entity, FONT_TYPE_INDEX);
for (driver_list = f->font_driver_list;
if (! driver_list)
return Qnil;
- font_object = driver_list->driver->open (f, entity, pixel_size);
- font_add_log ("open", entity, font_object);
+ font_object = driver_list->driver->open (f, entity, scaled_pixel_size);
+ ASET (font_object, FONT_SIZE_INDEX, make_number (pixel_size));
+ FONT_ADD_LOG ("open", entity, font_object);
if (NILP (font_object))
return Qnil;
ASET (entity, FONT_OBJLIST_INDEX,
if (NILP (AREF (font_object, FONT_TYPE_INDEX)))
/* Already closed. */
return;
- font_add_log ("close", font_object, Qnil);
+ FONT_ADD_LOG ("close", font_object, Qnil);
font->driver->close (f, font);
#ifdef HAVE_WINDOW_SYSTEM
font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts);
return spec;
}
+
+/* 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 (font_name)
Lisp_Object font_name;
{
- Lisp_Object args[2];
+ Lisp_Object spec = Ffont_spec (0, NULL);
- args[0] = QCname;
- args[1] = font_name;
- return Ffont_spec (2, args);
+ CHECK_STRING (font_name);
+ if (font_parse_name ((char *) SDATA (font_name), spec) == -1)
+ return Qnil;
+ font_put_extra (spec, QCname, font_name);
+ return spec;
}
if (! FONTP (font))
return;
+#if 0
+ if (! NILP (Ffont_get (font, QCname)))
+ {
+ font = Fcopy_font_spec (font);
+ font_put_extra (font, QCname, Qnil);
+ }
+
+#endif
if (NILP (AREF (font, prop))
- && prop != FONT_FAMILY_INDEX && prop != FONT_FOUNDRY_INDEX
+ && prop != FONT_FAMILY_INDEX
+ && prop != FONT_FOUNDRY_INDEX
+ && prop != FONT_WIDTH_INDEX
&& prop != FONT_SIZE_INDEX)
return;
- font = Fcopy_font_spec (font);
+ if (EQ (font, attrs[LFACE_FONT_INDEX]))
+ font = Fcopy_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);
+ {
+ 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_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;
}
if (! NILP (AREF (spec, FONT_WEIGHT_INDEX)))
attrs[LFACE_WEIGHT_INDEX] = FONT_WEIGHT_FOR_FACE (spec);
if (! NILP (AREF (spec, FONT_SLANT_INDEX)))
- attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);;
+ attrs[LFACE_SLANT_INDEX] = FONT_SLANT_FOR_FACE (spec);
if (! NILP (AREF (spec, FONT_WIDTH_INDEX)))
attrs[LFACE_SWIDTH_INDEX] = FONT_WIDTH_FOR_FACE (spec);
if (! NILP (AREF (spec, FONT_SIZE_INDEX)))
dpi = XINT (val);
point = PIXEL_TO_POINT (XINT (AREF (spec, FONT_SIZE_INDEX)) * 10,
dpi);
+ attrs[LFACE_HEIGHT_INDEX] = make_number (point);
}
else if (FLOATP (AREF (spec, FONT_SIZE_INDEX)))
- point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
- attrs[LFACE_HEIGHT_INDEX] = make_number (point);
+ {
+ point = XFLOAT_DATA (AREF (spec, FONT_SIZE_INDEX)) * 10;
+ attrs[LFACE_HEIGHT_INDEX] = make_number (point);
+ }
}
}
+/* Selecte a font from ENTITIES (list of font-entity vectors) that
+ supports C and matches best with ATTRS and PIXEL_SIZE. */
+
+static Lisp_Object
+font_select_entity (frame, entities, attrs, pixel_size, c)
+ Lisp_Object frame, entities, *attrs;
+ int pixel_size, c;
+{
+ Lisp_Object font_entity;
+ Lisp_Object prefer;
+ int result, i;
+ FRAME_PTR f = XFRAME (frame);
+
+ if (NILP (XCDR (entities))
+ && ASIZE (XCAR (entities)) == 1)
+ {
+ font_entity = AREF (XCAR (entities), 0);
+ if (c < 0
+ || (result = font_has_char (f, font_entity, c)) > 0)
+ return font_entity;
+ return Qnil;
+ }
+
+ /* Sort fonts by properties specified in ATTRS. */
+ 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_number (pixel_size));
+
+ return font_sort_entities (entities, prefer, frame, c);
+}
+
/* Return a font-entity satisfying SPEC and best matching with face's
font related attributes in ATTRS. C, if not negative, is a
character that the entity must support. */
int c;
{
Lisp_Object work;
- Lisp_Object frame, entities, val, props[FONT_REGISTRY_INDEX + 1] ;
+ Lisp_Object frame, entities, val;
Lisp_Object size, foundry[3], *family, registry[3], adstyle[3];
int pixel_size;
- int i, j, k, l, result;
+ int i, j, k, l;
registry[0] = AREF (spec, FONT_REGISTRY_INDEX);
if (NILP (registry[0]))
if (font_registry_charsets (AREF (spec, FONT_REGISTRY_INDEX),
&encoding, &repertory) < 0)
return Qnil;
- if (repertory)
- {
- if (ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
- return Qnil;
- /* Any font of this registry support C. So, let's
- suppress the further checking. */
- c = -1;
- }
+ if (repertory
+ && ENCODE_CHAR (repertory, c) == CHARSET_INVALID_CODE (repertory))
+ return Qnil;
else if (c > encoding->max_char)
return Qnil;
}
work = Fcopy_font_spec (spec);
+ ASET (work, FONT_TYPE_INDEX, AREF (spec, FONT_TYPE_INDEX));
XSETFRAME (frame, f);
size = AREF (spec, FONT_SIZE_INDEX);
pixel_size = font_pixel_size (f, spec);
foundry[1] = null_vector;
else if (STRINGP (attrs[LFACE_FOUNDRY_INDEX]))
{
- foundry[0] = font_intern_prop (SDATA (attrs[LFACE_FOUNDRY_INDEX]),
- SBYTES (attrs[LFACE_FOUNDRY_INDEX]), 1);
+ val = attrs[LFACE_FOUNDRY_INDEX];
+ foundry[0] = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
foundry[1] = Qnil;
foundry[2] = null_vector;
}
val = AREF (work, FONT_FAMILY_INDEX);
if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX]))
- val = font_intern_prop (SDATA (attrs[LFACE_FAMILY_INDEX]),
- SBYTES (attrs[LFACE_FAMILY_INDEX]), 1);
+ {
+ val = attrs[LFACE_FAMILY_INDEX];
+ val = font_intern_prop ((char *) SDATA (val), SBYTES (val), 1);
+ }
if (NILP (val))
{
family = alloca ((sizeof family[0]) * 2);
else
{
Lisp_Object alters
- = Fassoc_string (val, Vface_alternative_font_family_alist, Qt);
+ = Fassoc_string (val, Vface_alternative_font_family_alist,
+ /* Font family names are case-sensitive under NS. */
+#ifndef HAVE_NS
+ Qt
+#else
+ Qnil
+#endif
+ );
if (! NILP (alters))
{
{
ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]);
entities = font_list_entities (frame, work);
- if (ASIZE (entities) > 0)
- goto found;
+ if (! NILP (entities))
+ {
+ val = font_select_entity (frame, entities,
+ attrs, pixel_size, c);
+ if (! NILP (val))
+ return val;
+ }
}
}
}
}
return Qnil;
- found:
- if (ASIZE (entities) == 1)
- {
- if (c < 0)
- return AREF (entities, 0);
- }
- else
- {
- /* Sort fonts by properties specified in LFACE. */
- Lisp_Object prefer = scratch_font_prefer;
-
- for (i = 0; i < FONT_EXTRA_INDEX; i++)
- ASET (prefer, i, AREF (work, i));
- if (FONTP (attrs[LFACE_FONT_INDEX]))
- {
- Lisp_Object face_font = attrs[LFACE_FONT_INDEX];
-
- for (i = 0; i < FONT_EXTRA_INDEX; i++)
- if (NILP (AREF (prefer, 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_number (pixel_size));
- entities = font_sort_entites (entities, prefer, frame, c < 0);
- }
- if (c < 0)
- return entities;
-
- for (i = 0; i < ASIZE (entities); i++)
- {
- int j;
-
- val = AREF (entities, i);
- if (i > 0)
- {
- for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
- if (! EQ (AREF (val, j), props[j]))
- break;
- if (j > FONT_REGISTRY_INDEX)
- continue;
- }
- for (j = FONT_FOUNDRY_INDEX; j <= FONT_REGISTRY_INDEX; j++)
- props[j] = AREF (val, j);
- result = font_has_char (f, val, c);
- if (result > 0)
- return val;
- if (result == 0)
- return Qnil;
- val = font_open_for_lface (f, val, attrs, spec);
- if (NILP (val))
- continue;
- result = font_has_char (f, val, c);
- font_close_object (f, val);
- if (result > 0)
- return AREF (entities, i);
- }
- return Qnil;
}
size = font_pixel_size (f, spec);
else
{
- double pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
+ double pt;
+ if (INTEGERP (attrs[LFACE_HEIGHT_INDEX]))
+ pt = XINT (attrs[LFACE_HEIGHT_INDEX]);
+ else
+ {
+ struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX];
+ if (INTEGERP (height))
+ pt = XINT (height);
+ else
+ abort(); /* We should never end up here. */
+ }
pt /= 10;
size = POINT_TO_PIXEL (pt, f->resy);
FRAME_PTR f;
Lisp_Object *attrs, spec;
{
- Lisp_Object entity;
+ Lisp_Object entity, name;
entity = font_find_for_lface (f, attrs, spec, -1);
if (NILP (entity))
if (NILP (entity))
return Qnil;
}
- return font_open_for_lface (f, entity, attrs, spec);
+ /* Don't loose 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);
+ name = Ffont_get (spec, QCname);
+ if (STRINGP (name)) font_put_extra (entity, QCname, name);
+ return entity;
}
}
-/* Open a font best matching with NAME on frame F. If no proper font
- is found, return Qnil. */
+/* Open a font matching with font-spec SPEC on frame F. If no proper
+ font is found, return Qnil. */
Lisp_Object
-font_open_by_name (f, name)
+font_open_by_spec (f, spec)
FRAME_PTR f;
- char *name;
+ Lisp_Object spec;
{
- Lisp_Object args[2];
- Lisp_Object spec, attrs[LFACE_VECTOR_SIZE];
+ Lisp_Object attrs[LFACE_VECTOR_SIZE];
- args[0] = QCname;
- args[1] = make_unibyte_string (name, strlen (name));
- spec = Ffont_spec (2, args);
/* 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;
}
+/* Open a font matching with NAME on frame F. If no proper font is
+ found, return Qnil. */
+
+Lisp_Object
+font_open_by_name (f, name)
+ FRAME_PTR f;
+ char *name;
+{
+ Lisp_Object args[2];
+ Lisp_Object spec;
+
+ args[0] = QCname;
+ args[1] = make_unibyte_string (name, strlen (name));
+ spec = Ffont_spec (2, args);
+ return font_open_by_spec (f, spec);
+}
+
+
/* Register font-driver DRIVER. This function is used in two ways.
The first is with frame F non-NULL. In this case, make DRIVER
if (EQ (list->driver->type, driver->type))
error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type)));
- list = malloc (sizeof (struct font_driver_list));
+ list = xmalloc (sizeof (struct font_driver_list));
list->on = 0;
list->driver = driver;
list->next = NULL;
num_font_drivers++;
}
+void
+free_font_driver_list (f)
+ FRAME_PTR 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
}
for (list = f->font_driver_list; list; list = list->next)
if (! list->on)
- list_table[i] = list;
+ list_table[i++] = list;
list_table[i] = NULL;
next = &f->font_driver_list;
next = &(*next)->next;
}
*next = NULL;
+
+ 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 *driver = list->driver;
+ eassert (! list->on);
+ 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)
prev->next = list->next;
else
f->font_data_list = list->next;
- free (list);
+ xfree (list);
}
return 0;
}
if (! list)
{
- list = malloc (sizeof (struct font_data_list));
- if (! list)
- return -1;
+ list = xmalloc (sizeof (struct font_data_list));
list->driver = driver;
list->next = f->font_data_list;
f->font_data_list = list;
int multibyte;
Lisp_Object font_object;
+ multibyte = (NILP (string)
+ ? ! NILP (current_buffer->enable_multibyte_characters)
+ : STRING_MULTIBYTE (string));
if (c < 0)
{
if (NILP (string))
{
- multibyte = ! NILP (current_buffer->enable_multibyte_characters);
if (multibyte)
{
EMACS_INT pos_byte = CHAR_TO_BYTE (pos);
DEFAULT_FACE_ID, 0);
else
face_id = face_at_buffer_position (w, pos, -1, -1, &endptr,
- pos + 100, 0);
+ pos + 100, 0, -1);
face = FACE_FROM_ID (f, face_id);
}
if (multibyte)
}
-/* Check how many characters after POS (at most to LIMIT) can be
- displayed by the same font. FACE is the face selected for the
- character as POS on frame F. STRING, if not nil, is the string to
- check instead of the current buffer.
+#ifdef HAVE_WINDOW_SYSTEM
+
+/* Check how many characters after POS (at most to *LIMIT) can be
+ displayed by the same font on 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.
+
+ 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.
- The return value is the position of the character that is displayed
- by the differnt font than that of the character as POS. */
+ It is assured that the current buffer (or STRING) is multibyte. */
-EMACS_INT
-font_range (pos, limit, face, f, string)
- EMACS_INT pos, limit;
+Lisp_Object
+font_range (pos, limit, w, face, string)
+ EMACS_INT pos, *limit;
+ struct window *w;
struct face *face;
- FRAME_PTR f;
Lisp_Object string;
{
- int multibyte;
- EMACS_INT pos_byte;
+ EMACS_INT pos_byte, ignore, start, start_byte;
int c;
- struct font *font;
- int first = 1;
+ Lisp_Object font_object = Qnil;
if (NILP (string))
{
- multibyte = ! NILP (current_buffer->enable_multibyte_characters);
pos_byte = CHAR_TO_BYTE (pos);
+ if (! face)
+ {
+ int face_id;
+
+ face_id = face_at_buffer_position (w, pos, 0, 0, &ignore,
+ *limit, 0, -1);
+ face = FACE_FROM_ID (XFRAME (w->frame), face_id);
+ }
}
else
{
- multibyte = STRING_MULTIBYTE (string);
+ font_assert (face);
pos_byte = string_char_to_byte (string, pos);
}
- if (! multibyte)
- /* All unibyte character are displayed by the same font. */
- return limit;
-
- while (pos < limit)
+ start = pos, start_byte = pos_byte;
+ while (pos < *limit)
{
- int face_id;
+ Lisp_Object category;
if (NILP (string))
FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
else
FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
- face_id = FACE_FOR_CHAR (f, face, c, pos, string);
- face = FACE_FROM_ID (f, face_id);
- if (first)
+ if (NILP (font_object))
{
- font = face->font;
- first = 0;
+ font_object = font_for_char (face, c, pos - 1, string);
+ if (NILP (font_object))
+ return Qnil;
continue;
}
- else if (font != face->font)
+
+ category = CHAR_TABLE_REF (Vunicode_category_table, c);
+ if (! EQ (category, QCf)
+ && ! CHAR_VARIATION_SELECTOR_P (c)
+ && font_encode_char (font_object, c) == FONT_INVALID_CODE)
{
- pos--;
- break;
+ Lisp_Object f = font_for_char (face, c, pos - 1, string);
+ EMACS_INT i, i_byte;
+
+
+ if (NILP (f))
+ {
+ *limit = pos - 1;
+ return font_object;
+ }
+ i = start, i_byte = start_byte;
+ while (i < pos - 1)
+ {
+
+ if (NILP (string))
+ FETCH_CHAR_ADVANCE_NO_CHECK (c, i, i_byte);
+ else
+ FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, i, i_byte);
+ category = CHAR_TABLE_REF (Vunicode_category_table, c);
+ if (! EQ (category, QCf)
+ && ! CHAR_VARIATION_SELECTOR_P (c)
+ && font_encode_char (f, c) == FONT_INVALID_CODE)
+ {
+ *limit = pos - 1;
+ return font_object;
+ }
+ }
+ font_object = f;
}
}
- return pos;
+ return font_object;
}
+#endif
\f
/* Lisp API */
`: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).
+specifying the font size. It specifies the font size in pixels (if
+VALUE is an integer), or in points (if VALUE is a float).
`:name'
VALUE must be a string of XLFD-style or fontconfig-style font name.
-usage: (font-spec ARGS ...) */)
+
+`: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 of two-letter ISO-639 language names,
+e.g. `ja'.
+
+`: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' element. 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, and whose GPOS table of `thai' script's default
+language system must contain `mark' feature.
+
+usage: (font-spec ARGS...) */)
(nargs, args)
int nargs;
Lisp_Object *args;
for (i = 0; i < nargs; i += 2)
{
- Lisp_Object key = args[i], val = args[i + 1];
+ 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))
{
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. */)
+FONT is a font-spec, a font-entity, or a font-object.
+KEY must be one of these symbols:
+ :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
+ :size, :name, :script
+See the documentation of `font-spec' for their meanings.
+If FONT is a font-entity or font-object, the value of :script may be
+a list of scripts that are supported by the font. */)
(font, key)
Lisp_Object font, key;
{
(font_spec, frame, num, prefer)
Lisp_Object font_spec, frame, num, prefer;
{
- Lisp_Object vec, list, tail;
- int n = 0, i, len;
+ Lisp_Object vec, list;
+ int n = 0;
if (NILP (frame))
frame = selected_frame;
if (! NILP (prefer))
CHECK_FONT_SPEC (prefer);
- vec = font_list_entities (frame, font_spec);
- len = ASIZE (vec);
- if (len == 0)
+ list = font_list_entities (frame, font_spec);
+ if (NILP (list))
return Qnil;
- if (len == 1)
- return Fcons (AREF (vec, 0), Qnil);
+ if (NILP (XCDR (list))
+ && ASIZE (XCAR (list)) == 1)
+ return Fcons (AREF (XCAR (list), 0), Qnil);
if (! NILP (prefer))
- vec = font_sort_entites (vec, prefer, frame, 0);
-
- list = tail = Fcons (AREF (vec, 0), Qnil);
- if (n == 0 || n > len)
- n = len;
- for (i = 1; i < n; i++)
+ vec = font_sort_entities (list, prefer, frame, 0);
+ else
+ vec = font_vconcat_entity_vectors (list);
+ if (n == 0 || n >= ASIZE (vec))
{
- Lisp_Object val = Fcons (AREF (vec, i), Qnil);
+ Lisp_Object args[2];
- XSETCDR (tail, val);
- tail = val;
+ args[0] = vec;
+ args[1] = Qnil;
+ list = Fappend (2, args);
+ }
+ else
+ {
+ for (list = Qnil, n--; n >= 0; n--)
+ list = Fcons (AREF (vec, n), list);
}
return list;
}
if (driver_list->driver->list_family)
{
Lisp_Object val = driver_list->driver->list_family (frame);
+ Lisp_Object tail = list;
- if (NILP (list))
- list = val;
- else
- {
- Lisp_Object tail = list;
-
- for (; CONSP (val); val = XCDR (val))
- if (NILP (Fmemq (XCAR (val), tail)))
- list = Fcons (XCAR (val), 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;
}
return Qnil;
}
-/* The following three functions are still experimental. */
-
-DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0,
- doc: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
-FONT-OBJECT may be nil if it is not yet known.
-
-G-string is sequence of glyphs of a specific font,
-and is a vector of this form:
- [ HEADER GLYPH ... ]
-HEADER is a vector of this form:
- [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
-where
- FONT-OBJECT is a font-object for all glyphs in the g-string,
- WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
-GLYPH is a vector of this form:
- [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
- [ [X-OFF Y-OFF WADJUST] | nil] ]
-where
- FROM-IDX and TO-IDX are used internally and should not be touched.
- C is the character of the glyph.
- CODE is the glyph-code of C in FONT-OBJECT.
- WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
- X-OFF and Y-OFF are offests to the base position for the glyph.
- WADJUST is the adjustment to the normal width of the glyph. */)
- (font_object, num)
- Lisp_Object font_object, num;
-{
- Lisp_Object gstring, g;
- int len;
- int i;
-
- if (! NILP (font_object))
- CHECK_FONT_OBJECT (font_object);
- CHECK_NATNUM (num);
-
- len = XINT (num) + 1;
- gstring = Fmake_vector (make_number (len), Qnil);
- g = Fmake_vector (make_number (6), Qnil);
- ASET (g, 0, font_object);
- ASET (gstring, 0, g);
- for (i = 1; i < len; i++)
- ASET (gstring, i, Fmake_vector (make_number (10), Qnil));
- return gstring;
-}
-
-DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0,
- doc: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
-START and END specify the region to extract characters.
-If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
-where to extract characters.
-FONT-OBJECT may be nil if GSTRING already contains one. */)
- (gstring, font_object, start, end, object)
- Lisp_Object gstring, font_object, start, end, object;
+\f
+void
+font_fill_lglyph_metrics (glyph, font_object)
+ Lisp_Object glyph, font_object;
{
- int len, i, c;
+ struct font *font = XFONT_OBJECT (font_object);
unsigned code;
- struct font *font;
-
- CHECK_VECTOR (gstring);
- if (NILP (font_object))
- font_object = LGSTRING_FONT (gstring);
- font = XFONT_OBJECT (font_object);
+ /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
+ EMACS_INT ecode = font->driver->encode_char (font, LGLYPH_CHAR (glyph));
+ struct font_metrics metrics;
- if (STRINGP (object))
- {
- const unsigned char *p;
+ LGLYPH_SET_CODE (glyph, ecode);
+ code = ecode;
+ 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);
+}
- CHECK_NATNUM (start);
- CHECK_NATNUM (end);
- if (XINT (start) > XINT (end)
- || XINT (end) > ASIZE (object)
- || XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
- args_out_of_range_3 (object, start, end);
- len = XINT (end) - XINT (start);
- p = SDATA (object) + string_char_to_byte (object, XINT (start));
- for (i = 0; i < len; i++)
- {
- Lisp_Object g = LGSTRING_GLYPH (gstring, i);
- /* Shut up GCC warning in comparison with
- MOST_POSITIVE_FIXNUM below. */
- EMACS_INT cod;
-
- c = STRING_CHAR_ADVANCE (p);
- cod = code = font->driver->encode_char (font, c);
- if (cod > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
- break;
- LGLYPH_SET_FROM (g, i);
- LGLYPH_SET_TO (g, i);
- LGLYPH_SET_CHAR (g, c);
- LGLYPH_SET_CODE (g, code);
- }
- }
- else
- {
- int pos, pos_byte;
+DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0,
+ doc: /* Shape the glyph-string GSTRING.
+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.
- if (! NILP (object))
- Fset_buffer (object);
- validate_region (&start, &end);
- if (XINT (end) - XINT (start) > LGSTRING_LENGTH (gstring))
- args_out_of_range (start, end);
- len = XINT (end) - XINT (start);
- pos = XINT (start);
- pos_byte = CHAR_TO_BYTE (pos);
- for (i = 0; i < len; i++)
- {
- Lisp_Object g = LGSTRING_GLYPH (gstring, i);
- /* Shut up GCC warning in comparison with
- MOST_POSITIVE_FIXNUM below. */
- EMACS_INT cod;
-
- FETCH_CHAR_ADVANCE (c, pos, pos_byte);
- cod = code = font->driver->encode_char (font, c);
- if (cod > MOST_POSITIVE_FIXNUM || code == FONT_INVALID_CODE)
- break;
- LGLYPH_SET_FROM (g, i);
- LGLYPH_SET_TO (g, i);
- LGLYPH_SET_CHAR (g, c);
- LGLYPH_SET_CODE (g, code);
- }
- }
- for (; i < LGSTRING_LENGTH (gstring); i++)
- LGSTRING_SET_GLYPH (gstring, i, Qnil);
- return Qnil;
-}
-
-DEFUN ("font-shape-text", Ffont_shape_text, Sfont_shape_text, 3, 4, 0,
- doc: /* Shape text between FROM and TO by FONT-OBJECT.
-If optional 4th argument STRING is non-nil, it is a string to shape,
-and FROM and TO are indices to the string.
-The value is the end position of the text that can be shaped by
-FONT-OBJECT. */)
- (from, to, font_object, string)
- Lisp_Object from, to, font_object, string;
+If the shaping was successful, the value is GSTRING itself or a newly
+created glyph-string. Otherwise, the value is nil. */)
+ (gstring)
+ Lisp_Object gstring;
{
struct font *font;
- struct font_metrics metrics;
- EMACS_INT start, end;
- Lisp_Object gstring, n;
- int len, i;
-
- if (! FONT_OBJECT_P (font_object))
- return Qnil;
+ Lisp_Object font_object, n, glyph;
+ int i, j, from, to;
+
+ if (! composition_gstring_p (gstring))
+ signal_error ("Invalid glyph-string: ", gstring);
+ if (! NILP (LGSTRING_ID (gstring)))
+ return gstring;
+ font_object = LGSTRING_FONT (gstring);
+ CHECK_FONT_OBJECT (font_object);
font = XFONT_OBJECT (font_object);
if (! font->driver->shape)
return Qnil;
- if (NILP (string))
- {
- validate_region (&from, &to);
- start = XFASTINT (from);
- end = XFASTINT (to);
- modify_region (current_buffer, start, end, 0);
- }
- else
- {
- CHECK_STRING (string);
- start = XINT (from);
- end = XINT (to);
- if (start < 0 || start > end || end > SCHARS (string))
- args_out_of_range_3 (string, from, to);
- }
-
- len = end - start;
- gstring = Ffont_make_gstring (font_object, make_number (len));
- Ffont_fill_gstring (gstring, font_object, from, to, string);
-
/* Try at most three times with larger gstring each time. */
for (i = 0; i < 3; i++)
{
- Lisp_Object args[2];
-
n = font->driver->shape (gstring);
if (INTEGERP (n))
break;
- args[0] = gstring;
- args[1] = Fmake_vector (make_number (len), Qnil);
- gstring = Fvconcat (2, args);
+ gstring = larger_vector (gstring,
+ ASIZE (gstring) + LGSTRING_GLYPH_LEN (gstring),
+ Qnil);
}
- if (! INTEGERP (n) || XINT (n) == 0)
+ if (i == 3 || XINT (n) == 0)
return Qnil;
- len = XINT (n);
-
- for (i = 0; i < len;)
- {
- Lisp_Object gstr;
- Lisp_Object g = LGSTRING_GLYPH (gstring, i);
- EMACS_INT this_from = LGLYPH_FROM (g);
- EMACS_INT this_to = LGLYPH_TO (g) + 1;
- int j, k;
- int need_composition = 0;
-
- metrics.lbearing = LGLYPH_LBEARING (g);
- metrics.rbearing = LGLYPH_RBEARING (g);
- metrics.ascent = LGLYPH_ASCENT (g);
- metrics.descent = LGLYPH_DESCENT (g);
- if (NILP (LGLYPH_ADJUSTMENT (g)))
+
+ glyph = LGSTRING_GLYPH (gstring, 0);
+ from = LGLYPH_FROM (glyph);
+ to = LGLYPH_TO (glyph);
+ for (i = 1, j = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
+ {
+ Lisp_Object this = LGSTRING_GLYPH (gstring, i);
+
+ if (NILP (this))
+ break;
+ if (NILP (LGLYPH_ADJUSTMENT (this)))
{
- metrics.width = LGLYPH_WIDTH (g);
- if (LGLYPH_CHAR (g) == 0 || metrics.width == 0)
- need_composition = 1;
+ if (j < i - 1)
+ for (; j < i; j++)
+ {
+ glyph = LGSTRING_GLYPH (gstring, j);
+ LGLYPH_SET_FROM (glyph, from);
+ LGLYPH_SET_TO (glyph, to);
+ }
+ from = LGLYPH_FROM (this);
+ to = LGLYPH_TO (this);
+ j = i;
}
else
{
- metrics.width = LGLYPH_WADJUST (g);
- metrics.lbearing += LGLYPH_XOFF (g);
- metrics.rbearing += LGLYPH_XOFF (g);
- metrics.ascent -= LGLYPH_YOFF (g);
- metrics.descent += LGLYPH_YOFF (g);
- need_composition = 1;
- }
- for (j = i + 1; j < len; j++)
- {
- int x;
-
- g = LGSTRING_GLYPH (gstring, j);
- if (this_from != LGLYPH_FROM (g))
- break;
- need_composition = 1;
- x = metrics.width + LGLYPH_LBEARING (g) + LGLYPH_XOFF (g);
- if (metrics.lbearing > x)
- metrics.lbearing = x;
- x = metrics.width + LGLYPH_RBEARING (g) + LGLYPH_XOFF (g);
- if (metrics.rbearing < x)
- metrics.rbearing = x;
- x = LGLYPH_ASCENT (g) - LGLYPH_YOFF (g);
- if (metrics.ascent < x)
- metrics.ascent = x;
- x = LGLYPH_DESCENT (g) - LGLYPH_YOFF (g);
- if (metrics.descent < x)
- metrics.descent = x;
- if (NILP (LGLYPH_ADJUSTMENT (g)))
- metrics.width += LGLYPH_WIDTH (g);
- else
- metrics.width += LGLYPH_WADJUST (g);
- }
-
- if (need_composition)
- {
- gstr = Ffont_make_gstring (font_object, make_number (j - i));
- LGSTRING_SET_WIDTH (gstr, metrics.width);
- LGSTRING_SET_LBEARING (gstr, metrics.lbearing);
- LGSTRING_SET_RBEARING (gstr, metrics.rbearing);
- LGSTRING_SET_ASCENT (gstr, metrics.ascent);
- LGSTRING_SET_DESCENT (gstr, metrics.descent);
- for (k = i; i < j; i++)
- {
- Lisp_Object g = LGSTRING_GLYPH (gstring, i);
-
- LGLYPH_SET_FROM (g, LGLYPH_FROM (g) - this_from);
- LGLYPH_SET_TO (g, LGLYPH_TO (g) - this_from);
- LGSTRING_SET_GLYPH (gstr, i - k, LGSTRING_GLYPH (gstring, i));
- }
- from = make_number (start + this_from);
- to = make_number (start + this_to);
- if (NILP (string))
- Fcompose_region_internal (from, to, gstr, Qnil);
- else
- Fcompose_string_internal (string, from, to, gstr, Qnil);
+ if (from > LGLYPH_FROM (this))
+ from = LGLYPH_FROM (this);
+ if (to < LGLYPH_TO (this))
+ to = LGLYPH_TO (this);
}
- else
- i = j;
}
+ if (j < i - 1)
+ for (; j < i; j++)
+ {
+ glyph = LGSTRING_GLYPH (gstring, j);
+ LGLYPH_SET_FROM (glyph, from);
+ LGLYPH_SET_TO (glyph, to);
+ }
+ return composition_gstring_put_cache (gstring, XINT (n));
+}
- return to;
+DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs,
+ 2, 2, 0,
+ doc: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
+Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
+where
+ VARIATION-SELECTOR is a chracter code of variation selection
+ (#xFE00..#xFE0F or #xE0100..#xE01EF)
+ GLYPH-ID is a glyph code of the corresponding variation glyph. */)
+ (font_object, character)
+ Lisp_Object font_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, XINT (character), variations);
+ if (! n)
+ return Qnil;
+ val = Qnil;
+ for (i = 0; i < 255; i++)
+ if (variations[i])
+ {
+ Lisp_Object code;
+ int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
+ /* Stops GCC whining about limited range of data type. */
+ EMACS_INT var = variations[i];
+
+ if (var > MOST_POSITIVE_FIXNUM)
+ code = Fcons (make_number ((variations[i]) >> 16),
+ make_number ((variations[i]) & 0xFFFF));
+ else
+ code = make_number (variations[i]);
+ val = Fcons (Fcons (make_number (vs), code), val);
+ }
+ return val;
}
#if 0
{
CHECK_NUMBER_OR_FLOAT (size);
if (FLOATP (size))
- isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy);
+ isize = POINT_TO_PIXEL (XFLOAT_DATA (size), XFRAME (frame)->resy);
else
isize = XINT (size);
if (isize == 0)
DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
doc: /* Return information about a font named NAME on frame FRAME.
If FRAME is omitted or nil, use the selected frame.
-The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
+The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
where
OPENED-NAME is the name used for opening the font,
FULL-NAME is the full name of the font,
- SIZE is the maximum bound width of the font,
- HEIGHT is the height of the font,
+ 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.
info = Fmake_vector (make_number (7), Qnil);
XVECTOR (info)->contents[0] = AREF (font_object, FONT_NAME_INDEX);
- XVECTOR (info)->contents[1] = AREF (font_object, FONT_NAME_INDEX);
+ XVECTOR (info)->contents[1] = AREF (font_object, FONT_FULLNAME_INDEX);
XVECTOR (info)->contents[2] = make_number (font->pixel_size);
XVECTOR (info)->contents[3] = make_number (font->height);
XVECTOR (info)->contents[4] = make_number (font->baseline_offset);
elt = Fmake_vector (make_number (j + 1), Qnil);
ASET (elt, 0, make_number (entry[i].numeric));
for (j = 0; entry[i].names[j]; j++)
- ASET (elt, j + 1, intern (entry[i].names[j]));
+ ASET (elt, j + 1, intern_c_string (entry[i].names[j]));
ASET (table, i, elt);
}
return table;
}
-static Lisp_Object Vfont_log;
-static int font_log_env_checked;
+Lisp_Object Vfont_log;
+/* 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 (action, arg, result)
char *action;
Lisp_Object tail, val;
int i;
- if (! font_log_env_checked)
- {
- Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
- font_log_env_checked = 1;
- }
if (EQ (Vfont_log, Qt))
return;
+ if (STRINGP (AREF (Vfont_log_deferred, 0)))
+ {
+ char *str = (char *) SDATA (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))
- arg = Ffont_xlfd_name (arg, Qt);
+ {
+ Lisp_Object tail, elt;
+ Lisp_Object equalstr = build_string ("=");
+
+ val = Ffont_xlfd_name (arg, 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 (equalstr, SYMBOL_NAME (XCDR (elt))));
+ else if (EQ (XCAR (elt), QClang)
+ && SYMBOLP (XCDR (elt)))
+ val = concat3 (val, SYMBOL_NAME (QClang),
+ concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
+ else if (EQ (XCAR (elt), QCotf)
+ && CONSP (XCDR (elt)) && SYMBOLP (XCAR (XCDR (elt))))
+ val = concat3 (val, SYMBOL_NAME (QCotf),
+ concat2 (equalstr,
+ 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);
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 (action, arg, result)
+ char *action;
+ Lisp_Object arg, 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);
+}
+
extern void syms_of_ftfont P_ (());
extern void syms_of_xfont P_ (());
extern void syms_of_xftfont P_ (());
staticpro (&font_charset_alist);
font_charset_alist = Qnil;
- DEFSYM (Qfont_spec, "font-spec");
- DEFSYM (Qfont_entity, "font-entity");
- DEFSYM (Qfont_object, "font-object");
-
DEFSYM (Qopentype, "opentype");
DEFSYM (Qascii_0, "ascii-0");
DEFSYM (Qunicode_bmp, "unicode-bmp");
DEFSYM (Qunicode_sip, "unicode-sip");
+ DEFSYM (QCf, "Cf");
+
DEFSYM (QCotf, ":otf");
DEFSYM (QClang, ":lang");
DEFSYM (QCscript, ":script");
DEFSYM (Qp, "p");
DEFSYM (Qd, "d");
+ DEFSYM (Qja, "ja");
+ DEFSYM (Qko, "ko");
+
staticpro (&null_vector);
null_vector = Fmake_vector (make_number (0), Qnil);
staticpro (&scratch_font_prefer);
scratch_font_prefer = Ffont_spec (0, NULL);
+ staticpro (&Vfont_log_deferred);
+ Vfont_log_deferred = Fmake_vector (make_number (3), Qnil);
+
#if 0
#ifdef HAVE_LIBOTF
staticpro (&otf_list);
defsubr (&Sfind_font);
defsubr (&Sfont_xlfd_name);
defsubr (&Sclear_font_cache);
- defsubr (&Sfont_make_gstring);
- defsubr (&Sfont_fill_gstring);
- defsubr (&Sfont_shape_text);
+ defsubr (&Sfont_shape_gstring);
+ defsubr (&Sfont_variation_glyphs);
#if 0
defsubr (&Sfont_drive_otf);
defsubr (&Sfont_otf_alternates);
#endif /* HAVE_WINDOW_SYSTEM */
}
+void
+init_font ()
+{
+ Vfont_log = egetenv ("EMACS_FONT_LOG") ? Qnil : Qt;
+}
+
/* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
(do not change this comment) */