/* 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 "nsterm.h"
#endif /* HAVE_NS */
-Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
-
#ifdef HAVE_NS
extern Lisp_Object Qfontsize;
#endif
{ 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" }},
{
{ 0, { "reverse-oblique", "ro" }},
{ 10, { "reverse-italic", "ri" }},
- { 100, { "normal", "r" }},
+ { 100, { "normal", "r", "unspecified" }},
{ 200, { "italic" ,"i", "ot" }},
{ 210, { "oblique", "o" }}
};
{ 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" }},
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 (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;
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;
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);
}
static Lisp_Object font_sort_entites 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;
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;
}
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);
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);
for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist);
objlist = XCDR (objlist))
if (! driver_list)
return Qnil;
- font_object = driver_list->driver->open (f, entity, pixel_size);
+ 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;
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 (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);
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)))
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);
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;
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)
{
Lisp_Object f = font_for_char (face, c, pos - 1, string);
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;
`: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. */)
+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;
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;
}
struct font *font;
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)))
}
if (i == 3 || XINT (n) == 0)
return Qnil;
-
+
glyph = LGSTRING_GLYPH (gstring, 0);
from = LGLYPH_FROM (glyph);
to = LGLYPH_TO (glyph);
return composition_gstring_put_cache (gstring, XINT (n));
}
+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
DEFUN ("font-drive-otf", Ffont_drive_otf, Sfont_drive_otf, 6, 6, 0,
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_ (());
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");
defsubr (&Sfont_xlfd_name);
defsubr (&Sclear_font_cache);
defsubr (&Sfont_shape_gstring);
+ defsubr (&Sfont_variation_glyphs);
#if 0
defsubr (&Sfont_drive_otf);
defsubr (&Sfont_otf_alternates);