428
|
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.
|
2367
|
5 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing.
|
428
|
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
|
442
|
29 /* This file Mule-ized by Ben Wing, 7-10-00. */
|
|
30
|
428
|
31 #include <config.h>
|
|
32 #include "lisp.h"
|
|
33
|
872
|
34 #include "charset.h"
|
|
35 #include "device-impl.h"
|
|
36 #include "insdel.h"
|
428
|
37
|
872
|
38 #include "console-x-impl.h"
|
|
39 #include "objects-x-impl.h"
|
3659
|
40 #include "elhash.h"
|
428
|
41
|
3094
|
42 #ifdef USE_XFT
|
3354
|
43 #include "font-mgr.h"
|
3094
|
44 #endif
|
|
45
|
428
|
46 int x_handle_non_fully_specified_fonts;
|
|
47
|
3659
|
48 #ifdef DEBUG_XEMACS
|
|
49 Fixnum debug_x_objects;
|
|
50 #endif /* DEBUG_XEMACS */
|
|
51
|
428
|
52
|
|
53 /************************************************************************/
|
|
54 /* color instances */
|
|
55 /************************************************************************/
|
|
56
|
442
|
57 static int
|
|
58 x_parse_nearest_color (struct device *d, XColor *color, Lisp_Object name,
|
578
|
59 Error_Behavior errb)
|
428
|
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 {
|
442
|
68 const Extbyte *extname;
|
428
|
69
|
442
|
70 LISP_STRING_TO_EXTERNAL (name, extname, Qx_color_name_encoding);
|
|
71 result = XParseColor (dpy, cmap, extname, color);
|
428
|
72 }
|
|
73 if (!result)
|
|
74 {
|
563
|
75 maybe_signal_error (Qgui_error, "Unrecognized color",
|
|
76 name, Qcolor, errb);
|
428
|
77 return 0;
|
|
78 }
|
3094
|
79 result = x_allocate_nearest_color (dpy, cmap, visual, color);
|
428
|
80 if (!result)
|
|
81 {
|
563
|
82 maybe_signal_error (Qgui_error, "Couldn't allocate color",
|
|
83 name, Qcolor, errb);
|
428
|
84 return 0;
|
|
85 }
|
|
86
|
|
87 return result;
|
|
88 }
|
|
89
|
|
90 static int
|
440
|
91 x_initialize_color_instance (Lisp_Color_Instance *c, Lisp_Object name,
|
578
|
92 Lisp_Object device, Error_Behavior errb)
|
428
|
93 {
|
|
94 XColor color;
|
3094
|
95 #ifdef USE_XFT
|
|
96 XftColor xftColor;
|
|
97 #endif
|
428
|
98 int result;
|
|
99
|
442
|
100 result = x_parse_nearest_color (XDEVICE (device), &color, name, errb);
|
428
|
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;
|
3094
|
113
|
|
114 #ifdef USE_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
|
428
|
124 return 1;
|
|
125 }
|
|
126
|
|
127 static void
|
440
|
128 x_print_color_instance (Lisp_Color_Instance *c,
|
428
|
129 Lisp_Object printcharfun,
|
2286
|
130 int UNUSED (escapeflag))
|
428
|
131 {
|
|
132 XColor color = COLOR_INSTANCE_X_COLOR (c);
|
800
|
133 write_fmt_string (printcharfun, " %ld=(%X,%X,%X)",
|
|
134 color.pixel, color.red, color.green, color.blue);
|
428
|
135 }
|
|
136
|
|
137 static void
|
440
|
138 x_finalize_color_instance (Lisp_Color_Instance *c)
|
428
|
139 {
|
|
140 if (c->data)
|
|
141 {
|
|
142 if (DEVICE_LIVE_P (XDEVICE (c->device)))
|
|
143 {
|
|
144 if (COLOR_INSTANCE_X_DEALLOC (c))
|
|
145 {
|
442
|
146 XFreeColors (DEVICE_X_DISPLAY (XDEVICE (c->device)),
|
|
147 DEVICE_X_COLORMAP (XDEVICE (c->device)),
|
428
|
148 &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0);
|
|
149 }
|
|
150 }
|
1726
|
151 xfree (c->data, void *);
|
428
|
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
|
440
|
162 x_color_instance_equal (Lisp_Color_Instance *c1,
|
|
163 Lisp_Color_Instance *c2,
|
2286
|
164 int UNUSED (depth))
|
428
|
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
|
2515
|
173 static Hashcode
|
2286
|
174 x_color_instance_hash (Lisp_Color_Instance *c, int UNUSED (depth))
|
428
|
175 {
|
|
176 XColor color = COLOR_INSTANCE_X_COLOR (c);
|
|
177 return HASH3 (color.red, color.green, color.blue);
|
|
178 }
|
|
179
|
|
180 static Lisp_Object
|
440
|
181 x_color_instance_rgb_components (Lisp_Color_Instance *c)
|
428
|
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);
|
442
|
195 const Extbyte *extname;
|
428
|
196
|
442
|
197 LISP_STRING_TO_EXTERNAL (color, extname, Qx_color_name_encoding);
|
428
|
198
|
440
|
199 return XParseColor (dpy, cmap, extname, &c);
|
428
|
200 }
|
|
201
|
2527
|
202 static Lisp_Object
|
|
203 x_color_list (void)
|
|
204 {
|
|
205 return call0 (intern ("x-color-list-internal"));
|
|
206 }
|
|
207
|
428
|
208
|
|
209 /************************************************************************/
|
|
210 /* font instances */
|
|
211 /************************************************************************/
|
|
212
|
3094
|
213
|
428
|
214 static int
|
2286
|
215 x_initialize_font_instance (Lisp_Font_Instance *f, Lisp_Object UNUSED (name),
|
578
|
216 Lisp_Object device, Error_Behavior errb)
|
428
|
217 {
|
440
|
218 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (device));
|
3094
|
219 Extbyte *extname;
|
|
220 XFontStruct *fs = NULL; /* _F_ont _S_truct */
|
|
221 #ifdef USE_XFT
|
|
222 XftFont *rf = NULL; /* _R_ender _F_ont (X Render extension) */
|
|
223 #else
|
|
224 #define rf (0)
|
|
225 #endif
|
428
|
226
|
3094
|
227 #ifdef USE_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. */
|
3360
|
235 LISP_STRING_TO_EXTERNAL (f->name, extname, Qfc_font_name_encoding);
|
3094
|
236 rf = xft_open_font_by_name (dpy, extname);
|
|
237 #endif
|
442
|
238 LISP_STRING_TO_EXTERNAL (f->name, extname, Qx_font_name_encoding);
|
3659
|
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.) */
|
3094
|
245 fs = XLoadQueryFont (dpy, extname);
|
|
246
|
|
247 if (!fs && !rf)
|
428
|
248 {
|
3094
|
249 /* #### should this refer to X and/or Xft? */
|
|
250 maybe_signal_error (Qgui_error, "Couldn't load font", f->name,
|
|
251 Qfont, errb);
|
428
|
252 return 0;
|
|
253 }
|
|
254
|
3389
|
255 if (rf && fs)
|
|
256 {
|
|
257 XFreeFont (dpy, fs);
|
|
258 fs = NULL; /* we don' need no steenkin' X font */
|
|
259 }
|
|
260
|
3094
|
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);
|
3389
|
268 return 0;
|
3094
|
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. */
|
428
|
273 f->data = xnew (struct x_font_instance_data);
|
|
274
|
3094
|
275 #ifdef USE_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);
|
428
|
282
|
3094
|
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;
|
428
|
288 {
|
3094
|
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. */
|
3469
|
293 static const FcChar8 test_string8[] = "Mmneei";
|
3094
|
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);
|
428
|
300 }
|
3094
|
301 f->height = rf->height;
|
|
302 f->proportional_p = 1; /* we can't recognize monospaced fonts! */
|
|
303
|
3389
|
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);
|
3094
|
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;
|
428
|
329
|
3094
|
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 }
|
428
|
349 else
|
3094
|
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)
|
428
|
356 {
|
3094
|
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 }
|
428
|
364 }
|
|
365 }
|
3094
|
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 USE_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
|
428
|
398
|
|
399 return 1;
|
|
400 }
|
|
401
|
|
402 static void
|
440
|
403 x_print_font_instance (Lisp_Font_Instance *f,
|
428
|
404 Lisp_Object printcharfun,
|
2286
|
405 int UNUSED (escapeflag))
|
428
|
406 {
|
3659
|
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. */
|
3094
|
410 if (FONT_INSTANCE_X_FONT (f))
|
3659
|
411 write_fmt_string (printcharfun, " font id: 0x%lx,",
|
|
412 (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
|
|
413
|
3094
|
414 #ifdef USE_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
|
428
|
420 }
|
|
421
|
|
422 static void
|
440
|
423 x_finalize_font_instance (Lisp_Font_Instance *f)
|
428
|
424 {
|
|
425
|
3094
|
426 #ifdef USE_XFT
|
|
427 DEBUG_XFT1 (0, "finalizing %s\n", (STRINGP (f->name)
|
|
428 ? (char *) XSTRING_DATA (f->name)
|
|
429 : "(unnamed font)"));
|
|
430 #endif
|
|
431
|
428
|
432 if (f->data)
|
|
433 {
|
|
434 if (DEVICE_LIVE_P (XDEVICE (f->device)))
|
|
435 {
|
|
436 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device));
|
|
437
|
3094
|
438 if (FONT_INSTANCE_X_FONT (f))
|
|
439 XFreeFont (dpy, FONT_INSTANCE_X_FONT (f));
|
|
440 #ifdef USE_XFT
|
|
441 if (FONT_INSTANCE_X_XFTFONT (f))
|
|
442 XftFontClose (dpy, FONT_INSTANCE_X_XFTFONT (f));
|
|
443 #endif
|
428
|
444 }
|
1726
|
445 xfree (f->data, void *);
|
428
|
446 f->data = 0;
|
|
447 }
|
|
448 }
|
|
449
|
|
450 /* Determining the truename of a font is hard. (Big surprise.)
|
|
451
|
3094
|
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
|
428
|
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
|
442
|
472 else entirely (for example, removing the bitstream fonts from the path will
|
428
|
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
|
442
|
477 entries in the font path means something, but it's pretty noncommittal about
|
428
|
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
|
442
|
539 valid_x_font_name_p (Display *dpy, Extbyte *name)
|
428
|
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;
|
444
|
546 Extbyte **names = 0;
|
428
|
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
|
442
|
555 static Extbyte *
|
428
|
556 truename_via_FONT_prop (Display *dpy, XFontStruct *font)
|
|
557 {
|
|
558 unsigned long value = 0;
|
442
|
559 Extbyte *result = 0;
|
428
|
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...) */
|
647
|
566 if (result [0] != '-' || strlen (result) < 30)
|
428
|
567 {
|
|
568 XFree (result);
|
|
569 result = 0;
|
|
570 }
|
|
571 }
|
|
572 return result; /* this must be freed by caller if non-0 */
|
|
573 }
|
|
574
|
442
|
575 static Extbyte *
|
428
|
576 truename_via_random_props (Display *dpy, XFontStruct *font)
|
|
577 {
|
|
578 struct device *d = get_device_from_display (dpy);
|
|
579 unsigned long value = 0;
|
442
|
580 Extbyte *foundry, *family, *weight, *slant, *setwidth, *add_style;
|
428
|
581 unsigned long pixel, point, res_x, res_y;
|
442
|
582 Extbyte *spacing;
|
428
|
583 unsigned long avg_width;
|
442
|
584 Extbyte *registry, *encoding;
|
|
585 Extbyte composed_name [2048];
|
428
|
586 int ok = 0;
|
442
|
587 Extbyte *result;
|
428
|
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;
|
2367
|
630 result = xnew_extbytes (L);
|
428
|
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
|
3169
|
649 /* XListFonts doesn't allocate memory unconditionally based on this. (For
|
|
650 XFree86 in 2005, at least. */
|
|
651 #define MAX_FONT_COUNT INT_MAX
|
428
|
652
|
442
|
653 static Extbyte *
|
|
654 truename_via_XListFonts (Display *dpy, Extbyte *font_name)
|
428
|
655 {
|
442
|
656 Extbyte *result = 0;
|
444
|
657 Extbyte **names;
|
428
|
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);
|
3094
|
668 /* Find the lexicographic minimum of names[].
|
|
669 (#### Should we be comparing case-insensitively?) */
|
428
|
670 while (count--)
|
3094
|
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 */
|
428
|
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
|
442
|
687 x_font_truename (Display *dpy, Extbyte *name, XFontStruct *font)
|
428
|
688 {
|
442
|
689 Extbyte *truename_FONT = 0;
|
|
690 Extbyte *truename_random = 0;
|
|
691 Extbyte *truename = 0;
|
428
|
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 {
|
442
|
736 Lisp_Object result = build_ext_string (truename, Qx_font_name_encoding);
|
428
|
737 XFree (truename);
|
|
738 return result;
|
|
739 }
|
|
740 else
|
|
741 return Qnil;
|
|
742 }
|
|
743
|
|
744 static Lisp_Object
|
578
|
745 x_font_instance_truename (Lisp_Font_Instance *f, Error_Behavior errb)
|
428
|
746 {
|
|
747 struct device *d = XDEVICE (f->device);
|
3094
|
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 USE_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 (res)
|
|
762 {
|
3174
|
763 FONT_INSTANCE_TRUENAME (f) =
|
3469
|
764 build_ext_string ((Extbyte *) res, Qfc_font_name_encoding);
|
3094
|
765 free (res);
|
|
766 return FONT_INSTANCE_TRUENAME (f);
|
|
767 }
|
|
768 else
|
|
769 {
|
|
770 maybe_signal_error (Qgui_error,
|
|
771 "Couldn't unparse Xft font to truename",
|
|
772 Qnil, Qfont, errb);
|
|
773 /* used to return Qnil here */
|
|
774 }
|
|
775 }
|
|
776 #endif /* USE_XFT */
|
|
777
|
|
778 /* OK, fall back to core font. */
|
|
779 if (NILP (FONT_INSTANCE_TRUENAME (f))
|
|
780 && FONT_INSTANCE_X_FONT (f))
|
|
781 {
|
3286
|
782 nameext = NEW_LISP_STRING_TO_EXTERNAL (f->name, Qx_font_name_encoding);
|
3094
|
783 FONT_INSTANCE_TRUENAME (f) =
|
|
784 x_font_truename (dpy, nameext, FONT_INSTANCE_X_FONT (f));
|
|
785 }
|
428
|
786
|
872
|
787 if (NILP (FONT_INSTANCE_TRUENAME (f)))
|
428
|
788 {
|
3094
|
789 /* Urk, no luck. Whine about our bad luck and exit. */
|
|
790 Lisp_Object font_instance = wrap_font_instance (f);
|
|
791
|
|
792
|
|
793 maybe_signal_error (Qgui_error, "Couldn't determine font truename",
|
|
794 font_instance, Qfont, errb);
|
|
795 /* Ok, just this once, return the font name as the truename.
|
|
796 (This is only used by Fequal() right now.) */
|
|
797 return f->name;
|
|
798 }
|
442
|
799
|
3094
|
800 /* Return what we found. */
|
872
|
801 return FONT_INSTANCE_TRUENAME (f);
|
428
|
802 }
|
|
803
|
|
804 static Lisp_Object
|
440
|
805 x_font_instance_properties (Lisp_Font_Instance *f)
|
428
|
806 {
|
|
807 struct device *d = XDEVICE (f->device);
|
|
808 int i;
|
|
809 Lisp_Object result = Qnil;
|
444
|
810 Display *dpy = DEVICE_X_DISPLAY (d);
|
3094
|
811 XFontProp *props = NULL;
|
428
|
812
|
3094
|
813 /* #### really should hack Xft fonts, too
|
|
814 Strategy: fontconfig must have an iterator for this purpose. */
|
|
815 if (! FONT_INSTANCE_X_FONT (f)) return result;
|
|
816
|
|
817 props = FONT_INSTANCE_X_FONT (f)->properties;
|
428
|
818 for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--)
|
|
819 {
|
|
820 Lisp_Object name, value;
|
|
821 Atom atom = props [i].name;
|
867
|
822 Ibyte *name_str = 0;
|
647
|
823 Bytecount name_len;
|
442
|
824 Extbyte *namestrext = XGetAtomName (dpy, atom);
|
|
825
|
|
826 if (namestrext)
|
444
|
827 TO_INTERNAL_FORMAT (C_STRING, namestrext,
|
|
828 ALLOCA, (name_str, name_len),
|
|
829 Qx_atom_name_encoding);
|
442
|
830
|
771
|
831 name = (name_str ? intern_int (name_str) : Qnil);
|
428
|
832 if (name_str &&
|
|
833 (atom == XA_FONT ||
|
|
834 atom == DEVICE_XATOM_FOUNDRY (d) ||
|
|
835 atom == DEVICE_XATOM_FAMILY_NAME (d) ||
|
|
836 atom == DEVICE_XATOM_WEIGHT_NAME (d) ||
|
|
837 atom == DEVICE_XATOM_SLANT (d) ||
|
|
838 atom == DEVICE_XATOM_SETWIDTH_NAME (d) ||
|
|
839 atom == DEVICE_XATOM_ADD_STYLE_NAME (d) ||
|
|
840 atom == DEVICE_XATOM_SPACING (d) ||
|
|
841 atom == DEVICE_XATOM_CHARSET_REGISTRY (d) ||
|
|
842 atom == DEVICE_XATOM_CHARSET_ENCODING (d) ||
|
2367
|
843 !qxestrcmp_ascii (name_str, "CHARSET_COLLECTIONS") ||
|
|
844 !qxestrcmp_ascii (name_str, "FONTNAME_REGISTRY") ||
|
|
845 !qxestrcmp_ascii (name_str, "CLASSIFICATION") ||
|
|
846 !qxestrcmp_ascii (name_str, "COPYRIGHT") ||
|
|
847 !qxestrcmp_ascii (name_str, "DEVICE_FONT_NAME") ||
|
|
848 !qxestrcmp_ascii (name_str, "FULL_NAME") ||
|
|
849 !qxestrcmp_ascii (name_str, "MONOSPACED") ||
|
|
850 !qxestrcmp_ascii (name_str, "QUALITY") ||
|
|
851 !qxestrcmp_ascii (name_str, "RELATIVE_SET") ||
|
|
852 !qxestrcmp_ascii (name_str, "RELATIVE_WEIGHT") ||
|
|
853 !qxestrcmp_ascii (name_str, "STYLE")))
|
428
|
854 {
|
442
|
855 Extbyte *val_str = XGetAtomName (dpy, props [i].card32);
|
|
856
|
|
857 value = (val_str ? build_ext_string (val_str, Qx_atom_name_encoding)
|
|
858 : Qnil);
|
428
|
859 }
|
|
860 else
|
|
861 value = make_int (props [i].card32);
|
442
|
862 if (namestrext) XFree (namestrext);
|
428
|
863 result = Fcons (Fcons (name, value), result);
|
|
864 }
|
|
865 return result;
|
|
866 }
|
|
867
|
|
868 static Lisp_Object
|
2527
|
869 x_font_list (Lisp_Object pattern, Lisp_Object device, Lisp_Object maxnumber)
|
428
|
870 {
|
444
|
871 Extbyte **names;
|
428
|
872 int count = 0;
|
1701
|
873 int max_number = MAX_FONT_COUNT;
|
428
|
874 Lisp_Object result = Qnil;
|
442
|
875 const Extbyte *patternext;
|
428
|
876
|
442
|
877 LISP_STRING_TO_EXTERNAL (pattern, patternext, Qx_font_name_encoding);
|
428
|
878
|
1701
|
879 if (!NILP(maxnumber) && INTP(maxnumber))
|
|
880 {
|
|
881 max_number = XINT(maxnumber);
|
|
882 }
|
|
883
|
428
|
884 names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
|
1701
|
885 patternext, max_number, &count);
|
428
|
886 while (count--)
|
442
|
887 result = Fcons (build_ext_string (names[count], Qx_font_name_encoding),
|
|
888 result);
|
428
|
889 if (names)
|
|
890 XFreeFontNames (names);
|
|
891 return result;
|
|
892 }
|
|
893
|
3659
|
894 /* Include the charset support, shared, for the moment, with GTK. */
|
|
895 #define THIS_IS_X
|
|
896 #include "objects-xlike-inc.c"
|
428
|
897
|
|
898
|
|
899 /************************************************************************/
|
|
900 /* initialization */
|
|
901 /************************************************************************/
|
|
902
|
|
903 void
|
|
904 syms_of_objects_x (void)
|
|
905 {
|
|
906 }
|
|
907
|
|
908 void
|
|
909 console_type_create_objects_x (void)
|
|
910 {
|
|
911 /* object methods */
|
|
912
|
|
913 CONSOLE_HAS_METHOD (x, initialize_color_instance);
|
|
914 CONSOLE_HAS_METHOD (x, print_color_instance);
|
|
915 CONSOLE_HAS_METHOD (x, finalize_color_instance);
|
|
916 CONSOLE_HAS_METHOD (x, color_instance_equal);
|
|
917 CONSOLE_HAS_METHOD (x, color_instance_hash);
|
|
918 CONSOLE_HAS_METHOD (x, color_instance_rgb_components);
|
|
919 CONSOLE_HAS_METHOD (x, valid_color_name_p);
|
2527
|
920 CONSOLE_HAS_METHOD (x, color_list);
|
428
|
921
|
|
922 CONSOLE_HAS_METHOD (x, initialize_font_instance);
|
|
923 CONSOLE_HAS_METHOD (x, print_font_instance);
|
|
924 CONSOLE_HAS_METHOD (x, finalize_font_instance);
|
|
925 CONSOLE_HAS_METHOD (x, font_instance_truename);
|
|
926 CONSOLE_HAS_METHOD (x, font_instance_properties);
|
2527
|
927 CONSOLE_HAS_METHOD (x, font_list);
|
428
|
928 #ifdef MULE
|
|
929 CONSOLE_HAS_METHOD (x, find_charset_font);
|
|
930 CONSOLE_HAS_METHOD (x, font_spec_matches_charset);
|
|
931 #endif
|
|
932 }
|
|
933
|
|
934 void
|
|
935 vars_of_objects_x (void)
|
|
936 {
|
3659
|
937 #ifdef DEBUG_XEMACS
|
|
938 DEFVAR_INT ("debug-x-objects", &debug_x_objects /*
|
|
939 If non-zero, display debug information about X objects
|
|
940 */ );
|
|
941 debug_x_objects = 0;
|
|
942 #endif
|
|
943
|
428
|
944 DEFVAR_BOOL ("x-handle-non-fully-specified-fonts",
|
|
945 &x_handle_non_fully_specified_fonts /*
|
|
946 If this is true then fonts which do not have all characters specified
|
|
947 will be considered to be proportional width even if they are actually
|
|
948 fixed-width. If this is not done then characters which are supposed to
|
|
949 have 0 width may appear to actually have some width.
|
|
950
|
|
951 Note: While setting this to t guarantees correct output in all
|
|
952 circumstances, it also causes a noticeable performance hit when using
|
|
953 fixed-width fonts. Since most people don't use characters which could
|
|
954 cause problems this is set to nil by default.
|
|
955 */ );
|
|
956 x_handle_non_fully_specified_fonts = 0;
|
3094
|
957
|
|
958 #ifdef USE_XFT
|
|
959 Fprovide (intern ("xft-fonts"));
|
|
960 #endif
|
428
|
961 }
|
|
962
|
|
963 void
|
|
964 Xatoms_of_objects_x (struct device *d)
|
|
965 {
|
|
966 Display *D = DEVICE_X_DISPLAY (d);
|
|
967
|
|
968 DEVICE_XATOM_FOUNDRY (d) = XInternAtom (D, "FOUNDRY", False);
|
|
969 DEVICE_XATOM_FAMILY_NAME (d) = XInternAtom (D, "FAMILY_NAME", False);
|
|
970 DEVICE_XATOM_WEIGHT_NAME (d) = XInternAtom (D, "WEIGHT_NAME", False);
|
|
971 DEVICE_XATOM_SLANT (d) = XInternAtom (D, "SLANT", False);
|
|
972 DEVICE_XATOM_SETWIDTH_NAME (d) = XInternAtom (D, "SETWIDTH_NAME", False);
|
|
973 DEVICE_XATOM_ADD_STYLE_NAME (d) = XInternAtom (D, "ADD_STYLE_NAME", False);
|
|
974 DEVICE_XATOM_PIXEL_SIZE (d) = XInternAtom (D, "PIXEL_SIZE", False);
|
|
975 DEVICE_XATOM_POINT_SIZE (d) = XInternAtom (D, "POINT_SIZE", False);
|
|
976 DEVICE_XATOM_RESOLUTION_X (d) = XInternAtom (D, "RESOLUTION_X", False);
|
|
977 DEVICE_XATOM_RESOLUTION_Y (d) = XInternAtom (D, "RESOLUTION_Y", False);
|
|
978 DEVICE_XATOM_SPACING (d) = XInternAtom (D, "SPACING", False);
|
|
979 DEVICE_XATOM_AVERAGE_WIDTH (d) = XInternAtom (D, "AVERAGE_WIDTH", False);
|
|
980 DEVICE_XATOM_CHARSET_REGISTRY(d) = XInternAtom (D, "CHARSET_REGISTRY",False);
|
|
981 DEVICE_XATOM_CHARSET_ENCODING(d) = XInternAtom (D, "CHARSET_ENCODING",False);
|
|
982 }
|