/* font.c -- "Font" primitives.
-Copyright (C) 2006-2014 Free Software Foundation, Inc.
+Copyright (C) 2006-2015 Free Software Foundation, Inc.
Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
-#ifndef MAX
-# define MAX(a, b) ((a) > (b) ? (a) : (b))
-#endif
-
Lisp_Object Qopentype;
/* Important character set strings. */
Lisp_Object
font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol)
{
- ptrdiff_t i;
- Lisp_Object tem;
- Lisp_Object obarray;
- ptrdiff_t nbytes, nchars;
+ ptrdiff_t i, nbytes, nchars;
+ Lisp_Object tem, name, obarray;
if (len == 1 && *str == '*')
return Qnil;
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;
- tem = make_specified_string (str, nchars, len,
- len != nchars && len == nbytes);
- return Fintern (tem, obarray);
+ name = make_specified_string (str, nchars, len,
+ len != nchars && len == nbytes);
+ return intern_driver (name, obarray, XINT (tem));
}
/* Return a pixel size of font-spec SPEC on frame F. */
{
int i, j;
char *s;
- Lisp_Object args[2], elt;
+ Lisp_Object elt;
/* At first try exact match. */
for (i = 0; i < len; i++)
eassert (len < 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));
+ ASET (font_style_table, prop - FONT_WEIGHT_INDEX,
+ Fvconcat (2, ((Lisp_Object [])
+ { table, Fmake_vector (make_number (1), elt) })));
return (100 << 8) | (i << 4);
}
else
{
val = prop[XLFD_ENCODING_INDEX];
if (! NILP (val))
- val = concat2 (build_string ("*-"), SYMBOL_NAME (val));
+ {
+ AUTO_STRING (star_dash, "*-");
+ val = concat2 (star_dash, SYMBOL_NAME (val));
+ }
}
else if (NILP (prop[XLFD_ENCODING_INDEX]))
- val = concat2 (SYMBOL_NAME (val), build_string ("-*"));
+ {
+ AUTO_STRING (dash_star, "-*");
+ val = concat2 (SYMBOL_NAME (val), dash_star);
+ }
else
- val = concat3 (SYMBOL_NAME (val), build_string ("-"),
- SYMBOL_NAME (prop[XLFD_ENCODING_INDEX]));
+ {
+ 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));
val = AREF (font, FONT_SIZE_INDEX);
eassert (NUMBERP (val) || NILP (val));
char font_size_index_buf[sizeof "-*"
- + MAX (INT_STRLEN_BOUND (EMACS_INT),
+ + max (INT_STRLEN_BOUND (EMACS_INT),
1 + DBL_MAX_10_EXP + 1)];
if (INTEGERP (val))
{
void
font_parse_family_registry (Lisp_Object family, Lisp_Object registry, Lisp_Object font_spec)
{
- int len;
+ ptrdiff_t len;
char *p0, *p1;
if (! NILP (family)
p1 = strchr (p0, '-');
if (! p1)
{
- if (SDATA (registry)[len - 1] == '*')
- registry = concat2 (registry, build_string ("-*"));
- else
- registry = concat2 (registry, build_string ("*-*"));
+ AUTO_STRING (extra, ("*-*" + (len && p0[len - 1] == '*')));
+ registry = concat2 (registry, extra);
}
registry = Fdowncase (registry);
ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil));
{
Lisp_Object entity, val;
enum font_property_index prop;
- int i;
+ ptrdiff_t i;
for (val = Qnil, i = ASIZE (vec) - 1; i >= 0; i--)
{
return spec;
}
-/* Return a copy of FONT as a font-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)
{
- Lisp_Object new_spec, tail, prev, extra;
- int i;
+ enum { font_spec_size = VECSIZE (struct font_spec) };
+ Lisp_Object new_spec, tail, *pcdr;
+ struct font_spec *spec;
CHECK_FONT (font);
- new_spec = font_make_spec ();
- for (i = 1; i < FONT_EXTRA_INDEX; i++)
- ASET (new_spec, i, AREF (font, i));
- extra = Fcopy_alist (AREF (font, FONT_EXTRA_INDEX));
- /* We must remove :font-entity property. */
- for (prev = Qnil, tail = extra; CONSP (tail); prev = tail, tail = XCDR (tail))
- if (EQ (XCAR (XCAR (tail)), QCfont_entity))
- {
- if (NILP (prev))
- extra = XCDR (extra);
- else
- XSETCDR (prev, XCDR (tail));
- break;
- }
- ASET (new_spec, FONT_EXTRA_INDEX, extra);
+
+ /* 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 (XCAR (tail), Qnil), pcdr = xcdr_addr (*pcdr);
+
+ XSETFONT (new_spec, spec);
return new_spec;
}
{
if (NILP (fold_wildcards))
return font_name;
- strcpy (name, SSDATA (font_name));
+ lispstpcpy (name, font_name);
namelen = SBYTES (font_name);
goto done;
}
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.
-If the optional fourth arg OBJECT is not nil, it is a string or a
-vector containing the target characters.
+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]
else if (STRINGP (object))
{
const unsigned char *p;
+ ptrdiff_t ifrom, ito;
- CHECK_NUMBER (from);
- CHECK_NUMBER (to);
- if (XINT (from) < 0 || XINT (from) > XINT (to)
- || XINT (to) > SCHARS (object))
- args_out_of_range_3 (object, from, to);
- if (EQ (from, to))
+ validate_subarray (object, from, to, SCHARS (object), &ifrom, &ito);
+ if (ifrom == ito)
return Qnil;
- len = XFASTINT (to) - XFASTINT (from);
+ len = ito - ifrom;
SAFE_ALLOCA_LISP (chars, len);
p = SDATA (object);
if (STRING_MULTIBYTE (object))
- for (i = 0; i < len; i++)
+ {
+ int c;
+
+ /* Skip IFROM characters from the beginning. */
+ for (i = 0; i < ifrom; i++)
+ c = STRING_CHAR_ADVANCE (p);
+
+ /* Now fetch an interesting characters. */
+ for (i = 0; i < len; i++)
{
- int c = STRING_CHAR_ADVANCE (p);
+ c = STRING_CHAR_ADVANCE (p);
chars[i] = make_number (c);
}
+ }
else
for (i = 0; i < len; i++)
- chars[i] = make_number (p[i]);
+ chars[i] = make_number (p[ifrom + i]);
}
- else
+ else if (VECTORP (object))
{
- CHECK_VECTOR (object);
- CHECK_NUMBER (from);
- CHECK_NUMBER (to);
- if (XINT (from) < 0 || XINT (from) > XINT (to)
- || XINT (to) > ASIZE (object))
- args_out_of_range_3 (object, from, to);
- if (EQ (from, to))
+ ptrdiff_t ifrom, ito;
+
+ validate_subarray (object, from, to, ASIZE (object), &ifrom, &ito);
+ if (ifrom == ito)
return Qnil;
- len = XFASTINT (to) - XFASTINT (from);
+ len = ito - ifrom;
for (i = 0; i < len; i++)
{
- Lisp_Object elt = AREF (object, XFASTINT (from) + i);
+ Lisp_Object elt = AREF (object, ifrom + i);
CHECK_CHARACTER (elt);
}
- chars = aref_addr (object, XFASTINT (from));
+ chars = aref_addr (object, ifrom);
}
+ else
+ wrong_type_argument (Qarrayp, object);
vec = make_uninit_vector (len);
for (i = 0; i < len; i++)
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, SIZE,
- HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
+
+The returned value is a vector:
+ [ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE
+ DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
+ CAPABILITY ]
where
OPENED-NAME is the name used for opening the font,
FULL-NAME is the full name 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.
+ how to compose characters,
+ MAX-WIDTH is the maximum advance width of the font,
+ ASCENT, DESCENT, SPACE-WIDTH, 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 is not yet loaded, return nil. */)
(Lisp_Object name, Lisp_Object frame)
{
return Qnil;
font = XFONT_OBJECT (font_object);
- info = make_uninit_vector (7);
+ info = make_uninit_vector (14);
ASET (info, 0, AREF (font_object, FONT_NAME_INDEX));
ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX));
ASET (info, 2, make_number (font->pixel_size));
ASET (info, 4, make_number (font->baseline_offset));
ASET (info, 5, make_number (font->relative_compose));
ASET (info, 6, make_number (font->default_ascent));
+ ASET (info, 7, make_number (font->max_width));
+ ASET (info, 8, make_number (font->ascent));
+ ASET (info, 9, make_number (font->descent));
+ ASET (info, 10, make_number (font->space_width));
+ ASET (info, 11, make_number (font->average_width));
+ ASET (info, 12, AREF (font_object, FONT_FILE_INDEX));
+ if (font->driver->otf_capability)
+ ASET (info, 13, Fcons (Qopentype, font->driver->otf_capability (font)));
+ else
+ ASET (info, 13, Qnil);
#if 0
/* As font_object is still in FONT_OBJLIST of the entity, we can't
if (FONTP (arg))
{
Lisp_Object tail, elt;
- Lisp_Object equalstr = build_string ("=");
+ AUTO_STRING (equal, "=");
val = Ffont_xlfd_name (arg, Qt);
for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
if (EQ (XCAR (elt), QCscript)
&& SYMBOLP (XCDR (elt)))
val = concat3 (val, SYMBOL_NAME (QCscript),
- concat2 (equalstr, SYMBOL_NAME (XCDR (elt))));
+ concat2 (equal, 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))));
+ 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 (equalstr,
- SYMBOL_NAME (XCAR (XCDR (elt)))));
+ concat2 (equal, SYMBOL_NAME (XCAR (XCDR (elt)))));
}
arg = val;
}
{
val = Ffont_xlfd_name (result, Qt);
if (! FONT_SPEC_P (result))
- val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
- build_string (":"), val);
+ {
+ AUTO_STRING (colon, ":");
+ val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)),
+ colon, val);
+ }
result = val;
}
else if (CONSP (result))