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)
216 dpy = DEVICE_X_DISPLAY (d);
217 cmap = DEVICE_X_COLORMAP(d);
218 visual = DEVICE_X_VISUAL (d);
222 CONST Extbyte *extname;
225 GET_CHARPTR_EXT_BINARY_DATA_ALLOCA (name, len, extname, extnamelen);
226 result = XParseColor (dpy, cmap, (char *) extname, color);
230 maybe_signal_simple_error ("Unrecognized color", make_string (name, len),
234 result = allocate_nearest_color (dpy, cmap, visual, color);
237 maybe_signal_simple_error ("Couldn't allocate color",
238 make_string (name, len), Qcolor, errb);
246 x_initialize_color_instance (struct Lisp_Color_Instance *c, Lisp_Object name,
247 Lisp_Object device, Error_behavior errb)
252 result = x_parse_nearest_color (XDEVICE (device), &color,
254 XSTRING_LENGTH (name),
260 /* Don't allocate the data until we're sure that we will succeed,
261 or the finalize method may get fucked. */
262 c->data = xnew (struct x_color_instance_data);
264 COLOR_INSTANCE_X_DEALLOC (c) = 0;
266 COLOR_INSTANCE_X_DEALLOC (c) = 1;
267 COLOR_INSTANCE_X_COLOR (c) = color;
272 x_print_color_instance (struct Lisp_Color_Instance *c,
273 Lisp_Object printcharfun,
277 XColor color = COLOR_INSTANCE_X_COLOR (c);
278 sprintf (buf, " %ld=(%X,%X,%X)",
279 color.pixel, color.red, color.green, color.blue);
280 write_c_string (buf, printcharfun);
284 x_finalize_color_instance (struct Lisp_Color_Instance *c)
288 if (DEVICE_LIVE_P (XDEVICE (c->device)))
290 if (COLOR_INSTANCE_X_DEALLOC (c))
292 XFreeColors (DEVICE_X_DISPLAY (XDEVICE (c->device)), DEVICE_X_COLORMAP (XDEVICE (c->device)),
293 &COLOR_INSTANCE_X_COLOR (c).pixel, 1, 0);
301 /* Color instances are equal if they resolve to the same color on the
302 screen (have the same RGB values). I imagine that
303 "same RGB values" == "same cell in the colormap." Arguably we should
304 be comparing their names or pixel values instead. */
307 x_color_instance_equal (struct Lisp_Color_Instance *c1,
308 struct Lisp_Color_Instance *c2,
311 XColor color1 = COLOR_INSTANCE_X_COLOR (c1);
312 XColor color2 = COLOR_INSTANCE_X_COLOR (c2);
313 return ((color1.red == color2.red) &&
314 (color1.green == color2.green) &&
315 (color1.blue == color2.blue));
319 x_color_instance_hash (struct Lisp_Color_Instance *c, int depth)
321 XColor color = COLOR_INSTANCE_X_COLOR (c);
322 return HASH3 (color.red, color.green, color.blue);
326 x_color_instance_rgb_components (struct Lisp_Color_Instance *c)
328 XColor color = COLOR_INSTANCE_X_COLOR (c);
329 return (list3 (make_int (color.red),
330 make_int (color.green),
331 make_int (color.blue)));
335 x_valid_color_name_p (struct device *d, Lisp_Object color)
338 Display *dpy = DEVICE_X_DISPLAY (d);
339 Colormap cmap = DEVICE_X_COLORMAP (d);
343 GET_C_STRING_CTEXT_DATA_ALLOCA (color, extname);
345 return XParseColor (dpy, cmap,
350 /************************************************************************/
352 /************************************************************************/
355 x_initialize_font_instance (struct Lisp_Font_Instance *f, Lisp_Object name,
356 Lisp_Object device, Error_behavior errb)
362 dpy = DEVICE_X_DISPLAY (XDEVICE (device));
363 GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, extname);
364 xf = XLoadQueryFont (dpy, extname);
368 maybe_signal_simple_error ("Couldn't load font", f->name,
373 if (!xf->max_bounds.width)
375 /* yes, this has been known to happen. */
377 maybe_signal_simple_error ("X font is too small", f->name,
382 /* Don't allocate the data until we're sure that we will succeed,
383 or the finalize method may get fucked. */
384 f->data = xnew (struct x_font_instance_data);
385 FONT_INSTANCE_X_TRUENAME (f) = Qnil;
386 FONT_INSTANCE_X_FONT (f) = xf;
387 f->ascent = xf->ascent;
388 f->descent = xf->descent;
389 f->height = xf->ascent + xf->descent;
391 /* following change suggested by Ted Phelps <phelps@dstc.edu.au> */
392 unsigned int def_char = 'n'; /*xf->default_char;*/
393 unsigned int byte1, byte2;
396 byte1 = def_char >> 8;
397 byte2 = def_char & 0xFF;
401 /* Old versions of the R5 font server have garbage (>63k) as
402 def_char. 'n' might not be a valid character. */
403 if (byte1 < xf->min_byte1 ||
404 byte1 > xf->max_byte1 ||
405 byte2 < xf->min_char_or_byte2 ||
406 byte2 > xf->max_char_or_byte2)
409 f->width = xf->per_char[(byte1 - xf->min_byte1) *
410 (xf->max_char_or_byte2 -
411 xf->min_char_or_byte2 + 1) +
412 (byte2 - xf->min_char_or_byte2)].width;
415 f->width = xf->max_bounds.width;
417 /* Some fonts have a default char whose width is 0. This is no good.
418 If that's the case, first try 'n' as the default char, and if n has
419 0 width too (unlikely) then just use the max width. */
422 if (def_char == xf->default_char)
423 f->width = xf->max_bounds.width;
426 def_char = xf->default_char;
431 /* If all characters don't exist then there could potentially be
432 0-width characters lurking out there. Not setting this flag
433 trips an optimization that would make them appear to have width
434 to redisplay. This is bad. So we set it if not all characters
435 have the same width or if not all characters are defined.
437 /* #### This sucks. There is a measurable performance increase
438 when using proportional width fonts if this flag is not set.
439 Unfortunately so many of the fucking X fonts are not fully
440 defined that we could almost just get rid of this damn flag and
441 make it an assertion. */
442 f->proportional_p = (xf->min_bounds.width != xf->max_bounds.width ||
443 (x_handle_non_fully_specified_fonts &&
444 !xf->all_chars_exist));
450 x_mark_font_instance (struct Lisp_Font_Instance *f,
451 void (*markobj) (Lisp_Object))
453 markobj (FONT_INSTANCE_X_TRUENAME (f));
457 x_print_font_instance (struct Lisp_Font_Instance *f,
458 Lisp_Object printcharfun,
462 sprintf (buf, " 0x%lx", (unsigned long) FONT_INSTANCE_X_FONT (f)->fid);
463 write_c_string (buf, printcharfun);
467 x_finalize_font_instance (struct Lisp_Font_Instance *f)
472 if (DEVICE_LIVE_P (XDEVICE (f->device)))
474 Display *dpy = DEVICE_X_DISPLAY (XDEVICE (f->device));
476 XFreeFont (dpy, FONT_INSTANCE_X_FONT (f));
483 /* Determining the truename of a font is hard. (Big surprise.)
485 By "truename" we mean an XLFD-form name which contains no wildcards, yet
486 which resolves to *exactly* the same font as the one which we already have
487 the (probably wildcarded) name and `XFontStruct' of.
489 One might think that the first font returned by XListFonts would be the one
490 that XOpenFont would pick. Apparently this is the case on some servers,
491 but not on others. It would seem not to be specified.
493 The MIT R5 server sometimes appears to be picking the lexicographically
494 smallest font which matches the name (thus picking "adobe" fonts before
495 "bitstream" fonts even if the bitstream fonts are earlier in the path, and
496 also picking 100dpi adobe fonts over 75dpi adobe fonts even though the
497 75dpi are in the path earlier) but sometimes appears to be doing something
498 else entirely (for example, removing the bitsream fonts from the path will
499 cause the 75dpi adobe fonts to be used instead of the 100dpi, even though
500 their relative positions in the path (and their names!) have not changed).
502 The documentation for XSetFontPath() seems to indicate that the order of
503 entries in the font path means something, but it's pretty noncommital about
504 it, and the spirit of the law is apparently not being obeyed...
506 All the fonts I've seen have a property named `FONT' which contains the
507 truename of the font. However, there are two problems with using this: the
508 first is that the X Protocol Document is quite explicit that all properties
509 are optional, so we can't depend on it being there. The second is that
510 it's conceivable that this alleged truename isn't actually accessible as a
511 font, due to some difference of opinion between the font designers and
512 whoever installed the font on the system.
514 So, our first attempt is to look for a FONT property, and then verify that
515 the name there is a valid name by running XListFonts on it. There's still
516 the potential that this could be true but we could still be being lied to,
517 but that seems pretty remote.
519 Late breaking news: I've gotten reports that SunOS 4.1.3U1
520 with OpenWound 3.0 has a font whose truename is really
521 "-Adobe-Courier-Medium-R-Normal--12-120-75-75-M-70-ISO8859-1"
522 but whose FONT property contains "Courier".
524 So we disbelieve the FONT property unless it begins with a dash and
525 is more than 30 characters long. X Windows: The defacto substandard.
526 X Windows: Complex nonsolutions to simple nonproblems. X Windows:
529 If the FONT property doesn't exist, then we try and construct an XLFD name
530 out of the other font properties (FOUNDRY, FAMILY_NAME, WEIGHT_NAME, etc).
531 This is necessary at least for some versions of OpenWound. But who knows
532 what the future will bring.
534 If that doesn't work, then we use XListFonts and either take the first font
535 (which I think is the most sensible thing) or we find the lexicographically
536 least, depending on whether the preprocessor constant `XOPENFONT_SORTS' is
537 defined. This sucks because the two behaviors are a property of the server
538 being used, not the architecture on which emacs has been compiled. Also,
539 as I described above, sorting isn't ALWAYS what the server does. Really it
540 does something seemingly random. There is no reliable way to win if the
541 FONT property isn't present.
543 Another possibility which I haven't bothered to implement would be to map
544 over all of the matching fonts and find the first one that has the same
545 character metrics as the font we already have loaded. Even if this didn't
546 return exactly the same font, it would at least return one whose characters
547 were the same sizes, which would probably be good enough.
549 More late-breaking news: on RS/6000 AIX 3.2.4, the expression
550 XLoadQueryFont (dpy, "-*-Fixed-Medium-R-*-*-*-130-75-75-*-*-ISO8859-1")
551 actually returns the font
552 -Misc-Fixed-Medium-R-Normal--13-120-75-75-C-80-ISO8859-1
553 which is crazy, because that font doesn't even match that pattern! It is
554 also not included in the output produced by `xlsfonts' with that pattern.
556 So this is yet another example of XListFonts() and XOpenFont() using
557 completely different algorithms. This, however, is a goofier example of
558 this bug, because in this case, it's not just the search order that is
559 different -- the sets don't even intersect.
561 If anyone has any better ideas how to do this, or any insights on what it is
562 that the various servers are actually doing, please let me know! -- jwz. */
565 valid_x_font_name_p (Display *dpy, char *name)
567 /* Maybe this should be implemented by calling XLoadFont and trapping
568 the error. That would be a lot of work, and wasteful as hell, but
569 might be more correct.
575 names = XListFonts (dpy, name, 1, &nnames);
577 XFreeFontNames (names);
578 return (nnames != 0);
582 truename_via_FONT_prop (Display *dpy, XFontStruct *font)
584 unsigned long value = 0;
586 if (XGetFontProperty (font, XA_FONT, &value))
587 result = XGetAtomName (dpy, value);
588 /* result is now 0, or the string value of the FONT property. */
591 /* Verify that result is an XLFD name (roughly...) */
592 if (result [0] != '-' || strlen (result) < (unsigned int) 30)
598 return result; /* this must be freed by caller if non-0 */
602 truename_via_random_props (Display *dpy, XFontStruct *font)
604 struct device *d = get_device_from_display (dpy);
605 unsigned long value = 0;
606 char *foundry, *family, *weight, *slant, *setwidth, *add_style;
607 unsigned long pixel, point, res_x, res_y;
609 unsigned long avg_width;
610 char *registry, *encoding;
611 char composed_name [2048];
615 #define get_string(atom,var) \
616 if (XGetFontProperty (font, (atom), &value)) \
617 var = XGetAtomName (dpy, value); \
621 #define get_number(atom,var) \
622 if (!XGetFontProperty (font, (atom), &var) || \
626 foundry = family = weight = slant = setwidth = 0;
627 add_style = spacing = registry = encoding = 0;
629 get_string (DEVICE_XATOM_FOUNDRY (d), foundry);
630 get_string (DEVICE_XATOM_FAMILY_NAME (d), family);
631 get_string (DEVICE_XATOM_WEIGHT_NAME (d), weight);
632 get_string (DEVICE_XATOM_SLANT (d), slant);
633 get_string (DEVICE_XATOM_SETWIDTH_NAME (d), setwidth);
634 get_string (DEVICE_XATOM_ADD_STYLE_NAME (d), add_style);
635 get_number (DEVICE_XATOM_PIXEL_SIZE (d), pixel);
636 get_number (DEVICE_XATOM_POINT_SIZE (d), point);
637 get_number (DEVICE_XATOM_RESOLUTION_X (d), res_x);
638 get_number (DEVICE_XATOM_RESOLUTION_Y (d), res_y);
639 get_string (DEVICE_XATOM_SPACING (d), spacing);
640 get_number (DEVICE_XATOM_AVERAGE_WIDTH (d), avg_width);
641 get_string (DEVICE_XATOM_CHARSET_REGISTRY (d), registry);
642 get_string (DEVICE_XATOM_CHARSET_ENCODING (d), encoding);
646 sprintf (composed_name,
647 "-%s-%s-%s-%s-%s-%s-%ld-%ld-%ld-%ld-%s-%ld-%s-%s",
648 foundry, family, weight, slant, setwidth, add_style, pixel,
649 point, res_x, res_y, spacing, avg_width, registry, encoding);
655 int L = strlen (composed_name) + 1;
656 result = (char *) xmalloc (L);
657 strncpy (result, composed_name, L);
662 if (foundry) XFree (foundry);
663 if (family) XFree (family);
664 if (weight) XFree (weight);
665 if (slant) XFree (slant);
666 if (setwidth) XFree (setwidth);
667 if (add_style) XFree (add_style);
668 if (spacing) XFree (spacing);
669 if (registry) XFree (registry);
670 if (encoding) XFree (encoding);
675 /* Unbounded, for sufficiently small values of infinity... */
676 #define MAX_FONT_COUNT 5000
679 truename_via_XListFonts (Display *dpy, char *font_name)
685 #ifndef XOPENFONT_SORTS
686 /* In a sensible world, the first font returned by XListFonts()
687 would be the font that XOpenFont() would use. */
688 names = XListFonts (dpy, font_name, 1, &count);
689 if (count) result = names [0];
691 /* But the world I live in is much more perverse. */
692 names = XListFonts (dpy, font_name, MAX_FONT_COUNT, &count);
694 /* If names[count] is lexicographically less than result, use it.
695 (#### Should we be comparing case-insensitively?) */
696 if (result == 0 || (strcmp (result, names [count]) < 0))
697 result = names [count];
701 result = xstrdup (result);
703 XFreeFontNames (names);
705 return result; /* this must be freed by caller if non-0 */
709 x_font_truename (Display *dpy, char *name, XFontStruct *font)
711 char *truename_FONT = 0;
712 char *truename_random = 0;
715 /* The search order is:
716 - if FONT property exists, and is a valid name, return it.
717 - if the other props exist, and add up to a valid name, return it.
718 - if we find a matching name with XListFonts, return it.
719 - if FONT property exists, return it regardless.
720 - if other props exist, return the resultant name regardless.
724 truename = truename_FONT = truename_via_FONT_prop (dpy, font);
725 if (truename && !valid_x_font_name_p (dpy, truename))
728 truename = truename_random = truename_via_random_props (dpy, font);
729 if (truename && !valid_x_font_name_p (dpy, truename))
731 if (!truename && name)
732 truename = truename_via_XListFonts (dpy, name);
736 /* Gag - we weren't able to find a seemingly-valid truename.
737 Well, maybe we're on one of those braindead systems where
738 XListFonts() and XLoadFont() are in violent disagreement.
739 If we were able to compute a truename, try using that even
740 if evidence suggests that it's not a valid name - because
741 maybe it is, really, and that's better than nothing.
742 X Windows: You'll envy the dead.
745 truename = truename_FONT;
746 else if (truename_random)
747 truename = truename_random;
750 /* One or both of these are not being used - free them. */
751 if (truename_FONT && truename_FONT != truename)
752 XFree (truename_FONT);
753 if (truename_random && truename_random != truename)
754 XFree (truename_random);
758 Lisp_Object result = build_string (truename);
767 x_font_instance_truename (struct Lisp_Font_Instance *f, Error_behavior errb)
769 struct device *d = XDEVICE (f->device);
771 if (NILP (FONT_INSTANCE_X_TRUENAME (f)))
773 Display *dpy = DEVICE_X_DISPLAY (d);
774 char *name = (char *) XSTRING_DATA (f->name);
776 FONT_INSTANCE_X_TRUENAME (f) =
777 x_font_truename (dpy, name, FONT_INSTANCE_X_FONT (f));
779 if (NILP (FONT_INSTANCE_X_TRUENAME (f)))
781 Lisp_Object font_instance;
782 XSETFONT_INSTANCE (font_instance, f);
784 maybe_signal_simple_error ("Couldn't determine font truename",
785 font_instance, Qfont, errb);
786 /* Ok, just this once, return the font name as the truename.
787 (This is only used by Fequal() right now.) */
791 return (FONT_INSTANCE_X_TRUENAME (f));
795 x_font_instance_properties (struct Lisp_Font_Instance *f)
797 struct device *d = XDEVICE (f->device);
799 Lisp_Object result = Qnil;
803 dpy = DEVICE_X_DISPLAY (d);
804 props = FONT_INSTANCE_X_FONT (f)->properties;
805 for (i = FONT_INSTANCE_X_FONT (f)->n_properties - 1; i >= 0; i--)
809 Lisp_Object name, value;
810 Atom atom = props [i].name;
811 name_str = XGetAtomName (dpy, atom);
812 name = (name_str ? intern (name_str) : Qnil);
815 atom == DEVICE_XATOM_FOUNDRY (d) ||
816 atom == DEVICE_XATOM_FAMILY_NAME (d) ||
817 atom == DEVICE_XATOM_WEIGHT_NAME (d) ||
818 atom == DEVICE_XATOM_SLANT (d) ||
819 atom == DEVICE_XATOM_SETWIDTH_NAME (d) ||
820 atom == DEVICE_XATOM_ADD_STYLE_NAME (d) ||
821 atom == DEVICE_XATOM_SPACING (d) ||
822 atom == DEVICE_XATOM_CHARSET_REGISTRY (d) ||
823 atom == DEVICE_XATOM_CHARSET_ENCODING (d) ||
824 !strcmp (name_str, "CHARSET_COLLECTIONS") ||
825 !strcmp (name_str, "FONTNAME_REGISTRY") ||
826 !strcmp (name_str, "CLASSIFICATION") ||
827 !strcmp (name_str, "COPYRIGHT") ||
828 !strcmp (name_str, "DEVICE_FONT_NAME") ||
829 !strcmp (name_str, "FULL_NAME") ||
830 !strcmp (name_str, "MONOSPACED") ||
831 !strcmp (name_str, "QUALITY") ||
832 !strcmp (name_str, "RELATIVE_SET") ||
833 !strcmp (name_str, "RELATIVE_WEIGHT") ||
834 !strcmp (name_str, "STYLE")))
836 val_str = XGetAtomName (dpy, props [i].card32);
837 value = (val_str ? build_string (val_str) : Qnil);
840 value = make_int (props [i].card32);
841 if (name_str) XFree (name_str);
842 result = Fcons (Fcons (name, value), result);
848 x_list_fonts (Lisp_Object pattern, Lisp_Object device)
852 Lisp_Object result = Qnil;
853 CONST char *patternext;
855 GET_C_STRING_BINARY_DATA_ALLOCA (pattern, patternext);
857 names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
858 patternext, MAX_FONT_COUNT, &count);
860 result = Fcons (build_ext_string (names [count], FORMAT_BINARY), result);
862 XFreeFontNames (names);
869 x_font_spec_matches_charset (struct device *d, Lisp_Object charset,
870 CONST Bufbyte *nonreloc, Lisp_Object reloc,
871 Bytecount offset, Bytecount length)
873 if (UNBOUNDP (charset))
875 /* Hack! Short font names don't have the registry in them,
876 so we just assume the user knows what they're doing in the
877 case of ASCII. For other charsets, you gotta give the
878 long form; sorry buster.
880 if (EQ (charset, Vcharset_ascii))
882 CONST Bufbyte *the_nonreloc = nonreloc;
884 Bytecount the_length = length;
887 the_nonreloc = XSTRING_DATA (reloc);
888 fixup_internal_substring (nonreloc, reloc, offset, &the_length);
889 the_nonreloc += offset;
890 if (!memchr (the_nonreloc, '*', the_length))
894 CONST Bufbyte *new_nonreloc = (CONST Bufbyte *)
895 memchr (the_nonreloc, '-', the_length);
899 the_length -= new_nonreloc - the_nonreloc;
900 the_nonreloc = new_nonreloc;
903 /* If it has less than 5 dashes, it's a short font.
904 Of course, long fonts always have 14 dashes or so, but short
905 fonts never have more than 1 or 2 dashes, so this is some
906 sort of reasonable heuristic. */
912 return (fast_string_match (XCHARSET_REGISTRY (charset),
913 nonreloc, reloc, offset, length, 1,
917 /* find a font spec that matches font spec FONT and also matches
918 (the registry of) CHARSET. */
920 x_find_charset_font (Lisp_Object device, Lisp_Object font, Lisp_Object charset)
924 Lisp_Object result = Qnil;
925 CONST char *patternext;
928 GET_C_STRING_BINARY_DATA_ALLOCA (font, patternext);
930 names = XListFonts (DEVICE_X_DISPLAY (XDEVICE (device)),
931 patternext, MAX_FONT_COUNT, &count);
932 /* ### This code seems awfully bogus -- mrb */
933 for (i = 0; i < count; i ++)
935 CONST Bufbyte *intname;
937 GET_C_CHARPTR_INT_BINARY_DATA_ALLOCA (names[i], intname);
938 if (x_font_spec_matches_charset (XDEVICE (device), charset,
939 intname, Qnil, 0, -1))
941 result = build_string ((char *) intname);
947 XFreeFontNames (names);
949 /* Check for a short font name. */
951 && x_font_spec_matches_charset (XDEVICE (device), charset, 0,
961 /************************************************************************/
963 /************************************************************************/
966 syms_of_objects_x (void)
971 console_type_create_objects_x (void)
975 CONSOLE_HAS_METHOD (x, initialize_color_instance);
976 CONSOLE_HAS_METHOD (x, print_color_instance);
977 CONSOLE_HAS_METHOD (x, finalize_color_instance);
978 CONSOLE_HAS_METHOD (x, color_instance_equal);
979 CONSOLE_HAS_METHOD (x, color_instance_hash);
980 CONSOLE_HAS_METHOD (x, color_instance_rgb_components);
981 CONSOLE_HAS_METHOD (x, valid_color_name_p);
983 CONSOLE_HAS_METHOD (x, initialize_font_instance);
984 CONSOLE_HAS_METHOD (x, mark_font_instance);
985 CONSOLE_HAS_METHOD (x, print_font_instance);
986 CONSOLE_HAS_METHOD (x, finalize_font_instance);
987 CONSOLE_HAS_METHOD (x, font_instance_truename);
988 CONSOLE_HAS_METHOD (x, font_instance_properties);
989 CONSOLE_HAS_METHOD (x, list_fonts);
991 CONSOLE_HAS_METHOD (x, find_charset_font);
992 CONSOLE_HAS_METHOD (x, font_spec_matches_charset);
997 vars_of_objects_x (void)
999 DEFVAR_BOOL ("x-handle-non-fully-specified-fonts",
1000 &x_handle_non_fully_specified_fonts /*
1001 If this is true then fonts which do not have all characters specified
1002 will be considered to be proportional width even if they are actually
1003 fixed-width. If this is not done then characters which are supposed to
1004 have 0 width may appear to actually have some width.
1006 Note: While setting this to t guarantees correct output in all
1007 circumstances, it also causes a noticeable performance hit when using
1008 fixed-width fonts. Since most people don't use characters which could
1009 cause problems this is set to nil by default.
1011 x_handle_non_fully_specified_fonts = 0;
1015 Xatoms_of_objects_x (struct device *d)
1017 Display *D = DEVICE_X_DISPLAY (d);
1019 DEVICE_XATOM_FOUNDRY (d) = XInternAtom (D, "FOUNDRY", False);
1020 DEVICE_XATOM_FAMILY_NAME (d) = XInternAtom (D, "FAMILY_NAME", False);
1021 DEVICE_XATOM_WEIGHT_NAME (d) = XInternAtom (D, "WEIGHT_NAME", False);
1022 DEVICE_XATOM_SLANT (d) = XInternAtom (D, "SLANT", False);
1023 DEVICE_XATOM_SETWIDTH_NAME (d) = XInternAtom (D, "SETWIDTH_NAME", False);
1024 DEVICE_XATOM_ADD_STYLE_NAME (d) = XInternAtom (D, "ADD_STYLE_NAME", False);
1025 DEVICE_XATOM_PIXEL_SIZE (d) = XInternAtom (D, "PIXEL_SIZE", False);
1026 DEVICE_XATOM_POINT_SIZE (d) = XInternAtom (D, "POINT_SIZE", False);
1027 DEVICE_XATOM_RESOLUTION_X (d) = XInternAtom (D, "RESOLUTION_X", False);
1028 DEVICE_XATOM_RESOLUTION_Y (d) = XInternAtom (D, "RESOLUTION_Y", False);
1029 DEVICE_XATOM_SPACING (d) = XInternAtom (D, "SPACING", False);
1030 DEVICE_XATOM_AVERAGE_WIDTH (d) = XInternAtom (D, "AVERAGE_WIDTH", False);
1031 DEVICE_XATOM_CHARSET_REGISTRY(d) = XInternAtom (D, "CHARSET_REGISTRY",False);
1032 DEVICE_XATOM_CHARSET_ENCODING(d) = XInternAtom (D, "CHARSET_ENCODING",False);