|
3094
|
1 /* Lisp font handling implementation for X with Xft.
|
|
|
2
|
|
|
3 Copyright (C) 2003 Eric Knauel and Matthias Neubauer
|
|
|
4 Copyright (C) 2005 Eric Knauel
|
|
|
5 Copyright (C) 2004, 2005 Free Software Foundation, Inc.
|
|
|
6
|
|
|
7 Authors: Eric Knauel <knauel@informatik.uni-tuebingen.de>
|
|
|
8 Matthias Neubauer <neubauer@informatik.uni-freiburg.de>
|
|
|
9 Stephen J. Turnbull <stephen@xemacs.org>
|
|
|
10 Created: 27 Oct 2003
|
|
|
11 Updated: 05 Mar 2005 by Stephen J. Turnbull
|
|
|
12
|
|
|
13 This file is part of XEmacs.
|
|
|
14
|
|
|
15 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
16 under the terms of the GNU General Public License as published by the
|
|
|
17 Free Software Foundation; either version 2, or (at your option) any
|
|
|
18 later version.
|
|
|
19
|
|
|
20 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
21 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
22 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
23 for more details.
|
|
|
24
|
|
|
25 You should have received a copy of the GNU General Public License
|
|
|
26 along with XEmacs; see the file COPYING. If not, write to
|
|
|
27 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
28 Boston, MA 02111-1307, USA. */
|
|
|
29
|
|
|
30 /* Synched up with: Not in GNU Emacs. */
|
|
|
31
|
|
|
32 /* This module provides the Lisp interface to fonts in X11, including Xft,
|
|
|
33 but (at least at first) not GTK+ or Qt.
|
|
|
34
|
|
|
35 It should be renamed to fonts-x.h.
|
|
|
36
|
|
|
37 Sealevel code should be in ../lwlib/lwlib-fonts.c or
|
|
|
38 ../lwlib/lwlib-colors.c.
|
|
|
39 */
|
|
|
40
|
|
|
41 #include <config.h>
|
|
|
42 #include "lisp.h"
|
|
|
43 #include "device.h"
|
|
|
44 #include "device-impl.h"
|
|
|
45 #include "console-x-impl.h"
|
|
|
46 #include "objects-x.h"
|
|
|
47 #include "objects-x-impl.h"
|
|
|
48 #include "hash.h"
|
|
|
49 #include "xft-fonts.h"
|
|
|
50
|
|
|
51 /* #### TO DO ####
|
|
|
52 . The "x-xft-*" and "x_xft_*" nomenclature is mostly redundant, especially
|
|
|
53 if we separate X fonts from Xft fonts, and use fontconfig more generally.
|
|
|
54 . We should support the most recent Xft first, old Xft libraries later.
|
|
|
55 . We may (think about it) wish to use fontconfig generally, even if we're
|
|
|
56 not using Xft. Either way, names that are really from fontconfig should
|
|
|
57 use the Fc* namespace.
|
|
|
58 . Mule-ize this file.
|
|
|
59 . Separate X Font Struct ops from Xft Font ops; give precedence to Xft but
|
|
|
60 allow fallback to X.
|
|
|
61 . Push decisions about font choice, defaults, fallbacks to Lisp; if we
|
|
|
62 really need efficiency, can reimplement in C later.
|
|
|
63 . Implement symbols interned in this file in the Q* namespace.
|
|
|
64 . Implement FcMatrix (Lisp vector).
|
|
|
65 . Implement FcCharSets (Lisp chartable? For implementation hints, see
|
|
|
66 FcCharSetFirstPage and FcCharSetNextPage).
|
|
|
67 . Implement FcConfigs.
|
|
|
68 DONE
|
|
|
69 . Fontconfig fontnames are encoded in UTF-8.
|
|
|
70 */
|
|
|
71
|
|
|
72 Lisp_Object Qxft_font;
|
|
|
73 Lisp_Object Qfc_patternp;
|
|
|
74 Lisp_Object Qfc_fontsetp;
|
|
|
75 /* Lisp_Object Qfc_result_match; */ /* FcResultMatch */
|
|
|
76 Lisp_Object Qfc_result_type_mismatch; /* FcResultTypeMismatch */
|
|
|
77 Lisp_Object Qfc_result_no_match; /* FcResultNoMatch */
|
|
|
78 Lisp_Object Qfc_result_no_id; /* FcResultNoId */
|
|
|
79 Lisp_Object Qfc_internal_error;
|
|
|
80 Lisp_Object Vxlfd_font_name_regexp; /* #### Really needed? */
|
|
|
81 Lisp_Object Vxft_version;
|
|
|
82 /* Lisp_Object Vfc_version; */ /* #### Should have this, too! */
|
|
|
83 Fixnum debug_xft; /* Set to 1 enables lots of obnoxious messages.
|
|
|
84 Setting it to 2 or 3 enables even more. */
|
|
|
85
|
|
|
86 /****************************************************************
|
|
|
87 * FcPattern objects *
|
|
|
88 ****************************************************************/
|
|
|
89
|
|
|
90 static void
|
|
|
91 finalize_fc_pattern (void *header, int UNUSED (for_disksave))
|
|
|
92 {
|
|
|
93 struct fc_pattern *p = (struct fc_pattern *) header;
|
|
|
94 if (p->fcpatPtr)
|
|
|
95 {
|
|
|
96 FcPatternDestroy (p->fcpatPtr);
|
|
|
97 p->fcpatPtr = 0;
|
|
|
98 }
|
|
|
99 }
|
|
|
100
|
|
|
101 static const struct memory_description fcpattern_description [] = {
|
|
|
102 /* #### nothing here, is this right?? */
|
|
|
103 { XD_END }
|
|
|
104 };
|
|
|
105
|
|
|
106 DEFINE_LRECORD_IMPLEMENTATION("fc-pattern", fc_pattern,
|
|
|
107 0, 0, 0, finalize_fc_pattern, 0, 0,
|
|
|
108 fcpattern_description,
|
|
|
109 struct fc_pattern);
|
|
|
110
|
|
|
111 /*
|
|
|
112 * Helper Functions
|
|
|
113 */
|
|
|
114 static Lisp_Object make_xlfd_font_regexp (void);
|
|
|
115 static void string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os);
|
|
|
116
|
|
|
117 /*
|
|
|
118 extract the C representation of the Lisp string STR and convert it
|
|
|
119 to the encoding used by the Fontconfig API for property and font
|
|
|
120 names. I suppose that Qnative is the right encoding, the manual
|
|
|
121 doesn't say much about this topic. This functions assumes that STR
|
|
|
122 is a Lisp string.
|
|
|
123 */
|
|
|
124 #define extract_fcapi_string(str) \
|
|
|
125 ((FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((str), Qnative))
|
|
|
126
|
|
|
127 /* fontconfig assumes that objects (property names) are statically allocated,
|
|
|
128 and you will get bizarre results if you pass Lisp string data or strings
|
|
|
129 allocated on the stack as objects. fontconfig _does_ copy values, so we
|
|
|
130 (I hope) don't have to worry about that member.
|
|
|
131
|
|
|
132 Probably these functions don't get called so often that the memory leak
|
|
|
133 due to strdup'ing every time we add a property would matter, but XEmacs
|
|
|
134 _is_ a long-running process. So we hash them.
|
|
|
135
|
|
|
136 I suspect that using symbol names or even keywords does not provide
|
|
|
137 assurance that the string won't move in memory. So we hash them
|
|
|
138 ourselves; hash.c hashtables do not interpret the value pointers. */
|
|
|
139 static FcChar8 *fc_standard_properties[] = {
|
|
|
140 "antialias", "aspect", "autohint", "charset", "dpi", "family", "file",
|
|
|
141 "foundry", "ftface", "globaladvance", "hinting", "index", "lang",
|
|
|
142 "minspace", "outline", "pixelsize", "rasterizer", "rgba", "scalable",
|
|
|
143 "scale", "size", "slant", "spacing", "style", "verticallayout", "weight",
|
|
|
144 /* obsolete after Xft v. 1 */
|
|
|
145 "charwidth", "charheight", "core", "encoding", "render"
|
|
|
146 };
|
|
|
147
|
|
|
148 static struct hash_table *fc_property_name_hash_table;
|
|
|
149
|
|
|
150 /* #### Maybe fc_intern should be exposed to LISP? The idea is that
|
|
|
151 fc-pattern-add could warn or error if the property isn't interned. */
|
|
|
152
|
|
|
153 static FcChar8 *
|
|
|
154 fc_intern (Lisp_Object property)
|
|
|
155 {
|
|
|
156 const void *dummy;
|
|
|
157 FcChar8 *prop = extract_fcapi_string (property);
|
|
|
158 const void *val = gethash (prop, fc_property_name_hash_table, &dummy);
|
|
|
159
|
|
|
160 /* extract_fcapi_string returns something alloca'd
|
|
|
161 so we can just drop the old value of prop on the floor */
|
|
|
162 if (val)
|
|
|
163 prop = (FcChar8 *) val;
|
|
|
164 else
|
|
|
165 {
|
|
|
166 prop = FcStrCopy (prop);
|
|
|
167 puthash (prop, NULL, fc_property_name_hash_table);
|
|
|
168 }
|
|
|
169 return prop;
|
|
|
170 }
|
|
|
171
|
|
|
172 DEFUN("fc-pattern-p", Ffc_pattern_p, 1, 1, 0, /*
|
|
|
173 Returns t if OBJECT is of type fc-pattern, nil otherwise.
|
|
|
174 */
|
|
|
175 (object))
|
|
|
176 {
|
|
|
177 return FCPATTERNP(object) ? Qt : Qnil;
|
|
|
178 }
|
|
|
179
|
|
|
180 DEFUN("fc-pattern-create", Ffc_pattern_create, 0, 0, 0, /*
|
|
|
181 Return a new, empty fc-pattern object.
|
|
|
182 */
|
|
|
183 ())
|
|
|
184 {
|
|
|
185 fc_pattern *fcpat =
|
|
|
186 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
|
|
|
187
|
|
|
188 fcpat->fcpatPtr = FcPatternCreate();
|
|
|
189 return wrap_fcpattern(fcpat);
|
|
|
190 }
|
|
|
191
|
|
|
192 DEFUN("fc-name-parse", Ffc_name_parse, 1, 1, 0, /*
|
|
|
193 Parse an Fc font name and return its representation as a fc pattern object.
|
|
|
194 */
|
|
|
195 (name))
|
|
|
196 {
|
|
|
197 struct fc_pattern *fcpat =
|
|
|
198 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
|
|
|
199
|
|
|
200 CHECK_STRING(name); /* #### MEMORY LEAK!! maybe not ... */
|
|
|
201
|
|
|
202 fcpat->fcpatPtr = FcNameParse (extract_fcapi_string (name));
|
|
|
203 return wrap_fcpattern(fcpat);
|
|
|
204 }
|
|
|
205
|
|
|
206 /* #### Ga-a-ack! Xft's similar function is actually a different API.
|
|
|
207 We provide both. */
|
|
|
208 DEFUN("fc-name-unparse", Ffc_name_unparse, 1, 1, 0, /*
|
|
|
209 Unparse an fc pattern object to a string.
|
|
|
210 */
|
|
|
211 (pattern))
|
|
|
212 {
|
|
|
213 CHECK_FCPATTERN(pattern);
|
|
|
214 {
|
|
|
215 FcChar8 *temp = FcNameUnparse(XFCPATTERN_PTR(pattern));
|
|
|
216 Lisp_Object res = build_ext_string (temp, Qxft_font_name_encoding);
|
|
|
217 free (temp);
|
|
|
218 return res;
|
|
|
219 }
|
|
|
220 }
|
|
|
221
|
|
|
222 #if 0
|
|
|
223 /* #### This seems to not work? */
|
|
|
224 DEFUN("xft-name-unparse", Fxft_name_unparse, 1, 1, 0, /*
|
|
|
225 Unparse an fc pattern object to a string (using the Xft API).
|
|
|
226 */
|
|
|
227 (pattern))
|
|
|
228 {
|
|
|
229 char temp[FCSTRLEN];
|
|
|
230 Bool res;
|
|
|
231
|
|
|
232 CHECK_FCPATTERN(pattern);
|
|
|
233 res = XftNameUnparse(XFCPATTERN_PTR(pattern), temp, FCSTRLEN-1);
|
|
|
234 return res ? build_ext_string (temp, Qxft_font_name_encoding) : Qnil;
|
|
|
235 }
|
|
|
236 #endif
|
|
|
237
|
|
|
238 DEFUN("fc-pattern-duplicate", Ffc_pattern_duplicate, 1, 1, 0, /*
|
|
|
239 Make a copy of the fc pattern object PATTERN and return it.
|
|
|
240 */
|
|
|
241 (pattern))
|
|
|
242 {
|
|
|
243 struct fc_pattern *copy = NULL;
|
|
|
244 CHECK_FCPATTERN(pattern);
|
|
|
245
|
|
|
246 copy = ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
|
|
|
247 copy->fcpatPtr = FcPatternDuplicate(XFCPATTERN_PTR(pattern));
|
|
|
248 return wrap_fcpattern(copy);
|
|
|
249 }
|
|
|
250
|
|
|
251 DEFUN("fc-pattern-add", Ffc_pattern_add, 3, 3, 0, /*
|
|
|
252 Add attributes to the pattern object PATTERN. PROPERTY is a string naming
|
|
|
253 the attribute to add, VALUE the value for this attribute.
|
|
|
254
|
|
|
255 VALUE may be a string, integer, float, or symbol, in which case the value
|
|
|
256 will be added as an FcChar8[], int, double, or FcBool respectively.
|
|
|
257 */
|
|
|
258 (pattern, property, value))
|
|
|
259 {
|
|
|
260 Bool res = 0;
|
|
|
261 Extbyte *obj;
|
|
|
262 FcPattern *fcpat;
|
|
|
263
|
|
|
264 CHECK_FCPATTERN(pattern);
|
|
|
265 CHECK_STRING(property);
|
|
|
266
|
|
|
267 obj = fc_intern (property);
|
|
|
268 fcpat = XFCPATTERN_PTR (pattern);
|
|
|
269
|
|
|
270 if (STRINGP(value))
|
|
|
271 {
|
|
|
272 FcChar8 *str = (FcChar8 *) extract_fcapi_string (value);
|
|
|
273 res = FcPatternAddString (fcpat, obj, str);
|
|
|
274 }
|
|
|
275 else if (INTP(value))
|
|
|
276 {
|
|
|
277 res = FcPatternAddInteger (fcpat, obj, XINT(value));
|
|
|
278 }
|
|
|
279 else if (FLOATP(value))
|
|
|
280 {
|
|
|
281 res = FcPatternAddDouble (fcpat, obj, (double) XFLOAT_DATA(value));
|
|
|
282 }
|
|
|
283 else if (SYMBOLP(value))
|
|
|
284 {
|
|
|
285 res = FcPatternAddBool (fcpat, obj, !NILP(value));
|
|
|
286 }
|
|
|
287 /* else ... maybe we should wta here? */
|
|
|
288
|
|
|
289 return res ? Qt : Qnil;
|
|
|
290 }
|
|
|
291
|
|
|
292 DEFUN("fc-pattern-del", Ffc_pattern_del, 2, 2, 0, /*
|
|
|
293 Remove attribute PROPERTY from fc pattern object OBJECT.
|
|
|
294 */
|
|
|
295 (pattern, property))
|
|
|
296 {
|
|
|
297 Bool res;
|
|
|
298
|
|
|
299 CHECK_FCPATTERN(pattern);
|
|
|
300 CHECK_STRING(property);
|
|
|
301
|
|
|
302 res = FcPatternDel(XFCPATTERN_PTR(pattern),
|
|
|
303 extract_fcapi_string (property));
|
|
|
304 return res ? Qt : Qnil;
|
|
|
305 }
|
|
|
306
|
|
|
307 /* Generic interface to FcPatternGet()
|
|
|
308 * Don't support the losing symbol-for-property interface.
|
|
|
309 */
|
|
|
310 DEFUN("fc-pattern-get", Ffc_pattern_get, 2, 4, 0, /*
|
|
|
311 From PATTERN, extract PROPERTY for the ID'th member, of type TYPE.
|
|
|
312
|
|
|
313 PATTERN is an Xft (fontconfig) pattern object.
|
|
|
314 PROPERTY is a string naming an fontconfig font property.
|
|
|
315 Optional ID is a nonnegative integer indexing the list of values for PROPERTY
|
|
|
316 stored in PATTERN, defaulting to 0 (the first value).
|
|
|
317 Optional TYPE is a symbol, one of 'string, 'boolean, 'integer, 'float,
|
|
|
318 'double, 'matrix, 'charset, or 'void, corresponding to the FcValue types.
|
|
|
319 ('float is an alias for 'double).
|
|
|
320
|
|
|
321 The Lisp types returned will conform to TYPE:
|
|
|
322 string string
|
|
|
323 boolean `t' or `nil'
|
|
|
324 integer integer
|
|
|
325 double (float) float
|
|
|
326 matrix not implemented
|
|
|
327 charset not implemented
|
|
|
328 void not implemented
|
|
|
329
|
|
|
330 Symbols with names of the form "fc-result-DESCRIPTION" are returned when
|
|
|
331 the desired value is not available. These are
|
|
|
332
|
|
|
333 fc-result-type-mismatch the value found has an unexpected type
|
|
|
334 fc-result-no-match there is no such attribute
|
|
|
335 fc-result-no-id there is no value for the requested ID
|
|
|
336
|
|
|
337 The types of the following standard properties are predefined by fontconfig.
|
|
|
338 The symbol 'fc-result-type-mismatch will be returned if the object exists but
|
|
|
339 TYPE does not match the predefined type. It is best not to specify a type
|
|
|
340 for predefined properties, as a mistake here ensures error returns on the
|
|
|
341 correct type.
|
|
|
342
|
|
|
343 Each standard property has a convenience accessor defined in fontconfig.el,
|
|
|
344 named in the form "fc-pattern-get-PROPERTY". The convenience functions are
|
|
|
345 preferred to `fc-pattern-get' since a typo in the string naming a property
|
|
|
346 will result in a silent null return, while a typo in a function name will
|
|
|
347 usually result in a compiler or runtime \"not fboundp\" error. You may use
|
|
|
348 `defsubst' to define convenience functions for non-standard properties.
|
|
|
349
|
|
|
350 family String Font family name
|
|
|
351 style String Font style. Overrides weight and slant
|
|
|
352 slant Int Italic, oblique or roman
|
|
|
353 weight Int Light, medium, demibold, bold or black
|
|
|
354 size Double Point size
|
|
|
355 aspect Double Stretches glyphs horizontally before hinting
|
|
|
356 pixelsize Double Pixel size
|
|
|
357 spacing Int Proportional, monospace or charcell
|
|
|
358 foundry String Font foundry name
|
|
|
359 antialias Bool Whether glyphs can be antialiased
|
|
|
360 hinting Bool Whether the rasterizer should use hinting
|
|
|
361 verticallayout Bool Use vertical layout
|
|
|
362 autohint Bool Use autohinter instead of normal hinter
|
|
|
363 globaladvance Bool Use font global advance data
|
|
|
364 file String The filename holding the font
|
|
|
365 index Int The index of the font within the file
|
|
|
366 ftface FT_Face Use the specified FreeType face object
|
|
|
367 rasterizer String Which rasterizer is in use
|
|
|
368 outline Bool Whether the glyphs are outlines
|
|
|
369 scalable Bool Whether glyphs can be scaled
|
|
|
370 scale Double Scale factor for point->pixel conversions
|
|
|
371 dpi Double Target dots per inch
|
|
|
372 rgba Int unknown, rgb, bgr, vrgb, vbgr, none - subpixel geometry
|
|
|
373 minspace Bool Eliminate leading from line spacing
|
|
|
374 charset CharSet Unicode chars encoded by the font
|
|
|
375 lang String List of RFC-3066-style languages this font supports
|
|
|
376
|
|
|
377 The FT_Face, Matrix, CharSet types are unimplemented, so the corresponding
|
|
|
378 properties are not accessible from Lisp at this time. If the value of a
|
|
|
379 property returned has type FT_Face, FcCharSet, or FcMatrix,
|
|
|
380 `fc-result-type-mismatch' is returned.
|
|
|
381
|
|
|
382 The following properties which were standard in Xft v.1 are obsolete in
|
|
|
383 Xft v.2: encoding, charwidth, charheight, core, and render. */
|
|
|
384 (pattern, property, id, type))
|
|
|
385 {
|
|
|
386 FcChar8 *fc_property; /* UExtbyte * */
|
|
|
387 FcResult fc_result;
|
|
|
388 FcValue fc_value;
|
|
|
389
|
|
|
390 /*
|
|
|
391 process arguments
|
|
|
392 */
|
|
|
393 CHECK_FCPATTERN (pattern);
|
|
|
394
|
|
|
395 #if 0
|
|
|
396 /* Don't support the losing symbol-for-property interface. */
|
|
|
397 property = SYMBOLP (property) ? symbol_name (XSYMBOL (property)) : property;
|
|
|
398 #endif
|
|
|
399 if (STRINGP (property))
|
|
|
400 {
|
|
|
401 fc_property = (FcChar8 *) extract_fcapi_string (property);
|
|
|
402 }
|
|
|
403 else
|
|
|
404 {
|
|
|
405 /* if we allow symbols, this would need to be
|
|
|
406 list3 (Qlambda, list1 (Qobject),
|
|
|
407 list3 (Qor, list2 (Qstringp, Qobject),
|
|
|
408 list2 (Qsymbolp, Qobject)))
|
|
|
409 or something like that? */
|
|
|
410 dead_wrong_type_argument (Qstringp, property);
|
|
|
411 }
|
|
|
412
|
|
|
413 if (!NILP (id)) CHECK_NATNUM (id);
|
|
|
414 if (!NILP (type)) CHECK_SYMBOL (type);
|
|
|
415
|
|
|
416 /* get property */
|
|
|
417 fc_result = FcPatternGet (XFCPATTERN_PTR (pattern),
|
|
|
418 fc_property,
|
|
|
419 NILP (id) ? 0 : XINT(id),
|
|
|
420 &fc_value);
|
|
|
421
|
|
|
422 switch (fc_result)
|
|
|
423 {
|
|
|
424 case FcResultMatch:
|
|
|
425 /* wrap it and return */
|
|
|
426 switch (fc_value.type)
|
|
|
427 {
|
|
|
428 case FcTypeInteger:
|
|
|
429 return ((!NILP (type) && !EQ (type, Qinteger))
|
|
|
430 ? Qfc_result_type_mismatch : make_int (fc_value.u.i));
|
|
|
431 case FcTypeDouble:
|
|
|
432 return ((!NILP (type) && !EQ (type, intern ("double"))
|
|
|
433 && !EQ (type, Qfloat))
|
|
|
434 ? Qfc_result_type_mismatch : make_float (fc_value.u.d));
|
|
|
435 case FcTypeString:
|
|
|
436 return ((!NILP (type) && !EQ (type, Qstring))
|
|
|
437 ? Qfc_result_type_mismatch
|
|
|
438 : build_ext_string (fc_value.u.s, Qxft_font_name_encoding));
|
|
|
439 case FcTypeBool:
|
|
|
440 return ((!NILP (type) && !EQ (type, Qboolean))
|
|
|
441 ? Qfc_result_type_mismatch : fc_value.u.b ? Qt : Qnil);
|
|
|
442 case FcTypeMatrix:
|
|
|
443 return Qfc_result_type_mismatch;
|
|
|
444 /* #### unimplemented
|
|
|
445 return ((!NILP (type) && !EQ (type, intern ("matrix")))
|
|
|
446 ? Qfc_result_type_mismatch : make_int (fc_value.u.m));
|
|
|
447 */
|
|
|
448 case FcTypeCharSet:
|
|
|
449 return Qfc_result_type_mismatch;
|
|
|
450 /* #### unimplemented
|
|
|
451 return ((!NILP (type) && !EQ (type, intern ("charset")))
|
|
|
452 ? Qfc_result_type_mismatch : make_int (fc_value.u.c));
|
|
|
453 */
|
|
|
454 }
|
|
|
455 case FcResultTypeMismatch:
|
|
|
456 return Qfc_result_type_mismatch;
|
|
|
457 case FcResultNoMatch:
|
|
|
458 return Qfc_result_no_match;
|
|
|
459 case FcResultNoId:
|
|
|
460 return Qfc_result_no_id;
|
|
|
461 default:
|
|
|
462 return Qfc_internal_error;
|
|
|
463 }
|
|
|
464 }
|
|
|
465
|
|
|
466 DEFUN("fc-font-match", Ffc_font_match, 2, 2, 0, /*
|
|
|
467 Return the font on DEVICE that most closely matches PATTERN.
|
|
|
468
|
|
|
469 DEVICE is an X11 device.
|
|
|
470 PATTERN is a fontconfig pattern object.
|
|
|
471 Returns a fontconfig pattern object representing the closest match to the
|
|
|
472 given pattern, or an error code. Possible error codes are
|
|
|
473 `fc-result-no-match' and `fc-result-no-id'. */
|
|
|
474 (device, pattern))
|
|
|
475 {
|
|
|
476 Display *dpy;
|
|
|
477 FcResult res;
|
|
|
478
|
|
|
479 struct fc_pattern *res_fcpat =
|
|
|
480 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
|
|
|
481 CHECK_FCPATTERN(pattern); /* #### MEMORY LEAKS!!! */
|
|
|
482 if (NILP(device))
|
|
|
483 return Qnil;
|
|
|
484 CHECK_X_DEVICE(device);
|
|
|
485 if (!DEVICE_LIVE_P(XDEVICE(device)))
|
|
|
486 return Qnil;
|
|
|
487
|
|
|
488 dpy = DEVICE_X_DISPLAY(XDEVICE(device));
|
|
|
489 /* More Xft vs fontconfig brain damage? */
|
|
|
490 res_fcpat->fcpatPtr = XftFontMatch(dpy, DefaultScreen (dpy),
|
|
|
491 XFCPATTERN_PTR(pattern), &res);
|
|
|
492
|
|
|
493 if (res_fcpat->fcpatPtr == NULL)
|
|
|
494 switch (res) {
|
|
|
495 case FcResultNoMatch:
|
|
|
496 return Qfc_result_no_match;
|
|
|
497 case FcResultNoId:
|
|
|
498 return Qfc_result_no_id;
|
|
|
499 default:
|
|
|
500 return Qfc_internal_error;
|
|
|
501 }
|
|
|
502 else
|
|
|
503 return wrap_fcpattern(res_fcpat);
|
|
|
504 }
|
|
|
505
|
|
|
506 /* NOTE NOTE NOTE This function destroys the FcFontSet passed to it. */
|
|
|
507 static Lisp_Object
|
|
|
508 fontset_to_list (FcFontSet *fontset)
|
|
|
509 {
|
|
|
510 int idx;
|
|
|
511 Lisp_Object fontlist = Qnil;
|
|
|
512 fc_pattern *fcpat;
|
|
|
513
|
|
|
514 /* #### improve this error message */
|
|
|
515 if (!fontset)
|
|
|
516 Fsignal (Qinvalid_state,
|
|
|
517 list1 (build_string ("failed to create FcFontSet")));
|
|
|
518 for (idx = 0; idx < fontset->nfont; ++idx)
|
|
|
519 {
|
|
|
520 fcpat =
|
|
|
521 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
|
|
|
522 fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]);
|
|
|
523 fontlist = Fcons (wrap_fcpattern(fcpat), fontlist);
|
|
|
524 }
|
|
|
525 FcFontSetDestroy (fontset);
|
|
|
526 return fontlist;
|
|
|
527 }
|
|
|
528
|
|
|
529 /* #### fix this name to correspond to Ben's new nomenclature */
|
|
|
530 DEFUN("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects,
|
|
|
531 3, 3, 0, /*
|
|
|
532 Return a list of fonts on DEVICE that match PATTERN for PROPERTIES.
|
|
|
533 Each font is represented by a fontconfig pattern object.
|
|
|
534
|
|
|
535 DEVICE is an X11 device.
|
|
|
536 PATTERN is a fontconfig pattern to be matched.
|
|
|
537 PROPERTIES is a list of property names (strings) that should match.
|
|
|
538
|
|
|
539 #### DEVICE is unused, ignored, and may be removed if it's not needed to
|
|
|
540 match other font-listing APIs. */
|
|
|
541 (UNUSED (device), pattern, properties))
|
|
|
542 {
|
|
|
543 FcObjectSet *os;
|
|
|
544 FcFontSet *fontset;
|
|
|
545
|
|
|
546 CHECK_FCPATTERN (pattern);
|
|
|
547 CHECK_LIST (properties);
|
|
|
548
|
|
|
549 os = FcObjectSetCreate ();
|
|
|
550 string_list_to_fcobjectset (properties, os);
|
|
|
551 /* #### why don't we need to do the "usual substitutions"? */
|
|
|
552 fontset = FcFontList (NULL, XFCPATTERN_PTR (pattern), os);
|
|
|
553 FcObjectSetDestroy (os);
|
|
|
554
|
|
|
555 return fontset_to_list (fontset);
|
|
|
556
|
|
|
557 }
|
|
|
558
|
|
|
559 /* #### maybe this can/should be folded into fc-list-fonts-pattern-objects? */
|
|
|
560 DEFUN("fc-font-sort", Ffc_font_sort, 2, 4, 0, /*
|
|
|
561 Return a list of all fonts sorted by proximity to PATTERN.
|
|
|
562 Each font is represented by a fontconfig pattern object.
|
|
|
563
|
|
|
564 DEVICE is an X11 device.
|
|
|
565 PATTERN is a fontconfig pattern to be matched.
|
|
|
566 Optional argument TRIM, if non-nil, means to trim trailing fonts that do not
|
|
|
567 contribute new characters to the union repertoire.
|
|
|
568
|
|
|
569 #### Optional argument NOSUB, if non-nil, suppresses some of the usual
|
|
|
570 property substitutions. DON'T USE THIS in production code, it is intended
|
|
|
571 for exploring behavior of fontconfig and will be removed when this code is
|
|
|
572 stable.
|
|
|
573
|
|
|
574 #### DEVICE is unused, ignored, and may be removed if it's not needed to
|
|
|
575 match other font-listing APIs. */
|
|
|
576 (UNUSED (device), pattern, trim, nosub))
|
|
|
577 {
|
|
|
578 CHECK_FCPATTERN (pattern);
|
|
|
579
|
|
|
580 {
|
|
|
581 FcConfig *fcc = FcConfigGetCurrent();
|
|
|
582 FcFontSet *fontset;
|
|
|
583 FcPattern *p = XFCPATTERN_PTR (pattern);
|
|
|
584 FcResult fcresult;
|
|
|
585
|
|
|
586 if (NILP(nosub)) /* #### temporary debug hack */
|
|
|
587 FcDefaultSubstitute (p);
|
|
|
588 FcConfigSubstitute (fcc, p, FcMatchPattern);
|
|
|
589 fontset = FcFontSort (fcc, p, !NILP(trim), NULL, &fcresult);
|
|
|
590
|
|
|
591 return fontset_to_list (fontset);
|
|
|
592 }
|
|
|
593 }
|
|
|
594
|
|
|
595 /* #### this actually is an Xft function, should split those out
|
|
|
596 or get rid of them entirely? */
|
|
|
597 /* #### be consistent about argument order. */
|
|
|
598 DEFUN("fc-font-real-pattern", Ffc_font_real_pattern, 2, 2, 0, /*
|
|
|
599 Temporarily open FONTNAME (a string) and return the actual
|
|
|
600 fc pattern matched by the Fc library. */
|
|
|
601 (fontname, xdevice))
|
|
|
602 {
|
|
|
603 FcPattern *copy;
|
|
|
604 Display *dpy;
|
|
|
605 XftFont *font;
|
|
|
606 struct fc_pattern *fcpat =
|
|
|
607 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
|
|
|
608
|
|
|
609 CHECK_STRING (fontname); /* #### MEMORY LEAK?! maybe not ... */
|
|
|
610 if (NILP(xdevice))
|
|
|
611 return Qnil;
|
|
|
612 CHECK_X_DEVICE (xdevice);
|
|
|
613 if (!DEVICE_LIVE_P(XDEVICE(xdevice)))
|
|
|
614 return Qnil;
|
|
|
615
|
|
|
616 /* #### these gymnastics should be unnecessary, just use FcFontMatch */
|
|
|
617 dpy = DEVICE_X_DISPLAY (XDEVICE (xdevice));
|
|
|
618 font = XftFontOpenName (dpy, DefaultScreen(dpy),
|
|
|
619 extract_fcapi_string (fontname));
|
|
|
620 if (font == NULL)
|
|
|
621 return Qnil;
|
|
|
622 copy = FcPatternDuplicate(font->pattern);
|
|
|
623 XftFontClose(dpy, font);
|
|
|
624 if (copy == NULL)
|
|
|
625 return Qnil;
|
|
|
626 fcpat->fcpatPtr = copy;
|
|
|
627 return wrap_fcpattern(fcpat);
|
|
|
628 }
|
|
|
629
|
|
|
630 DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /*
|
|
|
631 Check whether the string FONTNAME is a XLFD font name. */
|
|
|
632 (fontname))
|
|
|
633 {
|
|
|
634 CHECK_STRING(fontname);
|
|
|
635 /* #### should bind `case-fold-search' here? */
|
|
|
636 return Fstring_match(Vxlfd_font_name_regexp, fontname, Qnil, Qnil);
|
|
|
637 }
|
|
|
638
|
|
|
639 /* FcPatternPrint: there is no point in having wrappers fc-pattern-print,
|
|
|
640 Ffc_pattern_print since this function prints to stdout. */
|
|
|
641
|
|
|
642 /* Initialization of xft-fonts */
|
|
|
643
|
|
|
644 #define XE_XLFD_SEPARATOR "-"
|
|
|
645 /* XLFD specifies ISO 8859-1 encoding, but we can't handle non-ASCII
|
|
|
646 in Mule when this function is called. So use HPC. */
|
|
|
647 #if 0
|
|
|
648 #define XE_XLFD_PREFIX "\\(\\+[\040-\176\240-\377]*\\)?-"
|
|
|
649 #define XE_XLFD_OPT_TEXT "\\([\040-\044\046-\176\240-\377]*\\)"
|
|
|
650 #define XE_XLFD_TEXT "\\([\040-\044\046-\176\240-\377]+\\)"
|
|
|
651 #else
|
|
|
652 #define XE_XLFD_PREFIX "\\(\\+[\040-\176]*\\)?-"
|
|
|
653 #define XE_XLFD_OPT_TEXT "\\([^-]*\\)"
|
|
|
654 #define XE_XLFD_TEXT "\\([^-]+\\)"
|
|
|
655 #endif
|
|
|
656
|
|
|
657 #define XE_XLFD_SLANT "\\([0-9ior?*][iot]?\\)"
|
|
|
658 #define XE_XLFD_SPACING "\\([cmp?*]\\)"
|
|
|
659 /* Hyphen as minus conflicts with use as separator. */
|
|
|
660 #define XE_XLFD_OPT_NEGATE "~?"
|
|
|
661 #define XE_XLFD_NUMBER "\\([0-9?*]+\\)"
|
|
|
662 #define XE_XLFD_PSIZE "\\([0-9?*]+\\|\\[[ 0-9+~.e?*]+\\]\\)"
|
|
|
663
|
|
|
664 /* Call this only from the init code
|
|
|
665 #### This is really horrible, let's get rid of it, please. */
|
|
|
666 static Lisp_Object
|
|
|
667 make_xlfd_font_regexp (void)
|
|
|
668 {
|
|
|
669 struct gcpro gcpro1;
|
|
|
670 unsigned i;
|
|
|
671 Lisp_Object reg = Qnil;
|
|
|
672 const Extbyte *re[] = /* #### This could just be catenated by
|
|
|
673 cpp and passed to build_ext_string. */
|
|
|
674 {
|
|
|
675 /* Regular expression matching XLFDs as defined by XLFD v. 1.5.
|
|
|
676 Matches must be case-insensitive.
|
|
|
677 PSIZE is a pixel or point size, which may be a "matrix". The
|
|
|
678 syntax of a matrix is not checked, just some lexical properties.
|
|
|
679 AFAICT none of the TEXT fields except adstyle is optional.
|
|
|
680
|
|
|
681 NB. It should not be a problem if this matches "too much", since
|
|
|
682 an "old" server will simply not be able to find a matching font. */
|
|
|
683 "\\`",
|
|
|
684 XE_XLFD_PREFIX, /* prefix */
|
|
|
685 XE_XLFD_TEXT, /* foundry */
|
|
|
686 XE_XLFD_SEPARATOR,
|
|
|
687 XE_XLFD_TEXT, /* family */
|
|
|
688 XE_XLFD_SEPARATOR,
|
|
|
689 XE_XLFD_TEXT, /* weight */
|
|
|
690 XE_XLFD_SEPARATOR,
|
|
|
691 XE_XLFD_SLANT, /* slant */
|
|
|
692 XE_XLFD_SEPARATOR,
|
|
|
693 XE_XLFD_TEXT, /* swidth */
|
|
|
694 XE_XLFD_SEPARATOR,
|
|
|
695 XE_XLFD_OPT_TEXT, /* adstyle */
|
|
|
696 XE_XLFD_SEPARATOR,
|
|
|
697 XE_XLFD_PSIZE, /* pixelsize */
|
|
|
698 XE_XLFD_SEPARATOR,
|
|
|
699 XE_XLFD_PSIZE, /* pointsize */
|
|
|
700 XE_XLFD_SEPARATOR,
|
|
|
701 XE_XLFD_NUMBER, /* resx */
|
|
|
702 XE_XLFD_SEPARATOR,
|
|
|
703 XE_XLFD_NUMBER, /* resy */
|
|
|
704 XE_XLFD_SEPARATOR,
|
|
|
705 XE_XLFD_SPACING, /* spacing */
|
|
|
706 XE_XLFD_SEPARATOR,
|
|
|
707 XE_XLFD_OPT_NEGATE, /* avgwidth */
|
|
|
708 XE_XLFD_NUMBER,
|
|
|
709 XE_XLFD_SEPARATOR,
|
|
|
710 XE_XLFD_TEXT, /* registry */
|
|
|
711 XE_XLFD_SEPARATOR,
|
|
|
712 XE_XLFD_TEXT, /* encoding */
|
|
|
713 "\\'"
|
|
|
714 };
|
|
|
715
|
|
|
716 GCPRO1 (reg);
|
|
|
717 for (i = 0; i < sizeof(re)/sizeof(Extbyte *); i++)
|
|
|
718 {
|
|
|
719 /* #### Currently this is Host Portable Coding, not ISO 8859-1. */
|
|
|
720 reg = concat2(reg, build_ext_string (re[i], Qx_font_name_encoding));
|
|
|
721 }
|
|
|
722
|
|
|
723 RETURN_UNGCPRO (reg);
|
|
|
724 }
|
|
|
725 #undef XE_XLFD_SEPARATOR
|
|
|
726 #undef XE_XLFD_PREFIX
|
|
|
727 #undef XE_XLFD_OPT_TEXT
|
|
|
728 #undef XE_XLFD_TEXT
|
|
|
729 #undef XE_XLFD_OPT_SLANT
|
|
|
730 #undef XE_XLFD_OPT_SPACING
|
|
|
731 #undef XE_XLFD_OPT_NEGATE
|
|
|
732 #undef XE_XLFD_NUMBER
|
|
|
733 #undef XE_XLFD_PSIZE
|
|
|
734
|
|
|
735 #define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \
|
|
|
736 ? ((unsigned long) (x)) : ((unsigned long) (y)))
|
|
|
737
|
|
|
738 static void
|
|
|
739 string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os)
|
|
|
740 {
|
|
|
741 EXTERNAL_LIST_LOOP_2 (elt, list)
|
|
|
742 {
|
|
|
743 FcChar8 *s;
|
|
|
744
|
|
|
745 CHECK_STRING (elt);
|
|
|
746 s = fc_intern (elt);
|
|
|
747 fprintf (stderr, "%s\n", s);
|
|
|
748 FcObjectSetAdd (os, s);
|
|
|
749 }
|
|
|
750 }
|
|
|
751
|
|
|
752 void
|
|
|
753 syms_of_xft_fonts (void)
|
|
|
754 {
|
|
|
755 INIT_LRECORD_IMPLEMENTATION(fc_pattern);
|
|
|
756
|
|
|
757 DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp);
|
|
|
758
|
|
|
759 DEFSYMBOL(Qfc_result_type_mismatch);
|
|
|
760 DEFSYMBOL(Qfc_result_no_match);
|
|
|
761 DEFSYMBOL(Qfc_result_no_id);
|
|
|
762 DEFSYMBOL(Qfc_internal_error);
|
|
|
763 DEFSYMBOL(Qxft_font);
|
|
|
764
|
|
|
765 DEFSUBR(Ffc_pattern_p);
|
|
|
766 DEFSUBR(Ffc_pattern_create);
|
|
|
767 DEFSUBR(Ffc_name_parse);
|
|
|
768 DEFSUBR(Ffc_name_unparse);
|
|
3097
|
769 #if 0
|
|
3094
|
770 DEFSUBR(Fxft_name_unparse); /* URK! */
|
|
3097
|
771 #endif
|
|
3094
|
772 DEFSUBR(Ffc_pattern_duplicate);
|
|
|
773 DEFSUBR(Ffc_pattern_add);
|
|
|
774 DEFSUBR(Ffc_pattern_del);
|
|
|
775 DEFSUBR(Ffc_pattern_get);
|
|
|
776 DEFSUBR(Ffc_list_fonts_pattern_objects);
|
|
|
777 DEFSUBR(Ffc_font_sort);
|
|
|
778 DEFSUBR(Ffc_font_match);
|
|
|
779 DEFSUBR(Ffc_font_real_pattern);
|
|
|
780 DEFSUBR(Fxlfd_font_name_p);
|
|
|
781 }
|
|
|
782
|
|
|
783 void
|
|
|
784 vars_of_xft_fonts (void)
|
|
|
785 {
|
|
|
786 /* #### I know, but the right fix is use the generic debug facility. */
|
|
|
787 DEFVAR_INT ("xft-debug-level", &debug_xft /*
|
|
|
788 Level of debugging messages to issue to stderr for Xft.
|
|
|
789 A nonnegative integer. Set to 0 to suppress all warnings.
|
|
|
790 Default is 1 to ensure a minimum of debugging output at initialization.
|
|
|
791 Higher levels give even more information.
|
|
|
792 */ );
|
|
|
793 debug_xft = 1;
|
|
|
794
|
|
|
795 DEFVAR_LISP("xft-version", &Vxft_version /*
|
|
|
796 The major version number of the Xft library being used.
|
|
|
797 */ );
|
|
|
798 Vxft_version = make_int(XFT_VERSION);
|
|
|
799
|
|
|
800 Fprovide (intern ("xft"));
|
|
|
801 }
|
|
|
802
|
|
|
803 void
|
|
|
804 complex_vars_of_xft_fonts (void)
|
|
|
805 {
|
|
|
806 DEFVAR_LISP("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /*
|
|
|
807 The regular expression used to match XLFD font names. */
|
|
|
808 );
|
|
|
809 Vxlfd_font_name_regexp = make_xlfd_font_regexp();
|
|
|
810 }
|
|
|
811
|
|
|
812 void
|
|
|
813 reinit_vars_of_xft_fonts (void)
|
|
|
814 {
|
|
|
815 int i, size = (int) countof (fc_standard_properties);
|
|
|
816
|
|
|
817 FcInit ();
|
|
|
818
|
|
|
819 fc_property_name_hash_table = make_string_hash_table (size);
|
|
|
820 for (i = 0; i < size; ++i)
|
|
|
821 puthash (fc_standard_properties[i], NULL, fc_property_name_hash_table);
|
|
|
822 }
|
|
|
823
|
