Mercurial > emacs
changeset 90400:80fff33f74f5
New file.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Tue, 06 Jun 2006 03:47:13 +0000 |
| parents | a5812696f7bf |
| children | 5ac810cdd794 |
| files | src/font.c src/font.h src/ftfont.c src/ftxfont.c src/xfont.c src/xftfont.c |
| diffstat | 6 files changed, 5547 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/font.c Tue Jun 06 03:47:13 2006 +0000 @@ -0,0 +1,2571 @@ +/* font.c -- "Font" primitives. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + 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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> +#include <stdlib.h> +#include <ctype.h> + +#include "lisp.h" +#include "buffer.h" +#include "frame.h" +#include "dispextern.h" +#include "charset.h" +#include "character.h" +#include "composite.h" +#include "fontset.h" +#include "font.h" + +#define FONT_DEBUG + +#ifdef FONT_DEBUG +#undef xassert +#define xassert(X) do {if (!(X)) abort ();} while (0) +#else +#define xassert(X) (void) 0 +#endif + +int enable_font_backend; + +Lisp_Object Qfontp; + +/* Like CHECK_FONT_SPEC but also validate properties of the font-spec, + and set X to the validated result. */ + +#define CHECK_VALIDATE_FONT_SPEC(x) \ + do { \ + if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \ + x = font_prop_validate (x); \ + } while (0) + +/* Number of pt per inch (from the TeXbook). */ +#define PT_PER_INCH 72.27 + +/* Return a pixel size corresponding to POINT size (1/10 pt unit) on + resolution RESY. */ +#define POINT_TO_PIXEL(POINT, RESY) ((POINT) * (RESY) / PT_PER_INCH / 10 + 0.5) + +#define PIXEL_TO_POINT(PIXEL, RESY) ((PIXEL) * PT_PER_INCH * 10 / (RESY) + 0.5) + +/* Special string of zero length. It is used to specify a NULL name + in a font properties (e.g. adstyle). We don't use the symbol of + NULL name because it's confusing (Lisp printer prints nothing for + it). */ +Lisp_Object null_string; + +/* Special vector of zero length. This is repeatedly used by (struct + font_driver *)->list when a specified font is not found. */ +Lisp_Object null_vector; + +/* Vector of 3 elements. Each element is an alist for one of font + style properties (weight, slant, width). The alist contains a + mapping between symbolic property values (e.g. `medium' for weight) + and numeric property values (e.g. 100). So, it looks like this: + [((thin . 0) ... (heavy . 210)) + ((ro . 0) ... (ot . 210)) + ((ultracondensed . 50) ... (wide . 200))] */ +static Lisp_Object font_style_table; + +/* Alist of font family vs the corresponding aliases. + Each element has this form: + (FAMILY ALIAS1 ALIAS2 ...) */ + +static Lisp_Object font_family_alist; + +/* Symbols representing keys of normal font properties. */ +extern Lisp_Object QCtype, QCfamily, QCweight, QCslant, QCwidth, QCsize, QCname; +Lisp_Object QCfoundry, QCadstyle, QCregistry, QCextra; +/* Symbols representing keys of font extra info. */ +Lisp_Object QCotf, QClanguage, QCscript; + +/* List of all font drivers. All font-backends (XXXfont.c) call + add_font_driver in syms_of_XXXfont to register the font-driver + here. */ +static struct font_driver_list *font_driver_list; + +static Lisp_Object prop_name_to_numeric P_ ((enum font_property_index, + Lisp_Object)); +static Lisp_Object prop_numeric_to_name P_ ((enum font_property_index, int)); +static Lisp_Object font_open_entity P_ ((FRAME_PTR, Lisp_Object, int)); + +/* Number of registered font drivers. */ +static int num_font_drivers; + +/* Return a numeric value corresponding to PROP's NAME (symbol). If + NAME is not registered in font_style_table, return Qnil. PROP must + be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */ + +static Lisp_Object +prop_name_to_numeric (prop, name) + enum font_property_index prop; + Lisp_Object name; +{ + int table_index = prop - FONT_WEIGHT_INDEX; + Lisp_Object val; + + val = assq_no_quit (name, AREF (font_style_table, table_index)); + return (NILP (val) ? Qnil : XCDR (val)); +} + + +/* Return a name (symbol) corresponding to PROP's NUMERIC value. If + no name is registered for NUMERIC in font_style_table, return a + symbol of integer name (e.g. `123'). PROP must be one of + FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */ + +static Lisp_Object +prop_numeric_to_name (prop, numeric) + enum font_property_index prop; + int numeric; +{ + int table_index = prop - FONT_WEIGHT_INDEX; + Lisp_Object table = AREF (font_style_table, table_index); + char buf[10]; + + while (! NILP (table)) + { + if (XINT (XCDR (XCAR (table))) >= numeric) + { + if (XINT (XCDR (XCAR (table))) == numeric) + return XCAR (XCAR (table)); + else + break; + } + table = XCDR (table); + } + sprintf (buf, "%d", numeric); + return intern (buf); +} + + +/* Return a symbol whose name is STR (length LEN). If STR contains + uppercase letters, downcase them in advance. */ + +Lisp_Object +intern_downcase (str, len) + char *str; + int len; +{ + char *buf; + int i; + + for (i = 0; i < len; i++) + if (isupper (str[i])) + break; + if (i == len) + return Fintern (make_unibyte_string (str, len), Qnil); + buf = alloca (len); + if (! buf) + return Fintern (null_string, Qnil); + bcopy (str, buf, len); + for (; i < len; i++) + if (isascii (buf[i])) + buf[i] = tolower (buf[i]); + return Fintern (make_unibyte_string (buf, len), Qnil); +} + +extern Lisp_Object Vface_alternative_font_family_alist; + +static void +build_font_family_alist () +{ + Lisp_Object alist = Vface_alternative_font_family_alist; + + for (; CONSP (alist); alist = XCDR (alist)) + { + Lisp_Object tail, elt; + + for (tail = XCAR (alist), elt = Qnil ; CONSP (tail); tail = XCDR (tail)) + elt = nconc2 (elt, Fcons (Fintern (XCAR (tail), Qnil), Qnil)); + font_family_alist = Fcons (elt, font_family_alist); + } +} + + +/* Font property validater. */ + +static Lisp_Object +font_prop_validate_type (prop, val) + enum font_property_index prop; + Lisp_Object val; +{ + return (SYMBOLP (val) ? val : Qerror); +} + +static Lisp_Object +font_prop_validate_symbol (prop, val) + enum font_property_index prop; + Lisp_Object val; +{ + if (STRINGP (val)) + val = (SCHARS (val) == 0 ? null_string + : intern_downcase ((char *) SDATA (val), SBYTES (val))); + else if (SYMBOLP (val)) + { + if (SCHARS (SYMBOL_NAME (val)) == 0) + val = null_string; + } + else + val = Qerror; + return val; +} + +static Lisp_Object +font_prop_validate_style (prop, val) + enum font_property_index prop; + Lisp_Object val; +{ + if (! INTEGERP (val)) + { + if (STRINGP (val)) + val = intern_downcase ((char *) SDATA (val), SBYTES (val)); + if (! SYMBOLP (val)) + val = Qerror; + else + { + val = prop_name_to_numeric (prop, val); + if (NILP (val)) + val = Qerror; + } + } + return val; +} + +static Lisp_Object +font_prop_validate_size (prop, val) + enum font_property_index prop; + Lisp_Object val; +{ + return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0) + ? val : Qerror); +} + +static Lisp_Object +font_prop_validate_extra (prop, val) + enum font_property_index prop; + Lisp_Object val; +{ + Lisp_Object tail; + + for (tail = val; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object key = Fcar (XCAR (tail)), this_val = Fcdr (XCAR (tail)); + + if (NILP (this_val)) + return Qnil; + if (EQ (key, QClanguage)) + if (! SYMBOLP (this_val)) + { + for (; CONSP (this_val); this_val = XCDR (this_val)) + if (! SYMBOLP (XCAR (this_val))) + return Qerror; + if (! NILP (this_val)) + return Qerror; + } + if (EQ (key, QCotf)) + if (! STRINGP (this_val)) + return Qerror; + } + return (NILP (tail) ? val : Qerror); +} + + +struct +{ + Lisp_Object *key; + Lisp_Object (*validater) P_ ((enum font_property_index prop, + Lisp_Object val)); +} font_property_table[FONT_SPEC_MAX] = + { { &QCtype, font_prop_validate_type }, + { &QCfoundry, font_prop_validate_symbol }, + { &QCfamily, font_prop_validate_symbol }, + { &QCadstyle, font_prop_validate_symbol }, + { &QCregistry, font_prop_validate_symbol }, + { &QCweight, font_prop_validate_style }, + { &QCslant, font_prop_validate_style }, + { &QCwidth, font_prop_validate_style }, + { &QCsize, font_prop_validate_size }, + { &QCextra, font_prop_validate_extra } + }; + +static enum font_property_index +check_font_prop_name (key) + Lisp_Object key; +{ + enum font_property_index i; + + for (i = FONT_TYPE_INDEX; i < FONT_SPEC_MAX; i++) + if (EQ (key, *font_property_table[i].key)) + break; + return i; +} + +static Lisp_Object +font_prop_validate (spec) + Lisp_Object spec; +{ + enum font_property_index i; + Lisp_Object val; + + for (i = FONT_TYPE_INDEX; i <= FONT_EXTRA_INDEX; i++) + { + if (! NILP (AREF (spec, i))) + { + val = (font_property_table[i].validater) (i, AREF (spec, i)); + if (EQ (val, Qerror)) + Fsignal (Qerror, list3 (build_string ("invalid font property"), + *font_property_table[i].key, + AREF (spec, i))); + ASET (spec, i, val); + } + } + return spec; +} + + +/* Font name parser and unparser */ + +/* 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_SIZE_INDEX, + XLFD_POINT_SIZE_INDEX, + XLFD_RESX_INDEX, + XLFD_RESY_INDEX, + XLFD_SPACING_INDEX, + XLFD_AVGWIDTH_INDEX, + XLFD_REGISTRY_INDEX, + XLFD_ENCODING_INDEX, + XLFD_LAST_INDEX +}; + +/* Return a symbol interned by string at STR and bytes LEN. + If LEN == 0, return a null string. + If the string is "*", return Qnil. + It is assured that LEN < 256. */ + +static Lisp_Object +intern_font_field (f, xlfd) + char *f[XLFD_LAST_INDEX + 1]; + int xlfd; +{ + char *str = f[xlfd] + 1; + int len; + + if (xlfd != XLFD_RESY_INDEX) + len = f[xlfd + 1] - f[xlfd] - 1; + else + len = f[XLFD_REGISTRY_INDEX] - f[xlfd] - 1; + + if (len == 0) + return null_string; + if (*str == '*' && len == 1) + return Qnil; + return intern_downcase (str, len); +} + +/* Parse P pointing 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 (p) + 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); +} + +/* Parse NAME (null terminated) as XLFD format, and store information + in FONT (font-spec or font-entity). If NAME is successfully + parsed, return 2 (non-scalable font), 1 (scalable vector font), or + 0 (auto-scaled font). Otherwise return -1. + + If FONT is a font-entity, store RESY-SPACING-AVWIDTH information as + a symbol in FONT_EXTRA_INDEX. + + If MERGE is nonzero, set a property of FONT only when it's nil. */ + +int +font_parse_xlfd (name, font, merge) + char *name; + Lisp_Object font; + int merge; +{ + int len = strlen (name); + int i, j; + int pixel_size, resy, avwidth; + double point_size; + char *f[XLFD_LAST_INDEX + 1]; + Lisp_Object val; + int first_wildcard_field = -1, last_wildcard_field = XLFD_LAST_INDEX; + + if (len > 255) + /* Maximum XLFD name length is 255. */ + return -1; + for (i = 0; *name; name++) + if (*name == '-' + && i < XLFD_LAST_INDEX) + { + f[i] = name; + if (name[1] == '*' && (! name[2] || name[2] == '-')) + { + if (first_wildcard_field < 0) + first_wildcard_field = i; + last_wildcard_field = i; + } + i++; + } + + f[XLFD_LAST_INDEX] = name; + if (i < XLFD_LAST_INDEX) + { + /* Not a fully specified XLFD. */ + if (first_wildcard_field < 0 ) + /* No wild card. */ + return -1; + i--; + if (last_wildcard_field < i) + { + /* Shift fields after the last wildcard field. */ + for (j = XLFD_LAST_INDEX - 1; j > last_wildcard_field; j--, i--) + f[j] = f[i]; + /* Make all fields between the first and last wildcard fieled + also wildcard fields. */ + for (j--; j > first_wildcard_field; j--) + f[j] = "-*"; + } + } + f[XLFD_ENCODING_INDEX] = f[XLFD_LAST_INDEX]; + + if (! merge || NILP (AREF (font, FONT_FOUNDRY_INDEX))) + ASET (font, FONT_FOUNDRY_INDEX, intern_font_field (f, XLFD_FOUNDRY_INDEX)); + if (! merge || NILP (AREF (font, FONT_FAMILY_INDEX))) + ASET (font, FONT_FAMILY_INDEX, intern_font_field (f, XLFD_FAMILY_INDEX)); + if (! merge || NILP (AREF (font, FONT_ADSTYLE_INDEX))) + ASET (font, FONT_ADSTYLE_INDEX, intern_font_field (f, XLFD_ADSTYLE_INDEX)); + if (! merge || NILP (AREF (font, FONT_REGISTRY_INDEX))) + ASET (font, FONT_REGISTRY_INDEX, intern_font_field (f, XLFD_REGISTRY_INDEX)); + + for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; + j <= XLFD_SWIDTH_INDEX; i++, j++) + if (! merge || NILP (AREF (font, i))) + { + if (isdigit(f[j][1])) + val = make_number (atoi (f[j] + 1)); + else + { + Lisp_Object sym = intern_font_field (f, j); + + val = prop_name_to_numeric (i, sym); + if (NILP (val)) + val = sym; + } + ASET (font, i, val); + } + + if (f[XLFD_PIXEL_SIZE_INDEX][1] == '*') + pixel_size = -1; /* indicates "unspecified" */ + else if (f[XLFD_PIXEL_SIZE_INDEX][1] == '[') + pixel_size = parse_matrix (f[XLFD_PIXEL_SIZE_INDEX] + 1); + else if (isdigit (f[XLFD_PIXEL_SIZE_INDEX][1])) + pixel_size = strtod (f[XLFD_PIXEL_SIZE_INDEX] + 1, NULL); + else + pixel_size = -1; + + if (pixel_size < 0 && FONT_ENTITY_P (font)) + return -1; + + if (f[XLFD_POINT_SIZE_INDEX][1] == '*') + point_size = -1; /* indicates "unspecified" */ + else if (f[XLFD_POINT_SIZE_INDEX][1] == '[') + point_size = parse_matrix (f[XLFD_POINT_SIZE_INDEX] + 1); + else if (isdigit (f[XLFD_POINT_SIZE_INDEX][1])) + point_size = strtod (f[XLFD_POINT_SIZE_INDEX] + 1, NULL); + else + point_size = -1; + + if (f[XLFD_RESY_INDEX][1] == '*') + resy = -1; /* indicates "unspecified" */ + else + resy = strtod (f[XLFD_RESY_INDEX] + 1, NULL); + + if (f[XLFD_AVGWIDTH_INDEX][1] == '*') + avwidth = -1; /* indicates "unspecified" */ + else if (f[XLFD_AVGWIDTH_INDEX][1] == '~') + avwidth = - strtod (f[XLFD_AVGWIDTH_INDEX] + 2, NULL); + else + avwidth = strtod (f[XLFD_AVGWIDTH_INDEX] + 1, NULL); + + if (! merge || NILP (AREF (font, FONT_SIZE_INDEX))) + { + if (pixel_size >= 0) + ASET (font, FONT_SIZE_INDEX, make_number (pixel_size)); + else + { + if (point_size >= 0) + { + if (resy > 0) + { + pixel_size = POINT_TO_PIXEL (point_size, resy); + ASET (font, FONT_SIZE_INDEX, make_number (pixel_size)); + } + else + { + ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10)); + } + } + else + ASET (font, FONT_SIZE_INDEX, Qnil); + } + } + + if (FONT_ENTITY_P (font) + && EQ (AREF (font, FONT_TYPE_INDEX), Qx)) + ASET (font, FONT_EXTRA_INDEX, intern_font_field (f, XLFD_RESY_INDEX)); + + return (avwidth > 0 ? 2 : resy == 0); +} + +/* 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. */ + +int +font_unparse_xlfd (font, pixel_size, name, nbytes) + Lisp_Object font; + char *name; + int nbytes; +{ + char *f[XLFD_REGISTRY_INDEX + 1], *pixel_point; + char work[256]; + Lisp_Object val; + int i, j, len = 0; + + xassert (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)) + f[j] = "*", len += 2; + else + { + if (SYMBOLP (val)) + val = SYMBOL_NAME (val); + f[j] = (char *) SDATA (val), len += SBYTES (val) + 1; + } + } + + for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; + i++, j++) + { + val = AREF (font, i); + if (NILP (val)) + f[j] = "*", len += 2; + else + { + if (INTEGERP (val)) + val = prop_numeric_to_name (i, XINT (val)); + if (SYMBOLP (val)) + val = SYMBOL_NAME (val); + xassert (STRINGP (val)); + f[j] = (char *) SDATA (val), len += SBYTES (val) + 1; + } + } + + val = AREF (font, FONT_SIZE_INDEX); + xassert (NUMBERP (val) || NILP (val)); + if (INTEGERP (val)) + { + i = XINT (val); + if (i > 0) + len += sprintf (work, "%d", i) + 1; + else /* i == 0 */ + len += sprintf (work, "%d-*", pixel_size) + 1; + pixel_point = work; + } + else if (FLOATP (val)) + { + i = XFLOAT_DATA (val) * 10; + len += sprintf (work, "*-%d", i) + 1; + pixel_point = work; + } + else + pixel_point = "*-*", len += 4; + + if (FONT_ENTITY_P (font) + && EQ (AREF (font, FONT_TYPE_INDEX), Qx)) + { + /* Setup names for RESY-SPACING-AVWIDTH. */ + val = AREF (font, FONT_EXTRA_INDEX); + if (SYMBOLP (val) && ! NILP (val)) + { + val = SYMBOL_NAME (val); + f[XLFD_RESY_INDEX] = (char *) SDATA (val), len += SBYTES (val) + 1; + } + else + f[XLFD_RESY_INDEX] = "*-*-*", len += 6; + } + else + f[XLFD_RESY_INDEX] = "*-*-*", len += 6; + + len += 3; /* for "-*" of resx, and terminating '\0'. */ + if (len >= nbytes) + return -1; + return sprintf (name, "-%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], pixel_point, + f[XLFD_RESY_INDEX], f[XLFD_REGISTRY_INDEX]); +} + +void +font_merge_old_spec (name, family, registry, spec) + Lisp_Object name, family, registry, spec; +{ + if (STRINGP (name)) + { + if (font_parse_xlfd ((char *) SDATA (name), spec, 1) < 0) + { + Lisp_Object extra = Fcons (Fcons (QCname, name), Qnil); + + ASET (spec, FONT_EXTRA_INDEX, extra); + } + } + else + { + if (! NILP (family)) + { + int len; + char *p0, *p1; + + xassert (STRINGP (family)); + len = SBYTES (family); + p0 = (char *) SDATA (family); + p1 = index (p0, '-'); + if (p1) + { + if (NILP (AREF (spec, FONT_FOUNDRY_INDEX))) + ASET (spec, FONT_FOUNDRY_INDEX, + intern_downcase (p0, p1 - p0)); + if (NILP (AREF (spec, FONT_FAMILY_INDEX))) + ASET (spec, FONT_FAMILY_INDEX, + intern_downcase (p1 + 1, len - (p1 + 1 - p0))); + } + else if (NILP (AREF (spec, FONT_FAMILY_INDEX))) + ASET (spec, FONT_FAMILY_INDEX, intern_downcase (p0, len)); + } + if (! NILP (registry) + && NILP (AREF (spec, FONT_REGISTRY_INDEX))) + ASET (spec, FONT_REGISTRY_INDEX, + intern_downcase ((char *) SDATA (registry), SBYTES (registry))); + } +} + + +/* OTF handler */ + +#ifdef HAVE_LIBOTF +#include <otf.h> + +struct otf_list +{ + Lisp_Object entity; + OTF *otf; + struct otf_list *next; +}; + +static struct otf_list *otf_list; + +static Lisp_Object +otf_tag_symbol (tag) + OTF_Tag tag; +{ + char name[5]; + + OTF_tag_name (tag, name); + return Fintern (make_unibyte_string (name, 4), Qnil); +} + +static OTF * +otf_open (entity, file) + Lisp_Object entity; + char *file; +{ + struct otf_list *list = otf_list; + + while (list && ! EQ (list->entity, entity)) + list = list->next; + if (! list) + { + list = malloc (sizeof (struct otf_list)); + list->entity = entity; + list->otf = file ? OTF_open (file) : NULL; + list->next = otf_list; + otf_list = list; + } + return list->otf; +} + + +/* Return a list describing which scripts/languages FONT supports by + which GSUB/GPOS features of OpenType tables. See the comment of + (sturct font_driver).otf_capability. */ + +Lisp_Object +font_otf_capability (font) + struct font *font; +{ + OTF *otf; + Lisp_Object capability = Fcons (Qnil, Qnil); + int i; + + otf = otf_open (font->entity, font->file_name); + 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 (j == 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; +} + +static int +parse_gsub_gpos_spec (spec, script, langsys, features) + Lisp_Object spec; + char **script, **langsys, **features; +{ + Lisp_Object val; + int len; + char *p; + int asterisk; + + val = XCAR (spec); + *script = (char *) SDATA (SYMBOL_NAME (val)); + spec = XCDR (spec); + val = XCAR (spec); + *langsys = NILP (val) ? NULL : (char *) SDATA (SYMBOL_NAME (val)); + spec = XCDR (spec); + len = XINT (Flength (spec)); + *features = p = malloc (6 * len); + if (! p) + return -1; + + for (asterisk = 0; CONSP (spec); spec = XCDR (spec)) + { + val = XCAR (spec); + if (SREF (SYMBOL_NAME (val), 0) == '*') + { + asterisk = 1; + p += sprintf (p, ",*"); + } + else if (! asterisk) + p += sprintf (p, ",%s", SDATA (SYMBOL_NAME (val))); + else + p += sprintf (p, ",~%s", SDATA (SYMBOL_NAME (val))); + } + return 0; +} + +#define DEVICE_DELTA(table, size) \ + (((size) >= (table).StartSize && (size) <= (table).EndSize) \ + ? (table).DeltaValue[(size) >= (table).StartSize] \ + : 0) + +void +adjust_anchor (struct font *font, OTF_Anchor *anchor, + unsigned code, int size, int *x, int *y) +{ + if (anchor->AnchorFormat == 2) + { + int x0, y0; + + if (font->driver->anchor_point (font, code, anchor->f.f1.AnchorPoint, + &x0, &y0) >= 0) + *x = x0, *y = y0; + } + else if (anchor->AnchorFormat == 3) + { + if (anchor->f.f2.XDeviceTable.offset) + *x += DEVICE_DELTA (anchor->f.f2.XDeviceTable, size); + if (anchor->f.f2.YDeviceTable.offset) + *y += DEVICE_DELTA (anchor->f.f2.YDeviceTable, size); + } +} + + +/* Drive FONT's OTF GSUB features according to GSUB_SPEC. See the + comment of (sturct font_driver).otf_gsub. */ + +int +font_otf_gsub (font, gsub_spec, gstring_in, from, to, gstring_out, idx) + struct font *font; + Lisp_Object gsub_spec; + Lisp_Object gstring_in; + int from, to; + Lisp_Object gstring_out; + int idx; +{ + int len; + int i; + OTF *otf; + OTF_GlyphString otf_gstring; + OTF_Glyph *g; + char *script, *langsys, *features; + + otf = otf_open (font->entity, font->file_name); + if (! otf) + return 0; + if (OTF_get_table (otf, "head") < 0) + return 0; + if (OTF_check_table (otf, "GSUB") < 0) + return 0; + if (parse_gsub_gpos_spec (gsub_spec, &script, &langsys, &features) < 0) + return 0; + len = to - from; + otf_gstring.size = otf_gstring.used = len; + otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len); + memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len); + for (i = 0; i < len; i++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring_in, from + i); + + otf_gstring.glyphs[i].c = XINT (LGLYPH_CHAR (g)); + otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (g)); + } + + OTF_drive_gdef (otf, &otf_gstring); + if (OTF_drive_gsub (otf, &otf_gstring, script, langsys, features) < 0) + { + free (otf_gstring.glyphs); + return 0; + } + if (ASIZE (gstring_out) < idx + otf_gstring.used) + { + free (otf_gstring.glyphs); + return -1; + } + + for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used;) + { + int i0 = g->f.index.from, i1 = g->f.index.to; + Lisp_Object glyph = LGSTRING_GLYPH (gstring_in, from + i0); + Lisp_Object min_idx = AREF (glyph, 0); + Lisp_Object max_idx = AREF (glyph, 1); + + if (i0 < i1) + { + int min_idx_i = XINT (min_idx), max_idx_i = XINT (max_idx); + + for (i0++; i0 <= i1; i0++) + { + glyph = LGSTRING_GLYPH (gstring_in, from + i0); + if (min_idx_i > XINT (AREF (glyph, 0))) + min_idx_i = XINT (AREF (glyph, 0)); + if (max_idx_i < XINT (AREF (glyph, 1))) + max_idx_i = XINT (AREF (glyph, 1)); + } + min_idx = make_number (min_idx_i); + max_idx = make_number (max_idx_i); + i0 = g->f.index.from; + } + for (; i < otf_gstring.used && g->f.index.from == i0; i++, g++) + { + glyph = LGSTRING_GLYPH (gstring_out, idx + i); + ASET (glyph, 0, min_idx); + ASET (glyph, 1, max_idx); + LGLYPH_SET_CHAR (glyph, make_number (g->c)); + LGLYPH_SET_CODE (glyph, make_number (g->glyph_id)); + } + } + + free (otf_gstring.glyphs); + return i; +} + +/* Drive FONT's OTF GPOS features according to GPOS_SPEC. See the + comment of (sturct font_driver).otf_gpos. */ + +int +font_otf_gpos (font, gpos_spec, gstring, from, to) + struct font *font; + Lisp_Object gpos_spec; + Lisp_Object gstring; + int from, to; +{ + int len; + int i; + OTF *otf; + OTF_GlyphString otf_gstring; + OTF_Glyph *g; + char *script, *langsys, *features; + Lisp_Object glyph; + int u, size; + Lisp_Object base, mark; + + otf = otf_open (font->entity, font->file_name); + if (! otf) + return 0; + if (OTF_get_table (otf, "head") < 0) + return 0; + if (OTF_check_table (otf, "GPOS") < 0) + return 0; + if (parse_gsub_gpos_spec (gpos_spec, &script, &langsys, &features) < 0) + return 0; + len = to - from; + otf_gstring.size = otf_gstring.used = len; + otf_gstring.glyphs = (OTF_Glyph *) malloc (sizeof (OTF_Glyph) * len); + memset (otf_gstring.glyphs, 0, sizeof (OTF_Glyph) * len); + for (i = 0; i < len; i++) + { + glyph = LGSTRING_GLYPH (gstring, from + i); + otf_gstring.glyphs[i].glyph_id = XINT (LGLYPH_CODE (glyph)); + } + + OTF_drive_gdef (otf, &otf_gstring); + + if (OTF_drive_gpos (otf, &otf_gstring, script, langsys, features) < 0) + { + free (otf_gstring.glyphs); + return 0; + } + + u = otf->head->unitsPerEm; + size = font->pixel_size; + base = mark = Qnil; + for (i = 0, g = otf_gstring.glyphs; i < otf_gstring.used; i++, g++) + { + Lisp_Object prev; + int xoff = 0, yoff = 0, width_adjust = 0; + + if (! g->glyph_id) + continue; + + glyph = LGSTRING_GLYPH (gstring, from + i); + switch (g->positioning_type) + { + case 0: + break; + case 1: case 2: + { + int format = g->f.f1.format; + + if (format & OTF_XPlacement) + xoff = g->f.f1.value->XPlacement * size / u; + if (format & OTF_XPlaDevice) + xoff += DEVICE_DELTA (g->f.f1.value->XPlaDevice, size); + if (format & OTF_YPlacement) + yoff = - (g->f.f1.value->YPlacement * size / u); + if (format & OTF_YPlaDevice) + yoff -= DEVICE_DELTA (g->f.f1.value->YPlaDevice, size); + if (format & OTF_XAdvance) + width_adjust += g->f.f1.value->XAdvance * size / u; + if (format & OTF_XAdvDevice) + width_adjust += DEVICE_DELTA (g->f.f1.value->XAdvDevice, size); + } + break; + case 3: + /* Not yet supported. */ + break; + case 4: case 5: + if (NILP (base)) + break; + prev = base; + goto label_adjust_anchor; + default: /* i.e. case 6 */ + if (NILP (mark)) + break; + prev = mark; + + label_adjust_anchor: + { + int base_x, base_y, mark_x, mark_y, width; + unsigned code; + + base_x = g->f.f4.base_anchor->XCoordinate * size / u; + base_y = g->f.f4.base_anchor->YCoordinate * size / u; + mark_x = g->f.f4.mark_anchor->XCoordinate * size / u; + mark_y = g->f.f4.mark_anchor->YCoordinate * size / u; + + code = XINT (LGLYPH_CODE (prev)); + if (g->f.f4.base_anchor->AnchorFormat != 1) + adjust_anchor (font, g->f.f4.base_anchor, + code, size, &base_x, &base_y); + if (g->f.f4.mark_anchor->AnchorFormat != 1) + adjust_anchor (font, g->f.f4.mark_anchor, + code, size, &mark_x, &mark_y); + + if (NILP (LGLYPH_WIDTH (prev))) + { + width = font->driver->text_extents (font, &code, 1, NULL); + LGLYPH_SET_WIDTH (prev, make_number (width)); + } + xoff = XINT (LGLYPH_XOFF (prev)) + (base_x - width) - mark_x; + yoff = XINT (LGLYPH_YOFF (prev)) + mark_y - base_y; + } + } + if (g->GlyphClass == OTF_GlyphClass0) + base = mark = glyph; + else if (g->GlyphClass == OTF_GlyphClassMark) + mark = glyph; + else + base = glyph; + + LGLYPH_SET_XOFF (glyph, make_number (xoff)); + LGLYPH_SET_YOFF (glyph, make_number (yoff)); + LGLYPH_SET_WADJUST (glyph, make_number (width_adjust)); + } + + free (otf_gstring.glyphs); + return 0; +} + +#endif /* HAVE_LIBOTF */ + + +/* glyph-string handler */ + +/* GSTRING is a vector of this form: + [ [FONT-OBJECT LBEARING RBEARING WITH ASCENT DESCENT] GLYPH ... ] + and GLYPH is a vector of this form: + [ FROM-IDX TO-IDX C CODE X-OFF Y-OFF WIDTH WADJUST ] + where + FROM-IDX and TO-IDX are used internally and should not be touched. + C is a character of the glyph. + CODE is a glyph-code of C in FONT-OBJECT. + X-OFF and Y-OFF are offests to the base position for the glyph. + WIDTH is a normal width of the glyph. + WADJUST is an adjustment to the normal width of the glyph. */ + +struct font * +font_prepare_composition (cmp) + struct composition *cmp; +{ + Lisp_Object gstring + = AREF (XHASH_TABLE (composition_hash_table)->key_and_value, + cmp->hash_index * 2); + struct font *font = XSAVE_VALUE (LGSTRING_FONT (gstring))->pointer; + int len = LGSTRING_LENGTH (gstring); + int i; + + cmp->font = font; + cmp->lbearing = cmp->rbearing = cmp->pixel_width = 0; + cmp->ascent = font->ascent; + cmp->descent = font->descent; + + for (i = 0; i < len; i++) + { + Lisp_Object g = LGSTRING_GLYPH (gstring, i); + unsigned code = XINT (LGLYPH_CODE (g)); + struct font_metrics metrics; + + font->driver->text_extents (font, &code, 1, &metrics); + LGLYPH_SET_WIDTH (g, make_number (metrics.width)); + metrics.lbearing += XINT (LGLYPH_XOFF (g)); + metrics.rbearing += XINT (LGLYPH_XOFF (g)); + metrics.ascent += XINT (LGLYPH_YOFF (g)); + metrics.descent += XINT (LGLYPH_YOFF (g)); + + if (cmp->lbearing > cmp->pixel_width + metrics.lbearing) + cmp->lbearing = cmp->pixel_width + metrics.lbearing; + if (cmp->rbearing < cmp->pixel_width + metrics.rbearing) + cmp->rbearing = cmp->pixel_width + metrics.rbearing; + if (cmp->ascent < metrics.ascent) + cmp->ascent = metrics.ascent; + if (cmp->descent < metrics.descent) + cmp->descent = metrics.descent; + cmp->pixel_width += metrics.width + XINT (LGLYPH_WADJUST (g)); + } + LGSTRING_SET_LBEARING (gstring, make_number (cmp->lbearing)); + LGSTRING_SET_RBEARING (gstring, make_number (cmp->rbearing)); + LGSTRING_SET_WIDTH (gstring, make_number (cmp->pixel_width)); + LGSTRING_SET_ASCENT (gstring, make_number (cmp->ascent)); + LGSTRING_SET_DESCENT (gstring, make_number (cmp->descent)); + + return font; +} + +int +font_gstring_produce (old, from, to, new, idx, code, n) + Lisp_Object old; + int from, to; + Lisp_Object new; + int idx; + unsigned *code; + int n; +{ + Lisp_Object min_idx, max_idx; + int i; + + if (idx + n > ASIZE (new)) + return -1; + if (from == to) + { + if (from == 0) + { + min_idx = make_number (0); + max_idx = make_number (1); + } + else + { + min_idx = AREF (AREF (old, from - 1), 0); + max_idx = AREF (AREF (old, from - 1), 1); + } + } + else if (from + 1 == to) + { + min_idx = AREF (AREF (old, from), 0); + max_idx = AREF (AREF (old, from), 1); + } + else + { + int min_idx_i = XINT (AREF (AREF (old, from), 0)); + int max_idx_i = XINT (AREF (AREF (old, from), 1)); + + for (i = from + 1; i < to; i++) + { + if (min_idx_i > XINT (AREF (AREF (old, i), 0))) + min_idx_i = XINT (AREF (AREF (old, i), 0)); + if (max_idx_i < XINT (AREF (AREF (old, i), 1))) + max_idx_i = XINT (AREF (AREF (old, i), 1)); + } + min_idx = make_number (min_idx_i); + max_idx = make_number (max_idx_i); + } + + for (i = 0; i < n; i++) + { + ASET (AREF (new, idx + i), 0, min_idx); + ASET (AREF (new, idx + i), 1, max_idx); + ASET (AREF (new, idx + i), 2, make_number (code[i])); + } + + return 0; +} + +/* 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, + Lisp_Object, Lisp_Object)); + +/* 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. + + Each 1-bit in the highest 4 bits of the score is used for atomic + properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY. + + Each 7-bit in the lowest 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. */ +static int sort_shift_bits[FONT_SIZE_INDEX + 1]; + +/* Score font-entity ENTITY against font-spec SPEC. The return value + indicates how different ENTITY is compared with SPEC. */ + +static unsigned +font_score (entity, spec) + Lisp_Object entity, spec; +{ + unsigned score = 0; + int i; + /* Score atomic fields. Maximum difference is 1. */ + for (i = FONT_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++) + { + Lisp_Object val = AREF (spec, i); + + if (! NILP (val) + && ! EQ (val, AREF (entity, i))) + score |= 1 << sort_shift_bits[i]; + } + + /* Score numeric fields. Maximum difference is 127. */ + for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++) + { + Lisp_Object spec_val = AREF (spec, i); + Lisp_Object entity_val = AREF (entity, i); + + if (! NILP (spec_val) && ! EQ (spec_val, entity_val)) + { + if (! INTEGERP (entity_val)) + score |= 127 << sort_shift_bits[i]; + else if (i < FONT_SIZE_INDEX + || XINT (entity_val) != 0) + { + int diff = XINT (entity_val) - XINT (spec_val); + + if (diff < 0) + diff = - diff; + score |= min (diff, 127) << sort_shift_bits[i]; + } + } + } + + return score; +} + + +/* The comparison function for qsort. */ + +static int +font_compare (d1, d2) + const void *d1, *d2; +{ + return (*(unsigned *) d1 < *(unsigned *) d2 + ? -1 : *(unsigned *) d1 > *(unsigned *) d2); +} + + +/* The structure for elements being sorted by qsort. */ +struct font_sort_data +{ + unsigned score; + Lisp_Object entity; +}; + + +/* Sort font-entities in vector VEC by closeness to font-spec PREFER. + If PREFER specifies a point-size, calculate the corresponding + pixel-size from the Y-resolution of FRAME before sorting. If SPEC + is not nil, it is a font-spec to get the font-entities in VEC. */ + +static Lisp_Object +font_sort_entites (vec, prefer, frame, spec) + Lisp_Object vec, prefer, frame, spec; +{ + Lisp_Object size; + int len, i; + struct font_sort_data *data; + int prefer_is_copy = 0; + USE_SAFE_ALLOCA; + + len = ASIZE (vec); + if (len <= 1) + return vec; + + size = AREF (spec, FONT_SIZE_INDEX); + if (FLOATP (size)) + { + double point_size = XFLOAT_DATA (size) * 10; + int pixel_size = POINT_TO_PIXEL (point_size, XFRAME (frame)->resy); + + prefer = Fcopy_sequence (prefer); + ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size)); + prefer_is_copy = 1; + } + + if (! NILP (spec)) + { + /* As it is assured that all fonts in VEC match with SPEC, we + should ignore properties specified in SPEC. So, set the + corresponding properties in PREFER nil. */ + for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++) + if (! NILP (AREF (spec, i)) && ! NILP (AREF (prefer, i))) + break; + if (i <= FONT_SIZE_INDEX) + { + if (! prefer_is_copy) + prefer = Fcopy_sequence (prefer); + for (; i <= FONT_SIZE_INDEX; i++) + if (! NILP (AREF (spec, i)) && ! NILP (AREF (prefer, i))) + ASET (prefer, i, Qnil); + } + } + + /* Scoring and sorting. */ + SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * len); + for (i = 0; i < len; i++) + { + data[i].entity = AREF (vec, i); + data[i].score = font_score (data[i].entity, prefer); + } + qsort (data, len, sizeof *data, font_compare); + for (i = 0; i < len; i++) + ASET (vec, i, data[i].entity); + SAFE_FREE (); + + return vec; +} + + +/* API of Font Service Layer. */ + +void +font_update_sort_order (order) + int *order; +{ + int i, shift_bits = 21; + + for (i = 0; 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; + } +} + +Lisp_Object +font_symbolic_weight (font) + Lisp_Object font; +{ + Lisp_Object weight = AREF (font, FONT_WEIGHT_INDEX); + + if (INTEGERP (weight)) + weight = prop_numeric_to_name (FONT_WEIGHT_INDEX, XINT (weight)); + return weight; +} + +Lisp_Object +font_symbolic_slant (font) + Lisp_Object font; +{ + Lisp_Object slant = AREF (font, FONT_SLANT_INDEX); + + if (INTEGERP (slant)) + slant = prop_numeric_to_name (FONT_SLANT_INDEX, XINT (slant)); + return slant; +} + +Lisp_Object +font_symbolic_width (font) + Lisp_Object font; +{ + Lisp_Object width = AREF (font, FONT_WIDTH_INDEX); + + if (INTEGERP (width)) + width = prop_numeric_to_name (FONT_WIDTH_INDEX, XINT (width)); + return width; +} + +Lisp_Object +font_find_object (font) + struct font *font; +{ + Lisp_Object tail, elt; + + for (tail = AREF (font->entity, FONT_OBJLIST_INDEX); CONSP (tail); + tail = XCDR (tail)) + { + elt = XCAR (tail); + if (font == XSAVE_VALUE (elt)->pointer + && XSAVE_VALUE (elt)->integer > 0) + return elt; + } + abort (); + return Qnil; +} + +static Lisp_Object scratch_font_spec, scratch_font_prefer; + +/* Return a vector of font-entities matching with SPEC on frame F. */ + +static Lisp_Object +font_list_entities (frame, spec) + Lisp_Object frame, spec; +{ + FRAME_PTR f = XFRAME (frame); + struct font_driver_list *driver_list = f->font_driver_list; + Lisp_Object ftype, family, alternate_familes; + Lisp_Object *vec = alloca (sizeof (Lisp_Object) * num_font_drivers); + int i; + + if (! vec) + return null_vector; + + family = AREF (spec, FONT_FAMILY_INDEX); + if (NILP (family)) + alternate_familes = Qnil; + else + { + if (NILP (font_family_alist) + && !NILP (Vface_alternative_font_family_alist)) + build_font_family_alist (); + alternate_familes = assq_no_quit (family, font_family_alist); + if (! NILP (alternate_familes)) + alternate_familes = XCDR (alternate_familes); + } + xassert (ASIZE (spec) == FONT_SPEC_MAX); + ftype = AREF (spec, FONT_TYPE_INDEX); + + for (i = 0; driver_list; driver_list = driver_list->next) + if (NILP (ftype) || EQ (driver_list->driver->type, ftype)) + { + Lisp_Object cache = driver_list->driver->get_cache (frame); + Lisp_Object tail = alternate_familes; + Lisp_Object val; + + xassert (CONSP (cache)); + ASET (spec, FONT_TYPE_INDEX, driver_list->driver->type); + ASET (spec, FONT_FAMILY_INDEX, family); + + while (1) + { + val = assoc_no_quit (spec, XCDR (cache)); + if (CONSP (val)) + val = XCDR (val); + else + { + val = driver_list->driver->list (frame, spec); + if (VECTORP (val)) + XSETCDR (cache, Fcons (Fcons (Fcopy_sequence (spec), val), + XCDR (cache))); + } + if (VECTORP (val) && ASIZE (val) > 0) + { + vec[i++] = val; + break; + } + if (NILP (tail)) + break; + ASET (spec, FONT_FAMILY_INDEX, XCAR (tail)); + tail = XCDR (tail); + } + } + ASET (spec, FONT_TYPE_INDEX, ftype); + ASET (spec, FONT_FAMILY_INDEX, family); + return (i > 0 ? Fvconcat (i, vec) : null_vector); +} + +static int num_fonts; + +static Lisp_Object +font_open_entity (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + struct font_driver_list *driver_list; + Lisp_Object objlist, size, val; + struct font *font; + + size = AREF (entity, FONT_SIZE_INDEX); + xassert (NATNUMP (size)); + if (XINT (size) != 0) + pixel_size = XINT (size); + + for (objlist = AREF (entity, FONT_OBJLIST_INDEX); CONSP (objlist); + objlist = XCDR (objlist)) + { + font = XSAVE_VALUE (XCAR (objlist))->pointer; + if (font->pixel_size == pixel_size) + { + XSAVE_VALUE (XCAR (objlist))->integer++; + return XCAR (objlist); + } + } + + xassert (FONT_ENTITY_P (entity)); + 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; + + font = driver_list->driver->open (f, entity, pixel_size); + if (! font) + return Qnil; + val = make_save_value (font, 1); + ASET (entity, FONT_OBJLIST_INDEX, + Fcons (val, AREF (entity, FONT_OBJLIST_INDEX))); + num_fonts++; + return val; +} + +void +font_close_object (f, font_object) + FRAME_PTR f; + Lisp_Object font_object; +{ + struct font *font; + Lisp_Object objlist = AREF (font->entity, FONT_OBJLIST_INDEX); + Lisp_Object tail, prev = Qnil; + + for (prev = Qnil, tail = objlist; CONSP (tail); + prev = tail, tail = XCDR (tail)) + if (EQ (font_object, XCAR (tail))) + { + struct Lisp_Save_Value *p = XSAVE_VALUE (font_object); + + xassert (p->integer > 0); + p->integer--; + if (p->integer == 0) + { + if (font->driver->close) + font->driver->close (f, p->pointer); + p->pointer = NULL; + if (NILP (prev)) + ASET (font->entity, FONT_OBJLIST_INDEX, XCDR (objlist)); + else + XSETCDR (prev, XCDR (objlist)); + } + break; + } +} + +int +font_has_char (f, font_entity, c) + FRAME_PTR f; + Lisp_Object font_entity; + int c; +{ + Lisp_Object type = AREF (font_entity, 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 -1; + return driver_list->driver->has_char (font_entity, c); +} + +unsigned +font_encode_char (font_object, c) + Lisp_Object font_object; + int c; +{ + struct font *font = XSAVE_VALUE (font_object)->pointer; + + return font->driver->encode_char (font, c); +} + +char * +font_get_name (font_object) + Lisp_Object font_object; +{ + struct font *font = XSAVE_VALUE (font_object)->pointer; + + return (font->font.full_name ? font->font.full_name + : font->file_name ? font->file_name + : ""); +} + +Lisp_Object +font_get_frame (font) + Lisp_Object font; +{ + if (FONT_OBJECT_P (font)) + font = ((struct font *) XSAVE_VALUE (font)->pointer)->entity; + xassert (FONT_ENTITY_P (font)); + return AREF (font, FONT_FRAME_INDEX); +} + +extern Lisp_Object Qunspecified, Qignore_defface; + +Lisp_Object +font_find_for_lface (f, lface, spec) + FRAME_PTR f; + Lisp_Object *lface; + Lisp_Object spec; +{ + Lisp_Object attrs[LFACE_SLANT_INDEX + 1]; + Lisp_Object frame, val, entities; + int i; + unsigned char try_unspecified[FONT_SPEC_MAX]; + + for (i = 0; i <= LFACE_SLANT_INDEX; i++) + { + val = lface[i]; + if (EQ (val, Qunspecified) || EQ (val, Qignore_defface)) + val = Qnil; + attrs[i] = val; + } + if (NILP (spec)) + for (i = 0; i < FONT_SPEC_MAX; i++) + ASET (scratch_font_spec, i, Qnil); + else + for (i = 0; i < FONT_SPEC_MAX; i++) + ASET (scratch_font_spec, i, AREF (spec, i)); + + /* If SPEC doesn't specify a specific property, it can be tried with + nil even if FACE specifies it. */ + for (i = FONT_FOUNDRY_INDEX; i <= FONT_SIZE_INDEX; i++) + try_unspecified[i] = NILP (AREF (scratch_font_spec, i)); + + if (STRINGP (attrs[LFACE_FONT_INDEX])) + font_merge_old_spec (attrs[LFACE_FONT_INDEX], Qnil, Qnil, + scratch_font_spec); + if (NILP (AREF (scratch_font_spec, FONT_FAMILY_INDEX)) + && ! NILP (attrs[LFACE_FAMILY_INDEX])) + font_merge_old_spec (Qnil, attrs[LFACE_FAMILY_INDEX], Qnil, + scratch_font_spec); + if (NILP (AREF (scratch_font_spec, FONT_REGISTRY_INDEX))) + { + ASET (scratch_font_spec, FONT_REGISTRY_INDEX, intern ("iso8859-1")); + try_unspecified[FONT_REGISTRY_INDEX] = 0; + } + + for (i = FONT_FAMILY_INDEX; i <= FONT_SIZE_INDEX; i++) + if (try_unspecified[i] + && NILP (AREF (scratch_font_spec, i))) + try_unspecified[i] = 0; + + XSETFRAME (frame, f); + entities = font_list_entities (frame, scratch_font_spec); + while (ASIZE (entities) == 0) + { + if (try_unspecified[FONT_WEIGHT_INDEX] + || try_unspecified[FONT_SLANT_INDEX] + || try_unspecified[FONT_WIDTH_INDEX] + || try_unspecified[FONT_SIZE_INDEX]) + { + for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++) + { + try_unspecified[i] = 0; + ASET (scratch_font_spec, i, Qnil); + } + entities = font_list_entities (frame, scratch_font_spec); + } + else if (try_unspecified[FONT_FOUNDRY_INDEX]) + { + try_unspecified[FONT_FOUNDRY_INDEX] = 0; + ASET (scratch_font_spec, FONT_FOUNDRY_INDEX, Qnil); + entities = font_list_entities (frame, scratch_font_spec); + } + else if (try_unspecified[FONT_FAMILY_INDEX]) + { + try_unspecified[FONT_FAMILY_INDEX] = 0; + ASET (scratch_font_spec, FONT_FAMILY_INDEX, Qnil); + entities = font_list_entities (frame, scratch_font_spec); + } + else + return Qnil; + } + + if (ASIZE (entities) > 1) + { + Lisp_Object prefer = scratch_font_prefer; + + for (i = 0; i < FONT_WEIGHT_INDEX; i++) + ASET (prefer, i, Qnil); + if (! NILP (attrs[LFACE_WEIGHT_INDEX])) + ASET (prefer, FONT_WEIGHT_INDEX, + font_prop_validate_style (FONT_WEIGHT_INDEX, + attrs[LFACE_WEIGHT_INDEX])); + if (! NILP (attrs[LFACE_SLANT_INDEX])) + ASET (prefer, FONT_SLANT_INDEX, + font_prop_validate_style (FONT_SLANT_INDEX, + attrs[LFACE_SLANT_INDEX])); + if (! NILP (attrs[LFACE_SWIDTH_INDEX])) + ASET (prefer, FONT_WIDTH_INDEX, + font_prop_validate_style (FONT_WIDTH_INDEX, + attrs[LFACE_SWIDTH_INDEX])); + if (! NILP (attrs[LFACE_HEIGHT_INDEX])) + { + int size; + + val = attrs[LFACE_HEIGHT_INDEX]; + size = POINT_TO_PIXEL (XINT (val), f->resy); + ASET (prefer, FONT_SIZE_INDEX, make_number (size)); + } + font_sort_entites (entities, prefer, frame, spec); + } + + return AREF (entities, 0); +} + +Lisp_Object +font_open_for_lface (f, lface, entity) + FRAME_PTR f; + Lisp_Object *lface; + Lisp_Object entity; +{ + int pt = XINT (lface[LFACE_HEIGHT_INDEX]); + int size = POINT_TO_PIXEL (pt, f->resy); + + return font_open_entity (f, entity, size); +} + +void +font_load_for_face (f, face) + FRAME_PTR f; + struct face *face; +{ + Lisp_Object entity; + + face->font_info_id = -1; + face->font_info = NULL; + face->font = NULL; + face->font_name = NULL; + + entity = font_find_for_lface (f, face->lface, Qnil); + if (! NILP (entity)) + { + Lisp_Object font_object = font_open_for_lface (f, face->lface, entity); + + if (! NILP (font_object)) + { + struct font *font = XSAVE_VALUE (font_object)->pointer; + + face->font = font->font.font; + face->font_info = (struct font_info *) font; + face->font_info_id = 0; + face->font_name = font->font.full_name; + } + } + if (! face->font) + add_to_log ("Unable to load font for a face%s", null_string, Qnil); +} + +void +font_prepare_for_face (f, face) + FRAME_PTR f; + struct face *face; +{ + struct font *font = (struct font *) face->font_info; + + if (font->driver->prepare_face) + font->driver->prepare_face (f, face); +} + +void +font_done_for_face (f, face) + FRAME_PTR f; + struct face *face; +{ + struct font *font = (struct font *) face->font_info; + + if (font->driver->done_face) + font->driver->done_face (f, face); + face->extra = NULL; +} + +Lisp_Object +font_open_by_name (f, name) + FRAME_PTR f; + char *name; +{ + Lisp_Object spec = Ffont_spec (0, NULL); + Lisp_Object entities = Qnil; + Lisp_Object frame; + int pixel_size; + + XSETFRAME (frame, f); + + ASET (spec, FONT_EXTRA_INDEX, + Fcons (Fcons (QCname, make_unibyte_string (name, strlen (name))), + Qnil)); + entities = font_list_entities (frame, spec); + if (ASIZE (entities) == 0) + return Qnil; + pixel_size = XINT (AREF (AREF (entities, 0), FONT_SIZE_INDEX)); + if (pixel_size == 0) + pixel_size = 12; + return font_open_entity (f, AREF (entities, 0), pixel_size); +} + + +/* Register font-driver DRIVER. This function is used in two ways. + + The first is with frame F non-NULL. In this case, DRIVER is + registered to be used for drawing characters on F. All frame + creaters (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 + (e.g. syms_of_xfont). */ + +void +register_font_driver (driver, f) + struct font_driver *driver; + FRAME_PTR f; +{ + struct font_driver_list *root = f ? f->font_driver_list : font_driver_list; + struct font_driver_list *prev, *list; + + if (f && ! driver->draw) + error ("Unsable font driver for a frame: %s", + SDATA (SYMBOL_NAME (driver->type))); + + for (prev = NULL, list = root; list; prev = list, list = list->next) + if (list->driver->type == driver->type) + error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver->type))); + + list = malloc (sizeof (struct font_driver_list)); + list->driver = driver; + list->next = NULL; + if (prev) + prev->next = list; + else if (f) + f->font_driver_list = list; + else + font_driver_list = list; + num_font_drivers++; +} + +/* Free font-driver list on frame F. It doesn't free font-drivers + themselves. */ + +void +free_font_driver_list (f) + FRAME_PTR f; +{ + while (f->font_driver_list) + { + struct font_driver_list *next = f->font_driver_list->next; + + free (f->font_driver_list); + f->font_driver_list = next; + } +} + + +/* Lisp API */ + +DEFUN ("fontp", Ffontp, Sfontp, 1, 1, 0, + doc: /* Return t if object is a font-spec or font-entity. */) + (object) + Lisp_Object object; +{ + return (FONTP (object) ? Qt : Qnil); +} + +DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0, + doc: /* Return a newly created font-spec with specified arguments as properties. +usage: (font-spec &rest properties) */) + (nargs, args) + int nargs; + Lisp_Object *args; +{ + Lisp_Object spec = Fmake_vector (make_number (FONT_SPEC_MAX), Qnil); + Lisp_Object extra = Qnil; + int i; + + for (i = 0; i < nargs; i += 2) + { + enum font_property_index prop; + Lisp_Object key = args[i], val = args[i + 1]; + + prop = check_font_prop_name (key); + if (prop < FONT_EXTRA_INDEX) + ASET (spec, prop, (font_property_table[prop].validater) (prop, val)); + else + extra = Fcons (Fcons (key, val), extra); + } + ASET (spec, FONT_EXTRA_INDEX, extra); + return spec; +} + + +DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0, + doc: /* Return the value of FONT's PROP property. +FONT may be a font-spec or font-entity. +If FONT is font-entity and PROP is :extra, always nil is returned. */) + (font, prop) + Lisp_Object font, prop; +{ + enum font_property_index idx; + + CHECK_FONT (font); + idx = check_font_prop_name (prop); + if (idx < FONT_EXTRA_INDEX) + return AREF (font, idx); + if (FONT_ENTITY_P (font)) + return Qnil; + return Fcdr (Fassoc (AREF (font, FONT_EXTRA_INDEX), prop)); +} + + +DEFUN ("font-put", Ffont_put, Sfont_put, 3, 3, 0, + doc: /* Set one property of FONT-SPEC: give property PROP value VALUE. */) + (font_spec, prop, val) + Lisp_Object font_spec, prop, val; +{ + enum font_property_index idx; + Lisp_Object extra, slot; + + CHECK_FONT_SPEC (font_spec); + idx = check_font_prop_name (prop); + if (idx < FONT_EXTRA_INDEX) + return ASET (font_spec, idx, val); + extra = AREF (font_spec, FONT_EXTRA_INDEX); + slot = Fassoc (extra, prop); + if (NILP (slot)) + extra = Fcons (Fcons (prop, val), extra); + else + Fsetcdr (slot, 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 sort fonts +by closeness to PREFER. */) + (font_spec, frame, num, prefer) + Lisp_Object font_spec, frame, num, prefer; +{ + Lisp_Object vec, list, tail; + int n = 0, i, len; + + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + CHECK_VALIDATE_FONT_SPEC (font_spec); + if (! NILP (num)) + { + CHECK_NUMBER (num); + n = XINT (num); + if (n <= 0) + return Qnil; + } + if (! NILP (prefer)) + CHECK_FONT (prefer); + + vec = font_list_entities (frame, font_spec); + len = ASIZE (vec); + if (len == 0) + return Qnil; + if (len == 1) + return Fcons (AREF (vec, 0), Qnil); + + if (! NILP (prefer)) + vec = font_sort_entites (vec, prefer, frame, font_spec); + + list = tail = Fcons (AREF (vec, 0), Qnil); + if (n == 0 || n > len) + n = len; + for (i = 1; i < n; i++) + { + Lisp_Object val = Fcons (AREF (vec, i), Qnil); + + XSETCDR (tail, val); + tail = val; + } + return list; +} + +DEFUN ("list-families", Flist_families, Slist_families, 0, 1, 0, + doc: /* List available font families on the current frame. +Optional 2nd argument FRAME specifies the target frame. */) + (frame) + Lisp_Object frame; +{ + FRAME_PTR f; + struct font_driver_list *driver_list; + Lisp_Object list; + + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + f = XFRAME (frame); + 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 (frame); + + 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); + } + } + 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. */) + (font_spec, frame) + Lisp_Object font_spec, frame; +{ + Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil); + + if (CONSP (val)) + val = XCAR (val); + return val; +} + +DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 1, 0, + doc: /* Return XLFD name of FONT. +FONT is a font-spec, font-entity, or font-object. +If the name is too long for XLFD (maximum 255 chars), return nil. */) + (font) + Lisp_Object font; +{ + char name[256]; + int pixel_size = 0; + + if (FONT_SPEC_P (font)) + CHECK_VALIDATE_FONT_SPEC (font); + else if (FONT_ENTITY_P (font)) + CHECK_FONT (font); + else + { + struct font *fontp; + + CHECK_FONT_GET_OBJECT (font, fontp); + font = fontp->entity; + pixel_size = fontp->pixel_size; + } + + if (font_unparse_xlfd (font, pixel_size, name, 256) < 0) + return Qnil; + return build_string (name); +} + +DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0, + doc: /* Clear font cache. */) + () +{ + Lisp_Object list, frame; + + FOR_EACH_FRAME (list, frame) + { + FRAME_PTR f = XFRAME (frame); + struct font_driver_list *driver_list = f->font_driver_list; + + for (; driver_list; driver_list = driver_list->next) + { + Lisp_Object cache = driver_list->driver->get_cache (frame); + Lisp_Object tail, elt; + + for (tail = XCDR (cache); CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + if (CONSP (elt) && FONT_SPEC_P (XCAR (elt))) + { + Lisp_Object vec = XCDR (elt); + int i; + + for (i = 0; i < ASIZE (vec); i++) + { + Lisp_Object entity = AREF (vec, i); + Lisp_Object objlist = AREF (entity, FONT_OBJLIST_INDEX); + + for (; CONSP (objlist); objlist = XCDR (objlist)) + { + Lisp_Object val = XCAR (objlist); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + struct font *font = p->pointer; + + xassert (font + && driver_list->driver == font->driver); + driver_list->driver->close (f, font); + p->pointer = NULL; + p->integer = 0; + } + if (driver_list->driver->free_entity) + driver_list->driver->free_entity (entity); + } + } + } + XSETCDR (cache, Qnil); + } + } + + return Qnil; +} + +DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table, + Sinternal_set_font_style_table, 2, 2, 0, + doc: /* Set font style table for PROP to TABLE. +PROP must be `:weight', `:slant', or `:width'. +TABLE must be an alist of symbols vs the corresponding numeric values +sorted by numeric values. */) + (prop, table) + Lisp_Object prop, table; +{ + int table_index; + int numeric; + Lisp_Object tail, val; + + CHECK_SYMBOL (prop); + table_index = (EQ (prop, QCweight) ? 0 + : EQ (prop, QCslant) ? 1 + : EQ (prop, QCwidth) ? 2 + : 3); + if (table_index >= ASIZE (font_style_table)) + error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop))); + table = Fcopy_sequence (table); + numeric = -1; + for (tail = table; ! NILP (tail); tail = Fcdr (tail)) + { + prop = Fcar (Fcar (tail)); + val = Fcdr (Fcar (tail)); + CHECK_SYMBOL (prop); + CHECK_NATNUM (val); + if (numeric > XINT (val)) + error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop))); + numeric = XINT (val); + XSETCAR (tail, Fcons (prop, val)); + } + ASET (font_style_table, table_index, table); + return Qnil; +} + +DEFUN ("font-make-gstring", Ffont_make_gstring, Sfont_make_gstring, 2, 2, 0, + doc: /* Return a newly created glyph-string for FONT-OBJECT with NUM glyphs. +FONT-OBJECT may be nil if it is not yet known. */) + (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 (8), make_number (0))); + return gstring; +} + +DEFUN ("font-fill-gstring", Ffont_fill_gstring, Sfont_fill_gstring, 4, 5, 0, + doc: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT. +START and END specifies the region to extract characters. +If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from +where to extract characters. +FONT-OBJECT may be nil if GSTRING already already contains one. */) + (gstring, font_object, start, end, object) + Lisp_Object gstring, font_object, start, end, object; +{ + int len, i, c; + unsigned code; + struct font *font; + + CHECK_VECTOR (gstring); + if (NILP (font_object)) + font_object = Faref (Faref (gstring, make_number (0)), make_number (0)); + CHECK_FONT_GET_OBJECT (font_object, font); + + if (STRINGP (object)) + { + const unsigned char *p; + + CHECK_NATNUM (start); + CHECK_NATNUM (end); + if (XINT (start) > XINT (end) + || XINT (end) > ASIZE (object) + || XINT (end) - XINT (start) >= XINT (Flength (gstring))) + args_out_of_range (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); + + c = STRING_CHAR_ADVANCE (p); + code = font->driver->encode_char (font, c); + if (code > MOST_POSITIVE_FIXNUM) + error ("Glyph code 0x%X is too large", code); + ASET (g, 0, make_number (i)); + ASET (g, 1, make_number (i + 1)); + LGLYPH_SET_CHAR (g, make_number (c)); + LGLYPH_SET_CODE (g, make_number (code)); + } + } + else + { + int pos, pos_byte; + + if (! NILP (object)) + Fset_buffer (object); + validate_region (&start, &end); + if (XINT (end) - XINT (start) > len) + 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); + + FETCH_CHAR_ADVANCE (c, pos, pos_byte); + code = font->driver->encode_char (font, c); + if (code > MOST_POSITIVE_FIXNUM) + error ("Glyph code 0x%X is too large", code); + ASET (g, 0, make_number (i)); + ASET (g, 1, make_number (i + 1)); + LGLYPH_SET_CHAR (g, make_number (c)); + LGLYPH_SET_CODE (g, make_number (code)); + } + } + return Qnil; +} + + +#ifdef FONT_DEBUG + +DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, + doc: /* Open FONT-ENTITY. */) + (font_entity, size, frame) + Lisp_Object font_entity; + Lisp_Object size; + Lisp_Object frame; +{ + int isize; + + CHECK_FONT_ENTITY (font_entity); + if (NILP (size)) + size = AREF (font_entity, FONT_SIZE_INDEX); + CHECK_NUMBER (size); + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + + isize = XINT (size); + if (isize < 0) + isize = POINT_TO_PIXEL (- isize, XFRAME (frame)->resy); + + return font_open_entity (XFRAME (frame), font_entity, isize); +} + +DEFUN ("close-font", Fclose_font, Sclose_font, 1, 2, 0, + doc: /* Close FONT-OBJECT. */) + (font_object, frame) + Lisp_Object font_object, frame; +{ + CHECK_FONT_OBJECT (font_object); + if (NILP (frame)) + frame = selected_frame; + CHECK_LIVE_FRAME (frame); + font_close_object (XFRAME (frame), font_object); + return Qnil; +} + +DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0, + doc: /* Return information about FONT-OBJECT. */) + (font_object) + Lisp_Object font_object; +{ + struct font *font; + Lisp_Object val; + + CHECK_FONT_GET_OBJECT (font_object, font); + + val = Fmake_vector (make_number (9), Qnil); + ASET (val, 0, Ffont_xlfd_name (font_object)); + if (font->file_name) + ASET (val, 1, make_unibyte_string (font->file_name, + strlen (font->file_name))); + ASET (val, 2, make_number (font->pixel_size)); + ASET (val, 3, make_number (font->font.size)); + ASET (val, 4, make_number (font->ascent)); + ASET (val, 5, make_number (font->descent)); + ASET (val, 6, make_number (font->font.space_width)); + ASET (val, 7, make_number (font->font.average_width)); + if (font->driver->otf_capability) + ASET (val, 8, font->driver->otf_capability (font)); + return val; +} + +DEFUN ("get-font-glyphs", Fget_font_glyphs, Sget_font_glyphs, 2, 2, 0, + doc: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING. +Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */) + (font_object, string) + Lisp_Object font_object, string; +{ + struct font *font; + int i, len; + Lisp_Object vec; + + CHECK_FONT_GET_OBJECT (font_object, font); + CHECK_STRING (string); + len = SCHARS (string); + vec = Fmake_vector (make_number (len), Qnil); + for (i = 0; i < len; i++) + { + Lisp_Object ch = Faref (string, make_number (i)); + Lisp_Object val; + int c = XINT (ch); + unsigned code; + struct font_metrics metrics; + + code = font->driver->encode_char (font, c); + if (code == FONT_INVALID_CODE) + continue; + val = Fmake_vector (make_number (6), Qnil); + if (code <= MOST_POSITIVE_FIXNUM) + ASET (val, 0, make_number (code)); + else + ASET (val, 0, Fcons (make_number (code >> 16), + make_number (code & 0xFFFF))); + font->driver->text_extents (font, &code, 1, &metrics); + ASET (val, 1, make_number (metrics.lbearing)); + ASET (val, 2, make_number (metrics.rbearing)); + ASET (val, 3, make_number (metrics.width)); + ASET (val, 4, make_number (metrics.ascent)); + ASET (val, 5, make_number (metrics.descent)); + ASET (vec, i, val); + } + return vec; +} + +#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. */) + (font_object, string) + Lisp_Object font_object, string; +{ + Lisp_Object frame = selected_frame; + FRAME_PTR 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_number (i)); + Lisp_Object val; + int c = XINT (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_number (len); +} +#endif + +#endif /* FONT_DEBUG */ + + +extern void syms_of_ftfont P_ (()); +extern void syms_of_xfont P_ (()); +extern void syms_of_xftfont P_ (()); +extern void syms_of_ftxfont P_ (()); +extern void syms_of_bdffont P_ (()); +extern void syms_of_w32font P_ (()); +extern void syms_of_atmfont P_ (()); + +void +syms_of_font () +{ + sort_shift_bits[FONT_SLANT_INDEX] = 0; + sort_shift_bits[FONT_WEIGHT_INDEX] = 7; + sort_shift_bits[FONT_SIZE_INDEX] = 14; + sort_shift_bits[FONT_WIDTH_INDEX] = 21; + sort_shift_bits[FONT_ADSTYLE_INDEX] = 28; + sort_shift_bits[FONT_FOUNDRY_INDEX] = 29; + sort_shift_bits[FONT_FAMILY_INDEX] = 30; + sort_shift_bits[FONT_REGISTRY_INDEX] = 31; + /* Note that sort_shift_bits[FONT_SLANT_TYPE] is never used. */ + + staticpro (&font_style_table); + font_style_table = Fmake_vector (make_number (3), Qnil); + + staticpro (&font_family_alist); + font_family_alist = Qnil; + + DEFSYM (Qfontp, "fontp"); + + DEFSYM (QCotf, ":otf"); + DEFSYM (QClanguage, ":language"); + DEFSYM (QCscript, ":script"); + + DEFSYM (QCfoundry, ":foundry"); + DEFSYM (QCadstyle, ":adstyle"); + DEFSYM (QCregistry, ":registry"); + DEFSYM (QCextra, ":extra"); + + staticpro (&null_string); + null_string = build_string (""); + staticpro (&null_vector); + null_vector = Fmake_vector (make_number (0), Qnil); + + staticpro (&scratch_font_spec); + scratch_font_spec = Ffont_spec (0, NULL); + staticpro (&scratch_font_prefer); + scratch_font_prefer = Ffont_spec (0, NULL); + + defsubr (&Sfontp); + defsubr (&Sfont_spec); + defsubr (&Sfont_get); + defsubr (&Sfont_put); + defsubr (&Slist_fonts); + defsubr (&Slist_families); + defsubr (&Sfind_font); + defsubr (&Sfont_xlfd_name); + defsubr (&Sclear_font_cache); + defsubr (&Sinternal_set_font_style_table); + defsubr (&Sfont_make_gstring); + defsubr (&Sfont_fill_gstring); + +#ifdef FONT_DEBUG + defsubr (&Sopen_font); + defsubr (&Sclose_font); + defsubr (&Squery_font); + defsubr (&Sget_font_glyphs); +#if 0 + defsubr (&Sdraw_string); +#endif +#endif /* FONT_DEBUG */ + +#ifdef HAVE_FREETYPE + syms_of_ftfont (); +#ifdef HAVE_X_WINDOWS + syms_of_xfont (); + syms_of_ftxfont (); +#ifdef HAVE_XFT + syms_of_xftfont (); +#endif /* HAVE_XFT */ +#endif /* 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 WINDOWSNT + syms_of_w32font (); +#endif /* WINDOWSNT */ +#ifdef MAC_OS + syms_of_atmfont (); +#endif /* MAC_OS */ +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/font.h Tue Jun 06 03:47:13 2006 +0000 @@ -0,0 +1,479 @@ +/* font.h -- Interface definition for font handling. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + 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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#ifndef EMACS_FONT_H +#define EMACS_FONT_H + +#include "ccl.h" + +/* We have three types of Lisp objects related to font. + + FONT-SPEC + + Vector (length FONT_SPEC_MAX) of font properties. Some + properties can be left unspecified (i.e. nil). Emacs asks + font-drivers to find a font by FONT-SPEC. A fontset entry + specifies requisite properties whereas a face specifies just + preferable properties. This object is fully modifiable by + Lisp. + + FONT-ENTITY + + Vector (length FONT_ENTITY_MAX) of fully specified font + properties that a font-driver returns upon a request of + FONT-SPEC. + + Note: Only the method `list' of a font-driver can create this + object, and should never be modified by Lisp. In that sense, + it may be cleaner to implement it as a Lisp object of a new + type (e.g. struct Lisp_Font). + + FONT-OBJECT + + Lisp object of type Lisp_Misc_Save_Value encapsulating a + pointer to "struct font". This corresponds to an opened font. + + Note: The note for FONT-ENTITY also applies to this. +*/ + + +struct font_driver; +struct font; + +/* An enumerator for each font property. This is used as an index to + the vector of FONT-SPEC and FONT-ENTITY. + + Note: The order is important and should not be changed. */ + +enum font_property_index + { + /* FONT-TYPE is a symbol indicating a font backend; currently `x', + `xft', `ftx', `freetype' are available. For windows, we need + `bdf' and `windows'. For Mac OS X, we need `atm'. */ + FONT_TYPE_INDEX, + + /* FONT-FOUNDRY is a foundry name (symbol). */ + FONT_FOUNDRY_INDEX, + + /* FONT-FAMILY is a family name (symbol). */ + FONT_FAMILY_INDEX, + + /* FONT-ADSTYLE is an additional style name (symbol). */ + FONT_ADSTYLE_INDEX, + + /* FONT-REGISTRY is a combination of a charset-registry and + charset0encoding name (symbol). */ + FONT_REGISTRY_INDEX, + + /* FONT-WEIGHT is a numeric value of weight (e.g. medium, bold) of + the font. The value is what defined by FC_WEIGHT_* in + fontconfig. */ + FONT_WEIGHT_INDEX, + + /* FONT-SLANT is a numeric value of slant (e.g. r, i, o) of the + font. The value is what defined by FC_SLANT_* in + fontconfig plus 100. */ + FONT_SLANT_INDEX, + + /* FONT-WIDTH is a numeric value of setwidth (e.g. normal, + condensed) of the font. The value is what defined by + FC_WIDTH_* in fontconfig. */ + FONT_WIDTH_INDEX, + + /* FONT-SIZE is a size of the font. If integer, it is a pixel + size. For a font-spec, the value can be float specifying a + point size. For a font-entity, the value can be zero meaning + that the font is scalable. */ + FONT_SIZE_INDEX, + + /* In a font-spec, the value is an alist of extra information of a + font such as name, OpenType features, and language coverage. + In a font-entity, the value is an extra infomation for + identifying a font (font-driver dependent). */ + FONT_EXTRA_INDEX, /* alist alist */ + + /* This value is the length of font-spec vector. */ + FONT_SPEC_MAX, + + /* The followings are used only for a font-entity. */ + + /* Frame on which the font is found. The value is nil if the font + can be opend on any frame. */ + FONT_FRAME_INDEX = FONT_SPEC_MAX, + + /* List of font-objects opened from the font-entity. */ + FONT_OBJLIST_INDEX, + + /* This value is the length of font-entity vector. */ + FONT_ENTITY_MAX + }; + +extern Lisp_Object QCotf, QClanguage, QCscript; + +extern Lisp_Object null_string; +extern Lisp_Object null_vector; + +/* Structure for an opened font. We can safely cast this structure to + "struft font_info". */ + +struct font +{ + struct font_info font; + + /* From which font-entity the font is opened. */ + Lisp_Object entity; + + /* By which pixel size the font is opened. */ + int pixel_size; + + /* Font-driver for the font. */ + struct font_driver *driver; + + /* File name of the font, or NULL if the font is not associated with + a file. */ + char *file_name; + + /* Charset to encode a character code into a glyph code of the + font. */ + int encoding_charset; + + /* Charset to check if a character code is supported by the font. + -1 means that the contents of the font must be looked up to + determine it. + */ + int repertory_charet; + + /* Minimum glyph width (in pixels). */ + int min_width; + + /* Ascent and descent of the font (in pixels). */ + int ascent, descent; + + /* There will be more to this structure, but they are private to a + font-driver. */ +}; + +struct font_metrics +{ + short lbearing, rbearing, width, ascent, descent; +}; + +struct font_bitmap +{ + int rows; + int width; + int pitch; + unsigned char *buffer; + int left; + int top; + int advance; + void *extra; +}; + +/* Predicates to check various font-related objects. */ + +#define FONTP(x) \ + (VECTORP (x) && (ASIZE (x) == FONT_SPEC_MAX || ASIZE (x) == FONT_ENTITY_MAX)) +#define FONT_SPEC_P(x) \ + (VECTORP (x) && ASIZE (x) == FONT_SPEC_MAX) +#define FONT_ENTITY_P(x) \ + (VECTORP (x) && ASIZE (x) == FONT_ENTITY_MAX) +#define FONT_OBJECT_P(x) \ + (XTYPE (x) == Lisp_Misc && XMISCTYPE (x) == Lisp_Misc_Save_Value) + + +/* Check macros for various font-related objects. */ + +#define CHECK_FONT(x) \ + do { if (! FONTP (x)) x = wrong_type_argument (Qfont, x); } while (0) +#define CHECK_FONT_SPEC(x) \ + do { if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); } while (0) +#define CHECK_FONT_ENTITY(x) \ + do { if (! FONT_ENTITY_P (x)) x = wrong_type_argument (Qfont, x); } while (0) +#define CHECK_FONT_OBJECT(x) \ + do { if (! FONT_OBJECT_P (x)) x = wrong_type_argument (Qfont, x); } while (0) + +#define CHECK_FONT_GET_OBJECT(x, font) \ + do { \ + if (! FONT_OBJECT_P (x)) x = wrong_type_argument (Qfont, x); \ + if (! XSAVE_VALUE (x)->pointer) error ("Font already closed"); \ + font = XSAVE_VALUE (x)->pointer; \ + } while (0) + +struct face; +struct composition; + +/* Macros for lispy glyph-string. */ +#define LGSTRING_FONT(lgs) AREF (AREF ((lgs), 0), 0) +#define LGSTRING_LBEARING(lgs) AREF (AREF ((lgs), 0), 1) +#define LGSTRING_RBEARING(lgs) AREF (AREF ((lgs), 0), 2) +#define LGSTRING_WIDTH(lgs) AREF (AREF ((lgs), 0), 3) +#define LGSTRING_ASCENT(lgs) AREF (AREF ((lgs), 0), 4) +#define LGSTRING_DESCENT(lgs) AREF (AREF ((lgs), 0), 5) +#define LGSTRING_SET_FONT(lgs, val) ASET (AREF ((lgs), 0), 0, (val)) +#define LGSTRING_SET_LBEARING(lgs, val) ASET (AREF ((lgs), 0), 1, (val)) +#define LGSTRING_SET_RBEARING(lgs, val) ASET (AREF ((lgs), 0), 2, (val)) +#define LGSTRING_SET_WIDTH(lgs, val) ASET (AREF ((lgs), 0), 3, (val)) +#define LGSTRING_SET_ASCENT(lgs, val) ASET (AREF ((lgs), 0), 4, (val)) +#define LGSTRING_SET_DESCENT(lgs, val) ASET (AREF ((lgs), 0), 5, (val)) + +#define LGSTRING_LENGTH(lgs) (ASIZE ((lgs)) - 1) +#define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 1) + +#define LGLYPH_CHAR(g) AREF ((g), 2) +#define LGLYPH_CODE(g) AREF ((g), 3) +#define LGLYPH_XOFF(g) AREF ((g), 4) +#define LGLYPH_YOFF(g) AREF ((g), 5) +#define LGLYPH_WIDTH(g) AREF ((g), 6) +#define LGLYPH_WADJUST(g) AREF ((g), 7) +#define LGLYPH_SET_CHAR(g, val) ASET ((g), 2, (val)) +#define LGLYPH_SET_CODE(g, val) ASET ((g), 3, (val)) +#define LGLYPH_SET_XOFF(g, val) ASET ((g), 4, (val)) +#define LGLYPH_SET_YOFF(g, val) ASET ((g), 5, (val)) +#define LGLYPH_SET_WIDTH(g, val) ASET ((g), 6, (val)) +#define LGLYPH_SET_WADJUST(g, val) ASET ((g), 7, (val)) + +#define FONT_INVALID_CODE 0xFFFFFFFF + +struct font_driver +{ + /* Symbol indicating the type of the font-driver. */ + Lisp_Object type; + + /* Return a cache of font-entities on FRAME. The cache must be a + cons whose cdr part is the actual cache area. */ + Lisp_Object (*get_cache) P_ ((Lisp_Object frame)); + + /* Parse font name NAME, store the font properties in SPEC, and + return 0. If the font-driver can't parse NAME, return -1. */ + int (*parse_name) P_ ((FRAME_PTR f, char *name, Lisp_Object spec)); + + /* List fonts matching with FONT_SPEC on FRAME. The value is a + vector of font-entities. This is the sole API that allocates + font-entities. */ + Lisp_Object (*list) P_ ((Lisp_Object frame, Lisp_Object font_spec)); + + /* List available families. The value is a list of family names + (symbols). The method can be NULL if the driver doesn't support + this facility. */ + Lisp_Object (*list_family) P_ ((Lisp_Object frame)); + + /* Free FONT_EXTRA_INDEX field of FONT_ENTITY. This method can be + NULL if FONT_EXTRA_INDEX of FONT_ENTITY is a normal Lisp object + (i.e. not Lisp_Save_Value). */ + void (*free_entity) P_ ((Lisp_Object font_entity)); + + /* Open a font specified by FONT_ENTITY on frame F. If the font is + scalable, open it with PIXEL_SIZE. */ + struct font *(*open) P_ ((FRAME_PTR f, Lisp_Object font_entity, + int pixel_size)); + + /* Close FONT on frame F. */ + void (*close) P_ ((FRAME_PTR f, struct font *font)); + + /* Prepare FACE for displaying characters by FONT on frame F. If + successful, return 0. Otherwise, return -1. This method can be + NULL if there's nothing to do. */ + int (*prepare_face) P_ ((FRAME_PTR f, struct face *face)); + + /* Done FACE for displaying characters by FACE->font on frame F. + This method can be NULL if there's nothing to do. */ + void (*done_face) P_ ((FRAME_PTR f, struct face *face)); + + /* If FONT_ENTITY has a glyph for character C, return 1. If not, + return 0. If a font must be opened to check it, return -1. This + method can be NULL if the driver always requires a font to be + opened for this check. In that case, we must open a font and use + `encode_char' method. */ + int (*has_char) P_ ((Lisp_Object entity, int c)); + + /* Return a glyph code of FONT for characer C. If FONT doesn't have + such a glyph, return FONT_INVALID_CODE. */ + unsigned (*encode_char) P_ ((struct font *font, int c)); + + /* Perform the size computation of glyphs of FONT and fillin members + of METRICS. The glyphs are specified by their glyph codes in + CODE (length NGLYPHS). */ + int (*text_extents) P_ ((struct font *font, + unsigned *code, int nglyphs, + struct font_metrics *metrics)); + + /* Draw glyphs between FROM and TO of S->char2b at (X Y) pixel + position of frame F with S->FACE and S->GC. If WITH_BACKGROUND + is nonzero, fill the background in advance. It is assured that + WITH_BACKGROUND is zero when (FROM > 0 || TO < S->nchars). */ + int (*draw) P_ ((struct glyph_string *s, int from, int to, + int x, int y, int with_background)); + + /* Store bitmap data for glyph-code CODE of FONT in BITMAP. This + method can be NULL if the driver doesn't support this facility. + It is intended that this method is callled from the other + font-driver for actual drawing. */ + int (*get_bitmap) P_ ((struct font *font, unsigned code, + struct font_bitmap *bitmap, + int bits_per_pixel)); + + /* Free bitmap data in BITMAP. This method can be NULL if no data + have to be freed. */ + void (*free_bitmap) P_ ((struct font *font, struct font_bitmap *bitmap)); + + /* Return an outline data for glyph-code CODE of FONT. The format + of the outline data depends on the font-driver. This method can + be NULL if the driver doesn't support this facility. */ + void *(*get_outline) P_ ((struct font *font, unsigned code)); + + /* Free OUTLINE (that is obtained by the above method). */ + void (*free_outline) P_ ((struct font *font, void *outline)); + + /* Get coordinates of the INDEXth anchor point of the glyph whose + code is CODE. Store the coordinates in *X and *Y. Return 0 if + the operations was successfull. Otherwise return -1. This + method can be NULL if the driver doesn't support this + facility. */ + int (*anchor_point) P_ ((struct font *font, unsigned code, int index, + int *x, int *y)); + + /* Return a list describing which scripts/languages FONT + supports by which GSUB/GPOS features of OpenType tables. */ + Lisp_Object (*otf_capability) P_ ((struct font *font)); + + /* Drive FONT's OTF GSUB features according to GSUB_SPEC. + + GSUB_SPEC is in this format (all elements are symbols): + (SCRIPT LANGSYS GSUB-FEATURE ...) + If one of GSUB-FEATURE is nil, apply all gsub features except for + already applied and listed later. For instance, if the font has + GSUB features nukt, haln, rphf, blwf, and half, + (deva nil nukt haln nil rphf) + applies nukt and haln in this order, then applies blwf and half + in the order apearing in the font. The features are of the + default langsys of `deva' script. + + This method applies the specified features to the codes in the + elements of GSTRING-IN (between FROMth and TOth). The output + codes are stored in GSTRING-OUT at the IDXth element and the + following elements. + + Return the number of output codes. If none of the features are + applicable to the input data, return 0. If GSTRING-OUT is too + short, return -1. */ + int (*otf_gsub) P_ ((struct font *font, Lisp_Object gsub_spec, + Lisp_Object gstring_in, int from, int to, + Lisp_Object gstring_out, int idx)); + + /* Drive FONT's OTF GPOS features according to GPOS_SPEC. + + GPOS_SPEC is in this format (all elements are symbols): + (SCRIPT LANGSYS GPOS-FEATURE ...) + The meaning is the same as GSUB_SPEC above. + + This method applies the specified features to the codes in the + elements of GSTRING (between FROMth and TOth). The resulting + positioning information (x-offset and y-offset) is stored in the + slots of the elements. + + Return 1 if at least one glyph has nonzero x-offset or y-offset. + Otherwise return 0. */ + int (*otf_gpos) P_ ((struct font *font, Lisp_Object gpos_spec, + Lisp_Object gstring, int from, int to)); +}; + + +struct font_driver_list +{ + struct font_driver *driver; + struct font_driver_list *next; +}; + +extern int enable_font_backend; + +EXFUN (Ffont_spec, MANY); + +extern Lisp_Object font_symbolic_weight P_ ((Lisp_Object font)); +extern Lisp_Object font_symbolic_slant P_ ((Lisp_Object font)); +extern Lisp_Object font_symbolic_width P_ ((Lisp_Object font)); + +extern Lisp_Object font_find_object P_ ((struct font *font)); +extern char *font_get_name P_ ((Lisp_Object)); +extern Lisp_Object font_get_frame P_ ((Lisp_Object font)); +extern int font_has_char P_ ((FRAME_PTR, Lisp_Object, int)); +extern unsigned font_encode_char P_ ((Lisp_Object, int)); + +extern int font_set_lface_from_name P_ ((FRAME_PTR f, + Lisp_Object lface, + Lisp_Object fontname, + int force_p, int may_fail_p)); +extern Lisp_Object font_find_for_lface P_ ((FRAME_PTR f, Lisp_Object *lface, + Lisp_Object spec)); +extern Lisp_Object font_open_for_lface P_ ((FRAME_PTR f, Lisp_Object *lface, + Lisp_Object entity)); +extern void font_load_for_face P_ ((FRAME_PTR f, struct face *face)); +extern void font_prepare_for_face P_ ((FRAME_PTR f, struct face *face)); +extern Lisp_Object font_open_by_name P_ ((FRAME_PTR f, char *name)); + +extern Lisp_Object intern_downcase P_ ((char *str, int len)); +extern void font_update_sort_order P_ ((int *order)); + +extern void font_parse_old_font_spec P_ ((Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object)); + + +extern int font_parse_xlfd P_ ((char *name, Lisp_Object font, int merge)); +extern int font_unparse_xlfd P_ ((Lisp_Object font, int pixel_size, + char *name, int bytes)); +extern void register_font_driver P_ ((struct font_driver *driver, FRAME_PTR f)); +extern void free_font_driver_list P_ ((FRAME_PTR f)); + +extern struct font *font_prepare_composition P_ ((struct composition *cmp)); + + +#ifdef HAVE_LIBOTF +/* This can be used as `otf_capability' method of a font-driver. */ +extern Lisp_Object font_otf_capability P_ ((struct font *font)); +/* This can be used as `otf_gsub' method of a font-driver. */ +extern int font_otf_gsub P_ ((struct font *font, Lisp_Object gsub_spec, + Lisp_Object gstring_in, int from, int to, + Lisp_Object gstring_out, int idx)); +/* This can be used as `otf_gpos' method of a font-driver. */ +extern int font_otf_gpos P_ ((struct font *font, Lisp_Object gpos_spec, + Lisp_Object gstring, int from, int to)); +#endif /* HAVE_LIBOTF */ + +#ifdef HAVE_FREETYPE +extern struct font_driver ftfont_driver; +#endif /* HAVE_FREETYPE */ +#ifdef HAVE_X_WINDOWS +extern struct font_driver xfont_driver; +extern struct font_driver ftxfont_driver; +#ifdef HAVE_XFT +extern struct font_driver xftfont_driver; +#endif /* HAVE_XFT */ +#endif /* HAVE_X_WINDOWS */ +#ifdef WINDOWSNT +extern struct font_driver w32font_driver; +#endif /* WINDOWSNT */ +#ifdef MAC_OS +extern struct font_driver atmfont_driver; +#endif /* MAC_OS */ + +#endif /* not EMACS_FONT_H */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/ftfont.c Tue Jun 06 03:47:13 2006 +0000 @@ -0,0 +1,731 @@ +/* ftfont.c -- FreeType font driver. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + 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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> + +#include <ft2build.h> +#include FT_FREETYPE_H +#include FT_SIZES_H +#include <fontconfig/fontconfig.h> +#include <fontconfig/fcfreetype.h> + +#include "lisp.h" +#include "dispextern.h" +#include "frame.h" +#include "blockinput.h" +#include "character.h" +#include "charset.h" +#include "coding.h" +#include "fontset.h" +#include "font.h" + +Lisp_Object Qfreetype; + +static int fc_initialized; +static FT_Library ft_library; + +static Lisp_Object freetype_font_cache; + +static Lisp_Object Qiso8859_1, Qiso10646_1, Qunicode_bmp; + +static FcCharSet *cs_iso8859_1; + +/* The actual structure for FreeType font that can be casted to struct + font. */ + +struct ftfont_info +{ + struct font font; + FT_Size ft_size; +}; + +static int +ftfont_build_basic_charsets () +{ + FcChar32 c; + + cs_iso8859_1 = FcCharSetCreate (); + if (! cs_iso8859_1) + return -1; + for (c = ' '; c < 127; c++) + if (! FcCharSetAddChar (cs_iso8859_1, c)) + return -1; + for (c = 192; c < 256; c++) + if (! FcCharSetAddChar (cs_iso8859_1, c)) + return -1; + return 0; +} + +static Lisp_Object ftfont_get_cache P_ ((Lisp_Object)); +static int ftfont_parse_name P_ ((FRAME_PTR, char *, Lisp_Object)); +static Lisp_Object ftfont_list P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object ftfont_list_family P_ ((Lisp_Object)); +static void ftfont_free_entity P_ ((Lisp_Object)); +static struct font *ftfont_open P_ ((FRAME_PTR, Lisp_Object, int)); +static void ftfont_close P_ ((FRAME_PTR, struct font *)); +static int ftfont_has_char P_ ((Lisp_Object, int)); +static unsigned ftfont_encode_char P_ ((struct font *, int)); +static int ftfont_text_extents P_ ((struct font *, unsigned *, int, + struct font_metrics *)); +static int ftfont_get_bitmap P_ ((struct font *, unsigned, + struct font_bitmap *, int)); +static int ftfont_anchor_point P_ ((struct font *, unsigned, int, + int *, int *)); + +struct font_driver ftfont_driver = + { + (Lisp_Object) NULL, /* Qfreetype */ + ftfont_get_cache, + ftfont_parse_name, + ftfont_list, + ftfont_list_family, + ftfont_free_entity, + ftfont_open, + ftfont_close, + /* We can't draw a text without device dependent functions. */ + NULL, + NULL, + ftfont_has_char, + ftfont_encode_char, + ftfont_text_extents, + /* We can't draw a text without device dependent functions. */ + NULL, + ftfont_get_bitmap, + NULL, + NULL, + NULL, + ftfont_anchor_point, +#ifdef HAVE_LIBOTF + font_otf_capability, + font_otf_gsub, + font_otf_gpos +#else + NULL, + NULL, + NULL +#endif /* HAVE_LIBOTF */ + }; + +#define SYMBOL_FcChar8(SYM) (FcChar8 *) SDATA (SYMBOL_NAME (SYM)) + +extern Lisp_Object QCname; + +static Lisp_Object +ftfont_get_cache (frame) + Lisp_Object frame; +{ + if (NILP (freetype_font_cache)) + freetype_font_cache = Fcons (Qt, Qnil); + return freetype_font_cache; +} + +static int +ftfont_parse_name (f, name, spec) + FRAME_PTR f; + char *name; + Lisp_Object spec; +{ + FcPattern *p; + FcChar8 *str; + int numeric; + double dbl; + + if (name[0] == '-' || strchr (name, '*')) + /* It seems that NAME is XLFD. */ + return -1; + p = FcNameParse ((FcChar8 *) name); + if (! p) + return -1; + if (FcPatternGetString (p, FC_FOUNDRY, 0, &str) == FcResultMatch) + ASET (spec, FONT_FOUNDRY_INDEX, + intern_downcase ((char *) str, strlen ((char *) str))); + if (FcPatternGetString (p, FC_FAMILY, 0, &str) == FcResultMatch) + ASET (spec, FONT_FAMILY_INDEX, + intern_downcase ((char *) str, strlen ((char *) str))); + if (FcPatternGetInteger (p, FC_WEIGHT, 0, &numeric) == FcResultMatch) + ASET (spec, FONT_WEIGHT_INDEX, make_number (numeric)); + if (FcPatternGetInteger (p, FC_SLANT, 0, &numeric) == FcResultMatch) + ASET (spec, FONT_SLANT_INDEX, make_number (numeric + 100)); + if (FcPatternGetInteger (p, FC_WIDTH, 0, &numeric) == FcResultMatch) + ASET (spec, FONT_WIDTH_INDEX, make_number (numeric)); + if (FcPatternGetDouble (p, FC_PIXEL_SIZE, 0, &dbl) == FcResultMatch) + ASET (spec, FONT_SIZE_INDEX, make_number (dbl)); + else if (FcPatternGetDouble (p, FC_SIZE, 0, &dbl) == FcResultMatch) + ASET (spec, FONT_SIZE_INDEX, make_float (dbl)); + return 0; +} + +static Lisp_Object +ftfont_list (frame, spec) + Lisp_Object frame, spec; +{ + Lisp_Object val, tmp, extra, font_name; + int i; + FcPattern *pattern = NULL; + FcCharSet *charset = NULL; + FcLangSet *langset = NULL; + FcFontSet *fontset = NULL; + FcObjectSet *objset = NULL; + Lisp_Object registry = Qnil; + + val = null_vector; + + if (! fc_initialized) + { + FcInit (); + fc_initialized = 1; + } + + if (! NILP (AREF (spec, FONT_ADSTYLE_INDEX))) + return val; + if (! NILP (AREF (spec, FONT_REGISTRY_INDEX))) + { + registry = AREF (spec, FONT_REGISTRY_INDEX); + if (EQ (registry, Qiso8859_1)) + { + if (! cs_iso8859_1 + && ftfont_build_basic_charsets () < 0) + goto err; + charset = cs_iso8859_1; + registry = Qnil; + } + } + + extra = AREF (spec, FONT_EXTRA_INDEX); + font_name = Qnil; + if (CONSP (extra)) + { + tmp = Fassq (QCotf, extra); + if (! NILP (tmp)) + return val; + tmp = Fassq (QClanguage, extra); + if (CONSP (tmp)) + { + langset = FcLangSetCreate (); + if (! langset) + goto err; + tmp = XCDR (tmp); + if (SYMBOLP (tmp)) + { + if (! FcLangSetAdd (langset, SYMBOL_FcChar8 (tmp))) + goto err; + } + else + while (CONSP (tmp)) + { + if (SYMBOLP (XCAR (tmp)) + && ! FcLangSetAdd (langset, SYMBOL_FcChar8 (XCAR (tmp)))) + goto err; + tmp = XCDR (tmp); + } + } + tmp = Fassq (QCname, extra); + if (CONSP (tmp)) + font_name = XCDR (tmp); + tmp = Fassq (QCscript, extra); + if (CONSP (tmp) && ! charset) + { + Lisp_Object script = XCDR (tmp); + Lisp_Object chars = assq_no_quit (script, + Vscript_representative_chars); + + if (CONSP (chars)) + { + charset = FcCharSetCreate (); + if (! charset) + goto err; + for (chars = XCDR (chars); CONSP (chars); chars = XCDR (chars)) + if (CHARACTERP (XCAR (chars)) + && ! FcCharSetAddChar (charset, XUINT (XCAR (chars)))) + goto err; + } + } + } + + if (! NILP (registry) && ! charset) + goto finish; + + if (STRINGP (font_name)) + { + if (! isalpha (SDATA (font_name)[0])) + goto finish; + pattern = FcNameParse (SDATA (font_name)); + if (! pattern) + goto err; + } + else + { + pattern = FcPatternCreate (); + if (! pattern) + goto err; + + tmp = AREF (spec, FONT_FOUNDRY_INDEX); + if (SYMBOLP (tmp) && ! NILP (tmp) + && ! FcPatternAddString (pattern, FC_FOUNDRY, SYMBOL_FcChar8 (tmp))) + goto err; + tmp = AREF (spec, FONT_FAMILY_INDEX); + if (SYMBOLP (tmp) && ! NILP (tmp) + && ! FcPatternAddString (pattern, FC_FAMILY, SYMBOL_FcChar8 (tmp))) + goto err; + tmp = AREF (spec, FONT_WEIGHT_INDEX); + if (INTEGERP (tmp) + && ! FcPatternAddInteger (pattern, FC_WEIGHT, XINT (tmp))) + goto err; + tmp = AREF (spec, FONT_SLANT_INDEX); + if (INTEGERP (tmp) + && XINT (tmp) >= 100 + && ! FcPatternAddInteger (pattern, FC_SLANT, XINT (tmp) - 100)) + goto err; + tmp = AREF (spec, FONT_WIDTH_INDEX); + if (INTEGERP (tmp) + && ! FcPatternAddInteger (pattern, FC_WIDTH, XINT (tmp))) + goto err; + if (! FcPatternAddBool (pattern, FC_SCALABLE, FcTrue)) + goto err; + } + + if (charset + && ! FcPatternAddCharSet (pattern, FC_CHARSET, charset)) + goto err; + if (langset + && ! FcPatternAddLangSet (pattern, FC_LANG, langset)) + goto err; + objset = FcObjectSetBuild (FC_FOUNDRY, FC_FAMILY, FC_WEIGHT, FC_SLANT, + FC_WIDTH, FC_PIXEL_SIZE, FC_SPACING, + FC_CHARSET, FC_FILE, NULL); + if (! objset) + goto err; + + BLOCK_INPUT; + fontset = FcFontList (NULL, pattern, objset); + UNBLOCK_INPUT; + if (! fontset) + goto err; + val = Qnil; + for (i = 0; i < fontset->nfont; i++) + { + FcPattern *p = fontset->fonts[i]; + FcChar8 *str, *file; + + if (FcPatternGetString (p, FC_FILE, 0, &file) == FcResultMatch + && FcPatternGetCharSet (p, FC_CHARSET, 0, &charset) == FcResultMatch) + { + Lisp_Object entity = Fmake_vector (make_number (FONT_ENTITY_MAX), + null_string); + int numeric; + double dbl; + FcPattern *p0; + + ASET (entity, FONT_TYPE_INDEX, Qfreetype); + ASET (entity, FONT_REGISTRY_INDEX, Qiso10646_1); + ASET (entity, FONT_FRAME_INDEX, frame); + ASET (entity, FONT_OBJLIST_INDEX, Qnil); + + if (FcPatternGetString (p, FC_FOUNDRY, 0, &str) == FcResultMatch) + ASET (entity, FONT_FOUNDRY_INDEX, + intern_downcase ((char *) str, strlen ((char *) str))); + if (FcPatternGetString (p, FC_FAMILY, 0, &str) == FcResultMatch) + ASET (entity, FONT_FAMILY_INDEX, + intern_downcase ((char *) str, strlen ((char *) str))); + if (FcPatternGetInteger (p, FC_WEIGHT, 0, &numeric) == FcResultMatch) + ASET (entity, FONT_WEIGHT_INDEX, make_number (numeric)); + if (FcPatternGetInteger (p, FC_SLANT, 0, &numeric) == FcResultMatch) + ASET (entity, FONT_SLANT_INDEX, make_number (numeric + 100)); + if (FcPatternGetInteger (p, FC_WIDTH, 0, &numeric) == FcResultMatch) + ASET (entity, FONT_WIDTH_INDEX, make_number (numeric)); + if (FcPatternGetDouble (p, FC_PIXEL_SIZE, 0, &dbl) == FcResultMatch) + ASET (entity, FONT_SIZE_INDEX, make_number (dbl)); + else + ASET (entity, FONT_SIZE_INDEX, make_number (0)); + + if (FcPatternGetInteger (p, FC_SPACING, 0, &numeric) != FcResultMatch) + numeric = FC_MONO; + p0 = FcPatternCreate (); + if (! p0 + || FcPatternAddString (p0, FC_FILE, file) == FcFalse + || FcPatternAddCharSet (p0, FC_CHARSET, charset) == FcFalse + || FcPatternAddInteger (p0, FC_SPACING, numeric) == FcFalse) + break; + ASET (entity, FONT_EXTRA_INDEX, make_save_value (p0, 0)); + + val = Fcons (entity, val); + } + } + val = Fvconcat (1, &val); + goto finish; + + err: + /* We come here because of unexpected error in fontconfig API call + (usually insufficiency memory). */ + val = Qnil; + + finish: + if (charset && charset != cs_iso8859_1) FcCharSetDestroy (charset); + if (objset) FcObjectSetDestroy (objset); + if (fontset) FcFontSetDestroy (fontset); + if (langset) FcLangSetDestroy (langset); + if (pattern) FcPatternDestroy (pattern); + + return val; +} + +static Lisp_Object +ftfont_list_family (frame) + Lisp_Object frame; +{ + Lisp_Object list; + FcPattern *pattern = NULL; + FcFontSet *fontset = NULL; + FcObjectSet *objset = NULL; + int i; + + if (! fc_initialized) + { + FcInit (); + fc_initialized = 1; + } + + pattern = FcPatternCreate (); + if (! pattern) + goto finish; + objset = FcObjectSetBuild (FC_FAMILY); + if (! objset) + goto finish; + fontset = FcFontList (NULL, pattern, objset); + if (! fontset) + goto finish; + + list = Qnil; + for (i = 0; i < fontset->nfont; i++) + { + FcPattern *pat = fontset->fonts[i]; + FcChar8 *str; + + if (FcPatternGetString (pat, FC_FAMILY, 0, &str) == FcResultMatch) + list = Fcons (intern_downcase ((char *) str, strlen ((char *) str)), + list); + } + + finish: + if (objset) FcObjectSetDestroy (objset); + if (fontset) FcFontSetDestroy (fontset); + if (pattern) FcPatternDestroy (pattern); + + return list; +} + + +static void +ftfont_free_entity (entity) + Lisp_Object entity; +{ + Lisp_Object val = AREF (entity, FONT_EXTRA_INDEX); + FcPattern *pattern = XSAVE_VALUE (val)->pointer; + + FcPatternDestroy (pattern); +} + +static struct font * +ftfont_open (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + struct ftfont_info *ftfont_info; + struct font *font; + FT_Face ft_face; + FT_Size ft_size; + FT_UInt size; + Lisp_Object val; + FcPattern *pattern; + FcChar8 *file; + int spacing; + + val = AREF (entity, FONT_EXTRA_INDEX); + if (XTYPE (val) != Lisp_Misc + || XMISCTYPE (val) != Lisp_Misc_Save_Value) + return NULL; + pattern = XSAVE_VALUE (val)->pointer; + if (XSAVE_VALUE (val)->integer == 0) + { + /* We have not yet created FT_Face for this font. */ + if (! ft_library + && FT_Init_FreeType (&ft_library) != 0) + return NULL; + if (FcPatternGetString (pattern, FC_FILE, 0, &file) != FcResultMatch) + return NULL; + if (FT_New_Face (ft_library, (char *) file, 0, &ft_face) != 0) + return NULL; + FcPatternAddFTFace (pattern, FC_FT_FACE, ft_face); + ft_size = ft_face->size; + } + else + { + if (FcPatternGetFTFace (pattern, FC_FT_FACE, 0, &ft_face) + != FcResultMatch) + return NULL; + if (FT_New_Size (ft_face, &ft_size) != 0) + return NULL; + if (FT_Activate_Size (ft_size) != 0) + { + FT_Done_Size (ft_size); + return NULL; + } + } + + size = XINT (AREF (entity, FONT_SIZE_INDEX)); + if (size == 0) + size = pixel_size; + if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0) + { + if (XSAVE_VALUE (val)->integer == 0) + FT_Done_Face (ft_face); + return NULL; + } + + ftfont_info = malloc (sizeof (struct ftfont_info)); + if (! ftfont_info) + return NULL; + ftfont_info->ft_size = ft_size; + + font = (struct font *) ftfont_info; + font->entity = entity; + font->pixel_size = size; + font->driver = &ftfont_driver; + font->font.name = font->font.full_name = NULL; + font->file_name = (char *) file; + font->font.size = ft_face->size->metrics.max_advance >> 6; + font->ascent = ft_face->size->metrics.ascender >> 6; + font->descent = - ft_face->size->metrics.descender >> 6; + font->font.height = ft_face->size->metrics.height >> 6; + if (FcPatternGetInteger (pattern, FC_SPACING, 0, &spacing) != FcResultMatch + || spacing != FC_PROPORTIONAL) + font->font.average_width = font->font.space_width = font->font.size; + else + { + int i; + + for (i = 32; i < 127; i++) + { + if (FT_Load_Char (ft_face, i, FT_LOAD_DEFAULT) != 0) + break; + if (i == 32) + font->font.space_width = ft_face->glyph->metrics.horiAdvance >> 6; + font->font.average_width += ft_face->glyph->metrics.horiAdvance >> 6; + } + if (i == 127) + { + /* The font contains all ASCII printable characters. */ + font->font.average_width /= 95; + } + else + { + if (i == 32) + font->font.space_width = font->font.size; + font->font.average_width = font->font.size; + } + } + + font->font.baseline_offset = 0; + font->font.relative_compose = 0; + font->font.default_ascent = 0; + font->font.vertical_centering = 0; + + (XSAVE_VALUE (val)->integer)++; + + return font; +} + +static void +ftfont_close (f, font) + FRAME_PTR f; + struct font *font; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + Lisp_Object entity = font->entity; + Lisp_Object val = AREF (entity, FONT_EXTRA_INDEX); + + (XSAVE_VALUE (val)->integer)--; + if (XSAVE_VALUE (val)->integer == 0) + FT_Done_Face (ftfont_info->ft_size->face); + else + FT_Done_Size (ftfont_info->ft_size); + + free (font); +} + +static int +ftfont_has_char (entity, c) + Lisp_Object entity; + int c; +{ + Lisp_Object val; + FcPattern *pattern; + FcCharSet *charset; + + val = AREF (entity, FONT_EXTRA_INDEX); + pattern = XSAVE_VALUE (val)->pointer; + FcPatternGetCharSet (pattern, FC_CHARSET, 0, &charset); + + return (FcCharSetHasChar (charset, (FcChar32) c) == FcTrue); +} + +static unsigned +ftfont_encode_char (font, c) + struct font *font; + int c; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + FT_Face ft_face = ftfont_info->ft_size->face; + FT_ULong charcode = c; + FT_UInt code = FT_Get_Char_Index (ft_face, charcode); + + return (code > 0 ? code : 0xFFFFFFFF); +} + +static int +ftfont_text_extents (font, code, nglyphs, metrics) + struct font *font; + unsigned *code; + int nglyphs; + struct font_metrics *metrics; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + FT_Face ft_face = ftfont_info->ft_size->face; + int width = 0; + int i; + + if (ftfont_info->ft_size != ft_face->size) + FT_Activate_Size (ftfont_info->ft_size); + if (metrics) + bzero (metrics, sizeof (struct font_metrics)); + for (i = 0; i < nglyphs; i++) + { + if (FT_Load_Glyph (ft_face, code[i], FT_LOAD_DEFAULT) == 0) + { + FT_Glyph_Metrics *m = &ft_face->glyph->metrics; + + if (metrics) + { + if (metrics->lbearing > width + (m->horiBearingX >> 6)) + metrics->lbearing = width + (m->horiBearingX >> 6); + if (metrics->rbearing + < width + ((m->horiBearingX + m->width) >> 6)) + metrics->rbearing + = width + ((m->horiBearingX + m->width) >> 6); + if (metrics->ascent < (m->horiBearingY >> 6)) + metrics->ascent = m->horiBearingY >> 6; + if (metrics->descent > ((m->horiBearingY + m->height) >> 6)) + metrics->descent = (m->horiBearingY + m->height) >> 6; + } + width += m->horiAdvance >> 6; + } + else + { + width += font->font.space_width; + } + } + if (metrics) + metrics->width = width; + + return width; +} + +static int +ftfont_get_bitmap (font, code, bitmap, bits_per_pixel) + struct font *font; + unsigned code; + struct font_bitmap *bitmap; + int bits_per_pixel; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + FT_Face ft_face = ftfont_info->ft_size->face; + FT_Int32 load_flags = FT_LOAD_RENDER; + + if (ftfont_info->ft_size != ft_face->size) + FT_Activate_Size (ftfont_info->ft_size); + if (bits_per_pixel == 1) + { +#ifdef FT_LOAD_TARGET_MONO + load_flags |= FT_LOAD_TARGET_MONO; +#else + load_flags |= FT_LOAD_MONOCHROME; +#endif + } + else if (bits_per_pixel != 8) + /* We don't support such a rendering. */ + return -1; + + if (FT_Load_Glyph (ft_face, code, load_flags) != 0) + return -1; + bitmap->rows = ft_face->glyph->bitmap.rows; + bitmap->width = ft_face->glyph->bitmap.width; + bitmap->pitch = ft_face->glyph->bitmap.pitch; + bitmap->buffer = ft_face->glyph->bitmap.buffer; + bitmap->left = ft_face->glyph->bitmap_left; + bitmap->top = ft_face->glyph->bitmap_top; + bitmap->advance = ft_face->glyph->metrics.horiAdvance >> 6; + bitmap->extra = NULL; + + return 0; +} + +static int +ftfont_anchor_point (font, code, index, x, y) + struct font *font; + unsigned code; + int index; + int *x, *y; +{ + struct ftfont_info *ftfont_info = (struct ftfont_info *) font; + FT_Face ft_face = ftfont_info->ft_size->face; + + if (ftfont_info->ft_size != ft_face->size) + FT_Activate_Size (ftfont_info->ft_size); + if (FT_Load_Glyph (ft_face, code, FT_LOAD_DEFAULT) != 0) + return -1; + if (ft_face->glyph->format != FT_GLYPH_FORMAT_OUTLINE) + return -1; + if (index >= ft_face->glyph->outline.n_points) + return -1; + *x = ft_face->glyph->outline.points[index].x; + *y = ft_face->glyph->outline.points[index].y; + return 0; +} + + +void +syms_of_ftfont () +{ + staticpro (&freetype_font_cache); + freetype_font_cache = Qnil; + + DEFSYM (Qfreetype, "freetype"); + DEFSYM (Qiso8859_1, "iso8859-1"); + DEFSYM (Qiso10646_1, "iso10646-1"); + DEFSYM (Qunicode_bmp, "unicode-bmp"); + + ftfont_driver.type = Qfreetype; + register_font_driver (&ftfont_driver, NULL); +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/ftxfont.c Tue Jun 06 03:47:13 2006 +0000 @@ -0,0 +1,346 @@ +/* ftxfont.c -- FreeType font driver on X (without using XFT). + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + 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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> +#include <X11/Xlib.h> + +#include "lisp.h" +#include "dispextern.h" +#include "xterm.h" +#include "frame.h" +#include "blockinput.h" +#include "character.h" +#include "charset.h" +#include "fontset.h" +#include "font.h" + +/* FTX font driver. */ + +static Lisp_Object Qftx; + +/* Prototypes for helper function. */ +static int ftxfont_draw_bitmap P_ ((FRAME_PTR, GC *, struct font *, unsigned, + int, int, XPoint *, int, int *n)); +static void ftxfont_draw_backgrond P_ ((FRAME_PTR, struct font *, GC, + int, int, int)); + +static int +ftxfont_draw_bitmap (f, gc, font, code, x, y, p, size, n) + FRAME_PTR f; + GC *gc; + struct font *font; + unsigned code; + int x, y; + XPoint *p; + int size, *n; +{ + struct font_bitmap bitmap; + unsigned char *b; + int i, j; + + if (ftfont_driver.get_bitmap (font, code, &bitmap, 1) < 0) + return 0; + for (i = 0, b = bitmap.buffer; i < bitmap.rows; + i++, b += bitmap.pitch) + { + if (size > 0x100) + { + for (j = 0; j < bitmap.width; j++) + if (b[j / 8] & (1 << (7 - (j % 8)))) + { + p[n[0]].x = x + bitmap.left + j; + p[n[0]].y = y - bitmap.top + i; + if (++n[0] == 0x400) + { + XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + gc[0], p, size, CoordModeOrigin); + n[0] = 0; + } + } + } + else + { + for (j = 0; j < bitmap.width; j++) + { + int idx = (b[j] >> 5) - 1; + + if (idx >= 0) + { + XPoint *pp = p + size * idx; + + pp[n[idx]].x = x + bitmap.left + j; + pp[n[idx]].y = y - bitmap.top + i; + if (++(n[idx]) == 0x100) + { + XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + gc[idx], pp, size, CoordModeOrigin); + n[idx] = 0; + } + } + } + } + } + + if (ftfont_driver.free_bitmap) + ftfont_driver.free_bitmap (font, &bitmap); + + return bitmap.advance; +} + +static void +ftxfont_draw_backgrond (f, font, gc, x, y, width) + FRAME_PTR f; + struct font *font; + GC gc; + int x, y, width; +{ + XGCValues xgcv; + + XGetGCValues (FRAME_X_DISPLAY (f), gc, + GCForeground | GCBackground, &xgcv); + XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.background); + XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), gc, + x, y - font->ascent, width, font->font.height); + XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground); +} + +/* Prototypes for font-driver methods. */ +static Lisp_Object ftxfont_list P_ ((Lisp_Object, Lisp_Object)); +static struct font *ftxfont_open P_ ((FRAME_PTR, Lisp_Object, int)); +static void ftxfont_close P_ ((FRAME_PTR, struct font *)); +static int ftxfont_prepare_face (FRAME_PTR, struct face *); +static void ftxfont_done_face (FRAME_PTR, struct face *); + +static int ftxfont_draw P_ ((struct glyph_string *, int, int, int, int, int)); + +struct font_driver ftxfont_driver; + +static Lisp_Object +ftxfont_list (frame, spec) + Lisp_Object frame; + Lisp_Object spec; +{ + Lisp_Object val = ftfont_driver.list (frame, spec); + + if (! NILP (val)) + { + int i; + + for (i = 0; i < ASIZE (val); i++) + ASET (AREF (val, i), FONT_TYPE_INDEX, Qftx); + } + return val; +} + +static struct font * +ftxfont_open (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + struct font *font; + XFontStruct *xfont = malloc (sizeof (XFontStruct)); + + if (! xfont) + return NULL; + font = ftfont_driver.open (f, entity, pixel_size); + if (! font) + { + free (xfont); + return NULL; + } + + xfont->fid = FRAME_FONT (f)->fid; + xfont->ascent = font->ascent; + xfont->descent = font->descent; + xfont->max_bounds.width = font->font.size; + xfont->min_bounds.width = font->min_width; + font->font.font = xfont; + font->driver = &ftxfont_driver; + + dpyinfo->n_fonts++; + + /* Set global flag fonts_changed_p to non-zero if the font loaded + has a character with a smaller width than any other character + before, or if the font loaded has a smaller height than any other + font loaded before. If this happens, it will make a glyph matrix + reallocation necessary. */ + if (dpyinfo->n_fonts == 1) + { + dpyinfo->smallest_font_height = font->font.height; + dpyinfo->smallest_char_width = font->min_width; + fonts_changed_p = 1; + } + else + { + if (dpyinfo->smallest_font_height > font->font.height) + dpyinfo->smallest_font_height = font->font.height, fonts_changed_p |= 1; + if (dpyinfo->smallest_char_width > font->min_width) + dpyinfo->smallest_char_width = font->min_width, fonts_changed_p |= 1; + } + + return font; +} + +static void +ftxfont_close (f, font) + FRAME_PTR f; + struct font *font; +{ + ftfont_driver.close (f, font); + FRAME_X_DISPLAY_INFO (f)->n_fonts--; +} + +static int +ftxfont_prepare_face (f, face) + FRAME_PTR f; + struct face *face; +{ + GC gc[6]; + XColor colors[3]; + XGCValues xgcv; + unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures; + int i; + + face->extra = NULL; + + /* Here, we create 6 more GCs to simulate anti-aliasing. */ + BLOCK_INPUT; + XGetGCValues (FRAME_X_DISPLAY (f), face->gc, mask, &xgcv); + colors[0].pixel = face->foreground; + colors[1].pixel = face->background; + XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors, 2); + for (i = 1; i < 7; i++) + { + colors[2].red = (colors[0].red * i + colors[1].red * (7 - i)) / 7; + colors[2].green = (colors[0].green * i + colors[1].green * (7 - i)) / 7; + colors[2].blue = (colors[0].blue * i + colors[1].blue * (7 - i)) / 7; + if (! x_alloc_nearest_color (f, FRAME_X_COLORMAP (f), &colors[2])) + break; + xgcv.foreground = colors[2].pixel; + gc[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + mask, &xgcv); + } + UNBLOCK_INPUT; + + if (i < 7) + return -1; + face->extra = malloc (sizeof (GC) * 7); + if (! face->extra) + return -1; + for (i = 0; i < 6; i++) + ((GC *) face->extra)[i] = gc[i]; + ((GC *) face->extra)[i] = face->gc; + return 0; +} + +static void +ftxfont_done_face (f, face) + FRAME_PTR f; + struct face *face; +{ + if (face->extra) + { + int i; + + BLOCK_INPUT; + for (i = 0; i < 7; i++) + XFreeGC (FRAME_X_DISPLAY (f), ((GC *) face->extra)[i]); + UNBLOCK_INPUT; + free (face->extra); + face->extra = NULL; + } +} + +static int +ftxfont_draw (s, from, to, x, y, with_background) + struct glyph_string *s; + int from, to, x, y, with_background; +{ + FRAME_PTR f = s->f; + struct face *face = s->face; + struct font *font = (struct font *) face->font; + XPoint p[0x700]; + int n[7]; + unsigned *code; + int len = to - from; + int i; + + n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0; + + BLOCK_INPUT; + + if (with_background) + ftxfont_draw_backgrond (f, font, s->gc, x, y, s->width); + code = alloca (sizeof (unsigned) * len); + for (i = 0; i < len; i++) + code[i] = ((XCHAR2B_BYTE1 (s->char2b + from + i) << 8) + | XCHAR2B_BYTE2 (s->char2b + from + i)); + + if (! face->extra) + { + for (i = 0; i < len; i++) + x += ftxfont_draw_bitmap (f, &face->gc, font, code[i], x, y, + p, 0x700, n); + if (n[0] > 0) + XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + face->gc, p, n[0], CoordModeOrigin); + } + else + { + GC *gc = face->extra; + + for (i = 0; i < len; i++) + x += ftxfont_draw_bitmap (f, &face->gc, font, code[i], x, y, + p, 0x100, n); + for (i = 0; i < 7; i++) + if (n[i] > 0) + XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + gc[i], p + 0x100 * i, n[i], CoordModeOrigin); + } + + UNBLOCK_INPUT; + + return len; +} + + + +void +syms_of_ftxfont () +{ + DEFSYM (Qftx, "ftx"); + + ftxfont_driver = ftfont_driver; + ftxfont_driver.type = Qftx; + ftxfont_driver.list = ftxfont_list; + ftxfont_driver.open = ftxfont_open; + ftxfont_driver.close = ftxfont_close; + ftxfont_driver.prepare_face = ftxfont_prepare_face; + ftxfont_driver.done_face = ftxfont_done_face; + ftxfont_driver.draw = ftxfont_draw; + + register_font_driver (&ftxfont_driver, NULL); +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/xfont.c Tue Jun 06 03:47:13 2006 +0000 @@ -0,0 +1,868 @@ +/* xfont.c -- X core font driver. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + 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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> +#include <X11/Xlib.h> + +#include "lisp.h" +#include "dispextern.h" +#include "xterm.h" +#include "frame.h" +#include "blockinput.h" +#include "character.h" +#include "charset.h" +#include "fontset.h" +#include "font.h" + + +/* X core font driver. */ + +Lisp_Object Qx; + +/* Alist of font registry symbol and the corresponding charsets + 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 x_font_charset_alist; + +/* Prototypes of support functions. */ +extern void x_clear_errors P_ ((Display *)); + +static char *xfont_query_font P_ ((Display *, char *, Lisp_Object)); +static XCharStruct *xfont_get_pcm P_ ((XFontStruct *, XChar2b *)); +static int xfont_registry_charsets P_ ((Lisp_Object, struct charset **, + struct charset **)); + +static char * +xfont_query_font (display, name, spec) + Display *display; + char *name; + Lisp_Object spec; +{ + XFontStruct *font; + + BLOCK_INPUT; + x_catch_errors (display); + font = XLoadQueryFont (display, name); + name = NULL; + if (x_had_errors_p (display)) + { + /* This error is perhaps due to insufficient memory on X + server. Let's just ignore it. */ + x_clear_errors (display); + } + else if (font) + { + unsigned long value; + + if (XGetFontProperty (font, XA_FONT, &value)) + { + char *n = (char *) XGetAtomName (display, (Atom) value); + + if (font_parse_xlfd (n, spec, 0) >= 0) + name = n; + else + XFree (n); + } + XFreeFont (display, font); + } + x_uncatch_errors (); + UNBLOCK_INPUT; + + return name; +} + + +/* Get metrics of character CHAR2B in XFONT. Value is null if CHAR2B + is not contained in the font. */ + +static XCharStruct * +xfont_get_pcm (xfont, char2b) + XFontStruct *xfont; + XChar2b *char2b; +{ + /* The result metric information. */ + XCharStruct *pcm = NULL; + + xassert (xfont && char2b); + + if (xfont->per_char != NULL) + { + if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0) + { + /* min_char_or_byte2 specifies the linear character index + corresponding to the first element of the per_char array, + max_char_or_byte2 is the index of the last character. A + character with non-zero CHAR2B->byte1 is not in the font. + A character with byte2 less than min_char_or_byte2 or + greater max_char_or_byte2 is not in the font. */ + if (char2b->byte1 == 0 + && char2b->byte2 >= xfont->min_char_or_byte2 + && char2b->byte2 <= xfont->max_char_or_byte2) + pcm = xfont->per_char + char2b->byte2 - xfont->min_char_or_byte2; + } + else + { + /* If either min_byte1 or max_byte1 are nonzero, both + min_char_or_byte2 and max_char_or_byte2 are less than + 256, and the 2-byte character index values corresponding + to the per_char array element N (counting from 0) are: + + byte1 = N/D + min_byte1 + byte2 = N\D + min_char_or_byte2 + + where: + + D = max_char_or_byte2 - min_char_or_byte2 + 1 + / = integer division + \ = integer modulus */ + if (char2b->byte1 >= xfont->min_byte1 + && char2b->byte1 <= xfont->max_byte1 + && char2b->byte2 >= xfont->min_char_or_byte2 + && char2b->byte2 <= xfont->max_char_or_byte2) + pcm = (xfont->per_char + + ((xfont->max_char_or_byte2 - xfont->min_char_or_byte2 + 1) + * (char2b->byte1 - xfont->min_byte1)) + + (char2b->byte2 - xfont->min_char_or_byte2)); + } + } + else + { + /* If the per_char pointer is null, all glyphs between the first + and last character indexes inclusive have the same + information, as given by both min_bounds and max_bounds. */ + if (char2b->byte2 >= xfont->min_char_or_byte2 + && char2b->byte2 <= xfont->max_char_or_byte2) + pcm = &xfont->max_bounds; + } + + return ((pcm == NULL + || (pcm->width == 0 && (pcm->rbearing - pcm->lbearing) == 0)) + ? NULL : pcm); +} + +extern Lisp_Object find_font_encoding P_ ((Lisp_Object)); + +/* 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. */ + +static int +xfont_registry_charsets (registry, encoding, repertory) + Lisp_Object registry; + struct charset **encoding, **repertory; +{ + Lisp_Object val; + int encoding_id, repertory_id; + + val = assq_no_quit (registry, x_font_charset_alist); + if (! NILP (val)) + { + val = XCDR (val); + if (NILP (val)) + return -1; + encoding_id = XINT (XCAR (val)); + repertory_id = XINT (XCDR (val)); + } + else + { + val = find_font_encoding (SYMBOL_NAME (registry)); + if (SYMBOLP (val) && CHARSETP (val)) + { + encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val)); + } + else if (CONSP (val)) + { + if (! CHARSETP (XCAR (val))) + goto invalid_entry; + encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val))); + if (NILP (XCDR (val))) + repertory_id = -1; + else + { + if (! CHARSETP (XCDR (val))) + goto invalid_entry; + repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val))); + } + } + else + goto invalid_entry; + val = Fcons (make_number (encoding_id), make_number (repertory_id)); + x_font_charset_alist + = nconc2 (x_font_charset_alist, Fcons (Fcons (registry, val), Qnil)); + } + + if (encoding) + *encoding = CHARSET_FROM_ID (encoding_id); + if (repertory) + *repertory = repertory_id >= 0 ? CHARSET_FROM_ID (repertory_id) : NULL; + return 0; + + invalid_entry: + x_font_charset_alist + = nconc2 (x_font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil)); + return -1; +} + +static Lisp_Object xfont_get_cache P_ ((Lisp_Object)); +static int xfont_parse_name P_ ((FRAME_PTR, char *, Lisp_Object)); +static Lisp_Object xfont_list P_ ((Lisp_Object, Lisp_Object)); +static Lisp_Object xfont_list_family P_ ((Lisp_Object)); +static struct font *xfont_open P_ ((FRAME_PTR, Lisp_Object, int)); +static void xfont_close P_ ((FRAME_PTR, struct font *)); +static int xfont_prepare_face P_ ((FRAME_PTR, struct face *)); +#if 0 +static void xfont_done_face P_ ((FRAME_PTR, struct face *)); +#endif +static int xfont_has_char P_ ((Lisp_Object, int)); +static unsigned xfont_encode_char P_ ((struct font *, int)); +static int xfont_text_extents P_ ((struct font *, unsigned *, int, + struct font_metrics *)); +static int xfont_draw P_ ((struct glyph_string *, int, int, int, int, int)); + +struct font_driver xfont_driver = + { + (Lisp_Object) NULL, /* Qx */ + xfont_get_cache, + xfont_parse_name, + xfont_list, + xfont_list_family, + NULL, + xfont_open, + xfont_close, + xfont_prepare_face, + NULL /*xfont_done_face*/, + xfont_has_char, + xfont_encode_char, + xfont_text_extents, + xfont_draw, + }; + +extern Lisp_Object QCname; + +static Lisp_Object +xfont_get_cache (frame) + Lisp_Object frame; +{ + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (XFRAME (frame)); + + return (dpyinfo->name_list_element); +} + +static int +xfont_parse_name (f, name, spec) + FRAME_PTR f; + char *name; + Lisp_Object spec; +{ + if (font_parse_xlfd (name, spec, 0) >= 0) + return 0; + name = xfont_query_font (FRAME_X_DISPLAY (f), name, spec); + if (name) + { + XFree (name); + return 0; + } + return -1; +} + +extern Lisp_Object Vface_alternative_font_registry_alist; + +static Lisp_Object +xfont_list (frame, spec) + Lisp_Object frame, spec; +{ + FRAME_PTR f = XFRAME (frame); + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Lisp_Object *vec, val, extra, font_name, entity; + char name[256], **names; + int i, idx, limit, num_fonts; + int error_occurred = 0; + USE_SAFE_ALLOCA; + + extra = AREF (spec, FONT_EXTRA_INDEX); + font_name = Qnil; + if (CONSP (extra)) + { + val = Fassq (QCotf, extra); + if (! NILP (val)) + return null_vector; + val = Fassq (QCname, extra); + if (CONSP (val)) + font_name = XCDR (val); + } + + if (! STRINGP (font_name) + && font_unparse_xlfd (spec, 0, name, 256) < 0) + return null_vector; + + BLOCK_INPUT; + x_catch_errors (dpyinfo->display); + + if (STRINGP (font_name)) + { + XFontStruct *font = XLoadQueryFont (dpyinfo->display, + (char *) SDATA (font_name)); + unsigned long value; + + num_fonts = 0; + if (x_had_errors_p (dpyinfo->display)) + { + /* This error is perhaps due to insufficient memory on X + server. Let's just ignore it. */ + font = NULL; + error_occurred = 1; + x_clear_errors (dpyinfo->display); + } + if (font) + { + if (XGetFontProperty (font, XA_FONT, &value)) + { + char *n = (char *) XGetAtomName (dpyinfo->display, (Atom) value); + int len = strlen (n); + char *tmp; + + /* If DXPC (a Differential X Protocol Compressor) + Ver.3.7 is running, XGetAtomName will return null + string. We must avoid such a name. */ + if (len > 0) + { + num_fonts = 1; + names = (char **) alloca (sizeof (char *)); + /* Some systems only allow alloca assigned to a + simple var. */ + tmp = (char *) alloca (len + 1); names[0] = tmp; + bcopy (n, names[0], len + 1); + } + XFree (n); + } + XFreeFont (dpyinfo->display, font); + } + } + else + { + Lisp_Object registry = AREF (spec, FONT_REGISTRY_INDEX); + Lisp_Object alter = Qnil; + char *r = NULL; + + if (! NILP (registry)) + alter = Fassoc_string (SYMBOL_NAME (registry), + Vface_alternative_font_registry_alist); + while (1) + { + for (limit = 512, num_fonts = 0; ; limit *= 2) + { + names = XListFonts (dpyinfo->display, name, limit, &num_fonts); + if (x_had_errors_p (dpyinfo->display)) + { + /* This error is perhaps due to insufficient memory + on X server. Let's just ignore it. */ + x_clear_errors (dpyinfo->display); + error_occurred = 1; + num_fonts = 0; + break; + } + if (num_fonts < limit) + break; + XFreeFontNames (names); + } + if (num_fonts > 0 + || NILP (alter)) + break; + + /* Setup for trying alternatives. */ + if (! r + && ! (r = strstr (name, (char *) SDATA (SYMBOL_NAME (registry))))) + abort (); + while (1) + { + registry = Qnil; + alter = XCDR (alter); + if (NILP (alter)) + break; + registry = XCAR (alter); + if ((r - name) + SBYTES (registry) < 255) + break; + } + if (NILP (registry)) + break; + bcopy (SDATA (registry), r, SBYTES (registry)); + } + } + + x_uncatch_errors (); + UNBLOCK_INPUT; + + if (error_occurred) + return Qnil; + if (num_fonts == 0) + return null_vector; + + entity = Fmake_vector (make_number (FONT_ENTITY_MAX), Qnil); + ASET (entity, FONT_TYPE_INDEX, Qx); + ASET (entity, FONT_FRAME_INDEX, frame); + + SAFE_ALLOCA_LISP (vec, num_fonts); + for (i = idx = 0; i < num_fonts; i++) + { + if (font_parse_xlfd (names[i], entity, 0) > 0) + vec[idx++] = Fcopy_sequence (entity); + } + if (! STRINGP (font_name)) + { + BLOCK_INPUT; + XFreeFontNames (names); + UNBLOCK_INPUT; + } + val = Fvector (idx, vec); + SAFE_FREE (); + + return val; +} + +static int +memq_no_quit (elt, list) + Lisp_Object elt, list; +{ + while (CONSP (list) && ! EQ (XCAR (list), elt)) + list = XCDR (list); + return (CONSP (list)); +} + +static Lisp_Object +xfont_list_family (frame) +{ + FRAME_PTR f = XFRAME (frame); + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + char **names; + int num_fonts, i; + Lisp_Object list; + char *last_family; + int last_len; + + BLOCK_INPUT; + x_catch_errors (dpyinfo->display); + names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*", + 0x8000, &num_fonts); + if (x_had_errors_p (dpyinfo->display)) + { + /* This error is perhaps due to insufficient memory on X server. + Let's just ignore it. */ + x_clear_errors (dpyinfo->display); + num_fonts = 0; + } + + list = Qnil; + for (i = 0, last_len = 0; i < num_fonts; i++) + { + char *p0 = names[i], *p1; + Lisp_Object family; + + p0++; /* skip the leading '-' */ + while (*p0 && *p0 != '-') p0++; /* skip foundry */ + if (! *p0) + continue; + p1 = ++p0; + while (*p1 && *p1 != '-') p1++; /* find the end of family */ + if (! *p1 || p1 == p0) + continue; + if (last_len == p1 - p0 + && bcmp (last_family, p0, last_len) == 0) + continue; + last_len = p1 - p0; + last_family = p0; + family = intern_downcase (p0, last_len); + if (! memq_no_quit (family, list)) + list = Fcons (family, list); + } + + XFreeFontNames (names); + x_uncatch_errors (); + UNBLOCK_INPUT; + + return list; +} + +static struct font * +xfont_open (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Display *display = dpyinfo->display; + char name[256]; + int len; + unsigned long value; + Lisp_Object registry; + struct charset *encoding, *repertory; + struct font *font; + XFontStruct *xfont; + + /* At first, check if we know how to encode characters for this + font. */ + registry = AREF (entity, FONT_REGISTRY_INDEX); + if (xfont_registry_charsets (registry, &encoding, &repertory) < 0) + return NULL; + + if (XINT (AREF (entity, FONT_SIZE_INDEX)) != 0) + pixel_size = XINT (AREF (entity, FONT_SIZE_INDEX)); + len = font_unparse_xlfd (entity, pixel_size, name, 256); + if (len <= 0) + return NULL; + + BLOCK_INPUT; + x_catch_errors (display); + xfont = XLoadQueryFont (display, name); + if (x_had_errors_p (display)) + { + /* This error is perhaps due to insufficient memory on X server. + Let's just ignore it. */ + x_clear_errors (display); + xfont = NULL; + } + x_uncatch_errors (); + UNBLOCK_INPUT; + + if (! xfont) + return NULL; + font = malloc (sizeof (struct font)); + font->font.font = xfont; + font->entity = entity; + font->pixel_size = pixel_size; + font->driver = &xfont_driver; + font->font.name = malloc (len + 1); + if (! font->font.name) + { + XFreeFont (display, xfont); + free (font); + return NULL; + } + bcopy (name, font->font.name, len + 1); + font->font.charset = encoding->id; + font->encoding_charset = encoding->id; + font->repertory_charet = repertory ? repertory->id : -1; + font->ascent = xfont->ascent; + font->descent = xfont->descent; + + if (xfont->min_bounds.width == xfont->max_bounds.width) + { + /* Fixed width font. */ + font->font.average_width = font->font.space_width + = xfont->min_bounds.width; + } + else + { + XChar2b char2b; + XCharStruct *pcm; + + char2b.byte1 = 0x00, char2b.byte2 = 0x20; + pcm = xfont_get_pcm (xfont, &char2b); + if (pcm) + font->font.space_width = pcm->width; + else + font->font.space_width = xfont->max_bounds.width; + + font->font.average_width + = (XGetFontProperty (xfont, dpyinfo->Xatom_AVERAGE_WIDTH, &value) + ? (long) value / 10 : 0); + if (font->font.average_width < 0) + font->font.average_width = - font->font.average_width; + if (font->font.average_width == 0) + { + if (pcm) + { + int width = pcm->width; + for (char2b.byte2 = 33; char2b.byte2 <= 126; char2b.byte2++) + if ((pcm = xfont_get_pcm (xfont, &char2b)) != NULL) + width += pcm->width; + font->font.average_width = width / 95; + } + else + font->font.average_width = xfont->max_bounds.width; + } + } + font->min_width = xfont->min_bounds.width; + if (font->min_width <= 0) + font->min_width = font->font.space_width; + + BLOCK_INPUT; + /* Try to get the full name of FONT. Put it in FULL_NAME. */ + if (XGetFontProperty (xfont, XA_FONT, &value)) + { + char *full_name = NULL, *p0, *p; + int dashes = 0; + + p0 = p = (char *) XGetAtomName (FRAME_X_DISPLAY (f), (Atom) value);; + /* Count the number of dashes in the "full name". + If it is too few, this isn't really the font's full name, + so don't use it. + In X11R4, the fonts did not come with their canonical names + stored in them. */ + while (*p) + { + if (*p == '-') + dashes++; + p++; + } + + if (dashes >= 13) + { + full_name = (char *) malloc (p - p0 + 1); + if (full_name) + bcopy (p0, full_name, p - p0 + 1); + } + XFree (p0); + + if (full_name) + font->font.full_name = full_name; + else + font->font.full_name = font->font.name; + } + font->file_name = NULL; + + font->font.size = xfont->max_bounds.width; + font->font.height = xfont->ascent + xfont->descent; + font->font.baseline_offset + = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_BASELINE_OFFSET, &value) + ? (long) value : 0); + font->font.relative_compose + = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_RELATIVE_COMPOSE, &value) + ? (long) value : 0); + font->font.default_ascent + = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value) + ? (long) value : 0); + font->font.vertical_centering + = (STRINGP (Vvertical_centering_font_regexp) + && (fast_c_string_match_ignore_case + (Vvertical_centering_font_regexp, font->font.full_name) >= 0)); + + UNBLOCK_INPUT; + + dpyinfo->n_fonts++; + + /* Set global flag fonts_changed_p to non-zero if the font loaded + has a character with a smaller width than any other character + before, or if the font loaded has a smaller height than any other + font loaded before. If this happens, it will make a glyph matrix + reallocation necessary. */ + if (dpyinfo->n_fonts == 1) + { + dpyinfo->smallest_font_height = font->font.height; + dpyinfo->smallest_char_width = font->min_width; + fonts_changed_p = 1; + } + else + { + if (dpyinfo->smallest_font_height > font->font.height) + dpyinfo->smallest_font_height = font->font.height, fonts_changed_p |= 1; + if (dpyinfo->smallest_char_width > font->min_width) + dpyinfo->smallest_char_width = font->min_width, fonts_changed_p |= 1; + } + + return font; +} + +static void +xfont_close (f, font) + FRAME_PTR f; + struct font *font; +{ + BLOCK_INPUT; + XFreeFont (FRAME_X_DISPLAY (f), font->font.font); + UNBLOCK_INPUT; + + if (font->font.name != font->font.full_name) + free (font->font.full_name); + free (font->font.name); + free (font); + FRAME_X_DISPLAY_INFO (f)->n_fonts--; +} + +static int +xfont_prepare_face (f, face) + FRAME_PTR f; + struct face *face; +{ + BLOCK_INPUT; + XSetFont (FRAME_X_DISPLAY (f), face->gc, face->font->fid); + UNBLOCK_INPUT; + + return 0; +} + +#if 0 +static void +xfont_done_face (f, face) + FRAME_PTR f; + struct face *face; +{ + if (face->extra) + { + BLOCK_INPUT; + XFreeGC (FRAME_X_DISPLAY (f), (GC) face->extra); + UNBLOCK_INPUT; + face->extra = NULL; + } +} +#endif /* 0 */ + +static int +xfont_has_char (entity, c) + Lisp_Object entity; + int c; +{ + Lisp_Object registry = AREF (entity, FONT_REGISTRY_INDEX); + struct charset *repertory; + + if (xfont_registry_charsets (registry, NULL, &repertory) < 0) + return -1; + if (! repertory) + return -1; + return (ENCODE_CHAR (repertory, c) != CHARSET_INVALID_CODE (repertory)); +} + +static unsigned +xfont_encode_char (font, c) + struct font *font; + int c; +{ + struct charset *charset; + unsigned code; + XChar2b char2b; + + charset = CHARSET_FROM_ID (font->encoding_charset); + code = ENCODE_CHAR (charset, c); + if (code == CHARSET_INVALID_CODE (charset)) + return 0xFFFFFFFF; + if (font->repertory_charet >= 0) + { + charset = CHARSET_FROM_ID (font->repertory_charet); + return (ENCODE_CHAR (charset, c) != CHARSET_INVALID_CODE (charset) + ? code : 0xFFFFFFFF); + } + char2b.byte1 = code >> 16; + char2b.byte2 = code & 0xFFFF; + return (xfont_get_pcm (font->font.font, &char2b) ? code : 0xFFFFFFFF); +} + +static int +xfont_text_extents (font, code, nglyphs, metrics) + struct font *font; + unsigned *code; + int nglyphs; + struct font_metrics *metrics; +{ + int width = 0; + int i, x; + + if (metrics) + bzero (metrics, sizeof (struct font_metrics)); + for (i = 0, x = 0; i < nglyphs; i++) + { + XChar2b char2b; + static XCharStruct *pcm; + + if (code[i] >= 0x10000) + continue; + char2b.byte1 = code[i] >> 8, char2b.byte2 = code[i] & 0xFF; + pcm = xfont_get_pcm (font->font.font, &char2b); + if (! pcm) + continue; + if (metrics->lbearing > width + pcm->lbearing) + metrics->lbearing = width + pcm->lbearing; + if (metrics->rbearing < width + pcm->rbearing) + metrics->rbearing = width + pcm->rbearing; + if (metrics->ascent < pcm->ascent) + metrics->ascent = pcm->ascent; + if (metrics->descent < pcm->descent) + metrics->descent = pcm->descent; + width += pcm->width; + } + if (metrics) + metrics->width = width; + return width; +} + +static int +xfont_draw (s, from, to, x, y, with_background) + struct glyph_string *s; + int from, to, x, y, with_background; +{ + XFontStruct *xfont = s->face->font; + int len = to - from; + + if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0) + { + char *str; + int i; + USE_SAFE_ALLOCA; + + SAFE_ALLOCA (str, char *, len); + for (i = 0; i < len ; i++) + str[i] = XCHAR2B_BYTE2 (s->char2b + from + i); + if (with_background > 0) + XDrawImageString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), + s->gc, x, y, str, len); + else + XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), + s->gc, x, y, str, len); + SAFE_FREE (); + return s->nchars; + } + + if (with_background > 0) + XDrawImageString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), + s->gc, x, y, s->char2b + from, len); + else + XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), + s->gc, x, y, s->char2b + from, len); + + return len; +} + + + +void +syms_of_xfont () +{ + staticpro (&x_font_charset_alist); + x_font_charset_alist = Qnil; + + DEFSYM (Qx, "x"); + xfont_driver.type = Qx; + register_font_driver (&xfont_driver, NULL); +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/xftfont.c Tue Jun 06 03:47:13 2006 +0000 @@ -0,0 +1,552 @@ +/* xftfont.c -- XFT font driver. + Copyright (C) 2006 Free Software Foundation, Inc. + Copyright (C) 2006 + 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 2, 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; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#include <config.h> +#include <stdio.h> +#include <X11/Xlib.h> +#include <X11/Xft/Xft.h> + +#include "lisp.h" +#include "dispextern.h" +#include "xterm.h" +#include "frame.h" +#include "blockinput.h" +#include "character.h" +#include "charset.h" +#include "fontset.h" +#include "font.h" + +/* Xft font driver. */ + +static Lisp_Object Qxft; + +/* The actual structure for Xft font that can be casted to struct + font. */ + +struct xftfont_info +{ + struct font font; + Display *display; + int screen; + XftFont *xftfont; + FT_Face ft_face; +}; + +/* Structure pointed by (struct face *)->extra */ +struct xftface_info +{ + XftColor xft_fg; + XftColor xft_bg; + XftDraw *xft_draw; +}; + +static void xftfont_get_colors P_ ((FRAME_PTR, struct face *, GC gc, + struct xftface_info *, + XftColor *fg, XftColor *bg)); +static Font xftfont_default_fid P_ ((FRAME_PTR)); + + +/* Setup colors pointed by FG and BG for GC. If XFTFACE_INFO is not + NULL, reuse the colors in it if possible. BG may be NULL. */ +static void +xftfont_get_colors (f, face, gc, xftface_info, fg, bg) + FRAME_PTR f; + struct face *face; + GC gc; + struct xftface_info *xftface_info; + XftColor *fg, *bg; +{ + if (xftface_info && face->gc == gc) + { + *fg = xftface_info->xft_fg; + if (bg) + *bg = xftface_info->xft_bg; + } + else + { + XGCValues xgcv; + int fg_done = 0, bg_done = 0; + + BLOCK_INPUT; + XGetGCValues (FRAME_X_DISPLAY (f), gc, + GCForeground | GCBackground, &xgcv); + if (xftface_info) + { + if (xgcv.foreground == face->foreground) + *fg = xftface_info->xft_fg, fg_done = 1; + else if (xgcv.foreground == face->background) + *fg = xftface_info->xft_bg, fg_done = 1; + if (! bg) + bg_done = 1; + else if (xgcv.background == face->background) + *bg = xftface_info->xft_bg, bg_done = 1; + else if (xgcv.background == face->foreground) + *bg = xftface_info->xft_fg, bg_done = 1; + } + + if (fg_done + bg_done < 2) + { + XColor colors[2]; + + colors[0].pixel = fg->pixel = xgcv.foreground; + if (bg) + colors[1].pixel = bg->pixel = xgcv.background; + XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), colors, + bg ? 2 : 1); + fg->color.alpha = 0xFFFF; + fg->color.red = colors[0].red; + fg->color.green = colors[0].green; + fg->color.blue = colors[0].blue; + if (bg) + { + bg->color.alpha = 0xFFFF; + bg->color.red = colors[1].red; + bg->color.green = colors[1].green; + bg->color.blue = colors[1].blue; + } + } + UNBLOCK_INPUT; + } +} + +/* Return the default Font ID on frame F. */ + +static Font +xftfont_default_fid (f) + FRAME_PTR f; +{ + static int fid_known; + static Font fid; + + if (! fid_known) + { + fid = XLoadFont (FRAME_X_DISPLAY (f), "fixed"); + if (! fid) + { + fid = XLoadFont (FRAME_X_DISPLAY (f), "*"); + if (! fid) + abort (); + } + } + return fid; +} + + +static Lisp_Object xftfont_list P_ ((Lisp_Object, Lisp_Object)); +static struct font *xftfont_open P_ ((FRAME_PTR, Lisp_Object, int)); +static void xftfont_close P_ ((FRAME_PTR, struct font *)); +static int xftfont_prepare_face P_ ((FRAME_PTR, struct face *)); +static void xftfont_done_face P_ ((FRAME_PTR, struct face *)); +static unsigned xftfont_encode_char P_ ((struct font *, int)); +static int xftfont_text_extents P_ ((struct font *, unsigned *, int, + struct font_metrics *)); +static int xftfont_draw P_ ((struct glyph_string *, int, int, int, int, int)); + +static int xftfont_anchor_point P_ ((struct font *, unsigned, int, + int *, int *)); + +struct font_driver xftfont_driver; + +static Lisp_Object +xftfont_list (frame, spec) + Lisp_Object frame; + Lisp_Object spec; +{ + Lisp_Object val = ftfont_driver.list (frame, spec); + + if (! NILP (val)) + { + int i; + + for (i = 0; i < ASIZE (val); i++) + ASET (AREF (val, i), FONT_TYPE_INDEX, Qxft); + } + return val; +} + +static FcChar8 ascii_printable[95]; + +static struct font * +xftfont_open (f, entity, pixel_size) + FRAME_PTR f; + Lisp_Object entity; + int pixel_size; +{ + Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); + Display *display = FRAME_X_DISPLAY (f); + Lisp_Object val; + FcPattern *pattern, *pat; + FcChar8 *file; + XFontStruct *xfont; + struct xftfont_info *xftfont_info; + struct font *font; + double size = 0; + XftFont *xftfont; + int spacing; + + val = AREF (entity, FONT_EXTRA_INDEX); + if (XTYPE (val) != Lisp_Misc + || XMISCTYPE (val) != Lisp_Misc_Save_Value) + return NULL; + pattern = XSAVE_VALUE (val)->pointer; + if (FcPatternGetString (pattern, FC_FILE, 0, &file) != FcResultMatch) + return NULL; + + size = XINT (AREF (entity, FONT_SIZE_INDEX)); + if (size == 0) + size = pixel_size; + pat = FcPatternCreate (); + FcPatternAddString (pat, FC_FILE, file); + FcPatternAddDouble (pat, FC_PIXEL_SIZE, pixel_size); + FcPatternAddBool (pat, FC_ANTIALIAS, FcTrue); + xftfont = XftFontOpenPattern (display, pat); + /* We should not destroy PAT here because it is kept in XFTFONT and + destroyed automatically when XFTFONT is closed. */ + if (! xftfont) + return NULL; + + xftfont_info = malloc (sizeof (struct xftfont_info)); + if (! xftfont_info) + { + XftFontClose (display, xftfont); + return NULL; + } + xfont = malloc (sizeof (XFontStruct)); + if (! xftfont_info) + { + XftFontClose (display, xftfont); + free (xftfont_info); + return NULL; + } + xftfont_info->display = display; + xftfont_info->screen = FRAME_X_SCREEN_NUMBER (f); + xftfont_info->xftfont = xftfont; + xftfont_info->ft_face = XftLockFace (xftfont); + + font = (struct font *) xftfont_info; + font->entity = entity; + font->pixel_size = size; + font->driver = &xftfont_driver; + font->font.name = font->font.full_name = NULL; + font->file_name = (char *) file; + font->font.size = xftfont->max_advance_width; + font->ascent = xftfont->ascent; + font->descent = xftfont->descent; + font->font.height = xftfont->ascent + xftfont->descent; + + if (FcPatternGetInteger (xftfont->pattern, FC_SPACING, 0, &spacing) + != FcResultMatch) + spacing = FC_PROPORTIONAL; + if (spacing != FC_PROPORTIONAL) + font->font.average_width = font->font.space_width + = xftfont->max_advance_width; + else + { + XGlyphInfo extents; + + if (! ascii_printable[0]) + { + int i; + for (i = 0; i < 95; i++) + ascii_printable[i] = ' ' + i; + } + XftTextExtents8 (display, xftfont, ascii_printable, 1, &extents); + font->font.space_width = extents.xOff; + if (font->font.space_width <= 0) + /* dirty workaround */ + font->font.space_width = pixel_size; + XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents); + font->font.average_width = (font->font.space_width + extents.xOff) / 95; + } + + /* Unfortunately Xft doesn't provide a way to get minimum char + width. So, we use space_width instead. */ + font->min_width = font->font.space_width; + + font->font.baseline_offset = 0; + font->font.relative_compose = 0; + font->font.default_ascent = 0; + font->font.vertical_centering = 0; + + /* Setup pseudo XFontStruct */ + xfont->fid = xftfont_default_fid (f); + xfont->ascent = xftfont->ascent; + xfont->descent = xftfont->descent; + xfont->max_bounds.descent = xftfont->descent; + xfont->max_bounds.width = xftfont->max_advance_width; + xfont->min_bounds.width = font->font.space_width; + font->font.font = xfont; + + dpyinfo->n_fonts++; + + /* Set global flag fonts_changed_p to non-zero if the font loaded + has a character with a smaller width than any other character + before, or if the font loaded has a smaller height than any other + font loaded before. If this happens, it will make a glyph matrix + reallocation necessary. */ + if (dpyinfo->n_fonts == 1) + { + dpyinfo->smallest_font_height = font->font.height; + dpyinfo->smallest_char_width = font->min_width; + fonts_changed_p = 1; + } + else + { + if (dpyinfo->smallest_font_height > font->font.height) + dpyinfo->smallest_font_height = font->font.height, + fonts_changed_p |= 1; + if (dpyinfo->smallest_char_width > font->min_width) + dpyinfo->smallest_char_width = font->min_width, + fonts_changed_p |= 1; + } + + return font; +} + +static void +xftfont_close (f, font) + FRAME_PTR f; + struct font *font; +{ + struct xftfont_info *xftfont_info = (struct xftfont_info *) font; + + XftUnlockFace (xftfont_info->xftfont); + XftFontClose (xftfont_info->display, xftfont_info->xftfont); + free (font); + FRAME_X_DISPLAY_INFO (f)->n_fonts--; +} + +struct xftdraw_list +{ + XftDraw *xftdraw; + struct xftdraw_list *next; +}; + +static struct xftdraw_list *xftdraw_list; + +static void +register_xftdraw (xftdraw) + XftDraw *xftdraw; +{ + struct xftdraw_list *list = malloc (sizeof (struct xftdraw_list)); + + list->xftdraw = xftdraw; + list->next = xftdraw_list; + xftdraw_list = list; +} + +static void +check_xftdraw (xftdraw) + XftDraw *xftdraw; +{ + struct xftdraw_list *list, *prev; + + for (list = xftdraw_list, prev = NULL; list; prev = list, list = list->next) + { + if (list->xftdraw == xftdraw) + { + if (! prev) + { + list = xftdraw_list->next; + free (xftdraw_list); + xftdraw_list = list; + } + else + { + prev->next = list->next; + free (list); + list = prev; + } + return; + } + } + abort (); +} + +static int +xftfont_prepare_face (f, face) + FRAME_PTR f; + struct face *face; +{ + struct xftface_info *xftface_info = malloc (sizeof (struct xftface_info)); + + if (! xftface_info) + return -1; + + BLOCK_INPUT; + xftface_info->xft_draw = XftDrawCreate (FRAME_X_DISPLAY (f), + FRAME_X_WINDOW (f), + FRAME_X_VISUAL (f), + FRAME_X_COLORMAP (f)); + register_xftdraw (xftface_info->xft_draw); + + xftfont_get_colors (f, face, face->gc, NULL, + &xftface_info->xft_fg, &xftface_info->xft_bg); + UNBLOCK_INPUT; + + face->extra = xftface_info; + return 0; +} + +static void +xftfont_done_face (f, face) + FRAME_PTR f; + struct face *face; +{ + struct xftface_info *xftface_info = (struct xftface_info *) face->extra; + + if (xftface_info) + { + BLOCK_INPUT; + check_xftdraw (xftface_info->xft_draw); + XftDrawDestroy (xftface_info->xft_draw); + UNBLOCK_INPUT; + free (xftface_info); + face->extra = NULL; + } +} + +static unsigned +xftfont_encode_char (font, c) + struct font *font; + int c; +{ + struct xftfont_info *xftfont_info = (struct xftfont_info *) font; + unsigned code = XftCharIndex (xftfont_info->display, xftfont_info->xftfont, + (FcChar32) c); + + return (code ? code : 0xFFFFFFFF); +} + +static int +xftfont_text_extents (font, code, nglyphs, metrics) + struct font *font; + unsigned *code; + int nglyphs; + struct font_metrics *metrics; +{ + struct xftfont_info *xftfont_info = (struct xftfont_info *) font; + XGlyphInfo extents; + + BLOCK_INPUT; + XftGlyphExtents (xftfont_info->display, xftfont_info->xftfont, code, nglyphs, + &extents); + UNBLOCK_INPUT; + if (metrics) + { + metrics->lbearing = - extents.x; + metrics->rbearing = - extents.x + extents.width; + metrics->width = extents.xOff; + metrics->ascent = extents.y; + metrics->descent = extents.y - extents.height; + } + return extents.xOff; +} + +static int +xftfont_draw (s, from, to, x, y, with_background) + struct glyph_string *s; + int from, to, x, y, with_background; +{ + FRAME_PTR f = s->f; + struct face *face = s->face; + struct xftfont_info *xftfont_info = (struct xftfont_info *) face->font_info; + struct xftface_info *xftface_info = (struct xftface_info *) face->extra; + FT_UInt *code; + XftColor fg, bg; + XRectangle r; + int len = to - from; + int i; + + xftfont_get_colors (f, face, s->gc, xftface_info, + &fg, s->width ? &bg : NULL); + BLOCK_INPUT; + if (s->clip_width) + { + r.x = s->clip_x, r.width = s->clip_width; + r.y = s->clip_y, r.height = s->clip_height; + XftDrawSetClipRectangles (xftface_info->xft_draw, 0, 0, &r, 1); + } + if (with_background) + { + struct font *font = (struct font *) face->font_info; + + XftDrawRect (xftface_info->xft_draw, &bg, + x, y - face->font->ascent, s->width, font->font.height); + } + code = alloca (sizeof (FT_UInt) * len); + for (i = 0; i < len; i++) + code[i] = ((XCHAR2B_BYTE1 (s->char2b + from + i) << 8) + | XCHAR2B_BYTE2 (s->char2b + from + i)); + + XftDrawGlyphs (xftface_info->xft_draw, &fg, xftfont_info->xftfont, + x, y, code, len); + if (s->clip_width) + XftDrawSetClip (xftface_info->xft_draw, NULL); + UNBLOCK_INPUT; + + return len; +} + +static int +xftfont_anchor_point (font, code, index, x, y) + struct font *font; + unsigned code; + int index; + int *x, *y; +{ + struct xftfont_info *xftfont_info = (struct xftfont_info *) font; + FT_Face ft_face = xftfont_info->ft_face; + + if (FT_Load_Glyph (ft_face, code, FT_LOAD_DEFAULT) != 0) + return -1; + if (ft_face->glyph->format != FT_GLYPH_FORMAT_OUTLINE) + return -1; + if (index >= ft_face->glyph->outline.n_points) + return -1; + *x = ft_face->glyph->outline.points[index].x; + *y = ft_face->glyph->outline.points[index].y; + return 0; +} + + +void +syms_of_xftfont () +{ + DEFSYM (Qxft, "xft"); + + xftfont_driver = ftfont_driver; + xftfont_driver.type = Qxft; + xftfont_driver.get_cache = xfont_driver.get_cache; + xftfont_driver.list = xftfont_list; + xftfont_driver.open = xftfont_open; + xftfont_driver.close = xftfont_close; + xftfont_driver.prepare_face = xftfont_prepare_face; + xftfont_driver.done_face = xftfont_done_face; + xftfont_driver.encode_char = xftfont_encode_char; + xftfont_driver.text_extents = xftfont_text_extents; + xftfont_driver.draw = xftfont_draw; + xftfont_driver.anchor_point = xftfont_anchor_point; + + register_font_driver (&xftfont_driver, NULL); +}