Mercurial > hg > xemacs-beta

comparison src/fontcolor-x.c @ 5176:8b2f75cecb89

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
rename objects* (.c, .h and .el files) to fontcolor* -------------------- ChangeLog entries follow: -------------------- etc/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * dbxrc.in: Rename objects.c -> fontcolor.c. lisp/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * dumped-lisp.el (preloaded-file-list): * font.el (font-tty-find-closest-color): * fontcolor.el: * fontcolor.el (ws-object-property-1): Removed. * fontcolor.el (fontcolor-property-1): New. * fontcolor.el (font-name): * fontcolor.el (font-ascent): * fontcolor.el (font-descent): * fontcolor.el (font-width): * fontcolor.el (font-height): * fontcolor.el (font-proportional-p): * fontcolor.el (font-properties): * fontcolor.el (font-truename): * fontcolor.el (color-name): * fontcolor.el (color-rgb-components): * x-faces.el: Rename objects.el -> fontcolor.el. lwlib/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * lwlib-colors.h: objects*.h -> fontcolor*.h. man/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * internals/internals.texi (A Summary of the Various XEmacs Modules): * internals/internals.texi (Modules for other Display-Related Lisp Objects): objects*.[ch] -> fontcolor*.[ch]. nt/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * xemacs.dsp: * xemacs.mak: * xemacs.mak (OPT_OBJS): objects*.[ch] -> fontcolor*.[ch]. src/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * EmacsFrame.c: * Makefile.in.in (x_objs): * Makefile.in.in (mswindows_objs): * Makefile.in.in (tty_objs): * Makefile.in.in (gtk_objs): * Makefile.in.in (objs): * console-tty.h: * console-x-impl.h: * console-x-impl.h (struct x_device): * console-x.h: * console-xlike-inc.h: * depend: * device-gtk.c: * device-msw.c: * device-x.c: * device-x.c (x_init_device): * device-x.c (x_finish_init_device): * device.c: * devslots.h (MARKED_SLOT): * emacs.c (main_1): * event-Xt.c: * event-gtk.c: * event-msw.c: * faces.c: * font-mgr.c: * fontcolor-gtk-impl.h: * fontcolor-gtk.c: * fontcolor-gtk.c (syms_of_fontcolor_gtk): * fontcolor-gtk.c (console_type_create_fontcolor_gtk): * fontcolor-gtk.c (vars_of_fontcolor_gtk): * fontcolor-gtk.h: * fontcolor-impl.h: * fontcolor-msw-impl.h: * fontcolor-msw.c: * fontcolor-msw.c (syms_of_fontcolor_mswindows): * fontcolor-msw.c (console_type_create_fontcolor_mswindows): * fontcolor-msw.c (reinit_vars_of_fontcolor_mswindows): * fontcolor-msw.c (vars_of_fontcolor_mswindows): * fontcolor-msw.h: * fontcolor-msw.h (mswindows_color_to_string): * fontcolor-tty-impl.h: * fontcolor-tty.c: * fontcolor-tty.c (syms_of_fontcolor_tty): * fontcolor-tty.c (console_type_create_fontcolor_tty): * fontcolor-tty.c (vars_of_fontcolor_tty): * fontcolor-tty.h: * fontcolor-x-impl.h: * fontcolor-x.c: * fontcolor-x.c (syms_of_fontcolor_x): * fontcolor-x.c (console_type_create_fontcolor_x): * fontcolor-x.c (vars_of_fontcolor_x): * fontcolor-x.c (Xatoms_of_fontcolor_x): * fontcolor-x.h: * fontcolor.c: * fontcolor.c (syms_of_fontcolor): * fontcolor.c (specifier_type_create_fontcolor): * fontcolor.c (reinit_specifier_type_create_fontcolor): * fontcolor.c (reinit_vars_of_fontcolor): * fontcolor.c (vars_of_fontcolor): * fontcolor.h: * fontcolor.h (set_face_boolean_attached_to): * frame-gtk.c: * frame-x.c: * glyphs-eimage.c: * glyphs-gtk.c: * glyphs-msw.c: * glyphs-widget.c: * glyphs-x.c: * glyphs.c: * gtk-glue.c: * gtk-glue.c (xemacs_type_register): * gtk-xemacs.c: * inline.c: * intl-win32.c: * lisp.h: * lrecord.h: * mule-charset.c: * native-gtk-toolbar.c: * redisplay-msw.c: * redisplay-tty.c: * redisplay.c: * select-x.c: * select.c: * symsinit.h: * toolbar-msw.c: * toolbar-msw.c (TOOLBAR_ITEM_ID_BITS): * toolbar-x.c: * ui-gtk.c: * window.c: Rename objects*.[ch] -> fontcolor*.[ch]. Fix up all references to the old files (e.g. in #include statements, Makefiles, functions like syms_of_objects_x(), etc.). tests/ChangeLog addition: 2010-02-22 Ben Wing <ben@xemacs.org> * reproduce-crashes.el (8): objects*.[ch] -> fontcolor*.[ch].
author Ben Wing <ben@xemacs.org>
date Mon, 22 Feb 2010 06:49:30 -0600
parents src/objects-x.c@3c3c1d139863
children b65692aa90d8
comparison
equal deleted inserted replaced
5175:dc94bf0afa37 5176:8b2f75cecb89
1 /* X-specific Lisp objects.
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Tinker Systems.
5 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing.
6 Copyright (C) 1995 Sun Microsystems, Inc.
7
8 This file is part of XEmacs.
9
10 XEmacs is free software; you can redistribute it and/or modify it
11 under the terms of the GNU General Public License as published by the
12 Free Software Foundation; either version 2, or (at your option) any
13 later version.
14
15 XEmacs is distributed in the hope that it will be useful, but WITHOUT
16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with XEmacs; see the file COPYING. If not, write to
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 Boston, MA 02111-1307, USA. */
24
25 /* Synched up with: Not in FSF. */
26
27 /* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */
28
29 /* This file Mule-ized by Ben Wing, 7-10-00. */
30
31 #include <config.h>
32 #include "lisp.h"
33
34 #include "charset.h"
35 #include "device-impl.h"
36 #include "insdel.h"
37
38 #include "console-x-impl.h"
39 #include "fontcolor-x-impl.h"
40 #include "elhash.h"
41
42 #ifdef HAVE_XFT
43 #include "font-mgr.h"
44 #endif
45
46 int x_handle_non_fully_specified_fonts;
47
48 #ifdef DEBUG_XEMACS
49 Fixnum debug_x_objects;
50 #endif /* DEBUG_XEMACS */
51
52
53 /************************************************************************/
54 /* color instances */
55 /************************************************************************/
56
57 static int
58 x_parse_nearest_color (struct device *d, XColor *color, Lisp_Object name,
59 Error_Behavior errb)
60 {
61 Display *dpy = DEVICE_X_DISPLAY (d);
62 Colormap cmap = DEVICE_X_COLORMAP (d);
63 Visual *visual = DEVICE_X_VISUAL (d);
64 int result;
65
66 xzero (*color);
67 {
68 const Extbyte *extname;
69
70 extname = LISP_STRING_TO_EXTERNAL (name, Qx_color_name_encoding);
71 result = XParseColor (dpy, cmap, extname, color);
72 }
73 if (!result)
74 {
75 maybe_signal_error (Qgui_error, "Unrecognized color",
76 name, Qcolor, errb);
77 return 0;
78 }
79 result = x_allocate_nearest_color (dpy, cmap, visual, color);
80 if (!result)
81 {
82 maybe_signal_error (Qgui_error, "Couldn't allocate color",
83 name, Qcolor, errb);
84 return 0;
85 }
86
87 return result;
88 }
89
90 static int
91 x_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name,
92 Lisp_Object device, Error_Behavior errb)
93 {
94 XColor color;
95 #ifdef HAVE_XFT
96 XftColor xftColor;
97 #endif
98 int result;
99
100 result = x_parse_nearest_color (XDEVICE (device), &color, name, errb);
101
102 if (!result)
103 return 0;
104
105 /* Don't allocate the data until we're sure that we will succeed,
106 or the finalize method may get fucked. */
107 c->data = xnew (struct x_color_instance_data);
108 if (result == 3)
109 COLOR_INSTANCE_X_DEALLOC (c) = 0;
110 else
111 COLOR_INSTANCE_X_DEALLOC (c) = 1;
112 COLOR_INSTANCE_X_COLOR (c) = color;
113
114 #ifdef HAVE_XFT
115 xftColor.pixel = color.pixel;
116 xftColor.color.red = color.red;
117 xftColor.color.green = color.green;
118 xftColor.color.blue = color.blue;
119 xftColor.color.alpha = 0xffff;
120
121 COLOR_INSTANCE_X_XFTCOLOR (c) = xftColor;
122 #endif
123
124 return 1;
125 }
126
127 static void
128 x_print_color_instance (Lisp_Color_Instance *c,
129 Lisp_Object printcharfun,
130 int UNUSED (escapeflag))
131 {
132 XColor color = COLOR_INSTANCE_X_COLOR (c);
133 write_fmt_string (printcharfun, " %ld=(%X,%X,%X)",
134 color.pixel, color.red, color.green, color.blue);
135 }
136
137 static void
138 x_finalize_color_instance (Lisp_Color_Instance *c)
139 {
140 if (c->data)
141 {
142 if (DEVICE_LIVE_P (XDEVICE (c->device)))
143 {
144 if (COLOR_INSTANCE_X_DEALLOC (c))
145 {
146 XFreeColors (DEVICE_X_DISPLAY (XDEVICE (c->device)),
147 DEVICE_X_COLORMAP (XDEVICE (c->device)),
148 &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0);
149 }
150 }
151 xfree (c->data);
152 c->data = 0;
153 }
154 }
155
156 /* Color instances are equal if they resolve to the same color on the
157 screen (have the same RGB values). I imagine that
158 "same RGB values" == "same cell in the colormap." Arguably we should
159 be comparing their names or pixel values instead. */
160
161 static int
162 x_color_instance_equal (Lisp_Color_Instance *c1,
163 Lisp_Color_Instance *c2,
164 int UNUSED (depth))
165 {
166 XColor color1 = COLOR_INSTANCE_X_COLOR (c1);
167 XColor color2 = COLOR_INSTANCE_X_COLOR (c2);
168 return ((color1.red == color2.red) &&
169 (color1.green == color2.green) &&
170 (color1.blue == color2.blue));
171 }
172
173 static Hashcode
174 x_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth))
175 {
176 XColor color = COLOR_INSTANCE_X_COLOR (c);
177 return HASH3 (color.red, color.green, color.blue);
178 }
179
180 static Lisp_Object
181 x_color_instance_rgb_components (Lisp_Color_Instance *c)
182 {
183 XColor color = COLOR_INSTANCE_X_COLOR (c);
184 return (list3 (make_int (color.red),
185 make_int (color.green),
186 make_int (color.blue)));
187 }
188
189 static int
190 x_valid_color_name_p (struct device *d, Lisp_Object color)
191 {
192 XColor c;
193 Display *dpy = DEVICE_X_DISPLAY (d);
194 Colormap cmap = DEVICE_X_COLORMAP (d);
195 const Extbyte *extname;
196
197 extname = LISP_STRING_TO_EXTERNAL (color, Qx_color_name_encoding);
198
199 return XParseColor (dpy, cmap, extname, &c);
200 }
201
202 static Lisp_Object
203 x_color_list (void)
204 {
205 return call0 (intern ("x-color-list-internal"));
206 }
207
208
209 /************************************************************************/
210 /* font instances */
211 /************************************************************************/
212
213
214 static int
215 x_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object UNUSED (name),
216 Lisp_Object device, Error_Behavior errb)
217 {
218 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device));
219 Extbyte *extname;
220 XFontStruct *fs = NULL; /* _F_ont _S_truct */
221 #ifdef HAVE_XFT
222 XftFont *rf = NULL; /* _R_ender _F_ont (X Render extension) */
223 #else
224 #define rf (0)
225 #endif
226
227 #ifdef HAVE_XFT
228 DEBUG_XFT1 (2, "attempting to initialize font spec %s\n",
229 XSTRING_DATA(f->name));
230 /* #### serialize (optimize) these later... */
231 /* #### This function really needs to go away.
232 The problem is that the fontconfig/Xft functions work much too hard
233 to ensure that something is returned; but that something need not be
234 at all close to what we asked for. */
235 extname = LISP_STRING_TO_EXTERNAL (f->name, Qfc_font_name_encoding);
236 rf = xft_open_font_by_name (dpy, extname);
237 #endif
238 extname = LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding);
239 /* With XFree86 4.0's fonts, XListFonts returns an entry for
240 -isas-fangsong ti-medium-r-normal--16-160-72-72-c-160-gb2312.1980-0 but
241 an XLoadQueryFont on the corresponding XLFD returns NULL.
242
243 XListFonts is not trustworthy (of course, this is news to exactly
244 no-one used to reading XEmacs source.) */
245 fs = XLoadQueryFont (dpy, extname);
246
247 if (!fs && !rf)
248 {
249 /* #### should this refer to X and/or Xft? */
250 maybe_signal_error (Qgui_error, "Couldn't load font", f->name,
251 Qfont, errb);
252 return 0;
253 }
254
255 if (rf && fs)
256 {
257 XFreeFont (dpy, fs);
258 fs = NULL; /* we don' need no steenkin' X font */
259 }
260
261 if (fs && !fs->max_bounds.width)
262 {
263 /* yes, this has been known to happen. */
264 XFreeFont (dpy, fs);
265 fs = NULL;
266 maybe_signal_error (Qgui_error, "X font is too small", f->name, Qfont,
267 errb);
268 return 0;
269 }
270
271 /* Now that we're sure that we will succeed, we can allocate data without
272 fear that the finalize method may get fucked. */
273 f->data = xnew (struct x_font_instance_data);
274
275 #ifdef HAVE_XFT
276 FONT_INSTANCE_X_XFTFONT (f) = rf;
277 if (rf)
278 /* Have an Xft font, initialize font info from it. */
279 {
280 DEBUG_XFT4 (2, "pre-initial ascent %d descent %d width %d height %d\n",
281 f->ascent, f->descent, f->width, f->height);
282
283 /* #### This shit is just plain wrong unless we have a character cell
284 font. It really hoses us on large repertoire Unicode fonts with
285 "double-width" characters. */
286 f->ascent = rf->ascent;
287 f->descent = rf->descent;
288 {
289 /* This is an approximation that AFAIK only gets used to compute
290 cell size for estimating window dimensions. The test_string8
291 is an ASCII string whose characters should approximate the
292 distribution of widths expected in real text. */
293 static const FcChar8 test_string8[] = "Mmneei";
294 static const int len = sizeof (test_string8) - 1;
295 XGlyphInfo glyphinfo;
296
297 XftTextExtents8 (dpy, rf, test_string8, len, &glyphinfo);
298 /* #### maybe should be glyphinfo.xOff - glyphinfo.x? */
299 f->width = (2*glyphinfo.width + len)/(2*len);
300 }
301 f->height = rf->height;
302 f->proportional_p = 1; /* we can't recognize monospaced fonts! */
303
304 /* #### This message appears wa-a-ay too often!
305 We probably need to cache truenames or something?
306 Even if Xft does it for us, we cons too many font instances. */
307 DEBUG_XFT4 (0,
308 "initialized metrics ascent %d descent %d width %d height %d\n",
309 f->ascent, f->descent, f->width, f->height);
310 }
311 else
312 {
313 DEBUG_XFT1 (0, "couldn't initialize Xft font %s\n",
314 XSTRING_DATA(f->name));
315 }
316 #endif
317
318 FONT_INSTANCE_X_FONT (f) = fs;
319 if (fs)
320 /* Have to use a core font, initialize font info from it. */
321 {
322 f->ascent = fs->ascent;
323 f->descent = fs->descent;
324 f->height = fs->ascent + fs->descent;
325 {
326 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
327 int def_char = 'n'; /*fs->default_char;*/
328 int byte1, byte2;
329
330 once_more:
331 byte1 = def_char >> 8;
332 byte2 = def_char & 0xFF;
333
334 if (fs->per_char)
335 {
336 /* Old versions of the R5 font server have garbage (>63k) as
337 def_char. 'n' might not be a valid character. */
338 if (byte1 < (int) fs->min_byte1 ||
339 byte1 > (int) fs->max_byte1 ||
340 byte2 < (int) fs->min_char_or_byte2 ||
341 byte2 > (int) fs->max_char_or_byte2)
342 f->width = 0;
343 else
344 f->width = fs->per_char[(byte1 - fs->min_byte1) *
345 (fs->max_char_or_byte2 -
346 fs->min_char_or_byte2 + 1) +
347 (byte2 - fs->min_char_or_byte2)].width;
348 }
349 else
350 f->width = fs->max_bounds.width;
351
352 /* Some fonts have a default char whose width is 0. This is no good.
353 If that's the case, first try 'n' as the default char, and if n has
354 0 width too (unlikely) then just use the max width. */
355 if (f->width == 0)
356 {
357 if (def_char == (int) fs->default_char)
358 f->width = fs->max_bounds.width;
359 else
360 {
361 def_char = fs->default_char;
362 goto once_more;
363 }
364 }
365 }
366
367 /* If all characters don't exist then there could potentially be
368 0-width characters lurking out there. Not setting this flag
369 trips an optimization that would make them appear to have width
370 to redisplay. This is bad. So we set it if not all characters
371 have the same width or if not all characters are defined. */
372 /* #### This sucks. There is a measurable performance increase
373 when using proportional width fonts if this flag is not set.
374 Unfortunately so many of the fucking X fonts are not fully
375 defined that we could almost just get rid of this damn flag and
376 make it an assertion. */
377 f->proportional_p = (fs->min_bounds.width != fs->max_bounds.width ||
378 (x_handle_non_fully_specified_fonts &&
379 !fs->all_chars_exist));
380 }
381
382 #ifdef HAVE_XFT
383 if (debug_xft > 0)
384 {
385 int n = 3, d = 5;
386 /* check for weirdness */
387 if (n * f->height < d * f->width)
388 stderr_out ("font %s: width:height is %d:%d, larger than %d:%d\n",
389 XSTRING_DATA(f->name), f->width, f->height, n, d);
390 if (f->height <= 0 || f->width <= 0)
391 stderr_out ("bogus dimensions of font %s: width = %d, height = %d\n",
392 XSTRING_DATA(f->name), f->width, f->height);
393 stderr_out ("initialized font %s\n", XSTRING_DATA(f->name));
394 }
395 #else
396 #undef rf
397 #endif
398
399 return 1;
400 }
401
402 static void
403 x_print_font_instance (Lisp_Font_Instance *f,
404 Lisp_Object printcharfun,
405 int UNUSED (escapeflag))
406 {
407 /* We should print information here about initial vs. final stages; we
408 can't rely on the device charset stage cache for that,
409 unfortunately. */
410 if (FONT_INSTANCE_X_FONT (f))
411 write_fmt_string (printcharfun, " font id: 0x%lx,",
412 (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
413
414 #ifdef HAVE_XFT
415 /* #### What should we do here? For now, print the address. */
416 if (FONT_INSTANCE_X_XFTFONT (f))
417 write_fmt_string (printcharfun, " xft font: 0x%lx",
418 (unsigned long) FONT_INSTANCE_X_XFTFONT (f));
419 #endif
420 }
421
422 static void
423 x_finalize_font_instance (Lisp_Font_Instance *f)
424 {
425
426 #ifdef HAVE_XFT
427 DEBUG_XFT1 (0, "finalizing %s\n", (STRINGP (f->name)
428 ? (char *) XSTRING_DATA (f->name)
429 : "(unnamed font)"));
430 #endif
431
432 if (f->data)
433 {
434 if (DEVICE_LIVE_P (XDEVICE (f->device)))
435 {
436 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device));
437
438 if (FONT_INSTANCE_X_FONT (f))
439 XFreeFont (dpy, FONT_INSTANCE_X_FONT (f));
440 #ifdef HAVE_XFT
441 if (FONT_INSTANCE_X_XFTFONT (f))
442 XftFontClose (dpy, FONT_INSTANCE_X_XFTFONT (f));
443 #endif
444 }
445 xfree (f->data);
446 f->data = 0;
447 }
448 }
449
450 /* Determining the truename of a font is hard. (Big surprise.)
451
452 This is not true for fontconfig. Each font has a (nearly) canonical
453 representation up to permutation of the order of properties. It is
454 possible to construct a name which exactly identifies the properties of
455 the current font. However, it is theoretically possible that there exists
456 another font with a super set of those properties that would happen to get
457 selected. -- sjt
458
459 By "truename" we mean an XLFD-form name which contains no wildcards, yet
460 which resolves to *exactly* the same font as the one which we already have
461 the (probably wildcarded) name and `XFontStruct' of.
462
463 One might think that the first font returned by XListFonts would be the one
464 that XOpenFont would pick. Apparently this is the case on some servers,
465 but not on others. It would seem not to be specified.
466
467 The MIT R5 server sometimes appears to be picking the lexicographically
468 smallest font which matches the name (thus picking "adobe" fonts before
469 "bitstream" fonts even if the bitstream fonts are earlier in the path, and
470 also picking 100dpi adobe fonts over 75dpi adobe fonts even though the
471 75dpi are in the path earlier) but sometimes appears to be doing something
472 else entirely (for example, removing the bitstream fonts from the path will
473 cause the 75dpi adobe fonts to be used instead of the 100dpi, even though
474 their relative positions in the path (and their names!) have not changed).
475
476 The documentation for XSetFontPath() seems to indicate that the order of
477 entries in the font path means something, but it's pretty noncommittal about
478 it, and the spirit of the law is apparently not being obeyed...
479
480 All the fonts I've seen have a property named `FONT' which contains the
481 truename of the font. However, there are two problems with using this: the
482 first is that the X Protocol Document is quite explicit that all properties
483 are optional, so we can't depend on it being there. The second is that
484 it's conceivable that this alleged truename isn't actually accessible as a
485 font, due to some difference of opinion between the font designers and
486 whoever installed the font on the system.
487
488 So, our first attempt is to look for a FONT property, and then verify that
489 the name there is a valid name by running XListFonts on it. There's still
490 the potential that this could be true but we could still be being lied to,
491 but that seems pretty remote.
492
493 Late breaking news: I've gotten reports that SunOS 4.1.3U1
494 with OpenWound 3.0 has a font whose truename is really
495 "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1"
496 but whose FONT property contains "Courier".
497
498 So we disbelieve the FONT property unless it begins with a dash and
499 is more than 30 characters long. X Windows: The defacto substandard.
500 X Windows: Complex nonsolutions to simple nonproblems. X Windows:
501 Live the nightmare.
502
503 If the FONT property doesn't exist, then we try and construct an XLFD name
504 out of the other font properties (FOUNDRY, FAMILY_NAME, WEIGHT_NAME, etc).
505 This is necessary at least for some versions of OpenWound. But who knows
506 what the future will bring.
507
508 If that doesn't work, then we use XListFonts and either take the first font
509 (which I think is the most sensible thing) or we find the lexicographically
510 least, depending on whether the preprocessor constant `XOPENFONT_SORTS' is
511 defined. This sucks because the two behaviors are a property of the server
512 being used, not the architecture on which emacs has been compiled. Also,
513 as I described above, sorting isn't ALWAYS what the server does. Really it
514 does something seemingly random. There is no reliable way to win if the
515 FONT property isn't present.
516
517 Another possibility which I haven't bothered to implement would be to map
518 over all of the matching fonts and find the first one that has the same
519 character metrics as the font we already have loaded. Even if this didn't
520 return exactly the same font, it would at least return one whose characters
521 were the same sizes, which would probably be good enough.
522
523 More late-breaking news: on RS/6000 AIX 3.2.4, the expression
524 XLoadQueryFont (dpy, "-*-Fixed-Medium-R-*-*-*-130-75-75-*-*-ISO8859-1")
525 actually returns the font
526 -Misc-Fixed-Medium-R-Normal--13-120-75-75-C-80-ISO8859-1
527 which is crazy, because that font doesn't even match that pattern! It is
528 also not included in the output produced by `xlsfonts' with that pattern.
529
530 So this is yet another example of XListFonts() and XOpenFont() using
531 completely different algorithms. This, however, is a goofier example of
532 this bug, because in this case, it's not just the search order that is
533 different -- the sets don't even intersect.
534
535 If anyone has any better ideas how to do this, or any insights on what it is
536 that the various servers are actually doing, please let me know! -- jwz. */
537
538 static int
539 valid_x_font_name_p (Display *dpy, Extbyte *name)
540 {
541 /* Maybe this should be implemented by calling XLoadFont and trapping
542 the error. That would be a lot of work, and wasteful as hell, but
543 might be more correct.
544 */
545 int nnames = 0;
546 Extbyte **names = 0;
547 if (! name)
548 return 0;
549 names = XListFonts (dpy, name, 1, &nnames);
550 if (names)
551 XFreeFontNames (names);
552 return (nnames != 0);
553 }
554
555 static Extbyte *
556 truename_via_FONT_prop (Display *dpy, XFontStruct *font)
557 {
558 unsigned long value = 0;
559 Extbyte *result = 0;
560 if (XGetFontProperty (font, XA_FONT, &value))
561 result = XGetAtomName (dpy, value);
562 /* result is now 0, or the string value of the FONT property. */
563 if (result)
564 {
565 /* Verify that result is an XLFD name (roughly...) */
566 if (result [0] != '-' || strlen (result) < 30)
567 {
568 XFree (result);
569 result = 0;
570 }
571 }
572 return result; /* this must be freed by caller if non-0 */
573 }
574
575 static Extbyte *
576 truename_via_random_props (Display *dpy, XFontStruct *font)
577 {
578 struct device *d = get_device_from_display (dpy);
579 unsigned long value = 0;
580 Extbyte *foundry, *family, *weight, *slant, *setwidth, *add_style;
581 unsigned long pixel, point, res_x, res_y;
582 Extbyte *spacing;
583 unsigned long avg_width;
584 Extbyte *registry, *encoding;
585 Extbyte composed_name [2048];
586 int ok = 0;
587 Extbyte *result;
588
589 #define get_string(atom,var) \
590 if (XGetFontProperty (font, (atom), &value)) \
591 var = XGetAtomName (dpy, value); \
592 else { \
593 var = 0; \
594 goto FAIL; }
595 #define get_number(atom,var) \
596 if (!XGetFontProperty (font, (atom), &var) || \
597 var > 999) \
598 goto FAIL;
599
600 foundry = family = weight = slant = setwidth = 0;
601 add_style = spacing = registry = encoding = 0;
602
603 get_string (DEVICE_XATOM_FOUNDRY (d), foundry);
604 get_string (DEVICE_XATOM_FAMILY_NAME (d), family);
605 get_string (DEVICE_XATOM_WEIGHT_NAME (d), weight);
606 get_string (DEVICE_XATOM_SLANT (d), slant);
607 get_string (DEVICE_XATOM_SETWIDTH_NAME (d), setwidth);
608 get_string (DEVICE_XATOM_ADD_STYLE_NAME (d), add_style);
609 get_number (DEVICE_XATOM_PIXEL_SIZE (d), pixel);
610 get_number (DEVICE_XATOM_POINT_SIZE (d), point);
611 get_number (DEVICE_XATOM_RESOLUTION_X (d), res_x);
612 get_number (DEVICE_XATOM_RESOLUTION_Y (d), res_y);
613 get_string (DEVICE_XATOM_SPACING (d), spacing);
614 get_number (DEVICE_XATOM_AVERAGE_WIDTH (d), avg_width);
615 get_string (DEVICE_XATOM_CHARSET_REGISTRY (d), registry);
616 get_string (DEVICE_XATOM_CHARSET_ENCODING (d), encoding);
617 #undef get_number
618 #undef get_string
619
620 sprintf (composed_name,
621 "-%s-%s-%s-%s-%s-%s-%ld-%ld-%ld-%ld-%s-%ld-%s-%s",
622 foundry, family, weight, slant, setwidth, add_style, pixel,
623 point, res_x, res_y, spacing, avg_width, registry, encoding);
624 ok = 1;
625
626 FAIL:
627 if (ok)
628 {
629 int L = strlen (composed_name) + 1;
630 result = xnew_extbytes (L);
631 strncpy (result, composed_name, L);
632 }
633 else
634 result = 0;
635
636 if (foundry) XFree (foundry);
637 if (family) XFree (family);
638 if (weight) XFree (weight);
639 if (slant) XFree (slant);
640 if (setwidth) XFree (setwidth);
641 if (add_style) XFree (add_style);
642 if (spacing) XFree (spacing);
643 if (registry) XFree (registry);
644 if (encoding) XFree (encoding);
645
646 return result;
647 }
648
649 /* XListFonts doesn't allocate memory unconditionally based on this. (For
650 XFree86 in 2005, at least. */
651 #define MAX_FONT_COUNT INT_MAX
652
653 static Extbyte *
654 truename_via_XListFonts (Display *dpy, Extbyte *font_name)
655 {
656 Extbyte *result = 0;
657 Extbyte **names;
658 int count = 0;
659
660 #ifndef XOPENFONT_SORTS
661 /* In a sensible world, the first font returned by XListFonts()
662 would be the font that XOpenFont() would use. */
663 names = XListFonts (dpy, font_name, 1, &count);
664 if (count) result = names [0];
665 #else
666 /* But the world I live in is much more perverse. */
667 names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count);
668 /* Find the lexicographic minimum of names[].
669 (#### Should we be comparing case-insensitively?) */
670 while (count--)
671 /* [[ !!#### Not Mule-friendly ]]
672 Doesn't matter, XLFDs are HPC (old) or Latin1 (modern). If they
673 aren't, who knows what they are? -- sjt */
674 if (result == 0 || (strcmp (result, names [count]) < 0))
675 result = names [count];
676 #endif
677
678 if (result)
679 result = xstrdup (result);
680 if (names)
681 XFreeFontNames (names);
682
683 return result; /* this must be freed by caller if non-0 */
684 }
685
686 static Lisp_Object
687 x_font_truename (Display *dpy, Extbyte *name, XFontStruct *font)
688 {
689 Extbyte *truename_FONT = 0;
690 Extbyte *truename_random = 0;
691 Extbyte *truename = 0;
692
693 /* The search order is:
694 - if FONT property exists, and is a valid name, return it.
695 - if the other props exist, and add up to a valid name, return it.
696 - if we find a matching name with XListFonts, return it.
697 - if FONT property exists, return it regardless.
698 - if other props exist, return the resultant name regardless.
699 - else return 0.
700 */
701
702 truename = truename_FONT = truename_via_FONT_prop (dpy, font);
703 if (truename && !valid_x_font_name_p (dpy, truename))
704 truename = 0;
705 if (!truename)
706 truename = truename_random = truename_via_random_props (dpy, font);
707 if (truename && !valid_x_font_name_p (dpy, truename))
708 truename = 0;
709 if (!truename && name)
710 truename = truename_via_XListFonts (dpy, name);
711
712 if (!truename)
713 {
714 /* Gag - we weren't able to find a seemingly-valid truename.
715 Well, maybe we're on one of those braindead systems where
716 XListFonts() and XLoadFont() are in violent disagreement.
717 If we were able to compute a truename, try using that even
718 if evidence suggests that it's not a valid name - because
719 maybe it is, really, and that's better than nothing.
720 X Windows: You'll envy the dead.
721 */
722 if (truename_FONT)
723 truename = truename_FONT;
724 else if (truename_random)
725 truename = truename_random;
726 }
727
728 /* One or both of these are not being used - free them. */
729 if (truename_FONT && truename_FONT != truename)
730 XFree (truename_FONT);
731 if (truename_random && truename_random != truename)
732 XFree (truename_random);
733
734 if (truename)
735 {
736 Lisp_Object result = build_extstring (truename, Qx_font_name_encoding);
737 XFree (truename);
738 return result;
739 }
740 else
741 return Qnil;
742 }
743
744 static Lisp_Object
745 x_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb)
746 {
747 struct device *d = XDEVICE (f->device);
748 Display *dpy = DEVICE_X_DISPLAY (d);
749 Extbyte *nameext;
750
751 /* #### restructure this so that we return a valid truename at the end,
752 and otherwise only return when we return something desperate that
753 doesn't get stored for future use. */
754
755 #ifdef HAVE_XFT
756 /* First, try an Xft font. */
757 if (NILP (FONT_INSTANCE_TRUENAME (f)) && FONT_INSTANCE_X_XFTFONT (f))
758 {
759 /* The font is already open, we just unparse. */
760 FcChar8 *res = FcNameUnparse (FONT_INSTANCE_X_XFTFONT (f)->pattern);
761 if (! FONT_INSTANCE_X_XFTFONT (f)->pattern)
762 {
763 maybe_signal_error (Qgui_error,
764 "Xft font present but lacks pattern",
765 wrap_font_instance(f), Qfont, errb);
766 }
767 if (res)
768 {
769 FONT_INSTANCE_TRUENAME (f) =
770 build_extstring ((Extbyte *) res, Qfc_font_name_encoding);
771 free (res);
772 return FONT_INSTANCE_TRUENAME (f);
773 }
774 else
775 {
776 maybe_signal_error (Qgui_error,
777 "Couldn't unparse Xft font to truename",
778 wrap_font_instance(f), Qfont, errb);
779 /* used to return Qnil here */
780 }
781 }
782 #endif /* HAVE_XFT */
783
784 /* OK, fall back to core font. */
785 if (NILP (FONT_INSTANCE_TRUENAME (f))
786 && FONT_INSTANCE_X_FONT (f))
787 {
788 nameext = LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding);
789 FONT_INSTANCE_TRUENAME (f) =
790 x_font_truename (dpy, nameext, FONT_INSTANCE_X_FONT (f));
791 }
792
793 if (NILP (FONT_INSTANCE_TRUENAME (f)))
794 {
795 /* Urk, no luck. Whine about our bad luck and exit. */
796 Lisp_Object font_instance = wrap_font_instance (f);
797
798
799 maybe_signal_error (Qgui_error, "Couldn't determine font truename",
800 font_instance, Qfont, errb);
801 /* Ok, just this once, return the font name as the truename.
802 (This is only used by Fequal() right now.) */
803 return f->name;
804 }
805
806 /* Return what we found. */
807 return FONT_INSTANCE_TRUENAME (f);
808 }
809
810 static Lisp_Object
811 x_font_instance_properties (Lisp_Font_Instance *f)
812 {
813 struct device *d = XDEVICE (f->device);
814 int i;
815 Lisp_Object result = Qnil;
816 Display *dpy = DEVICE_X_DISPLAY (d);
817 XFontProp *props = NULL;
818
819 /* #### really should hack Xft fonts, too
820 Strategy: fontconfig must have an iterator for this purpose. */
821 if (! FONT_INSTANCE_X_FONT (f)) return result;
822
823 props = FONT_INSTANCE_X_FONT (f)->properties;
824 for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--)
825 {
826 Lisp_Object name, value;
827 Atom atom = props [i].name;
828 Ibyte *name_str = 0;
829 Bytecount name_len;
830 Extbyte *namestrext = XGetAtomName (dpy, atom);
831
832 if (namestrext)
833 TO_INTERNAL_FORMAT (C_STRING, namestrext,
834 ALLOCA, (name_str, name_len),
835 Qx_atom_name_encoding);
836
837 name = (name_str ? intern_istring (name_str) : Qnil);
838 if (name_str &&
839 (atom == XA_FONT ||
840 atom == DEVICE_XATOM_FOUNDRY (d) ||
841 atom == DEVICE_XATOM_FAMILY_NAME (d) ||
842 atom == DEVICE_XATOM_WEIGHT_NAME (d) ||
843 atom == DEVICE_XATOM_SLANT (d) ||
844 atom == DEVICE_XATOM_SETWIDTH_NAME (d) ||
845 atom == DEVICE_XATOM_ADD_STYLE_NAME (d) ||
846 atom == DEVICE_XATOM_SPACING (d) ||
847 atom == DEVICE_XATOM_CHARSET_REGISTRY (d) ||
848 atom == DEVICE_XATOM_CHARSET_ENCODING (d) ||
849 !qxestrcmp_ascii (name_str, "CHARSET_COLLECTIONS") ||
850 !qxestrcmp_ascii (name_str, "FONTNAME_REGISTRY") ||
851 !qxestrcmp_ascii (name_str, "CLASSIFICATION") ||
852 !qxestrcmp_ascii (name_str, "COPYRIGHT") ||
853 !qxestrcmp_ascii (name_str, "DEVICE_FONT_NAME") ||
854 !qxestrcmp_ascii (name_str, "FULL_NAME") ||
855 !qxestrcmp_ascii (name_str, "MONOSPACED") ||
856 !qxestrcmp_ascii (name_str, "QUALITY") ||
857 !qxestrcmp_ascii (name_str, "RELATIVE_SET") ||
858 !qxestrcmp_ascii (name_str, "RELATIVE_WEIGHT") ||
859 !qxestrcmp_ascii (name_str, "STYLE")))
860 {
861 Extbyte *val_str = XGetAtomName (dpy, props [i].card32);
862
863 value = (val_str ? build_extstring (val_str, Qx_atom_name_encoding)
864 : Qnil);
865 }
866 else
867 value = make_int (props [i].card32);
868 if (namestrext) XFree (namestrext);
869 result = Fcons (Fcons (name, value), result);
870 }
871 return result;
872 }
873
874 static Lisp_Object
875 x_font_list (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber)
876 {
877 Extbyte **names;
878 int count = 0;
879 int max_number = MAX_FONT_COUNT;
880 Lisp_Object result = Qnil;
881 const Extbyte *patternext;
882
883 patternext = LISP_STRING_TO_EXTERNAL (pattern, Qx_font_name_encoding);
884
885 if (!NILP(maxnumber) && INTP(maxnumber))
886 {
887 max_number = XINT(maxnumber);
888 }
889
890 names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
891 patternext, max_number, &count);
892 while (count--)
893 result = Fcons (build_extstring (names[count], Qx_font_name_encoding),
894 result);
895 if (names)
896 XFreeFontNames (names);
897 return result;
898 }
899
900 /* Include the charset support, shared, for the moment, with GTK. */
901 #define THIS_IS_X
902 #include "fontcolor-xlike-inc.c"
903
904
905 /************************************************************************/
906 /* initialization */
907 /************************************************************************/
908
909 void
910 syms_of_fontcolor_x (void)
911 {
912 }
913
914 void
915 console_type_create_fontcolor_x (void)
916 {
917 /* object methods */
918
919 CONSOLE_HAS_METHOD (x, initialize_color_instance);
920 CONSOLE_HAS_METHOD (x, print_color_instance);
921 CONSOLE_HAS_METHOD (x, finalize_color_instance);
922 CONSOLE_HAS_METHOD (x, color_instance_equal);
923 CONSOLE_HAS_METHOD (x, color_instance_hash);
924 CONSOLE_HAS_METHOD (x, color_instance_rgb_components);
925 CONSOLE_HAS_METHOD (x, valid_color_name_p);
926 CONSOLE_HAS_METHOD (x, color_list);
927
928 CONSOLE_HAS_METHOD (x, initialize_font_instance);
929 CONSOLE_HAS_METHOD (x, print_font_instance);
930 CONSOLE_HAS_METHOD (x, finalize_font_instance);
931 CONSOLE_HAS_METHOD (x, font_instance_truename);
932 CONSOLE_HAS_METHOD (x, font_instance_properties);
933 CONSOLE_HAS_METHOD (x, font_list);
934 #ifdef MULE
935 CONSOLE_HAS_METHOD (x, find_charset_font);
936 CONSOLE_HAS_METHOD (x, font_spec_matches_charset);
937 #endif
938 }
939
940 void
941 vars_of_fontcolor_x (void)
942 {
943 #ifdef DEBUG_XEMACS
944 DEFVAR_INT ("debug-x-objects", &debug_x_objects /*
945 If non-zero, display debug information about X objects
946 */ );
947 debug_x_objects = 0;
948 #endif
949
950 DEFVAR_BOOL ("x-handle-non-fully-specified-fonts",
951 &x_handle_non_fully_specified_fonts /*
952 If this is true then fonts which do not have all characters specified
953 will be considered to be proportional width even if they are actually
954 fixed-width. If this is not done then characters which are supposed to
955 have 0 width may appear to actually have some width.
956
957 Note: While setting this to t guarantees correct output in all
958 circumstances, it also causes a noticeable performance hit when using
959 fixed-width fonts. Since most people don't use characters which could
960 cause problems this is set to nil by default.
961 */ );
962 x_handle_non_fully_specified_fonts = 0;
963
964 #ifdef HAVE_XFT
965 Fprovide (intern ("xft-fonts"));
966 #endif
967 }
968
969 void
970 Xatoms_of_fontcolor_x (struct device *d)
971 {
972 Display *D = DEVICE_X_DISPLAY (d);
973
974 DEVICE_XATOM_FOUNDRY (d) = XInternAtom (D, "FOUNDRY", False);
975 DEVICE_XATOM_FAMILY_NAME (d) = XInternAtom (D, "FAMILY_NAME", False);
976 DEVICE_XATOM_WEIGHT_NAME (d) = XInternAtom (D, "WEIGHT_NAME", False);
977 DEVICE_XATOM_SLANT (d) = XInternAtom (D, "SLANT", False);
978 DEVICE_XATOM_SETWIDTH_NAME (d) = XInternAtom (D, "SETWIDTH_NAME", False);
979 DEVICE_XATOM_ADD_STYLE_NAME (d) = XInternAtom (D, "ADD_STYLE_NAME", False);
980 DEVICE_XATOM_PIXEL_SIZE (d) = XInternAtom (D, "PIXEL_SIZE", False);
981 DEVICE_XATOM_POINT_SIZE (d) = XInternAtom (D, "POINT_SIZE", False);
982 DEVICE_XATOM_RESOLUTION_X (d) = XInternAtom (D, "RESOLUTION_X", False);
983 DEVICE_XATOM_RESOLUTION_Y (d) = XInternAtom (D, "RESOLUTION_Y", False);
984 DEVICE_XATOM_SPACING (d) = XInternAtom (D, "SPACING", False);
985 DEVICE_XATOM_AVERAGE_WIDTH (d) = XInternAtom (D, "AVERAGE_WIDTH", False);
986 DEVICE_XATOM_CHARSET_REGISTRY(d) = XInternAtom (D, "CHARSET_REGISTRY",False);
987 DEVICE_XATOM_CHARSET_ENCODING(d) = XInternAtom (D, "CHARSET_ENCODING",False);
988 }