Mercurial > hg > xemacs-beta

comparison src/xft-fonts.c @ 3094:ad2f4ae9895b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-11-26 11:45:47 by stephent] Xft merge. <87k6ev4p8q.fsf@tleepslib.sk.tsukuba.ac.jp>
author stephent
date Sat, 26 Nov 2005 11:46:25 +0000
parents
children 859a2346db99
comparison
equal deleted inserted replaced
3093:769dc945b085 3094:ad2f4ae9895b
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 #if 0
467 /* #### delete this after some testing!! don't forget the DEFSUBR */
468 /* #### This is a big mistake, no? --- crap, there's no implicit finalizer */
469 DEFUN("fc-pattern-destroy", Ffc_pattern_destroy, 1, 1, 0, /*
470 Explicitly deallocate a fc pattern object PATTERN. */
471 (pattern))
472 {
473 CHECK_FCPATTERN(pattern);
474
475 /* paranoia strikes deep */
476 if (XFCPATTERN_PTR(pattern))
477 {
478 FcPatternDestroy(XFCPATTERN_PTR(pattern));
479 XFCPATTERN_PTR(pattern) = 0;
480 }
481 return Qnil;
482 }
483 #endif
484
485 DEFUN("fc-font-match", Ffc_font_match, 2, 2, 0, /*
486 Return the font on DEVICE that most closely matches PATTERN.
487
488 DEVICE is an X11 device.
489 PATTERN is a fontconfig pattern object.
490 Returns a fontconfig pattern object representing the closest match to the
491 given pattern, or an error code. Possible error codes are
492 `fc-result-no-match' and `fc-result-no-id'. */
493 (device, pattern))
494 {
495 Display *dpy;
496 FcResult res;
497
498 struct fc_pattern *res_fcpat =
499 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
500 CHECK_FCPATTERN(pattern); /* #### MEMORY LEAKS!!! */
501 if (NILP(device))
502 return Qnil;
503 CHECK_X_DEVICE(device);
504 if (!DEVICE_LIVE_P(XDEVICE(device)))
505 return Qnil;
506
507 dpy = DEVICE_X_DISPLAY(XDEVICE(device));
508 /* More Xft vs fontconfig brain damage? */
509 res_fcpat->fcpatPtr = XftFontMatch(dpy, DefaultScreen (dpy),
510 XFCPATTERN_PTR(pattern), &res);
511
512 if (res_fcpat->fcpatPtr == NULL)
513 switch (res) {
514 case FcResultNoMatch:
515 return Qfc_result_no_match;
516 case FcResultNoId:
517 return Qfc_result_no_id;
518 default:
519 return Qfc_internal_error;
520 }
521 else
522 return wrap_fcpattern(res_fcpat);
523 }
524
525 /* NOTE NOTE NOTE This function destroys the FcFontSet passed to it. */
526 static Lisp_Object
527 fontset_to_list (FcFontSet *fontset)
528 {
529 int idx;
530 Lisp_Object fontlist = Qnil;
531 fc_pattern *fcpat;
532
533 /* #### improve this error message */
534 if (!fontset)
535 Fsignal (Qinvalid_state,
536 list1 (build_string ("failed to create FcFontSet")));
537 for (idx = 0; idx < fontset->nfont; ++idx)
538 {
539 fcpat =
540 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
541 fcpat->fcpatPtr = FcPatternDuplicate (fontset->fonts[idx]);
542 fontlist = Fcons (wrap_fcpattern(fcpat), fontlist);
543 }
544 FcFontSetDestroy (fontset);
545 return fontlist;
546 }
547
548 /* #### fix this name to correspond to Ben's new nomenclature */
549 DEFUN("fc-list-fonts-pattern-objects", Ffc_list_fonts_pattern_objects,
550 3, 3, 0, /*
551 Return a list of fonts on DEVICE that match PATTERN for PROPERTIES.
552 Each font is represented by a fontconfig pattern object.
553
554 DEVICE is an X11 device.
555 PATTERN is a fontconfig pattern to be matched.
556 PROPERTIES is a list of property names (strings) that should match.
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, properties))
561 {
562 FcObjectSet *os;
563 FcFontSet *fontset;
564
565 CHECK_FCPATTERN (pattern);
566 CHECK_LIST (properties);
567
568 os = FcObjectSetCreate ();
569 string_list_to_fcobjectset (properties, os);
570 /* #### why don't we need to do the "usual substitutions"? */
571 fontset = FcFontList (NULL, XFCPATTERN_PTR (pattern), os);
572 FcObjectSetDestroy (os);
573
574 return fontset_to_list (fontset);
575
576 }
577
578 /* #### maybe this can/should be folded into fc-list-fonts-pattern-objects? */
579 DEFUN("fc-font-sort", Ffc_font_sort, 2, 4, 0, /*
580 Return a list of all fonts sorted by proximity to PATTERN.
581 Each font is represented by a fontconfig pattern object.
582
583 DEVICE is an X11 device.
584 PATTERN is a fontconfig pattern to be matched.
585 Optional argument TRIM, if non-nil, means to trim trailing fonts that do not
586 contribute new characters to the union repertoire.
587
588 #### Optional argument NOSUB, if non-nil, suppresses some of the usual
589 property substitutions. DON'T USE THIS in production code, it is intended
590 for exploring behavior of fontconfig and will be removed when this code is
591 stable.
592
593 #### DEVICE is unused, ignored, and may be removed if it's not needed to
594 match other font-listing APIs. */
595 (UNUSED (device), pattern, trim, nosub))
596 {
597 CHECK_FCPATTERN (pattern);
598
599 {
600 FcConfig *fcc = FcConfigGetCurrent();
601 FcFontSet *fontset;
602 FcPattern *p = XFCPATTERN_PTR (pattern);
603 FcResult fcresult;
604
605 if (NILP(nosub)) /* #### temporary debug hack */
606 FcDefaultSubstitute (p);
607 FcConfigSubstitute (fcc, p, FcMatchPattern);
608 fontset = FcFontSort (fcc, p, !NILP(trim), NULL, &fcresult);
609
610 return fontset_to_list (fontset);
611 }
612 }
613
614 /* #### this actually is an Xft function, should split those out
615 or get rid of them entirely? */
616 /* #### be consistent about argument order. */
617 DEFUN("fc-font-real-pattern", Ffc_font_real_pattern, 2, 2, 0, /*
618 Temporarily open FONTNAME (a string) and return the actual
619 fc pattern matched by the Fc library. */
620 (fontname, xdevice))
621 {
622 FcPattern *copy;
623 Display *dpy;
624 XftFont *font;
625 struct fc_pattern *fcpat =
626 ALLOC_LCRECORD_TYPE (struct fc_pattern, &lrecord_fc_pattern);
627
628 CHECK_STRING (fontname); /* #### MEMORY LEAK?! maybe not ... */
629 if (NILP(xdevice))
630 return Qnil;
631 CHECK_X_DEVICE (xdevice);
632 if (!DEVICE_LIVE_P(XDEVICE(xdevice)))
633 return Qnil;
634
635 /* #### these gymnastics should be unnecessary, just use FcFontMatch */
636 dpy = DEVICE_X_DISPLAY (XDEVICE (xdevice));
637 font = XftFontOpenName (dpy, DefaultScreen(dpy),
638 extract_fcapi_string (fontname));
639 if (font == NULL)
640 return Qnil;
641 copy = FcPatternDuplicate(font->pattern);
642 XftFontClose(dpy, font);
643 if (copy == NULL)
644 return Qnil;
645 fcpat->fcpatPtr = copy;
646 return wrap_fcpattern(fcpat);
647 }
648
649 DEFUN("xlfd-font-name-p", Fxlfd_font_name_p, 1, 1, 0, /*
650 Check whether the string FONTNAME is a XLFD font name. */
651 (fontname))
652 {
653 CHECK_STRING(fontname);
654 /* #### should bind `case-fold-search' here? */
655 return Fstring_match(Vxlfd_font_name_regexp, fontname, Qnil, Qnil);
656 }
657
658 /* FcPatternPrint: there is no point in having wrappers fc-pattern-print,
659 Ffc_pattern_print since this function prints to stdout. */
660
661 /* Initialization of xft-fonts */
662
663 #define XE_XLFD_SEPARATOR "-"
664 /* XLFD specifies ISO 8859-1 encoding, but we can't handle non-ASCII
665 in Mule when this function is called. So use HPC. */
666 #if 0
667 #define XE_XLFD_PREFIX "\\(\\+[\040-\176\240-\377]*\\)?-"
668 #define XE_XLFD_OPT_TEXT "\\([\040-\044\046-\176\240-\377]*\\)"
669 #define XE_XLFD_TEXT "\\([\040-\044\046-\176\240-\377]+\\)"
670 #else
671 #define XE_XLFD_PREFIX "\\(\\+[\040-\176]*\\)?-"
672 #define XE_XLFD_OPT_TEXT "\\([^-]*\\)"
673 #define XE_XLFD_TEXT "\\([^-]+\\)"
674 #endif
675
676 #define XE_XLFD_SLANT "\\([0-9ior?*][iot]?\\)"
677 #define XE_XLFD_SPACING "\\([cmp?*]\\)"
678 /* Hyphen as minus conflicts with use as separator. */
679 #define XE_XLFD_OPT_NEGATE "~?"
680 #define XE_XLFD_NUMBER "\\([0-9?*]+\\)"
681 #define XE_XLFD_PSIZE "\\([0-9?*]+\\|\\[[ 0-9+~.e?*]+\\]\\)"
682
683 /* Call this only from the init code
684 #### This is really horrible, let's get rid of it, please. */
685 static Lisp_Object
686 make_xlfd_font_regexp (void)
687 {
688 struct gcpro gcpro1;
689 unsigned i;
690 Lisp_Object reg = Qnil;
691 const Extbyte *re[] = /* #### This could just be catenated by
692 cpp and passed to build_ext_string. */
693 {
694 /* Regular expression matching XLFDs as defined by XLFD v. 1.5.
695 Matches must be case-insensitive.
696 PSIZE is a pixel or point size, which may be a "matrix". The
697 syntax of a matrix is not checked, just some lexical properties.
698 AFAICT none of the TEXT fields except adstyle is optional.
699
700 NB. It should not be a problem if this matches "too much", since
701 an "old" server will simply not be able to find a matching font. */
702 "\\`",
703 XE_XLFD_PREFIX, /* prefix */
704 XE_XLFD_TEXT, /* foundry */
705 XE_XLFD_SEPARATOR,
706 XE_XLFD_TEXT, /* family */
707 XE_XLFD_SEPARATOR,
708 XE_XLFD_TEXT, /* weight */
709 XE_XLFD_SEPARATOR,
710 XE_XLFD_SLANT, /* slant */
711 XE_XLFD_SEPARATOR,
712 XE_XLFD_TEXT, /* swidth */
713 XE_XLFD_SEPARATOR,
714 XE_XLFD_OPT_TEXT, /* adstyle */
715 XE_XLFD_SEPARATOR,
716 XE_XLFD_PSIZE, /* pixelsize */
717 XE_XLFD_SEPARATOR,
718 XE_XLFD_PSIZE, /* pointsize */
719 XE_XLFD_SEPARATOR,
720 XE_XLFD_NUMBER, /* resx */
721 XE_XLFD_SEPARATOR,
722 XE_XLFD_NUMBER, /* resy */
723 XE_XLFD_SEPARATOR,
724 XE_XLFD_SPACING, /* spacing */
725 XE_XLFD_SEPARATOR,
726 XE_XLFD_OPT_NEGATE, /* avgwidth */
727 XE_XLFD_NUMBER,
728 XE_XLFD_SEPARATOR,
729 XE_XLFD_TEXT, /* registry */
730 XE_XLFD_SEPARATOR,
731 XE_XLFD_TEXT, /* encoding */
732 "\\'"
733 };
734
735 GCPRO1 (reg);
736 for (i = 0; i < sizeof(re)/sizeof(Extbyte *); i++)
737 {
738 /* #### Currently this is Host Portable Coding, not ISO 8859-1. */
739 reg = concat2(reg, build_ext_string (re[i], Qx_font_name_encoding));
740 }
741
742 RETURN_UNGCPRO (reg);
743 }
744 #undef XE_XLFD_SEPARATOR
745 #undef XE_XLFD_PREFIX
746 #undef XE_XLFD_OPT_TEXT
747 #undef XE_XLFD_TEXT
748 #undef XE_XLFD_OPT_SLANT
749 #undef XE_XLFD_OPT_SPACING
750 #undef XE_XLFD_OPT_NEGATE
751 #undef XE_XLFD_NUMBER
752 #undef XE_XLFD_PSIZE
753
754 #define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \
755 ? ((unsigned long) (x)) : ((unsigned long) (y)))
756
757 static void
758 string_list_to_fcobjectset (Lisp_Object list, FcObjectSet *os)
759 {
760 EXTERNAL_LIST_LOOP_2 (elt, list)
761 {
762 FcChar8 *s;
763
764 CHECK_STRING (elt);
765 s = fc_intern (elt);
766 fprintf (stderr, "%s\n", s);
767 FcObjectSetAdd (os, s);
768 }
769 }
770
771 void
772 syms_of_xft_fonts (void)
773 {
774 INIT_LRECORD_IMPLEMENTATION(fc_pattern);
775
776 DEFSYMBOL_MULTIWORD_PREDICATE(Qfc_patternp);
777
778 DEFSYMBOL(Qfc_result_type_mismatch);
779 DEFSYMBOL(Qfc_result_no_match);
780 DEFSYMBOL(Qfc_result_no_id);
781 DEFSYMBOL(Qfc_internal_error);
782 DEFSYMBOL(Qxft_font);
783
784 DEFSUBR(Ffc_pattern_p);
785 DEFSUBR(Ffc_pattern_create);
786 DEFSUBR(Ffc_name_parse);
787 DEFSUBR(Ffc_name_unparse);
788 DEFSUBR(Fxft_name_unparse); /* URK! */
789 DEFSUBR(Ffc_pattern_duplicate);
790 DEFSUBR(Ffc_pattern_add);
791 DEFSUBR(Ffc_pattern_del);
792 DEFSUBR(Ffc_pattern_get);
793 #if 0
794 DEFSUBR(Ffc_pattern_destroy);
795 #endif
796 DEFSUBR(Ffc_list_fonts_pattern_objects);
797 DEFSUBR(Ffc_font_sort);
798 DEFSUBR(Ffc_font_match);
799 DEFSUBR(Ffc_font_real_pattern);
800 DEFSUBR(Fxlfd_font_name_p);
801 }
802
803 void
804 vars_of_xft_fonts (void)
805 {
806 /* #### I know, but the right fix is use the generic debug facility. */
807 DEFVAR_INT ("xft-debug-level", &debug_xft /*
808 Level of debugging messages to issue to stderr for Xft.
809 A nonnegative integer. Set to 0 to suppress all warnings.
810 Default is 1 to ensure a minimum of debugging output at initialization.
811 Higher levels give even more information.
812 */ );
813 debug_xft = 1;
814
815 DEFVAR_LISP("xft-version", &Vxft_version /*
816 The major version number of the Xft library being used.
817 */ );
818 Vxft_version = make_int(XFT_VERSION);
819
820 Fprovide (intern ("xft"));
821 }
822
823 void
824 complex_vars_of_xft_fonts (void)
825 {
826 DEFVAR_LISP("xft-xlfd-font-regexp", &Vxlfd_font_name_regexp /*
827 The regular expression used to match XLFD font names. */
828 );
829 Vxlfd_font_name_regexp = make_xlfd_font_regexp();
830 }
831
832 void
833 reinit_vars_of_xft_fonts (void)
834 {
835 int i, size = (int) countof (fc_standard_properties);
836
837 FcInit ();
838
839 fc_property_name_hash_table = make_string_hash_table (size);
840 for (i = 0; i < size; ++i)
841 puthash (fc_standard_properties[i], NULL, fc_property_name_hash_table);
842 }
843