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, 2000 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. Heavily modified /
28 rewritten by Andy Piper. */
41 #include "redisplay.h"
46 #include "blocktype.h"
52 Lisp_Object Qimage_conversion_error;
54 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
55 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p;
56 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p;
57 Lisp_Object Qmono_pixmap_image_instance_p;
58 Lisp_Object Qcolor_pixmap_image_instance_p;
59 Lisp_Object Qpointer_image_instance_p;
60 Lisp_Object Qsubwindow_image_instance_p;
61 Lisp_Object Qlayout_image_instance_p;
62 Lisp_Object Qwidget_image_instance_p;
63 Lisp_Object Qconst_glyph_variable;
64 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow;
65 Lisp_Object Q_file, Q_data, Q_face, Q_pixel_width, Q_pixel_height;
66 Lisp_Object Qformatted_string;
67 Lisp_Object Vcurrent_display_table;
68 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph;
69 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph;
70 Lisp_Object Vxemacs_logo;
71 Lisp_Object Vthe_nothing_vector;
72 Lisp_Object Vimage_instantiator_format_list;
73 Lisp_Object Vimage_instance_type_list;
74 Lisp_Object Vglyph_type_list;
76 int disable_animated_pixmaps;
78 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
79 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
80 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
81 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
82 DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow);
83 DEFINE_IMAGE_INSTANTIATOR_FORMAT (text);
85 #ifdef HAVE_WINDOW_SYSTEM
86 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
89 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
90 Lisp_Object Q_foreground, Q_background;
92 #define BitmapSuccess 0
93 #define BitmapOpenFailed 1
94 #define BitmapFileInvalid 2
95 #define BitmapNoMemory 3
100 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
105 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
107 Lisp_Object Q_color_symbols;
110 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
111 struct image_instantiator_format_entry
115 struct image_instantiator_methods *meths;
120 Dynarr_declare (struct image_instantiator_format_entry);
121 } image_instantiator_format_entry_dynarr;
123 image_instantiator_format_entry_dynarr *
124 the_image_instantiator_format_entry_dynarr;
126 static Lisp_Object allocate_image_instance (Lisp_Object device, Lisp_Object glyph);
127 static void image_validate (Lisp_Object instantiator);
128 static void glyph_property_was_changed (Lisp_Object glyph,
129 Lisp_Object property,
131 static void register_ignored_expose (struct frame* f, int x, int y, int width, int height);
132 /* Unfortunately windows and X are different. In windows BeginPaint()
133 will prevent WM_PAINT messages being generated so it is unnecessary
134 to register exposures as they will not occur. Under X they will
136 int hold_ignored_expose_registration;
138 EXFUN (Fimage_instance_type, 1);
139 EXFUN (Fglyph_type, 1);
142 /****************************************************************************
143 * Image Instantiators *
144 ****************************************************************************/
146 struct image_instantiator_methods *
147 decode_device_ii_format (Lisp_Object device, Lisp_Object format,
152 if (!SYMBOLP (format))
154 if (ERRB_EQ (errb, ERROR_ME))
155 CHECK_SYMBOL (format);
159 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
163 Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
166 Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
168 if ((NILP (d) && NILP (device))
171 EQ (CONSOLE_TYPE (XCONSOLE
172 (DEVICE_CONSOLE (XDEVICE (device)))), d)))
173 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
177 maybe_signal_simple_error ("Invalid image-instantiator format", format,
183 struct image_instantiator_methods *
184 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
186 return decode_device_ii_format (Qnil, format, errb);
190 valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale)
193 struct image_instantiator_methods* meths =
194 decode_image_instantiator_format (format, ERROR_ME_NOT);
195 Lisp_Object contype = Qnil;
196 /* mess with the locale */
197 if (!NILP (locale) && SYMBOLP (locale))
201 struct console* console = decode_console (locale);
202 contype = console ? CONSOLE_TYPE (console) : locale;
204 /* nothing is valid in all locales */
205 if (EQ (format, Qnothing))
207 /* reject unknown formats */
208 else if (NILP (contype) || !meths)
211 for (i = 0; i < Dynarr_length (meths->consoles); i++)
212 if (EQ (contype, Dynarr_at (meths->consoles, i).symbol))
217 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
219 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
220 If LOCALE is non-nil then the format is checked in that domain.
221 If LOCALE is nil the current console is used.
222 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
223 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
224 'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled.
226 (image_instantiator_format, locale))
228 return valid_image_instantiator_format_p (image_instantiator_format, locale) ?
232 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
234 Return a list of valid image-instantiator formats.
238 return Fcopy_sequence (Vimage_instantiator_format_list);
242 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol,
243 struct image_instantiator_methods *meths)
245 struct image_instantiator_format_entry entry;
247 entry.symbol = symbol;
248 entry.device = device;
250 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
251 Vimage_instantiator_format_list =
252 Fcons (symbol, Vimage_instantiator_format_list);
256 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
258 image_instantiator_methods *meths)
260 add_entry_to_device_ii_format_list (Qnil, symbol, meths);
264 get_image_conversion_list (Lisp_Object console_type)
266 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
269 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
271 Set the image-conversion-list for consoles of the given TYPE.
272 The image-conversion-list specifies how image instantiators that
273 are strings should be interpreted. Each element of the list should be
274 a list of two elements (a regular expression string and a vector) or
275 a list of three elements (the preceding two plus an integer index into
276 the vector). The string is converted to the vector associated with the
277 first matching regular expression. If a vector index is specified, the
278 string itself is substituted into that position in the vector.
280 Note: The conversion above is applied when the image instantiator is
281 added to an image specifier, not when the specifier is actually
282 instantiated. Therefore, changing the image-conversion-list only affects
283 newly-added instantiators. Existing instantiators in glyphs and image
284 specifiers will not be affected.
286 (console_type, list))
289 Lisp_Object *imlist = get_image_conversion_list (console_type);
291 /* Check the list to make sure that it only has valid entries. */
293 EXTERNAL_LIST_LOOP (tail, list)
295 Lisp_Object mapping = XCAR (tail);
297 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
298 if (!CONSP (mapping) ||
299 !CONSP (XCDR (mapping)) ||
300 (!NILP (XCDR (XCDR (mapping))) &&
301 (!CONSP (XCDR (XCDR (mapping))) ||
302 !NILP (XCDR (XCDR (XCDR (mapping)))))))
303 signal_simple_error ("Invalid mapping form", mapping);
306 Lisp_Object exp = XCAR (mapping);
307 Lisp_Object typevec = XCAR (XCDR (mapping));
308 Lisp_Object pos = Qnil;
313 CHECK_VECTOR (typevec);
314 if (!NILP (XCDR (XCDR (mapping))))
316 pos = XCAR (XCDR (XCDR (mapping)));
318 if (XINT (pos) < 0 ||
319 XINT (pos) >= XVECTOR_LENGTH (typevec))
321 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
324 newvec = Fcopy_sequence (typevec);
326 XVECTOR_DATA (newvec)[XINT (pos)] = exp;
328 image_validate (newvec);
333 *imlist = Fcopy_tree (list, Qt);
337 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
339 Return the image-conversion-list for devices of the given TYPE.
340 The image-conversion-list specifies how to interpret image string
341 instantiators for the specified console type. See
342 `set-console-type-image-conversion-list' for a description of its syntax.
346 return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
349 /* Process a string instantiator according to the image-conversion-list for
350 CONSOLE_TYPE. Returns a vector. */
353 process_image_string_instantiator (Lisp_Object data,
354 Lisp_Object console_type,
359 LIST_LOOP (tail, *get_image_conversion_list (console_type))
361 Lisp_Object mapping = XCAR (tail);
362 Lisp_Object exp = XCAR (mapping);
363 Lisp_Object typevec = XCAR (XCDR (mapping));
365 /* if the result is of a type that can't be instantiated
366 (e.g. a string when we're dealing with a pointer glyph),
369 IIFORMAT_METH (decode_image_instantiator_format
370 (XVECTOR_DATA (typevec)[0], ERROR_ME),
371 possible_dest_types, ())))
373 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
375 if (!NILP (XCDR (XCDR (mapping))))
377 int pos = XINT (XCAR (XCDR (XCDR (mapping))));
378 Lisp_Object newvec = Fcopy_sequence (typevec);
379 XVECTOR_DATA (newvec)[pos] = data;
388 signal_simple_error ("Unable to interpret glyph instantiator",
395 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
396 Lisp_Object default_)
399 int instantiator_len;
401 elt = XVECTOR_DATA (vector);
402 instantiator_len = XVECTOR_LENGTH (vector);
407 while (instantiator_len > 0)
409 if (EQ (elt[0], keyword))
412 instantiator_len -= 2;
419 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
421 return find_keyword_in_vector_or_given (vector, keyword, Qnil);
425 check_valid_string (Lisp_Object data)
431 check_valid_vector (Lisp_Object data)
437 check_valid_face (Lisp_Object data)
443 check_valid_int (Lisp_Object data)
449 file_or_data_must_be_present (Lisp_Object instantiator)
451 if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
452 NILP (find_keyword_in_vector (instantiator, Q_data)))
453 signal_simple_error ("Must supply either :file or :data",
458 data_must_be_present (Lisp_Object instantiator)
460 if (NILP (find_keyword_in_vector (instantiator, Q_data)))
461 signal_simple_error ("Must supply :data", instantiator);
465 face_must_be_present (Lisp_Object instantiator)
467 if (NILP (find_keyword_in_vector (instantiator, Q_face)))
468 signal_simple_error ("Must supply :face", instantiator);
471 /* utility function useful in retrieving data from a file. */
474 make_string_from_file (Lisp_Object file)
476 /* This function can call lisp */
477 int count = specpdl_depth ();
478 Lisp_Object temp_buffer;
482 specbind (Qinhibit_quit, Qt);
483 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
484 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
485 GCPRO1 (temp_buffer);
486 set_buffer_internal (XBUFFER (temp_buffer));
487 Ferase_buffer (Qnil);
488 specbind (intern ("format-alist"), Qnil);
489 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
490 data = Fbuffer_substring (Qnil, Qnil, Qnil);
491 unbind_to (count, Qnil);
496 /* The following two functions are provided to make it easier for
497 the normalize methods to work with keyword-value vectors.
498 Hash tables are kind of heavyweight for this purpose.
499 (If vectors were resizable, we could avoid this problem;
500 but they're not.) An alternative approach that might be
501 more efficient but require more work is to use a type of
502 assoc-Dynarr and provide primitives for deleting elements out
503 of it. (However, you'd also have to add an unwind-protect
504 to make sure the Dynarr got freed in case of an error in
505 the normalization process.) */
508 tagged_vector_to_alist (Lisp_Object vector)
510 Lisp_Object *elt = XVECTOR_DATA (vector);
511 int len = XVECTOR_LENGTH (vector);
512 Lisp_Object result = Qnil;
515 for (len -= 2; len >= 1; len -= 2)
516 result = Fcons (Fcons (elt[len], elt[len+1]), result);
522 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
524 int len = 1 + 2 * XINT (Flength (alist));
525 Lisp_Object *elt = alloca_array (Lisp_Object, len);
531 LIST_LOOP (rest, alist)
533 Lisp_Object pair = XCAR (rest);
534 elt[i] = XCAR (pair);
535 elt[i+1] = XCDR (pair);
539 return Fvector (len, elt);
543 normalize_image_instantiator (Lisp_Object instantiator,
545 Lisp_Object dest_mask)
547 if (IMAGE_INSTANCEP (instantiator))
550 if (STRINGP (instantiator))
551 instantiator = process_image_string_instantiator (instantiator, contype,
554 assert (VECTORP (instantiator));
555 /* We have to always store the actual pixmap data and not the
556 filename even though this is a potential memory pig. We have to
557 do this because it is quite possible that we will need to
558 instantiate a new instance of the pixmap and the file will no
559 longer exist (e.g. w3 pixmaps are almost always from temporary
563 struct image_instantiator_methods *meths;
565 GCPRO1 (instantiator);
567 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
569 RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
570 (instantiator, contype),
576 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
577 Lisp_Object instantiator,
578 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
579 int dest_mask, Lisp_Object glyph)
581 Lisp_Object ii = allocate_image_instance (device, glyph);
582 struct image_instantiator_methods *meths;
587 if (!valid_image_instantiator_format_p (XVECTOR_DATA (instantiator)[0], device))
589 ("Image instantiator format is invalid in this locale.",
592 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
594 methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate);
595 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
596 pointer_bg, dest_mask, domain));
598 /* now do device specific instantiation */
599 meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0],
602 if (!methp && (!meths || !HAS_IIFORMAT_METH_P (meths, instantiate)))
604 ("Don't know how to instantiate this image instantiator?",
606 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
607 pointer_bg, dest_mask, domain));
614 /****************************************************************************
615 * Image-Instance Object *
616 ****************************************************************************/
618 Lisp_Object Qimage_instancep;
621 mark_image_instance (Lisp_Object obj)
623 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
625 mark_object (i->name);
626 /* We don't mark the glyph reference since that would create a
627 circularity preventing GC. */
628 switch (IMAGE_INSTANCE_TYPE (i))
631 mark_object (IMAGE_INSTANCE_TEXT_STRING (i));
633 case IMAGE_MONO_PIXMAP:
634 case IMAGE_COLOR_PIXMAP:
635 mark_object (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
636 mark_object (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
637 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
638 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
639 mark_object (IMAGE_INSTANCE_PIXMAP_FG (i));
640 mark_object (IMAGE_INSTANCE_PIXMAP_BG (i));
644 mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i));
645 mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i));
646 mark_object (IMAGE_INSTANCE_WIDGET_FACE (i));
647 mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i));
648 case IMAGE_SUBWINDOW:
649 mark_object (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
653 mark_object (IMAGE_INSTANCE_LAYOUT_CHILDREN (i));
654 mark_object (IMAGE_INSTANCE_LAYOUT_BORDER (i));
655 mark_object (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
662 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i));
668 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
672 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
675 error ("printing unreadable object #<image-instance 0x%x>",
677 write_c_string ("#<image-instance (", printcharfun);
678 print_internal (Fimage_instance_type (obj), printcharfun, 0);
679 write_c_string (") ", printcharfun);
680 if (!NILP (ii->name))
682 print_internal (ii->name, printcharfun, 1);
683 write_c_string (" ", printcharfun);
685 write_c_string ("on ", printcharfun);
686 print_internal (ii->device, printcharfun, 0);
687 write_c_string (" ", printcharfun);
688 switch (IMAGE_INSTANCE_TYPE (ii))
694 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
697 case IMAGE_MONO_PIXMAP:
698 case IMAGE_COLOR_PIXMAP:
700 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
703 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
704 s = strrchr ((char *) XSTRING_DATA (filename), '/');
706 print_internal (build_string (s + 1), printcharfun, 1);
708 print_internal (filename, printcharfun, 1);
710 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
711 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
712 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
713 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
715 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
716 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
717 write_c_string (buf, printcharfun);
718 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
719 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
721 write_c_string (" @", printcharfun);
722 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
724 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
725 write_c_string (buf, printcharfun);
728 write_c_string ("??", printcharfun);
729 write_c_string (",", printcharfun);
730 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
732 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
733 write_c_string (buf, printcharfun);
736 write_c_string ("??", printcharfun);
738 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
739 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
741 write_c_string (" (", printcharfun);
742 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
746 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
748 write_c_string ("/", printcharfun);
749 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
753 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
755 write_c_string (")", printcharfun);
760 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
762 write_c_string (" (", printcharfun);
764 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
765 write_c_string (")", printcharfun);
768 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
769 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0);
771 case IMAGE_SUBWINDOW:
773 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
774 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
775 write_c_string (buf, printcharfun);
777 /* This is stolen from frame.c. Subwindows are strange in that they
778 are specific to a particular frame so we want to print in their
779 description what that frame is. */
781 write_c_string (" on #<", printcharfun);
783 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
785 if (!FRAME_LIVE_P (f))
786 write_c_string ("dead", printcharfun);
788 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
791 write_c_string ("-frame ", printcharfun);
793 write_c_string (">", printcharfun);
794 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
795 write_c_string (buf, printcharfun);
803 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
804 (ii, printcharfun, escapeflag));
805 sprintf (buf, " 0x%x>", ii->header.uid);
806 write_c_string (buf, printcharfun);
810 finalize_image_instance (void *header, int for_disksave)
812 struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header;
814 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
815 /* objects like this exist at dump time, so don't bomb out. */
817 if (for_disksave) finalose (i);
819 /* do this so that the cachels get reset */
820 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
822 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
824 MARK_FRAME_SUBWINDOWS_CHANGED
825 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
828 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
832 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
834 struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
835 struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
836 struct device *d1 = XDEVICE (i1->device);
837 struct device *d2 = XDEVICE (i2->device);
841 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)
842 || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2)
843 || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2)
844 || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2)
845 || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (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_DEPTH (i1) ==
867 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
868 IMAGE_INSTANCE_PIXMAP_SLICE (i1) ==
869 IMAGE_INSTANCE_PIXMAP_SLICE (i2) &&
870 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
871 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
872 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
873 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
874 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
875 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
877 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
878 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
884 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
885 IMAGE_INSTANCE_WIDGET_TYPE (i2))
886 && IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
887 IMAGE_INSTANCE_SUBWINDOW_ID (i2)
888 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1),
889 IMAGE_INSTANCE_WIDGET_ITEMS (i2),
891 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
892 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),
910 case IMAGE_SUBWINDOW:
911 if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
912 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
920 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
924 image_instance_hash (Lisp_Object obj, int depth)
926 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
927 struct device *d = XDEVICE (i->device);
928 unsigned long hash = HASH3 ((unsigned long) d,
929 IMAGE_INSTANCE_WIDTH (i),
930 IMAGE_INSTANCE_HEIGHT (i));
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 = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i),
946 IMAGE_INSTANCE_PIXMAP_SLICE (i),
947 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
953 internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1),
954 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
955 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1));
956 case IMAGE_SUBWINDOW:
957 hash = HASH2 (hash, (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
962 internal_hash (IMAGE_INSTANCE_LAYOUT_BORDER (i), depth + 1),
963 internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i),
971 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
975 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
976 mark_image_instance, print_image_instance,
977 finalize_image_instance, image_instance_equal,
978 image_instance_hash, 0,
979 struct Lisp_Image_Instance);
982 allocate_image_instance (Lisp_Object device, Lisp_Object glyph)
984 struct Lisp_Image_Instance *lp =
985 alloc_lcrecord_type (struct Lisp_Image_Instance, &lrecord_image_instance);
990 lp->type = IMAGE_NOTHING;
997 MARK_IMAGE_INSTANCE_CHANGED (lp); /* So that layouts get done. */
998 XSETIMAGE_INSTANCE (val, lp);
999 MARK_GLYPHS_CHANGED; /* So that the dirty flag gets reset. */
1003 static enum image_instance_type
1004 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
1006 if (ERRB_EQ (errb, ERROR_ME))
1007 CHECK_SYMBOL (type);
1009 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
1010 if (EQ (type, Qtext)) return IMAGE_TEXT;
1011 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
1012 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
1013 if (EQ (type, Qpointer)) return IMAGE_POINTER;
1014 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
1015 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
1016 if (EQ (type, Qlayout)) return IMAGE_LAYOUT;
1018 maybe_signal_simple_error ("Invalid image-instance type", type,
1021 return IMAGE_UNKNOWN; /* not reached */
1025 encode_image_instance_type (enum image_instance_type type)
1029 case IMAGE_NOTHING: return Qnothing;
1030 case IMAGE_TEXT: return Qtext;
1031 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
1032 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
1033 case IMAGE_POINTER: return Qpointer;
1034 case IMAGE_SUBWINDOW: return Qsubwindow;
1035 case IMAGE_WIDGET: return Qwidget;
1036 case IMAGE_LAYOUT: return Qlayout;
1041 return Qnil; /* not reached */
1045 image_instance_type_to_mask (enum image_instance_type type)
1047 /* This depends on the fact that enums are assigned consecutive
1048 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
1049 first enum.) I'm fairly sure this behavior is ANSI-mandated,
1050 so there should be no portability problems here. */
1051 return (1 << ((int) (type) - 1));
1055 decode_image_instance_type_list (Lisp_Object list)
1065 enum image_instance_type type =
1066 decode_image_instance_type (list, ERROR_ME);
1067 return image_instance_type_to_mask (type);
1070 EXTERNAL_LIST_LOOP (rest, list)
1072 enum image_instance_type type =
1073 decode_image_instance_type (XCAR (rest), ERROR_ME);
1074 mask |= image_instance_type_to_mask (type);
1081 encode_image_instance_type_list (int mask)
1084 Lisp_Object result = Qnil;
1090 result = Fcons (encode_image_instance_type
1091 ((enum image_instance_type) count), result);
1095 return Fnreverse (result);
1099 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1100 int desired_dest_mask)
1105 (emacs_doprnt_string_lisp_2
1107 "No compatible image-instance types given: wanted one of %s, got %s",
1109 encode_image_instance_type_list (desired_dest_mask),
1110 encode_image_instance_type_list (given_dest_mask)),
1115 valid_image_instance_type_p (Lisp_Object type)
1117 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1120 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1121 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1122 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1123 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1125 (image_instance_type))
1127 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1130 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1131 Return a list of valid image-instance types.
1135 return Fcopy_sequence (Vimage_instance_type_list);
1139 decode_error_behavior_flag (Lisp_Object no_error)
1141 if (NILP (no_error)) return ERROR_ME;
1142 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1143 else return ERROR_ME_WARN;
1147 encode_error_behavior_flag (Error_behavior errb)
1149 if (ERRB_EQ (errb, ERROR_ME))
1151 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1155 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1161 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1162 Lisp_Object dest_types)
1165 struct gcpro gcpro1;
1168 XSETDEVICE (device, decode_device (device));
1169 /* instantiate_image_instantiator() will abort if given an
1170 image instance ... */
1171 if (IMAGE_INSTANCEP (data))
1172 signal_simple_error ("Image instances not allowed here", data);
1173 image_validate (data);
1174 dest_mask = decode_image_instance_type_list (dest_types);
1175 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1176 make_int (dest_mask));
1178 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1179 signal_simple_error ("Inheritance not allowed here", data);
1180 ii = instantiate_image_instantiator (device, device, data,
1181 Qnil, Qnil, dest_mask, Qnil);
1182 RETURN_UNGCPRO (ii);
1185 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1186 Return a new `image-instance' object.
1188 Image-instance objects encapsulate the way a particular image (pixmap,
1189 etc.) is displayed on a particular device. In most circumstances, you
1190 do not need to directly create image instances; use a glyph instead.
1191 However, it may occasionally be useful to explicitly create image
1192 instances, if you want more control over the instantiation process.
1194 DATA is an image instantiator, which describes the image; see
1195 `image-specifier-p' for a description of the allowed values.
1197 DEST-TYPES should be a list of allowed image instance types that can
1198 be generated. The recognized image instance types are
1201 Nothing is displayed.
1203 Displayed as text. The foreground and background colors and the
1204 font of the text are specified independent of the pixmap. Typically
1205 these attributes will come from the face of the surrounding text,
1206 unless a face is specified for the glyph in which the image appears.
1208 Displayed as a mono pixmap (a pixmap with only two colors where the
1209 foreground and background can be specified independent of the pixmap;
1210 typically the pixmap assumes the foreground and background colors of
1211 the text around it, unless a face is specified for the glyph in which
1214 Displayed as a color pixmap.
1216 Used as the mouse pointer for a window.
1218 A child window that is treated as an image. This allows (e.g.)
1219 another program to be responsible for drawing into the window.
1221 A child window that contains a window-system widget, e.g. a push
1224 The DEST-TYPES list is unordered. If multiple destination types
1225 are possible for a given instantiator, the "most natural" type
1226 for the instantiator's format is chosen. (For XBM, the most natural
1227 types are `mono-pixmap', followed by `color-pixmap', followed by
1228 `pointer'. For the other normal image formats, the most natural
1229 types are `color-pixmap', followed by `mono-pixmap', followed by
1230 `pointer'. For the string and formatted-string formats, the most
1231 natural types are `text', followed by `mono-pixmap' (not currently
1232 implemented), followed by `color-pixmap' (not currently implemented).
1233 The other formats can only be instantiated as one type. (If you
1234 want to control more specifically the order of the types into which
1235 an image is instantiated, just call `make-image-instance' repeatedly
1236 until it succeeds, passing less and less preferred destination types
1239 If DEST-TYPES is omitted, all possible types are allowed.
1241 NO-ERROR controls what happens when the image cannot be generated.
1242 If nil, an error message is generated. If t, no messages are
1243 generated and this function returns nil. If anything else, a warning
1244 message is generated and this function returns nil.
1246 (data, device, dest_types, no_error))
1248 Error_behavior errb = decode_error_behavior_flag (no_error);
1250 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1252 3, data, device, dest_types);
1255 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1256 Return non-nil if OBJECT is an image instance.
1260 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1263 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1264 Return the type of the given image instance.
1265 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1266 'color-pixmap, 'pointer, or 'subwindow.
1270 CHECK_IMAGE_INSTANCE (image_instance);
1271 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1274 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1275 Return the name of the given image instance.
1279 CHECK_IMAGE_INSTANCE (image_instance);
1280 return XIMAGE_INSTANCE_NAME (image_instance);
1283 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1284 Return the string of the given image instance.
1285 This will only be non-nil for text image instances and widgets.
1289 CHECK_IMAGE_INSTANCE (image_instance);
1290 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1291 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1292 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1293 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1298 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1299 Return the given property of the given image instance.
1300 Returns nil if the property or the property method do not exist for
1301 the image instance in the domain.
1303 (image_instance, prop))
1305 struct Lisp_Image_Instance* ii;
1306 Lisp_Object type, ret;
1307 struct image_instantiator_methods* meths;
1309 CHECK_IMAGE_INSTANCE (image_instance);
1310 CHECK_SYMBOL (prop);
1311 ii = XIMAGE_INSTANCE (image_instance);
1313 /* ... then try device specific methods ... */
1314 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1315 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1316 type, ERROR_ME_NOT);
1317 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1319 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1323 /* ... then format specific methods ... */
1324 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1325 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1327 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1335 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1336 Set the given property of the given image instance.
1337 Does nothing if the property or the property method do not exist for
1338 the image instance in the domain.
1340 (image_instance, prop, val))
1342 struct Lisp_Image_Instance* ii;
1343 Lisp_Object type, ret;
1344 struct image_instantiator_methods* meths;
1346 CHECK_IMAGE_INSTANCE (image_instance);
1347 CHECK_SYMBOL (prop);
1348 ii = XIMAGE_INSTANCE (image_instance);
1349 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1350 /* try device specific methods first ... */
1351 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1352 type, ERROR_ME_NOT);
1353 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1356 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1362 /* ... then format specific methods ... */
1363 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1364 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1367 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1377 /* Make sure the image instance gets redisplayed. */
1378 MARK_IMAGE_INSTANCE_CHANGED (ii);
1379 MARK_SUBWINDOWS_STATE_CHANGED;
1380 MARK_GLYPHS_CHANGED;
1385 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1386 Return the file name from which IMAGE-INSTANCE was read, if known.
1390 CHECK_IMAGE_INSTANCE (image_instance);
1392 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1394 case IMAGE_MONO_PIXMAP:
1395 case IMAGE_COLOR_PIXMAP:
1397 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1404 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1405 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1409 CHECK_IMAGE_INSTANCE (image_instance);
1411 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1413 case IMAGE_MONO_PIXMAP:
1414 case IMAGE_COLOR_PIXMAP:
1416 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1423 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1424 Return the depth of the image instance.
1425 This is 0 for a bitmap, or a positive integer for a pixmap.
1429 CHECK_IMAGE_INSTANCE (image_instance);
1431 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1433 case IMAGE_MONO_PIXMAP:
1434 case IMAGE_COLOR_PIXMAP:
1436 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1443 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1444 Return the height of the image instance, in pixels.
1448 CHECK_IMAGE_INSTANCE (image_instance);
1450 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1452 case IMAGE_MONO_PIXMAP:
1453 case IMAGE_COLOR_PIXMAP:
1455 case IMAGE_SUBWINDOW:
1458 return make_int (XIMAGE_INSTANCE_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 case IMAGE_SUBWINDOW:
1480 return make_int (XIMAGE_INSTANCE_WIDTH (image_instance));
1487 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1488 Return the X coordinate of the image instance's hotspot, if known.
1489 This is a point relative to the origin of the pixmap. When an image is
1490 used as a mouse pointer, the hotspot is the point on the image that sits
1491 over the location that the pointer points to. This is, for example, the
1492 tip of the arrow or the center of the crosshairs.
1493 This will always be nil for a non-pointer image instance.
1497 CHECK_IMAGE_INSTANCE (image_instance);
1499 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1501 case IMAGE_MONO_PIXMAP:
1502 case IMAGE_COLOR_PIXMAP:
1504 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1511 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1512 Return the Y coordinate of the image instance's hotspot, if known.
1513 This is a point relative to the origin of the pixmap. When an image is
1514 used as a mouse pointer, the hotspot is the point on the image that sits
1515 over the location that the pointer points to. This is, for example, the
1516 tip of the arrow or the center of the crosshairs.
1517 This will always be nil for a non-pointer image instance.
1521 CHECK_IMAGE_INSTANCE (image_instance);
1523 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1525 case IMAGE_MONO_PIXMAP:
1526 case IMAGE_COLOR_PIXMAP:
1528 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1535 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1536 Return the foreground color of IMAGE-INSTANCE, if applicable.
1537 This will be a color instance or nil. (It will only be non-nil for
1538 colorized mono pixmaps and for pointers.)
1542 CHECK_IMAGE_INSTANCE (image_instance);
1544 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1546 case IMAGE_MONO_PIXMAP:
1547 case IMAGE_COLOR_PIXMAP:
1549 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1552 return FACE_FOREGROUND (
1553 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1554 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1562 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1563 Return the background color of IMAGE-INSTANCE, if applicable.
1564 This will be a color instance or nil. (It will only be non-nil for
1565 colorized mono pixmaps and for pointers.)
1569 CHECK_IMAGE_INSTANCE (image_instance);
1571 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1573 case IMAGE_MONO_PIXMAP:
1574 case IMAGE_COLOR_PIXMAP:
1576 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1579 return FACE_BACKGROUND (
1580 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1581 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1590 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1591 Make the image instance be displayed in the given colors.
1592 This function returns a new image instance that is exactly like the
1593 specified one except that (if possible) the foreground and background
1594 colors and as specified. Currently, this only does anything if the image
1595 instance is a mono pixmap; otherwise, the same image instance is returned.
1597 (image_instance, foreground, background))
1602 CHECK_IMAGE_INSTANCE (image_instance);
1603 CHECK_COLOR_INSTANCE (foreground);
1604 CHECK_COLOR_INSTANCE (background);
1606 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1607 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1608 return image_instance;
1610 /* #### There should be a copy_image_instance(), which calls a
1611 device-specific method to copy the window-system subobject. */
1612 new = allocate_image_instance (device, Qnil);
1613 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1614 /* note that if this method returns non-zero, this method MUST
1615 copy any window-system resources, so that when one image instance is
1616 freed, the other one is not hosed. */
1617 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1619 return image_instance;
1624 /************************************************************************/
1625 /* Geometry calculations */
1626 /************************************************************************/
1628 /* Find out desired geometry of the image instance. If there is no
1629 special function then just return the width and / or height. */
1631 image_instance_query_geometry (Lisp_Object image_instance,
1632 unsigned int* width, unsigned int* height,
1633 enum image_instance_geometry disp,
1636 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1638 struct image_instantiator_methods* meths;
1640 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1641 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1643 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1645 IIFORMAT_METH (meths, query_geometry, (image_instance, width, height,
1651 *width = IMAGE_INSTANCE_WIDTH (ii);
1653 *height = IMAGE_INSTANCE_HEIGHT (ii);
1657 /* Layout the image instance using the provided dimensions. Layout
1658 widgets are going to do different kinds of calculations to
1659 determine what size to give things so we could make the layout
1660 function relatively simple to take account of that. An alternative
1661 approach is to consider separately the two cases, one where you
1662 don't mind what size you have (normal widgets) and one where you
1663 want to specifiy something (layout widgets). */
1665 image_instance_layout (Lisp_Object image_instance,
1666 unsigned int width, unsigned int height,
1669 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1671 struct image_instantiator_methods* meths;
1673 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1674 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1676 /* If geometry is unspecified then get some reasonable values for it. */
1677 if (width == IMAGE_UNSPECIFIED_GEOMETRY
1679 height == IMAGE_UNSPECIFIED_GEOMETRY)
1681 unsigned int dwidth, dheight;
1683 /* Get the desired geometry. */
1684 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1686 IIFORMAT_METH (meths, query_geometry, (image_instance, &dwidth, &dheight,
1687 IMAGE_DESIRED_GEOMETRY,
1692 dwidth = IMAGE_INSTANCE_WIDTH (ii);
1693 dheight = IMAGE_INSTANCE_HEIGHT (ii);
1696 /* Compare with allowed geometry. */
1697 if (width == IMAGE_UNSPECIFIED_GEOMETRY)
1699 if (height == IMAGE_UNSPECIFIED_GEOMETRY)
1703 /* At this point width and height should contain sane values. Thus
1704 we set the glyph geometry and lay it out. */
1705 IMAGE_INSTANCE_WIDTH (ii) = width;
1706 IMAGE_INSTANCE_HEIGHT (ii) = height;
1708 if (meths && HAS_IIFORMAT_METH_P (meths, layout))
1710 IIFORMAT_METH (meths, layout, (image_instance, width, height, domain));
1712 /* else no change to the geometry. */
1716 /************************************************************************/
1718 /************************************************************************/
1720 signal_image_error (CONST char *reason, Lisp_Object frob)
1722 signal_error (Qimage_conversion_error,
1723 list2 (build_translated_string (reason), frob));
1727 signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1)
1729 signal_error (Qimage_conversion_error,
1730 list3 (build_translated_string (reason), frob0, frob1));
1733 /****************************************************************************
1735 ****************************************************************************/
1738 nothing_possible_dest_types (void)
1740 return IMAGE_NOTHING_MASK;
1744 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1745 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1746 int dest_mask, Lisp_Object domain)
1748 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1750 if (dest_mask & IMAGE_NOTHING_MASK)
1751 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1753 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1757 /****************************************************************************
1759 ****************************************************************************/
1762 inherit_validate (Lisp_Object instantiator)
1764 face_must_be_present (instantiator);
1768 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1772 assert (XVECTOR_LENGTH (inst) == 3);
1773 face = XVECTOR_DATA (inst)[2];
1775 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1780 inherit_possible_dest_types (void)
1782 return IMAGE_MONO_PIXMAP_MASK;
1786 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1787 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1788 int dest_mask, Lisp_Object domain)
1790 /* handled specially in image_instantiate */
1795 /****************************************************************************
1797 ****************************************************************************/
1800 string_validate (Lisp_Object instantiator)
1802 data_must_be_present (instantiator);
1806 string_possible_dest_types (void)
1808 return IMAGE_TEXT_MASK;
1811 /* Called from autodetect_instantiate() */
1813 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1814 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1815 int dest_mask, Lisp_Object domain)
1817 Lisp_Object string = find_keyword_in_vector (instantiator, Q_data);
1818 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1820 /* Should never get here with a domain other than a window. */
1821 assert (!NILP (string) && WINDOWP (domain));
1822 if (dest_mask & IMAGE_TEXT_MASK)
1824 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1825 IMAGE_INSTANCE_TEXT_STRING (ii) = string;
1828 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1831 /* Sort out the size of the text that is being displayed. Calculating
1832 it dynamically allows us to change the text and still see
1833 everything. Note that the following methods are for text not string
1834 since that is what the instantiated type is. The first method is a
1835 helper that is used elsewhere for calculating text geometry. */
1837 query_string_geometry (Lisp_Object string, Lisp_Object face,
1838 unsigned int* width, unsigned int* height,
1839 unsigned int* descent, Lisp_Object domain)
1841 struct font_metric_info fm;
1842 Charset_ID charsets[NUM_LEADING_BYTES];
1843 struct face_cachel frame_cachel;
1844 struct face_cachel *cachel;
1845 Lisp_Object frame = FW_FRAME (domain);
1847 /* Compute height */
1850 /* Compute string metric info */
1851 find_charsets_in_bufbyte_string (charsets,
1852 XSTRING_DATA (string),
1853 XSTRING_LENGTH (string));
1855 /* Fallback to the default face if none was provided. */
1858 reset_face_cachel (&frame_cachel);
1859 update_face_cachel_data (&frame_cachel, frame, face);
1860 cachel = &frame_cachel;
1864 cachel = WINDOW_FACE_CACHEL (XWINDOW (domain), DEFAULT_INDEX);
1867 ensure_face_cachel_complete (cachel, domain, charsets);
1868 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
1870 *height = fm.ascent + fm.descent;
1871 /* #### descent only gets set if we query the height as well. */
1873 *descent = fm.descent;
1880 *width = redisplay_frame_text_width_string (XFRAME (frame),
1884 *width = redisplay_frame_text_width_string (XFRAME (frame),
1891 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain)
1893 Charset_ID charsets[NUM_LEADING_BYTES];
1894 struct face_cachel frame_cachel;
1895 struct face_cachel *cachel;
1897 Lisp_Object frame = FW_FRAME (domain);
1899 /* Compute string font info */
1900 find_charsets_in_bufbyte_string (charsets,
1901 XSTRING_DATA (string),
1902 XSTRING_LENGTH (string));
1904 reset_face_cachel (&frame_cachel);
1905 update_face_cachel_data (&frame_cachel, frame, face);
1906 cachel = &frame_cachel;
1908 ensure_face_cachel_complete (cachel, domain, charsets);
1910 for (i = 0; i < NUM_LEADING_BYTES; i++)
1914 return FACE_CACHEL_FONT (cachel,
1915 CHARSET_BY_LEADING_BYTE (i +
1921 return Qnil; /* NOT REACHED */
1925 text_query_geometry (Lisp_Object image_instance,
1926 unsigned int* width, unsigned int* height,
1927 enum image_instance_geometry disp, Lisp_Object domain)
1929 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1930 unsigned int descent = 0;
1932 query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii),
1933 IMAGE_INSTANCE_FACE (ii),
1934 width, height, &descent, domain);
1936 /* The descent gets set as a side effect of querying the
1938 IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent;
1941 /* set the properties of a string */
1943 text_set_property (Lisp_Object image_instance, Lisp_Object prop,
1946 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1948 if (EQ (prop, Q_data))
1951 IMAGE_INSTANCE_TEXT_STRING (ii) = val;
1959 /****************************************************************************
1960 * formatted-string *
1961 ****************************************************************************/
1964 formatted_string_validate (Lisp_Object instantiator)
1966 data_must_be_present (instantiator);
1970 formatted_string_possible_dest_types (void)
1972 return IMAGE_TEXT_MASK;
1976 formatted_string_instantiate (Lisp_Object image_instance,
1977 Lisp_Object instantiator,
1978 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1979 int dest_mask, Lisp_Object domain)
1981 /* #### implement this */
1982 warn_when_safe (Qunimplemented, Qnotice,
1983 "`formatted-string' not yet implemented; assuming `string'");
1985 string_instantiate (image_instance, instantiator,
1986 pointer_fg, pointer_bg, dest_mask, domain);
1990 /************************************************************************/
1991 /* pixmap file functions */
1992 /************************************************************************/
1994 /* If INSTANTIATOR refers to inline data, return Qnil.
1995 If INSTANTIATOR refers to data in a file, return the full filename
1996 if it exists; otherwise, return a cons of (filename).
1998 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
1999 keywords used to look up the file and inline data,
2000 respectively, in the instantiator. Normally these would
2001 be Q_file and Q_data, but might be different for mask data. */
2004 potential_pixmap_file_instantiator (Lisp_Object instantiator,
2005 Lisp_Object file_keyword,
2006 Lisp_Object data_keyword,
2007 Lisp_Object console_type)
2012 assert (VECTORP (instantiator));
2014 data = find_keyword_in_vector (instantiator, data_keyword);
2015 file = find_keyword_in_vector (instantiator, file_keyword);
2017 if (!NILP (file) && NILP (data))
2019 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
2020 (decode_console_type(console_type, ERROR_ME),
2021 locate_pixmap_file, (file));
2026 return Fcons (file, Qnil); /* should have been file */
2033 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
2034 Lisp_Object image_type_tag)
2036 /* This function can call lisp */
2037 Lisp_Object file = Qnil;
2038 struct gcpro gcpro1, gcpro2;
2039 Lisp_Object alist = Qnil;
2041 GCPRO2 (file, alist);
2043 /* Now, convert any file data into inline data. At the end of this,
2044 `data' will contain the inline data (if any) or Qnil, and `file'
2045 will contain the name this data was derived from (if known) or
2048 Note that if we cannot generate any regular inline data, we
2051 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2054 if (CONSP (file)) /* failure locating filename */
2055 signal_double_file_error ("Opening pixmap file",
2056 "no such file or directory",
2059 if (NILP (file)) /* no conversion necessary */
2060 RETURN_UNGCPRO (inst);
2062 alist = tagged_vector_to_alist (inst);
2065 Lisp_Object data = make_string_from_file (file);
2066 alist = remassq_no_quit (Q_file, alist);
2067 /* there can't be a :data at this point. */
2068 alist = Fcons (Fcons (Q_file, file),
2069 Fcons (Fcons (Q_data, data), alist));
2073 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
2075 RETURN_UNGCPRO (result);
2080 #ifdef HAVE_WINDOW_SYSTEM
2081 /**********************************************************************
2083 **********************************************************************/
2085 /* Check if DATA represents a valid inline XBM spec (i.e. a list
2086 of (width height bits), with checking done on the dimensions).
2087 If not, signal an error. */
2090 check_valid_xbm_inline (Lisp_Object data)
2092 Lisp_Object width, height, bits;
2094 if (!CONSP (data) ||
2095 !CONSP (XCDR (data)) ||
2096 !CONSP (XCDR (XCDR (data))) ||
2097 !NILP (XCDR (XCDR (XCDR (data)))))
2098 signal_simple_error ("Must be list of 3 elements", data);
2100 width = XCAR (data);
2101 height = XCAR (XCDR (data));
2102 bits = XCAR (XCDR (XCDR (data)));
2104 CHECK_STRING (bits);
2106 if (!NATNUMP (width))
2107 signal_simple_error ("Width must be a natural number", width);
2109 if (!NATNUMP (height))
2110 signal_simple_error ("Height must be a natural number", height);
2112 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
2113 signal_simple_error ("data is too short for width and height",
2114 vector3 (width, height, bits));
2117 /* Validate method for XBM's. */
2120 xbm_validate (Lisp_Object instantiator)
2122 file_or_data_must_be_present (instantiator);
2125 /* Given a filename that is supposed to contain XBM data, return
2126 the inline representation of it as (width height bits). Return
2127 the hotspot through XHOT and YHOT, if those pointers are not 0.
2128 If there is no hotspot, XHOT and YHOT will contain -1.
2130 If the function fails:
2132 -- if OK_IF_DATA_INVALID is set and the data was invalid,
2134 -- maybe return an error, or return Qnil.
2137 #ifdef HAVE_X_WINDOWS
2138 #include <X11/Xlib.h>
2140 #define XFree(data) free(data)
2144 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
2145 int ok_if_data_invalid)
2150 CONST char *filename_ext;
2152 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
2153 result = read_bitmap_data_from_file (filename_ext, &w, &h,
2156 if (result == BitmapSuccess)
2159 int len = (w + 7) / 8 * h;
2161 retval = list3 (make_int (w), make_int (h),
2162 make_ext_string (data, len, FORMAT_BINARY));
2163 XFree ((char *) data);
2169 case BitmapOpenFailed:
2171 /* should never happen */
2172 signal_double_file_error ("Opening bitmap file",
2173 "no such file or directory",
2176 case BitmapFileInvalid:
2178 if (ok_if_data_invalid)
2180 signal_double_file_error ("Reading bitmap file",
2181 "invalid data in file",
2184 case BitmapNoMemory:
2186 signal_double_file_error ("Reading bitmap file",
2192 signal_double_file_error_2 ("Reading bitmap file",
2193 "unknown error code",
2194 make_int (result), name);
2198 return Qnil; /* not reached */
2202 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2203 Lisp_Object mask_file, Lisp_Object console_type)
2205 /* This is unclean but it's fairly standard -- a number of the
2206 bitmaps in /usr/include/X11/bitmaps use it -- so we support
2208 if (NILP (mask_file)
2209 /* don't override explicitly specified mask data. */
2210 && NILP (assq_no_quit (Q_mask_data, alist))
2213 mask_file = MAYBE_LISP_CONTYPE_METH
2214 (decode_console_type(console_type, ERROR_ME),
2215 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
2216 if (NILP (mask_file))
2217 mask_file = MAYBE_LISP_CONTYPE_METH
2218 (decode_console_type(console_type, ERROR_ME),
2219 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
2222 if (!NILP (mask_file))
2224 Lisp_Object mask_data =
2225 bitmap_to_lisp_data (mask_file, 0, 0, 0);
2226 alist = remassq_no_quit (Q_mask_file, alist);
2227 /* there can't be a :mask-data at this point. */
2228 alist = Fcons (Fcons (Q_mask_file, mask_file),
2229 Fcons (Fcons (Q_mask_data, mask_data), alist));
2235 /* Normalize method for XBM's. */
2238 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
2240 Lisp_Object file = Qnil, mask_file = Qnil;
2241 struct gcpro gcpro1, gcpro2, gcpro3;
2242 Lisp_Object alist = Qnil;
2244 GCPRO3 (file, mask_file, alist);
2246 /* Now, convert any file data into inline data for both the regular
2247 data and the mask data. At the end of this, `data' will contain
2248 the inline data (if any) or Qnil, and `file' will contain
2249 the name this data was derived from (if known) or Qnil.
2250 Likewise for `mask_file' and `mask_data'.
2252 Note that if we cannot generate any regular inline data, we
2255 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2257 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2258 Q_mask_data, console_type);
2260 if (CONSP (file)) /* failure locating filename */
2261 signal_double_file_error ("Opening bitmap file",
2262 "no such file or directory",
2265 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2266 RETURN_UNGCPRO (inst);
2268 alist = tagged_vector_to_alist (inst);
2273 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
2274 alist = remassq_no_quit (Q_file, alist);
2275 /* there can't be a :data at this point. */
2276 alist = Fcons (Fcons (Q_file, file),
2277 Fcons (Fcons (Q_data, data), alist));
2279 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2280 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2282 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2283 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2287 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2290 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2292 RETURN_UNGCPRO (result);
2298 xbm_possible_dest_types (void)
2301 IMAGE_MONO_PIXMAP_MASK |
2302 IMAGE_COLOR_PIXMAP_MASK |
2310 /**********************************************************************
2312 **********************************************************************/
2315 xface_validate (Lisp_Object instantiator)
2317 file_or_data_must_be_present (instantiator);
2321 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2323 /* This function can call lisp */
2324 Lisp_Object file = Qnil, mask_file = Qnil;
2325 struct gcpro gcpro1, gcpro2, gcpro3;
2326 Lisp_Object alist = Qnil;
2328 GCPRO3 (file, mask_file, alist);
2330 /* Now, convert any file data into inline data for both the regular
2331 data and the mask data. At the end of this, `data' will contain
2332 the inline data (if any) or Qnil, and `file' will contain
2333 the name this data was derived from (if known) or Qnil.
2334 Likewise for `mask_file' and `mask_data'.
2336 Note that if we cannot generate any regular inline data, we
2339 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2341 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2342 Q_mask_data, console_type);
2344 if (CONSP (file)) /* failure locating filename */
2345 signal_double_file_error ("Opening bitmap file",
2346 "no such file or directory",
2349 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2350 RETURN_UNGCPRO (inst);
2352 alist = tagged_vector_to_alist (inst);
2355 Lisp_Object data = make_string_from_file (file);
2356 alist = remassq_no_quit (Q_file, alist);
2357 /* there can't be a :data at this point. */
2358 alist = Fcons (Fcons (Q_file, file),
2359 Fcons (Fcons (Q_data, data), alist));
2362 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2365 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2367 RETURN_UNGCPRO (result);
2372 xface_possible_dest_types (void)
2375 IMAGE_MONO_PIXMAP_MASK |
2376 IMAGE_COLOR_PIXMAP_MASK |
2380 #endif /* HAVE_XFACE */
2385 /**********************************************************************
2387 **********************************************************************/
2390 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2396 GET_C_STRING_FILENAME_DATA_ALLOCA (name, fname);
2397 result = XpmReadFileToData (fname, &data);
2399 if (result == XpmSuccess)
2401 Lisp_Object retval = Qnil;
2402 struct buffer *old_buffer = current_buffer;
2403 Lisp_Object temp_buffer =
2404 Fget_buffer_create (build_string (" *pixmap conversion*"));
2406 int height, width, ncolors;
2407 struct gcpro gcpro1, gcpro2, gcpro3;
2408 int speccount = specpdl_depth ();
2410 GCPRO3 (name, retval, temp_buffer);
2412 specbind (Qinhibit_quit, Qt);
2413 set_buffer_internal (XBUFFER (temp_buffer));
2414 Ferase_buffer (Qnil);
2416 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2417 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2419 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2420 for (elt = 0; elt <= width + ncolors; elt++)
2422 buffer_insert_c_string (current_buffer, "\"");
2423 buffer_insert_c_string (current_buffer, data[elt]);
2425 if (elt < width + ncolors)
2426 buffer_insert_c_string (current_buffer, "\",\r");
2428 buffer_insert_c_string (current_buffer, "\"};\r");
2431 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2434 set_buffer_internal (old_buffer);
2435 unbind_to (speccount, Qnil);
2437 RETURN_UNGCPRO (retval);
2442 case XpmFileInvalid:
2444 if (ok_if_data_invalid)
2446 signal_image_error ("invalid XPM data in file", name);
2450 signal_double_file_error ("Reading pixmap file",
2451 "out of memory", name);
2455 /* should never happen? */
2456 signal_double_file_error ("Opening pixmap file",
2457 "no such file or directory", name);
2461 signal_double_file_error_2 ("Parsing pixmap file",
2462 "unknown error code",
2463 make_int (result), name);
2468 return Qnil; /* not reached */
2472 check_valid_xpm_color_symbols (Lisp_Object data)
2476 for (rest = data; !NILP (rest); rest = XCDR (rest))
2478 if (!CONSP (rest) ||
2479 !CONSP (XCAR (rest)) ||
2480 !STRINGP (XCAR (XCAR (rest))) ||
2481 (!STRINGP (XCDR (XCAR (rest))) &&
2482 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2483 signal_simple_error ("Invalid color symbol alist", data);
2488 xpm_validate (Lisp_Object instantiator)
2490 file_or_data_must_be_present (instantiator);
2493 Lisp_Object Vxpm_color_symbols;
2496 evaluate_xpm_color_symbols (void)
2498 Lisp_Object rest, results = Qnil;
2499 struct gcpro gcpro1, gcpro2;
2501 GCPRO2 (rest, results);
2502 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2504 Lisp_Object name, value, cons;
2510 CHECK_STRING (name);
2511 value = XCDR (cons);
2513 value = XCAR (value);
2514 value = Feval (value);
2517 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2519 ("Result from xpm-color-symbols eval must be nil, string, or color",
2521 results = Fcons (Fcons (name, value), results);
2523 UNGCPRO; /* no more evaluation */
2528 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2530 Lisp_Object file = Qnil;
2531 Lisp_Object color_symbols;
2532 struct gcpro gcpro1, gcpro2;
2533 Lisp_Object alist = Qnil;
2535 GCPRO2 (file, alist);
2537 /* Now, convert any file data into inline data. At the end of this,
2538 `data' will contain the inline data (if any) or Qnil, and
2539 `file' will contain the name this data was derived from (if
2542 Note that if we cannot generate any regular inline data, we
2545 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2548 if (CONSP (file)) /* failure locating filename */
2549 signal_double_file_error ("Opening pixmap file",
2550 "no such file or directory",
2553 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2556 if (NILP (file) && !UNBOUNDP (color_symbols))
2557 /* no conversion necessary */
2558 RETURN_UNGCPRO (inst);
2560 alist = tagged_vector_to_alist (inst);
2564 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2565 alist = remassq_no_quit (Q_file, alist);
2566 /* there can't be a :data at this point. */
2567 alist = Fcons (Fcons (Q_file, file),
2568 Fcons (Fcons (Q_data, data), alist));
2571 if (UNBOUNDP (color_symbols))
2573 color_symbols = evaluate_xpm_color_symbols ();
2574 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2579 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2581 RETURN_UNGCPRO (result);
2586 xpm_possible_dest_types (void)
2589 IMAGE_MONO_PIXMAP_MASK |
2590 IMAGE_COLOR_PIXMAP_MASK |
2594 #endif /* HAVE_XPM */
2597 /****************************************************************************
2598 * Image Specifier Object *
2599 ****************************************************************************/
2601 DEFINE_SPECIFIER_TYPE (image);
2604 image_create (Lisp_Object obj)
2606 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2608 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2609 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2610 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2614 image_mark (Lisp_Object obj)
2616 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2618 mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
2619 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2623 image_instantiate_cache_result (Lisp_Object locative)
2625 /* locative = (instance instantiator . subtable) */
2626 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2627 free_cons (XCONS (XCDR (locative)));
2628 free_cons (XCONS (locative));
2632 /* Given a specification for an image, return an instance of
2633 the image which matches the given instantiator and which can be
2634 displayed in the given domain. */
2637 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2638 Lisp_Object domain, Lisp_Object instantiator,
2641 Lisp_Object device = DFW_DEVICE (domain);
2642 struct device *d = XDEVICE (device);
2643 Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2644 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2645 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2647 if (IMAGE_INSTANCEP (instantiator))
2649 /* make sure that the image instance's device and type are
2652 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2655 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2656 if (mask & dest_mask)
2657 return instantiator;
2659 signal_simple_error ("Type of image instance not allowed here",
2663 signal_simple_error_2 ("Wrong device for image instance",
2664 instantiator, device);
2666 else if (VECTORP (instantiator)
2667 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2669 assert (XVECTOR_LENGTH (instantiator) == 3);
2670 return (FACE_PROPERTY_INSTANCE
2671 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2672 Qbackground_pixmap, domain, 0, depth));
2676 Lisp_Object instance;
2677 Lisp_Object subtable;
2678 Lisp_Object ls3 = Qnil;
2679 Lisp_Object pointer_fg = Qnil;
2680 Lisp_Object pointer_bg = Qnil;
2684 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2685 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2686 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2689 /* First look in the hash table. */
2690 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2692 if (UNBOUNDP (subtable))
2694 /* For the image instance cache, we do comparisons with EQ rather
2695 than with EQUAL, as we do for color and font names.
2698 1) pixmap data can be very long, and thus the hashing and
2699 comparing will take awhile.
2700 2) It's not so likely that we'll run into things that are EQUAL
2701 but not EQ (that can happen a lot with faces, because their
2702 specifiers are copied around); but pixmaps tend not to be
2705 However, if the image-instance could be a pointer, we have to
2706 use EQUAL because we massaged the instantiator into a cons3
2707 also containing the foreground and background of the
2711 subtable = make_lisp_hash_table (20,
2712 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2713 : HASH_TABLE_KEY_WEAK,
2714 pointerp ? HASH_TABLE_EQUAL
2716 Fputhash (make_int (dest_mask), subtable,
2717 d->image_instance_cache);
2718 instance = Qunbound;
2722 instance = Fgethash (pointerp ? ls3 : instantiator,
2723 subtable, Qunbound);
2724 /* subwindows have a per-window cache and have to be treated
2725 differently. dest_mask can be a bitwise OR of all image
2726 types so we will only catch someone possibly trying to
2727 instantiate a subwindow type thing. Unfortunately, this
2728 will occur most of the time so this probably slows things
2729 down. But with the current design I don't see anyway
2731 if (UNBOUNDP (instance)
2733 dest_mask & (IMAGE_SUBWINDOW_MASK
2737 if (!WINDOWP (domain))
2738 signal_simple_error ("Can't instantiate text or subwindow outside a window",
2740 instance = Fgethash (instantiator,
2741 XWINDOW (domain)->subwindow_instance_cache,
2746 if (UNBOUNDP (instance))
2748 Lisp_Object locative =
2750 noseeum_cons (pointerp ? ls3 : instantiator,
2752 int speccount = specpdl_depth ();
2754 /* make sure we cache the failures, too.
2755 Use an unwind-protect to catch such errors.
2756 If we fail, the unwind-protect records nil in
2757 the hash table. If we succeed, we change the
2758 car of the locative to the resulting instance,
2759 which gets recorded instead. */
2760 record_unwind_protect (image_instantiate_cache_result,
2762 instance = instantiate_image_instantiator (device,
2765 pointer_fg, pointer_bg,
2769 Fsetcar (locative, instance);
2770 /* only after the image has been instantiated do we know
2771 whether we need to put it in the per-window image instance
2773 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2775 (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2777 if (!WINDOWP (domain))
2778 signal_simple_error ("Can't instantiate subwindow outside a window",
2781 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache );
2783 unbind_to (speccount, Qnil);
2788 if (NILP (instance))
2789 signal_simple_error ("Can't instantiate image (probably cached)",
2795 return Qnil; /* not reached */
2798 /* Validate an image instantiator. */
2801 image_validate (Lisp_Object instantiator)
2803 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2805 else if (VECTORP (instantiator))
2807 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2808 int instantiator_len = XVECTOR_LENGTH (instantiator);
2809 struct image_instantiator_methods *meths;
2810 Lisp_Object already_seen = Qnil;
2811 struct gcpro gcpro1;
2814 if (instantiator_len < 1)
2815 signal_simple_error ("Vector length must be at least 1",
2818 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2819 if (!(instantiator_len & 1))
2821 ("Must have alternating keyword/value pairs", instantiator);
2823 GCPRO1 (already_seen);
2825 for (i = 1; i < instantiator_len; i += 2)
2827 Lisp_Object keyword = elt[i];
2828 Lisp_Object value = elt[i+1];
2831 CHECK_SYMBOL (keyword);
2832 if (!SYMBOL_IS_KEYWORD (keyword))
2833 signal_simple_error ("Symbol must begin with a colon", keyword);
2835 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2836 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2839 if (j == Dynarr_length (meths->keywords))
2840 signal_simple_error ("Unrecognized keyword", keyword);
2842 if (!Dynarr_at (meths->keywords, j).multiple_p)
2844 if (!NILP (memq_no_quit (keyword, already_seen)))
2846 ("Keyword may not appear more than once", keyword);
2847 already_seen = Fcons (keyword, already_seen);
2850 (Dynarr_at (meths->keywords, j).validate) (value);
2855 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2858 signal_simple_error ("Must be string or vector", instantiator);
2862 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2864 Lisp_Object attachee =
2865 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2866 Lisp_Object property =
2867 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2868 if (FACEP (attachee))
2869 face_property_was_changed (attachee, property, locale);
2870 else if (GLYPHP (attachee))
2871 glyph_property_was_changed (attachee, property, locale);
2875 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2876 Lisp_Object property)
2878 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2880 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2881 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2885 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2886 Lisp_Object tag_set, Lisp_Object instantiator)
2888 Lisp_Object possible_console_types = Qnil;
2890 Lisp_Object retlist = Qnil;
2891 struct gcpro gcpro1, gcpro2;
2893 LIST_LOOP (rest, Vconsole_type_list)
2895 Lisp_Object contype = XCAR (rest);
2896 if (!NILP (memq_no_quit (contype, tag_set)))
2897 possible_console_types = Fcons (contype, possible_console_types);
2900 if (XINT (Flength (possible_console_types)) > 1)
2901 /* two conflicting console types specified */
2904 if (NILP (possible_console_types))
2905 possible_console_types = Vconsole_type_list;
2907 GCPRO2 (retlist, possible_console_types);
2909 LIST_LOOP (rest, possible_console_types)
2911 Lisp_Object contype = XCAR (rest);
2912 Lisp_Object newinst = call_with_suspended_errors
2913 ((lisp_fn_t) normalize_image_instantiator,
2914 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2915 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2917 if (!NILP (newinst))
2920 if (NILP (memq_no_quit (contype, tag_set)))
2921 newtag = Fcons (contype, tag_set);
2924 retlist = Fcons (Fcons (newtag, newinst), retlist);
2933 /* Copy an image instantiator. We can't use Fcopy_tree since widgets
2934 may contain circular references which would send Fcopy_tree into
2937 image_copy_vector_instantiator (Lisp_Object instantiator)
2940 struct image_instantiator_methods *meths;
2942 int instantiator_len;
2944 CHECK_VECTOR (instantiator);
2946 instantiator = Fcopy_sequence (instantiator);
2947 elt = XVECTOR_DATA (instantiator);
2948 instantiator_len = XVECTOR_LENGTH (instantiator);
2950 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2952 for (i = 1; i < instantiator_len; i += 2)
2955 Lisp_Object keyword = elt[i];
2956 Lisp_Object value = elt[i+1];
2958 /* Find the keyword entry. */
2959 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2961 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2965 /* Only copy keyword values that should be copied. */
2966 if (Dynarr_at (meths->keywords, j).copy_p
2968 (CONSP (value) || VECTORP (value)))
2970 elt [i+1] = Fcopy_tree (value, Qt);
2974 return instantiator;
2978 image_copy_instantiator (Lisp_Object arg)
2983 rest = arg = Fcopy_sequence (arg);
2984 while (CONSP (rest))
2986 Lisp_Object elt = XCAR (rest);
2988 XCAR (rest) = Fcopy_tree (elt, Qt);
2989 else if (VECTORP (elt))
2990 XCAR (rest) = image_copy_vector_instantiator (elt);
2991 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
2992 XCDR (rest) = Fcopy_tree (XCDR (rest), Qt);
2996 else if (VECTORP (arg))
2998 arg = image_copy_vector_instantiator (arg);
3003 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
3004 Return non-nil if OBJECT is an image specifier.
3006 An image specifier is used for images (pixmaps and the like). It is used
3007 to describe the actual image in a glyph. It is instanced as an image-
3010 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
3011 etc. This describes the format of the data describing the image. The
3012 resulting image instances also come in many types -- `mono-pixmap',
3013 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
3014 the image and the sorts of places it can appear. (For example, a
3015 color-pixmap image has fixed colors specified for it, while a
3016 mono-pixmap image comes in two unspecified shades "foreground" and
3017 "background" that are determined from the face of the glyph or
3018 surrounding text; a text image appears as a string of text and has an
3019 unspecified foreground, background, and font; a pointer image behaves
3020 like a mono-pixmap image but can only be used as a mouse pointer
3021 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
3022 important to keep the distinction between image instantiator format and
3023 image instance type in mind. Typically, a given image instantiator
3024 format can result in many different image instance types (for example,
3025 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
3026 whereas `cursor-font' can be instanced only as `pointer'), and a
3027 particular image instance type can be generated by many different
3028 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
3029 `gif', `jpeg', etc.).
3031 See `make-image-instance' for a more detailed discussion of image
3034 An image instantiator should be a string or a vector of the form
3036 [FORMAT :KEYWORD VALUE ...]
3038 i.e. a format symbol followed by zero or more alternating keyword-value
3039 pairs. FORMAT should be one of
3042 (Don't display anything; no keywords are valid for this.
3043 Can only be instanced as `nothing'.)
3045 (Display this image as a text string. Can only be instanced
3046 as `text', although support for instancing as `mono-pixmap'
3049 (Display this image as a text string, with replaceable fields;
3050 not currently implemented.)
3052 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
3053 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3055 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
3056 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
3058 (An X-Face bitmap, used to encode people's faces in e-mail messages;
3059 only if X-Face support was compiled into this XEmacs. Can be
3060 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3062 (A GIF87 or GIF89 image; only if GIF support was compiled into this
3063 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
3064 Can be instanced as `color-pixmap'.)
3066 (A JPEG image; only if JPEG support was compiled into this XEmacs.
3067 Can be instanced as `color-pixmap'.)
3069 (A PNG image; only if PNG support was compiled into this XEmacs.
3070 Can be instanced as `color-pixmap'.)
3072 (A TIFF image; only if TIFF support was compiled into this XEmacs.
3073 Can be instanced as `color-pixmap'.)
3075 (One of the standard cursor-font names, such as "watch" or
3076 "right_ptr" under X. Under X, this is, more specifically, any
3077 of the standard cursor names from appendix B of the Xlib manual
3078 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
3079 On other window systems, the valid names will be specific to the
3080 type of window system. Can only be instanced as `pointer'.)
3082 (A glyph from a font; i.e. the name of a font, and glyph index into it
3083 of the form "FONT fontname index [[mask-font] mask-index]".
3084 Currently can only be instanced as `pointer', although this should
3087 (An embedded windowing system window.)
3089 (A text editing widget glyph.)
3091 (A button widget glyph; either a push button, radio button or toggle button.)
3093 (A tab widget glyph; a series of user selectable tabs.)
3095 (A sliding widget glyph, for showing progress.)
3097 (A drop list of selectable items in a widget glyph, for editing text.)
3099 (A static, text-only, widget glyph; for displaying text.)
3101 (A folding widget glyph.)
3103 (XEmacs tries to guess what format the data is in. If X support
3104 exists, the data string will be checked to see if it names a filename.
3105 If so, and this filename contains XBM or XPM data, the appropriate
3106 sort of pixmap or pointer will be created. [This includes picking up
3107 any specified hotspot or associated mask file.] Otherwise, if `pointer'
3108 is one of the allowable image-instance types and the string names a
3109 valid cursor-font name, the image will be created as a pointer.
3110 Otherwise, the image will be displayed as text. If no X support
3111 exists, the image will always be displayed as text.)
3113 Inherit from the background-pixmap property of a face.
3115 The valid keywords are:
3118 (Inline data. For most formats above, this should be a string. For
3119 XBM images, this should be a list of three elements: width, height, and
3120 a string of bit data. This keyword is not valid for instantiator
3121 formats `nothing' and `inherit'.)
3123 (Data is contained in a file. The value is the name of this file.
3124 If both :data and :file are specified, the image is created from
3125 what is specified in :data and the string in :file becomes the
3126 value of the `image-instance-file-name' function when applied to
3127 the resulting image-instance. This keyword is not valid for
3128 instantiator formats `nothing', `string', `formatted-string',
3129 `cursor-font', `font', `autodetect', and `inherit'.)
3132 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
3133 allow you to explicitly specify foreground and background colors.
3134 The argument should be anything acceptable to `make-color-instance'.
3135 This will cause what would be a `mono-pixmap' to instead be colorized
3136 as a two-color color-pixmap, and specifies the foreground and/or
3137 background colors for a pointer instead of black and white.)
3139 (For `xbm' and `xface'. This specifies a mask to be used with the
3140 bitmap. The format is a list of width, height, and bits, like for
3143 (For `xbm' and `xface'. This specifies a file containing the mask data.
3144 If neither a mask file nor inline mask data is given for an XBM image,
3145 and the XBM image comes from a file, XEmacs will look for a mask file
3146 with the same name as the image file but with "Mask" or "msk"
3147 appended. For example, if you specify the XBM file "left_ptr"
3148 [usually located in "/usr/include/X11/bitmaps"], the associated
3149 mask file "left_ptrmsk" will automatically be picked up.)
3152 (For `xbm' and `xface'. These keywords specify a hotspot if the image
3153 is instantiated as a `pointer'. Note that if the XBM image file
3154 specifies a hotspot, it will automatically be picked up if no
3155 explicit hotspot is given.)
3157 (Only for `xpm'. This specifies an alist that maps strings
3158 that specify symbolic color names to the actual color to be used
3159 for that symbolic color (in the form of a string or a color-specifier
3160 object). If this is not specified, the contents of `xpm-color-symbols'
3161 are used to generate the alist.)
3163 (Only for `inherit'. This specifies the face to inherit from.
3164 For widget glyphs this also specifies the face to use for
3165 display. It defaults to gui-element-face.)
3167 Keywords accepted as menu item specs are also accepted by widget
3168 glyphs. These are `:selected', `:active', `:suffix', `:keys',
3169 `:style', `:filter', `:config', `:included', `:key-sequence',
3170 `:accelerator', `:label' and `:callback'.
3172 If instead of a vector, the instantiator is a string, it will be
3173 converted into a vector by looking it up according to the specs in the
3174 `console-type-image-conversion-list' (q.v.) for the console type of
3175 the domain (usually a window; sometimes a frame or device) over which
3176 the image is being instantiated.
3178 If the instantiator specifies data from a file, the data will be read
3179 in at the time that the instantiator is added to the image (which may
3180 be well before when the image is actually displayed), and the
3181 instantiator will be converted into one of the inline-data forms, with
3182 the filename retained using a :file keyword. This implies that the
3183 file must exist when the instantiator is added to the image, but does
3184 not need to exist at any other time (e.g. it may safely be a temporary
3189 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
3193 /****************************************************************************
3195 ****************************************************************************/
3198 mark_glyph (Lisp_Object obj)
3200 struct Lisp_Glyph *glyph = XGLYPH (obj);
3202 mark_object (glyph->image);
3203 mark_object (glyph->contrib_p);
3204 mark_object (glyph->baseline);
3205 mark_object (glyph->face);
3207 return glyph->plist;
3211 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3213 struct Lisp_Glyph *glyph = XGLYPH (obj);
3217 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
3219 write_c_string ("#<glyph (", printcharfun);
3220 print_internal (Fglyph_type (obj), printcharfun, 0);
3221 write_c_string (") ", printcharfun);
3222 print_internal (glyph->image, printcharfun, 1);
3223 sprintf (buf, "0x%x>", glyph->header.uid);
3224 write_c_string (buf, printcharfun);
3227 /* Glyphs are equal if all of their display attributes are equal. We
3228 don't compare names or doc-strings, because that would make equal
3231 This isn't concerned with "unspecified" attributes, that's what
3232 #'glyph-differs-from-default-p is for. */
3234 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3236 struct Lisp_Glyph *g1 = XGLYPH (obj1);
3237 struct Lisp_Glyph *g2 = XGLYPH (obj2);
3241 return (internal_equal (g1->image, g2->image, depth) &&
3242 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
3243 internal_equal (g1->baseline, g2->baseline, depth) &&
3244 internal_equal (g1->face, g2->face, depth) &&
3245 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
3248 static unsigned long
3249 glyph_hash (Lisp_Object obj, int depth)
3253 /* No need to hash all of the elements; that would take too long.
3254 Just hash the most common ones. */
3255 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
3256 internal_hash (XGLYPH (obj)->face, depth));
3260 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
3262 struct Lisp_Glyph *g = XGLYPH (obj);
3264 if (EQ (prop, Qimage)) return g->image;
3265 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
3266 if (EQ (prop, Qbaseline)) return g->baseline;
3267 if (EQ (prop, Qface)) return g->face;
3269 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
3273 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3275 if (EQ (prop, Qimage) ||
3276 EQ (prop, Qcontrib_p) ||
3277 EQ (prop, Qbaseline))
3280 if (EQ (prop, Qface))
3282 XGLYPH (obj)->face = Fget_face (value);
3286 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
3291 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
3293 if (EQ (prop, Qimage) ||
3294 EQ (prop, Qcontrib_p) ||
3295 EQ (prop, Qbaseline))
3298 if (EQ (prop, Qface))
3300 XGLYPH (obj)->face = Qnil;
3304 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
3308 glyph_plist (Lisp_Object obj)
3310 struct Lisp_Glyph *glyph = XGLYPH (obj);
3311 Lisp_Object result = glyph->plist;
3313 result = cons3 (Qface, glyph->face, result);
3314 result = cons3 (Qbaseline, glyph->baseline, result);
3315 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
3316 result = cons3 (Qimage, glyph->image, result);
3321 static const struct lrecord_description glyph_description[] = {
3322 { XD_LISP_OBJECT, offsetof(struct Lisp_Glyph, image), 5 },
3326 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
3327 mark_glyph, print_glyph, 0,
3328 glyph_equal, glyph_hash, glyph_description,
3329 glyph_getprop, glyph_putprop,
3330 glyph_remprop, glyph_plist,
3334 allocate_glyph (enum glyph_type type,
3335 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
3336 Lisp_Object locale))
3338 /* This function can GC */
3339 Lisp_Object obj = Qnil;
3340 struct Lisp_Glyph *g =
3341 alloc_lcrecord_type (struct Lisp_Glyph, &lrecord_glyph);
3344 g->image = Fmake_specifier (Qimage); /* This function can GC */
3349 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3350 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
3351 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
3352 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK
3353 | IMAGE_LAYOUT_MASK;
3356 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3357 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
3360 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3361 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK
3362 | IMAGE_COLOR_PIXMAP_MASK;
3368 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
3369 /* We're getting enough reports of odd behavior in this area it seems */
3370 /* best to GCPRO everything. */
3372 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3373 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3374 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3375 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3377 GCPRO4 (obj, tem1, tem2, tem3);
3379 set_specifier_fallback (g->image, tem1);
3380 g->contrib_p = Fmake_specifier (Qboolean);
3381 set_specifier_fallback (g->contrib_p, tem2);
3382 /* #### should have a specifier for the following */
3383 g->baseline = Fmake_specifier (Qgeneric);
3384 set_specifier_fallback (g->baseline, tem3);
3387 g->after_change = after_change;
3390 set_image_attached_to (g->image, obj, Qimage);
3397 static enum glyph_type
3398 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3401 return GLYPH_BUFFER;
3403 if (ERRB_EQ (errb, ERROR_ME))
3404 CHECK_SYMBOL (type);
3406 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3407 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3408 if (EQ (type, Qicon)) return GLYPH_ICON;
3410 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3412 return GLYPH_UNKNOWN;
3416 valid_glyph_type_p (Lisp_Object type)
3418 return !NILP (memq_no_quit (type, Vglyph_type_list));
3421 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3422 Given a GLYPH-TYPE, return non-nil if it is valid.
3423 Valid types are `buffer', `pointer', and `icon'.
3427 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3430 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3431 Return a list of valid glyph types.
3435 return Fcopy_sequence (Vglyph_type_list);
3438 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3439 Create and return a new uninitialized glyph or type TYPE.
3441 TYPE specifies the type of the glyph; this should be one of `buffer',
3442 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3443 specifies in which contexts the glyph can be used, and controls the
3444 allowable image types into which the glyph's image can be
3447 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3448 extent, in the modeline, and in the toolbar. Their image can be
3449 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3452 `pointer' glyphs can be used to specify the mouse pointer. Their
3453 image can be instantiated as `pointer'.
3455 `icon' glyphs can be used to specify the icon used when a frame is
3456 iconified. Their image can be instantiated as `mono-pixmap' and
3461 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3462 return allocate_glyph (typeval, 0);
3465 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3466 Return non-nil if OBJECT is a glyph.
3468 A glyph is an object used for pixmaps and the like. It is used
3469 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3470 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3471 buttons, and the like. Its image is described using an image specifier --
3472 see `image-specifier-p'.
3476 return GLYPHP (object) ? Qt : Qnil;
3479 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3480 Return the type of the given glyph.
3481 The return value will be one of 'buffer, 'pointer, or 'icon.
3485 CHECK_GLYPH (glyph);
3486 switch (XGLYPH_TYPE (glyph))
3489 case GLYPH_BUFFER: return Qbuffer;
3490 case GLYPH_POINTER: return Qpointer;
3491 case GLYPH_ICON: return Qicon;
3496 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3497 Error_behavior errb, int no_quit)
3499 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3501 /* This can never return Qunbound. All glyphs have 'nothing as
3503 Lisp_Object image_instance = specifier_instance (specifier, Qunbound,
3504 domain, errb, no_quit, 0,
3507 return image_instance;
3511 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window)
3513 Lisp_Object instance = glyph_or_image;
3515 if (GLYPHP (glyph_or_image))
3516 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3521 /*****************************************************************************
3524 Return the width of the given GLYPH on the given WINDOW.
3525 Calculations are done based on recursively querying the geometry of
3526 the associated image instances.
3527 ****************************************************************************/
3529 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain)
3531 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3533 if (!IMAGE_INSTANCEP (instance))
3536 if (XIMAGE_INSTANCE_DIRTYP (instance))
3537 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3538 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3540 return XIMAGE_INSTANCE_WIDTH (instance);
3543 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3544 Return the width of GLYPH on WINDOW.
3545 This may not be exact as it does not take into account all of the context
3546 that redisplay will.
3550 XSETWINDOW (window, decode_window (window));
3551 CHECK_GLYPH (glyph);
3553 return make_int (glyph_width (glyph, window));
3557 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain)
3559 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3561 if (!IMAGE_INSTANCEP (instance))
3564 if (XIMAGE_INSTANCE_DIRTYP (instance))
3565 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3566 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3568 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3569 return XIMAGE_INSTANCE_TEXT_ASCENT (instance);
3571 return XIMAGE_INSTANCE_HEIGHT (instance);
3575 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain)
3577 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3579 if (!IMAGE_INSTANCEP (instance))
3582 if (XIMAGE_INSTANCE_DIRTYP (instance))
3583 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3584 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3586 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3587 return XIMAGE_INSTANCE_TEXT_DESCENT (instance);
3592 /* strictly a convenience function. */
3594 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain)
3596 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3599 if (!IMAGE_INSTANCEP (instance))
3602 if (XIMAGE_INSTANCE_DIRTYP (instance))
3603 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3604 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3606 return XIMAGE_INSTANCE_HEIGHT (instance);
3609 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3610 Return the ascent value of GLYPH on WINDOW.
3611 This may not be exact as it does not take into account all of the context
3612 that redisplay will.
3616 XSETWINDOW (window, decode_window (window));
3617 CHECK_GLYPH (glyph);
3619 return make_int (glyph_ascent (glyph, window));
3622 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3623 Return the descent value of GLYPH on WINDOW.
3624 This may not be exact as it does not take into account all of the context
3625 that redisplay will.
3629 XSETWINDOW (window, decode_window (window));
3630 CHECK_GLYPH (glyph);
3632 return make_int (glyph_descent (glyph, window));
3635 /* This is redundant but I bet a lot of people expect it to exist. */
3636 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3637 Return the height of GLYPH on WINDOW.
3638 This may not be exact as it does not take into account all of the context
3639 that redisplay will.
3643 XSETWINDOW (window, decode_window (window));
3644 CHECK_GLYPH (glyph);
3646 return make_int (glyph_height (glyph, window));
3650 glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window)
3652 return XIMAGE_INSTANCE_DIRTYP (glyph_image_instance_maybe
3653 (glyph_or_image, window));
3657 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty)
3659 Lisp_Object instance = glyph_or_image;
3661 if (!NILP (glyph_or_image))
3663 if (GLYPHP (glyph_or_image))
3665 instance = glyph_image_instance (glyph_or_image, window,
3667 XGLYPH_DIRTYP (glyph_or_image) = dirty;
3670 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
3674 /* #### do we need to cache this info to speed things up? */
3677 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3679 if (!GLYPHP (glyph))
3683 Lisp_Object retval =
3684 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3685 /* #### look into ERROR_ME_NOT */
3686 Qunbound, domain, ERROR_ME_NOT,
3688 if (!NILP (retval) && !INTP (retval))
3690 else if (INTP (retval))
3692 if (XINT (retval) < 0)
3694 if (XINT (retval) > 100)
3695 retval = make_int (100);
3702 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3704 /* #### Domain parameter not currently used but it will be */
3705 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3709 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3711 if (!GLYPHP (glyph))
3714 return !NILP (specifier_instance_no_quit
3715 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3716 /* #### look into ERROR_ME_NOT */
3717 ERROR_ME_NOT, 0, Qzero));
3721 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3724 if (XGLYPH (glyph)->after_change)
3725 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3728 #if 0 /* Not used for now */
3730 glyph_query_geometry (Lisp_Object glyph_or_image, Lisp_Object window,
3731 unsigned int* width, unsigned int* height,
3732 enum image_instance_geometry disp, Lisp_Object domain)
3734 Lisp_Object instance = glyph_or_image;
3736 if (GLYPHP (glyph_or_image))
3737 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3739 image_instance_query_geometry (instance, width, height, disp, domain);
3743 glyph_layout (Lisp_Object glyph_or_image, Lisp_Object window,
3744 unsigned int width, unsigned int height, Lisp_Object domain)
3746 Lisp_Object instance = glyph_or_image;
3748 if (GLYPHP (glyph_or_image))
3749 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3751 image_instance_layout (instance, width, height, domain);
3756 /*****************************************************************************
3757 * glyph cachel functions *
3758 *****************************************************************************/
3761 #### All of this is 95% copied from face cachels.
3762 Consider consolidating.
3766 mark_glyph_cachels (glyph_cachel_dynarr *elements)
3773 for (elt = 0; elt < Dynarr_length (elements); elt++)
3775 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3776 mark_object (cachel->glyph);
3781 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3782 struct glyph_cachel *cachel)
3784 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)
3785 || XGLYPH_DIRTYP (cachel->glyph))
3787 Lisp_Object window, instance;
3789 XSETWINDOW (window, w);
3791 cachel->glyph = glyph;
3792 /* Speed things up slightly by grabbing the glyph instantiation
3793 and passing it to the size functions. */
3794 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3795 cachel->dirty = XGLYPH_DIRTYP (glyph) = glyph_dirty_p (glyph, window);
3796 cachel->width = glyph_width (instance, window);
3797 cachel->ascent = glyph_ascent (instance, window);
3798 cachel->descent = glyph_descent (instance, window);
3801 cachel->updated = 1;
3805 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3807 struct glyph_cachel new_cachel;
3810 new_cachel.glyph = Qnil;
3812 update_glyph_cachel_data (w, glyph, &new_cachel);
3813 Dynarr_add (w->glyph_cachels, new_cachel);
3817 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3824 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3826 struct glyph_cachel *cachel =
3827 Dynarr_atp (w->glyph_cachels, elt);
3829 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3831 update_glyph_cachel_data (w, glyph, cachel);
3836 /* If we didn't find the glyph, add it and then return its index. */
3837 add_glyph_cachel (w, glyph);
3842 reset_glyph_cachels (struct window *w)
3844 Dynarr_reset (w->glyph_cachels);
3845 get_glyph_cachel_index (w, Vcontinuation_glyph);
3846 get_glyph_cachel_index (w, Vtruncation_glyph);
3847 get_glyph_cachel_index (w, Vhscroll_glyph);
3848 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3849 get_glyph_cachel_index (w, Voctal_escape_glyph);
3850 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3854 mark_glyph_cachels_as_not_updated (struct window *w)
3858 /* We need to have a dirty flag to tell if the glyph has changed.
3859 We can check to see if each glyph variable is actually a
3860 completely different glyph, though. */
3861 #define FROB(glyph_obj, gindex) \
3862 update_glyph_cachel_data (w, glyph_obj, \
3863 Dynarr_atp (w->glyph_cachels, gindex))
3865 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3866 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3867 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3868 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3869 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3870 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3873 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3875 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3879 /* Unset the dirty bit on all the glyph cachels that have it. */
3881 mark_glyph_cachels_as_clean (struct window* w)
3885 XSETWINDOW (window, w);
3886 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3888 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt);
3890 set_glyph_dirty_p (cachel->glyph, window, 0);
3894 #ifdef MEMORY_USAGE_STATS
3897 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3898 struct overhead_stats *ovstats)
3903 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3908 #endif /* MEMORY_USAGE_STATS */
3912 /*****************************************************************************
3913 * subwindow cachel functions *
3914 *****************************************************************************/
3915 /* Subwindows are curious in that you have to physically unmap them to
3916 not display them. It is problematic deciding what to do in
3917 redisplay. We have two caches - a per-window instance cache that
3918 keeps track of subwindows on a window, these are linked to their
3919 instantiator in the hashtable and when the instantiator goes away
3920 we want the instance to go away also. However we also have a
3921 per-frame instance cache that we use to determine if a subwindow is
3922 obscuring an area that we want to clear. We need to be able to flip
3923 through this quickly so a hashtable is not suitable hence the
3924 subwindow_cachels. The question is should we just not mark
3925 instances in the subwindow_cachels or should we try and invalidate
3926 the cache at suitable points in redisplay? If we don't invalidate
3927 the cache it will fill up with crud that will only get removed when
3928 the frame is deleted. So invalidation is good, the question is when
3929 and whether we mark as well. Go for the simple option - don't mark,
3930 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
3933 mark_subwindow_cachels (subwindow_cachel_dynarr *elements)
3940 for (elt = 0; elt < Dynarr_length (elements); elt++)
3942 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
3943 mark_object (cachel->subwindow);
3948 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
3949 struct subwindow_cachel *cachel)
3951 cachel->subwindow = subwindow;
3952 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3953 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3954 cachel->updated = 1;
3958 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
3960 struct subwindow_cachel new_cachel;
3963 new_cachel.subwindow = Qnil;
3966 new_cachel.being_displayed=0;
3968 update_subwindow_cachel_data (f, subwindow, &new_cachel);
3969 Dynarr_add (f->subwindow_cachels, new_cachel);
3973 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
3980 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3982 struct subwindow_cachel *cachel =
3983 Dynarr_atp (f->subwindow_cachels, elt);
3985 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
3987 if (!cachel->updated)
3988 update_subwindow_cachel_data (f, subwindow, cachel);
3993 /* If we didn't find the glyph, add it and then return its index. */
3994 add_subwindow_cachel (f, subwindow);
3999 update_subwindow_cachel (Lisp_Object subwindow)
4004 if (NILP (subwindow))
4007 f = XFRAME ( XIMAGE_INSTANCE_SUBWINDOW_FRAME (subwindow));
4009 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4011 struct subwindow_cachel *cachel =
4012 Dynarr_atp (f->subwindow_cachels, elt);
4014 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
4016 update_subwindow_cachel_data (f, subwindow, cachel);
4021 /* redisplay in general assumes that drawing something will erase
4022 what was there before. unfortunately this does not apply to
4023 subwindows that need to be specifically unmapped in order to
4024 disappear. we take a brute force approach - on the basis that its
4025 cheap - and unmap all subwindows in a display line */
4027 reset_subwindow_cachels (struct frame *f)
4030 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4032 struct subwindow_cachel *cachel =
4033 Dynarr_atp (f->subwindow_cachels, elt);
4035 if (!NILP (cachel->subwindow) && cachel->being_displayed)
4037 cachel->updated = 1;
4038 /* #### This is not optimal as update_subwindow will search
4039 the cachels for ourselves as well. We could easily optimize. */
4040 unmap_subwindow (cachel->subwindow);
4043 Dynarr_reset (f->subwindow_cachels);
4047 mark_subwindow_cachels_as_not_updated (struct frame *f)
4051 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4052 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
4057 /*****************************************************************************
4058 * subwindow exposure ignorance *
4059 *****************************************************************************/
4060 /* when we unmap subwindows the associated window system will generate
4061 expose events. This we do not want as redisplay already copes with
4062 the repainting necessary. Worse, we can get in an endless cycle of
4063 redisplay if we are not careful. Thus we keep a per-frame list of
4064 expose events that are going to come and ignore them as
4067 struct expose_ignore_blocktype
4069 Blocktype_declare (struct expose_ignore);
4070 } *the_expose_ignore_blocktype;
4073 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
4075 struct expose_ignore *ei, *prev;
4076 /* the ignore list is FIFO so we should generally get a match with
4077 the first element in the list */
4078 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next)
4080 /* Checking for exact matches just isn't good enough as we
4081 mighte get exposures for partially obscure subwindows, thus
4082 we have to check for overlaps. Being conservative we will
4083 check for exposures wholly contained by the subwindow, this
4084 might give us what we want.*/
4085 if (ei->x <= x && ei->y <= y
4086 && ei->x + ei->width >= x + width
4087 && ei->y + ei->height >= y + height)
4089 #ifdef DEBUG_WIDGETS
4090 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n",
4091 x, y, width, height, ei->x, ei->y, ei->width, ei->height);
4094 f->subwindow_exposures = ei->next;
4096 prev->next = ei->next;
4098 if (ei == f->subwindow_exposures_tail)
4099 f->subwindow_exposures_tail = prev;
4101 Blocktype_free (the_expose_ignore_blocktype, ei);
4110 register_ignored_expose (struct frame* f, int x, int y, int width, int height)
4112 if (!hold_ignored_expose_registration)
4114 struct expose_ignore *ei;
4116 ei = Blocktype_alloc (the_expose_ignore_blocktype);
4122 ei->height = height;
4124 /* we have to add the exposure to the end of the list, since we
4125 want to check the oldest events first. for speed we keep a record
4126 of the end so that we can add right to it. */
4127 if (f->subwindow_exposures_tail)
4129 f->subwindow_exposures_tail->next = ei;
4131 if (!f->subwindow_exposures)
4133 f->subwindow_exposures = ei;
4135 f->subwindow_exposures_tail = ei;
4139 /****************************************************************************
4140 find_matching_subwindow
4142 See if there is a subwindow that completely encloses the requested
4144 ****************************************************************************/
4145 int find_matching_subwindow (struct frame* f, int x, int y, int width, int height)
4149 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4151 struct subwindow_cachel *cachel =
4152 Dynarr_atp (f->subwindow_cachels, elt);
4154 if (cachel->being_displayed
4156 cachel->x <= x && cachel->y <= y
4158 cachel->x + cachel->width >= x + width
4160 cachel->y + cachel->height >= y + height)
4169 /*****************************************************************************
4170 * subwindow functions *
4171 *****************************************************************************/
4173 /* update the displayed characteristics of a subwindow */
4175 update_subwindow (Lisp_Object subwindow)
4177 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4179 if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4181 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4184 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
4185 /* We must update the window's size as it may have been changed by
4186 the the layout routines. We also do this here so that explicit resizing
4187 from lisp does not result in synchronous updates. */
4188 MAYBE_DEVMETH (XDEVICE (ii->device), resize_subwindow, (ii,
4189 IMAGE_INSTANCE_WIDTH (ii),
4190 IMAGE_INSTANCE_HEIGHT (ii)));
4193 /* Update all the subwindows on a frame. */
4195 update_frame_subwindows (struct frame *f)
4199 if (f->subwindows_changed || f->subwindows_state_changed || f->faces_changed)
4200 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4202 struct subwindow_cachel *cachel =
4203 Dynarr_atp (f->subwindow_cachels, elt);
4205 if (cachel->being_displayed)
4207 update_subwindow (cachel->subwindow);
4212 /* remove a subwindow from its frame */
4213 void unmap_subwindow (Lisp_Object subwindow)
4215 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4217 struct subwindow_cachel* cachel;
4220 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4222 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4224 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4226 #ifdef DEBUG_WIDGETS
4227 stderr_out ("unmapping subwindow %d\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
4229 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4230 elt = get_subwindow_cachel_index (f, subwindow);
4231 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4233 /* make sure we don't get expose events */
4234 register_ignored_expose (f, cachel->x, cachel->y, cachel->width, cachel->height);
4237 cachel->being_displayed = 0;
4238 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4240 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
4243 /* show a subwindow in its frame */
4244 void map_subwindow (Lisp_Object subwindow, int x, int y,
4245 struct display_glyph_area *dga)
4247 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4249 struct subwindow_cachel* cachel;
4252 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4254 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4256 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4259 #ifdef DEBUG_WIDGETS
4260 stderr_out ("mapping subwindow %d, %dx%d@%d+%d\n",
4261 IMAGE_INSTANCE_SUBWINDOW_ID (ii),
4262 dga->width, dga->height, x, y);
4264 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4265 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
4266 elt = get_subwindow_cachel_index (f, subwindow);
4267 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4270 cachel->width = dga->width;
4271 cachel->height = dga->height;
4272 cachel->being_displayed = 1;
4274 /* This forces any pending display changes to happen to the image
4275 before we show it. I'm not sure whether or not we need mark as
4276 clean here, but for now we will. */
4277 if (IMAGE_INSTANCE_DIRTYP (ii))
4279 update_subwindow (subwindow);
4280 IMAGE_INSTANCE_DIRTYP (ii) = 0;
4283 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y, dga));
4287 subwindow_possible_dest_types (void)
4289 return IMAGE_SUBWINDOW_MASK;
4292 /* Partially instantiate a subwindow. */
4294 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
4295 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
4296 int dest_mask, Lisp_Object domain)
4298 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
4299 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
4300 Lisp_Object frame = FW_FRAME (domain);
4301 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
4302 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
4305 signal_simple_error ("No selected frame", device);
4307 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
4308 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
4311 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
4312 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4313 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
4315 /* #### This stuff may get overidden by the widget code and is
4316 actually really dumb now that we have dynamic geometry
4317 calculations. What should really happen is that the subwindow
4318 should query its child for and appropriate geometry. */
4320 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
4325 if (XINT (width) > 1)
4327 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
4330 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
4335 if (XINT (height) > 1)
4337 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
4341 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
4342 Return non-nil if OBJECT is a subwindow.
4346 CHECK_IMAGE_INSTANCE (object);
4347 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
4350 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
4351 Return the window id of SUBWINDOW as a number.
4355 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4356 return make_int ((int) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow));
4359 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
4360 Resize SUBWINDOW to WIDTH x HEIGHT.
4361 If a value is nil that parameter is not changed.
4363 (subwindow, width, height))
4367 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4370 neww = XIMAGE_INSTANCE_WIDTH (subwindow);
4372 neww = XINT (width);
4375 newh = XIMAGE_INSTANCE_HEIGHT (subwindow);
4377 newh = XINT (height);
4379 /* The actual resizing gets done asychronously by
4380 update_subwindow. */
4381 XIMAGE_INSTANCE_HEIGHT (subwindow) = newh;
4382 XIMAGE_INSTANCE_WIDTH (subwindow) = neww;
4384 /* need to update the cachels as redisplay will not do this */
4385 update_subwindow_cachel (subwindow);
4390 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
4391 Generate a Map event for SUBWINDOW.
4395 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4397 map_subwindow (subwindow, 0, 0);
4403 /*****************************************************************************
4405 *****************************************************************************/
4407 /* Get the display tables for use currently on window W with face
4408 FACE. #### This will have to be redone. */
4411 get_display_tables (struct window *w, face_index findex,
4412 Lisp_Object *face_table, Lisp_Object *window_table)
4415 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
4419 tem = noseeum_cons (tem, Qnil);
4421 tem = w->display_table;
4425 tem = noseeum_cons (tem, Qnil);
4426 *window_table = tem;
4430 display_table_entry (Emchar ch, Lisp_Object face_table,
4431 Lisp_Object window_table)
4435 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
4436 for (tail = face_table; 1; tail = XCDR (tail))
4441 if (!NILP (window_table))
4443 tail = window_table;
4444 window_table = Qnil;
4449 table = XCAR (tail);
4451 if (VECTORP (table))
4453 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
4454 return XVECTOR_DATA (table)[ch];
4458 else if (CHAR_TABLEP (table)
4459 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
4461 return get_char_table (ch, XCHAR_TABLE (table));
4463 else if (CHAR_TABLEP (table)
4464 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
4466 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
4472 else if (RANGE_TABLEP (table))
4474 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
4485 /*****************************************************************************
4486 * timeouts for animated glyphs *
4487 *****************************************************************************/
4488 static Lisp_Object Qglyph_animated_timeout_handler;
4490 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /*
4491 Callback function for updating animated images.
4496 CHECK_WEAK_LIST (arg);
4498 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg))))
4500 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg));
4502 if (IMAGE_INSTANCEP (value))
4504 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value);
4506 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value)
4508 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1
4510 !disable_animated_pixmaps)
4512 /* Increment the index of the image slice we are currently
4514 IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
4515 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
4516 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
4517 /* We might need to kick redisplay at this point - but we
4519 MARK_DEVICE_FRAMES_GLYPHS_CHANGED
4520 (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)));
4521 MARK_IMAGE_INSTANCE_CHANGED (ii);
4528 Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image)
4530 Lisp_Object ret = Qnil;
4532 if (tickms > 0 && IMAGE_INSTANCEP (image))
4534 double ms = ((double)tickms) / 1000.0;
4535 struct gcpro gcpro1;
4536 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE);
4539 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil);
4541 ret = Fadd_timeout (make_float (ms),
4542 Qglyph_animated_timeout_handler,
4543 holder, make_float (ms));
4550 void disable_glyph_animated_timeout (int i)
4555 Fdisable_timeout (id);
4559 /*****************************************************************************
4561 *****************************************************************************/
4564 syms_of_glyphs (void)
4566 /* image instantiators */
4568 DEFSUBR (Fimage_instantiator_format_list);
4569 DEFSUBR (Fvalid_image_instantiator_format_p);
4570 DEFSUBR (Fset_console_type_image_conversion_list);
4571 DEFSUBR (Fconsole_type_image_conversion_list);
4573 defkeyword (&Q_file, ":file");
4574 defkeyword (&Q_data, ":data");
4575 defkeyword (&Q_face, ":face");
4576 defkeyword (&Q_pixel_height, ":pixel-height");
4577 defkeyword (&Q_pixel_width, ":pixel-width");
4580 defkeyword (&Q_color_symbols, ":color-symbols");
4582 #ifdef HAVE_WINDOW_SYSTEM
4583 defkeyword (&Q_mask_file, ":mask-file");
4584 defkeyword (&Q_mask_data, ":mask-data");
4585 defkeyword (&Q_hotspot_x, ":hotspot-x");
4586 defkeyword (&Q_hotspot_y, ":hotspot-y");
4587 defkeyword (&Q_foreground, ":foreground");
4588 defkeyword (&Q_background, ":background");
4590 /* image specifiers */
4592 DEFSUBR (Fimage_specifier_p);
4593 /* Qimage in general.c */
4595 /* image instances */
4597 defsymbol (&Qimage_instancep, "image-instance-p");
4599 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
4600 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
4601 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
4602 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
4603 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
4604 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
4605 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
4606 defsymbol (&Qlayout_image_instance_p, "layout-image-instance-p");
4608 DEFSUBR (Fmake_image_instance);
4609 DEFSUBR (Fimage_instance_p);
4610 DEFSUBR (Fimage_instance_type);
4611 DEFSUBR (Fvalid_image_instance_type_p);
4612 DEFSUBR (Fimage_instance_type_list);
4613 DEFSUBR (Fimage_instance_name);
4614 DEFSUBR (Fimage_instance_string);
4615 DEFSUBR (Fimage_instance_file_name);
4616 DEFSUBR (Fimage_instance_mask_file_name);
4617 DEFSUBR (Fimage_instance_depth);
4618 DEFSUBR (Fimage_instance_height);
4619 DEFSUBR (Fimage_instance_width);
4620 DEFSUBR (Fimage_instance_hotspot_x);
4621 DEFSUBR (Fimage_instance_hotspot_y);
4622 DEFSUBR (Fimage_instance_foreground);
4623 DEFSUBR (Fimage_instance_background);
4624 DEFSUBR (Fimage_instance_property);
4625 DEFSUBR (Fset_image_instance_property);
4626 DEFSUBR (Fcolorize_image_instance);
4628 DEFSUBR (Fsubwindowp);
4629 DEFSUBR (Fimage_instance_subwindow_id);
4630 DEFSUBR (Fresize_subwindow);
4631 DEFSUBR (Fforce_subwindow_map);
4633 /* Qnothing defined as part of the "nothing" image-instantiator
4635 /* Qtext defined in general.c */
4636 defsymbol (&Qmono_pixmap, "mono-pixmap");
4637 defsymbol (&Qcolor_pixmap, "color-pixmap");
4638 /* Qpointer defined in general.c */
4642 defsymbol (&Qglyphp, "glyphp");
4643 defsymbol (&Qcontrib_p, "contrib-p");
4644 defsymbol (&Qbaseline, "baseline");
4646 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4647 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4648 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4650 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4652 DEFSUBR (Fglyph_type);
4653 DEFSUBR (Fvalid_glyph_type_p);
4654 DEFSUBR (Fglyph_type_list);
4656 DEFSUBR (Fmake_glyph_internal);
4657 DEFSUBR (Fglyph_width);
4658 DEFSUBR (Fglyph_ascent);
4659 DEFSUBR (Fglyph_descent);
4660 DEFSUBR (Fglyph_height);
4662 /* Qbuffer defined in general.c. */
4663 /* Qpointer defined above */
4665 /* Unfortunately, timeout handlers must be lisp functions. This is
4666 for animated glyphs. */
4667 defsymbol (&Qglyph_animated_timeout_handler,
4668 "glyph-animated-timeout-handler");
4669 DEFSUBR (Fglyph_animated_timeout_handler);
4672 deferror (&Qimage_conversion_error,
4673 "image-conversion-error",
4674 "image-conversion error", Qio_error);
4678 static const struct lrecord_description image_specifier_description[] = {
4679 { XD_LISP_OBJECT, specifier_data_offset + offsetof(struct image_specifier, attachee), 2 },
4684 specifier_type_create_image (void)
4686 /* image specifiers */
4688 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4690 SPECIFIER_HAS_METHOD (image, create);
4691 SPECIFIER_HAS_METHOD (image, mark);
4692 SPECIFIER_HAS_METHOD (image, instantiate);
4693 SPECIFIER_HAS_METHOD (image, validate);
4694 SPECIFIER_HAS_METHOD (image, after_change);
4695 SPECIFIER_HAS_METHOD (image, going_to_add);
4696 SPECIFIER_HAS_METHOD (image, copy_instantiator);
4700 reinit_specifier_type_create_image (void)
4702 REINITIALIZE_SPECIFIER_TYPE (image);
4706 static const struct lrecord_description iike_description_1[] = {
4707 { XD_LISP_OBJECT, offsetof(ii_keyword_entry, keyword), 1 },
4711 static const struct struct_description iike_description = {
4712 sizeof(ii_keyword_entry),
4716 static const struct lrecord_description iiked_description_1[] = {
4717 XD_DYNARR_DESC(ii_keyword_entry_dynarr, &iike_description),
4721 static const struct struct_description iiked_description = {
4722 sizeof(ii_keyword_entry_dynarr),
4726 static const struct lrecord_description iife_description_1[] = {
4727 { XD_LISP_OBJECT, offsetof(image_instantiator_format_entry, symbol), 2 },
4728 { XD_STRUCT_PTR, offsetof(image_instantiator_format_entry, meths), 1, &iim_description },
4732 static const struct struct_description iife_description = {
4733 sizeof(image_instantiator_format_entry),
4737 static const struct lrecord_description iifed_description_1[] = {
4738 XD_DYNARR_DESC(image_instantiator_format_entry_dynarr, &iife_description),
4742 static const struct struct_description iifed_description = {
4743 sizeof(image_instantiator_format_entry_dynarr),
4747 static const struct lrecord_description iim_description_1[] = {
4748 { XD_LISP_OBJECT, offsetof(struct image_instantiator_methods, symbol), 2 },
4749 { XD_STRUCT_PTR, offsetof(struct image_instantiator_methods, keywords), 1, &iiked_description },
4750 { XD_STRUCT_PTR, offsetof(struct image_instantiator_methods, consoles), 1, &cted_description },
4754 const struct struct_description iim_description = {
4755 sizeof(struct image_instantiator_methods),
4760 image_instantiator_format_create (void)
4762 /* image instantiators */
4764 the_image_instantiator_format_entry_dynarr =
4765 Dynarr_new (image_instantiator_format_entry);
4767 Vimage_instantiator_format_list = Qnil;
4768 staticpro (&Vimage_instantiator_format_list);
4770 dumpstruct (&the_image_instantiator_format_entry_dynarr, &iifed_description);
4772 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
4774 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
4775 IIFORMAT_HAS_METHOD (nothing, instantiate);
4777 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
4779 IIFORMAT_HAS_METHOD (inherit, validate);
4780 IIFORMAT_HAS_METHOD (inherit, normalize);
4781 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
4782 IIFORMAT_HAS_METHOD (inherit, instantiate);
4784 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
4786 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
4788 IIFORMAT_HAS_METHOD (string, validate);
4789 IIFORMAT_HAS_METHOD (string, possible_dest_types);
4790 IIFORMAT_HAS_METHOD (string, instantiate);
4792 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4793 /* Do this so we can set strings. */
4794 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text");
4795 IIFORMAT_HAS_METHOD (text, set_property);
4796 IIFORMAT_HAS_METHOD (text, query_geometry);
4798 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4800 IIFORMAT_HAS_METHOD (formatted_string, validate);
4801 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4802 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
4803 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
4806 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
4807 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
4808 IIFORMAT_HAS_METHOD (subwindow, instantiate);
4809 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
4810 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
4812 #ifdef HAVE_WINDOW_SYSTEM
4813 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4815 IIFORMAT_HAS_METHOD (xbm, validate);
4816 IIFORMAT_HAS_METHOD (xbm, normalize);
4817 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4819 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4820 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4821 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4822 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4823 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4824 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4825 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4826 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4827 #endif /* HAVE_WINDOW_SYSTEM */
4830 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
4832 IIFORMAT_HAS_METHOD (xface, validate);
4833 IIFORMAT_HAS_METHOD (xface, normalize);
4834 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
4836 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
4837 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
4838 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
4839 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
4840 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
4841 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
4845 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
4847 IIFORMAT_HAS_METHOD (xpm, validate);
4848 IIFORMAT_HAS_METHOD (xpm, normalize);
4849 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
4851 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
4852 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
4853 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
4854 #endif /* HAVE_XPM */
4858 reinit_vars_of_glyphs (void)
4860 the_expose_ignore_blocktype =
4861 Blocktype_new (struct expose_ignore_blocktype);
4863 hold_ignored_expose_registration = 0;
4868 vars_of_glyphs (void)
4870 reinit_vars_of_glyphs ();
4872 Vthe_nothing_vector = vector1 (Qnothing);
4873 staticpro (&Vthe_nothing_vector);
4875 /* image instances */
4877 Vimage_instance_type_list = Fcons (Qnothing,
4878 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
4879 Qpointer, Qsubwindow, Qwidget));
4880 staticpro (&Vimage_instance_type_list);
4884 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
4885 staticpro (&Vglyph_type_list);
4887 /* The octal-escape glyph, control-arrow-glyph and
4888 invisible-text-glyph are completely initialized in glyphs.el */
4890 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
4891 What to prefix character codes displayed in octal with.
4893 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4895 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
4896 What to use as an arrow for control characters.
4898 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
4899 redisplay_glyph_changed);
4901 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
4902 What to use to indicate the presence of invisible text.
4903 This is the glyph that is displayed when an ellipsis is called for
4904 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
4905 Normally this is three dots ("...").
4907 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
4908 redisplay_glyph_changed);
4910 /* Partially initialized in glyphs.el */
4911 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
4912 What to display at the beginning of horizontally scrolled lines.
4914 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4915 #ifdef HAVE_WINDOW_SYSTEM
4921 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
4922 Definitions of logical color-names used when reading XPM files.
4923 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
4924 The COLOR-NAME should be a string, which is the name of the color to define;
4925 the FORM should evaluate to a `color' specifier object, or a string to be
4926 passed to `make-color-instance'. If a loaded XPM file references a symbolic
4927 color called COLOR-NAME, it will display as the computed color instead.
4929 The default value of this variable defines the logical color names
4930 \"foreground\" and \"background\" to be the colors of the `default' face.
4932 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
4933 #endif /* HAVE_XPM */
4938 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /*
4939 Whether animated pixmaps should be animated.
4942 disable_animated_pixmaps = 0;
4946 specifier_vars_of_glyphs (void)
4948 /* #### Can we GC here? The set_specifier_* calls definitely need */
4950 /* display tables */
4952 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
4953 *The display table currently in use.
4954 This is a specifier; use `set-specifier' to change it.
4955 The display table is a vector created with `make-display-table'.
4956 The 256 elements control how to display each possible text character.
4957 Each value should be a string, a glyph, a vector or nil.
4958 If a value is a vector it must be composed only of strings and glyphs.
4959 nil means display the character in the default fashion.
4960 Faces can have their own, overriding display table.
4962 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
4963 set_specifier_fallback (Vcurrent_display_table,
4964 list1 (Fcons (Qnil, Qnil)));
4965 set_specifier_caching (Vcurrent_display_table,
4966 offsetof (struct window, display_table),
4967 some_window_value_changed,
4972 complex_vars_of_glyphs (void)
4974 /* Partially initialized in glyphs-x.c, glyphs.el */
4975 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
4976 What to display at the end of truncated lines.
4978 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4980 /* Partially initialized in glyphs-x.c, glyphs.el */
4981 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
4982 What to display at the end of wrapped lines.
4984 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4986 /* Partially initialized in glyphs-x.c, glyphs.el */
4987 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
4988 The glyph used to display the XEmacs logo at startup.
4990 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);