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.
8 This file is part of XEmacs.
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
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
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. */
25 /* Synched up with: Not in FSF. */
27 /* Authors: Jamie Zawinski, Chuck Thompson, Ben Wing */
32 #include "console-x.h"
33 #include "objects-x.h"
39 int x_handle_non_fully_specified_fonts;
42 /************************************************************************/
44 /************************************************************************/
46 /* Replacement for XAllocColor() that tries to return the nearest
47 available color if the colormap is full. Original was from FSFmacs,
48 but rewritten by Jareth Hein <jareth@camelot-soft.com> 97/11/25 */
50 /* Return value is 1 for normal success, 2 for nearest color success,
51 3 for Non-deallocable sucess, and 0 for absolute failure (shouldn't
54 allocate_nearest_color (Display *display, Colormap colormap, Visual *visual,
59 if (visual->class == DirectColor || visual->class == TrueColor)
61 if (XAllocColor (display, colormap, color_def) != 0)
67 /* We're dealing with a TrueColor/DirectColor visual, so play games
68 with the RGB values in the XColor struct. */
69 /* ### JH: I'm not sure how a call to XAllocColor can fail in a
70 TrueColor or DirectColor visual, so I will just reformat the
71 request to match the requirements of the visual, and re-issue
72 the request. If this fails for anybody, I wanna know about it
73 so I can come up with a better plan */
75 unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk;
76 junk = visual->red_mask;
78 while ((junk & 0x1) == 0) {
87 junk = visual->green_mask;
89 while ((junk & 0x1) == 0) {
98 junk = visual->blue_mask;
100 while ((junk & 0x1) == 0) {
110 color_def->red = color_def->red >> (16 - rbits);
111 color_def->green = color_def->green >> (16 - gbits);
112 color_def->blue = color_def->blue >> (16 - bbits);
113 if (XAllocColor (display, colormap, color_def) != 0)
118 /* ### JH: I'm punting here, knowing that doing this will at
119 least draw the color correctly. However, unless we convert
120 all of the functions that allocate colors (graphics
121 libraries, etc) to use this function doing this is very
122 likely to cause problems later... */
125 rd = color_def->red << (rbits - 8);
127 rd = color_def->red >> (8 - rbits);
129 gr = color_def->green << (gbits - 8);
131 gr = color_def->green >> (8 - gbits);
133 bl = color_def->blue << (bbits - 8);
135 bl = color_def->blue >> (8 - bbits);
136 color_def->pixel = (rd << rshift) | (gr << gshift) | (bl << bshift);
143 if (XAllocColor (display, colormap, color_def) != 0)
147 /* If we got to this point, the colormap is full, so we're
148 going to try and get the next closest color. The algorithm used
149 is a least-squares matching, which is what X uses for closest
150 color matching with StaticColor visuals. */
152 /* JH: I can't believe there's no way to go backwards from a
153 colormap ID and get its visual and number of entries, but X
154 apparently isn't built that way... */
155 int no_cells = visual->map_entries;
157 long nearest_delta, trial_delta;
160 cells = alloca_array (XColor, no_cells);
162 for (x = 0; x < no_cells; x++)
165 /* read the current colormap */
166 XQueryColors (display, colormap, cells, no_cells);
168 /* I'm assuming CSE so I'm not going to condense this. */
169 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
170 * ((color_def->red >> 8) - (cells[0].red >> 8)))
172 (((color_def->green >> 8) - (cells[0].green >> 8))
173 * ((color_def->green >> 8) - (cells[0].green >> 8)))
175 (((color_def->blue >> 8) - (cells[0].blue >> 8))
176 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
177 for (x = 1; x < no_cells; x++)
179 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
180 * ((color_def->red >> 8) - (cells[x].red >> 8)))
182 (((color_def->green >> 8) - (cells[x].green >> 8))
183 * ((color_def->green >> 8) - (cells[x].green >> 8)))
185 (((color_def->blue >> 8) - (cells[x].blue >> 8))
186 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
187 if (trial_delta < nearest_delta)
190 nearest_delta = trial_delta;
193 color_def->red = cells[nearest].red;
194 color_def->green = cells[nearest].green;
195 color_def->blue = cells[nearest].blue;
196 if (XAllocColor (display, colormap, color_def) != 0) {
199 status = 0; /* JH: how does this happen??? DOES this happen??? */
200 fprintf(stderr,"allocate_nearest_color returned 0!!!\n");
208 x_parse_nearest_color (struct device *d, XColor *color, Bufbyte *name,
209 Bytecount len, Error_behavior errb)
217 dpy = DEVICE_X_DISPLAY (d);
218 xs = DefaultScreenOfDisplay (dpy);
219 cmap = DEVICE_X_COLORMAP(d);
220 visual = DEVICE_X_VISUAL (d);
224 CONST Extbyte *extname;
227 GET_CHARPTR_EXT_BINARY_DATA_ALLOCA (name, len, extname, extnamelen);
228 result = XParseColor (dpy, cmap, (char *) extname, color);
232 maybe_signal_simple_error ("unrecognized color", make_string (name, len),
236 result = allocate_nearest_color (dpy, cmap, visual, color);
239 maybe_signal_simple_error ("couldn't allocate color",
240 make_string (name, len), Qcolor, errb);
248 x_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
249 Lisp_Object device, Error_behavior errb)
254 result = x_parse_nearest_color (XDEVICE (device), &color,
256 XSTRING_LENGTH (name),
262 /* Don't allocate the data until we're sure that we will succeed,
263 or the finalize method may get fucked. */
264 c->data = xnew (struct x_color_instance_data);
266 COLOR_INSTANCE_X_DEALLOC (c) = 0;
268 COLOR_INSTANCE_X_DEALLOC (c) = 1;
269 COLOR_INSTANCE_X_COLOR (c) = color;
274 x_print_color_instance (struct Lisp_Color_Instance *c,
275 Lisp_Object printcharfun,
279 XColor color = COLOR_INSTANCE_X_COLOR (c);
280 sprintf (buf, " %ld=(%X,%X,%X)",
281 color.pixel, color.red, color.green, color.blue);
282 write_c_string (buf, printcharfun);
286 x_finalize_color_instance (struct Lisp_Color_Instance *c)
290 if (DEVICE_LIVE_P (XDEVICE (c->device)))
292 if (COLOR_INSTANCE_X_DEALLOC (c))
294 XFreeColors (DEVICE_X_DISPLAY (XDEVICE (c->device)), DEVICE_X_COLORMAP (XDEVICE (c->device)),
295 &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0);
303 /* Color instances are equal if they resolve to the same color on the
304 screen (have the same RGB values). I imagine that
305 "same RGB values" == "same cell in the colormap." Arguably we should
306 be comparing their names or pixel values instead. */
309 x_color_instance_equal (struct Lisp_Color_Instance *c1,
310 struct Lisp_Color_Instance *c2,
313 XColor color1 = COLOR_INSTANCE_X_COLOR (c1);
314 XColor color2 = COLOR_INSTANCE_X_COLOR (c2);
315 return ((color1.red == color2.red) &&
316 (color1.green == color2.green) &&
317 (color1.blue == color2.blue));
321 x_color_instance_hash (struct Lisp_Color_Instance *c, int depth)
323 XColor color = COLOR_INSTANCE_X_COLOR (c);
324 return HASH3 (color.red, color.green, color.blue);
328 x_color_instance_rgb_components (struct Lisp_Color_Instance *c)
330 XColor color = COLOR_INSTANCE_X_COLOR (c);
331 return (list3 (make_int (color.red),
332 make_int (color.green),
333 make_int (color.blue)));
337 x_valid_color_name_p (struct device *d, Lisp_Object color)
340 Display *dpy = DEVICE_X_DISPLAY (d);
341 Colormap cmap = DEVICE_X_COLORMAP (d);
345 GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname);
347 return XParseColor (dpy, cmap,
352 /************************************************************************/
354 /************************************************************************/
357 x_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name,
358 Lisp_Object device, Error_behavior errb)
364 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
365 GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname);
366 xf = XLoadQueryFont (dpy, extname);
370 maybe_signal_simple_error ("couldn't load font", f->name,
375 if (!xf->max_bounds.width)
377 /* yes, this has been known to happen. */
379 maybe_signal_simple_error ("X font is too small", f->name,
384 /* Don't allocate the data until we're sure that we will succeed,
385 or the finalize method may get fucked. */
386 f->data = xnew (struct x_font_instance_data);
387 FONT_INSTANCE_X_TRUENAME (f) = Qnil;
388 FONT_INSTANCE_X_FONT (f) = xf;
389 f->ascent = xf->ascent;
390 f->descent = xf->descent;
391 f->height = xf->ascent + xf->descent;
393 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
394 unsigned int def_char = 'n'; /*xf->default_char;*/
395 unsigned int byte1, byte2;
398 byte1 = def_char >> 8;
399 byte2 = def_char & 0xFF;
403 /* Old versions of the R5 font server have garbage (>63k) as
404 def_char. 'n' might not be a valid character. */
405 if (byte1 < xf->min_byte1 ||
406 byte1 > xf->max_byte1 ||
407 byte2 < xf->min_char_or_byte2 ||
408 byte2 > xf->max_char_or_byte2)
411 f->width = xf->per_char[(byte1 - xf->min_byte1) *
412 (xf->max_char_or_byte2 -
413 xf->min_char_or_byte2 + 1) +
414 (byte2 - xf->min_char_or_byte2)].width;
417 f->width = xf->max_bounds.width;
419 /* Some fonts have a default char whose width is 0. This is no good.
420 If that's the case, first try 'n' as the default char, and if n has
421 0 width too (unlikely) then just use the max width. */
424 if (def_char == xf->default_char)
425 f->width = xf->max_bounds.width;
428 def_char = xf->default_char;
433 /* If all characters don't exist then there could potentially be
434 0-width characters lurking out there. Not setting this flag
435 trips an optimization that would make them appear to have width
436 to redisplay. This is bad. So we set it if not all characters
437 have the same width or if not all characters are defined.
439 /* #### This sucks. There is a measurable performance increase
440 when using proportional width fonts if this flag is not set.
441 Unfortunately so many of the fucking X fonts are not fully
442 defined that we could almost just get rid of this damn flag and
443 make it an assertion. */
444 f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width ||
445 (x_handle_non_fully_specified_fonts &&
446 !xf->all_chars_exist));
452 x_mark_font_instance (struct Lisp_Font_Instance *f,
453 void (*markobj) (Lisp_Object))
455 ((markobj) (FONT_INSTANCE_X_TRUENAME (f)));
459 x_print_font_instance (struct Lisp_Font_Instance *f,
460 Lisp_Object printcharfun,
464 sprintf (buf, " 0x%lx", (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
465 write_c_string (buf, printcharfun);
469 x_finalize_font_instance (struct Lisp_Font_Instance *f)
474 if (DEVICE_LIVE_P (XDEVICE (f->device)))
476 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device));
478 XFreeFont (dpy, FONT_INSTANCE_X_FONT (f));
485 /* Determining the truename of a font is hard. (Big surprise.)
487 By "truename" we mean an XLFD-form name which contains no wildcards, yet
488 which resolves to *exactly* the same font as the one which we already have
489 the (probably wildcarded) name and `XFontStruct' of.
491 One might think that the first font returned by XListFonts would be the one
492 that XOpenFont would pick. Apparently this is the case on some servers,
493 but not on others. It would seem not to be specified.
495 The MIT R5 server sometimes appears to be picking the lexicographically
496 smallest font which matches the name (thus picking "adobe" fonts before
497 "bitstream" fonts even if the bitstream fonts are earlier in the path, and
498 also picking 100dpi adobe fonts over 75dpi adobe fonts even though the
499 75dpi are in the path earlier) but sometimes appears to be doing something
500 else entirely (for example, removing the bitsream fonts from the path will
501 cause the 75dpi adobe fonts to be used instead of the100dpi, even though
502 their relative positions in the path (and their names!) have not changed).
504 The documentation for XSetFontPath() seems to indicate that the order of
505 entries in the font path means something, but it's pretty noncommital about
506 it, and the spirit of the law is apparently not being obeyed...
508 All the fonts I've seen have a property named `FONT' which contains the
509 truename of the font. However, there are two problems with using this: the
510 first is that the X Protocol Document is quite explicit that all properties
511 are optional, so we can't depend on it being there. The second is that
512 it's concievable that this alleged truename isn't actually accessible as a
513 font, due to some difference of opinion between the font designers and
514 whoever installed the font on the system.
516 So, our first attempt is to look for a FONT property, and then verify that
517 the name there is a valid name by running XListFonts on it. There's still
518 the potential that this could be true but we could still be being lied to,
519 but that seems pretty remote.
521 Late breaking news: I've gotten reports that SunOS 4.1.3U1
522 with OpenWound 3.0 has a font whose truename is really
523 "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1"
524 but whose FONT property contains "Courier".
526 So we disbelieve the FONT property unless it begins with a dash and
527 is more than 30 characters long. X Windows: The defacto substandard.
528 X Windows: Complex nonsolutions to simple nonproblems. X Windows:
531 If the FONT property doesn't exist, then we try and construct an XLFD name
532 out of the other font properties (FOUNDRY, FAMILY_NAME, WEIGHT_NAME, etc).
533 This is necessary at least for some versions of OpenWound. But who knows
534 what the future will bring.
536 If that doesn't work, then we use XListFonts and either take the first font
537 (which I think is the most sensible thing) or we find the lexicographically
538 least, depending on whether the preprocessor constant `XOPENFONT_SORTS' is
539 defined. This sucks because the two behaviors are a property of the server
540 being used, not the architecture on which emacs has been compiled. Also,
541 as I described above, sorting isn't ALWAYS what the server does. Really it
542 does something seemingly random. There is no reliable way to win if the
543 FONT property isn't present.
545 Another possibility which I haven't bothered to implement would be to map
546 over all of the matching fonts and find the first one that has the same
547 character metrics as the font we already have loaded. Even if this didn't
548 return exactly the same font, it would at least return one whose characters
549 were the same sizes, which would probably be good enough.
551 More late-breaking news: on RS/6000 AIX 3.2.4, the expression
552 XLoadQueryFont (dpy, "-*-Fixed-Medium-R-*-*-*-130-75-75-*-*-ISO8859-1")
553 actually returns the font
554 -Misc-Fixed-Medium-R-Normal--13-120-75-75-C-80-ISO8859-1
555 which is crazy, because that font doesn't even match that pattern! It is
556 also not included in the output produced by `xlsfonts' with that pattern.
558 So this is yet another example of XListFonts() and XOpenFont() using
559 completely different algorithms. This, however, is a goofier example of
560 this bug, because in this case, it's not just the search order that is
561 different -- the sets don't even intersect.
563 If anyone has any better ideas how to do this, or any insights on what it is
564 that the various servers are actually doing, please let me know! -- jwz. */
567 valid_x_font_name_p (Display *dpy, char *name)
569 /* Maybe this should be implemented by callign XLoadFont and trapping
570 the error. That would be a lot of work, and wasteful as hell, but
571 might be more correct.
577 names = XListFonts (dpy, name, 1, &nnames);
579 XFreeFontNames (names);
580 return (nnames != 0);
584 truename_via_FONT_prop (Display *dpy, XFontStruct *font)
586 unsigned long value = 0;
588 if (XGetFontProperty (font, XA_FONT, &value))
589 result = XGetAtomName (dpy, value);
590 /* result is now 0, or the string value of the FONT property. */
593 /* Verify that result is an XLFD name (roughly...) */
594 if (result [0] != '-' || strlen (result) < (unsigned int) 30)
600 return result; /* this must be freed by caller if non-0 */
604 truename_via_random_props (Display *dpy, XFontStruct *font)
606 struct device *d = get_device_from_display (dpy);
607 unsigned long value = 0;
608 char *foundry, *family, *weight, *slant, *setwidth, *add_style;
609 unsigned long pixel, point, res_x, res_y;
611 unsigned long avg_width;
612 char *registry, *encoding;
613 char composed_name [2048];
617 #define get_string(atom,var) \
618 if (XGetFontProperty (font, (atom), &value)) \
619 var = XGetAtomName (dpy, value); \
623 #define get_number(atom,var) \
624 if (!XGetFontProperty (font, (atom), &var) || \
628 foundry = family = weight = slant = setwidth = 0;
629 add_style = spacing = registry = encoding = 0;
631 get_string (DEVICE_XATOM_FOUNDRY (d), foundry);
632 get_string (DEVICE_XATOM_FAMILY_NAME (d), family);
633 get_string (DEVICE_XATOM_WEIGHT_NAME (d), weight);
634 get_string (DEVICE_XATOM_SLANT (d), slant);
635 get_string (DEVICE_XATOM_SETWIDTH_NAME (d), setwidth);
636 get_string (DEVICE_XATOM_ADD_STYLE_NAME (d), add_style);
637 get_number (DEVICE_XATOM_PIXEL_SIZE (d), pixel);
638 get_number (DEVICE_XATOM_POINT_SIZE (d), point);
639 get_number (DEVICE_XATOM_RESOLUTION_X (d), res_x);
640 get_number (DEVICE_XATOM_RESOLUTION_Y (d), res_y);
641 get_string (DEVICE_XATOM_SPACING (d), spacing);
642 get_number (DEVICE_XATOM_AVERAGE_WIDTH (d), avg_width);
643 get_string (DEVICE_XATOM_CHARSET_REGISTRY (d), registry);
644 get_string (DEVICE_XATOM_CHARSET_ENCODING (d), encoding);
648 sprintf (composed_name,
649 "-%s-%s-%s-%s-%s-%s-%ld-%ld-%ld-%ld-%s-%ld-%s-%s",
650 foundry, family, weight, slant, setwidth, add_style, pixel,
651 point, res_x, res_y, spacing, avg_width, registry, encoding);
657 int L = strlen (composed_name) + 1;
658 result = (char *) xmalloc (L);
659 strncpy (result, composed_name, L);
664 if (foundry) XFree (foundry);
665 if (family) XFree (family);
666 if (weight) XFree (weight);
667 if (slant) XFree (slant);
668 if (setwidth) XFree (setwidth);
669 if (add_style) XFree (add_style);
670 if (spacing) XFree (spacing);
671 if (registry) XFree (registry);
672 if (encoding) XFree (encoding);
677 /* Unbounded, for sufficiently small values of infinity... */
678 #define MAX_FONT_COUNT 5000
681 truename_via_XListFonts (Display *dpy, char *font_name)
687 #ifndef XOPENFONT_SORTS
688 /* In a sensible world, the first font returned by XListFonts()
689 would be the font that XOpenFont() would use. */
690 names = XListFonts (dpy, font_name, 1, &count);
691 if (count) result = names [0];
693 /* But the world I live in is much more perverse. */
694 names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count);
696 /* If names[count] is lexicographically less than result, use it.
697 (#### Should we be comparing case-insensitively?) */
698 if (result == 0 || (strcmp (result, names [count]) < 0))
699 result = names [count];
703 result = xstrdup (result);
705 XFreeFontNames (names);
707 return result; /* this must be freed by caller if non-0 */
711 x_font_truename (Display *dpy, char *name, XFontStruct *font)
713 char *truename_FONT = 0;
714 char *truename_random = 0;
717 /* The search order is:
718 - if FONT property exists, and is a valid name, return it.
719 - if the other props exist, and add up to a valid name, return it.
720 - if we find a matching name with XListFonts, return it.
721 - if FONT property exists, return it regardless.
722 - if other props exist, return the resultant name regardless.
726 truename = truename_FONT = truename_via_FONT_prop (dpy, font);
727 if (truename && !valid_x_font_name_p (dpy, truename))
730 truename = truename_random = truename_via_random_props (dpy, font);
731 if (truename && !valid_x_font_name_p (dpy, truename))
733 if (!truename && name)
734 truename = truename_via_XListFonts (dpy, name);
738 /* Gag - we weren't able to find a seemingly-valid truename.
739 Well, maybe we're on one of those braindead systems where
740 XListFonts() and XLoadFont() are in violent disagreement.
741 If we were able to compute a truename, try using that even
742 if evidence suggests that it's not a valid name - because
743 maybe it is, really, and that's better than nothing.
744 X Windows: You'll envy the dead.
747 truename = truename_FONT;
748 else if (truename_random)
749 truename = truename_random;
752 /* One or both of these are not being used - free them. */
753 if (truename_FONT && truename_FONT != truename)
754 XFree (truename_FONT);
755 if (truename_random && truename_random != truename)
756 XFree (truename_random);
760 Lisp_Object result = build_string (truename);
769 x_font_instance_truename (struct Lisp_Font_Instance *f, Error_behavior errb)
771 struct device *d = XDEVICE (f->device);
773 if (NILP (FONT_INSTANCE_X_TRUENAME (f)))
775 Display *dpy = DEVICE_X_DISPLAY (d);
776 char *name = (char *) XSTRING_DATA (f->name);
778 FONT_INSTANCE_X_TRUENAME (f) =
779 x_font_truename (dpy, name, FONT_INSTANCE_X_FONT (f));
781 if (NILP (FONT_INSTANCE_X_TRUENAME (f)))
783 Lisp_Object font_instance;
784 XSETFONT_INSTANCE (font_instance, f);
786 maybe_signal_simple_error ("couldn't determine font truename",
787 font_instance, Qfont, errb);
788 /* Ok, just this once, return the font name as the truename.
789 (This is only used by Fequal() right now.) */
793 return (FONT_INSTANCE_X_TRUENAME (f));
797 x_font_instance_properties (struct Lisp_Font_Instance *f)
799 struct device *d = XDEVICE (f->device);
801 Lisp_Object result = Qnil;
805 dpy = DEVICE_X_DISPLAY (d);
806 props = FONT_INSTANCE_X_FONT (f)->properties;
807 for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--)
811 Lisp_Object name, value;
812 Atom atom = props [i].name;
813 name_str = XGetAtomName (dpy, atom);
814 name = (name_str ? intern (name_str) : Qnil);
817 atom == DEVICE_XATOM_FOUNDRY (d) ||
818 atom == DEVICE_XATOM_FAMILY_NAME (d) ||
819 atom == DEVICE_XATOM_WEIGHT_NAME (d) ||
820 atom == DEVICE_XATOM_SLANT (d) ||
821 atom == DEVICE_XATOM_SETWIDTH_NAME (d) ||
822 atom == DEVICE_XATOM_ADD_STYLE_NAME (d) ||
823 atom == DEVICE_XATOM_SPACING (d) ||
824 atom == DEVICE_XATOM_CHARSET_REGISTRY (d) ||
825 atom == DEVICE_XATOM_CHARSET_ENCODING (d) ||
826 !strcmp (name_str, "CHARSET_COLLECTIONS") ||
827 !strcmp (name_str, "FONTNAME_REGISTRY") ||
828 !strcmp (name_str, "CLASSIFICATION") ||
829 !strcmp (name_str, "COPYRIGHT") ||
830 !strcmp (name_str, "DEVICE_FONT_NAME") ||
831 !strcmp (name_str, "FULL_NAME") ||
832 !strcmp (name_str, "MONOSPACED") ||
833 !strcmp (name_str, "QUALITY") ||
834 !strcmp (name_str, "RELATIVE_SET") ||
835 !strcmp (name_str, "RELATIVE_WEIGHT") ||
836 !strcmp (name_str, "STYLE")))
838 val_str = XGetAtomName (dpy, props [i].card32);
839 value = (val_str ? build_string (val_str) : Qnil);
842 value = make_int (props [i].card32);
843 if (name_str) XFree (name_str);
844 result = Fcons (Fcons (name, value), result);
850 x_list_fonts (Lisp_Object pattern, Lisp_Object device)
854 Lisp_Object result = Qnil;
855 CONST char *patternext;
857 GET_C_STRING_BINARY_DATA_ALLOCA (pattern, patternext);
859 names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
860 patternext, MAX_FONT_COUNT, &count);
862 result = Fcons (build_ext_string (names [count], FORMAT_BINARY), result);
864 XFreeFontNames (names);
871 x_font_spec_matches_charset (struct device *d, Lisp_Object charset,
872 CONST Bufbyte *nonreloc, Lisp_Object reloc,
873 Bytecount offset, Bytecount length)
875 if (UNBOUNDP (charset))
877 /* Hack! Short font names don't have the registry in them,
878 so we just assume the user knows what they're doing in the
879 case of ASCII. For other charsets, you gotta give the
880 long form; sorry buster.
882 if (EQ (charset, Vcharset_ascii))
884 CONST Bufbyte *the_nonreloc = nonreloc;
886 Bytecount the_length = length;
889 the_nonreloc = XSTRING_DATA (reloc);
890 fixup_internal_substring (nonreloc, reloc, offset, &the_length);
891 the_nonreloc += offset;
892 if (!memchr (the_nonreloc, '*', the_length))
896 CONST Bufbyte *new_nonreloc = (CONST Bufbyte *)
897 memchr (the_nonreloc, '-', the_length);
901 the_length -= new_nonreloc - the_nonreloc;
902 the_nonreloc = new_nonreloc;
905 /* If it has less than 5 dashes, it's a short font.
906 Of course, long fonts always have 14 dashes or so, but short
907 fonts never have more than 1 or 2 dashes, so this is some
908 sort of reasonable heuristic. */
914 return (fast_string_match (XCHARSET_REGISTRY (charset),
915 nonreloc, reloc, offset, length, 1,
919 /* find a font spec that matches font spec FONT and also matches
920 (the registry of) CHARSET. */
922 x_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset)
926 Lisp_Object result = Qnil;
927 CONST char *patternext;
930 GET_C_STRING_BINARY_DATA_ALLOCA (font, patternext);
932 names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
933 patternext, MAX_FONT_COUNT, &count);
934 /* ### This code seems awfully bogus -- mrb */
935 for (i = 0; i < count; i ++)
937 CONST Bufbyte *intname;
939 GET_C_CHARPTR_INT_BINARY_DATA_ALLOCA (names[i], intname);
940 if (x_font_spec_matches_charset (XDEVICE (device), charset,
941 intname, Qnil, 0, -1))
943 result = build_string ((char *) intname);
949 XFreeFontNames (names);
951 /* Check for a short font name. */
953 && x_font_spec_matches_charset (XDEVICE (device), charset, 0,
963 /************************************************************************/
965 /************************************************************************/
968 syms_of_objects_x (void)
973 console_type_create_objects_x (void)
977 CONSOLE_HAS_METHOD (x, initialize_color_instance);
978 CONSOLE_HAS_METHOD (x, print_color_instance);
979 CONSOLE_HAS_METHOD (x, finalize_color_instance);
980 CONSOLE_HAS_METHOD (x, color_instance_equal);
981 CONSOLE_HAS_METHOD (x, color_instance_hash);
982 CONSOLE_HAS_METHOD (x, color_instance_rgb_components);
983 CONSOLE_HAS_METHOD (x, valid_color_name_p);
985 CONSOLE_HAS_METHOD (x, initialize_font_instance);
986 CONSOLE_HAS_METHOD (x, mark_font_instance);
987 CONSOLE_HAS_METHOD (x, print_font_instance);
988 CONSOLE_HAS_METHOD (x, finalize_font_instance);
989 CONSOLE_HAS_METHOD (x, font_instance_truename);
990 CONSOLE_HAS_METHOD (x, font_instance_properties);
991 CONSOLE_HAS_METHOD (x, list_fonts);
993 CONSOLE_HAS_METHOD (x, find_charset_font);
994 CONSOLE_HAS_METHOD (x, font_spec_matches_charset);
999 vars_of_objects_x (void)
1001 DEFVAR_BOOL ("x-handle-non-fully-specified-fonts",
1002 &x_handle_non_fully_specified_fonts /*
1003 If this is true then fonts which do not have all characters specified
1004 will be considered to be proportional width even if they are actually
1005 fixed-width. If this is not done then characters which are supposed to
1006 have 0 width may appear to actually have some width.
1008 Note: While setting this to t guarantees correct output in all
1009 circumstances, it also causes a noticeable performance hit when using
1010 fixed-width fonts. Since most people don't use characters which could
1011 cause problems this is set to nil by default.
1013 x_handle_non_fully_specified_fonts = 0;
1017 Xatoms_of_objects_x (struct device *d)
1019 Display *D = DEVICE_X_DISPLAY (d);
1021 DEVICE_XATOM_FOUNDRY (d) = XInternAtom (D, "FOUNDRY", False);
1022 DEVICE_XATOM_FAMILY_NAME (d) = XInternAtom (D, "FAMILY_NAME", False);
1023 DEVICE_XATOM_WEIGHT_NAME (d) = XInternAtom (D, "WEIGHT_NAME", False);
1024 DEVICE_XATOM_SLANT (d) = XInternAtom (D, "SLANT", False);
1025 DEVICE_XATOM_SETWIDTH_NAME (d) = XInternAtom (D, "SETWIDTH_NAME", False);
1026 DEVICE_XATOM_ADD_STYLE_NAME (d) = XInternAtom (D, "ADD_STYLE_NAME", False);
1027 DEVICE_XATOM_PIXEL_SIZE (d) = XInternAtom (D, "PIXEL_SIZE", False);
1028 DEVICE_XATOM_POINT_SIZE (d) = XInternAtom (D, "POINT_SIZE", False);
1029 DEVICE_XATOM_RESOLUTION_X (d) = XInternAtom (D, "RESOLUTION_X", False);
1030 DEVICE_XATOM_RESOLUTION_Y (d) = XInternAtom (D, "RESOLUTION_Y", False);
1031 DEVICE_XATOM_SPACING (d) = XInternAtom (D, "SPACING", False);
1032 DEVICE_XATOM_AVERAGE_WIDTH (d) = XInternAtom (D, "AVERAGE_WIDTH", False);
1033 DEVICE_XATOM_CHARSET_REGISTRY(d) = XInternAtom (D, "CHARSET_REGISTRY",False);
1034 DEVICE_XATOM_CHARSET_ENCODING(d) = XInternAtom (D, "CHARSET_ENCODING",False);