Mercurial > hg > xemacs-beta

comparison src/objects-x.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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 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 #include <config.h>
30 #include "lisp.h"
31
32 #include "console-x.h"
33 #include "objects-x.h"
34
35 #include "buffer.h"
36 #include "device.h"
37 #include "insdel.h"
38
39 int handle_nonfull_spec_fonts;
40
41
42 /************************************************************************/
43 /* color instances */
44 /************************************************************************/
45
46 /* Replacement for XAllocColor() that tries to return the nearest
47 available color if the colormap is full. From FSF Emacs. */
48
49 int
50 allocate_nearest_color (Display *display, Colormap screen_colormap,
51 XColor *color_def)
52 {
53 int status;
54
55 status = XAllocColor (display, screen_colormap, color_def);
56 if (!status)
57 {
58 /* If we got to this point, the colormap is full, so we're
59 going to try and get the next closest color.
60 The algorithm used is a least-squares matching, which is
61 what X uses for closest color matching with StaticColor visuals. */
62
63 XColor *cells;
64 int no_cells;
65 int nearest;
66 long nearest_delta, trial_delta;
67 int x;
68
69 no_cells = XDisplayCells (display, XDefaultScreen (display));
70 cells = (XColor *) alloca (sizeof (XColor) * no_cells);
71
72 for (x = 0; x < no_cells; x++)
73 cells[x].pixel = x;
74
75 XQueryColors (display, screen_colormap, cells, no_cells);
76 nearest = 0;
77 /* I'm assuming CSE so I'm not going to condense this. */
78 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
79 * ((color_def->red >> 8) - (cells[0].red >> 8)))
80 +
81 (((color_def->green >> 8) - (cells[0].green >> 8))
82 * ((color_def->green >> 8) - (cells[0].green >> 8)))
83 +
84 (((color_def->blue >> 8) - (cells[0].blue >> 8))
85 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
86 for (x = 1; x < no_cells; x++)
87 {
88 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
89 * ((color_def->red >> 8) - (cells[x].red >> 8)))
90 +
91 (((color_def->green >> 8) - (cells[x].green >> 8))
92 * ((color_def->green >> 8) - (cells[x].green >> 8)))
93 +
94 (((color_def->blue >> 8) - (cells[x].blue >> 8))
95 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
96 if (trial_delta < nearest_delta)
97 {
98 nearest = x;
99 nearest_delta = trial_delta;
100 }
101 }
102 color_def->red = cells[nearest].red;
103 color_def->green = cells[nearest].green;
104 color_def->blue = cells[nearest].blue;
105 status = XAllocColor (display, screen_colormap, color_def);
106 }
107
108 return status;
109 }
110
111 int
112 x_parse_nearest_color (struct device *d, XColor *color, Bufbyte *name,
113 Bytecount len, Error_behavior errb)
114 {
115 Display *dpy;
116 Screen *xs;
117 Colormap cmap;
118 int result;
119
120 dpy = DEVICE_X_DISPLAY (d);
121 xs = DefaultScreenOfDisplay (dpy);
122 cmap = DefaultColormapOfScreen (xs);
123
124 memset (color, 0, sizeof (*color));
125 {
126 CONST Extbyte *extname;
127 Extcount extnamelen;
128
129 GET_CHARPTR_EXT_BINARY_DATA_ALLOCA (name, len, extname, extnamelen);
130 result = XParseColor (dpy, cmap, (char *) extname, color);
131 }
132 if (!result)
133 {
134 maybe_signal_simple_error ("unrecognized color", make_string (name, len),
135 Qcolor, errb);
136 return 0;
137 }
138 result = allocate_nearest_color (dpy, cmap, color);
139 if (!result)
140 {
141 maybe_signal_simple_error ("couldn't allocate color",
142 make_string (name, len), Qcolor, errb);
143 return 0;
144 }
145
146 return 1;
147 }
148
149 static int
150 x_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
151 Lisp_Object device, Error_behavior errb)
152 {
153 XColor color;
154 int result;
155
156 result = x_parse_nearest_color (XDEVICE (device), &color,
157 string_data (XSTRING (name)),
158 string_length (XSTRING (name)),
159 errb);
160
161 if (!result)
162 return 0;
163
164 /* Don't allocate the data until we're sure that we will succeed,
165 or the finalize method may get fucked. */
166 c->data = malloc_type (struct x_color_instance_data);
167 COLOR_INSTANCE_X_COLOR (c) = color;
168 return 1;
169 }
170
171 static void
172 x_print_color_instance (struct Lisp_Color_Instance *c,
173 Lisp_Object printcharfun,
174 int escapeflag)
175 {
176 char buf[100];
177 XColor color = COLOR_INSTANCE_X_COLOR (c);
178 sprintf (buf, " %ld=(%X,%X,%X)",
179 color.pixel, color.red, color.green, color.blue);
180 write_c_string (buf, printcharfun);
181 }
182
183 static void
184 x_finalize_color_instance (struct Lisp_Color_Instance *c)
185 {
186 if (c->data)
187 {
188 if (DEVICE_LIVE_P (XDEVICE (c->device)))
189 {
190 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (c->device));
191
192 XFreeColors (dpy,
193 DefaultColormapOfScreen (DefaultScreenOfDisplay (dpy)),
194 &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0);
195 }
196 xfree (c->data);
197 c->data = 0;
198 }
199 }
200
201 /* Color instances are equal if they resolve to the same color on the
202 screen (have the same RGB values). I imagine that
203 "same RGV values" == "same cell in the colormap." Arguably we should
204 be comparing their names instead. */
205
206 static int
207 x_color_instance_equal (struct Lisp_Color_Instance *c1,
208 struct Lisp_Color_Instance *c2,
209 int depth)
210 {
211 XColor color1 = COLOR_INSTANCE_X_COLOR (c1);
212 XColor color2 = COLOR_INSTANCE_X_COLOR (c2);
213 return ((color1.red == color2.red) &&
214 (color1.green == color2.green) &&
215 (color1.blue == color2.blue));
216 }
217
218 static unsigned long
219 x_color_instance_hash (struct Lisp_Color_Instance *c, int depth)
220 {
221 XColor color = COLOR_INSTANCE_X_COLOR (c);
222 return HASH3 (color.red, color.green, color.blue);
223 }
224
225 static Lisp_Object
226 x_color_instance_rgb_components (struct Lisp_Color_Instance *c)
227 {
228 XColor color = COLOR_INSTANCE_X_COLOR (c);
229 return (list3 (make_int (color.red),
230 make_int (color.green),
231 make_int (color.blue)));
232 }
233
234 static int
235 x_valid_color_name_p (struct device *d, Lisp_Object color)
236 {
237 XColor c;
238 Display *dpy = DEVICE_X_DISPLAY (d);
239 CONST char *extname;
240
241 GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname);
242
243 return XParseColor (dpy,
244 DefaultColormapOfScreen (DefaultScreenOfDisplay (dpy)),
245 extname, &c);
246 }
247
248
249 /************************************************************************/
250 /* font instances */
251 /************************************************************************/
252
253 static int
254 x_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name,
255 Lisp_Object device, Error_behavior errb)
256 {
257 Display *dpy;
258 XFontStruct *xf;
259 CONST char *extname;
260
261 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
262 GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname);
263 xf = XLoadQueryFont (dpy, extname);
264
265 if (!xf)
266 {
267 maybe_signal_simple_error ("couldn't load font", f->name,
268 Qfont, errb);
269 return 0;
270 }
271
272 if (!xf->max_bounds.width)
273 {
274 /* yes, this has been known to happen. */
275 XFreeFont (dpy, xf);
276 maybe_signal_simple_error ("X font is too small", f->name,
277 Qfont, errb);
278 return 0;
279 }
280
281 /* Don't allocate the data until we're sure that we will succeed,
282 or the finalize method may get fucked. */
283 f->data = malloc_type (struct x_font_instance_data);
284 FONT_INSTANCE_X_TRUENAME (f) = Qnil;
285 FONT_INSTANCE_X_FONT (f) = xf;
286 f->ascent = xf->ascent;
287 f->descent = xf->descent;
288 f->height = xf->ascent + xf->descent;
289 {
290 unsigned int def_char = xf->default_char;
291 int byte1, byte2;
292
293 once_more:
294 byte1 = def_char >> 8;
295 byte2 = def_char & 0xFF;
296
297 if (xf->per_char)
298 {
299 /* Old versions of the R5 font server have garbage (>63k) as
300 def_char. 'n' might not be a valid character. */
301 if (byte1 < xf->min_byte1 || byte1 > xf->max_byte1 ||
302 byte2 < xf->min_char_or_byte2 || byte2 > xf->max_char_or_byte2)
303 f->width = 0;
304 else
305 f->width = xf->per_char[(byte1 - xf->min_byte1) *
306 (xf->max_char_or_byte2 -
307 xf->min_char_or_byte2 + 1) +
308 (byte2 - xf->min_char_or_byte2)].width;
309 }
310 else
311 f->width = xf->max_bounds.width;
312
313 /* Some fonts have a default char whose width is 0. This is no good.
314 If that's the case, first try 'n' as the default char, and if n has
315 0 width too (unlikely) then just use the max width. */
316 if (f->width == 0)
317 {
318 if (def_char == 'n')
319 f->width = xf->max_bounds.width;
320 else
321 {
322 def_char = 'n';
323 goto once_more;
324 }
325 }
326 }
327 /* If all characters don't exist then there could potentially be
328 0-width characters lurking out there. Not setting this flag
329 trips an optimization that would make them appear to have width
330 to redisplay. This is bad. So we set it if not all characters
331 have the same width or if not all characters are defined.
332 */
333 /* #### This sucks. There is a measurable performance increase
334 when using proportional width fonts if this flag is not set.
335 Unfortunately so many of the fucking X fonts are not fully
336 defined that we could almost just get rid of this damn flag and
337 make it an assertion. */
338 f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width ||
339 (handle_nonfull_spec_fonts &&
340 !xf->all_chars_exist));
341
342 return 1;
343 }
344
345 static void
346 x_mark_font_instance (struct Lisp_Font_Instance *f,
347 void (*markobj) (Lisp_Object))
348 {
349 ((markobj) (FONT_INSTANCE_X_TRUENAME (f)));
350 }
351
352 static void
353 x_print_font_instance (struct Lisp_Font_Instance *f,
354 Lisp_Object printcharfun,
355 int escapeflag)
356 {
357 char buf[200];
358 sprintf (buf, " 0x%lx", (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
359 write_c_string (buf, printcharfun);
360 }
361
362 static void
363 x_finalize_font_instance (struct Lisp_Font_Instance *f)
364 {
365
366 if (f->data)
367 {
368 if (DEVICE_LIVE_P (XDEVICE (f->device)))
369 {
370 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device));
371
372 XFreeFont (dpy, FONT_INSTANCE_X_FONT (f));
373 }
374 xfree (f->data);
375 f->data = 0;
376 }
377 }
378
379 /* Determining the truename of a font is hard. (Big surprise.)
380
381 By "truename" we mean an XLFD-form name which contains no wildcards, yet
382 which resolves to *exactly* the same font as the one which we already have
383 the (probably wildcarded) name and `XFontStruct' of.
384
385 One might think that the first font returned by XListFonts would be the one
386 that XOpenFont would pick. Apparently this is the case on some servers,
387 but not on others. It would seem not to be specified.
388
389 The MIT R5 server sometimes appears to be picking the lexicographically
390 smallest font which matches the name (thus picking "adobe" fonts before
391 "bitstream" fonts even if the bitstream fonts are earlier in the path, and
392 also picking 100dpi adobe fonts over 75dpi adobe fonts even though the
393 75dpi are in the path earlier) but sometimes appears to be doing something
394 else entirely (for example, removing the bitsream fonts from the path will
395 cause the 75dpi adobe fonts to be used instead of the100dpi, even though
396 their relative positions in the path (and their names!) have not changed).
397
398 The documentation for XSetFontPath() seems to indicate that the order of
399 entries in the font path means something, but it's pretty noncommital about
400 it, and the spirit of the law is apparently not being obeyed...
401
402 All the fonts I've seen have a property named `FONT' which contains the
403 truename of the font. However, there are two problems with using this: the
404 first is that the X Protocol Document is quite explicit that all properties
405 are optional, so we can't depend on it being there. The second is that
406 it's concievable that this alleged truename isn't actually accessible as a
407 font, due to some difference of opinion between the font designers and
408 whoever installed the font on the system.
409
410 So, our first attempt is to look for a FONT property, and then verify that
411 the name there is a valid name by running XListFonts on it. There's still
412 the potential that this could be true but we could still be being lied to,
413 but that seems pretty remote.
414
415 Late breaking news: I've gotten reports that SunOS 4.1.3U1
416 with OpenWound 3.0 has a font whose truename is really
417 "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1"
418 but whose FONT property contains "Courier".
419
420 So we disbelieve the FONT property unless it begins with a dash and
421 is more than 30 characters long. X Windows: The defacto substandard.
422 X Windows: Complex nonsolutions to simple nonproblems. X Windows:
423 Live the nightmare.
424
425 If the FONT property doesn't exist, then we try and construct an XLFD name
426 out of the other font properties (FOUNDRY, FAMILY_NAME, WEIGHT_NAME, etc).
427 This is necessary at least for some versions of OpenWound. But who knows
428 what the future will bring.
429
430 If that doesn't work, then we use XListFonts and either take the first font
431 (which I think is the most sensible thing) or we find the lexicographically
432 least, depending on whether the preprocessor constant `XOPENFONT_SORTS' is
433 defined. This sucks because the two behaviors are a property of the server
434 being used, not the architecture on which emacs has been compiled. Also,
435 as I described above, sorting isn't ALWAYS what the server does. Really it
436 does something seemingly random. There is no reliable way to win if the
437 FONT property isn't present.
438
439 Another possibility which I haven't bothered to implement would be to map
440 over all of the matching fonts and find the first one that has the same
441 character metrics as the font we already have loaded. Even if this didn't
442 return exactly the same font, it would at least return one whose characters
443 were the same sizes, which would probably be good enough.
444
445 More late-breaking news: on RS/6000 AIX 3.2.4, the expression
446 XLoadQueryFont (dpy, "-*-Fixed-Medium-R-*-*-*-130-75-75-*-*-ISO8859-1")
447 actually returns the font
448 -Misc-Fixed-Medium-R-Normal--13-120-75-75-C-80-ISO8859-1
449 which is crazy, because that font doesn't even match that pattern! It is
450 also not included in the output produced by `xlsfonts' with that pattern.
451
452 So this is yet another example of XListFonts() and XOpenFont() using
453 completely different algorithms. This, however, is a goofier example of
454 this bug, because in this case, it's not just the search order that is
455 different -- the sets don't even intersect.
456
457 If anyone has any better ideas how to do this, or any insights on what it is
458 that the various servers are actually doing, please let me know! -- jwz. */
459
460 static int
461 valid_x_font_name_p (Display *dpy, char *name)
462 {
463 /* Maybe this should be implemented by callign XLoadFont and trapping
464 the error. That would be a lot of work, and wasteful as hell, but
465 might be more correct.
466 */
467 int nnames = 0;
468 char **names = 0;
469 if (! name)
470 return 0;
471 names = XListFonts (dpy, name, 1, &nnames);
472 if (names)
473 XFreeFontNames (names);
474 return (nnames != 0);
475 }
476
477 static char *
478 truename_via_FONT_prop (Display *dpy, XFontStruct *font)
479 {
480 unsigned long value = 0;
481 char *result = 0;
482 if (XGetFontProperty (font, XA_FONT, &value))
483 result = XGetAtomName (dpy, value);
484 /* result is now 0, or the string value of the FONT property. */
485 if (result)
486 {
487 /* Verify that result is an XLFD name (roughly...) */
488 if (result [0] != '-' || strlen (result) < (unsigned int) 30)
489 {
490 XFree (result);
491 result = 0;
492 }
493 }
494 return result; /* this must be freed by caller if non-0 */
495 }
496
497 static char *
498 truename_via_random_props (Display *dpy, XFontStruct *font)
499 {
500 struct device *d = get_device_from_display (dpy);
501 unsigned long value = 0;
502 char *foundry, *family, *weight, *slant, *setwidth, *add_style;
503 unsigned long pixel, point, res_x, res_y;
504 char *spacing;
505 unsigned long avg_width;
506 char *registry, *encoding;
507 char composed_name [2048];
508 int ok = 0;
509 char *result;
510
511 #define get_string(atom,var) \
512 if (XGetFontProperty (font, (atom), &value)) \
513 var = XGetAtomName (dpy, value); \
514 else { \
515 var = 0; \
516 goto FAIL; }
517 #define get_number(atom,var) \
518 if (!XGetFontProperty (font, (atom), &var) || \
519 var > 999) \
520 goto FAIL;
521
522 foundry = family = weight = slant = setwidth = 0;
523 add_style = spacing = registry = encoding = 0;
524
525 get_string (DEVICE_XATOM_FOUNDRY (d), foundry);
526 get_string (DEVICE_XATOM_FAMILY_NAME (d), family);
527 get_string (DEVICE_XATOM_WEIGHT_NAME (d), weight);
528 get_string (DEVICE_XATOM_SLANT (d), slant);
529 get_string (DEVICE_XATOM_SETWIDTH_NAME (d), setwidth);
530 get_string (DEVICE_XATOM_ADD_STYLE_NAME (d), add_style);
531 get_number (DEVICE_XATOM_PIXEL_SIZE (d), pixel);
532 get_number (DEVICE_XATOM_POINT_SIZE (d), point);
533 get_number (DEVICE_XATOM_RESOLUTION_X (d), res_x);
534 get_number (DEVICE_XATOM_RESOLUTION_Y (d), res_y);
535 get_string (DEVICE_XATOM_SPACING (d), spacing);
536 get_number (DEVICE_XATOM_AVERAGE_WIDTH (d), avg_width);
537 get_string (DEVICE_XATOM_CHARSET_REGISTRY (d), registry);
538 get_string (DEVICE_XATOM_CHARSET_ENCODING (d), encoding);
539 #undef get_number
540 #undef get_string
541
542 sprintf (composed_name,
543 "-%s-%s-%s-%s-%s-%s-%ld-%ld-%ld-%ld-%s-%ld-%s-%s",
544 foundry, family, weight, slant, setwidth, add_style, pixel,
545 point, res_x, res_y, spacing, avg_width, registry, encoding);
546 ok = 1;
547
548 FAIL:
549 if (ok)
550 {
551 int L = strlen (composed_name) + 1;
552 result = xmalloc (L);
553 strncpy (result, composed_name, L);
554 }
555 else
556 result = 0;
557
558 if (foundry) XFree (foundry);
559 if (family) XFree (family);
560 if (weight) XFree (weight);
561 if (slant) XFree (slant);
562 if (setwidth) XFree (setwidth);
563 if (add_style) XFree (add_style);
564 if (spacing) XFree (spacing);
565 if (registry) XFree (registry);
566 if (encoding) XFree (encoding);
567
568 return result;
569 }
570
571 /* Unbounded, for sufficiently small values of infinity... */
572 #define MAX_FONT_COUNT 5000
573
574 static char *
575 truename_via_XListFonts (Display *dpy, char *font_name)
576 {
577 char *result = 0;
578 char **names;
579 int count = 0;
580
581 #ifndef XOPENFONT_SORTS
582 /* In a sensible world, the first font returned by XListFonts()
583 would be the font that XOpenFont() would use. */
584 names = XListFonts (dpy, font_name, 1, &count);
585 if (count) result = names [0];
586 #else
587 /* But the world I live in is much more perverse. */
588 names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count);
589 while (count--)
590 /* If names[count] is lexicographically less than result, use it.
591 (#### Should we be comparing case-insensitively?) */
592 if (result == 0 || (strcmp (result, names [count]) < 0))
593 result = names [count];
594 #endif
595
596 if (result)
597 result = xstrdup (result);
598 if (names)
599 XFreeFontNames (names);
600
601 return result; /* this must be freed by caller if non-0 */
602 }
603
604 static Lisp_Object
605 x_font_truename (Display *dpy, char *name, XFontStruct *font)
606 {
607 char *truename_FONT = 0;
608 char *truename_random = 0;
609 char *truename = 0;
610
611 /* The search order is:
612 - if FONT property exists, and is a valid name, return it.
613 - if the other props exist, and add up to a valid name, return it.
614 - if we find a matching name with XListFonts, return it.
615 - if FONT property exists, return it regardless.
616 - if other props exist, return the resultant name regardless.
617 - else return 0.
618 */
619
620 truename = truename_FONT = truename_via_FONT_prop (dpy, font);
621 if (truename && !valid_x_font_name_p (dpy, truename))
622 truename = 0;
623 if (!truename)
624 truename = truename_random = truename_via_random_props (dpy, font);
625 if (truename && !valid_x_font_name_p (dpy, truename))
626 truename = 0;
627 if (!truename && name)
628 truename = truename_via_XListFonts (dpy, name);
629
630 if (!truename)
631 {
632 /* Gag - we weren't able to find a seemingly-valid truename.
633 Well, maybe we're on one of those braindead systems where
634 XListFonts() and XLoadFont() are in violent disagreement.
635 If we were able to compute a truename, try using that even
636 if evidence suggests that it's not a valid name - because
637 maybe it is, really, and that's better than nothing.
638 X Windows: You'll envy the dead.
639 */
640 if (truename_FONT)
641 truename = truename_FONT;
642 else if (truename_random)
643 truename = truename_random;
644 }
645
646 /* One or both of these are not being used - free them. */
647 if (truename_FONT && truename_FONT != truename)
648 XFree (truename_FONT);
649 if (truename_random && truename_random != truename)
650 XFree (truename_random);
651
652 if (truename)
653 {
654 Lisp_Object result = build_string (truename);
655 xfree (truename);
656 return result;
657 }
658 else
659 return Qnil;
660 }
661
662 static Lisp_Object
663 x_font_instance_truename (struct Lisp_Font_Instance *f, Error_behavior errb)
664 {
665 struct device *d = XDEVICE (f->device);
666
667 if (NILP (FONT_INSTANCE_X_TRUENAME (f)))
668 {
669 Display *dpy = DEVICE_X_DISPLAY (d);
670 char *name =
671 (char *) string_data (XSTRING (f->name));
672 {
673 FONT_INSTANCE_X_TRUENAME (f) =
674 x_font_truename (dpy, name, FONT_INSTANCE_X_FONT (f));
675 }
676 if (NILP (FONT_INSTANCE_X_TRUENAME (f)))
677 {
678 Lisp_Object font_instance = Qnil;
679 XSETFONT_INSTANCE (font_instance, f);
680
681 maybe_signal_simple_error ("couldn't determine font truename",
682 font_instance, Qfont, errb);
683 /* Ok, just this once, return the font name as the truename.
684 (This is only used by Fequal() right now.) */
685 return f->name;
686 }
687 }
688 return (FONT_INSTANCE_X_TRUENAME (f));
689 }
690
691 static Lisp_Object
692 x_font_instance_properties (struct Lisp_Font_Instance *f)
693 {
694 struct device *d = XDEVICE (f->device);
695 int i;
696 Lisp_Object result = Qnil;
697 XFontProp *props;
698 Display *dpy;
699
700 dpy = DEVICE_X_DISPLAY (d);
701 props = FONT_INSTANCE_X_FONT (f)->properties;
702 for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--)
703 {
704 char *name_str = 0;
705 char *val_str = 0;
706 Lisp_Object name, value;
707 Atom atom = props [i].name;
708 name_str = XGetAtomName (dpy, atom);
709 name = (name_str ? intern (name_str) : Qnil);
710 if (name_str &&
711 (atom == XA_FONT ||
712 atom == DEVICE_XATOM_FOUNDRY (d) ||
713 atom == DEVICE_XATOM_FAMILY_NAME (d) ||
714 atom == DEVICE_XATOM_WEIGHT_NAME (d) ||
715 atom == DEVICE_XATOM_SLANT (d) ||
716 atom == DEVICE_XATOM_SETWIDTH_NAME (d) ||
717 atom == DEVICE_XATOM_ADD_STYLE_NAME (d) ||
718 atom == DEVICE_XATOM_SPACING (d) ||
719 atom == DEVICE_XATOM_CHARSET_REGISTRY (d) ||
720 atom == DEVICE_XATOM_CHARSET_ENCODING (d) ||
721 !strcmp (name_str, "CHARSET_COLLECTIONS") ||
722 !strcmp (name_str, "FONTNAME_REGISTRY") ||
723 !strcmp (name_str, "CLASSIFICATION") ||
724 !strcmp (name_str, "COPYRIGHT") ||
725 !strcmp (name_str, "DEVICE_FONT_NAME") ||
726 !strcmp (name_str, "FULL_NAME") ||
727 !strcmp (name_str, "MONOSPACED") ||
728 !strcmp (name_str, "QUALITY") ||
729 !strcmp (name_str, "RELATIVE_SET") ||
730 !strcmp (name_str, "RELATIVE_WEIGHT") ||
731 !strcmp (name_str, "STYLE")))
732 {
733 val_str = XGetAtomName (dpy, props [i].card32);
734 value = (val_str ? build_string (val_str) : Qnil);
735 }
736 else
737 value = make_int (props [i].card32);
738 if (name_str) XFree (name_str);
739 result = Fcons (Fcons (name, value), result);
740 }
741 return result;
742 }
743
744 static Lisp_Object
745 x_list_fonts (Lisp_Object pattern, Lisp_Object device)
746 {
747 char **names;
748 int count = 0;
749 Lisp_Object result = Qnil;
750 CONST char *patternext;
751
752 GET_C_STRING_BINARY_DATA_ALLOCA (pattern, patternext);
753
754 names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
755 patternext, MAX_FONT_COUNT, &count);
756 while (count--)
757 result = Fcons (build_ext_string (names [count], FORMAT_BINARY), result);
758 if (names)
759 XFreeFontNames (names);
760 return result;
761 }
762
763
764 /************************************************************************/
765 /* initialization */
766 /************************************************************************/
767
768 void
769 syms_of_objects_x (void)
770 {
771 }
772
773 void
774 console_type_create_objects_x (void)
775 {
776 /* object methods */
777
778 CONSOLE_HAS_METHOD (x, initialize_color_instance);
779 CONSOLE_HAS_METHOD (x, print_color_instance);
780 CONSOLE_HAS_METHOD (x, finalize_color_instance);
781 CONSOLE_HAS_METHOD (x, color_instance_equal);
782 CONSOLE_HAS_METHOD (x, color_instance_hash);
783 CONSOLE_HAS_METHOD (x, color_instance_rgb_components);
784 CONSOLE_HAS_METHOD (x, valid_color_name_p);
785
786 CONSOLE_HAS_METHOD (x, initialize_font_instance);
787 CONSOLE_HAS_METHOD (x, mark_font_instance);
788 CONSOLE_HAS_METHOD (x, print_font_instance);
789 CONSOLE_HAS_METHOD (x, finalize_font_instance);
790 CONSOLE_HAS_METHOD (x, font_instance_truename);
791 CONSOLE_HAS_METHOD (x, font_instance_properties);
792 CONSOLE_HAS_METHOD (x, list_fonts);
793 }
794
795 void
796 vars_of_objects_x (void)
797 {
798 DEFVAR_BOOL ("x-handle-non-fully-specified-fonts",&handle_nonfull_spec_fonts /*
799 If this is true then fonts which do not have all characters specified
800 will be considered to be proportional width even if they are actually
801 fixed-width. If this is not done then characters which are supposed to
802 have 0 width may appear to actually have some width.
803
804 Note: While setting this to t guarantees correct output in all
805 circumstances, it also causes a noticeable performance hit when using
806 fixed-width fonts. Since most people don't use characters which could
807 cause problems this is set to nil by default.
808 */ );
809 handle_nonfull_spec_fonts = 0;
810 }
811
812
813 void
814 Xatoms_of_objects_x (struct device *d)
815 {
816 #define ATOM(x) XInternAtom (DEVICE_X_DISPLAY (d), (x), False)
817
818 DEVICE_XATOM_FOUNDRY (d) = ATOM ("FOUNDRY");
819 DEVICE_XATOM_FAMILY_NAME (d) = ATOM ("FAMILY_NAME");
820 DEVICE_XATOM_WEIGHT_NAME (d) = ATOM ("WEIGHT_NAME");
821 DEVICE_XATOM_SLANT (d) = ATOM ("SLANT");
822 DEVICE_XATOM_SETWIDTH_NAME (d) = ATOM ("SETWIDTH_NAME");
823 DEVICE_XATOM_ADD_STYLE_NAME (d) = ATOM ("ADD_STYLE_NAME");
824 DEVICE_XATOM_PIXEL_SIZE (d) = ATOM ("PIXEL_SIZE");
825 DEVICE_XATOM_POINT_SIZE (d) = ATOM ("POINT_SIZE");
826 DEVICE_XATOM_RESOLUTION_X (d) = ATOM ("RESOLUTION_X");
827 DEVICE_XATOM_RESOLUTION_Y (d) = ATOM ("RESOLUTION_Y");
828 DEVICE_XATOM_SPACING (d) = ATOM ("SPACING");
829 DEVICE_XATOM_AVERAGE_WIDTH (d) = ATOM ("AVERAGE_WIDTH");
830 DEVICE_XATOM_CHARSET_REGISTRY (d) = ATOM ("CHARSET_REGISTRY");
831 DEVICE_XATOM_CHARSET_ENCODING (d) = ATOM ("CHARSET_ENCODING");
832 }