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 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));
645 mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i));
646 mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i));
647 mark_object (IMAGE_INSTANCE_WIDGET_FACE (i));
648 mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i));
649 case IMAGE_SUBWINDOW:
650 mark_object (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
657 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i));
663 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
667 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
670 error ("printing unreadable object #<image-instance 0x%x>",
672 write_c_string ("#<image-instance (", printcharfun);
673 print_internal (Fimage_instance_type (obj), printcharfun, 0);
674 write_c_string (") ", printcharfun);
675 if (!NILP (ii->name))
677 print_internal (ii->name, printcharfun, 1);
678 write_c_string (" ", printcharfun);
680 write_c_string ("on ", printcharfun);
681 print_internal (ii->device, printcharfun, 0);
682 write_c_string (" ", printcharfun);
683 switch (IMAGE_INSTANCE_TYPE (ii))
689 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
692 case IMAGE_MONO_PIXMAP:
693 case IMAGE_COLOR_PIXMAP:
695 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
698 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
699 s = strrchr ((char *) XSTRING_DATA (filename), '/');
701 print_internal (build_string (s + 1), printcharfun, 1);
703 print_internal (filename, printcharfun, 1);
705 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
706 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
707 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
708 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
710 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
711 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
712 write_c_string (buf, printcharfun);
713 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
714 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
716 write_c_string (" @", printcharfun);
717 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
719 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
720 write_c_string (buf, printcharfun);
723 write_c_string ("??", printcharfun);
724 write_c_string (",", printcharfun);
725 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
727 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
728 write_c_string (buf, printcharfun);
731 write_c_string ("??", printcharfun);
733 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
734 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
736 write_c_string (" (", printcharfun);
737 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
741 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
743 write_c_string ("/", printcharfun);
744 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
748 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
750 write_c_string (")", printcharfun);
755 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
757 write_c_string (" (", printcharfun);
759 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
760 write_c_string (")", printcharfun);
763 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
764 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0);
766 case IMAGE_SUBWINDOW:
768 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
769 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
770 write_c_string (buf, printcharfun);
772 /* This is stolen from frame.c. Subwindows are strange in that they
773 are specific to a particular frame so we want to print in their
774 description what that frame is. */
776 write_c_string (" on #<", printcharfun);
778 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
780 if (!FRAME_LIVE_P (f))
781 write_c_string ("dead", printcharfun);
783 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
786 write_c_string ("-frame ", printcharfun);
788 write_c_string (">", printcharfun);
789 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
790 write_c_string (buf, printcharfun);
798 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
799 (ii, printcharfun, escapeflag));
800 sprintf (buf, " 0x%x>", ii->header.uid);
801 write_c_string (buf, printcharfun);
805 finalize_image_instance (void *header, int for_disksave)
807 Lisp_Image_Instance *i = (Lisp_Image_Instance *) header;
809 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
810 /* objects like this exist at dump time, so don't bomb out. */
812 if (for_disksave) finalose (i);
814 /* do this so that the cachels get reset */
815 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
817 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
819 MARK_FRAME_SUBWINDOWS_CHANGED
820 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
823 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
827 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
829 Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
830 Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
831 struct device *d1 = XDEVICE (i1->device);
832 struct device *d2 = XDEVICE (i2->device);
836 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)
837 || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2)
838 || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2)
839 || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2)
840 || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (i2))
842 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
846 switch (IMAGE_INSTANCE_TYPE (i1))
852 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
853 IMAGE_INSTANCE_TEXT_STRING (i2),
858 case IMAGE_MONO_PIXMAP:
859 case IMAGE_COLOR_PIXMAP:
861 if (!(IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
862 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
863 IMAGE_INSTANCE_PIXMAP_SLICE (i1) ==
864 IMAGE_INSTANCE_PIXMAP_SLICE (i2) &&
865 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
866 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
867 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
868 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
869 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
870 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
872 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
873 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
880 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
881 IMAGE_INSTANCE_WIDGET_TYPE (i2))
882 && IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
883 IMAGE_INSTANCE_SUBWINDOW_ID (i2)
884 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1),
885 IMAGE_INSTANCE_WIDGET_ITEMS (i2),
887 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
888 IMAGE_INSTANCE_WIDGET_PROPS (i2),
894 case IMAGE_SUBWINDOW:
895 if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
896 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
904 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
908 image_instance_hash (Lisp_Object obj, int depth)
910 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
911 struct device *d = XDEVICE (i->device);
912 unsigned long hash = HASH3 ((unsigned long) d,
913 IMAGE_INSTANCE_WIDTH (i),
914 IMAGE_INSTANCE_HEIGHT (i));
916 switch (IMAGE_INSTANCE_TYPE (i))
922 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
926 case IMAGE_MONO_PIXMAP:
927 case IMAGE_COLOR_PIXMAP:
929 hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i),
930 IMAGE_INSTANCE_PIXMAP_SLICE (i),
931 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
938 internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1),
939 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
940 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1));
941 case IMAGE_SUBWINDOW:
942 hash = HASH2 (hash, (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
949 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
953 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
954 mark_image_instance, print_image_instance,
955 finalize_image_instance, image_instance_equal,
956 image_instance_hash, 0,
957 Lisp_Image_Instance);
960 allocate_image_instance (Lisp_Object device, Lisp_Object glyph)
962 Lisp_Image_Instance *lp =
963 alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance);
968 lp->type = IMAGE_NOTHING;
975 MARK_IMAGE_INSTANCE_CHANGED (lp); /* So that layouts get done. */
976 XSETIMAGE_INSTANCE (val, lp);
977 MARK_GLYPHS_CHANGED; /* So that the dirty flag gets reset. */
981 static enum image_instance_type
982 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
984 if (ERRB_EQ (errb, ERROR_ME))
987 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
988 if (EQ (type, Qtext)) return IMAGE_TEXT;
989 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
990 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
991 if (EQ (type, Qpointer)) return IMAGE_POINTER;
992 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
993 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
994 if (EQ (type, Qlayout)) return IMAGE_LAYOUT;
996 maybe_signal_simple_error ("Invalid image-instance type", type,
999 return IMAGE_UNKNOWN; /* not reached */
1003 encode_image_instance_type (enum image_instance_type type)
1007 case IMAGE_NOTHING: return Qnothing;
1008 case IMAGE_TEXT: return Qtext;
1009 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
1010 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
1011 case IMAGE_POINTER: return Qpointer;
1012 case IMAGE_SUBWINDOW: return Qsubwindow;
1013 case IMAGE_WIDGET: return Qwidget;
1014 case IMAGE_LAYOUT: return Qlayout;
1019 return Qnil; /* not reached */
1023 image_instance_type_to_mask (enum image_instance_type type)
1025 /* This depends on the fact that enums are assigned consecutive
1026 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
1027 first enum.) I'm fairly sure this behavior is ANSI-mandated,
1028 so there should be no portability problems here. */
1029 return (1 << ((int) (type) - 1));
1033 decode_image_instance_type_list (Lisp_Object list)
1043 enum image_instance_type type =
1044 decode_image_instance_type (list, ERROR_ME);
1045 return image_instance_type_to_mask (type);
1048 EXTERNAL_LIST_LOOP (rest, list)
1050 enum image_instance_type type =
1051 decode_image_instance_type (XCAR (rest), ERROR_ME);
1052 mask |= image_instance_type_to_mask (type);
1059 encode_image_instance_type_list (int mask)
1062 Lisp_Object result = Qnil;
1068 result = Fcons (encode_image_instance_type
1069 ((enum image_instance_type) count), result);
1073 return Fnreverse (result);
1077 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1078 int desired_dest_mask)
1083 (emacs_doprnt_string_lisp_2
1085 "No compatible image-instance types given: wanted one of %s, got %s",
1087 encode_image_instance_type_list (desired_dest_mask),
1088 encode_image_instance_type_list (given_dest_mask)),
1093 valid_image_instance_type_p (Lisp_Object type)
1095 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1098 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1099 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1100 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1101 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1103 (image_instance_type))
1105 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1108 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1109 Return a list of valid image-instance types.
1113 return Fcopy_sequence (Vimage_instance_type_list);
1117 decode_error_behavior_flag (Lisp_Object no_error)
1119 if (NILP (no_error)) return ERROR_ME;
1120 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1121 else return ERROR_ME_WARN;
1125 encode_error_behavior_flag (Error_behavior errb)
1127 if (ERRB_EQ (errb, ERROR_ME))
1129 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1133 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1139 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1140 Lisp_Object dest_types)
1143 struct gcpro gcpro1;
1146 XSETDEVICE (device, decode_device (device));
1147 /* instantiate_image_instantiator() will abort if given an
1148 image instance ... */
1149 if (IMAGE_INSTANCEP (data))
1150 signal_simple_error ("Image instances not allowed here", data);
1151 image_validate (data);
1152 dest_mask = decode_image_instance_type_list (dest_types);
1153 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1154 make_int (dest_mask));
1156 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1157 signal_simple_error ("Inheritance not allowed here", data);
1158 ii = instantiate_image_instantiator (device, device, data,
1159 Qnil, Qnil, dest_mask, Qnil);
1160 RETURN_UNGCPRO (ii);
1163 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1164 Return a new `image-instance' object.
1166 Image-instance objects encapsulate the way a particular image (pixmap,
1167 etc.) is displayed on a particular device. In most circumstances, you
1168 do not need to directly create image instances; use a glyph instead.
1169 However, it may occasionally be useful to explicitly create image
1170 instances, if you want more control over the instantiation process.
1172 DATA is an image instantiator, which describes the image; see
1173 `image-specifier-p' for a description of the allowed values.
1175 DEST-TYPES should be a list of allowed image instance types that can
1176 be generated. The recognized image instance types are
1179 Nothing is displayed.
1181 Displayed as text. The foreground and background colors and the
1182 font of the text are specified independent of the pixmap. Typically
1183 these attributes will come from the face of the surrounding text,
1184 unless a face is specified for the glyph in which the image appears.
1186 Displayed as a mono pixmap (a pixmap with only two colors where the
1187 foreground and background can be specified independent of the pixmap;
1188 typically the pixmap assumes the foreground and background colors of
1189 the text around it, unless a face is specified for the glyph in which
1192 Displayed as a color pixmap.
1194 Used as the mouse pointer for a window.
1196 A child window that is treated as an image. This allows (e.g.)
1197 another program to be responsible for drawing into the window.
1199 A child window that contains a window-system widget, e.g. a push
1202 The DEST-TYPES list is unordered. If multiple destination types
1203 are possible for a given instantiator, the "most natural" type
1204 for the instantiator's format is chosen. (For XBM, the most natural
1205 types are `mono-pixmap', followed by `color-pixmap', followed by
1206 `pointer'. For the other normal image formats, the most natural
1207 types are `color-pixmap', followed by `mono-pixmap', followed by
1208 `pointer'. For the string and formatted-string formats, the most
1209 natural types are `text', followed by `mono-pixmap' (not currently
1210 implemented), followed by `color-pixmap' (not currently implemented).
1211 The other formats can only be instantiated as one type. (If you
1212 want to control more specifically the order of the types into which
1213 an image is instantiated, just call `make-image-instance' repeatedly
1214 until it succeeds, passing less and less preferred destination types
1217 If DEST-TYPES is omitted, all possible types are allowed.
1219 NO-ERROR controls what happens when the image cannot be generated.
1220 If nil, an error message is generated. If t, no messages are
1221 generated and this function returns nil. If anything else, a warning
1222 message is generated and this function returns nil.
1224 (data, device, dest_types, no_error))
1226 Error_behavior errb = decode_error_behavior_flag (no_error);
1228 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1230 3, data, device, dest_types);
1233 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1234 Return non-nil if OBJECT is an image instance.
1238 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1241 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1242 Return the type of the given image instance.
1243 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1244 'color-pixmap, 'pointer, or 'subwindow.
1248 CHECK_IMAGE_INSTANCE (image_instance);
1249 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1252 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1253 Return the name of the given image instance.
1257 CHECK_IMAGE_INSTANCE (image_instance);
1258 return XIMAGE_INSTANCE_NAME (image_instance);
1261 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1262 Return the string of the given image instance.
1263 This will only be non-nil for text image instances and widgets.
1267 CHECK_IMAGE_INSTANCE (image_instance);
1268 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1269 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1270 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1271 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1276 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1277 Return the given property of the given image instance.
1278 Returns nil if the property or the property method do not exist for
1279 the image instance in the domain.
1281 (image_instance, prop))
1283 Lisp_Image_Instance* ii;
1284 Lisp_Object type, ret;
1285 struct image_instantiator_methods* meths;
1287 CHECK_IMAGE_INSTANCE (image_instance);
1288 CHECK_SYMBOL (prop);
1289 ii = XIMAGE_INSTANCE (image_instance);
1291 /* ... then try device specific methods ... */
1292 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1293 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1294 type, ERROR_ME_NOT);
1295 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1297 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1301 /* ... then format specific methods ... */
1302 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1303 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1305 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1313 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1314 Set the given property of the given image instance.
1315 Does nothing if the property or the property method do not exist for
1316 the image instance in the domain.
1318 (image_instance, prop, val))
1320 Lisp_Image_Instance* ii;
1321 Lisp_Object type, ret;
1322 struct image_instantiator_methods* meths;
1324 CHECK_IMAGE_INSTANCE (image_instance);
1325 CHECK_SYMBOL (prop);
1326 ii = XIMAGE_INSTANCE (image_instance);
1327 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1328 /* try device specific methods first ... */
1329 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1330 type, ERROR_ME_NOT);
1331 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1334 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1340 /* ... then format specific methods ... */
1341 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1342 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1345 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1355 /* Make sure the image instance gets redisplayed.
1357 ### This currently does not change the dirty state of an
1358 enclosing layout which may be bad. */
1359 MARK_IMAGE_INSTANCE_CHANGED (ii);
1360 MARK_SUBWINDOWS_STATE_CHANGED;
1361 MARK_GLYPHS_CHANGED;
1366 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1367 Return the file name from which IMAGE-INSTANCE was read, if known.
1371 CHECK_IMAGE_INSTANCE (image_instance);
1373 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1375 case IMAGE_MONO_PIXMAP:
1376 case IMAGE_COLOR_PIXMAP:
1378 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1385 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1386 Return the file name from which IMAGE-INSTANCE's mask 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_MASK_FILENAME (image_instance);
1404 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1405 Return the depth of the image instance.
1406 This is 0 for a bitmap, or a positive integer for a pixmap.
1410 CHECK_IMAGE_INSTANCE (image_instance);
1412 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1414 case IMAGE_MONO_PIXMAP:
1415 case IMAGE_COLOR_PIXMAP:
1417 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1424 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1425 Return the height of the image instance, in pixels.
1429 CHECK_IMAGE_INSTANCE (image_instance);
1431 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1433 case IMAGE_MONO_PIXMAP:
1434 case IMAGE_COLOR_PIXMAP:
1436 case IMAGE_SUBWINDOW:
1439 return make_int (XIMAGE_INSTANCE_HEIGHT (image_instance));
1446 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1447 Return the width of the image instance, in pixels.
1451 CHECK_IMAGE_INSTANCE (image_instance);
1453 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1455 case IMAGE_MONO_PIXMAP:
1456 case IMAGE_COLOR_PIXMAP:
1458 case IMAGE_SUBWINDOW:
1461 return make_int (XIMAGE_INSTANCE_WIDTH (image_instance));
1468 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1469 Return the X coordinate of the image instance's hotspot, if known.
1470 This is a point relative to the origin of the pixmap. When an image is
1471 used as a mouse pointer, the hotspot is the point on the image that sits
1472 over the location that the pointer points to. This is, for example, the
1473 tip of the arrow or the center of the crosshairs.
1474 This will always be nil for a non-pointer image instance.
1478 CHECK_IMAGE_INSTANCE (image_instance);
1480 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1482 case IMAGE_MONO_PIXMAP:
1483 case IMAGE_COLOR_PIXMAP:
1485 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1492 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1493 Return the Y coordinate of the image instance's hotspot, if known.
1494 This is a point relative to the origin of the pixmap. When an image is
1495 used as a mouse pointer, the hotspot is the point on the image that sits
1496 over the location that the pointer points to. This is, for example, the
1497 tip of the arrow or the center of the crosshairs.
1498 This will always be nil for a non-pointer image instance.
1502 CHECK_IMAGE_INSTANCE (image_instance);
1504 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1506 case IMAGE_MONO_PIXMAP:
1507 case IMAGE_COLOR_PIXMAP:
1509 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1516 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1517 Return the foreground color of IMAGE-INSTANCE, if applicable.
1518 This will be a color instance or nil. (It will only be non-nil for
1519 colorized mono pixmaps and for pointers.)
1523 CHECK_IMAGE_INSTANCE (image_instance);
1525 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1527 case IMAGE_MONO_PIXMAP:
1528 case IMAGE_COLOR_PIXMAP:
1530 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1533 return FACE_FOREGROUND (
1534 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1535 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1543 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1544 Return the background color of IMAGE-INSTANCE, if applicable.
1545 This will be a color instance or nil. (It will only be non-nil for
1546 colorized mono pixmaps and for pointers.)
1550 CHECK_IMAGE_INSTANCE (image_instance);
1552 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1554 case IMAGE_MONO_PIXMAP:
1555 case IMAGE_COLOR_PIXMAP:
1557 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1560 return FACE_BACKGROUND (
1561 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1562 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1571 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1572 Make the image instance be displayed in the given colors.
1573 This function returns a new image instance that is exactly like the
1574 specified one except that (if possible) the foreground and background
1575 colors and as specified. Currently, this only does anything if the image
1576 instance is a mono pixmap; otherwise, the same image instance is returned.
1578 (image_instance, foreground, background))
1583 CHECK_IMAGE_INSTANCE (image_instance);
1584 CHECK_COLOR_INSTANCE (foreground);
1585 CHECK_COLOR_INSTANCE (background);
1587 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1588 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1589 return image_instance;
1591 /* #### There should be a copy_image_instance(), which calls a
1592 device-specific method to copy the window-system subobject. */
1593 new = allocate_image_instance (device, Qnil);
1594 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1595 /* note that if this method returns non-zero, this method MUST
1596 copy any window-system resources, so that when one image instance is
1597 freed, the other one is not hosed. */
1598 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1600 return image_instance;
1605 /************************************************************************/
1606 /* Geometry calculations */
1607 /************************************************************************/
1609 /* Find out desired geometry of the image instance. If there is no
1610 special function then just return the width and / or height. */
1612 image_instance_query_geometry (Lisp_Object image_instance,
1613 unsigned int* width, unsigned int* height,
1614 enum image_instance_geometry disp,
1617 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1619 struct image_instantiator_methods* meths;
1621 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1622 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1624 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1626 IIFORMAT_METH (meths, query_geometry, (image_instance, width, height,
1632 *width = IMAGE_INSTANCE_WIDTH (ii);
1634 *height = IMAGE_INSTANCE_HEIGHT (ii);
1638 /* Layout the image instance using the provided dimensions. Layout
1639 widgets are going to do different kinds of calculations to
1640 determine what size to give things so we could make the layout
1641 function relatively simple to take account of that. An alternative
1642 approach is to consider separately the two cases, one where you
1643 don't mind what size you have (normal widgets) and one where you
1644 want to specifiy something (layout widgets). */
1646 image_instance_layout (Lisp_Object image_instance,
1647 unsigned int width, unsigned int height,
1650 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1652 struct image_instantiator_methods* meths;
1654 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1655 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1657 /* If geometry is unspecified then get some reasonable values for it. */
1658 if (width == IMAGE_UNSPECIFIED_GEOMETRY
1660 height == IMAGE_UNSPECIFIED_GEOMETRY)
1662 unsigned int dwidth, dheight;
1664 /* Get the desired geometry. */
1665 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1667 IIFORMAT_METH (meths, query_geometry, (image_instance, &dwidth, &dheight,
1668 IMAGE_DESIRED_GEOMETRY,
1673 dwidth = IMAGE_INSTANCE_WIDTH (ii);
1674 dheight = IMAGE_INSTANCE_HEIGHT (ii);
1677 /* Compare with allowed geometry. */
1678 if (width == IMAGE_UNSPECIFIED_GEOMETRY)
1680 if (height == IMAGE_UNSPECIFIED_GEOMETRY)
1684 /* At this point width and height should contain sane values. Thus
1685 we set the glyph geometry and lay it out. */
1686 IMAGE_INSTANCE_WIDTH (ii) = width;
1687 IMAGE_INSTANCE_HEIGHT (ii) = height;
1689 if (meths && HAS_IIFORMAT_METH_P (meths, layout))
1691 IIFORMAT_METH (meths, layout, (image_instance, width, height, domain));
1693 /* else no change to the geometry. */
1695 XIMAGE_INSTANCE_DIRTYP (image_instance) = 0;
1699 * Mark image instance in W as dirty if (a) W's faces have changed and
1700 * (b) GLYPH_OR_II instance in W is a string.
1702 * Return non-zero if instance has been marked dirty.
1705 invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w)
1707 if (XFRAME(WINDOW_FRAME(w))->faces_changed)
1709 Lisp_Object image = glyph_or_ii;
1711 if (GLYPHP (glyph_or_ii))
1714 XSETWINDOW (window, w);
1715 image = glyph_image_instance (glyph_or_ii, window, ERROR_ME_NOT, 1);
1718 if (TEXT_IMAGE_INSTANCEP (image))
1720 XIMAGE_INSTANCE_DIRTYP (image) = 1;
1721 if (GLYPHP (glyph_or_ii))
1722 XGLYPH_DIRTYP (glyph_or_ii) = 1;
1731 /************************************************************************/
1733 /************************************************************************/
1735 signal_image_error (CONST char *reason, Lisp_Object frob)
1737 signal_error (Qimage_conversion_error,
1738 list2 (build_translated_string (reason), frob));
1742 signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1)
1744 signal_error (Qimage_conversion_error,
1745 list3 (build_translated_string (reason), frob0, frob1));
1748 /****************************************************************************
1750 ****************************************************************************/
1753 nothing_possible_dest_types (void)
1755 return IMAGE_NOTHING_MASK;
1759 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1760 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1761 int dest_mask, Lisp_Object domain)
1763 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1765 if (dest_mask & IMAGE_NOTHING_MASK)
1766 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1768 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1772 /****************************************************************************
1774 ****************************************************************************/
1777 inherit_validate (Lisp_Object instantiator)
1779 face_must_be_present (instantiator);
1783 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1787 assert (XVECTOR_LENGTH (inst) == 3);
1788 face = XVECTOR_DATA (inst)[2];
1790 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1795 inherit_possible_dest_types (void)
1797 return IMAGE_MONO_PIXMAP_MASK;
1801 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1802 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1803 int dest_mask, Lisp_Object domain)
1805 /* handled specially in image_instantiate */
1810 /****************************************************************************
1812 ****************************************************************************/
1815 string_validate (Lisp_Object instantiator)
1817 data_must_be_present (instantiator);
1821 string_possible_dest_types (void)
1823 return IMAGE_TEXT_MASK;
1826 /* Called from autodetect_instantiate() */
1828 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1829 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1830 int dest_mask, Lisp_Object domain)
1832 Lisp_Object string = find_keyword_in_vector (instantiator, Q_data);
1833 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1835 /* Should never get here with a domain other than a window. */
1836 assert (!NILP (string) && WINDOWP (domain));
1837 if (dest_mask & IMAGE_TEXT_MASK)
1839 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1840 IMAGE_INSTANCE_TEXT_STRING (ii) = string;
1843 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1846 /* Sort out the size of the text that is being displayed. Calculating
1847 it dynamically allows us to change the text and still see
1848 everything. Note that the following methods are for text not string
1849 since that is what the instantiated type is. The first method is a
1850 helper that is used elsewhere for calculating text geometry. */
1852 query_string_geometry (Lisp_Object string, Lisp_Object face,
1853 unsigned int* width, unsigned int* height,
1854 unsigned int* descent, Lisp_Object domain)
1856 struct font_metric_info fm;
1857 unsigned char charsets[NUM_LEADING_BYTES];
1858 struct face_cachel frame_cachel;
1859 struct face_cachel *cachel;
1860 Lisp_Object frame = FW_FRAME (domain);
1862 /* Compute height */
1865 /* Compute string metric info */
1866 find_charsets_in_bufbyte_string (charsets,
1867 XSTRING_DATA (string),
1868 XSTRING_LENGTH (string));
1870 /* Fallback to the default face if none was provided. */
1873 reset_face_cachel (&frame_cachel);
1874 update_face_cachel_data (&frame_cachel, frame, face);
1875 cachel = &frame_cachel;
1879 cachel = WINDOW_FACE_CACHEL (XWINDOW (domain), DEFAULT_INDEX);
1882 ensure_face_cachel_complete (cachel, domain, charsets);
1883 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
1885 *height = fm.ascent + fm.descent;
1886 /* #### descent only gets set if we query the height as well. */
1888 *descent = fm.descent;
1895 *width = redisplay_frame_text_width_string (XFRAME (frame),
1899 *width = redisplay_frame_text_width_string (XFRAME (frame),
1906 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain)
1908 unsigned char charsets[NUM_LEADING_BYTES];
1909 struct face_cachel frame_cachel;
1910 struct face_cachel *cachel;
1912 Lisp_Object frame = FW_FRAME (domain);
1914 /* Compute string font info */
1915 find_charsets_in_bufbyte_string (charsets,
1916 XSTRING_DATA (string),
1917 XSTRING_LENGTH (string));
1919 reset_face_cachel (&frame_cachel);
1920 update_face_cachel_data (&frame_cachel, frame, face);
1921 cachel = &frame_cachel;
1923 ensure_face_cachel_complete (cachel, domain, charsets);
1925 for (i = 0; i < NUM_LEADING_BYTES; i++)
1929 return FACE_CACHEL_FONT (cachel,
1930 CHARSET_BY_LEADING_BYTE (i +
1936 return Qnil; /* NOT REACHED */
1940 text_query_geometry (Lisp_Object image_instance,
1941 unsigned int* width, unsigned int* height,
1942 enum image_instance_geometry disp, Lisp_Object domain)
1944 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1945 unsigned int descent = 0;
1947 query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii),
1948 IMAGE_INSTANCE_FACE (ii),
1949 width, height, &descent, domain);
1951 /* The descent gets set as a side effect of querying the
1953 IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent;
1956 /* set the properties of a string */
1958 text_set_property (Lisp_Object image_instance, Lisp_Object prop,
1961 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1963 if (EQ (prop, Q_data))
1966 IMAGE_INSTANCE_TEXT_STRING (ii) = val;
1974 /****************************************************************************
1975 * formatted-string *
1976 ****************************************************************************/
1979 formatted_string_validate (Lisp_Object instantiator)
1981 data_must_be_present (instantiator);
1985 formatted_string_possible_dest_types (void)
1987 return IMAGE_TEXT_MASK;
1991 formatted_string_instantiate (Lisp_Object image_instance,
1992 Lisp_Object instantiator,
1993 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1994 int dest_mask, Lisp_Object domain)
1996 /* #### implement this */
1997 warn_when_safe (Qunimplemented, Qnotice,
1998 "`formatted-string' not yet implemented; assuming `string'");
2000 string_instantiate (image_instance, instantiator,
2001 pointer_fg, pointer_bg, dest_mask, domain);
2005 /************************************************************************/
2006 /* pixmap file functions */
2007 /************************************************************************/
2009 /* If INSTANTIATOR refers to inline data, return Qnil.
2010 If INSTANTIATOR refers to data in a file, return the full filename
2011 if it exists; otherwise, return a cons of (filename).
2013 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
2014 keywords used to look up the file and inline data,
2015 respectively, in the instantiator. Normally these would
2016 be Q_file and Q_data, but might be different for mask data. */
2019 potential_pixmap_file_instantiator (Lisp_Object instantiator,
2020 Lisp_Object file_keyword,
2021 Lisp_Object data_keyword,
2022 Lisp_Object console_type)
2027 assert (VECTORP (instantiator));
2029 data = find_keyword_in_vector (instantiator, data_keyword);
2030 file = find_keyword_in_vector (instantiator, file_keyword);
2032 if (!NILP (file) && NILP (data))
2034 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
2035 (decode_console_type(console_type, ERROR_ME),
2036 locate_pixmap_file, (file));
2041 return Fcons (file, Qnil); /* should have been file */
2048 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
2049 Lisp_Object image_type_tag)
2051 /* This function can call lisp */
2052 Lisp_Object file = Qnil;
2053 struct gcpro gcpro1, gcpro2;
2054 Lisp_Object alist = Qnil;
2056 GCPRO2 (file, alist);
2058 /* Now, convert any file data into inline data. At the end of this,
2059 `data' will contain the inline data (if any) or Qnil, and `file'
2060 will contain the name this data was derived from (if known) or
2063 Note that if we cannot generate any regular inline data, we
2066 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2069 if (CONSP (file)) /* failure locating filename */
2070 signal_double_file_error ("Opening pixmap file",
2071 "no such file or directory",
2074 if (NILP (file)) /* no conversion necessary */
2075 RETURN_UNGCPRO (inst);
2077 alist = tagged_vector_to_alist (inst);
2080 Lisp_Object data = make_string_from_file (file);
2081 alist = remassq_no_quit (Q_file, alist);
2082 /* there can't be a :data at this point. */
2083 alist = Fcons (Fcons (Q_file, file),
2084 Fcons (Fcons (Q_data, data), alist));
2088 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
2090 RETURN_UNGCPRO (result);
2095 #ifdef HAVE_WINDOW_SYSTEM
2096 /**********************************************************************
2098 **********************************************************************/
2100 /* Check if DATA represents a valid inline XBM spec (i.e. a list
2101 of (width height bits), with checking done on the dimensions).
2102 If not, signal an error. */
2105 check_valid_xbm_inline (Lisp_Object data)
2107 Lisp_Object width, height, bits;
2109 if (!CONSP (data) ||
2110 !CONSP (XCDR (data)) ||
2111 !CONSP (XCDR (XCDR (data))) ||
2112 !NILP (XCDR (XCDR (XCDR (data)))))
2113 signal_simple_error ("Must be list of 3 elements", data);
2115 width = XCAR (data);
2116 height = XCAR (XCDR (data));
2117 bits = XCAR (XCDR (XCDR (data)));
2119 CHECK_STRING (bits);
2121 if (!NATNUMP (width))
2122 signal_simple_error ("Width must be a natural number", width);
2124 if (!NATNUMP (height))
2125 signal_simple_error ("Height must be a natural number", height);
2127 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
2128 signal_simple_error ("data is too short for width and height",
2129 vector3 (width, height, bits));
2132 /* Validate method for XBM's. */
2135 xbm_validate (Lisp_Object instantiator)
2137 file_or_data_must_be_present (instantiator);
2140 /* Given a filename that is supposed to contain XBM data, return
2141 the inline representation of it as (width height bits). Return
2142 the hotspot through XHOT and YHOT, if those pointers are not 0.
2143 If there is no hotspot, XHOT and YHOT will contain -1.
2145 If the function fails:
2147 -- if OK_IF_DATA_INVALID is set and the data was invalid,
2149 -- maybe return an error, or return Qnil.
2152 #ifdef HAVE_X_WINDOWS
2153 #include <X11/Xlib.h>
2155 #define XFree(data) free(data)
2159 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
2160 int ok_if_data_invalid)
2165 CONST char *filename_ext;
2167 TO_EXTERNAL_FORMAT (LISP_STRING, name,
2168 C_STRING_ALLOCA, filename_ext,
2170 result = read_bitmap_data_from_file (filename_ext, &w, &h,
2173 if (result == BitmapSuccess)
2176 int len = (w + 7) / 8 * h;
2178 retval = list3 (make_int (w), make_int (h),
2179 make_ext_string (data, len, Qbinary));
2180 XFree ((char *) data);
2186 case BitmapOpenFailed:
2188 /* should never happen */
2189 signal_double_file_error ("Opening bitmap file",
2190 "no such file or directory",
2193 case BitmapFileInvalid:
2195 if (ok_if_data_invalid)
2197 signal_double_file_error ("Reading bitmap file",
2198 "invalid data in file",
2201 case BitmapNoMemory:
2203 signal_double_file_error ("Reading bitmap file",
2209 signal_double_file_error_2 ("Reading bitmap file",
2210 "unknown error code",
2211 make_int (result), name);
2215 return Qnil; /* not reached */
2219 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2220 Lisp_Object mask_file, Lisp_Object console_type)
2222 /* This is unclean but it's fairly standard -- a number of the
2223 bitmaps in /usr/include/X11/bitmaps use it -- so we support
2225 if (NILP (mask_file)
2226 /* don't override explicitly specified mask data. */
2227 && NILP (assq_no_quit (Q_mask_data, alist))
2230 mask_file = MAYBE_LISP_CONTYPE_METH
2231 (decode_console_type(console_type, ERROR_ME),
2232 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
2233 if (NILP (mask_file))
2234 mask_file = MAYBE_LISP_CONTYPE_METH
2235 (decode_console_type(console_type, ERROR_ME),
2236 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
2239 if (!NILP (mask_file))
2241 Lisp_Object mask_data =
2242 bitmap_to_lisp_data (mask_file, 0, 0, 0);
2243 alist = remassq_no_quit (Q_mask_file, alist);
2244 /* there can't be a :mask-data at this point. */
2245 alist = Fcons (Fcons (Q_mask_file, mask_file),
2246 Fcons (Fcons (Q_mask_data, mask_data), alist));
2252 /* Normalize method for XBM's. */
2255 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
2257 Lisp_Object file = Qnil, mask_file = Qnil;
2258 struct gcpro gcpro1, gcpro2, gcpro3;
2259 Lisp_Object alist = Qnil;
2261 GCPRO3 (file, mask_file, alist);
2263 /* Now, convert any file data into inline data for both the regular
2264 data and the mask data. At the end of this, `data' will contain
2265 the inline data (if any) or Qnil, and `file' will contain
2266 the name this data was derived from (if known) or Qnil.
2267 Likewise for `mask_file' and `mask_data'.
2269 Note that if we cannot generate any regular inline data, we
2272 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2274 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2275 Q_mask_data, console_type);
2277 if (CONSP (file)) /* failure locating filename */
2278 signal_double_file_error ("Opening bitmap file",
2279 "no such file or directory",
2282 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2283 RETURN_UNGCPRO (inst);
2285 alist = tagged_vector_to_alist (inst);
2290 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
2291 alist = remassq_no_quit (Q_file, alist);
2292 /* there can't be a :data at this point. */
2293 alist = Fcons (Fcons (Q_file, file),
2294 Fcons (Fcons (Q_data, data), alist));
2296 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2297 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2299 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2300 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2304 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2307 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2309 RETURN_UNGCPRO (result);
2315 xbm_possible_dest_types (void)
2318 IMAGE_MONO_PIXMAP_MASK |
2319 IMAGE_COLOR_PIXMAP_MASK |
2327 /**********************************************************************
2329 **********************************************************************/
2332 xface_validate (Lisp_Object instantiator)
2334 file_or_data_must_be_present (instantiator);
2338 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2340 /* This function can call lisp */
2341 Lisp_Object file = Qnil, mask_file = Qnil;
2342 struct gcpro gcpro1, gcpro2, gcpro3;
2343 Lisp_Object alist = Qnil;
2345 GCPRO3 (file, mask_file, alist);
2347 /* Now, convert any file data into inline data for both the regular
2348 data and the mask data. At the end of this, `data' will contain
2349 the inline data (if any) or Qnil, and `file' will contain
2350 the name this data was derived from (if known) or Qnil.
2351 Likewise for `mask_file' and `mask_data'.
2353 Note that if we cannot generate any regular inline data, we
2356 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2358 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2359 Q_mask_data, console_type);
2361 if (CONSP (file)) /* failure locating filename */
2362 signal_double_file_error ("Opening bitmap file",
2363 "no such file or directory",
2366 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2367 RETURN_UNGCPRO (inst);
2369 alist = tagged_vector_to_alist (inst);
2372 Lisp_Object data = make_string_from_file (file);
2373 alist = remassq_no_quit (Q_file, alist);
2374 /* there can't be a :data at this point. */
2375 alist = Fcons (Fcons (Q_file, file),
2376 Fcons (Fcons (Q_data, data), alist));
2379 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2382 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2384 RETURN_UNGCPRO (result);
2389 xface_possible_dest_types (void)
2392 IMAGE_MONO_PIXMAP_MASK |
2393 IMAGE_COLOR_PIXMAP_MASK |
2397 #endif /* HAVE_XFACE */
2402 /**********************************************************************
2404 **********************************************************************/
2407 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2413 TO_EXTERNAL_FORMAT (LISP_STRING, name,
2414 C_STRING_ALLOCA, fname,
2416 result = XpmReadFileToData (fname, &data);
2418 if (result == XpmSuccess)
2420 Lisp_Object retval = Qnil;
2421 struct buffer *old_buffer = current_buffer;
2422 Lisp_Object temp_buffer =
2423 Fget_buffer_create (build_string (" *pixmap conversion*"));
2425 int height, width, ncolors;
2426 struct gcpro gcpro1, gcpro2, gcpro3;
2427 int speccount = specpdl_depth ();
2429 GCPRO3 (name, retval, temp_buffer);
2431 specbind (Qinhibit_quit, Qt);
2432 set_buffer_internal (XBUFFER (temp_buffer));
2433 Ferase_buffer (Qnil);
2435 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2436 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2438 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2439 for (elt = 0; elt <= width + ncolors; elt++)
2441 buffer_insert_c_string (current_buffer, "\"");
2442 buffer_insert_c_string (current_buffer, data[elt]);
2444 if (elt < width + ncolors)
2445 buffer_insert_c_string (current_buffer, "\",\r");
2447 buffer_insert_c_string (current_buffer, "\"};\r");
2450 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2453 set_buffer_internal (old_buffer);
2454 unbind_to (speccount, Qnil);
2456 RETURN_UNGCPRO (retval);
2461 case XpmFileInvalid:
2463 if (ok_if_data_invalid)
2465 signal_image_error ("invalid XPM data in file", name);
2469 signal_double_file_error ("Reading pixmap file",
2470 "out of memory", name);
2474 /* should never happen? */
2475 signal_double_file_error ("Opening pixmap file",
2476 "no such file or directory", name);
2480 signal_double_file_error_2 ("Parsing pixmap file",
2481 "unknown error code",
2482 make_int (result), name);
2487 return Qnil; /* not reached */
2491 check_valid_xpm_color_symbols (Lisp_Object data)
2495 for (rest = data; !NILP (rest); rest = XCDR (rest))
2497 if (!CONSP (rest) ||
2498 !CONSP (XCAR (rest)) ||
2499 !STRINGP (XCAR (XCAR (rest))) ||
2500 (!STRINGP (XCDR (XCAR (rest))) &&
2501 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2502 signal_simple_error ("Invalid color symbol alist", data);
2507 xpm_validate (Lisp_Object instantiator)
2509 file_or_data_must_be_present (instantiator);
2512 Lisp_Object Vxpm_color_symbols;
2515 evaluate_xpm_color_symbols (void)
2517 Lisp_Object rest, results = Qnil;
2518 struct gcpro gcpro1, gcpro2;
2520 GCPRO2 (rest, results);
2521 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2523 Lisp_Object name, value, cons;
2529 CHECK_STRING (name);
2530 value = XCDR (cons);
2532 value = XCAR (value);
2533 value = Feval (value);
2536 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2538 ("Result from xpm-color-symbols eval must be nil, string, or color",
2540 results = Fcons (Fcons (name, value), results);
2542 UNGCPRO; /* no more evaluation */
2547 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2549 Lisp_Object file = Qnil;
2550 Lisp_Object color_symbols;
2551 struct gcpro gcpro1, gcpro2;
2552 Lisp_Object alist = Qnil;
2554 GCPRO2 (file, alist);
2556 /* Now, convert any file data into inline data. At the end of this,
2557 `data' will contain the inline data (if any) or Qnil, and
2558 `file' will contain the name this data was derived from (if
2561 Note that if we cannot generate any regular inline data, we
2564 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2567 if (CONSP (file)) /* failure locating filename */
2568 signal_double_file_error ("Opening pixmap file",
2569 "no such file or directory",
2572 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2575 if (NILP (file) && !UNBOUNDP (color_symbols))
2576 /* no conversion necessary */
2577 RETURN_UNGCPRO (inst);
2579 alist = tagged_vector_to_alist (inst);
2583 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2584 alist = remassq_no_quit (Q_file, alist);
2585 /* there can't be a :data at this point. */
2586 alist = Fcons (Fcons (Q_file, file),
2587 Fcons (Fcons (Q_data, data), alist));
2590 if (UNBOUNDP (color_symbols))
2592 color_symbols = evaluate_xpm_color_symbols ();
2593 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2598 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2600 RETURN_UNGCPRO (result);
2605 xpm_possible_dest_types (void)
2608 IMAGE_MONO_PIXMAP_MASK |
2609 IMAGE_COLOR_PIXMAP_MASK |
2613 #endif /* HAVE_XPM */
2616 /****************************************************************************
2617 * Image Specifier Object *
2618 ****************************************************************************/
2620 DEFINE_SPECIFIER_TYPE (image);
2623 image_create (Lisp_Object obj)
2625 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2627 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2628 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2629 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2633 image_mark (Lisp_Object obj)
2635 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2637 mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
2638 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2642 image_instantiate_cache_result (Lisp_Object locative)
2644 /* locative = (instance instantiator . subtable) */
2645 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2646 free_cons (XCONS (XCDR (locative)));
2647 free_cons (XCONS (locative));
2651 /* Given a specification for an image, return an instance of
2652 the image which matches the given instantiator and which can be
2653 displayed in the given domain. */
2656 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2657 Lisp_Object domain, Lisp_Object instantiator,
2660 Lisp_Object device = DFW_DEVICE (domain);
2661 struct device *d = XDEVICE (device);
2662 Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2663 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2664 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2666 if (IMAGE_INSTANCEP (instantiator))
2668 /* make sure that the image instance's device and type are
2671 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2674 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2675 if (mask & dest_mask)
2676 return instantiator;
2678 signal_simple_error ("Type of image instance not allowed here",
2682 signal_simple_error_2 ("Wrong device for image instance",
2683 instantiator, device);
2685 else if (VECTORP (instantiator)
2686 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2688 assert (XVECTOR_LENGTH (instantiator) == 3);
2689 return (FACE_PROPERTY_INSTANCE
2690 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2691 Qbackground_pixmap, domain, 0, depth));
2695 Lisp_Object instance;
2696 Lisp_Object subtable;
2697 Lisp_Object ls3 = Qnil;
2698 Lisp_Object pointer_fg = Qnil;
2699 Lisp_Object pointer_bg = Qnil;
2703 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2704 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2705 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2708 /* First look in the hash table. */
2709 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2711 if (UNBOUNDP (subtable))
2713 /* For the image instance cache, we do comparisons with EQ rather
2714 than with EQUAL, as we do for color and font names.
2717 1) pixmap data can be very long, and thus the hashing and
2718 comparing will take awhile.
2719 2) It's not so likely that we'll run into things that are EQUAL
2720 but not EQ (that can happen a lot with faces, because their
2721 specifiers are copied around); but pixmaps tend not to be
2724 However, if the image-instance could be a pointer, we have to
2725 use EQUAL because we massaged the instantiator into a cons3
2726 also containing the foreground and background of the
2730 subtable = make_lisp_hash_table (20,
2731 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2732 : HASH_TABLE_KEY_WEAK,
2733 pointerp ? HASH_TABLE_EQUAL
2735 Fputhash (make_int (dest_mask), subtable,
2736 d->image_instance_cache);
2737 instance = Qunbound;
2741 instance = Fgethash (pointerp ? ls3 : instantiator,
2742 subtable, Qunbound);
2743 /* subwindows have a per-window cache and have to be treated
2744 differently. dest_mask can be a bitwise OR of all image
2745 types so we will only catch someone possibly trying to
2746 instantiate a subwindow type thing. Unfortunately, this
2747 will occur most of the time so this probably slows things
2748 down. But with the current design I don't see anyway
2750 if (UNBOUNDP (instance)
2752 dest_mask & (IMAGE_SUBWINDOW_MASK
2756 if (!WINDOWP (domain))
2757 signal_simple_error ("Can't instantiate text or subwindow outside a window",
2759 instance = Fgethash (instantiator,
2760 XWINDOW (domain)->subwindow_instance_cache,
2765 if (UNBOUNDP (instance))
2767 Lisp_Object locative =
2769 noseeum_cons (pointerp ? ls3 : instantiator,
2771 int speccount = specpdl_depth ();
2773 /* make sure we cache the failures, too.
2774 Use an unwind-protect to catch such errors.
2775 If we fail, the unwind-protect records nil in
2776 the hash table. If we succeed, we change the
2777 car of the locative to the resulting instance,
2778 which gets recorded instead. */
2779 record_unwind_protect (image_instantiate_cache_result,
2781 instance = instantiate_image_instantiator (device,
2784 pointer_fg, pointer_bg,
2788 Fsetcar (locative, instance);
2789 /* only after the image has been instantiated do we know
2790 whether we need to put it in the per-window image instance
2792 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2794 (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2796 if (!WINDOWP (domain))
2797 signal_simple_error ("Can't instantiate subwindow outside a window",
2800 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache );
2802 unbind_to (speccount, Qnil);
2807 if (NILP (instance))
2808 signal_simple_error ("Can't instantiate image (probably cached)",
2814 return Qnil; /* not reached */
2817 /* Validate an image instantiator. */
2820 image_validate (Lisp_Object instantiator)
2822 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2824 else if (VECTORP (instantiator))
2826 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2827 int instantiator_len = XVECTOR_LENGTH (instantiator);
2828 struct image_instantiator_methods *meths;
2829 Lisp_Object already_seen = Qnil;
2830 struct gcpro gcpro1;
2833 if (instantiator_len < 1)
2834 signal_simple_error ("Vector length must be at least 1",
2837 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2838 if (!(instantiator_len & 1))
2840 ("Must have alternating keyword/value pairs", instantiator);
2842 GCPRO1 (already_seen);
2844 for (i = 1; i < instantiator_len; i += 2)
2846 Lisp_Object keyword = elt[i];
2847 Lisp_Object value = elt[i+1];
2850 CHECK_SYMBOL (keyword);
2851 if (!SYMBOL_IS_KEYWORD (keyword))
2852 signal_simple_error ("Symbol must begin with a colon", keyword);
2854 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2855 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2858 if (j == Dynarr_length (meths->keywords))
2859 signal_simple_error ("Unrecognized keyword", keyword);
2861 if (!Dynarr_at (meths->keywords, j).multiple_p)
2863 if (!NILP (memq_no_quit (keyword, already_seen)))
2865 ("Keyword may not appear more than once", keyword);
2866 already_seen = Fcons (keyword, already_seen);
2869 (Dynarr_at (meths->keywords, j).validate) (value);
2874 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2877 signal_simple_error ("Must be string or vector", instantiator);
2881 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2883 Lisp_Object attachee =
2884 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2885 Lisp_Object property =
2886 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2887 if (FACEP (attachee))
2888 face_property_was_changed (attachee, property, locale);
2889 else if (GLYPHP (attachee))
2890 glyph_property_was_changed (attachee, property, locale);
2894 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2895 Lisp_Object property)
2897 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2899 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2900 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2904 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2905 Lisp_Object tag_set, Lisp_Object instantiator)
2907 Lisp_Object possible_console_types = Qnil;
2909 Lisp_Object retlist = Qnil;
2910 struct gcpro gcpro1, gcpro2;
2912 LIST_LOOP (rest, Vconsole_type_list)
2914 Lisp_Object contype = XCAR (rest);
2915 if (!NILP (memq_no_quit (contype, tag_set)))
2916 possible_console_types = Fcons (contype, possible_console_types);
2919 if (XINT (Flength (possible_console_types)) > 1)
2920 /* two conflicting console types specified */
2923 if (NILP (possible_console_types))
2924 possible_console_types = Vconsole_type_list;
2926 GCPRO2 (retlist, possible_console_types);
2928 LIST_LOOP (rest, possible_console_types)
2930 Lisp_Object contype = XCAR (rest);
2931 Lisp_Object newinst = call_with_suspended_errors
2932 ((lisp_fn_t) normalize_image_instantiator,
2933 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2934 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2936 if (!NILP (newinst))
2939 if (NILP (memq_no_quit (contype, tag_set)))
2940 newtag = Fcons (contype, tag_set);
2943 retlist = Fcons (Fcons (newtag, newinst), retlist);
2952 /* Copy an image instantiator. We can't use Fcopy_tree since widgets
2953 may contain circular references which would send Fcopy_tree into
2956 image_copy_vector_instantiator (Lisp_Object instantiator)
2959 struct image_instantiator_methods *meths;
2961 int instantiator_len;
2963 CHECK_VECTOR (instantiator);
2965 instantiator = Fcopy_sequence (instantiator);
2966 elt = XVECTOR_DATA (instantiator);
2967 instantiator_len = XVECTOR_LENGTH (instantiator);
2969 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2971 for (i = 1; i < instantiator_len; i += 2)
2974 Lisp_Object keyword = elt[i];
2975 Lisp_Object value = elt[i+1];
2977 /* Find the keyword entry. */
2978 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2980 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2984 /* Only copy keyword values that should be copied. */
2985 if (Dynarr_at (meths->keywords, j).copy_p
2987 (CONSP (value) || VECTORP (value)))
2989 elt [i+1] = Fcopy_tree (value, Qt);
2993 return instantiator;
2997 image_copy_instantiator (Lisp_Object arg)
3002 rest = arg = Fcopy_sequence (arg);
3003 while (CONSP (rest))
3005 Lisp_Object elt = XCAR (rest);
3007 XCAR (rest) = Fcopy_tree (elt, Qt);
3008 else if (VECTORP (elt))
3009 XCAR (rest) = image_copy_vector_instantiator (elt);
3010 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
3011 XCDR (rest) = Fcopy_tree (XCDR (rest), Qt);
3015 else if (VECTORP (arg))
3017 arg = image_copy_vector_instantiator (arg);
3022 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
3023 Return non-nil if OBJECT is an image specifier.
3025 An image specifier is used for images (pixmaps and the like). It is used
3026 to describe the actual image in a glyph. It is instanced as an image-
3029 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
3030 etc. This describes the format of the data describing the image. The
3031 resulting image instances also come in many types -- `mono-pixmap',
3032 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
3033 the image and the sorts of places it can appear. (For example, a
3034 color-pixmap image has fixed colors specified for it, while a
3035 mono-pixmap image comes in two unspecified shades "foreground" and
3036 "background" that are determined from the face of the glyph or
3037 surrounding text; a text image appears as a string of text and has an
3038 unspecified foreground, background, and font; a pointer image behaves
3039 like a mono-pixmap image but can only be used as a mouse pointer
3040 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
3041 important to keep the distinction between image instantiator format and
3042 image instance type in mind. Typically, a given image instantiator
3043 format can result in many different image instance types (for example,
3044 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
3045 whereas `cursor-font' can be instanced only as `pointer'), and a
3046 particular image instance type can be generated by many different
3047 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
3048 `gif', `jpeg', etc.).
3050 See `make-image-instance' for a more detailed discussion of image
3053 An image instantiator should be a string or a vector of the form
3055 [FORMAT :KEYWORD VALUE ...]
3057 i.e. a format symbol followed by zero or more alternating keyword-value
3058 pairs. FORMAT should be one of
3061 (Don't display anything; no keywords are valid for this.
3062 Can only be instanced as `nothing'.)
3064 (Display this image as a text string. Can only be instanced
3065 as `text', although support for instancing as `mono-pixmap'
3068 (Display this image as a text string, with replaceable fields;
3069 not currently implemented.)
3071 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
3072 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3074 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
3075 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
3077 (An X-Face bitmap, used to encode people's faces in e-mail messages;
3078 only if X-Face support was compiled into this XEmacs. Can be
3079 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3081 (A GIF87 or GIF89 image; only if GIF support was compiled into this
3082 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
3083 Can be instanced as `color-pixmap'.)
3085 (A JPEG image; only if JPEG support was compiled into this XEmacs.
3086 Can be instanced as `color-pixmap'.)
3088 (A PNG image; only if PNG support was compiled into this XEmacs.
3089 Can be instanced as `color-pixmap'.)
3091 (A TIFF image; only if TIFF support was compiled into this XEmacs.
3092 Can be instanced as `color-pixmap'.)
3094 (One of the standard cursor-font names, such as "watch" or
3095 "right_ptr" under X. Under X, this is, more specifically, any
3096 of the standard cursor names from appendix B of the Xlib manual
3097 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
3098 On other window systems, the valid names will be specific to the
3099 type of window system. Can only be instanced as `pointer'.)
3101 (A glyph from a font; i.e. the name of a font, and glyph index into it
3102 of the form "FONT fontname index [[mask-font] mask-index]".
3103 Currently can only be instanced as `pointer', although this should
3106 (An embedded windowing system window.)
3108 (A text editing widget glyph.)
3110 (A button widget glyph; either a push button, radio button or toggle button.)
3112 (A tab widget glyph; a series of user selectable tabs.)
3114 (A sliding widget glyph, for showing progress.)
3116 (A drop list of selectable items in a widget glyph, for editing text.)
3118 (A static, text-only, widget glyph; for displaying text.)
3120 (A folding widget glyph.)
3122 (XEmacs tries to guess what format the data is in. If X support
3123 exists, the data string will be checked to see if it names a filename.
3124 If so, and this filename contains XBM or XPM data, the appropriate
3125 sort of pixmap or pointer will be created. [This includes picking up
3126 any specified hotspot or associated mask file.] Otherwise, if `pointer'
3127 is one of the allowable image-instance types and the string names a
3128 valid cursor-font name, the image will be created as a pointer.
3129 Otherwise, the image will be displayed as text. If no X support
3130 exists, the image will always be displayed as text.)
3132 Inherit from the background-pixmap property of a face.
3134 The valid keywords are:
3137 (Inline data. For most formats above, this should be a string. For
3138 XBM images, this should be a list of three elements: width, height, and
3139 a string of bit data. This keyword is not valid for instantiator
3140 formats `nothing' and `inherit'.)
3142 (Data is contained in a file. The value is the name of this file.
3143 If both :data and :file are specified, the image is created from
3144 what is specified in :data and the string in :file becomes the
3145 value of the `image-instance-file-name' function when applied to
3146 the resulting image-instance. This keyword is not valid for
3147 instantiator formats `nothing', `string', `formatted-string',
3148 `cursor-font', `font', `autodetect', and `inherit'.)
3151 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
3152 allow you to explicitly specify foreground and background colors.
3153 The argument should be anything acceptable to `make-color-instance'.
3154 This will cause what would be a `mono-pixmap' to instead be colorized
3155 as a two-color color-pixmap, and specifies the foreground and/or
3156 background colors for a pointer instead of black and white.)
3158 (For `xbm' and `xface'. This specifies a mask to be used with the
3159 bitmap. The format is a list of width, height, and bits, like for
3162 (For `xbm' and `xface'. This specifies a file containing the mask data.
3163 If neither a mask file nor inline mask data is given for an XBM image,
3164 and the XBM image comes from a file, XEmacs will look for a mask file
3165 with the same name as the image file but with "Mask" or "msk"
3166 appended. For example, if you specify the XBM file "left_ptr"
3167 [usually located in "/usr/include/X11/bitmaps"], the associated
3168 mask file "left_ptrmsk" will automatically be picked up.)
3171 (For `xbm' and `xface'. These keywords specify a hotspot if the image
3172 is instantiated as a `pointer'. Note that if the XBM image file
3173 specifies a hotspot, it will automatically be picked up if no
3174 explicit hotspot is given.)
3176 (Only for `xpm'. This specifies an alist that maps strings
3177 that specify symbolic color names to the actual color to be used
3178 for that symbolic color (in the form of a string or a color-specifier
3179 object). If this is not specified, the contents of `xpm-color-symbols'
3180 are used to generate the alist.)
3182 (Only for `inherit'. This specifies the face to inherit from.
3183 For widget glyphs this also specifies the face to use for
3184 display. It defaults to gui-element-face.)
3186 Keywords accepted as menu item specs are also accepted by widget
3187 glyphs. These are `:selected', `:active', `:suffix', `:keys',
3188 `:style', `:filter', `:config', `:included', `:key-sequence',
3189 `:accelerator', `:label' and `:callback'.
3191 If instead of a vector, the instantiator is a string, it will be
3192 converted into a vector by looking it up according to the specs in the
3193 `console-type-image-conversion-list' (q.v.) for the console type of
3194 the domain (usually a window; sometimes a frame or device) over which
3195 the image is being instantiated.
3197 If the instantiator specifies data from a file, the data will be read
3198 in at the time that the instantiator is added to the image (which may
3199 be well before when the image is actually displayed), and the
3200 instantiator will be converted into one of the inline-data forms, with
3201 the filename retained using a :file keyword. This implies that the
3202 file must exist when the instantiator is added to the image, but does
3203 not need to exist at any other time (e.g. it may safely be a temporary
3208 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
3212 /****************************************************************************
3214 ****************************************************************************/
3217 mark_glyph (Lisp_Object obj)
3219 Lisp_Glyph *glyph = XGLYPH (obj);
3221 mark_object (glyph->image);
3222 mark_object (glyph->contrib_p);
3223 mark_object (glyph->baseline);
3224 mark_object (glyph->face);
3226 return glyph->plist;
3230 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3232 Lisp_Glyph *glyph = XGLYPH (obj);
3236 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
3238 write_c_string ("#<glyph (", printcharfun);
3239 print_internal (Fglyph_type (obj), printcharfun, 0);
3240 write_c_string (") ", printcharfun);
3241 print_internal (glyph->image, printcharfun, 1);
3242 sprintf (buf, "0x%x>", glyph->header.uid);
3243 write_c_string (buf, printcharfun);
3246 /* Glyphs are equal if all of their display attributes are equal. We
3247 don't compare names or doc-strings, because that would make equal
3250 This isn't concerned with "unspecified" attributes, that's what
3251 #'glyph-differs-from-default-p is for. */
3253 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3255 Lisp_Glyph *g1 = XGLYPH (obj1);
3256 Lisp_Glyph *g2 = XGLYPH (obj2);
3260 return (internal_equal (g1->image, g2->image, depth) &&
3261 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
3262 internal_equal (g1->baseline, g2->baseline, depth) &&
3263 internal_equal (g1->face, g2->face, depth) &&
3264 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
3267 static unsigned long
3268 glyph_hash (Lisp_Object obj, int depth)
3272 /* No need to hash all of the elements; that would take too long.
3273 Just hash the most common ones. */
3274 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
3275 internal_hash (XGLYPH (obj)->face, depth));
3279 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
3281 Lisp_Glyph *g = XGLYPH (obj);
3283 if (EQ (prop, Qimage)) return g->image;
3284 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
3285 if (EQ (prop, Qbaseline)) return g->baseline;
3286 if (EQ (prop, Qface)) return g->face;
3288 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
3292 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3294 if (EQ (prop, Qimage) ||
3295 EQ (prop, Qcontrib_p) ||
3296 EQ (prop, Qbaseline))
3299 if (EQ (prop, Qface))
3301 XGLYPH (obj)->face = Fget_face (value);
3305 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
3310 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
3312 if (EQ (prop, Qimage) ||
3313 EQ (prop, Qcontrib_p) ||
3314 EQ (prop, Qbaseline))
3317 if (EQ (prop, Qface))
3319 XGLYPH (obj)->face = Qnil;
3323 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
3327 glyph_plist (Lisp_Object obj)
3329 Lisp_Glyph *glyph = XGLYPH (obj);
3330 Lisp_Object result = glyph->plist;
3332 result = cons3 (Qface, glyph->face, result);
3333 result = cons3 (Qbaseline, glyph->baseline, result);
3334 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
3335 result = cons3 (Qimage, glyph->image, result);
3340 static const struct lrecord_description glyph_description[] = {
3341 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) },
3342 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) },
3343 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) },
3344 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) },
3345 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) },
3349 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
3350 mark_glyph, print_glyph, 0,
3351 glyph_equal, glyph_hash, glyph_description,
3352 glyph_getprop, glyph_putprop,
3353 glyph_remprop, glyph_plist,
3357 allocate_glyph (enum glyph_type type,
3358 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
3359 Lisp_Object locale))
3361 /* This function can GC */
3362 Lisp_Object obj = Qnil;
3363 Lisp_Glyph *g = alloc_lcrecord_type (Lisp_Glyph, &lrecord_glyph);
3366 g->image = Fmake_specifier (Qimage); /* This function can GC */
3371 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3372 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
3373 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
3374 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK
3375 | IMAGE_LAYOUT_MASK;
3378 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3379 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
3382 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3383 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK
3384 | IMAGE_COLOR_PIXMAP_MASK;
3390 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
3391 /* We're getting enough reports of odd behavior in this area it seems */
3392 /* best to GCPRO everything. */
3394 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3395 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3396 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3397 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3399 GCPRO4 (obj, tem1, tem2, tem3);
3401 set_specifier_fallback (g->image, tem1);
3402 g->contrib_p = Fmake_specifier (Qboolean);
3403 set_specifier_fallback (g->contrib_p, tem2);
3404 /* #### should have a specifier for the following */
3405 g->baseline = Fmake_specifier (Qgeneric);
3406 set_specifier_fallback (g->baseline, tem3);
3409 g->after_change = after_change;
3412 set_image_attached_to (g->image, obj, Qimage);
3419 static enum glyph_type
3420 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3423 return GLYPH_BUFFER;
3425 if (ERRB_EQ (errb, ERROR_ME))
3426 CHECK_SYMBOL (type);
3428 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3429 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3430 if (EQ (type, Qicon)) return GLYPH_ICON;
3432 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3434 return GLYPH_UNKNOWN;
3438 valid_glyph_type_p (Lisp_Object type)
3440 return !NILP (memq_no_quit (type, Vglyph_type_list));
3443 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3444 Given a GLYPH-TYPE, return non-nil if it is valid.
3445 Valid types are `buffer', `pointer', and `icon'.
3449 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3452 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3453 Return a list of valid glyph types.
3457 return Fcopy_sequence (Vglyph_type_list);
3460 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3461 Create and return a new uninitialized glyph or type TYPE.
3463 TYPE specifies the type of the glyph; this should be one of `buffer',
3464 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3465 specifies in which contexts the glyph can be used, and controls the
3466 allowable image types into which the glyph's image can be
3469 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3470 extent, in the modeline, and in the toolbar. Their image can be
3471 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3474 `pointer' glyphs can be used to specify the mouse pointer. Their
3475 image can be instantiated as `pointer'.
3477 `icon' glyphs can be used to specify the icon used when a frame is
3478 iconified. Their image can be instantiated as `mono-pixmap' and
3483 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3484 return allocate_glyph (typeval, 0);
3487 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3488 Return non-nil if OBJECT is a glyph.
3490 A glyph is an object used for pixmaps and the like. It is used
3491 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3492 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3493 buttons, and the like. Its image is described using an image specifier --
3494 see `image-specifier-p'.
3498 return GLYPHP (object) ? Qt : Qnil;
3501 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3502 Return the type of the given glyph.
3503 The return value will be one of 'buffer, 'pointer, or 'icon.
3507 CHECK_GLYPH (glyph);
3508 switch (XGLYPH_TYPE (glyph))
3511 case GLYPH_BUFFER: return Qbuffer;
3512 case GLYPH_POINTER: return Qpointer;
3513 case GLYPH_ICON: return Qicon;
3518 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3519 Error_behavior errb, int no_quit)
3521 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3523 /* This can never return Qunbound. All glyphs have 'nothing as
3525 Lisp_Object image_instance = specifier_instance (specifier, Qunbound,
3526 domain, errb, no_quit, 0,
3528 assert (!UNBOUNDP (image_instance));
3530 return image_instance;
3534 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window)
3536 Lisp_Object instance = glyph_or_image;
3538 if (GLYPHP (glyph_or_image))
3539 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3544 /*****************************************************************************
3547 Return the width of the given GLYPH on the given WINDOW.
3548 Calculations are done based on recursively querying the geometry of
3549 the associated image instances.
3550 ****************************************************************************/
3552 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain)
3554 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3556 if (!IMAGE_INSTANCEP (instance))
3559 if (XIMAGE_INSTANCE_DIRTYP (instance))
3560 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3561 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3563 return XIMAGE_INSTANCE_WIDTH (instance);
3566 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3567 Return the width of GLYPH on WINDOW.
3568 This may not be exact as it does not take into account all of the context
3569 that redisplay will.
3573 XSETWINDOW (window, decode_window (window));
3574 CHECK_GLYPH (glyph);
3576 return make_int (glyph_width (glyph, window));
3580 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain)
3582 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3584 if (!IMAGE_INSTANCEP (instance))
3587 if (XIMAGE_INSTANCE_DIRTYP (instance))
3588 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3589 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3591 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3592 return XIMAGE_INSTANCE_TEXT_ASCENT (instance);
3594 return XIMAGE_INSTANCE_HEIGHT (instance);
3598 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain)
3600 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3602 if (!IMAGE_INSTANCEP (instance))
3605 if (XIMAGE_INSTANCE_DIRTYP (instance))
3606 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3607 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3609 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3610 return XIMAGE_INSTANCE_TEXT_DESCENT (instance);
3615 /* strictly a convenience function. */
3617 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain)
3619 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3622 if (!IMAGE_INSTANCEP (instance))
3625 if (XIMAGE_INSTANCE_DIRTYP (instance))
3626 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3627 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3629 return XIMAGE_INSTANCE_HEIGHT (instance);
3632 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3633 Return the ascent value of GLYPH on WINDOW.
3634 This may not be exact as it does not take into account all of the context
3635 that redisplay will.
3639 XSETWINDOW (window, decode_window (window));
3640 CHECK_GLYPH (glyph);
3642 return make_int (glyph_ascent (glyph, window));
3645 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3646 Return the descent value of GLYPH on WINDOW.
3647 This may not be exact as it does not take into account all of the context
3648 that redisplay will.
3652 XSETWINDOW (window, decode_window (window));
3653 CHECK_GLYPH (glyph);
3655 return make_int (glyph_descent (glyph, window));
3658 /* This is redundant but I bet a lot of people expect it to exist. */
3659 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3660 Return the height of GLYPH on WINDOW.
3661 This may not be exact as it does not take into account all of the context
3662 that redisplay will.
3666 XSETWINDOW (window, decode_window (window));
3667 CHECK_GLYPH (glyph);
3669 return make_int (glyph_height (glyph, window));
3673 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty)
3675 Lisp_Object instance = glyph_or_image;
3677 if (!NILP (glyph_or_image))
3679 if (GLYPHP (glyph_or_image))
3681 instance = glyph_image_instance (glyph_or_image, window,
3683 XGLYPH_DIRTYP (glyph_or_image) = dirty;
3686 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
3690 /* #### do we need to cache this info to speed things up? */
3693 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3695 if (!GLYPHP (glyph))
3699 Lisp_Object retval =
3700 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3701 /* #### look into ERROR_ME_NOT */
3702 Qunbound, domain, ERROR_ME_NOT,
3704 if (!NILP (retval) && !INTP (retval))
3706 else if (INTP (retval))
3708 if (XINT (retval) < 0)
3710 if (XINT (retval) > 100)
3711 retval = make_int (100);
3718 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3720 /* #### Domain parameter not currently used but it will be */
3721 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3725 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3727 if (!GLYPHP (glyph))
3730 return !NILP (specifier_instance_no_quit
3731 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3732 /* #### look into ERROR_ME_NOT */
3733 ERROR_ME_NOT, 0, Qzero));
3737 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3740 if (XGLYPH (glyph)->after_change)
3741 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3744 #if 0 /* Not used for now */
3746 glyph_query_geometry (Lisp_Object glyph_or_image, Lisp_Object window,
3747 unsigned int* width, unsigned int* height,
3748 enum image_instance_geometry disp, Lisp_Object domain)
3750 Lisp_Object instance = glyph_or_image;
3752 if (GLYPHP (glyph_or_image))
3753 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3755 image_instance_query_geometry (instance, width, height, disp, domain);
3759 glyph_layout (Lisp_Object glyph_or_image, Lisp_Object window,
3760 unsigned int width, unsigned int height, Lisp_Object domain)
3762 Lisp_Object instance = glyph_or_image;
3764 if (GLYPHP (glyph_or_image))
3765 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3767 image_instance_layout (instance, width, height, domain);
3772 /*****************************************************************************
3773 * glyph cachel functions *
3774 *****************************************************************************/
3777 #### All of this is 95% copied from face cachels.
3778 Consider consolidating.
3782 mark_glyph_cachels (glyph_cachel_dynarr *elements)
3789 for (elt = 0; elt < Dynarr_length (elements); elt++)
3791 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3792 mark_object (cachel->glyph);
3797 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3798 struct glyph_cachel *cachel)
3800 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)
3801 || XGLYPH_DIRTYP (cachel->glyph)
3802 || XFRAME(WINDOW_FRAME(w))->faces_changed)
3804 Lisp_Object window, instance;
3806 XSETWINDOW (window, w);
3808 cachel->glyph = glyph;
3809 /* Speed things up slightly by grabbing the glyph instantiation
3810 and passing it to the size functions. */
3811 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3813 /* Mark text instance of the glyph dirty if faces have changed,
3814 because its geometry might have changed. */
3815 invalidate_glyph_geometry_maybe (instance, w);
3817 /* #### Do the following 2 lines buy us anything? --kkm */
3818 XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance);
3819 cachel->dirty = XGLYPH_DIRTYP (glyph);
3820 cachel->width = glyph_width (instance, window);
3821 cachel->ascent = glyph_ascent (instance, window);
3822 cachel->descent = glyph_descent (instance, window);
3825 cachel->updated = 1;
3829 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3831 struct glyph_cachel new_cachel;
3834 new_cachel.glyph = Qnil;
3836 update_glyph_cachel_data (w, glyph, &new_cachel);
3837 Dynarr_add (w->glyph_cachels, new_cachel);
3841 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3848 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3850 struct glyph_cachel *cachel =
3851 Dynarr_atp (w->glyph_cachels, elt);
3853 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3855 update_glyph_cachel_data (w, glyph, cachel);
3860 /* If we didn't find the glyph, add it and then return its index. */
3861 add_glyph_cachel (w, glyph);
3866 reset_glyph_cachels (struct window *w)
3868 Dynarr_reset (w->glyph_cachels);
3869 get_glyph_cachel_index (w, Vcontinuation_glyph);
3870 get_glyph_cachel_index (w, Vtruncation_glyph);
3871 get_glyph_cachel_index (w, Vhscroll_glyph);
3872 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3873 get_glyph_cachel_index (w, Voctal_escape_glyph);
3874 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3878 mark_glyph_cachels_as_not_updated (struct window *w)
3882 /* We need to have a dirty flag to tell if the glyph has changed.
3883 We can check to see if each glyph variable is actually a
3884 completely different glyph, though. */
3885 #define FROB(glyph_obj, gindex) \
3886 update_glyph_cachel_data (w, glyph_obj, \
3887 Dynarr_atp (w->glyph_cachels, gindex))
3889 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3890 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3891 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3892 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3893 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3894 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3897 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3899 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3903 /* Unset the dirty bit on all the glyph cachels that have it. */
3905 mark_glyph_cachels_as_clean (struct window* w)
3909 XSETWINDOW (window, w);
3910 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3912 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt);
3914 set_glyph_dirty_p (cachel->glyph, window, 0);
3918 #ifdef MEMORY_USAGE_STATS
3921 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3922 struct overhead_stats *ovstats)
3927 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3932 #endif /* MEMORY_USAGE_STATS */
3936 /*****************************************************************************
3937 * subwindow cachel functions *
3938 *****************************************************************************/
3939 /* Subwindows are curious in that you have to physically unmap them to
3940 not display them. It is problematic deciding what to do in
3941 redisplay. We have two caches - a per-window instance cache that
3942 keeps track of subwindows on a window, these are linked to their
3943 instantiator in the hashtable and when the instantiator goes away
3944 we want the instance to go away also. However we also have a
3945 per-frame instance cache that we use to determine if a subwindow is
3946 obscuring an area that we want to clear. We need to be able to flip
3947 through this quickly so a hashtable is not suitable hence the
3948 subwindow_cachels. The question is should we just not mark
3949 instances in the subwindow_cachels or should we try and invalidate
3950 the cache at suitable points in redisplay? If we don't invalidate
3951 the cache it will fill up with crud that will only get removed when
3952 the frame is deleted. So invalidation is good, the question is when
3953 and whether we mark as well. Go for the simple option - don't mark,
3954 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
3957 mark_subwindow_cachels (subwindow_cachel_dynarr *elements)
3964 for (elt = 0; elt < Dynarr_length (elements); elt++)
3966 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
3967 mark_object (cachel->subwindow);
3972 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
3973 struct subwindow_cachel *cachel)
3975 cachel->subwindow = subwindow;
3976 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3977 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3978 cachel->updated = 1;
3982 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
3984 struct subwindow_cachel new_cachel;
3987 new_cachel.subwindow = Qnil;
3990 new_cachel.being_displayed=0;
3992 update_subwindow_cachel_data (f, subwindow, &new_cachel);
3993 Dynarr_add (f->subwindow_cachels, new_cachel);
3997 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
4004 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4006 struct subwindow_cachel *cachel =
4007 Dynarr_atp (f->subwindow_cachels, elt);
4009 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
4011 if (!cachel->updated)
4012 update_subwindow_cachel_data (f, subwindow, cachel);
4017 /* If we didn't find the glyph, add it and then return its index. */
4018 add_subwindow_cachel (f, subwindow);
4023 update_subwindow_cachel (Lisp_Object subwindow)
4028 if (NILP (subwindow))
4031 f = XFRAME ( XIMAGE_INSTANCE_SUBWINDOW_FRAME (subwindow));
4033 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4035 struct subwindow_cachel *cachel =
4036 Dynarr_atp (f->subwindow_cachels, elt);
4038 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
4040 update_subwindow_cachel_data (f, subwindow, cachel);
4045 /* redisplay in general assumes that drawing something will erase
4046 what was there before. unfortunately this does not apply to
4047 subwindows that need to be specifically unmapped in order to
4048 disappear. we take a brute force approach - on the basis that its
4049 cheap - and unmap all subwindows in a display line */
4051 reset_subwindow_cachels (struct frame *f)
4054 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4056 struct subwindow_cachel *cachel =
4057 Dynarr_atp (f->subwindow_cachels, elt);
4059 if (!NILP (cachel->subwindow) && cachel->being_displayed)
4061 cachel->updated = 1;
4062 /* #### This is not optimal as update_subwindow will search
4063 the cachels for ourselves as well. We could easily optimize. */
4064 unmap_subwindow (cachel->subwindow);
4067 Dynarr_reset (f->subwindow_cachels);
4071 mark_subwindow_cachels_as_not_updated (struct frame *f)
4075 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4076 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
4081 /*****************************************************************************
4082 * subwindow exposure ignorance *
4083 *****************************************************************************/
4084 /* when we unmap subwindows the associated window system will generate
4085 expose events. This we do not want as redisplay already copes with
4086 the repainting necessary. Worse, we can get in an endless cycle of
4087 redisplay if we are not careful. Thus we keep a per-frame list of
4088 expose events that are going to come and ignore them as
4091 struct expose_ignore_blocktype
4093 Blocktype_declare (struct expose_ignore);
4094 } *the_expose_ignore_blocktype;
4097 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
4099 struct expose_ignore *ei, *prev;
4100 /* the ignore list is FIFO so we should generally get a match with
4101 the first element in the list */
4102 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next)
4104 /* Checking for exact matches just isn't good enough as we
4105 mighte get exposures for partially obscure subwindows, thus
4106 we have to check for overlaps. Being conservative we will
4107 check for exposures wholly contained by the subwindow, this
4108 might give us what we want.*/
4109 if (ei->x <= x && ei->y <= y
4110 && ei->x + ei->width >= x + width
4111 && ei->y + ei->height >= y + height)
4113 #ifdef DEBUG_WIDGETS
4114 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n",
4115 x, y, width, height, ei->x, ei->y, ei->width, ei->height);
4118 f->subwindow_exposures = ei->next;
4120 prev->next = ei->next;
4122 if (ei == f->subwindow_exposures_tail)
4123 f->subwindow_exposures_tail = prev;
4125 Blocktype_free (the_expose_ignore_blocktype, ei);
4134 register_ignored_expose (struct frame* f, int x, int y, int width, int height)
4136 if (!hold_ignored_expose_registration)
4138 struct expose_ignore *ei;
4140 ei = Blocktype_alloc (the_expose_ignore_blocktype);
4146 ei->height = height;
4148 /* we have to add the exposure to the end of the list, since we
4149 want to check the oldest events first. for speed we keep a record
4150 of the end so that we can add right to it. */
4151 if (f->subwindow_exposures_tail)
4153 f->subwindow_exposures_tail->next = ei;
4155 if (!f->subwindow_exposures)
4157 f->subwindow_exposures = ei;
4159 f->subwindow_exposures_tail = ei;
4163 /****************************************************************************
4164 find_matching_subwindow
4166 See if there is a subwindow that completely encloses the requested
4168 ****************************************************************************/
4169 int find_matching_subwindow (struct frame* f, int x, int y, int width, int height)
4173 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4175 struct subwindow_cachel *cachel =
4176 Dynarr_atp (f->subwindow_cachels, elt);
4178 if (cachel->being_displayed
4180 cachel->x <= x && cachel->y <= y
4182 cachel->x + cachel->width >= x + width
4184 cachel->y + cachel->height >= y + height)
4193 /*****************************************************************************
4194 * subwindow functions *
4195 *****************************************************************************/
4197 /* update the displayed characteristics of a subwindow */
4199 update_subwindow (Lisp_Object subwindow)
4201 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4203 if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4205 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4208 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
4209 /* We must update the window's size as it may have been changed by
4210 the the layout routines. We also do this here so that explicit resizing
4211 from lisp does not result in synchronous updates. */
4212 MAYBE_DEVMETH (XDEVICE (ii->device), resize_subwindow, (ii,
4213 IMAGE_INSTANCE_WIDTH (ii),
4214 IMAGE_INSTANCE_HEIGHT (ii)));
4217 /* Update all the subwindows on a frame. */
4219 update_frame_subwindows (struct frame *f)
4223 if (f->subwindows_changed || f->subwindows_state_changed || f->faces_changed)
4224 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4226 struct subwindow_cachel *cachel =
4227 Dynarr_atp (f->subwindow_cachels, elt);
4229 if (cachel->being_displayed)
4231 update_subwindow (cachel->subwindow);
4236 /* remove a subwindow from its frame */
4237 void unmap_subwindow (Lisp_Object subwindow)
4239 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4241 struct subwindow_cachel* cachel;
4244 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4246 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4248 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4250 #ifdef DEBUG_WIDGETS
4251 stderr_out ("unmapping subwindow %d\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
4253 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4254 elt = get_subwindow_cachel_index (f, subwindow);
4255 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4257 /* make sure we don't get expose events */
4258 register_ignored_expose (f, cachel->x, cachel->y, cachel->width, cachel->height);
4261 cachel->being_displayed = 0;
4262 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4264 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
4267 /* show a subwindow in its frame */
4268 void map_subwindow (Lisp_Object subwindow, int x, int y,
4269 struct display_glyph_area *dga)
4271 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4273 struct subwindow_cachel* cachel;
4276 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4278 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4280 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4283 #ifdef DEBUG_WIDGETS
4284 stderr_out ("mapping subwindow %d, %dx%d@%d+%d\n",
4285 IMAGE_INSTANCE_SUBWINDOW_ID (ii),
4286 dga->width, dga->height, x, y);
4288 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4289 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
4290 elt = get_subwindow_cachel_index (f, subwindow);
4291 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4294 cachel->width = dga->width;
4295 cachel->height = dga->height;
4296 cachel->being_displayed = 1;
4298 /* This forces any pending display changes to happen to the image
4299 before we show it. I'm not sure whether or not we need mark as
4300 clean here, but for now we will. */
4301 if (IMAGE_INSTANCE_DIRTYP (ii))
4303 update_subwindow (subwindow);
4304 IMAGE_INSTANCE_DIRTYP (ii) = 0;
4307 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y, dga));
4311 subwindow_possible_dest_types (void)
4313 return IMAGE_SUBWINDOW_MASK;
4316 /* Partially instantiate a subwindow. */
4318 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
4319 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
4320 int dest_mask, Lisp_Object domain)
4322 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
4323 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
4324 Lisp_Object frame = FW_FRAME (domain);
4325 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
4326 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
4329 signal_simple_error ("No selected frame", device);
4331 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
4332 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
4335 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
4336 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4337 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
4339 /* #### This stuff may get overidden by the widget code and is
4340 actually really dumb now that we have dynamic geometry
4341 calculations. What should really happen is that the subwindow
4342 should query its child for an appropriate geometry. */
4344 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
4349 if (XINT (width) > 1)
4351 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
4354 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
4359 if (XINT (height) > 1)
4361 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
4365 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
4366 Return non-nil if OBJECT is a subwindow.
4370 CHECK_IMAGE_INSTANCE (object);
4371 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
4374 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
4375 Return the window id of SUBWINDOW as a number.
4379 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4380 return make_int ((int) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow));
4383 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
4384 Resize SUBWINDOW to WIDTH x HEIGHT.
4385 If a value is nil that parameter is not changed.
4387 (subwindow, width, height))
4391 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4394 neww = XIMAGE_INSTANCE_WIDTH (subwindow);
4396 neww = XINT (width);
4399 newh = XIMAGE_INSTANCE_HEIGHT (subwindow);
4401 newh = XINT (height);
4403 /* The actual resizing gets done asychronously by
4404 update_subwindow. */
4405 XIMAGE_INSTANCE_HEIGHT (subwindow) = newh;
4406 XIMAGE_INSTANCE_WIDTH (subwindow) = neww;
4408 /* need to update the cachels as redisplay will not do this */
4409 update_subwindow_cachel (subwindow);
4414 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
4415 Generate a Map event for SUBWINDOW.
4419 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4421 map_subwindow (subwindow, 0, 0);
4427 /*****************************************************************************
4429 *****************************************************************************/
4431 /* Get the display tables for use currently on window W with face
4432 FACE. #### This will have to be redone. */
4435 get_display_tables (struct window *w, face_index findex,
4436 Lisp_Object *face_table, Lisp_Object *window_table)
4439 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
4443 tem = noseeum_cons (tem, Qnil);
4445 tem = w->display_table;
4449 tem = noseeum_cons (tem, Qnil);
4450 *window_table = tem;
4454 display_table_entry (Emchar ch, Lisp_Object face_table,
4455 Lisp_Object window_table)
4459 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
4460 for (tail = face_table; 1; tail = XCDR (tail))
4465 if (!NILP (window_table))
4467 tail = window_table;
4468 window_table = Qnil;
4473 table = XCAR (tail);
4475 if (VECTORP (table))
4477 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
4478 return XVECTOR_DATA (table)[ch];
4482 else if (CHAR_TABLEP (table)
4483 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
4485 return get_char_table (ch, XCHAR_TABLE (table));
4487 else if (CHAR_TABLEP (table)
4488 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
4490 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
4496 else if (RANGE_TABLEP (table))
4498 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
4509 /*****************************************************************************
4510 * timeouts for animated glyphs *
4511 *****************************************************************************/
4512 static Lisp_Object Qglyph_animated_timeout_handler;
4514 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /*
4515 Callback function for updating animated images.
4520 CHECK_WEAK_LIST (arg);
4522 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg))))
4524 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg));
4526 if (IMAGE_INSTANCEP (value))
4528 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value);
4530 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value)
4532 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1
4534 !disable_animated_pixmaps)
4536 /* Increment the index of the image slice we are currently
4538 IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
4539 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
4540 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
4541 /* We might need to kick redisplay at this point - but we
4543 MARK_DEVICE_FRAMES_GLYPHS_CHANGED
4544 (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)));
4545 MARK_IMAGE_INSTANCE_CHANGED (ii);
4552 Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image)
4554 Lisp_Object ret = Qnil;
4556 if (tickms > 0 && IMAGE_INSTANCEP (image))
4558 double ms = ((double)tickms) / 1000.0;
4559 struct gcpro gcpro1;
4560 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE);
4563 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil);
4565 ret = Fadd_timeout (make_float (ms),
4566 Qglyph_animated_timeout_handler,
4567 holder, make_float (ms));
4574 void disable_glyph_animated_timeout (int i)
4579 Fdisable_timeout (id);
4583 /*****************************************************************************
4585 *****************************************************************************/
4588 syms_of_glyphs (void)
4590 /* image instantiators */
4592 DEFSUBR (Fimage_instantiator_format_list);
4593 DEFSUBR (Fvalid_image_instantiator_format_p);
4594 DEFSUBR (Fset_console_type_image_conversion_list);
4595 DEFSUBR (Fconsole_type_image_conversion_list);
4597 defkeyword (&Q_file, ":file");
4598 defkeyword (&Q_data, ":data");
4599 defkeyword (&Q_face, ":face");
4600 defkeyword (&Q_pixel_height, ":pixel-height");
4601 defkeyword (&Q_pixel_width, ":pixel-width");
4604 defkeyword (&Q_color_symbols, ":color-symbols");
4606 #ifdef HAVE_WINDOW_SYSTEM
4607 defkeyword (&Q_mask_file, ":mask-file");
4608 defkeyword (&Q_mask_data, ":mask-data");
4609 defkeyword (&Q_hotspot_x, ":hotspot-x");
4610 defkeyword (&Q_hotspot_y, ":hotspot-y");
4611 defkeyword (&Q_foreground, ":foreground");
4612 defkeyword (&Q_background, ":background");
4614 /* image specifiers */
4616 DEFSUBR (Fimage_specifier_p);
4617 /* Qimage in general.c */
4619 /* image instances */
4621 defsymbol (&Qimage_instancep, "image-instance-p");
4623 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
4624 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
4625 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
4626 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
4627 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
4628 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
4629 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
4630 defsymbol (&Qlayout_image_instance_p, "layout-image-instance-p");
4632 DEFSUBR (Fmake_image_instance);
4633 DEFSUBR (Fimage_instance_p);
4634 DEFSUBR (Fimage_instance_type);
4635 DEFSUBR (Fvalid_image_instance_type_p);
4636 DEFSUBR (Fimage_instance_type_list);
4637 DEFSUBR (Fimage_instance_name);
4638 DEFSUBR (Fimage_instance_string);
4639 DEFSUBR (Fimage_instance_file_name);
4640 DEFSUBR (Fimage_instance_mask_file_name);
4641 DEFSUBR (Fimage_instance_depth);
4642 DEFSUBR (Fimage_instance_height);
4643 DEFSUBR (Fimage_instance_width);
4644 DEFSUBR (Fimage_instance_hotspot_x);
4645 DEFSUBR (Fimage_instance_hotspot_y);
4646 DEFSUBR (Fimage_instance_foreground);
4647 DEFSUBR (Fimage_instance_background);
4648 DEFSUBR (Fimage_instance_property);
4649 DEFSUBR (Fset_image_instance_property);
4650 DEFSUBR (Fcolorize_image_instance);
4652 DEFSUBR (Fsubwindowp);
4653 DEFSUBR (Fimage_instance_subwindow_id);
4654 DEFSUBR (Fresize_subwindow);
4655 DEFSUBR (Fforce_subwindow_map);
4657 /* Qnothing defined as part of the "nothing" image-instantiator
4659 /* Qtext defined in general.c */
4660 defsymbol (&Qmono_pixmap, "mono-pixmap");
4661 defsymbol (&Qcolor_pixmap, "color-pixmap");
4662 /* Qpointer defined in general.c */
4666 defsymbol (&Qglyphp, "glyphp");
4667 defsymbol (&Qcontrib_p, "contrib-p");
4668 defsymbol (&Qbaseline, "baseline");
4670 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4671 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4672 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4674 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4676 DEFSUBR (Fglyph_type);
4677 DEFSUBR (Fvalid_glyph_type_p);
4678 DEFSUBR (Fglyph_type_list);
4680 DEFSUBR (Fmake_glyph_internal);
4681 DEFSUBR (Fglyph_width);
4682 DEFSUBR (Fglyph_ascent);
4683 DEFSUBR (Fglyph_descent);
4684 DEFSUBR (Fglyph_height);
4686 /* Qbuffer defined in general.c. */
4687 /* Qpointer defined above */
4689 /* Unfortunately, timeout handlers must be lisp functions. This is
4690 for animated glyphs. */
4691 defsymbol (&Qglyph_animated_timeout_handler,
4692 "glyph-animated-timeout-handler");
4693 DEFSUBR (Fglyph_animated_timeout_handler);
4696 deferror (&Qimage_conversion_error,
4697 "image-conversion-error",
4698 "image-conversion error", Qio_error);
4702 static const struct lrecord_description image_specifier_description[] = {
4703 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee) },
4704 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee_property) },
4709 specifier_type_create_image (void)
4711 /* image specifiers */
4713 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4715 SPECIFIER_HAS_METHOD (image, create);
4716 SPECIFIER_HAS_METHOD (image, mark);
4717 SPECIFIER_HAS_METHOD (image, instantiate);
4718 SPECIFIER_HAS_METHOD (image, validate);
4719 SPECIFIER_HAS_METHOD (image, after_change);
4720 SPECIFIER_HAS_METHOD (image, going_to_add);
4721 SPECIFIER_HAS_METHOD (image, copy_instantiator);
4725 reinit_specifier_type_create_image (void)
4727 REINITIALIZE_SPECIFIER_TYPE (image);
4731 static const struct lrecord_description iike_description_1[] = {
4732 { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) },
4736 static const struct struct_description iike_description = {
4737 sizeof (ii_keyword_entry),
4741 static const struct lrecord_description iiked_description_1[] = {
4742 XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description),
4746 static const struct struct_description iiked_description = {
4747 sizeof (ii_keyword_entry_dynarr),
4751 static const struct lrecord_description iife_description_1[] = {
4752 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) },
4753 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) },
4754 { XD_STRUCT_PTR, offsetof (image_instantiator_format_entry, meths), 1, &iim_description },
4758 static const struct struct_description iife_description = {
4759 sizeof (image_instantiator_format_entry),
4763 static const struct lrecord_description iifed_description_1[] = {
4764 XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description),
4768 static const struct struct_description iifed_description = {
4769 sizeof (image_instantiator_format_entry_dynarr),
4773 static const struct lrecord_description iim_description_1[] = {
4774 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) },
4775 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) },
4776 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, keywords), 1, &iiked_description },
4777 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, consoles), 1, &cted_description },
4781 const struct struct_description iim_description = {
4782 sizeof(struct image_instantiator_methods),
4787 image_instantiator_format_create (void)
4789 /* image instantiators */
4791 the_image_instantiator_format_entry_dynarr =
4792 Dynarr_new (image_instantiator_format_entry);
4794 Vimage_instantiator_format_list = Qnil;
4795 staticpro (&Vimage_instantiator_format_list);
4797 dumpstruct (&the_image_instantiator_format_entry_dynarr, &iifed_description);
4799 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
4801 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
4802 IIFORMAT_HAS_METHOD (nothing, instantiate);
4804 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
4806 IIFORMAT_HAS_METHOD (inherit, validate);
4807 IIFORMAT_HAS_METHOD (inherit, normalize);
4808 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
4809 IIFORMAT_HAS_METHOD (inherit, instantiate);
4811 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
4813 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
4815 IIFORMAT_HAS_METHOD (string, validate);
4816 IIFORMAT_HAS_METHOD (string, possible_dest_types);
4817 IIFORMAT_HAS_METHOD (string, instantiate);
4819 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4820 /* Do this so we can set strings. */
4821 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text");
4822 IIFORMAT_HAS_METHOD (text, set_property);
4823 IIFORMAT_HAS_METHOD (text, query_geometry);
4825 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4827 IIFORMAT_HAS_METHOD (formatted_string, validate);
4828 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4829 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
4830 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
4833 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
4834 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
4835 IIFORMAT_HAS_METHOD (subwindow, instantiate);
4836 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
4837 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
4839 #ifdef HAVE_WINDOW_SYSTEM
4840 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4842 IIFORMAT_HAS_METHOD (xbm, validate);
4843 IIFORMAT_HAS_METHOD (xbm, normalize);
4844 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4846 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4847 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4848 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4849 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4850 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4851 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4852 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4853 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4854 #endif /* HAVE_WINDOW_SYSTEM */
4857 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
4859 IIFORMAT_HAS_METHOD (xface, validate);
4860 IIFORMAT_HAS_METHOD (xface, normalize);
4861 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
4863 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
4864 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
4865 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
4866 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
4867 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
4868 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
4872 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
4874 IIFORMAT_HAS_METHOD (xpm, validate);
4875 IIFORMAT_HAS_METHOD (xpm, normalize);
4876 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
4878 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
4879 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
4880 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
4881 #endif /* HAVE_XPM */
4885 reinit_vars_of_glyphs (void)
4887 the_expose_ignore_blocktype =
4888 Blocktype_new (struct expose_ignore_blocktype);
4890 hold_ignored_expose_registration = 0;
4895 vars_of_glyphs (void)
4897 reinit_vars_of_glyphs ();
4899 Vthe_nothing_vector = vector1 (Qnothing);
4900 staticpro (&Vthe_nothing_vector);
4902 /* image instances */
4904 Vimage_instance_type_list = Fcons (Qnothing,
4905 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
4906 Qpointer, Qsubwindow, Qwidget));
4907 staticpro (&Vimage_instance_type_list);
4911 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
4912 staticpro (&Vglyph_type_list);
4914 /* The octal-escape glyph, control-arrow-glyph and
4915 invisible-text-glyph are completely initialized in glyphs.el */
4917 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
4918 What to prefix character codes displayed in octal with.
4920 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4922 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
4923 What to use as an arrow for control characters.
4925 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
4926 redisplay_glyph_changed);
4928 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
4929 What to use to indicate the presence of invisible text.
4930 This is the glyph that is displayed when an ellipsis is called for
4931 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
4932 Normally this is three dots ("...").
4934 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
4935 redisplay_glyph_changed);
4937 /* Partially initialized in glyphs.el */
4938 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
4939 What to display at the beginning of horizontally scrolled lines.
4941 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4942 #ifdef HAVE_WINDOW_SYSTEM
4948 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
4949 Definitions of logical color-names used when reading XPM files.
4950 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
4951 The COLOR-NAME should be a string, which is the name of the color to define;
4952 the FORM should evaluate to a `color' specifier object, or a string to be
4953 passed to `make-color-instance'. If a loaded XPM file references a symbolic
4954 color called COLOR-NAME, it will display as the computed color instead.
4956 The default value of this variable defines the logical color names
4957 \"foreground\" and \"background\" to be the colors of the `default' face.
4959 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
4960 #endif /* HAVE_XPM */
4965 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /*
4966 Whether animated pixmaps should be animated.
4969 disable_animated_pixmaps = 0;
4973 specifier_vars_of_glyphs (void)
4975 /* #### Can we GC here? The set_specifier_* calls definitely need */
4977 /* display tables */
4979 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
4980 *The display table currently in use.
4981 This is a specifier; use `set-specifier' to change it.
4982 The display table is a vector created with `make-display-table'.
4983 The 256 elements control how to display each possible text character.
4984 Each value should be a string, a glyph, a vector or nil.
4985 If a value is a vector it must be composed only of strings and glyphs.
4986 nil means display the character in the default fashion.
4987 Faces can have their own, overriding display table.
4989 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
4990 set_specifier_fallback (Vcurrent_display_table,
4991 list1 (Fcons (Qnil, Qnil)));
4992 set_specifier_caching (Vcurrent_display_table,
4993 offsetof (struct window, display_table),
4994 some_window_value_changed,
4999 complex_vars_of_glyphs (void)
5001 /* Partially initialized in glyphs-x.c, glyphs.el */
5002 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
5003 What to display at the end of truncated lines.
5005 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5007 /* Partially initialized in glyphs-x.c, glyphs.el */
5008 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
5009 What to display at the end of wrapped lines.
5011 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5013 /* Partially initialized in glyphs-x.c, glyphs.el */
5014 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
5015 The glyph used to display the XEmacs logo at startup.
5017 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);