Mercurial > hg > xemacs-beta

comparison src/font-mgr.c @ 3354:15fb91e3a115

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2006-04-23 16:11:16 by stephent] Xft/fontconfig refactoring, Part I. <87hd4ks29d.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Sun, 23 Apr 2006 16:11:34 +0000
parents
children 316fddbf58e2
comparison
equal deleted inserted replaced
3353:521d94807505 3354:15fb91e3a115
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 "font-mgr.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 DEFUN("fc-pattern-duplicate", Ffc_pattern_duplicate, 1, 1, 0, /*
223 Make a copy of the fc pattern object PATTERN and return it.
224 */
225 (pattern))
226 {
227 struct fc_pattern *copy = NULL;
228 CHECK_FCPATTERN(pattern);
229
230 copy = ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
231 copy->fcpatPtr = FcPatternDuplicate(XFCPATTERN_PTR(pattern));
232 return wrap_fcpattern(copy);
233 }
234
235 DEFUN("fc-pattern-add", Ffc_pattern_add, 3, 3, 0, /*
236 Add attributes to the pattern object PATTERN. PROPERTY is a string naming
237 the attribute to add, VALUE the value for this attribute.
238
239 VALUE may be a string, integer, float, or symbol, in which case the value
240 will be added as an FcChar8[], int, double, or FcBool respectively.
241 */
242 (pattern, property, value))
243 {
244 Bool res = 0;
245 Extbyte *obj;
246 FcPattern *fcpat;
247
248 CHECK_FCPATTERN(pattern);
249 CHECK_STRING(property);
250
251 obj = fc_intern (property);
252 fcpat = XFCPATTERN_PTR (pattern);
253
254 if (STRINGP(value))
255 {
256 FcChar8 *str = (FcChar8 *) extract_fcapi_string (value);
257 res = FcPatternAddString (fcpat, obj, str);
258 }
259 else if (INTP(value))
260 {
261 res = FcPatternAddInteger (fcpat, obj, XINT(value));
262 }
263 else if (FLOATP(value))
264 {
265 res = FcPatternAddDouble (fcpat, obj, (double) XFLOAT_DATA(value));
266 }
267 else if (SYMBOLP(value))
268 {
269 res = FcPatternAddBool (fcpat, obj, !NILP(value));
270 }
271 /* else ... maybe we should wta here? */
272
273 return res ? Qt : Qnil;
274 }
275
276 DEFUN("fc-pattern-del", Ffc_pattern_del, 2, 2, 0, /*
277 Remove attribute PROPERTY from fc pattern object OBJECT.
278 */
279 (pattern, property))
280 {
281 Bool res;
282
283 CHECK_FCPATTERN(pattern);
284 CHECK_STRING(property);
285
286 res = FcPatternDel(XFCPATTERN_PTR(pattern),
287 extract_fcapi_string (property));
288 return res ? Qt : Qnil;
289 }
290
291 /* Generic interface to FcPatternGet()
292 * Don't support the losing symbol-for-property interface.
293 */
294 DEFUN("fc-pattern-get", Ffc_pattern_get, 2, 4, 0, /*
295 From PATTERN, extract PROPERTY for the ID'th member, of type TYPE.
296
297 PATTERN is an Xft (fontconfig) pattern object.
298 PROPERTY is a string naming an fontconfig font property.
299 Optional ID is a nonnegative integer indexing the list of values for PROPERTY
300 stored in PATTERN, defaulting to 0 (the first value).
301 Optional TYPE is a symbol, one of 'string, 'boolean, 'integer, 'float,
302 'double, 'matrix, 'charset, or 'void, corresponding to the FcValue types.
303 ('float is an alias for 'double).
304
305 The Lisp types returned will conform to TYPE:
306 string string
307 boolean `t' or `nil'
308 integer integer
309 double (float) float
310 matrix not implemented
311 charset not implemented
312 void not implemented
313
314 Symbols with names of the form "fc-result-DESCRIPTION" are returned when
315 the desired value is not available. These are
316
317 fc-result-type-mismatch the value found has an unexpected type
318 fc-result-no-match there is no such attribute
319 fc-result-no-id there is no value for the requested ID
320
321 The types of the following standard properties are predefined by fontconfig.
322 The symbol 'fc-result-type-mismatch will be returned if the object exists but
323 TYPE does not match the predefined type. It is best not to specify a type
324 for predefined properties, as a mistake here ensures error returns on the
325 correct type.
326
327 Each standard property has a convenience accessor defined in fontconfig.el,
328 named in the form "fc-pattern-get-PROPERTY". The convenience functions are
329 preferred to `fc-pattern-get' since a typo in the string naming a property
330 will result in a silent null return, while a typo in a function name will
331 usually result in a compiler or runtime \"not fboundp\" error. You may use
332 `defsubst' to define convenience functions for non-standard properties.
333
334 family String Font family name
335 style String Font style. Overrides weight and slant
336 slant Int Italic, oblique or roman
337 weight Int Light, medium, demibold, bold or black
338 size Double Point size
339 aspect Double Stretches glyphs horizontally before hinting
340 pixelsize Double Pixel size
341 spacing Int Proportional, monospace or charcell
342 foundry String Font foundry name
343 antialias Bool Whether glyphs can be antialiased
344 hinting Bool Whether the rasterizer should use hinting
345 verticallayout Bool Use vertical layout
346 autohint Bool Use autohinter instead of normal hinter
347 globaladvance Bool Use font global advance data
348 file String The filename holding the font
349 index Int The index of the font within the file
350 ftface FT_Face Use the specified FreeType face object
351 rasterizer String Which rasterizer is in use
352 outline Bool Whether the glyphs are outlines
353 scalable Bool Whether glyphs can be scaled
354 scale Double Scale factor for point->pixel conversions
355 dpi Double Target dots per inch
356 rgba Int unknown, rgb, bgr, vrgb, vbgr, none - subpixel geometry
357 minspace Bool Eliminate leading from line spacing
358 charset CharSet Unicode chars encoded by the font
359 lang String List of RFC-3066-style languages this font supports
360
361 The FT_Face, Matrix, CharSet types are unimplemented, so the corresponding
362 properties are not accessible from Lisp at this time. If the value of a
363 property returned has type FT_Face, FcCharSet, or FcMatrix,
364 `fc-result-type-mismatch' is returned.
365
366 The following properties which were standard in Xft v.1 are obsolete in
367 Xft v.2: encoding, charwidth, charheight, core, and render. */
368 (pattern, property, id, type))
369 {
370 FcChar8 *fc_property; /* UExtbyte * */
371 FcResult fc_result;
372 FcValue fc_value;
373
374 /*
375 process arguments
376 */
377 CHECK_FCPATTERN (pattern);
378
379 #if 0
380 /* Don't support the losing symbol-for-property interface. */
381 property = SYMBOLP (property) ? symbol_name (XSYMBOL (property)) : property;
382 #endif
383 if (STRINGP (property))
384 {
385 fc_property = (FcChar8 *) extract_fcapi_string (property);
386 }
387 else
388 {
389 /* if we allow symbols, this would need to be
390 list3 (Qlambda, list1 (Qobject),
391 list3 (Qor, list2 (Qstringp, Qobject),
392 list2 (Qsymbolp, Qobject)))
393 or something like that? */
394 dead_wrong_type_argument (Qstringp, property);
395 }
396
397 if (!NILP (id)) CHECK_NATNUM (id);
398 if (!NILP (type)) CHECK_SYMBOL (type);
399
400 /* get property */
401 fc_result = FcPatternGet (XFCPATTERN_PTR (pattern),
402 fc_property,
403 NILP (id) ? 0 : XINT(id),
404 &fc_value);
405
406 switch (fc_result)
407 {
408 case FcResultMatch:
409 /* wrap it and return */
410 switch (fc_value.type)
411 {
412 case FcTypeInteger:
413 return ((!NILP (type) && !EQ (type, Qinteger))
414 ? Qfc_result_type_mismatch : make_int (fc_value.u.i));
415 case FcTypeDouble:
416 return ((!NILP (type) && !EQ (type, intern ("double"))
417 && !EQ (type, Qfloat))
418 ? Qfc_result_type_mismatch : make_float (fc_value.u.d));
419 case FcTypeString:
420 return ((!NILP (type) && !EQ (type, Qstring))
421 ? Qfc_result_type_mismatch
422 : build_ext_string (fc_value.u.s, Qxft_font_name_encoding));
423 case FcTypeBool:
424 return ((!NILP (type) && !EQ (type, Qboolean))
425 ? Qfc_result_type_mismatch : fc_value.u.b ? Qt : Qnil);
426 case FcTypeMatrix:
427 return Qfc_result_type_mismatch;
428 /* #### unimplemented
429 return ((!NILP (type) && !EQ (type, intern ("matrix")))
430 ? Qfc_result_type_mismatch : make_int (fc_value.u.m));
431 */
432 case FcTypeCharSet:
433 return Qfc_result_type_mismatch;
434 /* #### unimplemented
435 return ((!NILP (type) && !EQ (type, intern ("charset")))
436 ? Qfc_result_type_mismatch : make_int (fc_value.u.c));
437 */
438 }
439 case FcResultTypeMismatch:
440 return Qfc_result_type_mismatch;
441 case FcResultNoMatch:
442 return Qfc_result_no_match;
443 case FcResultNoId:
444 return Qfc_result_no_id;
445 default:
446 return Qfc_internal_error;
447 }
448 }
449
450 DEFUN("fc-font-match", Ffc_font_match, 2, 2, 0, /*
451 Return the font on DEVICE that most closely matches PATTERN.
452
453 DEVICE is an X11 device.
454 PATTERN is a fontconfig pattern object.
455 Returns a fontconfig pattern object representing the closest match to the
456 given pattern, or an error code. Possible error codes are
457 `fc-result-no-match' and `fc-result-no-id'. */
458 (device, pattern))
459 {
460 Display *dpy;
461 FcResult res;
462
463 struct fc_pattern *res_fcpat =
464 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
465 CHECK_FCPATTERN(pattern); /* #### MEMORY LEAKS!!! */
466 if (NILP(device))
467 return Qnil;
468 CHECK_X_DEVICE(device);
469 if (!DEVICE_LIVE_P(XDEVICE(device)))
470 return Qnil;
471
472 dpy = DEVICE_X_DISPLAY(XDEVICE(device));
473 /* More Xft vs fontconfig brain damage? */
474 res_fcpat->fcpatPtr = XftFontMatch(dpy, DefaultScreen (dpy),
475 XFCPATTERN_PTR(pattern), &res);
476
477 if (res_fcpat->fcpatPtr == NULL)
478 switch (res) {
479 case FcResultNoMatch:
480 return Qfc_result_no_match;
481 case FcResultNoId:
482 return Qfc_result_no_id;
483 default:
484 return Qfc_internal_error;
485 }
486 else
487 return wrap_fcpattern(res_fcpat);
488 }
489
490 /* NOTE NOTE NOTE This function destroys the FcFontSet passed to it. */
491 static Lisp_Object
492 fontset_to_list (FcFontSet *fontset)
493 {
494 int idx;
495 Lisp_Object fontlist = Qnil;
496 fc_pattern *fcpat;
497
498 /* #### improve this error message */
499 if (!fontset)
500 Fsignal (Qinvalid_state,
501 list1 (build_string ("failed to create FcFontSet")));
502 for (idx = 0; idx < fontset->nfont; ++idx)
503 {
504 fcpat =
505 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
506 fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]);
507 fontlist = Fcons (wrap_fcpattern(fcpat), fontlist);
508 }
509 FcFontSetDestroy (fontset);
510 return fontlist;
511 }
512
513 /* #### fix this name to correspond to Ben's new nomenclature */
514 DEFUN("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects,
515 3, 3, 0, /*
516 Return a list of fonts on DEVICE that match PATTERN for PROPERTIES.
517 Each font is represented by a fontconfig pattern object.
518
519 DEVICE is an X11 device.
520 PATTERN is a fontconfig pattern to be matched.
521 PROPERTIES is a list of property names (strings) that should match.
522
523 #### DEVICE is unused, ignored, and may be removed if it's not needed to
524 match other font-listing APIs. */
525 (UNUSED (device), pattern, properties))
526 {
527 FcObjectSet *os;
528 FcFontSet *fontset;
529
530 CHECK_FCPATTERN (pattern);
531 CHECK_LIST (properties);
532
533 os = FcObjectSetCreate ();
534 string_list_to_fcobjectset (properties, os);
535 /* #### why don't we need to do the "usual substitutions"? */
536 fontset = FcFontList (NULL, XFCPATTERN_PTR (pattern), os);
537 FcObjectSetDestroy (os);
538
539 return fontset_to_list (fontset);
540
541 }
542
543 /* #### maybe this can/should be folded into fc-list-fonts-pattern-objects? */
544 DEFUN("fc-font-sort", Ffc_font_sort, 2, 4, 0, /*
545 Return a list of all fonts sorted by proximity to PATTERN.
546 Each font is represented by a fontconfig pattern object.
547
548 DEVICE is an X11 device.
549 PATTERN is a fontconfig pattern to be matched.
550 Optional argument TRIM, if non-nil, means to trim trailing fonts that do not
551 contribute new characters to the union repertoire.
552
553 #### Optional argument NOSUB, if non-nil, suppresses some of the usual
554 property substitutions. DON'T USE THIS in production code, it is intended
555 for exploring behavior of fontconfig and will be removed when this code is
556 stable.
557
558 #### DEVICE is unused, ignored, and may be removed if it's not needed to
559 match other font-listing APIs. */
560 (UNUSED (device), pattern, trim, nosub))
561 {
562 CHECK_FCPATTERN (pattern);
563
564 {
565 FcConfig *fcc = FcConfigGetCurrent();
566 FcFontSet *fontset;
567 FcPattern *p = XFCPATTERN_PTR (pattern);
568 FcResult fcresult;
569
570 if (NILP(nosub)) /* #### temporary debug hack */
571 FcDefaultSubstitute (p);
572 FcConfigSubstitute (fcc, p, FcMatchPattern);
573 fontset = FcFontSort (fcc, p, !NILP(trim), NULL, &fcresult);
574
575 return fontset_to_list (fontset);
576 }
577 }
578
579 /* #### this actually is an Xft function, should split those out
580 or get rid of them entirely? */
581 /* #### be consistent about argument order. */
582 DEFUN("fc-font-real-pattern", Ffc_font_real_pattern, 2, 2, 0, /*
583 Temporarily open FONTNAME (a string) and return the actual
584 fc pattern matched by the Fc library. */
585 (fontname, xdevice))
586 {
587 FcPattern *copy;
588 Display *dpy;
589 XftFont *font;
590 struct fc_pattern *fcpat =
591 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
592
593 CHECK_STRING (fontname); /* #### MEMORY LEAK?! maybe not ... */
594 if (NILP(xdevice))
595 return Qnil;
596 CHECK_X_DEVICE (xdevice);
597 if (!DEVICE_LIVE_P(XDEVICE(xdevice)))
598 return Qnil;
599
600 /* #### these gymnastics should be unnecessary, just use FcFontMatch */
601 dpy = DEVICE_X_DISPLAY (XDEVICE (xdevice));
602 font = XftFontOpenName (dpy, DefaultScreen(dpy),
603 extract_fcapi_string (fontname));
604 if (font == NULL)
605 return Qnil;
606 copy = FcPatternDuplicate(font->pattern);
607 XftFontClose(dpy, font);
608 if (copy == NULL)
609 return Qnil;
610 fcpat->fcpatPtr = copy;
611 return wrap_fcpattern(fcpat);
612 }
613
614 DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /*
615 Check whether the string FONTNAME is a XLFD font name. */
616 (fontname))
617 {
618 CHECK_STRING(fontname);
619 /* #### should bind `case-fold-search' here? */
620 return Fstring_match(Vxlfd_font_name_regexp, fontname, Qnil, Qnil);
621 }
622
623 /* FcPatternPrint: there is no point in having wrappers fc-pattern-print,
624 Ffc_pattern_print since this function prints to stdout. */
625
626 /* Initialization of font-mgr */
627
628 #define XE_XLFD_SEPARATOR "-"
629 /* XLFD specifies ISO 8859-1 encoding, but we can't handle non-ASCII
630 in Mule when this function is called. So use HPC. */
631 #if 0
632 #define XE_XLFD_PREFIX "\\(\\+[\040-\176\240-\377]*\\)?-"
633 #define XE_XLFD_OPT_TEXT "\\([\040-\044\046-\176\240-\377]*\\)"
634 #define XE_XLFD_TEXT "\\([\040-\044\046-\176\240-\377]+\\)"
635 #else
636 #define XE_XLFD_PREFIX "\\(\\+[\040-\176]*\\)?-"
637 #define XE_XLFD_OPT_TEXT "\\([^-]*\\)"
638 #define XE_XLFD_TEXT "\\([^-]+\\)"
639 #endif
640
641 #define XE_XLFD_SLANT "\\([0-9ior?*][iot]?\\)"
642 #define XE_XLFD_SPACING "\\([cmp?*]\\)"
643 /* Hyphen as minus conflicts with use as separator. */
644 #define XE_XLFD_OPT_NEGATE "~?"
645 #define XE_XLFD_NUMBER "\\([0-9?*]+\\)"
646 #define XE_XLFD_PSIZE "\\([0-9?*]+\\|\\[[ 0-9+~.e?*]+\\]\\)"
647
648 /* Call this only from the init code
649 #### This is really horrible, let's get rid of it, please. */
650 static Lisp_Object
651 make_xlfd_font_regexp (void)
652 {
653 struct gcpro gcpro1;
654 unsigned i;
655 Lisp_Object reg = Qnil;
656 const Extbyte *re[] = /* #### This could just be catenated by
657 cpp and passed to build_ext_string. */
658 {
659 /* Regular expression matching XLFDs as defined by XLFD v. 1.5.
660 Matches must be case-insensitive.
661 PSIZE is a pixel or point size, which may be a "matrix". The
662 syntax of a matrix is not checked, just some lexical properties.
663 AFAICT none of the TEXT fields except adstyle is optional.
664
665 NB. It should not be a problem if this matches "too much", since
666 an "old" server will simply not be able to find a matching font. */
667 "\\`",
668 XE_XLFD_PREFIX, /* prefix */
669 XE_XLFD_TEXT, /* foundry */
670 XE_XLFD_SEPARATOR,
671 XE_XLFD_TEXT, /* family */
672 XE_XLFD_SEPARATOR,
673 XE_XLFD_TEXT, /* weight */
674 XE_XLFD_SEPARATOR,
675 XE_XLFD_SLANT, /* slant */
676 XE_XLFD_SEPARATOR,
677 XE_XLFD_TEXT, /* swidth */
678 XE_XLFD_SEPARATOR,
679 XE_XLFD_OPT_TEXT, /* adstyle */
680 XE_XLFD_SEPARATOR,
681 XE_XLFD_PSIZE, /* pixelsize */
682 XE_XLFD_SEPARATOR,
683 XE_XLFD_PSIZE, /* pointsize */
684 XE_XLFD_SEPARATOR,
685 XE_XLFD_NUMBER, /* resx */
686 XE_XLFD_SEPARATOR,
687 XE_XLFD_NUMBER, /* resy */
688 XE_XLFD_SEPARATOR,
689 XE_XLFD_SPACING, /* spacing */
690 XE_XLFD_SEPARATOR,
691 XE_XLFD_OPT_NEGATE, /* avgwidth */
692 XE_XLFD_NUMBER,
693 XE_XLFD_SEPARATOR,
694 XE_XLFD_TEXT, /* registry */
695 XE_XLFD_SEPARATOR,
696 XE_XLFD_TEXT, /* encoding */
697 "\\'"
698 };
699
700 GCPRO1 (reg);
701 for (i = 0; i < sizeof(re)/sizeof(Extbyte *); i++)
702 {
703 /* #### Currently this is Host Portable Coding, not ISO 8859-1. */
704 reg = concat2(reg, build_ext_string (re[i], Qx_font_name_encoding));
705 }
706
707 RETURN_UNGCPRO (reg);
708 }
709 #undef XE_XLFD_SEPARATOR
710 #undef XE_XLFD_PREFIX
711 #undef XE_XLFD_OPT_TEXT
712 #undef XE_XLFD_TEXT
713 #undef XE_XLFD_OPT_SLANT
714 #undef XE_XLFD_OPT_SPACING
715 #undef XE_XLFD_OPT_NEGATE
716 #undef XE_XLFD_NUMBER
717 #undef XE_XLFD_PSIZE
718
719 #define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \
720 ? ((unsigned long) (x)) : ((unsigned long) (y)))
721
722 static void
723 string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os)
724 {
725 EXTERNAL_LIST_LOOP_2 (elt, list)
726 {
727 FcChar8 *s;
728
729 CHECK_STRING (elt);
730 s = fc_intern (elt);
731 fprintf (stderr, "%s\n", s);
732 FcObjectSetAdd (os, s);
733 }
734 }
735
736 void
737 syms_of_font_mgr (void)
738 {
739 INIT_LRECORD_IMPLEMENTATION(fc_pattern);
740
741 DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp);
742
743 DEFSYMBOL(Qfc_result_type_mismatch);
744 DEFSYMBOL(Qfc_result_no_match);
745 DEFSYMBOL(Qfc_result_no_id);
746 DEFSYMBOL(Qfc_internal_error);
747 DEFSYMBOL(Qxft_font);
748
749 DEFSUBR(Ffc_pattern_p);
750 DEFSUBR(Ffc_pattern_create);
751 DEFSUBR(Ffc_name_parse);
752 DEFSUBR(Ffc_name_unparse);
753 DEFSUBR(Ffc_pattern_duplicate);
754 DEFSUBR(Ffc_pattern_add);
755 DEFSUBR(Ffc_pattern_del);
756 DEFSUBR(Ffc_pattern_get);
757 DEFSUBR(Ffc_list_fonts_pattern_objects);
758 DEFSUBR(Ffc_font_sort);
759 DEFSUBR(Ffc_font_match);
760 DEFSUBR(Ffc_font_real_pattern);
761 DEFSUBR(Fxlfd_font_name_p);
762 }
763
764 void
765 vars_of_font_mgr (void)
766 {
767 /* #### These two variables need to go somewhere else. */
768
769 /* #### I know, but the right fix is use the generic debug facility. */
770 DEFVAR_INT ("xft-debug-level", &debug_xft /*
771 Level of debugging messages to issue to stderr for Xft.
772 A nonnegative integer. Set to 0 to suppress all warnings.
773 Default is 1 to ensure a minimum of debugging output at initialization.
774 Higher levels give even more information.
775 */ );
776 debug_xft = 1;
777
778 DEFVAR_LISP("xft-version", &Vxft_version /*
779 The major version number of the Xft library being used.
780 */ );
781 Vxft_version = make_int(XFT_VERSION);
782
783 Fprovide (intern ("xft"));
784 }
785
786 void
787 complex_vars_of_font_mgr (void)
788 {
789 DEFVAR_LISP("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /*
790 The regular expression used to match XLFD font names. */
791 );
792 Vxlfd_font_name_regexp = make_xlfd_font_regexp();
793 }
794
795 void
796 reinit_vars_of_font_mgr (void)
797 {
798 int i, size = (int) countof (fc_standard_properties);
799
800 FcInit ();
801
802 fc_property_name_hash_table = make_string_hash_table (size);
803 for (i = 0; i < size; ++i)
804 puthash (fc_standard_properties[i], NULL, fc_property_name_hash_table);
805 }
806