Mercurial > hg > xemacs-beta

comparison src/font-mgr.c @ 5118:e0db3c197671 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents 75975fd0b7fc
children 623d57b7fbe8
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
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-2009 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: 18 November 2009 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 Sealevel code should be in ../lwlib/lwlib-fonts.c or
36 ../lwlib/lwlib-colors.c.
37 */
38
39 #include <config.h>
40 #include "lisp.h"
41 #include "device.h"
42 #include "device-impl.h"
43 #include "console-x-impl.h"
44 #include "objects-x.h"
45 #include "objects-x-impl.h"
46 #include "hash.h"
47 #include "font-mgr.h"
48
49 /* #### TO DO ####
50 . The "x-xft-*" and "x_xft_*" nomenclature is mostly redundant, especially
51 if we separate X fonts from Xft fonts, and use fontconfig more generally.
52 . We should support the most recent Xft first, old Xft libraries later.
53 . We may (think about it) wish to use fontconfig generally, even if we're
54 not using Xft. Either way, names that are really from fontconfig should
55 use the Fc* namespace.
56 . Mule-ize this file.
57 . Separate X Font Struct ops from Xft Font ops; give precedence to Xft but
58 allow fallback to X.
59 . Push decisions about font choice, defaults, fallbacks to Lisp; if we
60 really need efficiency, can reimplement in C later.
61 . Implement symbols interned in this file in the Q* namespace.
62 . Implement FcMatrix (Lisp vector).
63 . Implement FcCharSets (Lisp chartable? For implementation hints, see
64 FcCharSetFirstPage and FcCharSetNextPage).
65 . Implement FcConfigs.
66 DONE
67 . Fontconfig fontnames are encoded in UTF-8.
68 */
69
70 Lisp_Object Qfont_mgr;
71 Lisp_Object Qfc_patternp;
72 /* Lisp_Object Qfc_result_match; */ /* FcResultMatch */
73 Lisp_Object Qfc_result_type_mismatch; /* FcResultTypeMismatch */
74 Lisp_Object Qfc_result_no_match; /* FcResultNoMatch */
75 Lisp_Object Qfc_result_no_id; /* FcResultNoId */
76 Lisp_Object Qfc_internal_error;
77 Lisp_Object Qfc_match_pattern;
78 Lisp_Object Qfc_match_font;
79 Lisp_Object Vxlfd_font_name_regexp; /* #### Really needed? */
80 Fixnum xft_version;
81 Fixnum fc_version;
82 Fixnum debug_xft; /* Set to 1 enables lots of obnoxious messages.
83 Setting it to 2 or 3 enables even more. */
84 #ifdef FONTCONFIG_EXPOSE_CONFIG
85 Lisp_Object Qfc_configp;
86 static Lisp_Object Vfc_config_weak_list;
87 #endif
88
89 /****************************************************************
90 * FcPattern objects *
91 ****************************************************************/
92
93 static void
94 finalize_fc_pattern (void *header, int UNUSED (for_disksave))
95 {
96 struct fc_pattern *p = (struct fc_pattern *) header;
97 if (p->fcpatPtr)
98 {
99 FcPatternDestroy (p->fcpatPtr);
100 p->fcpatPtr = 0;
101 }
102 }
103
104 static void
105 print_fc_pattern (Lisp_Object obj, Lisp_Object printcharfun,
106 int UNUSED(escapeflag))
107 {
108 struct fc_pattern *c = XFCPATTERN (obj);
109 if (print_readably)
110 printing_unreadable_object ("#<fc-pattern 0x%x>", c->header.uid);
111 write_fmt_string (printcharfun, "#<fc-pattern 0x%x>", c->header.uid);
112 }
113
114 /* #### We really need an equal method and a hash method (required if you
115 have an equal method). For the equal method, we can probably use one
116 or both of
117
118 -- Function: FcBool FcPatternEqual (const FcPattern *pa, const
119 FcPattern *pb);
120 Returns whether PA and PB are exactly alike.
121
122 -- Function: FcBool FcPatternEqualSubset (const FcPattern *pa, const
123 FcPattern *pb, const FcObjectSet *os)
124 Returns whether PA and PB have exactly the same values for all of
125 the objects in OS.
126
127 For the hash, we'll have to extract some subset of attributes.
128
129 #### Crap. It's altogether unobvious what we need. x_color_instance
130 does have a hash method, but fonts are apparently special. I get the
131 feeling that for this to work properly we're going to need to switch
132 to fontconfig-based font specifications (although we can allow the
133 platform syntaxes, the underlying specification object will need to
134 conform to the fontconfig API, or more precisely the font-mgr API).
135
136 I think the whole `font-truename' interface needs to be dropped. */
137
138 static const struct memory_description fcpattern_description [] = {
139 /* #### nothing here, is this right?? */
140 { XD_END }
141 };
142
143 DEFINE_NODUMP_LISP_OBJECT ("fc-pattern", fc_pattern,
144 0, print_fc_pattern, finalize_fc_pattern,
145 0, 0, fcpattern_description,
146 struct fc_pattern);
147
148 /*
149 * Helper Functions
150 */
151 static Lisp_Object make_xlfd_font_regexp (void);
152 static void string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os);
153
154 /*
155 extract the C representation of the Lisp string STR and convert it
156 to the encoding used by the Fontconfig API for property and font
157 names. I suppose that Qnative is the right encoding, the manual
158 doesn't say much about this topic. This functions assumes that STR
159 is a Lisp string.
160 */
161 #define extract_fcapi_string(str) \
162 (NEW_LISP_STRING_TO_EXTERNAL ((str), Qfc_font_name_encoding))
163
164 #define build_fcapi_string(str) \
165 (build_ext_string ((Extbyte *) (str), Qfc_font_name_encoding))
166
167 /* #### This homebrew lashup should be replaced with FcConstants.
168
169 fontconfig assumes that objects (property names) are statically allocated,
170 and you will get bizarre results if you pass Lisp string data or strings
171 allocated on the stack as objects. fontconfig _does_ copy values, so we
172 (I hope) don't have to worry about that member.
173
174 Probably these functions don't get called so often that the memory leak
175 due to strdup'ing every time we add a property would matter, but XEmacs
176 _is_ a long-running process. So we hash them.
177
178 I suspect that using symbol names or even keywords does not provide
179 assurance that the string won't move in memory. So we hash them
180 ourselves; hash.c hashtables do not interpret the value pointers.
181
182 This array should be FcChar8**, but GCC 4.x bitches about signedness. */
183 static Extbyte *fc_standard_properties[] = {
184 /* treated specially, ordered first */
185 "family", "size",
186 /* remaining are alphabetized by group */
187 /* standard properties in fontconfig and Xft v.2 */
188 "antialias", "aspect", "autohint", "charset", "dpi", "file",
189 "foundry", "ftface", "globaladvance", "hinting", "index", "lang",
190 "minspace", "outline", "pixelsize", "rasterizer", "rgba", "scalable",
191 "scale", "slant", "spacing", "style", "verticallayout", "weight",
192 /* common in modern fonts */
193 "fontformat", "fontversion",
194 /* obsolete after Xft v. 1 */
195 "charwidth", "charheight", "core", "encoding", "render"
196 };
197
198 static struct hash_table *fc_property_name_hash_table;
199
200 /* #### Maybe fc_intern should be exposed to LISP? The idea is that
201 fc-pattern-add could warn or error if the property isn't interned. */
202
203 static const Extbyte *
204 fc_intern (Lisp_Object property)
205 {
206 const void *dummy;
207 const Extbyte *prop = extract_fcapi_string (property);
208 const void *val = gethash (prop, fc_property_name_hash_table, &dummy);
209
210 /* extract_fcapi_string returns something alloca'd
211 so we can just drop the old value of prop on the floor */
212 if (val)
213 prop = (const Extbyte *) val;
214 else
215 {
216 prop = (const Extbyte *) FcStrCopy ((FcChar8 *) prop);
217 puthash (prop, NULL, fc_property_name_hash_table);
218 }
219 return prop;
220 }
221
222 DEFUN("fc-pattern-p", Ffc_pattern_p, 1, 1, 0, /*
223 Returns t if OBJECT is of type fc-pattern, nil otherwise.
224 */
225 (object))
226 {
227 return FCPATTERNP(object) ? Qt : Qnil;
228 }
229
230 DEFUN("fc-pattern-create", Ffc_pattern_create, 0, 0, 0, /*
231 Return a new, empty fc-pattern object.
232 */
233 ())
234 {
235 fc_pattern *fcpat = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern));
236
237 fcpat->fcpatPtr = FcPatternCreate ();
238 return wrap_fcpattern (fcpat);
239 }
240
241 DEFUN("fc-name-parse", Ffc_name_parse, 1, 1, 0, /*
242 Parse an Fc font name and return its representation as a fc pattern object.
243 */
244 (name))
245 {
246 fc_pattern *fcpat = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern));
247
248 CHECK_STRING (name);
249
250 fcpat->fcpatPtr = FcNameParse ((FcChar8 *) extract_fcapi_string (name));
251 return wrap_fcpattern (fcpat);
252 }
253
254 /* #### Ga-a-ack! Xft's similar function is actually a different API.
255 We provide both. */
256 DEFUN("fc-name-unparse", Ffc_name_unparse, 1, 1, 0, /*
257 Unparse an fc pattern object to a string.
258 */
259 (pattern))
260 {
261 CHECK_FCPATTERN(pattern);
262 return build_fcapi_string (FcNameUnparse (XFCPATTERN_PTR (pattern)));
263 }
264
265 DEFUN("fc-pattern-duplicate", Ffc_pattern_duplicate, 1, 1, 0, /*
266 Make a copy of the fc pattern object PATTERN and return it.
267 */
268 (pattern))
269 {
270 struct fc_pattern *copy = NULL;
271 CHECK_FCPATTERN (pattern);
272
273 copy = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern));
274 copy->fcpatPtr = FcPatternDuplicate (XFCPATTERN_PTR (pattern));
275 return wrap_fcpattern (copy);
276 }
277
278 DEFUN("fc-pattern-add", Ffc_pattern_add, 3, 3, 0, /*
279 Add attributes to the pattern object PATTERN. PROPERTY is a string naming
280 the attribute to add, VALUE the value for this attribute.
281
282 VALUE may be a string, integer, float, or symbol, in which case the value
283 will be added as an FcChar8[], int, double, or FcBool respectively.
284 */
285 (pattern, property, value))
286 {
287 Bool res = 0;
288 const Extbyte *obj;
289 FcPattern *fcpat;
290
291 CHECK_FCPATTERN (pattern);
292 CHECK_STRING (property);
293
294 obj = fc_intern (property);
295 fcpat = XFCPATTERN_PTR (pattern);
296
297 if (STRINGP(value))
298 {
299 FcChar8 *str = (FcChar8 *) extract_fcapi_string (value);
300 res = FcPatternAddString (fcpat, obj, str);
301 }
302 else if (INTP(value))
303 {
304 res = FcPatternAddInteger (fcpat, obj, XINT(value));
305 }
306 else if (FLOATP(value))
307 {
308 res = FcPatternAddDouble (fcpat, obj, (double) XFLOAT_DATA(value));
309 }
310 else if (SYMBOLP(value))
311 {
312 res = FcPatternAddBool (fcpat, obj, !NILP(value));
313 }
314 /* else ... maybe we should wta here? */
315
316 return res ? Qt : Qnil;
317 }
318
319 DEFUN("fc-pattern-del", Ffc_pattern_del, 2, 2, 0, /*
320 Remove attribute PROPERTY from fc pattern object OBJECT.
321 */
322 (pattern, property))
323 {
324 Bool res;
325
326 CHECK_FCPATTERN(pattern);
327 CHECK_STRING(property);
328
329 res = FcPatternDel(XFCPATTERN_PTR(pattern), extract_fcapi_string (property));
330 return res ? Qt : Qnil;
331 }
332
333 /* Generic interface to FcPatternGet()
334 * Don't support the losing symbol-for-property interface.
335 */
336 DEFUN("fc-pattern-get", Ffc_pattern_get, 2, 4, 0, /*
337 From PATTERN, extract PROPERTY for the ID'th member, of type TYPE.
338
339 PATTERN is an Xft (fontconfig) pattern object.
340 PROPERTY is a string naming an fontconfig font property.
341 Optional ID is a nonnegative integer indexing the list of values for PROPERTY
342 stored in PATTERN, defaulting to 0 (the first value).
343 Optional TYPE is a symbol, one of 'string, 'boolean, 'integer, 'float,
344 'double, 'matrix, 'charset, or 'void, corresponding to the FcValue types.
345 ('float is an alias for 'double).
346
347 The Lisp types returned will conform to TYPE:
348 string string
349 boolean `t' or `nil'
350 integer integer
351 double (float) float
352 matrix not implemented
353 charset not implemented
354 void not implemented
355
356 Symbols with names of the form "fc-result-DESCRIPTION" are returned when
357 the desired value is not available. These are
358
359 fc-result-type-mismatch the value found has an unexpected type
360 fc-result-no-match there is no such attribute
361 fc-result-no-id there is no value for the requested ID
362
363 The types of the following standard properties are predefined by fontconfig.
364 The symbol 'fc-result-type-mismatch will be returned if the object exists but
365 TYPE does not match the predefined type. It is best not to specify a type
366 for predefined properties, as a mistake here ensures error returns on the
367 correct type.
368
369 Each standard property has a convenience accessor defined in fontconfig.el,
370 named in the form "fc-pattern-get-PROPERTY". The convenience functions are
371 preferred to `fc-pattern-get' since a typo in the string naming a property
372 will result in a silent null return, while a typo in a function name will
373 usually result in a compiler or runtime \"not fboundp\" error. You may use
374 `defsubst' to define convenience functions for non-standard properties.
375
376 family String Font family name
377 style String Font style. Overrides weight and slant
378 slant Int Italic, oblique or roman
379 weight Int Light, medium, demibold, bold or black
380 size Double Point size
381 aspect Double Stretches glyphs horizontally before hinting
382 pixelsize Double Pixel size
383 spacing Int Proportional, monospace or charcell
384 foundry String Font foundry name
385 antialias Bool Whether glyphs can be antialiased
386 hinting Bool Whether the rasterizer should use hinting
387 verticallayout Bool Use vertical layout
388 autohint Bool Use autohinter instead of normal hinter
389 globaladvance Bool Use font global advance data
390 file String The filename holding the font
391 index Int The index of the font within the file
392 ftface FT_Face Use the specified FreeType face object
393 rasterizer String Which rasterizer is in use
394 outline Bool Whether the glyphs are outlines
395 scalable Bool Whether glyphs can be scaled
396 scale Double Scale factor for point->pixel conversions
397 dpi Double Target dots per inch
398 rgba Int unknown, rgb, bgr, vrgb, vbgr, none - subpixel geometry
399 minspace Bool Eliminate leading from line spacing
400 charset CharSet Unicode chars encoded by the font
401 lang String List of RFC-3066-style languages this font supports
402
403 The FT_Face, Matrix, CharSet types are unimplemented, so the corresponding
404 properties are not accessible from Lisp at this time. If the value of a
405 property returned has type FT_Face, FcCharSet, or FcMatrix,
406 `fc-result-type-mismatch' is returned.
407
408 The following properties which were standard in Xft v.1 are obsolete in
409 Xft v.2: encoding, charwidth, charheight, core, and render. */
410 (pattern, property, id, type))
411 {
412 Extbyte *fc_property;
413 FcResult fc_result;
414 FcValue fc_value;
415
416 /*
417 process arguments
418 */
419 CHECK_FCPATTERN (pattern);
420
421 #if 0
422 /* Don't support the losing symbol-for-property interface. */
423 property = SYMBOLP (property) ? symbol_name (XSYMBOL (property)) : property;
424 #endif
425 if (STRINGP (property))
426 {
427 fc_property = extract_fcapi_string (property);
428 }
429 else
430 {
431 /* if we allow symbols, this would need to be
432 list3 (Qlambda, list1 (Qobject),
433 list3 (Qor, list2 (Qstringp, Qobject),
434 list2 (Qsymbolp, Qobject)))
435 or something like that? */
436 dead_wrong_type_argument (Qstringp, property);
437 }
438
439 if (!NILP (id)) CHECK_NATNUM (id);
440 if (!NILP (type)) CHECK_SYMBOL (type);
441
442 /* get property */
443 fc_result = FcPatternGet (XFCPATTERN_PTR (pattern),
444 fc_property,
445 NILP (id) ? 0 : XINT(id),
446 &fc_value);
447
448 switch (fc_result)
449 {
450 case FcResultMatch:
451 /* wrap it and return */
452 switch (fc_value.type)
453 {
454 case FcTypeInteger:
455 return ((!NILP (type) && !EQ (type, Qinteger))
456 ? Qfc_result_type_mismatch : make_int (fc_value.u.i));
457 case FcTypeDouble:
458 return ((!NILP (type) && !EQ (type, intern ("double"))
459 && !EQ (type, Qfloat))
460 ? Qfc_result_type_mismatch : make_float (fc_value.u.d));
461 case FcTypeString:
462 return ((!NILP (type) && !EQ (type, Qstring))
463 ? Qfc_result_type_mismatch
464 : build_fcapi_string (fc_value.u.s));
465 case FcTypeBool:
466 return ((!NILP (type) && !EQ (type, Qboolean))
467 ? Qfc_result_type_mismatch : fc_value.u.b ? Qt : Qnil);
468 case FcTypeMatrix:
469 return Qfc_result_type_mismatch;
470 /* #### unimplemented
471 return ((!NILP (type) && !EQ (type, intern ("matrix")))
472 ? Qfc_result_type_mismatch : make_int (fc_value.u.m));
473 */
474 case FcTypeCharSet:
475 return Qfc_result_type_mismatch;
476 /* #### unimplemented
477 return ((!NILP (type) && !EQ (type, intern ("charset")))
478 ? Qfc_result_type_mismatch : make_int (fc_value.u.c));
479 */
480 }
481 case FcResultTypeMismatch:
482 return Qfc_result_type_mismatch;
483 case FcResultNoMatch:
484 return Qfc_result_no_match;
485 case FcResultNoId:
486 return Qfc_result_no_id;
487 default:
488 return Qfc_internal_error;
489 }
490 }
491
492 /* FcConfig handling functions. */
493
494 /* We obviously need to be careful about garbage collecting the current
495 FcConfig. I infer from the documentation of FcConfigDestroy that that
496 is the only reference maintained by fontconfig.
497 So we keep track of our own references on a weak list, and only cons a
498 new object if we don't already have a reference to it there. */
499
500 enum DestroyFontsetP { DestroyNo = 0, DestroyYes = 1 };
501
502 static Lisp_Object
503 fc_config_create_using (FcConfig * (*create_function) ())
504 {
505 FcConfig *fc = (*create_function) ();
506 Lisp_Object configs = XWEAK_LIST_LIST (Vfc_config_weak_list);
507
508 /* Linear search: fc_configs are not going to multiply like conses. */
509 {
510 LIST_LOOP_2 (cfg, configs)
511 if (fc == XFCCONFIG_PTR (cfg))
512 return cfg;
513 }
514
515 {
516 fc_config *fccfg = XFCCONFIG (ALLOC_LISP_OBJECT (fc_config));
517 fccfg->fccfgPtr = fc;
518 configs = Fcons (wrap_fcconfig (fccfg), configs);
519 XWEAK_LIST_LIST (Vfc_config_weak_list) = configs;
520 return wrap_fcconfig (fccfg);
521 }
522 }
523
524 static Lisp_Object
525 fc_strlist_to_lisp_using (FcStrList * (*getter) (FcConfig *),
526 Lisp_Object config)
527 {
528 FcChar8 *thing;
529 Lisp_Object value = Qnil;
530 FcStrList *thing_list;
531
532 CHECK_FCCONFIG (config);
533 thing_list = (*getter) (XFCCONFIG_PTR(config));
534 /* Yes, we need to do this check -- sheesh, Keith! */
535 if (!thing_list)
536 return Qnil;
537 while ((thing = FcStrListNext (thing_list)))
538 value = Fcons (build_fcapi_string (thing), value);
539 FcStrListDone (thing_list);
540 return value;
541 }
542
543 static Lisp_Object
544 fontset_to_list (FcFontSet *fontset, enum DestroyFontsetP destroyp)
545 {
546 int idx;
547 Lisp_Object fontlist = Qnil;
548 fc_pattern *fcpat;
549
550 /* #### improve this error message */
551 if (!fontset)
552 Fsignal (Qinvalid_state,
553 list1 (build_string ("failed to create FcFontSet")));
554 for (idx = 0; idx < fontset->nfont; ++idx)
555 {
556 fcpat = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern));
557 fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]);
558 fontlist = Fcons (wrap_fcpattern(fcpat), fontlist);
559 }
560 if (destroyp)
561 FcFontSetDestroy (fontset);
562 return fontlist;
563 }
564
565 DEFUN("fc-config-p", Ffc_config_p, 1, 1, 0, /*
566 Returns t if OBJECT is of type fc-config, nil otherwise.
567 */
568 (object))
569 {
570 return FCCONFIGP (object) ? Qt : Qnil;
571 }
572
573 DEFUN("fc-config-create", Ffc_config_create, 0, 0, 0, /*
574 -- Function: FcConfig *FcConfigCreate (void)
575 Creates an empty configuration. */
576 ())
577 {
578 return fc_config_create_using (&FcConfigCreate);
579 }
580
581 #if 0
582 /* I'm sorry, but we just don't do this in Lisp, OK?
583 Don't even think about implementing this. */
584 DEFUN("fc-config-destroy", Ffc_config_destroy, 1, 1, 0, /*
585 -- Function: void FcConfigDestroy (FcConfig *config)
586 Destroys a configuration and any data associated with it. Note
587 that calling this function with the return value from
588 FcConfigGetCurrent will place the library in an indeterminate
589 state. */
590 (config))
591 {
592 signal_error (Qunimplemented, "No user-servicable parts!",
593 intern ("fc-config-destroy"));
594 }
595 #endif
596
597 DEFUN("fc-config-up-to-date", Ffc_config_up_to_date, 1, 1, 0, /*
598 -- Function: FcBool FcConfigUptoDate (FcConfig *config)
599 Checks all of the files related to 'config' and returns whether the
600 in-memory version is in sync with the disk version. */
601 (config))
602 {
603 CHECK_FCCONFIG (config);
604 return FcConfigUptoDate (XFCCONFIG_PTR (config)) == FcFalse ? Qnil : Qt;
605 }
606
607 DEFUN("fc-config-build-fonts", Ffc_config_build_fonts, 1, 1, 0, /*
608 -- Function: FcBool FcConfigBuildFonts (FcConfig *config)
609 Builds the set of available fonts for the given configuration.
610 Note that any changes to the configuration after this call have
611 indeterminate effects. Returns FcFalse if this operation runs out
612 of memory.
613 XEmacs: signal out-of-memory, or return nil on success. */
614 (config))
615 {
616 CHECK_FCCONFIG (config);
617 if (FcConfigBuildFonts (XFCCONFIG_PTR (config)) == FcFalse)
618 out_of_memory ("FcConfigBuildFonts failed", config);
619 return Qnil;
620 }
621
622 DEFUN("fc-config-get-config-dirs", Ffc_config_get_config_dirs, 1, 1, 0, /*
623 -- Function: FcStrList *FcConfigGetConfigDirs (FcConfig *config)
624 Returns the list of font directories specified in the
625 configuration files for 'config'. Does not include any
626 subdirectories. */
627 (config))
628 {
629 return fc_strlist_to_lisp_using (&FcConfigGetConfigDirs, config);
630 }
631
632 DEFUN("fc-config-get-font-dirs", Ffc_config_get_font_dirs, 1, 1, 0, /*
633 -- Function: FcStrList *FcConfigGetFontDirs (FcConfig *config)
634 Returns the list of font directories in 'config'. This includes the
635 configured font directories along with any directories below those
636 in the filesystem. */
637 (config))
638 {
639 return fc_strlist_to_lisp_using (&FcConfigGetFontDirs, config);
640 }
641
642 DEFUN("fc-config-get-config-files", Ffc_config_get_config_files, 1, 1, 0, /*
643 -- Function: FcStrList *FcConfigGetConfigFiles (FcConfig *config)
644 Returns the list of known configuration files used to generate
645 'config'. Note that this will not include any configuration done
646 with FcConfigParse. */
647 (config))
648 {
649 return fc_strlist_to_lisp_using (&FcConfigGetConfigFiles, config);
650 }
651
652 DEFUN("fc-config-get-cache", Ffc_config_get_cache, 1, 1, 0, /*
653 -- Function: char *FcConfigGetCache (FcConfig *config)
654 Returns the name of the file used to store per-user font
655 information. */
656 (config))
657 {
658 CHECK_FCCONFIG (config);
659 /* Surely FcConfigGetCache just casts an FcChar8* to char*. */
660 return build_fcapi_string ((FcChar8 *) FcConfigGetCache (XFCCONFIG_PTR (config)));
661 }
662
663 DEFUN("fc-config-get-fonts", Ffc_config_get_fonts, 2, 2, 0, /*
664 -- Function: FcFontSet *FcConfigGetFonts (FcConfig *config, FcSetName set)
665 Returns one of the two sets of fonts from the configuration as
666 specified by 'set'.
667 `FcSetName'
668 Specifies one of the two sets of fonts available in a
669 configuration; FcSetSystem for those fonts specified in the
670 configuration and FcSetApplication which holds fonts provided by
671 the application. */
672 (config, set))
673 {
674 FcSetName name = FcSetSystem;
675 FcFontSet *fs = NULL;
676
677 CHECK_FCCONFIG (config);
678 CHECK_SYMBOL (set);
679
680 if (EQ (set, intern ("fc-set-system")))
681 name = FcSetSystem;
682 else if (EQ (set, intern ("fc-set-application")))
683 name = FcSetApplication;
684 else
685 wtaerror ("must be in (fc-set-system fc-set-application)", set);
686
687 fs = FcConfigGetFonts (XFCCONFIG_PTR (config), name);
688 return fs ? fontset_to_list (fs, DestroyNo) : Qnil;
689 }
690
691 DEFUN("fc-config-set-current", Ffc_config_set_current, 1, 1, 0, /*
692 -- Function: FcBool FcConfigSetCurrent (FcConfig *config)
693 Sets the current default configuration to 'config'. Implicitly
694 calls FcConfigBuildFonts if necessary, returning FcFalse if that
695 call fails.
696 XEmacs: signals out-of-memory if FcConfigBuildFonts fails, or args-out-of-range
697 if the resulting FcConfig has no fonts (which would crash XEmacs if installed).
698 */
699 (config))
700 {
701 CHECK_FCCONFIG (config);
702 /* *sigh* "Success" DOES NOT mean you have any fonts available. It is
703 easy to crash fontconfig, and XEmacs with it. Without the following
704 check, this will do it:
705 (progn
706 (fc-config-set-current (fc-config-create))
707 (set-face-font 'default "serif-12"))
708 */
709
710 if (FcConfigBuildFonts (XFCCONFIG_PTR (config)) == FcFalse)
711 out_of_memory ("FcConfigBuildFonts failed", config);
712 /* #### We'd like to avoid this consing, and FcConfigGetFonts sometimes
713 returns NULL, but it doesn't always. This will do for now .... */
714 if (NILP (Ffc_config_get_fonts (config, intern ("fc-set-system")))
715 && NILP (Ffc_config_get_fonts (config, intern ("fc-set-application"))))
716 signal_error (intern ("args-out-of-range"), "no fonts found", config);
717 /* Should never happen, but I don't trust Keith anymore .... */
718 if (FcConfigSetCurrent (XFCCONFIG_PTR (config)) == FcFalse)
719 out_of_memory ("FcConfigBuildFonts failed in set", config);
720 return Qnil;
721 }
722
723 DEFUN("fc-config-get-blanks", Ffc_config_get_blanks, 1, 1, 0, /*
724 -- Function: FcBlanks *FcConfigGetBlanks (FcConfig *config)
725 Returns the FcBlanks object associated with the given
726 configuration, if no blanks were present in the configuration,
727 this function will return 0.
728 XEmacs: should convert to a chartable.
729 #### Unimplemented. */
730 (config))
731 {
732 CHECK_FCCONFIG (config);
733 signal_error (Qunimplemented, "no method to convert FcBlanks object",
734 intern ("fc-config-get-blanks"));
735 }
736
737 DEFUN("fc-config-get-rescan-interval", Ffc_config_get_rescan_interval, 1, 1, 0, /*
738 -- Function: int FcConfigGetRescanInterval (FcConfig *config)
739 Returns the interval between automatic checks of the configuration
740 (in seconds) specified in 'config'. The configuration is checked
741 during a call to FcFontList when this interval has passed since
742 the last check. */
743 (config))
744 {
745 CHECK_FCCONFIG (config);
746 return make_int (FcConfigGetRescanInterval (XFCCONFIG_PTR (config)));
747 }
748
749 DEFUN("fc-config-set-rescan-interval", Ffc_config_set_rescan_interval, 2, 2, 0, /*
750 -- Function: FcBool FcConfigSetRescanInterval (FcConfig *config, int
751 rescanInterval)
752 Sets the rescan interval; returns FcFalse if an error occurred.
753 XEmacs: signal such error, or return nil on success. */
754 (config, rescan_interval))
755 {
756 CHECK_FCCONFIG (config);
757 CHECK_INT (rescan_interval);
758 if (FcConfigSetRescanInterval (XFCCONFIG_PTR (config),
759 XINT (rescan_interval)) == FcFalse)
760 signal_error (Qio_error, "FcConfigSetRescanInverval barfed",
761 intern ("fc-config-set-rescan-interval"));
762 return Qnil;
763 }
764
765 /* #### This might usefully be made interactive. */
766 DEFUN("fc-config-app-font-add-file", Ffc_config_app_font_add_file, 2, 2, 0, /*
767 -- Function: FcBool FcConfigAppFontAddFile (FcConfig *config, const
768 char *file)
769 Adds an application-specific font to the configuration. */
770 (config, file))
771 {
772 CHECK_FCCONFIG (config);
773 CHECK_STRING (file);
774 if (FcConfigAppFontAddFile
775 (XFCCONFIG_PTR (config),
776 /* #### FIXME! is this really Qnative? */
777 (FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((file), Qnative)) == FcFalse)
778 return Qnil;
779 else
780 return Qt;
781 }
782
783 /* #### This might usefully be made interactive. */
784 DEFUN("fc-config-app-font-add-dir", Ffc_config_app_font_add_dir, 2, 2, 0, /*
785 -- Function: FcBool FcConfigAppFontAddDir (FcConfig *config, const
786 char *dir)
787 Scans the specified directory for fonts, adding each one found to
788 the application-specific set of fonts. */
789 (config, dir))
790 {
791 CHECK_FCCONFIG (config);
792 CHECK_STRING (dir);
793 if (FcConfigAppFontAddDir
794 (XFCCONFIG_PTR (config),
795 /* #### FIXME! is this really Qnative? */
796 (FcChar8 *) NEW_LISP_STRING_TO_EXTERNAL ((dir), Qnative)) == FcFalse)
797 return Qnil;
798 else
799 return Qt;
800 }
801
802 /* #### This might usefully be made interactive. */
803 DEFUN("fc-config-app-font-clear", Ffc_config_app_font_clear, 1, 1, 0, /*
804 -- Function: void FcConfigAppFontClear (FcConfig *config)
805 Clears the set of application-specific fonts. */
806 (config))
807 {
808 CHECK_FCCONFIG (config);
809 FcConfigAppFontClear (XFCCONFIG_PTR (config));
810 return Qnil;
811 }
812
813 /* These functions provide some control over how the default
814 configuration of the library is initialized. (This configuration is
815 normally implicitly initialized.) */
816
817 DEFUN("fc-config-filename", Ffc_config_filename, 1, 1, 0, /*
818 -- Function: char *FcConfigFilename (const char *name)
819 Given the specified external entity name, return the associated
820 filename. This provides applications a way to convert various
821 configuration file references into filename form.
822
823 A null or empty 'name' indicates that the default configuration
824 file should be used; which file this references can be overridden
825 with the FC_CONFIG_FILE environment variable. Next, if the name
826 starts with '~', it refers to a file in the current users home
827 directory. Otherwise if the name doesn't start with '/', it
828 refers to a file in the default configuration directory; the
829 built-in default directory can be overridden with the
830 FC_CONFIG_DIR environment variable. */
831 (name))
832 {
833 char *fcname = "";
834
835 if (!NILP (name))
836 {
837 CHECK_STRING (name);
838 /* #### FIXME! is this really Qnative? */
839 fcname = NEW_LISP_STRING_TO_EXTERNAL (name, Qnative);
840 }
841 return (build_fcapi_string (FcConfigFilename ((FcChar8 *) fcname)));
842 }
843
844 DEFUN("fc-init-load-config", Ffc_init_load_config, 0, 0, 0, /*
845 -- Function: FcConfig *FcInitLoadConfig (void)
846 Loads the default configuration file and returns the resulting
847 configuration. Does not load any font information. */
848 ())
849 {
850 return fc_config_create_using (&FcInitLoadConfig);
851 }
852
853 DEFUN("fc-init-load-config-and-fonts", Ffc_init_load_config_and_fonts, 0, 0, 0, /*
854 -- Function: FcConfig *FcInitLoadConfigAndFonts (void)
855 Loads the default configuration file and builds information about
856 the available fonts. Returns the resulting configuration. */
857 ())
858 {
859 return fc_config_create_using (&FcInitLoadConfigAndFonts);
860 }
861
862 DEFUN("fc-config-get-current", Ffc_config_get_current, 0, 0, 0, /*
863 -- Function: FcConfig *FcConfigGetCurrent (void)
864 Returns the current default configuration. */
865 ())
866 {
867 return fc_config_create_using (&FcConfigGetCurrent);
868 }
869
870 /* Pattern manipulation functions. */
871
872 DEFUN("fc-default-substitute", Ffc_default_substitute, 1, 1, 0, /*
873 Adds defaults for certain attributes if not specified in PATTERN.
874 FcPattern PATTERN is modified in-place, and nil is returned.
875 * Patterns without a specified style or weight are set to Medium
876 * Patterns without a specified style or slant are set to Roman
877 * Patterns without a specified pixel size are given one computed from any
878 specified point size (default 12), dpi (default 75) and scale (default 1). */
879 (pattern))
880 {
881 CHECK_FCPATTERN (pattern);
882 FcDefaultSubstitute (XFCPATTERN_PTR (pattern));
883 return Qnil;
884 }
885
886 /* -- Function: FcBool FcConfigSubstituteWithPat (FcConfig *config,
887 FcPattern *p, FcPattern *p_pat FcMatchKind kind)
888 OMITTED: use optional arguments in `fc-config-substitute'. */
889
890 DEFUN("fc-config-substitute", Ffc_config_substitute, 1, 4, 0, /*
891 Modifies PATTERN according to KIND and TESTPAT using operations from CONFIG.
892 PATTERN is modified in-place. Returns an undocumented Boolean value.
893 If optional KIND is `fc-match-pattern', then those tagged as pattern operations
894 are applied, else if KIND is `fc-match-font', those tagged as font operations
895 are applied and TESTPAT is used for <test> elements with target=pattern. KIND
896 defaults to `fc-match-font'.
897 If optional TESTPAT is nil, it is ignored. Otherwise it must be an FcPattern.
898 Optional CONFIG must be an FcConfig, defaulting to the current one.
899
900 Note that this function actually corresponds to FcConfigSubstituteWithPat, and
901 the argument order is changed to take advantage of Lisp optional arguments. */
902 (pattern, kind, testpat, config))
903 {
904 FcMatchKind knd;
905
906 /* There ought to be a standard idiom for this.... */
907 if (NILP (kind)
908 || EQ (kind, Qfc_match_font)) {
909 knd = FcMatchFont;
910 }
911 else if (EQ (kind, Qfc_match_pattern)) {
912 knd = FcMatchPattern;
913 }
914 else {
915 Fsignal (Qwrong_type_argument,
916 list2 (build_string ("need `fc-match-pattern' or `fc-match-font'"),
917 kind));
918 }
919
920 /* Typecheck arguments */
921 CHECK_FCPATTERN (pattern);
922 if (!NILP (testpat)) CHECK_FCPATTERN (testpat);
923 if (!NILP (config)) CHECK_FCCONFIG (config);
924
925 return (FcConfigSubstituteWithPat
926 (NILP (config) ? FcConfigGetCurrent () : XFCCONFIG_PTR (config),
927 XFCPATTERN_PTR (pattern),
928 NILP (testpat) ? NULL : XFCPATTERN_PTR (testpat),
929 knd) == FcTrue)
930 ? Qt : Qnil;
931 }
932
933 /* Pattern matching functions. */
934
935 /* The following functions return fonts that match a certain pattern.
936 `FcFontRenderPrepare' and `FcFontMatch' always return a single best
937 match. `FcFontList' returns the list of fonts that match a given
938 pattern on a certain set of properties. `FcFontSort' returns the
939 entire list of fonts, sorted in order of match quality, possibly
940 filtering out fonts that do not provide additional characters beyond
941 those provided by preferred fonts. */
942
943 DEFUN("fc-font-render-prepare", Ffc_font_render_prepare, 2, 3, 0, /*
944 Return a new pattern blending PATTERN and FONT.
945 Optional CONFIG is an FcConfig, defaulting to the current one.
946 The returned pattern consists of elements of FONT not appearing in PATTERN,
947 elements of PATTERN not appearing in FONT, and the best matching value from
948 PATTERN for elements appearing in both. The result is passed to
949 FcConfigSubstitute with 'kind' FcMatchFont and then returned. */
950 (pattern, font, config))
951 {
952 if (NILP (config)) {
953 config = Ffc_config_get_current ();
954 }
955 CHECK_FCPATTERN (pattern);
956 CHECK_FCPATTERN (font);
957 CHECK_FCCONFIG (config);
958
959 /* I don't think this can fail? */
960 return wrap_fcpattern (FcFontRenderPrepare (XFCCONFIG_PTR(config),
961 XFCPATTERN_PTR(font),
962 XFCPATTERN_PTR(pattern)));
963 }
964
965 DEFUN("fc-font-match", Ffc_font_match, 2, 3, 0, /*
966 Return the font on DEVICE that most closely matches PATTERN.
967
968 DEVICE is an X11 device.
969 PATTERN is a fontconfig pattern object.
970 Optional CONFIG is an FcConfig, defaulting to the current one.
971 Returns a fontconfig pattern object representing the closest match to the
972 given pattern, or an error code. Possible error codes are
973 `fc-result-no-match' and `fc-result-no-id'.
974 PATTERN is massaged with FcConfigSubstitute and FcDefaultSubstitute before
975 being processed by FcFontMatch. */
976 (device, pattern, config))
977 {
978 FcResult res;
979 struct fc_pattern *res_fcpat;
980 FcPattern *p;
981 FcConfig *fcc;
982
983 CHECK_FCPATTERN(pattern);
984 if (NILP(device))
985 return Qnil;
986 CHECK_X_DEVICE(device);
987 if (!DEVICE_LIVE_P(XDEVICE(device)))
988 return Qnil;
989 if (!NILP (config))
990 CHECK_FCCONFIG (config);
991
992 res_fcpat = XFCPATTERN (ALLOC_LISP_OBJECT (fc_pattern));
993 p = XFCPATTERN_PTR(pattern);
994 fcc = NILP (config) ? FcConfigGetCurrent () : XFCCONFIG_PTR (config);
995
996 FcConfigSubstitute (fcc, p, FcMatchPattern);
997 FcDefaultSubstitute (p);
998 res_fcpat->fcpatPtr = FcFontMatch (fcc, p, &res);
999
1000 if (res_fcpat->fcpatPtr == NULL)
1001 switch (res) {
1002 case FcResultNoMatch:
1003 return Qfc_result_no_match;
1004 case FcResultNoId:
1005 return Qfc_result_no_id;
1006 default:
1007 return Qfc_internal_error;
1008 }
1009 else
1010 return wrap_fcpattern(res_fcpat);
1011 }
1012
1013 /* #### fix this name to correspond to Ben's new nomenclature */
1014 DEFUN("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects,
1015 3, 3, 0, /*
1016 Return a list of fonts on DEVICE that match PATTERN for PROPERTIES.
1017 Each font is represented by a fontconfig pattern object.
1018
1019 DEVICE is an X11 device.
1020 PATTERN is a fontconfig pattern to be matched.
1021 PROPERTIES is a list of property names (strings) that should match.
1022
1023 #### DEVICE is unused, ignored, and may be removed if it's not needed to
1024 match other font-listing APIs. */
1025 (UNUSED (device), pattern, properties))
1026 {
1027 FcObjectSet *os;
1028 FcFontSet *fontset;
1029
1030 CHECK_FCPATTERN (pattern);
1031 CHECK_LIST (properties);
1032
1033 os = FcObjectSetCreate ();
1034 string_list_to_fcobjectset (properties, os);
1035 /* #### why don't we need to do the "usual substitutions"? */
1036 fontset = FcFontList (NULL, XFCPATTERN_PTR (pattern), os);
1037 FcObjectSetDestroy (os);
1038
1039 return fontset_to_list (fontset, DestroyYes);
1040
1041 }
1042
1043 /* #### maybe this can/should be folded into fc-list-fonts-pattern-objects? */
1044 DEFUN("fc-font-sort", Ffc_font_sort, 2, 4, 0, /*
1045 Return a list of all fonts sorted by proximity to PATTERN.
1046 Each font is represented by a fontconfig pattern object.
1047
1048 DEVICE is an X11 device.
1049 PATTERN is a fontconfig pattern to be matched.
1050 Optional argument TRIM, if non-nil, means to trim trailing fonts that do not
1051 contribute new characters to the union repertoire.
1052
1053 #### Optional argument NOSUB, if non-nil, suppresses some of the usual
1054 property substitutions. DON'T USE THIS in production code, it is intended
1055 for exploring behavior of fontconfig and will be removed when this code is
1056 stable.
1057
1058 #### DEVICE is unused, ignored, and may be removed if it's not needed to
1059 match other font-listing APIs. */
1060 (UNUSED (device), pattern, trim, nosub))
1061 {
1062 CHECK_FCPATTERN (pattern);
1063
1064 {
1065 FcConfig *fcc = FcConfigGetCurrent();
1066 FcFontSet *fontset;
1067 FcPattern *p = XFCPATTERN_PTR (pattern);
1068 FcResult fcresult;
1069
1070 if (NILP(nosub)) /* #### temporary debug hack */
1071 FcDefaultSubstitute (p);
1072 FcConfigSubstitute (fcc, p, FcMatchPattern);
1073 fontset = FcFontSort (fcc, p, !NILP(trim), NULL, &fcresult);
1074
1075 return fontset_to_list (fontset, DestroyYes);
1076 }
1077 }
1078
1079 #ifdef FONTCONFIG_EXPOSE_CONFIG
1080
1081 /* Configuration routines --- for debugging
1082 Don't depend on these routines being available in the future!
1083
1084 3.2.10 Initialization
1085 ---------------------
1086
1087 An FcConfig object holds the internal representation of a configuration.
1088 There is a default configuration which applications may use by passing
1089 0 to any function using the data within an FcConfig.
1090 */
1091
1092 static void
1093 finalize_fc_config (void *header, int UNUSED (for_disksave))
1094 {
1095 struct fc_config *p = (struct fc_config *) header;
1096 if (p->fccfgPtr && p->fccfgPtr != FcConfigGetCurrent())
1097 {
1098 /* If we get here, all of *our* references are garbage (see comment on
1099 fc_config_create_using() for why), and the only reference that
1100 fontconfig keeps is the current FcConfig. */
1101 FcConfigDestroy (p->fccfgPtr);
1102 }
1103 p->fccfgPtr = 0;
1104 }
1105
1106 static void
1107 print_fc_config (Lisp_Object obj, Lisp_Object printcharfun,
1108 int UNUSED(escapeflag))
1109 {
1110 struct fc_config *c = XFCCONFIG (obj);
1111 if (print_readably)
1112 printing_unreadable_object ("#<fc-config 0x%x>", c->header.uid);
1113 write_fmt_string (printcharfun, "#<fc-config 0x%x>", c->header.uid);
1114 }
1115
1116 static const struct memory_description fcconfig_description [] = {
1117 /* #### nothing here, is this right?? */
1118 { XD_END }
1119 };
1120
1121 DEFINE_NODUMP_LISP_OBJECT ("fc-config", fc_config,
1122 0, print_fc_config, finalize_fc_config, 0, 0,
1123 fcconfig_description,
1124 struct fc_config);
1125
1126 DEFUN("fc-init", Ffc_init, 0, 0, 0, /*
1127 -- Function: FcBool FcInit (void)
1128 Loads the default configuration file and the fonts referenced
1129 therein and sets the default configuration to that result.
1130 Returns whether this process succeeded or not. If the default
1131 configuration has already been loaded, this routine does nothing
1132 and returns FcTrue. */
1133 ())
1134 {
1135 return (FcInit () == FcTrue) ? Qt : Qnil;
1136 }
1137
1138 DEFUN("fc-get-version", Ffc_get_version, 0, 0, 0, /*
1139 -- Function: int FcGetVersion (void)
1140 Returns the version number of the library.
1141 XEmacs: No, this should NOT return a pretty string.
1142 (let ((i (fc-get-version)))
1143 (format "%d.%d.%d" (/ i 10000) (mod (/ i 100) 100) (mod i 100)))
1144 gives the usual x.y.z format. This is the version of the .so. It can be
1145 checked against `fc-version', which is the version of fontconfig.h.
1146 It's probably not a disaster if `(> (fc-get-version) fc-version)'. */
1147 ())
1148 {
1149 return make_int (FcGetVersion ());
1150 }
1151
1152 DEFUN("fc-init-reinitialize", Ffc_init_reinitialize, 0, 0, 0, /*
1153 -- Function: FcBool FcInitReinitialize (void)
1154 Forces the default configuration file to be reloaded and resets
1155 the default configuration. */
1156 ())
1157 {
1158 return (FcInitReinitialize () == FcTrue) ? Qt : Qnil;
1159 }
1160
1161 DEFUN("fc-init-bring-up-to-date", Ffc_init_bring_up_to_date, 0, 0, 0, /*
1162 -- Function: FcBool FcInitBringUptoDate (void)
1163 Checks the rescan interval in the default configuration, checking
1164 the configuration if the interval has passed and reloading the
1165 configuration when any changes are detected. */
1166 ())
1167 {
1168 return (FcInitBringUptoDate () == FcTrue) ? Qt : Qnil;
1169 }
1170
1171 #endif /* FONTCONFIG_EXPOSE_CONFIG */
1172
1173 DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /*
1174 Check whether the string FONTNAME is a XLFD font name. */
1175 (fontname))
1176 {
1177 CHECK_STRING(fontname);
1178 /* #### should bind `case-fold-search' here? */
1179 return Fstring_match(Vxlfd_font_name_regexp, fontname, Qnil, Qnil);
1180 }
1181
1182 /* FcPatternPrint: there is no point in having wrappers fc-pattern-print,
1183 Ffc_pattern_print since this function prints to stdout. */
1184
1185 /* Initialization of font-mgr */
1186
1187 #define XE_XLFD_SEPARATOR "-"
1188 /* XLFD specifies ISO 8859-1 encoding, but we can't handle non-ASCII
1189 in Mule when this function is called. So use HPC. */
1190 #if 0
1191 #define XE_XLFD_PREFIX "\\(\\+[\040-\176\240-\377]*\\)?-"
1192 #define XE_XLFD_OPT_TEXT "\\([\040-\044\046-\176\240-\377]*\\)"
1193 #define XE_XLFD_TEXT "\\([\040-\044\046-\176\240-\377]+\\)"
1194 #else
1195 #define XE_XLFD_PREFIX "\\(\\+[\040-\176]*\\)?-"
1196 #define XE_XLFD_OPT_TEXT "\\([^-]*\\)"
1197 #define XE_XLFD_TEXT "\\([^-]+\\)"
1198 #endif
1199
1200 #define XE_XLFD_SLANT "\\([0-9ior?*][iot]?\\)"
1201 #define XE_XLFD_SPACING "\\([cmp?*]\\)"
1202 /* Hyphen as minus conflicts with use as separator. */
1203 #define XE_XLFD_OPT_NEGATE "~?"
1204 #define XE_XLFD_NUMBER "\\([0-9?*]+\\)"
1205 #define XE_XLFD_PSIZE "\\([0-9?*]+\\|\\[[ 0-9+~.e?*]+\\]\\)"
1206
1207 /* Call this only from the init code
1208 #### This is really horrible, let's get rid of it, please. */
1209 static Lisp_Object
1210 make_xlfd_font_regexp (void)
1211 {
1212 struct gcpro gcpro1;
1213 unsigned i;
1214 Lisp_Object reg = Qnil;
1215 const Extbyte *re[] = /* #### This could just be catenated by
1216 cpp and passed to build_ext_string. */
1217 {
1218 /* Regular expression matching XLFDs as defined by XLFD v. 1.5.
1219 Matches must be case-insensitive.
1220 PSIZE is a pixel or point size, which may be a "matrix". The
1221 syntax of a matrix is not checked, just some lexical properties.
1222 AFAICT none of the TEXT fields except adstyle is optional.
1223
1224 NB. It should not be a problem if this matches "too much", since
1225 an "old" server will simply not be able to find a matching font. */
1226 "\\`",
1227 XE_XLFD_PREFIX, /* prefix */
1228 XE_XLFD_TEXT, /* foundry */
1229 XE_XLFD_SEPARATOR,
1230 XE_XLFD_TEXT, /* family */
1231 XE_XLFD_SEPARATOR,
1232 XE_XLFD_TEXT, /* weight */
1233 XE_XLFD_SEPARATOR,
1234 XE_XLFD_SLANT, /* slant */
1235 XE_XLFD_SEPARATOR,
1236 XE_XLFD_TEXT, /* swidth */
1237 XE_XLFD_SEPARATOR,
1238 XE_XLFD_OPT_TEXT, /* adstyle */
1239 XE_XLFD_SEPARATOR,
1240 XE_XLFD_PSIZE, /* pixelsize */
1241 XE_XLFD_SEPARATOR,
1242 XE_XLFD_PSIZE, /* pointsize */
1243 XE_XLFD_SEPARATOR,
1244 XE_XLFD_NUMBER, /* resx */
1245 XE_XLFD_SEPARATOR,
1246 XE_XLFD_NUMBER, /* resy */
1247 XE_XLFD_SEPARATOR,
1248 XE_XLFD_SPACING, /* spacing */
1249 XE_XLFD_SEPARATOR,
1250 XE_XLFD_OPT_NEGATE, /* avgwidth */
1251 XE_XLFD_NUMBER,
1252 XE_XLFD_SEPARATOR,
1253 XE_XLFD_TEXT, /* registry */
1254 XE_XLFD_SEPARATOR,
1255 XE_XLFD_TEXT, /* encoding */
1256 "\\'"
1257 };
1258
1259 GCPRO1 (reg);
1260 for (i = 0; i < sizeof(re)/sizeof(Extbyte *); i++)
1261 {
1262 /* #### Currently this is Host Portable Coding, not ISO 8859-1. */
1263 reg = concat2(reg, build_ext_string (re[i], Qx_font_name_encoding));
1264 }
1265
1266 RETURN_UNGCPRO (reg);
1267 }
1268 #undef XE_XLFD_SEPARATOR
1269 #undef XE_XLFD_PREFIX
1270 #undef XE_XLFD_OPT_TEXT
1271 #undef XE_XLFD_TEXT
1272 #undef XE_XLFD_OPT_SLANT
1273 #undef XE_XLFD_OPT_SPACING
1274 #undef XE_XLFD_OPT_NEGATE
1275 #undef XE_XLFD_NUMBER
1276 #undef XE_XLFD_PSIZE
1277
1278 #define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \
1279 ? ((unsigned long) (x)) : ((unsigned long) (y)))
1280
1281 static void
1282 string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os)
1283 {
1284 EXTERNAL_LIST_LOOP_2 (elt, list)
1285 {
1286 const Extbyte *s;
1287
1288 CHECK_STRING (elt);
1289 s = fc_intern (elt);
1290 FcObjectSetAdd (os, s);
1291 }
1292 }
1293
1294 void
1295 syms_of_font_mgr (void) {
1296 INIT_LISP_OBJECT(fc_pattern);
1297
1298 DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp);
1299
1300 DEFSYMBOL(Qfc_result_type_mismatch);
1301 DEFSYMBOL(Qfc_result_no_match);
1302 DEFSYMBOL(Qfc_result_no_id);
1303 DEFSYMBOL(Qfc_internal_error);
1304 DEFSYMBOL(Qfc_match_pattern);
1305 DEFSYMBOL(Qfc_match_font);
1306 DEFSYMBOL(Qfont_mgr);
1307
1308 DEFSUBR(Ffc_pattern_p);
1309 DEFSUBR(Ffc_pattern_create);
1310 DEFSUBR(Ffc_name_parse);
1311 DEFSUBR(Ffc_name_unparse);
1312 DEFSUBR(Ffc_pattern_duplicate);
1313 DEFSUBR(Ffc_pattern_add);
1314 DEFSUBR(Ffc_pattern_del);
1315 DEFSUBR(Ffc_pattern_get);
1316 DEFSUBR(Ffc_list_fonts_pattern_objects);
1317 DEFSUBR(Ffc_font_sort);
1318 DEFSUBR(Ffc_font_match);
1319 DEFSUBR(Ffc_default_substitute);
1320 DEFSUBR(Ffc_config_substitute);
1321 DEFSUBR(Ffc_font_render_prepare);
1322 DEFSUBR(Fxlfd_font_name_p);
1323
1324 #ifdef FONTCONFIG_EXPOSE_CONFIG
1325 INIT_LISP_OBJECT(fc_config);
1326
1327 DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_configp);
1328
1329 DEFSUBR(Ffc_config_p);
1330 DEFSUBR(Ffc_config_create);
1331 #if 0
1332 DEFSUBR(Ffc_config_destroy);
1333 #endif
1334 DEFSUBR(Ffc_config_set_current);
1335 DEFSUBR(Ffc_config_get_current);
1336 DEFSUBR(Ffc_config_up_to_date);
1337 DEFSUBR(Ffc_config_build_fonts);
1338 DEFSUBR(Ffc_config_get_config_dirs);
1339 DEFSUBR(Ffc_config_get_font_dirs);
1340 DEFSUBR(Ffc_config_get_config_files);
1341 DEFSUBR(Ffc_config_get_cache);
1342 DEFSUBR(Ffc_config_get_fonts);
1343 DEFSUBR(Ffc_config_get_blanks);
1344 DEFSUBR(Ffc_config_get_rescan_interval);
1345 DEFSUBR(Ffc_config_set_rescan_interval);
1346 DEFSUBR(Ffc_config_app_font_add_file);
1347 DEFSUBR(Ffc_config_app_font_add_dir);
1348 DEFSUBR(Ffc_config_app_font_clear);
1349 DEFSUBR(Ffc_config_filename);
1350 DEFSUBR(Ffc_init_load_config);
1351 DEFSUBR(Ffc_init_load_config_and_fonts);
1352 DEFSUBR(Ffc_init);
1353 DEFSUBR(Ffc_get_version);
1354 DEFSUBR(Ffc_init_reinitialize);
1355 DEFSUBR(Ffc_init_bring_up_to_date);
1356 #endif /* FONTCONFIG_EXPOSE_CONFIG */
1357 }
1358
1359 void
1360 vars_of_font_mgr (void)
1361 {
1362 /* #### The next two DEFVARs belong somewhere else. */
1363
1364 /* #### I know, but the right fix is use the generic debug facility. */
1365 DEFVAR_INT ("xft-debug-level", &debug_xft /*
1366 Level of debugging messages to issue to stderr for Xft.
1367 A nonnegative integer. Set to 0 to suppress all warnings.
1368 Default is 1 to ensure a minimum of debugging output at initialization.
1369 Higher levels give even more information.
1370 */ );
1371 debug_xft = 0;
1372
1373 DEFVAR_CONST_INT("xft-version", &xft_version /*
1374 The major version number of the Xft library being used.
1375 */ );
1376 xft_version = XFT_VERSION;
1377
1378 DEFVAR_CONST_INT("fc-version", &fc_version /*
1379 The version number of fontconfig.h. It can be checked against
1380 `(fc-get-version)', which is the version of the .so.
1381 It's probably not a disaster if `(> (fc-get-version) fc-version)'.
1382 */ );
1383 fc_version = FC_VERSION;
1384
1385 Fprovide (intern ("font-mgr"));
1386 }
1387
1388 void
1389 complex_vars_of_font_mgr (void)
1390 {
1391 #ifdef FONTCONFIG_EXPOSE_CONFIG
1392 Vfc_config_weak_list = make_weak_list (WEAK_LIST_SIMPLE);
1393 staticpro (&Vfc_config_weak_list);
1394 #endif
1395
1396 DEFVAR_LISP("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /*
1397 The regular expression used to match XLFD font names. */
1398 );
1399 Vxlfd_font_name_regexp = make_xlfd_font_regexp();
1400 }
1401
1402 void
1403 reinit_vars_of_font_mgr (void)
1404 {
1405 int i, size = (int) countof (fc_standard_properties);
1406
1407 FcInit ();
1408
1409 fc_property_name_hash_table = make_string_hash_table (size);
1410 for (i = 0; i < size; ++i)
1411 puthash (fc_standard_properties[i], NULL, fc_property_name_hash_table);
1412 }
1413