1 /* Generic glyph/image implementation + display tables
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 1995 Tinker Systems
4 Copyright (C) 1995, 1996 Ben Wing
5 Copyright (C) 1995 Sun Microsystems
6 Copyright (C) 1998, 1999 Andy Piper
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 /* Written by Ben Wing and Chuck Thompson. */
40 #include "redisplay.h"
45 #include "blocktype.h"
51 Lisp_Object Qimage_conversion_error;
53 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
54 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p;
55 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p;
56 Lisp_Object Qmono_pixmap_image_instance_p;
57 Lisp_Object Qcolor_pixmap_image_instance_p;
58 Lisp_Object Qpointer_image_instance_p;
59 Lisp_Object Qsubwindow_image_instance_p;
60 Lisp_Object Qlayout_image_instance_p;
61 Lisp_Object Qwidget_image_instance_p;
62 Lisp_Object Qconst_glyph_variable;
63 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow;
64 Lisp_Object Q_file, Q_data, Q_face, Q_pixel_width, Q_pixel_height;
65 Lisp_Object Qformatted_string;
66 Lisp_Object Vcurrent_display_table;
67 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph;
68 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph;
69 Lisp_Object Vxemacs_logo;
70 Lisp_Object Vthe_nothing_vector;
71 Lisp_Object Vimage_instantiator_format_list;
72 Lisp_Object Vimage_instance_type_list;
73 Lisp_Object Vglyph_type_list;
75 int disable_animated_pixmaps;
77 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
78 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
79 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
80 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
81 DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow);
82 DEFINE_IMAGE_INSTANTIATOR_FORMAT (text);
84 #ifdef HAVE_WINDOW_SYSTEM
85 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
88 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
89 Lisp_Object Q_foreground, Q_background;
91 #define BitmapSuccess 0
92 #define BitmapOpenFailed 1
93 #define BitmapFileInvalid 2
94 #define BitmapNoMemory 3
99 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
104 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
106 Lisp_Object Q_color_symbols;
109 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
110 struct image_instantiator_format_entry
114 struct image_instantiator_methods *meths;
119 Dynarr_declare (struct image_instantiator_format_entry);
120 } image_instantiator_format_entry_dynarr;
122 image_instantiator_format_entry_dynarr *
123 the_image_instantiator_format_entry_dynarr;
125 static Lisp_Object allocate_image_instance (Lisp_Object device);
126 static void image_validate (Lisp_Object instantiator);
127 static void glyph_property_was_changed (Lisp_Object glyph,
128 Lisp_Object property,
130 static void register_ignored_expose (struct frame* f, int x, int y, int width, int height);
131 /* Unfortunately windows and X are different. In windows BeginPaint()
132 will prevent WM_PAINT messages being generated so it is unnecessary
133 to register exposures as they will not occur. Under X they will
135 int hold_ignored_expose_registration;
137 EXFUN (Fimage_instance_type, 1);
138 EXFUN (Fglyph_type, 1);
141 /****************************************************************************
142 * Image Instantiators *
143 ****************************************************************************/
145 struct image_instantiator_methods *
146 decode_device_ii_format (Lisp_Object device, Lisp_Object format,
151 if (!SYMBOLP (format))
153 if (ERRB_EQ (errb, ERROR_ME))
154 CHECK_SYMBOL (format);
158 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
162 Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
165 Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
167 if ((NILP (d) && NILP (device))
170 EQ (CONSOLE_TYPE (XCONSOLE
171 (DEVICE_CONSOLE (XDEVICE (device)))), d)))
172 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
176 maybe_signal_simple_error ("Invalid image-instantiator format", format,
182 struct image_instantiator_methods *
183 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
185 return decode_device_ii_format (Qnil, format, errb);
189 valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale)
192 struct image_instantiator_methods* meths =
193 decode_image_instantiator_format (format, ERROR_ME_NOT);
194 Lisp_Object contype = Qnil;
195 /* mess with the locale */
196 if (!NILP (locale) && SYMBOLP (locale))
200 struct console* console = decode_console (locale);
201 contype = console ? CONSOLE_TYPE (console) : locale;
203 /* nothing is valid in all locales */
204 if (EQ (format, Qnothing))
206 /* reject unknown formats */
207 else if (NILP (contype) || !meths)
210 for (i = 0; i < Dynarr_length (meths->consoles); i++)
211 if (EQ (contype, Dynarr_at (meths->consoles, i).symbol))
216 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
218 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
219 If LOCALE is non-nil then the format is checked in that domain.
220 If LOCALE is nil the current console is used.
221 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
222 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
223 'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled.
225 (image_instantiator_format, locale))
227 return valid_image_instantiator_format_p (image_instantiator_format, locale) ?
231 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
233 Return a list of valid image-instantiator formats.
237 return Fcopy_sequence (Vimage_instantiator_format_list);
241 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol,
242 struct image_instantiator_methods *meths)
244 struct image_instantiator_format_entry entry;
246 entry.symbol = symbol;
247 entry.device = device;
249 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
250 Vimage_instantiator_format_list =
251 Fcons (symbol, Vimage_instantiator_format_list);
255 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
257 image_instantiator_methods *meths)
259 add_entry_to_device_ii_format_list (Qnil, symbol, meths);
263 get_image_conversion_list (Lisp_Object console_type)
265 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
268 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
270 Set the image-conversion-list for consoles of the given TYPE.
271 The image-conversion-list specifies how image instantiators that
272 are strings should be interpreted. Each element of the list should be
273 a list of two elements (a regular expression string and a vector) or
274 a list of three elements (the preceding two plus an integer index into
275 the vector). The string is converted to the vector associated with the
276 first matching regular expression. If a vector index is specified, the
277 string itself is substituted into that position in the vector.
279 Note: The conversion above is applied when the image instantiator is
280 added to an image specifier, not when the specifier is actually
281 instantiated. Therefore, changing the image-conversion-list only affects
282 newly-added instantiators. Existing instantiators in glyphs and image
283 specifiers will not be affected.
285 (console_type, list))
288 Lisp_Object *imlist = get_image_conversion_list (console_type);
290 /* Check the list to make sure that it only has valid entries. */
292 EXTERNAL_LIST_LOOP (tail, list)
294 Lisp_Object mapping = XCAR (tail);
296 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
297 if (!CONSP (mapping) ||
298 !CONSP (XCDR (mapping)) ||
299 (!NILP (XCDR (XCDR (mapping))) &&
300 (!CONSP (XCDR (XCDR (mapping))) ||
301 !NILP (XCDR (XCDR (XCDR (mapping)))))))
302 signal_simple_error ("Invalid mapping form", mapping);
305 Lisp_Object exp = XCAR (mapping);
306 Lisp_Object typevec = XCAR (XCDR (mapping));
307 Lisp_Object pos = Qnil;
312 CHECK_VECTOR (typevec);
313 if (!NILP (XCDR (XCDR (mapping))))
315 pos = XCAR (XCDR (XCDR (mapping)));
317 if (XINT (pos) < 0 ||
318 XINT (pos) >= XVECTOR_LENGTH (typevec))
320 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
323 newvec = Fcopy_sequence (typevec);
325 XVECTOR_DATA (newvec)[XINT (pos)] = exp;
327 image_validate (newvec);
332 *imlist = Fcopy_tree (list, Qt);
336 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
338 Return the image-conversion-list for devices of the given TYPE.
339 The image-conversion-list specifies how to interpret image string
340 instantiators for the specified console type. See
341 `set-console-type-image-conversion-list' for a description of its syntax.
345 return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
348 /* Process a string instantiator according to the image-conversion-list for
349 CONSOLE_TYPE. Returns a vector. */
352 process_image_string_instantiator (Lisp_Object data,
353 Lisp_Object console_type,
358 LIST_LOOP (tail, *get_image_conversion_list (console_type))
360 Lisp_Object mapping = XCAR (tail);
361 Lisp_Object exp = XCAR (mapping);
362 Lisp_Object typevec = XCAR (XCDR (mapping));
364 /* if the result is of a type that can't be instantiated
365 (e.g. a string when we're dealing with a pointer glyph),
368 IIFORMAT_METH (decode_image_instantiator_format
369 (XVECTOR_DATA (typevec)[0], ERROR_ME),
370 possible_dest_types, ())))
372 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
374 if (!NILP (XCDR (XCDR (mapping))))
376 int pos = XINT (XCAR (XCDR (XCDR (mapping))));
377 Lisp_Object newvec = Fcopy_sequence (typevec);
378 XVECTOR_DATA (newvec)[pos] = data;
387 signal_simple_error ("Unable to interpret glyph instantiator",
394 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
395 Lisp_Object default_)
398 int instantiator_len;
400 elt = XVECTOR_DATA (vector);
401 instantiator_len = XVECTOR_LENGTH (vector);
406 while (instantiator_len > 0)
408 if (EQ (elt[0], keyword))
411 instantiator_len -= 2;
418 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
420 return find_keyword_in_vector_or_given (vector, keyword, Qnil);
424 check_valid_string (Lisp_Object data)
430 check_valid_vector (Lisp_Object data)
436 check_valid_face (Lisp_Object data)
442 check_valid_int (Lisp_Object data)
448 file_or_data_must_be_present (Lisp_Object instantiator)
450 if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
451 NILP (find_keyword_in_vector (instantiator, Q_data)))
452 signal_simple_error ("Must supply either :file or :data",
457 data_must_be_present (Lisp_Object instantiator)
459 if (NILP (find_keyword_in_vector (instantiator, Q_data)))
460 signal_simple_error ("Must supply :data", instantiator);
464 face_must_be_present (Lisp_Object instantiator)
466 if (NILP (find_keyword_in_vector (instantiator, Q_face)))
467 signal_simple_error ("Must supply :face", instantiator);
470 /* utility function useful in retrieving data from a file. */
473 make_string_from_file (Lisp_Object file)
475 /* This function can call lisp */
476 int count = specpdl_depth ();
477 Lisp_Object temp_buffer;
481 specbind (Qinhibit_quit, Qt);
482 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
483 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
484 GCPRO1 (temp_buffer);
485 set_buffer_internal (XBUFFER (temp_buffer));
486 Ferase_buffer (Qnil);
487 specbind (intern ("format-alist"), Qnil);
488 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
489 data = Fbuffer_substring (Qnil, Qnil, Qnil);
490 unbind_to (count, Qnil);
495 /* The following two functions are provided to make it easier for
496 the normalize methods to work with keyword-value vectors.
497 Hash tables are kind of heavyweight for this purpose.
498 (If vectors were resizable, we could avoid this problem;
499 but they're not.) An alternative approach that might be
500 more efficient but require more work is to use a type of
501 assoc-Dynarr and provide primitives for deleting elements out
502 of it. (However, you'd also have to add an unwind-protect
503 to make sure the Dynarr got freed in case of an error in
504 the normalization process.) */
507 tagged_vector_to_alist (Lisp_Object vector)
509 Lisp_Object *elt = XVECTOR_DATA (vector);
510 int len = XVECTOR_LENGTH (vector);
511 Lisp_Object result = Qnil;
514 for (len -= 2; len >= 1; len -= 2)
515 result = Fcons (Fcons (elt[len], elt[len+1]), result);
521 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
523 int len = 1 + 2 * XINT (Flength (alist));
524 Lisp_Object *elt = alloca_array (Lisp_Object, len);
530 LIST_LOOP (rest, alist)
532 Lisp_Object pair = XCAR (rest);
533 elt[i] = XCAR (pair);
534 elt[i+1] = XCDR (pair);
538 return Fvector (len, elt);
542 normalize_image_instantiator (Lisp_Object instantiator,
544 Lisp_Object dest_mask)
546 if (IMAGE_INSTANCEP (instantiator))
549 if (STRINGP (instantiator))
550 instantiator = process_image_string_instantiator (instantiator, contype,
553 assert (VECTORP (instantiator));
554 /* We have to always store the actual pixmap data and not the
555 filename even though this is a potential memory pig. We have to
556 do this because it is quite possible that we will need to
557 instantiate a new instance of the pixmap and the file will no
558 longer exist (e.g. w3 pixmaps are almost always from temporary
562 struct image_instantiator_methods *meths;
564 GCPRO1 (instantiator);
566 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
568 RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
569 (instantiator, contype),
575 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
576 Lisp_Object instantiator,
577 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
580 Lisp_Object ii = allocate_image_instance (device);
581 struct image_instantiator_methods *meths;
586 if (!valid_image_instantiator_format_p (XVECTOR_DATA (instantiator)[0], device))
588 ("Image instantiator format is invalid in this locale.",
591 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
593 methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate);
594 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
595 pointer_bg, dest_mask, domain));
597 /* now do device specific instantiation */
598 meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0],
601 if (!methp && (!meths || !HAS_IIFORMAT_METH_P (meths, instantiate)))
603 ("Don't know how to instantiate this image instantiator?",
605 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
606 pointer_bg, dest_mask, domain));
613 /****************************************************************************
614 * Image-Instance Object *
615 ****************************************************************************/
617 Lisp_Object Qimage_instancep;
620 mark_image_instance (Lisp_Object obj)
622 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
624 mark_object (i->name);
625 switch (IMAGE_INSTANCE_TYPE (i))
628 mark_object (IMAGE_INSTANCE_TEXT_STRING (i));
630 case IMAGE_MONO_PIXMAP:
631 case IMAGE_COLOR_PIXMAP:
632 mark_object (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
633 mark_object (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
634 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
635 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
636 mark_object (IMAGE_INSTANCE_PIXMAP_FG (i));
637 mark_object (IMAGE_INSTANCE_PIXMAP_BG (i));
641 mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i));
642 mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i));
643 mark_object (IMAGE_INSTANCE_WIDGET_FACE (i));
644 mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i));
645 case IMAGE_SUBWINDOW:
646 mark_object (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
650 mark_object (IMAGE_INSTANCE_LAYOUT_CHILDREN (i));
651 mark_object (IMAGE_INSTANCE_LAYOUT_BORDER (i));
652 mark_object (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
659 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i));
665 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
669 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
672 error ("printing unreadable object #<image-instance 0x%x>",
674 write_c_string ("#<image-instance (", printcharfun);
675 print_internal (Fimage_instance_type (obj), printcharfun, 0);
676 write_c_string (") ", printcharfun);
677 if (!NILP (ii->name))
679 print_internal (ii->name, printcharfun, 1);
680 write_c_string (" ", printcharfun);
682 write_c_string ("on ", printcharfun);
683 print_internal (ii->device, printcharfun, 0);
684 write_c_string (" ", printcharfun);
685 switch (IMAGE_INSTANCE_TYPE (ii))
691 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
694 case IMAGE_MONO_PIXMAP:
695 case IMAGE_COLOR_PIXMAP:
697 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
700 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
701 s = strrchr ((char *) XSTRING_DATA (filename), '/');
703 print_internal (build_string (s + 1), printcharfun, 1);
705 print_internal (filename, printcharfun, 1);
707 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
708 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
709 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
710 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
712 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
713 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
714 write_c_string (buf, printcharfun);
715 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
716 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
718 write_c_string (" @", printcharfun);
719 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
721 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
722 write_c_string (buf, printcharfun);
725 write_c_string ("??", printcharfun);
726 write_c_string (",", printcharfun);
727 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
729 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
730 write_c_string (buf, printcharfun);
733 write_c_string ("??", printcharfun);
735 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
736 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
738 write_c_string (" (", printcharfun);
739 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
743 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
745 write_c_string ("/", printcharfun);
746 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
750 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
752 write_c_string (")", printcharfun);
758 if (!NILP (IMAGE_INSTANCE_WIDGET_CALLBACK (ii)))
760 print_internal (IMAGE_INSTANCE_WIDGET_CALLBACK (ii), printcharfun, 0);
761 write_c_string (", ", printcharfun);
764 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
766 write_c_string (" (", printcharfun);
768 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
769 write_c_string (")", printcharfun);
772 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
773 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0);
775 case IMAGE_SUBWINDOW:
777 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
778 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
779 write_c_string (buf, printcharfun);
781 /* This is stolen from frame.c. Subwindows are strange in that they
782 are specific to a particular frame so we want to print in their
783 description what that frame is. */
785 write_c_string (" on #<", printcharfun);
787 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
789 if (!FRAME_LIVE_P (f))
790 write_c_string ("dead", printcharfun);
792 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
795 write_c_string ("-frame ", printcharfun);
797 write_c_string (">", printcharfun);
798 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
799 write_c_string (buf, printcharfun);
807 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
808 (ii, printcharfun, escapeflag));
809 sprintf (buf, " 0x%x>", ii->header.uid);
810 write_c_string (buf, printcharfun);
814 finalize_image_instance (void *header, int for_disksave)
816 struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header;
818 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
819 /* objects like this exist at dump time, so don't bomb out. */
821 if (for_disksave) finalose (i);
823 /* do this so that the cachels get reset */
824 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
826 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
828 MARK_FRAME_SUBWINDOWS_CHANGED
829 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
832 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
836 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
838 struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
839 struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
840 struct device *d1 = XDEVICE (i1->device);
841 struct device *d2 = XDEVICE (i2->device);
845 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2))
847 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
851 switch (IMAGE_INSTANCE_TYPE (i1))
857 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
858 IMAGE_INSTANCE_TEXT_STRING (i2),
863 case IMAGE_MONO_PIXMAP:
864 case IMAGE_COLOR_PIXMAP:
866 if (!(IMAGE_INSTANCE_PIXMAP_WIDTH (i1) ==
867 IMAGE_INSTANCE_PIXMAP_WIDTH (i2) &&
868 IMAGE_INSTANCE_PIXMAP_HEIGHT (i1) ==
869 IMAGE_INSTANCE_PIXMAP_HEIGHT (i2) &&
870 IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
871 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
872 IMAGE_INSTANCE_PIXMAP_SLICE (i1) ==
873 IMAGE_INSTANCE_PIXMAP_SLICE (i2) &&
874 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
875 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
876 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
877 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
878 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
879 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
881 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
882 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
888 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
889 IMAGE_INSTANCE_WIDGET_TYPE (i2))
890 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1),
891 IMAGE_INSTANCE_WIDGET_ITEMS (i2),
893 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
894 IMAGE_INSTANCE_WIDGET_PROPS (i2),
899 if (IMAGE_INSTANCE_TYPE (i1) == IMAGE_LAYOUT
901 !(EQ (IMAGE_INSTANCE_LAYOUT_BORDER (i1),
902 IMAGE_INSTANCE_LAYOUT_BORDER (i2))
904 internal_equal (IMAGE_INSTANCE_LAYOUT_CHILDREN (i1),
905 IMAGE_INSTANCE_LAYOUT_CHILDREN (i2),
908 case IMAGE_SUBWINDOW:
909 if (!(IMAGE_INSTANCE_SUBWINDOW_WIDTH (i1) ==
910 IMAGE_INSTANCE_SUBWINDOW_WIDTH (i2) &&
911 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i1) ==
912 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i2) &&
913 IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
914 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
922 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
926 image_instance_hash (Lisp_Object obj, int depth)
928 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
929 struct device *d = XDEVICE (i->device);
930 unsigned long hash = (unsigned long) d;
932 switch (IMAGE_INSTANCE_TYPE (i))
938 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
942 case IMAGE_MONO_PIXMAP:
943 case IMAGE_COLOR_PIXMAP:
945 hash = HASH6 (hash, IMAGE_INSTANCE_PIXMAP_WIDTH (i),
946 IMAGE_INSTANCE_PIXMAP_HEIGHT (i),
947 IMAGE_INSTANCE_PIXMAP_DEPTH (i),
948 IMAGE_INSTANCE_PIXMAP_SLICE (i),
949 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
955 internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1),
956 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
957 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1));
959 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_LAYOUT)
961 internal_hash (IMAGE_INSTANCE_LAYOUT_BORDER (i), depth + 1),
962 internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i),
964 case IMAGE_SUBWINDOW:
965 hash = HASH4 (hash, IMAGE_INSTANCE_SUBWINDOW_WIDTH (i),
966 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i),
967 (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
974 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
978 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
979 mark_image_instance, print_image_instance,
980 finalize_image_instance, image_instance_equal,
981 image_instance_hash, 0,
982 struct Lisp_Image_Instance);
985 allocate_image_instance (Lisp_Object device)
987 struct Lisp_Image_Instance *lp =
988 alloc_lcrecord_type (struct Lisp_Image_Instance, &lrecord_image_instance);
993 lp->type = IMAGE_NOTHING;
997 XSETIMAGE_INSTANCE (val, lp);
1001 static enum image_instance_type
1002 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
1004 if (ERRB_EQ (errb, ERROR_ME))
1005 CHECK_SYMBOL (type);
1007 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
1008 if (EQ (type, Qtext)) return IMAGE_TEXT;
1009 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
1010 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
1011 if (EQ (type, Qpointer)) return IMAGE_POINTER;
1012 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
1013 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
1014 if (EQ (type, Qlayout)) return IMAGE_LAYOUT;
1016 maybe_signal_simple_error ("Invalid image-instance type", type,
1019 return IMAGE_UNKNOWN; /* not reached */
1023 encode_image_instance_type (enum image_instance_type type)
1027 case IMAGE_NOTHING: return Qnothing;
1028 case IMAGE_TEXT: return Qtext;
1029 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
1030 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
1031 case IMAGE_POINTER: return Qpointer;
1032 case IMAGE_SUBWINDOW: return Qsubwindow;
1033 case IMAGE_WIDGET: return Qwidget;
1034 case IMAGE_LAYOUT: return Qlayout;
1039 return Qnil; /* not reached */
1043 image_instance_type_to_mask (enum image_instance_type type)
1045 /* This depends on the fact that enums are assigned consecutive
1046 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
1047 first enum.) I'm fairly sure this behavior is ANSI-mandated,
1048 so there should be no portability problems here. */
1049 return (1 << ((int) (type) - 1));
1053 decode_image_instance_type_list (Lisp_Object list)
1063 enum image_instance_type type =
1064 decode_image_instance_type (list, ERROR_ME);
1065 return image_instance_type_to_mask (type);
1068 EXTERNAL_LIST_LOOP (rest, list)
1070 enum image_instance_type type =
1071 decode_image_instance_type (XCAR (rest), ERROR_ME);
1072 mask |= image_instance_type_to_mask (type);
1079 encode_image_instance_type_list (int mask)
1082 Lisp_Object result = Qnil;
1088 result = Fcons (encode_image_instance_type
1089 ((enum image_instance_type) count), result);
1093 return Fnreverse (result);
1097 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1098 int desired_dest_mask)
1103 (emacs_doprnt_string_lisp_2
1105 "No compatible image-instance types given: wanted one of %s, got %s",
1107 encode_image_instance_type_list (desired_dest_mask),
1108 encode_image_instance_type_list (given_dest_mask)),
1113 valid_image_instance_type_p (Lisp_Object type)
1115 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1118 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1119 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1120 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1121 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1123 (image_instance_type))
1125 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1128 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1129 Return a list of valid image-instance types.
1133 return Fcopy_sequence (Vimage_instance_type_list);
1137 decode_error_behavior_flag (Lisp_Object no_error)
1139 if (NILP (no_error)) return ERROR_ME;
1140 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1141 else return ERROR_ME_WARN;
1145 encode_error_behavior_flag (Error_behavior errb)
1147 if (ERRB_EQ (errb, ERROR_ME))
1149 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1153 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1159 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1160 Lisp_Object dest_types)
1163 struct gcpro gcpro1;
1166 XSETDEVICE (device, decode_device (device));
1167 /* instantiate_image_instantiator() will abort if given an
1168 image instance ... */
1169 if (IMAGE_INSTANCEP (data))
1170 signal_simple_error ("Image instances not allowed here", data);
1171 image_validate (data);
1172 dest_mask = decode_image_instance_type_list (dest_types);
1173 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1174 make_int (dest_mask));
1176 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1177 signal_simple_error ("Inheritance not allowed here", data);
1178 ii = instantiate_image_instantiator (device, device, data,
1179 Qnil, Qnil, dest_mask);
1180 RETURN_UNGCPRO (ii);
1183 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1184 Return a new `image-instance' object.
1186 Image-instance objects encapsulate the way a particular image (pixmap,
1187 etc.) is displayed on a particular device. In most circumstances, you
1188 do not need to directly create image instances; use a glyph instead.
1189 However, it may occasionally be useful to explicitly create image
1190 instances, if you want more control over the instantiation process.
1192 DATA is an image instantiator, which describes the image; see
1193 `image-specifier-p' for a description of the allowed values.
1195 DEST-TYPES should be a list of allowed image instance types that can
1196 be generated. The recognized image instance types are
1199 Nothing is displayed.
1201 Displayed as text. The foreground and background colors and the
1202 font of the text are specified independent of the pixmap. Typically
1203 these attributes will come from the face of the surrounding text,
1204 unless a face is specified for the glyph in which the image appears.
1206 Displayed as a mono pixmap (a pixmap with only two colors where the
1207 foreground and background can be specified independent of the pixmap;
1208 typically the pixmap assumes the foreground and background colors of
1209 the text around it, unless a face is specified for the glyph in which
1212 Displayed as a color pixmap.
1214 Used as the mouse pointer for a window.
1216 A child window that is treated as an image. This allows (e.g.)
1217 another program to be responsible for drawing into the window.
1219 A child window that contains a window-system widget, e.g. a push
1222 The DEST-TYPES list is unordered. If multiple destination types
1223 are possible for a given instantiator, the "most natural" type
1224 for the instantiator's format is chosen. (For XBM, the most natural
1225 types are `mono-pixmap', followed by `color-pixmap', followed by
1226 `pointer'. For the other normal image formats, the most natural
1227 types are `color-pixmap', followed by `mono-pixmap', followed by
1228 `pointer'. For the string and formatted-string formats, the most
1229 natural types are `text', followed by `mono-pixmap' (not currently
1230 implemented), followed by `color-pixmap' (not currently implemented).
1231 The other formats can only be instantiated as one type. (If you
1232 want to control more specifically the order of the types into which
1233 an image is instantiated, just call `make-image-instance' repeatedly
1234 until it succeeds, passing less and less preferred destination types
1237 If DEST-TYPES is omitted, all possible types are allowed.
1239 NO-ERROR controls what happens when the image cannot be generated.
1240 If nil, an error message is generated. If t, no messages are
1241 generated and this function returns nil. If anything else, a warning
1242 message is generated and this function returns nil.
1244 (data, device, dest_types, no_error))
1246 Error_behavior errb = decode_error_behavior_flag (no_error);
1248 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1250 3, data, device, dest_types);
1253 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1254 Return non-nil if OBJECT is an image instance.
1258 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1261 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1262 Return the type of the given image instance.
1263 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1264 'color-pixmap, 'pointer, or 'subwindow.
1268 CHECK_IMAGE_INSTANCE (image_instance);
1269 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1272 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1273 Return the name of the given image instance.
1277 CHECK_IMAGE_INSTANCE (image_instance);
1278 return XIMAGE_INSTANCE_NAME (image_instance);
1281 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1282 Return the string of the given image instance.
1283 This will only be non-nil for text image instances and widgets.
1287 CHECK_IMAGE_INSTANCE (image_instance);
1288 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1289 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1290 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1291 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1296 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1297 Return the given property of the given image instance.
1298 Returns nil if the property or the property method do not exist for
1299 the image instance in the domain.
1301 (image_instance, prop))
1303 struct Lisp_Image_Instance* ii;
1304 Lisp_Object type, ret;
1305 struct image_instantiator_methods* meths;
1307 CHECK_IMAGE_INSTANCE (image_instance);
1308 CHECK_SYMBOL (prop);
1309 ii = XIMAGE_INSTANCE (image_instance);
1311 /* ... then try device specific methods ... */
1312 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1313 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1314 type, ERROR_ME_NOT);
1315 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1317 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1321 /* ... then format specific methods ... */
1322 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1323 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1325 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1333 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1334 Set the given property of the given image instance.
1335 Does nothing if the property or the property method do not exist for
1336 the image instance in the domain.
1338 (image_instance, prop, val))
1340 struct Lisp_Image_Instance* ii;
1341 Lisp_Object type, ret;
1342 struct image_instantiator_methods* meths;
1344 CHECK_IMAGE_INSTANCE (image_instance);
1345 CHECK_SYMBOL (prop);
1346 ii = XIMAGE_INSTANCE (image_instance);
1347 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1348 /* try device specific methods first ... */
1349 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1350 type, ERROR_ME_NOT);
1351 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1354 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1360 /* ... then format specific methods ... */
1361 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1362 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1365 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1375 /* Make sure the image instance gets redisplayed. */
1376 MARK_IMAGE_INSTANCE_CHANGED (ii);
1377 MARK_SUBWINDOWS_STATE_CHANGED;
1378 MARK_GLYPHS_CHANGED;
1383 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1384 Return the file name from which IMAGE-INSTANCE was read, if known.
1388 CHECK_IMAGE_INSTANCE (image_instance);
1390 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1392 case IMAGE_MONO_PIXMAP:
1393 case IMAGE_COLOR_PIXMAP:
1395 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1402 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1403 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1407 CHECK_IMAGE_INSTANCE (image_instance);
1409 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1411 case IMAGE_MONO_PIXMAP:
1412 case IMAGE_COLOR_PIXMAP:
1414 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1421 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1422 Return the depth of the image instance.
1423 This is 0 for a bitmap, or a positive integer for a pixmap.
1427 CHECK_IMAGE_INSTANCE (image_instance);
1429 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1431 case IMAGE_MONO_PIXMAP:
1432 case IMAGE_COLOR_PIXMAP:
1434 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1441 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1442 Return the height of the image instance, in pixels.
1446 CHECK_IMAGE_INSTANCE (image_instance);
1448 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1450 case IMAGE_MONO_PIXMAP:
1451 case IMAGE_COLOR_PIXMAP:
1453 return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance));
1455 case IMAGE_SUBWINDOW:
1458 return make_int (XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (image_instance));
1465 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1466 Return the width of the image instance, in pixels.
1470 CHECK_IMAGE_INSTANCE (image_instance);
1472 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1474 case IMAGE_MONO_PIXMAP:
1475 case IMAGE_COLOR_PIXMAP:
1477 return make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance));
1479 case IMAGE_SUBWINDOW:
1482 return make_int (XIMAGE_INSTANCE_SUBWINDOW_WIDTH (image_instance));
1489 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1490 Return the X coordinate of the image instance's hotspot, if known.
1491 This is a point relative to the origin of the pixmap. When an image is
1492 used as a mouse pointer, the hotspot is the point on the image that sits
1493 over the location that the pointer points to. This is, for example, the
1494 tip of the arrow or the center of the crosshairs.
1495 This will always be nil for a non-pointer image instance.
1499 CHECK_IMAGE_INSTANCE (image_instance);
1501 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1503 case IMAGE_MONO_PIXMAP:
1504 case IMAGE_COLOR_PIXMAP:
1506 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1513 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1514 Return the Y coordinate of the image instance's hotspot, if known.
1515 This is a point relative to the origin of the pixmap. When an image is
1516 used as a mouse pointer, the hotspot is the point on the image that sits
1517 over the location that the pointer points to. This is, for example, the
1518 tip of the arrow or the center of the crosshairs.
1519 This will always be nil for a non-pointer image instance.
1523 CHECK_IMAGE_INSTANCE (image_instance);
1525 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1527 case IMAGE_MONO_PIXMAP:
1528 case IMAGE_COLOR_PIXMAP:
1530 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1537 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1538 Return the foreground color of IMAGE-INSTANCE, if applicable.
1539 This will be a color instance or nil. (It will only be non-nil for
1540 colorized mono pixmaps and for pointers.)
1544 CHECK_IMAGE_INSTANCE (image_instance);
1546 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1548 case IMAGE_MONO_PIXMAP:
1549 case IMAGE_COLOR_PIXMAP:
1551 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1554 return FACE_FOREGROUND (
1555 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1556 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1564 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1565 Return the background color of IMAGE-INSTANCE, if applicable.
1566 This will be a color instance or nil. (It will only be non-nil for
1567 colorized mono pixmaps and for pointers.)
1571 CHECK_IMAGE_INSTANCE (image_instance);
1573 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1575 case IMAGE_MONO_PIXMAP:
1576 case IMAGE_COLOR_PIXMAP:
1578 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1581 return FACE_BACKGROUND (
1582 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1583 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1592 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1593 Make the image instance be displayed in the given colors.
1594 This function returns a new image instance that is exactly like the
1595 specified one except that (if possible) the foreground and background
1596 colors and as specified. Currently, this only does anything if the image
1597 instance is a mono pixmap; otherwise, the same image instance is returned.
1599 (image_instance, foreground, background))
1604 CHECK_IMAGE_INSTANCE (image_instance);
1605 CHECK_COLOR_INSTANCE (foreground);
1606 CHECK_COLOR_INSTANCE (background);
1608 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1609 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1610 return image_instance;
1612 /* #### There should be a copy_image_instance(), which calls a
1613 device-specific method to copy the window-system subobject. */
1614 new = allocate_image_instance (device);
1615 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1616 /* note that if this method returns non-zero, this method MUST
1617 copy any window-system resources, so that when one image instance is
1618 freed, the other one is not hosed. */
1619 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1621 return image_instance;
1626 /************************************************************************/
1628 /************************************************************************/
1630 signal_image_error (CONST char *reason, Lisp_Object frob)
1632 signal_error (Qimage_conversion_error,
1633 list2 (build_translated_string (reason), frob));
1637 signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1)
1639 signal_error (Qimage_conversion_error,
1640 list3 (build_translated_string (reason), frob0, frob1));
1643 /****************************************************************************
1645 ****************************************************************************/
1648 nothing_possible_dest_types (void)
1650 return IMAGE_NOTHING_MASK;
1654 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1655 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1656 int dest_mask, Lisp_Object domain)
1658 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1660 if (dest_mask & IMAGE_NOTHING_MASK)
1661 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1663 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1667 /****************************************************************************
1669 ****************************************************************************/
1672 inherit_validate (Lisp_Object instantiator)
1674 face_must_be_present (instantiator);
1678 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1682 assert (XVECTOR_LENGTH (inst) == 3);
1683 face = XVECTOR_DATA (inst)[2];
1685 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1690 inherit_possible_dest_types (void)
1692 return IMAGE_MONO_PIXMAP_MASK;
1696 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1697 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1698 int dest_mask, Lisp_Object domain)
1700 /* handled specially in image_instantiate */
1705 /****************************************************************************
1707 ****************************************************************************/
1710 string_validate (Lisp_Object instantiator)
1712 data_must_be_present (instantiator);
1716 string_possible_dest_types (void)
1718 return IMAGE_TEXT_MASK;
1721 /* called from autodetect_instantiate() */
1723 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1724 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1725 int dest_mask, Lisp_Object domain)
1727 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1728 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1730 assert (!NILP (data));
1731 if (dest_mask & IMAGE_TEXT_MASK)
1733 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1734 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1737 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1740 /* set the properties of a string */
1742 text_set_property (Lisp_Object image_instance, Lisp_Object prop,
1745 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1747 if (EQ (prop, Q_data))
1750 IMAGE_INSTANCE_TEXT_STRING (ii) = val;
1758 /****************************************************************************
1759 * formatted-string *
1760 ****************************************************************************/
1763 formatted_string_validate (Lisp_Object instantiator)
1765 data_must_be_present (instantiator);
1769 formatted_string_possible_dest_types (void)
1771 return IMAGE_TEXT_MASK;
1775 formatted_string_instantiate (Lisp_Object image_instance,
1776 Lisp_Object instantiator,
1777 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1778 int dest_mask, Lisp_Object domain)
1780 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1781 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1783 assert (!NILP (data));
1784 /* #### implement this */
1785 warn_when_safe (Qunimplemented, Qnotice,
1786 "`formatted-string' not yet implemented; assuming `string'");
1787 if (dest_mask & IMAGE_TEXT_MASK)
1789 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1790 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1793 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1797 /************************************************************************/
1798 /* pixmap file functions */
1799 /************************************************************************/
1801 /* If INSTANTIATOR refers to inline data, return Qnil.
1802 If INSTANTIATOR refers to data in a file, return the full filename
1803 if it exists; otherwise, return a cons of (filename).
1805 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
1806 keywords used to look up the file and inline data,
1807 respectively, in the instantiator. Normally these would
1808 be Q_file and Q_data, but might be different for mask data. */
1811 potential_pixmap_file_instantiator (Lisp_Object instantiator,
1812 Lisp_Object file_keyword,
1813 Lisp_Object data_keyword,
1814 Lisp_Object console_type)
1819 assert (VECTORP (instantiator));
1821 data = find_keyword_in_vector (instantiator, data_keyword);
1822 file = find_keyword_in_vector (instantiator, file_keyword);
1824 if (!NILP (file) && NILP (data))
1826 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
1827 (decode_console_type(console_type, ERROR_ME),
1828 locate_pixmap_file, (file));
1833 return Fcons (file, Qnil); /* should have been file */
1840 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
1841 Lisp_Object image_type_tag)
1843 /* This function can call lisp */
1844 Lisp_Object file = Qnil;
1845 struct gcpro gcpro1, gcpro2;
1846 Lisp_Object alist = Qnil;
1848 GCPRO2 (file, alist);
1850 /* Now, convert any file data into inline data. At the end of this,
1851 `data' will contain the inline data (if any) or Qnil, and `file'
1852 will contain the name this data was derived from (if known) or
1855 Note that if we cannot generate any regular inline data, we
1858 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1861 if (CONSP (file)) /* failure locating filename */
1862 signal_double_file_error ("Opening pixmap file",
1863 "no such file or directory",
1866 if (NILP (file)) /* no conversion necessary */
1867 RETURN_UNGCPRO (inst);
1869 alist = tagged_vector_to_alist (inst);
1872 Lisp_Object data = make_string_from_file (file);
1873 alist = remassq_no_quit (Q_file, alist);
1874 /* there can't be a :data at this point. */
1875 alist = Fcons (Fcons (Q_file, file),
1876 Fcons (Fcons (Q_data, data), alist));
1880 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
1882 RETURN_UNGCPRO (result);
1887 #ifdef HAVE_WINDOW_SYSTEM
1888 /**********************************************************************
1890 **********************************************************************/
1892 /* Check if DATA represents a valid inline XBM spec (i.e. a list
1893 of (width height bits), with checking done on the dimensions).
1894 If not, signal an error. */
1897 check_valid_xbm_inline (Lisp_Object data)
1899 Lisp_Object width, height, bits;
1901 if (!CONSP (data) ||
1902 !CONSP (XCDR (data)) ||
1903 !CONSP (XCDR (XCDR (data))) ||
1904 !NILP (XCDR (XCDR (XCDR (data)))))
1905 signal_simple_error ("Must be list of 3 elements", data);
1907 width = XCAR (data);
1908 height = XCAR (XCDR (data));
1909 bits = XCAR (XCDR (XCDR (data)));
1911 CHECK_STRING (bits);
1913 if (!NATNUMP (width))
1914 signal_simple_error ("Width must be a natural number", width);
1916 if (!NATNUMP (height))
1917 signal_simple_error ("Height must be a natural number", height);
1919 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
1920 signal_simple_error ("data is too short for width and height",
1921 vector3 (width, height, bits));
1924 /* Validate method for XBM's. */
1927 xbm_validate (Lisp_Object instantiator)
1929 file_or_data_must_be_present (instantiator);
1932 /* Given a filename that is supposed to contain XBM data, return
1933 the inline representation of it as (width height bits). Return
1934 the hotspot through XHOT and YHOT, if those pointers are not 0.
1935 If there is no hotspot, XHOT and YHOT will contain -1.
1937 If the function fails:
1939 -- if OK_IF_DATA_INVALID is set and the data was invalid,
1941 -- maybe return an error, or return Qnil.
1944 #ifdef HAVE_X_WINDOWS
1945 #include <X11/Xlib.h>
1947 #define XFree(data) free(data)
1951 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
1952 int ok_if_data_invalid)
1957 CONST char *filename_ext;
1959 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
1960 result = read_bitmap_data_from_file (filename_ext, &w, &h,
1963 if (result == BitmapSuccess)
1966 int len = (w + 7) / 8 * h;
1968 retval = list3 (make_int (w), make_int (h),
1969 make_ext_string (data, len, FORMAT_BINARY));
1970 XFree ((char *) data);
1976 case BitmapOpenFailed:
1978 /* should never happen */
1979 signal_double_file_error ("Opening bitmap file",
1980 "no such file or directory",
1983 case BitmapFileInvalid:
1985 if (ok_if_data_invalid)
1987 signal_double_file_error ("Reading bitmap file",
1988 "invalid data in file",
1991 case BitmapNoMemory:
1993 signal_double_file_error ("Reading bitmap file",
1999 signal_double_file_error_2 ("Reading bitmap file",
2000 "unknown error code",
2001 make_int (result), name);
2005 return Qnil; /* not reached */
2009 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2010 Lisp_Object mask_file, Lisp_Object console_type)
2012 /* This is unclean but it's fairly standard -- a number of the
2013 bitmaps in /usr/include/X11/bitmaps use it -- so we support
2015 if (NILP (mask_file)
2016 /* don't override explicitly specified mask data. */
2017 && NILP (assq_no_quit (Q_mask_data, alist))
2020 mask_file = MAYBE_LISP_CONTYPE_METH
2021 (decode_console_type(console_type, ERROR_ME),
2022 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
2023 if (NILP (mask_file))
2024 mask_file = MAYBE_LISP_CONTYPE_METH
2025 (decode_console_type(console_type, ERROR_ME),
2026 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
2029 if (!NILP (mask_file))
2031 Lisp_Object mask_data =
2032 bitmap_to_lisp_data (mask_file, 0, 0, 0);
2033 alist = remassq_no_quit (Q_mask_file, alist);
2034 /* there can't be a :mask-data at this point. */
2035 alist = Fcons (Fcons (Q_mask_file, mask_file),
2036 Fcons (Fcons (Q_mask_data, mask_data), alist));
2042 /* Normalize method for XBM's. */
2045 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
2047 Lisp_Object file = Qnil, mask_file = Qnil;
2048 struct gcpro gcpro1, gcpro2, gcpro3;
2049 Lisp_Object alist = Qnil;
2051 GCPRO3 (file, mask_file, alist);
2053 /* Now, convert any file data into inline data for both the regular
2054 data and the mask data. At the end of this, `data' will contain
2055 the inline data (if any) or Qnil, and `file' will contain
2056 the name this data was derived from (if known) or Qnil.
2057 Likewise for `mask_file' and `mask_data'.
2059 Note that if we cannot generate any regular inline data, we
2062 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2064 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2065 Q_mask_data, console_type);
2067 if (CONSP (file)) /* failure locating filename */
2068 signal_double_file_error ("Opening bitmap file",
2069 "no such file or directory",
2072 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2073 RETURN_UNGCPRO (inst);
2075 alist = tagged_vector_to_alist (inst);
2080 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
2081 alist = remassq_no_quit (Q_file, alist);
2082 /* there can't be a :data at this point. */
2083 alist = Fcons (Fcons (Q_file, file),
2084 Fcons (Fcons (Q_data, data), alist));
2086 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2087 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2089 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2090 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2094 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2097 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2099 RETURN_UNGCPRO (result);
2105 xbm_possible_dest_types (void)
2108 IMAGE_MONO_PIXMAP_MASK |
2109 IMAGE_COLOR_PIXMAP_MASK |
2117 /**********************************************************************
2119 **********************************************************************/
2122 xface_validate (Lisp_Object instantiator)
2124 file_or_data_must_be_present (instantiator);
2128 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2130 /* This function can call lisp */
2131 Lisp_Object file = Qnil, mask_file = Qnil;
2132 struct gcpro gcpro1, gcpro2, gcpro3;
2133 Lisp_Object alist = Qnil;
2135 GCPRO3 (file, mask_file, alist);
2137 /* Now, convert any file data into inline data for both the regular
2138 data and the mask data. At the end of this, `data' will contain
2139 the inline data (if any) or Qnil, and `file' will contain
2140 the name this data was derived from (if known) or Qnil.
2141 Likewise for `mask_file' and `mask_data'.
2143 Note that if we cannot generate any regular inline data, we
2146 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2148 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2149 Q_mask_data, console_type);
2151 if (CONSP (file)) /* failure locating filename */
2152 signal_double_file_error ("Opening bitmap file",
2153 "no such file or directory",
2156 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2157 RETURN_UNGCPRO (inst);
2159 alist = tagged_vector_to_alist (inst);
2162 Lisp_Object data = make_string_from_file (file);
2163 alist = remassq_no_quit (Q_file, alist);
2164 /* there can't be a :data at this point. */
2165 alist = Fcons (Fcons (Q_file, file),
2166 Fcons (Fcons (Q_data, data), alist));
2169 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2172 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2174 RETURN_UNGCPRO (result);
2179 xface_possible_dest_types (void)
2182 IMAGE_MONO_PIXMAP_MASK |
2183 IMAGE_COLOR_PIXMAP_MASK |
2187 #endif /* HAVE_XFACE */
2192 /**********************************************************************
2194 **********************************************************************/
2197 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2203 GET_C_STRING_FILENAME_DATA_ALLOCA (name, fname);
2204 result = XpmReadFileToData (fname, &data);
2206 if (result == XpmSuccess)
2208 Lisp_Object retval = Qnil;
2209 struct buffer *old_buffer = current_buffer;
2210 Lisp_Object temp_buffer =
2211 Fget_buffer_create (build_string (" *pixmap conversion*"));
2213 int height, width, ncolors;
2214 struct gcpro gcpro1, gcpro2, gcpro3;
2215 int speccount = specpdl_depth ();
2217 GCPRO3 (name, retval, temp_buffer);
2219 specbind (Qinhibit_quit, Qt);
2220 set_buffer_internal (XBUFFER (temp_buffer));
2221 Ferase_buffer (Qnil);
2223 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2224 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2226 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2227 for (elt = 0; elt <= width + ncolors; elt++)
2229 buffer_insert_c_string (current_buffer, "\"");
2230 buffer_insert_c_string (current_buffer, data[elt]);
2232 if (elt < width + ncolors)
2233 buffer_insert_c_string (current_buffer, "\",\r");
2235 buffer_insert_c_string (current_buffer, "\"};\r");
2238 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2241 set_buffer_internal (old_buffer);
2242 unbind_to (speccount, Qnil);
2244 RETURN_UNGCPRO (retval);
2249 case XpmFileInvalid:
2251 if (ok_if_data_invalid)
2253 signal_image_error ("invalid XPM data in file", name);
2257 signal_double_file_error ("Reading pixmap file",
2258 "out of memory", name);
2262 /* should never happen? */
2263 signal_double_file_error ("Opening pixmap file",
2264 "no such file or directory", name);
2268 signal_double_file_error_2 ("Parsing pixmap file",
2269 "unknown error code",
2270 make_int (result), name);
2275 return Qnil; /* not reached */
2279 check_valid_xpm_color_symbols (Lisp_Object data)
2283 for (rest = data; !NILP (rest); rest = XCDR (rest))
2285 if (!CONSP (rest) ||
2286 !CONSP (XCAR (rest)) ||
2287 !STRINGP (XCAR (XCAR (rest))) ||
2288 (!STRINGP (XCDR (XCAR (rest))) &&
2289 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2290 signal_simple_error ("Invalid color symbol alist", data);
2295 xpm_validate (Lisp_Object instantiator)
2297 file_or_data_must_be_present (instantiator);
2300 Lisp_Object Vxpm_color_symbols;
2303 evaluate_xpm_color_symbols (void)
2305 Lisp_Object rest, results = Qnil;
2306 struct gcpro gcpro1, gcpro2;
2308 GCPRO2 (rest, results);
2309 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2311 Lisp_Object name, value, cons;
2317 CHECK_STRING (name);
2318 value = XCDR (cons);
2320 value = XCAR (value);
2321 value = Feval (value);
2324 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2326 ("Result from xpm-color-symbols eval must be nil, string, or color",
2328 results = Fcons (Fcons (name, value), results);
2330 UNGCPRO; /* no more evaluation */
2335 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2337 Lisp_Object file = Qnil;
2338 Lisp_Object color_symbols;
2339 struct gcpro gcpro1, gcpro2;
2340 Lisp_Object alist = Qnil;
2342 GCPRO2 (file, alist);
2344 /* Now, convert any file data into inline data. At the end of this,
2345 `data' will contain the inline data (if any) or Qnil, and
2346 `file' will contain the name this data was derived from (if
2349 Note that if we cannot generate any regular inline data, we
2352 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2355 if (CONSP (file)) /* failure locating filename */
2356 signal_double_file_error ("Opening pixmap file",
2357 "no such file or directory",
2360 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2363 if (NILP (file) && !UNBOUNDP (color_symbols))
2364 /* no conversion necessary */
2365 RETURN_UNGCPRO (inst);
2367 alist = tagged_vector_to_alist (inst);
2371 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2372 alist = remassq_no_quit (Q_file, alist);
2373 /* there can't be a :data at this point. */
2374 alist = Fcons (Fcons (Q_file, file),
2375 Fcons (Fcons (Q_data, data), alist));
2378 if (UNBOUNDP (color_symbols))
2380 color_symbols = evaluate_xpm_color_symbols ();
2381 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2386 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2388 RETURN_UNGCPRO (result);
2393 xpm_possible_dest_types (void)
2396 IMAGE_MONO_PIXMAP_MASK |
2397 IMAGE_COLOR_PIXMAP_MASK |
2401 #endif /* HAVE_XPM */
2404 /****************************************************************************
2405 * Image Specifier Object *
2406 ****************************************************************************/
2408 DEFINE_SPECIFIER_TYPE (image);
2411 image_create (Lisp_Object obj)
2413 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2415 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2416 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2417 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2421 image_mark (Lisp_Object obj)
2423 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2425 mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
2426 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2430 image_instantiate_cache_result (Lisp_Object locative)
2432 /* locative = (instance instantiator . subtable) */
2433 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2434 free_cons (XCONS (XCDR (locative)));
2435 free_cons (XCONS (locative));
2439 /* Given a specification for an image, return an instance of
2440 the image which matches the given instantiator and which can be
2441 displayed in the given domain. */
2444 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2445 Lisp_Object domain, Lisp_Object instantiator,
2448 Lisp_Object device = DFW_DEVICE (domain);
2449 struct device *d = XDEVICE (device);
2450 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2451 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2453 if (IMAGE_INSTANCEP (instantiator))
2455 /* make sure that the image instance's device and type are
2458 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2461 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2462 if (mask & dest_mask)
2463 return instantiator;
2465 signal_simple_error ("Type of image instance not allowed here",
2469 signal_simple_error_2 ("Wrong device for image instance",
2470 instantiator, device);
2472 else if (VECTORP (instantiator)
2473 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2475 assert (XVECTOR_LENGTH (instantiator) == 3);
2476 return (FACE_PROPERTY_INSTANCE
2477 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2478 Qbackground_pixmap, domain, 0, depth));
2482 Lisp_Object instance;
2483 Lisp_Object subtable;
2484 Lisp_Object ls3 = Qnil;
2485 Lisp_Object pointer_fg = Qnil;
2486 Lisp_Object pointer_bg = Qnil;
2490 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2491 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2492 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2495 /* First look in the hash table. */
2496 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2498 if (UNBOUNDP (subtable))
2500 /* For the image instance cache, we do comparisons with EQ rather
2501 than with EQUAL, as we do for color and font names.
2504 1) pixmap data can be very long, and thus the hashing and
2505 comparing will take awhile.
2506 2) It's not so likely that we'll run into things that are EQUAL
2507 but not EQ (that can happen a lot with faces, because their
2508 specifiers are copied around); but pixmaps tend not to be
2511 However, if the image-instance could be a pointer, we have to
2512 use EQUAL because we massaged the instantiator into a cons3
2513 also containing the foreground and background of the
2517 subtable = make_lisp_hash_table (20,
2518 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2519 : HASH_TABLE_KEY_WEAK,
2520 pointerp ? HASH_TABLE_EQUAL
2522 Fputhash (make_int (dest_mask), subtable,
2523 d->image_instance_cache);
2524 instance = Qunbound;
2528 instance = Fgethash (pointerp ? ls3 : instantiator,
2529 subtable, Qunbound);
2530 /* subwindows have a per-window cache and have to be treated
2531 differently. dest_mask can be a bitwise OR of all image
2532 types so we will only catch someone possibly trying to
2533 instantiate a subwindow type thing. Unfortunately, this
2534 will occur most of the time so this probably slows things
2535 down. But with the current design I don't see anyway
2537 if (UNBOUNDP (instance)
2539 dest_mask & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2541 if (!WINDOWP (domain))
2542 signal_simple_error ("Can't instantiate subwindow outside a window",
2544 instance = Fgethash (instantiator,
2545 XWINDOW (domain)->subwindow_instance_cache,
2550 if (UNBOUNDP (instance))
2552 Lisp_Object locative =
2554 noseeum_cons (pointerp ? ls3 : instantiator,
2556 int speccount = specpdl_depth ();
2558 /* make sure we cache the failures, too.
2559 Use an unwind-protect to catch such errors.
2560 If we fail, the unwind-protect records nil in
2561 the hash table. If we succeed, we change the
2562 car of the locative to the resulting instance,
2563 which gets recorded instead. */
2564 record_unwind_protect (image_instantiate_cache_result,
2566 instance = instantiate_image_instantiator (device,
2569 pointer_fg, pointer_bg,
2572 Fsetcar (locative, instance);
2573 /* only after the image has been instantiated do we know
2574 whether we need to put it in the per-window image instance
2576 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2578 (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2580 if (!WINDOWP (domain))
2581 signal_simple_error ("Can't instantiate subwindow outside a window",
2584 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache );
2586 unbind_to (speccount, Qnil);
2591 if (NILP (instance))
2592 signal_simple_error ("Can't instantiate image (probably cached)",
2598 return Qnil; /* not reached */
2601 /* Validate an image instantiator. */
2604 image_validate (Lisp_Object instantiator)
2606 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2608 else if (VECTORP (instantiator))
2610 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2611 int instantiator_len = XVECTOR_LENGTH (instantiator);
2612 struct image_instantiator_methods *meths;
2613 Lisp_Object already_seen = Qnil;
2614 struct gcpro gcpro1;
2617 if (instantiator_len < 1)
2618 signal_simple_error ("Vector length must be at least 1",
2621 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2622 if (!(instantiator_len & 1))
2624 ("Must have alternating keyword/value pairs", instantiator);
2626 GCPRO1 (already_seen);
2628 for (i = 1; i < instantiator_len; i += 2)
2630 Lisp_Object keyword = elt[i];
2631 Lisp_Object value = elt[i+1];
2634 CHECK_SYMBOL (keyword);
2635 if (!SYMBOL_IS_KEYWORD (keyword))
2636 signal_simple_error ("Symbol must begin with a colon", keyword);
2638 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2639 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2642 if (j == Dynarr_length (meths->keywords))
2643 signal_simple_error ("Unrecognized keyword", keyword);
2645 if (!Dynarr_at (meths->keywords, j).multiple_p)
2647 if (!NILP (memq_no_quit (keyword, already_seen)))
2649 ("Keyword may not appear more than once", keyword);
2650 already_seen = Fcons (keyword, already_seen);
2653 (Dynarr_at (meths->keywords, j).validate) (value);
2658 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2661 signal_simple_error ("Must be string or vector", instantiator);
2665 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2667 Lisp_Object attachee =
2668 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2669 Lisp_Object property =
2670 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2671 if (FACEP (attachee))
2672 face_property_was_changed (attachee, property, locale);
2673 else if (GLYPHP (attachee))
2674 glyph_property_was_changed (attachee, property, locale);
2678 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2679 Lisp_Object property)
2681 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2683 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2684 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2688 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2689 Lisp_Object tag_set, Lisp_Object instantiator)
2691 Lisp_Object possible_console_types = Qnil;
2693 Lisp_Object retlist = Qnil;
2694 struct gcpro gcpro1, gcpro2;
2696 LIST_LOOP (rest, Vconsole_type_list)
2698 Lisp_Object contype = XCAR (rest);
2699 if (!NILP (memq_no_quit (contype, tag_set)))
2700 possible_console_types = Fcons (contype, possible_console_types);
2703 if (XINT (Flength (possible_console_types)) > 1)
2704 /* two conflicting console types specified */
2707 if (NILP (possible_console_types))
2708 possible_console_types = Vconsole_type_list;
2710 GCPRO2 (retlist, possible_console_types);
2712 LIST_LOOP (rest, possible_console_types)
2714 Lisp_Object contype = XCAR (rest);
2715 Lisp_Object newinst = call_with_suspended_errors
2716 ((lisp_fn_t) normalize_image_instantiator,
2717 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2718 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2720 if (!NILP (newinst))
2723 if (NILP (memq_no_quit (contype, tag_set)))
2724 newtag = Fcons (contype, tag_set);
2727 retlist = Fcons (Fcons (newtag, newinst), retlist);
2736 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
2737 Return non-nil if OBJECT is an image specifier.
2739 An image specifier is used for images (pixmaps and the like). It is used
2740 to describe the actual image in a glyph. It is instanced as an image-
2743 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
2744 etc. This describes the format of the data describing the image. The
2745 resulting image instances also come in many types -- `mono-pixmap',
2746 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
2747 the image and the sorts of places it can appear. (For example, a
2748 color-pixmap image has fixed colors specified for it, while a
2749 mono-pixmap image comes in two unspecified shades "foreground" and
2750 "background" that are determined from the face of the glyph or
2751 surrounding text; a text image appears as a string of text and has an
2752 unspecified foreground, background, and font; a pointer image behaves
2753 like a mono-pixmap image but can only be used as a mouse pointer
2754 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
2755 important to keep the distinction between image instantiator format and
2756 image instance type in mind. Typically, a given image instantiator
2757 format can result in many different image instance types (for example,
2758 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
2759 whereas `cursor-font' can be instanced only as `pointer'), and a
2760 particular image instance type can be generated by many different
2761 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
2762 `gif', `jpeg', etc.).
2764 See `make-image-instance' for a more detailed discussion of image
2767 An image instantiator should be a string or a vector of the form
2769 [FORMAT :KEYWORD VALUE ...]
2771 i.e. a format symbol followed by zero or more alternating keyword-value
2772 pairs. FORMAT should be one of
2775 (Don't display anything; no keywords are valid for this.
2776 Can only be instanced as `nothing'.)
2778 (Display this image as a text string. Can only be instanced
2779 as `text', although support for instancing as `mono-pixmap'
2782 (Display this image as a text string, with replaceable fields;
2783 not currently implemented.)
2785 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
2786 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2788 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
2789 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
2791 (An X-Face bitmap, used to encode people's faces in e-mail messages;
2792 only if X-Face support was compiled into this XEmacs. Can be
2793 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2795 (A GIF87 or GIF89 image; only if GIF support was compiled into this
2796 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
2797 Can be instanced as `color-pixmap'.)
2799 (A JPEG image; only if JPEG support was compiled into this XEmacs.
2800 Can be instanced as `color-pixmap'.)
2802 (A PNG image; only if PNG support was compiled into this XEmacs.
2803 Can be instanced as `color-pixmap'.)
2805 (A TIFF image; only if TIFF support was compiled into this XEmacs.
2806 Can be instanced as `color-pixmap'.)
2808 (One of the standard cursor-font names, such as "watch" or
2809 "right_ptr" under X. Under X, this is, more specifically, any
2810 of the standard cursor names from appendix B of the Xlib manual
2811 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
2812 On other window systems, the valid names will be specific to the
2813 type of window system. Can only be instanced as `pointer'.)
2815 (A glyph from a font; i.e. the name of a font, and glyph index into it
2816 of the form "FONT fontname index [[mask-font] mask-index]".
2817 Currently can only be instanced as `pointer', although this should
2820 (An embedded windowing system window.)
2822 (A text editing widget glyph.)
2824 (A button widget glyph; either a push button, radio button or toggle button.)
2826 (A tab widget glyph; a series of user selectable tabs.)
2828 (A sliding widget glyph, for showing progress.)
2830 (A drop list of selectable items in a widget glyph, for editing text.)
2832 (A static, text-only, widget glyph; for displaying text.)
2834 (A folding widget glyph.)
2836 (XEmacs tries to guess what format the data is in. If X support
2837 exists, the data string will be checked to see if it names a filename.
2838 If so, and this filename contains XBM or XPM data, the appropriate
2839 sort of pixmap or pointer will be created. [This includes picking up
2840 any specified hotspot or associated mask file.] Otherwise, if `pointer'
2841 is one of the allowable image-instance types and the string names a
2842 valid cursor-font name, the image will be created as a pointer.
2843 Otherwise, the image will be displayed as text. If no X support
2844 exists, the image will always be displayed as text.)
2846 Inherit from the background-pixmap property of a face.
2848 The valid keywords are:
2851 (Inline data. For most formats above, this should be a string. For
2852 XBM images, this should be a list of three elements: width, height, and
2853 a string of bit data. This keyword is not valid for instantiator
2854 formats `nothing' and `inherit'.)
2856 (Data is contained in a file. The value is the name of this file.
2857 If both :data and :file are specified, the image is created from
2858 what is specified in :data and the string in :file becomes the
2859 value of the `image-instance-file-name' function when applied to
2860 the resulting image-instance. This keyword is not valid for
2861 instantiator formats `nothing', `string', `formatted-string',
2862 `cursor-font', `font', `autodetect', and `inherit'.)
2865 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
2866 allow you to explicitly specify foreground and background colors.
2867 The argument should be anything acceptable to `make-color-instance'.
2868 This will cause what would be a `mono-pixmap' to instead be colorized
2869 as a two-color color-pixmap, and specifies the foreground and/or
2870 background colors for a pointer instead of black and white.)
2872 (For `xbm' and `xface'. This specifies a mask to be used with the
2873 bitmap. The format is a list of width, height, and bits, like for
2876 (For `xbm' and `xface'. This specifies a file containing the mask data.
2877 If neither a mask file nor inline mask data is given for an XBM image,
2878 and the XBM image comes from a file, XEmacs will look for a mask file
2879 with the same name as the image file but with "Mask" or "msk"
2880 appended. For example, if you specify the XBM file "left_ptr"
2881 [usually located in "/usr/include/X11/bitmaps"], the associated
2882 mask file "left_ptrmsk" will automatically be picked up.)
2885 (For `xbm' and `xface'. These keywords specify a hotspot if the image
2886 is instantiated as a `pointer'. Note that if the XBM image file
2887 specifies a hotspot, it will automatically be picked up if no
2888 explicit hotspot is given.)
2890 (Only for `xpm'. This specifies an alist that maps strings
2891 that specify symbolic color names to the actual color to be used
2892 for that symbolic color (in the form of a string or a color-specifier
2893 object). If this is not specified, the contents of `xpm-color-symbols'
2894 are used to generate the alist.)
2896 (Only for `inherit'. This specifies the face to inherit from.
2897 For widget glyphs this also specifies the face to use for
2898 display. It defaults to gui-element-face.)
2900 Keywords accepted as menu item specs are also accepted by widget
2901 glyphs. These are `:selected', `:active', `:suffix', `:keys',
2902 `:style', `:filter', `:config', `:included', `:key-sequence',
2903 `:accelerator', `:label' and `:callback'.
2905 If instead of a vector, the instantiator is a string, it will be
2906 converted into a vector by looking it up according to the specs in the
2907 `console-type-image-conversion-list' (q.v.) for the console type of
2908 the domain (usually a window; sometimes a frame or device) over which
2909 the image is being instantiated.
2911 If the instantiator specifies data from a file, the data will be read
2912 in at the time that the instantiator is added to the image (which may
2913 be well before when the image is actually displayed), and the
2914 instantiator will be converted into one of the inline-data forms, with
2915 the filename retained using a :file keyword. This implies that the
2916 file must exist when the instantiator is added to the image, but does
2917 not need to exist at any other time (e.g. it may safely be a temporary
2922 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
2926 /****************************************************************************
2928 ****************************************************************************/
2931 mark_glyph (Lisp_Object obj)
2933 struct Lisp_Glyph *glyph = XGLYPH (obj);
2935 mark_object (glyph->image);
2936 mark_object (glyph->contrib_p);
2937 mark_object (glyph->baseline);
2938 mark_object (glyph->face);
2940 return glyph->plist;
2944 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2946 struct Lisp_Glyph *glyph = XGLYPH (obj);
2950 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
2952 write_c_string ("#<glyph (", printcharfun);
2953 print_internal (Fglyph_type (obj), printcharfun, 0);
2954 write_c_string (") ", printcharfun);
2955 print_internal (glyph->image, printcharfun, 1);
2956 sprintf (buf, "0x%x>", glyph->header.uid);
2957 write_c_string (buf, printcharfun);
2960 /* Glyphs are equal if all of their display attributes are equal. We
2961 don't compare names or doc-strings, because that would make equal
2964 This isn't concerned with "unspecified" attributes, that's what
2965 #'glyph-differs-from-default-p is for. */
2967 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
2969 struct Lisp_Glyph *g1 = XGLYPH (obj1);
2970 struct Lisp_Glyph *g2 = XGLYPH (obj2);
2974 return (internal_equal (g1->image, g2->image, depth) &&
2975 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
2976 internal_equal (g1->baseline, g2->baseline, depth) &&
2977 internal_equal (g1->face, g2->face, depth) &&
2978 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
2981 static unsigned long
2982 glyph_hash (Lisp_Object obj, int depth)
2986 /* No need to hash all of the elements; that would take too long.
2987 Just hash the most common ones. */
2988 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
2989 internal_hash (XGLYPH (obj)->face, depth));
2993 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
2995 struct Lisp_Glyph *g = XGLYPH (obj);
2997 if (EQ (prop, Qimage)) return g->image;
2998 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
2999 if (EQ (prop, Qbaseline)) return g->baseline;
3000 if (EQ (prop, Qface)) return g->face;
3002 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
3006 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3008 if (EQ (prop, Qimage) ||
3009 EQ (prop, Qcontrib_p) ||
3010 EQ (prop, Qbaseline))
3013 if (EQ (prop, Qface))
3015 XGLYPH (obj)->face = Fget_face (value);
3019 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
3024 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
3026 if (EQ (prop, Qimage) ||
3027 EQ (prop, Qcontrib_p) ||
3028 EQ (prop, Qbaseline))
3031 if (EQ (prop, Qface))
3033 XGLYPH (obj)->face = Qnil;
3037 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
3041 glyph_plist (Lisp_Object obj)
3043 struct Lisp_Glyph *glyph = XGLYPH (obj);
3044 Lisp_Object result = glyph->plist;
3046 result = cons3 (Qface, glyph->face, result);
3047 result = cons3 (Qbaseline, glyph->baseline, result);
3048 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
3049 result = cons3 (Qimage, glyph->image, result);
3054 static const struct lrecord_description glyph_description[] = {
3055 { XD_LISP_OBJECT, offsetof(struct Lisp_Glyph, image), 5 },
3059 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
3060 mark_glyph, print_glyph, 0,
3061 glyph_equal, glyph_hash, glyph_description,
3062 glyph_getprop, glyph_putprop,
3063 glyph_remprop, glyph_plist,
3067 allocate_glyph (enum glyph_type type,
3068 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
3069 Lisp_Object locale))
3071 /* This function can GC */
3072 Lisp_Object obj = Qnil;
3073 struct Lisp_Glyph *g =
3074 alloc_lcrecord_type (struct Lisp_Glyph, &lrecord_glyph);
3077 g->image = Fmake_specifier (Qimage); /* This function can GC */
3082 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3083 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
3084 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
3085 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK
3086 | IMAGE_LAYOUT_MASK;
3089 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3090 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
3093 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3094 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK;
3100 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
3101 /* We're getting enough reports of odd behavior in this area it seems */
3102 /* best to GCPRO everything. */
3104 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3105 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3106 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3107 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3109 GCPRO4 (obj, tem1, tem2, tem3);
3111 set_specifier_fallback (g->image, tem1);
3112 g->contrib_p = Fmake_specifier (Qboolean);
3113 set_specifier_fallback (g->contrib_p, tem2);
3114 /* #### should have a specifier for the following */
3115 g->baseline = Fmake_specifier (Qgeneric);
3116 set_specifier_fallback (g->baseline, tem3);
3119 g->after_change = after_change;
3122 set_image_attached_to (g->image, obj, Qimage);
3129 static enum glyph_type
3130 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3133 return GLYPH_BUFFER;
3135 if (ERRB_EQ (errb, ERROR_ME))
3136 CHECK_SYMBOL (type);
3138 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3139 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3140 if (EQ (type, Qicon)) return GLYPH_ICON;
3142 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3144 return GLYPH_UNKNOWN;
3148 valid_glyph_type_p (Lisp_Object type)
3150 return !NILP (memq_no_quit (type, Vglyph_type_list));
3153 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3154 Given a GLYPH-TYPE, return non-nil if it is valid.
3155 Valid types are `buffer', `pointer', and `icon'.
3159 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3162 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3163 Return a list of valid glyph types.
3167 return Fcopy_sequence (Vglyph_type_list);
3170 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3171 Create and return a new uninitialized glyph or type TYPE.
3173 TYPE specifies the type of the glyph; this should be one of `buffer',
3174 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3175 specifies in which contexts the glyph can be used, and controls the
3176 allowable image types into which the glyph's image can be
3179 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3180 extent, in the modeline, and in the toolbar. Their image can be
3181 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3184 `pointer' glyphs can be used to specify the mouse pointer. Their
3185 image can be instantiated as `pointer'.
3187 `icon' glyphs can be used to specify the icon used when a frame is
3188 iconified. Their image can be instantiated as `mono-pixmap' and
3193 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3194 return allocate_glyph (typeval, 0);
3197 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3198 Return non-nil if OBJECT is a glyph.
3200 A glyph is an object used for pixmaps and the like. It is used
3201 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3202 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3203 buttons, and the like. Its image is described using an image specifier --
3204 see `image-specifier-p'.
3208 return GLYPHP (object) ? Qt : Qnil;
3211 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3212 Return the type of the given glyph.
3213 The return value will be one of 'buffer, 'pointer, or 'icon.
3217 CHECK_GLYPH (glyph);
3218 switch (XGLYPH_TYPE (glyph))
3221 case GLYPH_BUFFER: return Qbuffer;
3222 case GLYPH_POINTER: return Qpointer;
3223 case GLYPH_ICON: return Qicon;
3227 /*****************************************************************************
3230 Return the width of the given GLYPH on the given WINDOW. If the
3231 instance is a string then the width is calculated using the font of
3232 the given FACE, unless a face is defined by the glyph itself.
3233 ****************************************************************************/
3235 glyph_width (Lisp_Object glyph_or_image, Lisp_Object frame_face,
3236 face_index window_findex, Lisp_Object window)
3238 Lisp_Object instance = glyph_or_image;
3239 Lisp_Object frame = XWINDOW (window)->frame;
3241 /* #### We somehow need to distinguish between the user causing this
3242 error condition and a bug causing it. */
3243 if (GLYPHP (glyph_or_image))
3244 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3246 if (!IMAGE_INSTANCEP (instance))
3249 switch (XIMAGE_INSTANCE_TYPE (instance))
3253 Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance);
3254 Lisp_Object private_face = Qnil;
3256 if (GLYPHP (glyph_or_image))
3257 private_face = XGLYPH_FACE(glyph_or_image);
3259 if (!NILP (private_face))
3260 return redisplay_frame_text_width_string (XFRAME (frame),
3264 if (!NILP (frame_face))
3265 return redisplay_frame_text_width_string (XFRAME (frame),
3269 return redisplay_text_width_string (XWINDOW (window),
3274 case IMAGE_MONO_PIXMAP:
3275 case IMAGE_COLOR_PIXMAP:
3277 return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance);
3282 case IMAGE_SUBWINDOW:
3285 return XIMAGE_INSTANCE_SUBWINDOW_WIDTH (instance);
3293 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3294 Return the width of GLYPH on WINDOW.
3295 This may not be exact as it does not take into account all of the context
3296 that redisplay will.
3300 XSETWINDOW (window, decode_window (window));
3301 CHECK_GLYPH (glyph);
3303 return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window));
3306 #define RETURN_ASCENT 0
3307 #define RETURN_DESCENT 1
3308 #define RETURN_HEIGHT 2
3311 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3312 Error_behavior errb, int no_quit)
3314 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3316 /* This can never return Qunbound. All glyphs have 'nothing as
3318 return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0,
3322 static unsigned short
3323 glyph_height_internal (Lisp_Object glyph_or_image, Lisp_Object frame_face,
3324 face_index window_findex, Lisp_Object window,
3327 Lisp_Object instance = glyph_or_image;
3328 Lisp_Object frame = XWINDOW (window)->frame;
3330 if (GLYPHP (glyph_or_image))
3331 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3333 if (!IMAGE_INSTANCEP (instance))
3336 switch (XIMAGE_INSTANCE_TYPE (instance))
3340 struct font_metric_info fm;
3341 Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance);
3342 Charset_ID charsets[NUM_LEADING_BYTES];
3343 struct face_cachel frame_cachel;
3344 struct face_cachel *cachel;
3346 find_charsets_in_bufbyte_string (charsets,
3347 XSTRING_DATA (string),
3348 XSTRING_LENGTH (string));
3350 if (!NILP (frame_face))
3352 reset_face_cachel (&frame_cachel);
3353 update_face_cachel_data (&frame_cachel, frame, frame_face);
3354 cachel = &frame_cachel;
3357 cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex);
3358 ensure_face_cachel_complete (cachel, window, charsets);
3360 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
3364 case RETURN_ASCENT: return fm.ascent;
3365 case RETURN_DESCENT: return fm.descent;
3366 case RETURN_HEIGHT: return fm.ascent + fm.descent;
3369 return 0; /* not reached */
3373 case IMAGE_MONO_PIXMAP:
3374 case IMAGE_COLOR_PIXMAP:
3376 /* #### Ugh ugh ugh -- temporary crap */
3377 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3378 return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance);
3385 case IMAGE_SUBWINDOW:
3388 /* #### Ugh ugh ugh -- temporary crap */
3389 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3390 return XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (instance);
3401 glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face,
3402 face_index window_findex, Lisp_Object window)
3404 return glyph_height_internal (glyph, frame_face, window_findex, window,
3409 glyph_descent (Lisp_Object glyph, Lisp_Object frame_face,
3410 face_index window_findex, Lisp_Object window)
3412 return glyph_height_internal (glyph, frame_face, window_findex, window,
3416 /* strictly a convenience function. */
3418 glyph_height (Lisp_Object glyph, Lisp_Object frame_face,
3419 face_index window_findex, Lisp_Object window)
3421 return glyph_height_internal (glyph, frame_face, window_findex, window,
3425 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3426 Return the ascent value of GLYPH on WINDOW.
3427 This may not be exact as it does not take into account all of the context
3428 that redisplay will.
3432 XSETWINDOW (window, decode_window (window));
3433 CHECK_GLYPH (glyph);
3435 return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window));
3438 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3439 Return the descent value of GLYPH on WINDOW.
3440 This may not be exact as it does not take into account all of the context
3441 that redisplay will.
3445 XSETWINDOW (window, decode_window (window));
3446 CHECK_GLYPH (glyph);
3448 return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window));
3451 /* This is redundant but I bet a lot of people expect it to exist. */
3452 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3453 Return the height of GLYPH on WINDOW.
3454 This may not be exact as it does not take into account all of the context
3455 that redisplay will.
3459 XSETWINDOW (window, decode_window (window));
3460 CHECK_GLYPH (glyph);
3462 return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window));
3465 #undef RETURN_ASCENT
3466 #undef RETURN_DESCENT
3467 #undef RETURN_HEIGHT
3470 glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window)
3472 Lisp_Object instance = glyph_or_image;
3474 if (GLYPHP (glyph_or_image))
3475 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3477 return XIMAGE_INSTANCE_DIRTYP (instance);
3481 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty)
3483 Lisp_Object instance = glyph_or_image;
3485 if (!NILP (glyph_or_image))
3487 if (GLYPHP (glyph_or_image))
3489 instance = glyph_image_instance (glyph_or_image, window,
3491 XGLYPH_DIRTYP (glyph_or_image) = dirty;
3494 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
3498 /* #### do we need to cache this info to speed things up? */
3501 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3503 if (!GLYPHP (glyph))
3507 Lisp_Object retval =
3508 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3509 /* #### look into ERROR_ME_NOT */
3510 Qunbound, domain, ERROR_ME_NOT,
3512 if (!NILP (retval) && !INTP (retval))
3514 else if (INTP (retval))
3516 if (XINT (retval) < 0)
3518 if (XINT (retval) > 100)
3519 retval = make_int (100);
3526 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3528 /* #### Domain parameter not currently used but it will be */
3529 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3533 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3535 if (!GLYPHP (glyph))
3538 return !NILP (specifier_instance_no_quit
3539 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3540 /* #### look into ERROR_ME_NOT */
3541 ERROR_ME_NOT, 0, Qzero));
3545 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3548 if (XGLYPH (glyph)->after_change)
3549 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3553 /*****************************************************************************
3554 * glyph cachel functions *
3555 *****************************************************************************/
3558 #### All of this is 95% copied from face cachels.
3559 Consider consolidating.
3563 mark_glyph_cachels (glyph_cachel_dynarr *elements)
3570 for (elt = 0; elt < Dynarr_length (elements); elt++)
3572 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3573 mark_object (cachel->glyph);
3578 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3579 struct glyph_cachel *cachel)
3581 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)
3582 || XGLYPH_DIRTYP (cachel->glyph))
3584 Lisp_Object window, instance;
3586 XSETWINDOW (window, w);
3588 cachel->glyph = glyph;
3589 /* Speed things up slightly by grabbing the glyph instantiation
3590 and passing it to the size functions. */
3591 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3592 cachel->dirty = XGLYPH_DIRTYP (glyph) = glyph_dirty_p (glyph, window);
3593 cachel->width = glyph_width (instance, Qnil, DEFAULT_INDEX, window);
3594 cachel->ascent = glyph_ascent (instance, Qnil, DEFAULT_INDEX, window);
3595 cachel->descent = glyph_descent (instance, Qnil, DEFAULT_INDEX, window);
3598 cachel->updated = 1;
3602 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3604 struct glyph_cachel new_cachel;
3607 new_cachel.glyph = Qnil;
3609 update_glyph_cachel_data (w, glyph, &new_cachel);
3610 Dynarr_add (w->glyph_cachels, new_cachel);
3614 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3621 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3623 struct glyph_cachel *cachel =
3624 Dynarr_atp (w->glyph_cachels, elt);
3626 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3628 update_glyph_cachel_data (w, glyph, cachel);
3633 /* If we didn't find the glyph, add it and then return its index. */
3634 add_glyph_cachel (w, glyph);
3639 reset_glyph_cachels (struct window *w)
3641 Dynarr_reset (w->glyph_cachels);
3642 get_glyph_cachel_index (w, Vcontinuation_glyph);
3643 get_glyph_cachel_index (w, Vtruncation_glyph);
3644 get_glyph_cachel_index (w, Vhscroll_glyph);
3645 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3646 get_glyph_cachel_index (w, Voctal_escape_glyph);
3647 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3651 mark_glyph_cachels_as_not_updated (struct window *w)
3655 /* We need to have a dirty flag to tell if the glyph has changed.
3656 We can check to see if each glyph variable is actually a
3657 completely different glyph, though. */
3658 #define FROB(glyph_obj, gindex) \
3659 update_glyph_cachel_data (w, glyph_obj, \
3660 Dynarr_atp (w->glyph_cachels, gindex))
3662 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3663 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3664 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3665 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3666 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3667 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3670 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3672 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3676 /* Unset the dirty bit on all the glyph cachels that have it. */
3678 mark_glyph_cachels_as_clean (struct window* w)
3682 XSETWINDOW (window, w);
3683 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3685 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt);
3687 set_glyph_dirty_p (cachel->glyph, window, 0);
3691 #ifdef MEMORY_USAGE_STATS
3694 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3695 struct overhead_stats *ovstats)
3700 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3705 #endif /* MEMORY_USAGE_STATS */
3709 /*****************************************************************************
3710 * subwindow cachel functions *
3711 *****************************************************************************/
3712 /* subwindows are curious in that you have to physically unmap them to
3713 not display them. It is problematic deciding what to do in
3714 redisplay. We have two caches - a per-window instance cache that
3715 keeps track of subwindows on a window, these are linked to their
3716 instantiator in the hashtable and when the instantiator goes away
3717 we want the instance to go away also. However we also have a
3718 per-frame instance cache that we use to determine if a subwindow is
3719 obscuring an area that we want to clear. We need to be able to flip
3720 through this quickly so a hashtable is not suitable hence the
3721 subwindow_cachels. The question is should we just not mark
3722 instances in the subwindow_cachels or should we try and invalidate
3723 the cache at suitable points in redisplay? If we don't invalidate
3724 the cache it will fill up with crud that will only get removed when
3725 the frame is deleted. So invalidation is good, the question is when
3726 and whether we mark as well. Go for the simple option - don't mark,
3727 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
3730 mark_subwindow_cachels (subwindow_cachel_dynarr *elements)
3737 for (elt = 0; elt < Dynarr_length (elements); elt++)
3739 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
3740 mark_object (cachel->subwindow);
3745 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
3746 struct subwindow_cachel *cachel)
3748 cachel->subwindow = subwindow;
3749 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3750 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3751 cachel->updated = 1;
3755 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
3757 struct subwindow_cachel new_cachel;
3760 new_cachel.subwindow = Qnil;
3763 new_cachel.being_displayed=0;
3765 update_subwindow_cachel_data (f, subwindow, &new_cachel);
3766 Dynarr_add (f->subwindow_cachels, new_cachel);
3770 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
3777 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3779 struct subwindow_cachel *cachel =
3780 Dynarr_atp (f->subwindow_cachels, elt);
3782 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
3784 if (!cachel->updated)
3785 update_subwindow_cachel_data (f, subwindow, cachel);
3790 /* If we didn't find the glyph, add it and then return its index. */
3791 add_subwindow_cachel (f, subwindow);
3796 update_subwindow_cachel (Lisp_Object subwindow)
3801 if (NILP (subwindow))
3804 f = XFRAME ( XIMAGE_INSTANCE_SUBWINDOW_FRAME (subwindow));
3806 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3808 struct subwindow_cachel *cachel =
3809 Dynarr_atp (f->subwindow_cachels, elt);
3811 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
3813 update_subwindow_cachel_data (f, subwindow, cachel);
3818 /* redisplay in general assumes that drawing something will erase
3819 what was there before. unfortunately this does not apply to
3820 subwindows that need to be specifically unmapped in order to
3821 disappear. we take a brute force approach - on the basis that its
3822 cheap - and unmap all subwindows in a display line */
3824 reset_subwindow_cachels (struct frame *f)
3827 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3829 struct subwindow_cachel *cachel =
3830 Dynarr_atp (f->subwindow_cachels, elt);
3832 if (!NILP (cachel->subwindow) && cachel->being_displayed)
3834 cachel->updated = 1;
3835 /* #### This is not optimal as update_subwindow will search
3836 the cachels for ourselves as well. We could easily optimize. */
3837 unmap_subwindow (cachel->subwindow);
3840 Dynarr_reset (f->subwindow_cachels);
3844 mark_subwindow_cachels_as_not_updated (struct frame *f)
3848 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3849 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
3854 /*****************************************************************************
3855 * subwindow exposure ignorance *
3856 *****************************************************************************/
3857 /* when we unmap subwindows the associated window system will generate
3858 expose events. This we do not want as redisplay already copes with
3859 the repainting necessary. Worse, we can get in an endless cycle of
3860 redisplay if we are not careful. Thus we keep a per-frame list of
3861 expose events that are going to come and ignore them as
3864 struct expose_ignore_blocktype
3866 Blocktype_declare (struct expose_ignore);
3867 } *the_expose_ignore_blocktype;
3870 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
3872 struct expose_ignore *ei, *prev;
3873 /* the ignore list is FIFO so we should generally get a match with
3874 the first element in the list */
3875 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next)
3877 /* Checking for exact matches just isn't good enough as we
3878 mighte get exposures for partially obscure subwindows, thus
3879 we have to check for overlaps. Being conservative we will
3880 check for exposures wholly contained by the subwindow, this
3881 might give us what we want.*/
3882 if (ei->x <= x && ei->y <= y
3883 && ei->x + ei->width >= x + width
3884 && ei->y + ei->height >= y + height)
3886 #ifdef DEBUG_WIDGETS
3887 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n",
3888 x, y, width, height, ei->x, ei->y, ei->width, ei->height);
3891 f->subwindow_exposures = ei->next;
3893 prev->next = ei->next;
3895 if (ei == f->subwindow_exposures_tail)
3896 f->subwindow_exposures_tail = prev;
3898 Blocktype_free (the_expose_ignore_blocktype, ei);
3907 register_ignored_expose (struct frame* f, int x, int y, int width, int height)
3909 if (!hold_ignored_expose_registration)
3911 struct expose_ignore *ei;
3913 ei = Blocktype_alloc (the_expose_ignore_blocktype);
3919 ei->height = height;
3921 /* we have to add the exposure to the end of the list, since we
3922 want to check the oldest events first. for speed we keep a record
3923 of the end so that we can add right to it. */
3924 if (f->subwindow_exposures_tail)
3926 f->subwindow_exposures_tail->next = ei;
3928 if (!f->subwindow_exposures)
3930 f->subwindow_exposures = ei;
3932 f->subwindow_exposures_tail = ei;
3936 /****************************************************************************
3937 find_matching_subwindow
3939 See if there is a subwindow that completely encloses the requested
3941 ****************************************************************************/
3942 int find_matching_subwindow (struct frame* f, int x, int y, int width, int height)
3946 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3948 struct subwindow_cachel *cachel =
3949 Dynarr_atp (f->subwindow_cachels, elt);
3951 if (cachel->being_displayed
3953 cachel->x <= x && cachel->y <= y
3955 cachel->x + cachel->width >= x + width
3957 cachel->y + cachel->height >= y + height)
3966 /*****************************************************************************
3967 * subwindow functions *
3968 *****************************************************************************/
3970 /* update the displayed characteristics of a subwindow */
3972 update_subwindow (Lisp_Object subwindow)
3974 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3976 if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3978 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3981 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
3985 update_frame_subwindows (struct frame *f)
3989 if (f->subwindows_changed || f->subwindows_state_changed || f->faces_changed)
3990 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3992 struct subwindow_cachel *cachel =
3993 Dynarr_atp (f->subwindow_cachels, elt);
3995 if (cachel->being_displayed)
3997 update_subwindow (cachel->subwindow);
4002 /* remove a subwindow from its frame */
4003 void unmap_subwindow (Lisp_Object subwindow)
4005 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4007 struct subwindow_cachel* cachel;
4010 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4012 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4014 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4016 #ifdef DEBUG_WIDGETS
4017 stderr_out ("unmapping subwindow %d\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
4019 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4020 elt = get_subwindow_cachel_index (f, subwindow);
4021 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4023 /* make sure we don't get expose events */
4024 register_ignored_expose (f, cachel->x, cachel->y, cachel->width, cachel->height);
4027 cachel->being_displayed = 0;
4028 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4030 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
4033 /* show a subwindow in its frame */
4034 void map_subwindow (Lisp_Object subwindow, int x, int y,
4035 struct display_glyph_area *dga)
4037 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4039 struct subwindow_cachel* cachel;
4042 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4044 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4046 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4049 #ifdef DEBUG_WIDGETS
4050 stderr_out ("mapping subwindow %d, %dx%d@%d+%d\n",
4051 IMAGE_INSTANCE_SUBWINDOW_ID (ii),
4052 dga->width, dga->height, x, y);
4054 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4055 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
4056 elt = get_subwindow_cachel_index (f, subwindow);
4057 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4060 cachel->width = dga->width;
4061 cachel->height = dga->height;
4062 cachel->being_displayed = 1;
4064 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y, dga));
4068 subwindow_possible_dest_types (void)
4070 return IMAGE_SUBWINDOW_MASK;
4073 /* Partially instantiate a subwindow. */
4075 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
4076 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
4077 int dest_mask, Lisp_Object domain)
4079 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
4080 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
4081 Lisp_Object frame = FW_FRAME (domain);
4082 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
4083 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
4086 signal_simple_error ("No selected frame", device);
4088 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
4089 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
4092 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
4093 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4094 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
4096 /* this stuff may get overidden by the widget code */
4098 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
4103 if (XINT (width) > 1)
4105 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
4108 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
4113 if (XINT (height) > 1)
4115 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
4119 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
4120 Return non-nil if OBJECT is a subwindow.
4124 CHECK_IMAGE_INSTANCE (object);
4125 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
4128 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
4129 Return the window id of SUBWINDOW as a number.
4133 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4134 return make_int ((int) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow));
4137 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
4138 Resize SUBWINDOW to WIDTH x HEIGHT.
4139 If a value is nil that parameter is not changed.
4141 (subwindow, width, height))
4145 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4148 neww = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
4150 neww = XINT (width);
4153 newh = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
4155 newh = XINT (height);
4158 MAYBE_DEVMETH (XDEVICE (XIMAGE_INSTANCE_DEVICE (subwindow)),
4159 resize_subwindow, (XIMAGE_INSTANCE (subwindow), neww, newh));
4161 XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow) = newh;
4162 XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow) = neww;
4164 /* need to update the cachels as redisplay will not do this */
4165 update_subwindow_cachel (subwindow);
4170 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
4171 Generate a Map event for SUBWINDOW.
4175 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4177 map_subwindow (subwindow, 0, 0);
4183 /*****************************************************************************
4185 *****************************************************************************/
4187 /* Get the display tables for use currently on window W with face
4188 FACE. #### This will have to be redone. */
4191 get_display_tables (struct window *w, face_index findex,
4192 Lisp_Object *face_table, Lisp_Object *window_table)
4195 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
4199 tem = noseeum_cons (tem, Qnil);
4201 tem = w->display_table;
4205 tem = noseeum_cons (tem, Qnil);
4206 *window_table = tem;
4210 display_table_entry (Emchar ch, Lisp_Object face_table,
4211 Lisp_Object window_table)
4215 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
4216 for (tail = face_table; 1; tail = XCDR (tail))
4221 if (!NILP (window_table))
4223 tail = window_table;
4224 window_table = Qnil;
4229 table = XCAR (tail);
4231 if (VECTORP (table))
4233 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
4234 return XVECTOR_DATA (table)[ch];
4238 else if (CHAR_TABLEP (table)
4239 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
4241 return get_char_table (ch, XCHAR_TABLE (table));
4243 else if (CHAR_TABLEP (table)
4244 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
4246 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
4252 else if (RANGE_TABLEP (table))
4254 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
4265 /*****************************************************************************
4266 * timeouts for animated glyphs *
4267 *****************************************************************************/
4268 static Lisp_Object Qglyph_animated_timeout_handler;
4270 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /*
4271 Callback function for updating animated images.
4276 CHECK_WEAK_LIST (arg);
4278 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg))))
4280 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg));
4282 if (IMAGE_INSTANCEP (value))
4284 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value);
4286 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value)
4288 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1
4290 !disable_animated_pixmaps)
4292 /* Increment the index of the image slice we are currently
4294 IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
4295 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
4296 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
4297 /* We might need to kick redisplay at this point - but we
4299 MARK_DEVICE_FRAMES_GLYPHS_CHANGED
4300 (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)));
4301 IMAGE_INSTANCE_DIRTYP (ii) = 1;
4308 Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image)
4310 Lisp_Object ret = Qnil;
4312 if (tickms > 0 && IMAGE_INSTANCEP (image))
4314 double ms = ((double)tickms) / 1000.0;
4315 struct gcpro gcpro1;
4316 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE);
4319 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil);
4321 ret = Fadd_timeout (make_float (ms),
4322 Qglyph_animated_timeout_handler,
4323 holder, make_float (ms));
4330 void disable_glyph_animated_timeout (int i)
4335 Fdisable_timeout (id);
4339 /*****************************************************************************
4341 *****************************************************************************/
4344 syms_of_glyphs (void)
4346 /* image instantiators */
4348 DEFSUBR (Fimage_instantiator_format_list);
4349 DEFSUBR (Fvalid_image_instantiator_format_p);
4350 DEFSUBR (Fset_console_type_image_conversion_list);
4351 DEFSUBR (Fconsole_type_image_conversion_list);
4353 defkeyword (&Q_file, ":file");
4354 defkeyword (&Q_data, ":data");
4355 defkeyword (&Q_face, ":face");
4356 defkeyword (&Q_pixel_height, ":pixel-height");
4357 defkeyword (&Q_pixel_width, ":pixel-width");
4360 defkeyword (&Q_color_symbols, ":color-symbols");
4362 #ifdef HAVE_WINDOW_SYSTEM
4363 defkeyword (&Q_mask_file, ":mask-file");
4364 defkeyword (&Q_mask_data, ":mask-data");
4365 defkeyword (&Q_hotspot_x, ":hotspot-x");
4366 defkeyword (&Q_hotspot_y, ":hotspot-y");
4367 defkeyword (&Q_foreground, ":foreground");
4368 defkeyword (&Q_background, ":background");
4370 /* image specifiers */
4372 DEFSUBR (Fimage_specifier_p);
4373 /* Qimage in general.c */
4375 /* image instances */
4377 defsymbol (&Qimage_instancep, "image-instance-p");
4379 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
4380 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
4381 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
4382 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
4383 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
4384 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
4385 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
4386 defsymbol (&Qlayout_image_instance_p, "layout-image-instance-p");
4388 DEFSUBR (Fmake_image_instance);
4389 DEFSUBR (Fimage_instance_p);
4390 DEFSUBR (Fimage_instance_type);
4391 DEFSUBR (Fvalid_image_instance_type_p);
4392 DEFSUBR (Fimage_instance_type_list);
4393 DEFSUBR (Fimage_instance_name);
4394 DEFSUBR (Fimage_instance_string);
4395 DEFSUBR (Fimage_instance_file_name);
4396 DEFSUBR (Fimage_instance_mask_file_name);
4397 DEFSUBR (Fimage_instance_depth);
4398 DEFSUBR (Fimage_instance_height);
4399 DEFSUBR (Fimage_instance_width);
4400 DEFSUBR (Fimage_instance_hotspot_x);
4401 DEFSUBR (Fimage_instance_hotspot_y);
4402 DEFSUBR (Fimage_instance_foreground);
4403 DEFSUBR (Fimage_instance_background);
4404 DEFSUBR (Fimage_instance_property);
4405 DEFSUBR (Fset_image_instance_property);
4406 DEFSUBR (Fcolorize_image_instance);
4408 DEFSUBR (Fsubwindowp);
4409 DEFSUBR (Fimage_instance_subwindow_id);
4410 DEFSUBR (Fresize_subwindow);
4411 DEFSUBR (Fforce_subwindow_map);
4413 /* Qnothing defined as part of the "nothing" image-instantiator
4415 /* Qtext defined in general.c */
4416 defsymbol (&Qmono_pixmap, "mono-pixmap");
4417 defsymbol (&Qcolor_pixmap, "color-pixmap");
4418 /* Qpointer defined in general.c */
4422 defsymbol (&Qglyphp, "glyphp");
4423 defsymbol (&Qcontrib_p, "contrib-p");
4424 defsymbol (&Qbaseline, "baseline");
4426 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4427 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4428 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4430 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4432 DEFSUBR (Fglyph_type);
4433 DEFSUBR (Fvalid_glyph_type_p);
4434 DEFSUBR (Fglyph_type_list);
4436 DEFSUBR (Fmake_glyph_internal);
4437 DEFSUBR (Fglyph_width);
4438 DEFSUBR (Fglyph_ascent);
4439 DEFSUBR (Fglyph_descent);
4440 DEFSUBR (Fglyph_height);
4442 /* Qbuffer defined in general.c. */
4443 /* Qpointer defined above */
4445 /* Unfortunately, timeout handlers must be lisp functions. This is
4446 for animated glyphs. */
4447 defsymbol (&Qglyph_animated_timeout_handler,
4448 "glyph-animated-timeout-handler");
4449 DEFSUBR (Fglyph_animated_timeout_handler);
4452 deferror (&Qimage_conversion_error,
4453 "image-conversion-error",
4454 "image-conversion error", Qio_error);
4458 static const struct lrecord_description image_specifier_description[] = {
4459 { XD_LISP_OBJECT, specifier_data_offset + offsetof(struct image_specifier, attachee), 2 },
4464 specifier_type_create_image (void)
4466 /* image specifiers */
4468 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4470 SPECIFIER_HAS_METHOD (image, create);
4471 SPECIFIER_HAS_METHOD (image, mark);
4472 SPECIFIER_HAS_METHOD (image, instantiate);
4473 SPECIFIER_HAS_METHOD (image, validate);
4474 SPECIFIER_HAS_METHOD (image, after_change);
4475 SPECIFIER_HAS_METHOD (image, going_to_add);
4479 reinit_specifier_type_create_image (void)
4481 REINITIALIZE_SPECIFIER_TYPE (image);
4485 static const struct lrecord_description iike_description_1[] = {
4486 { XD_LISP_OBJECT, offsetof(ii_keyword_entry, keyword), 1 },
4490 static const struct struct_description iike_description = {
4491 sizeof(ii_keyword_entry),
4495 static const struct lrecord_description iiked_description_1[] = {
4496 XD_DYNARR_DESC(ii_keyword_entry_dynarr, &iike_description),
4500 static const struct struct_description iiked_description = {
4501 sizeof(ii_keyword_entry_dynarr),
4505 static const struct lrecord_description iife_description_1[] = {
4506 { XD_LISP_OBJECT, offsetof(image_instantiator_format_entry, symbol), 2 },
4507 { XD_STRUCT_PTR, offsetof(image_instantiator_format_entry, meths), 1, &iim_description },
4511 static const struct struct_description iife_description = {
4512 sizeof(image_instantiator_format_entry),
4516 static const struct lrecord_description iifed_description_1[] = {
4517 XD_DYNARR_DESC(image_instantiator_format_entry_dynarr, &iife_description),
4521 static const struct struct_description iifed_description = {
4522 sizeof(image_instantiator_format_entry_dynarr),
4526 static const struct lrecord_description iim_description_1[] = {
4527 { XD_LISP_OBJECT, offsetof(struct image_instantiator_methods, symbol), 2 },
4528 { XD_STRUCT_PTR, offsetof(struct image_instantiator_methods, keywords), 1, &iiked_description },
4529 { XD_STRUCT_PTR, offsetof(struct image_instantiator_methods, consoles), 1, &cted_description },
4533 const struct struct_description iim_description = {
4534 sizeof(struct image_instantiator_methods),
4539 image_instantiator_format_create (void)
4541 /* image instantiators */
4543 the_image_instantiator_format_entry_dynarr =
4544 Dynarr_new (image_instantiator_format_entry);
4546 Vimage_instantiator_format_list = Qnil;
4547 staticpro (&Vimage_instantiator_format_list);
4549 dumpstruct (&the_image_instantiator_format_entry_dynarr, &iifed_description);
4551 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
4553 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
4554 IIFORMAT_HAS_METHOD (nothing, instantiate);
4556 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
4558 IIFORMAT_HAS_METHOD (inherit, validate);
4559 IIFORMAT_HAS_METHOD (inherit, normalize);
4560 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
4561 IIFORMAT_HAS_METHOD (inherit, instantiate);
4563 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
4565 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
4567 IIFORMAT_HAS_METHOD (string, validate);
4568 IIFORMAT_HAS_METHOD (string, possible_dest_types);
4569 IIFORMAT_HAS_METHOD (string, instantiate);
4571 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4572 /* Do this so we can set strings. */
4573 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text");
4574 IIFORMAT_HAS_METHOD (text, set_property);
4576 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4578 IIFORMAT_HAS_METHOD (formatted_string, validate);
4579 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4580 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
4581 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
4584 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
4585 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
4586 IIFORMAT_HAS_METHOD (subwindow, instantiate);
4587 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
4588 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
4590 #ifdef HAVE_WINDOW_SYSTEM
4591 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4593 IIFORMAT_HAS_METHOD (xbm, validate);
4594 IIFORMAT_HAS_METHOD (xbm, normalize);
4595 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4597 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4598 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4599 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4600 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4601 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4602 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4603 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4604 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4605 #endif /* HAVE_WINDOW_SYSTEM */
4608 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
4610 IIFORMAT_HAS_METHOD (xface, validate);
4611 IIFORMAT_HAS_METHOD (xface, normalize);
4612 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
4614 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
4615 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
4616 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
4617 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
4618 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
4619 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
4623 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
4625 IIFORMAT_HAS_METHOD (xpm, validate);
4626 IIFORMAT_HAS_METHOD (xpm, normalize);
4627 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
4629 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
4630 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
4631 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
4632 #endif /* HAVE_XPM */
4636 reinit_vars_of_glyphs (void)
4638 the_expose_ignore_blocktype =
4639 Blocktype_new (struct expose_ignore_blocktype);
4641 hold_ignored_expose_registration = 0;
4646 vars_of_glyphs (void)
4648 reinit_vars_of_glyphs ();
4650 Vthe_nothing_vector = vector1 (Qnothing);
4651 staticpro (&Vthe_nothing_vector);
4653 /* image instances */
4655 Vimage_instance_type_list = Fcons (Qnothing,
4656 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
4657 Qpointer, Qsubwindow, Qwidget));
4658 staticpro (&Vimage_instance_type_list);
4662 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
4663 staticpro (&Vglyph_type_list);
4665 /* The octal-escape glyph, control-arrow-glyph and
4666 invisible-text-glyph are completely initialized in glyphs.el */
4668 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
4669 What to prefix character codes displayed in octal with.
4671 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4673 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
4674 What to use as an arrow for control characters.
4676 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
4677 redisplay_glyph_changed);
4679 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
4680 What to use to indicate the presence of invisible text.
4681 This is the glyph that is displayed when an ellipsis is called for
4682 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
4683 Normally this is three dots ("...").
4685 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
4686 redisplay_glyph_changed);
4688 /* Partially initialized in glyphs.el */
4689 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
4690 What to display at the beginning of horizontally scrolled lines.
4692 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4693 #ifdef HAVE_WINDOW_SYSTEM
4699 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
4700 Definitions of logical color-names used when reading XPM files.
4701 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
4702 The COLOR-NAME should be a string, which is the name of the color to define;
4703 the FORM should evaluate to a `color' specifier object, or a string to be
4704 passed to `make-color-instance'. If a loaded XPM file references a symbolic
4705 color called COLOR-NAME, it will display as the computed color instead.
4707 The default value of this variable defines the logical color names
4708 \"foreground\" and \"background\" to be the colors of the `default' face.
4710 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
4711 #endif /* HAVE_XPM */
4716 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /*
4717 Whether animated pixmaps should be animated.
4720 disable_animated_pixmaps = 0;
4724 specifier_vars_of_glyphs (void)
4726 /* #### Can we GC here? The set_specifier_* calls definitely need */
4728 /* display tables */
4730 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
4731 *The display table currently in use.
4732 This is a specifier; use `set-specifier' to change it.
4733 The display table is a vector created with `make-display-table'.
4734 The 256 elements control how to display each possible text character.
4735 Each value should be a string, a glyph, a vector or nil.
4736 If a value is a vector it must be composed only of strings and glyphs.
4737 nil means display the character in the default fashion.
4738 Faces can have their own, overriding display table.
4740 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
4741 set_specifier_fallback (Vcurrent_display_table,
4742 list1 (Fcons (Qnil, Qnil)));
4743 set_specifier_caching (Vcurrent_display_table,
4744 slot_offset (struct window,
4746 some_window_value_changed,
4751 complex_vars_of_glyphs (void)
4753 /* Partially initialized in glyphs-x.c, glyphs.el */
4754 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
4755 What to display at the end of truncated lines.
4757 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4759 /* Partially initialized in glyphs-x.c, glyphs.el */
4760 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
4761 What to display at the end of wrapped lines.
4763 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4765 /* Partially initialized in glyphs-x.c, glyphs.el */
4766 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
4767 The glyph used to display the XEmacs logo at startup.
4769 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);