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, 2000 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. */
33 #include "blocktype.h"
45 #include "redisplay.h"
46 #include "specifier.h"
49 #if defined (HAVE_XPM) && !defined (HAVE_GTK)
53 Lisp_Object Qimage_conversion_error;
55 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
56 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p;
57 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p;
58 Lisp_Object Qmono_pixmap_image_instance_p;
59 Lisp_Object Qcolor_pixmap_image_instance_p;
60 Lisp_Object Qpointer_image_instance_p;
61 Lisp_Object Qsubwindow_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);
84 DEFINE_IMAGE_INSTANTIATOR_FORMAT (pointer);
86 #ifdef HAVE_WINDOW_SYSTEM
87 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
90 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
91 Lisp_Object Q_foreground, Q_background;
93 #define BitmapSuccess 0
94 #define BitmapOpenFailed 1
95 #define BitmapFileInvalid 2
96 #define BitmapNoMemory 3
101 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
106 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
108 Lisp_Object Q_color_symbols;
111 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
112 struct image_instantiator_format_entry
116 struct image_instantiator_methods *meths;
121 Dynarr_declare (struct image_instantiator_format_entry);
122 } image_instantiator_format_entry_dynarr;
124 /* This contains one entry per format, per device it's defined on. */
125 image_instantiator_format_entry_dynarr *
126 the_image_instantiator_format_entry_dynarr;
128 static Lisp_Object allocate_image_instance (Lisp_Object governing_domain,
130 Lisp_Object instantiator);
131 static void image_validate (Lisp_Object instantiator);
132 static void glyph_property_was_changed (Lisp_Object glyph,
133 Lisp_Object property,
135 static void set_image_instance_dirty_p (Lisp_Object instance, int dirty);
136 static void register_ignored_expose (struct frame* f, int x, int y, int width, int height);
137 static void cache_subwindow_instance_in_frame_maybe (Lisp_Object instance);
138 static void update_image_instance (Lisp_Object image_instance,
139 Lisp_Object instantiator);
140 /* Unfortunately windows and X are different. In windows BeginPaint()
141 will prevent WM_PAINT messages being generated so it is unnecessary
142 to register exposures as they will not occur. Under X they will
144 int hold_ignored_expose_registration;
146 EXFUN (Fimage_instance_type, 1);
147 EXFUN (Fglyph_type, 1);
148 EXFUN (Fnext_window, 4);
151 /****************************************************************************
152 * Image Instantiators *
153 ****************************************************************************/
155 struct image_instantiator_methods *
156 decode_device_ii_format (Lisp_Object device, Lisp_Object format,
161 if (!SYMBOLP (format))
163 if (ERRB_EQ (errb, ERROR_ME))
164 CHECK_SYMBOL (format);
168 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
172 Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
175 Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
177 if ((NILP (d) && NILP (device))
180 EQ (CONSOLE_TYPE (XCONSOLE
181 (DEVICE_CONSOLE (XDEVICE (device)))), d)))
182 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
186 maybe_signal_simple_error ("Invalid image-instantiator format", format,
192 struct image_instantiator_methods *
193 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
195 return decode_device_ii_format (Qnil, format, errb);
199 valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale)
202 struct image_instantiator_methods* meths =
203 decode_image_instantiator_format (format, ERROR_ME_NOT);
204 Lisp_Object contype = Qnil;
205 /* mess with the locale */
206 if (!NILP (locale) && SYMBOLP (locale))
210 struct console* console = decode_console (locale);
211 contype = console ? CONSOLE_TYPE (console) : locale;
213 /* nothing is valid in all locales */
214 if (EQ (format, Qnothing))
216 /* reject unknown formats */
217 else if (NILP (contype) || !meths)
220 for (i = 0; i < Dynarr_length (meths->consoles); i++)
221 if (EQ (contype, Dynarr_at (meths->consoles, i).symbol))
226 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
228 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
229 If LOCALE is non-nil then the format is checked in that locale.
230 If LOCALE is nil the current console is used.
232 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
233 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
234 'autodetect, 'subwindow, 'inherit, 'mswindows-resource, 'bmp,
235 'native-layout, 'layout, 'label, 'tab-control, 'tree-view,
236 'progress-gauge, 'scrollbar, 'combo-box, 'edit-field, 'button,
237 'widget, 'pointer, and 'text, depending on how XEmacs was compiled.
239 (image_instantiator_format, locale))
241 return valid_image_instantiator_format_p (image_instantiator_format,
246 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
248 Return a list of valid image-instantiator formats.
252 return Fcopy_sequence (Vimage_instantiator_format_list);
256 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol,
257 struct image_instantiator_methods *meths)
259 struct image_instantiator_format_entry entry;
261 entry.symbol = symbol;
262 entry.device = device;
264 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
265 if (NILP (memq_no_quit (symbol, Vimage_instantiator_format_list)))
266 Vimage_instantiator_format_list =
267 Fcons (symbol, Vimage_instantiator_format_list);
271 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
273 image_instantiator_methods *meths)
275 add_entry_to_device_ii_format_list (Qnil, symbol, meths);
279 get_image_conversion_list (Lisp_Object console_type)
281 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
284 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
286 Set the image-conversion-list for consoles of the given CONSOLE-TYPE.
287 The image-conversion-list specifies how image instantiators that
288 are strings should be interpreted. Each element of the list should be
289 a list of two elements (a regular expression string and a vector) or
290 a list of three elements (the preceding two plus an integer index into
291 the vector). The string is converted to the vector associated with the
292 first matching regular expression. If a vector index is specified, the
293 string itself is substituted into that position in the vector.
295 Note: The conversion above is applied when the image instantiator is
296 added to an image specifier, not when the specifier is actually
297 instantiated. Therefore, changing the image-conversion-list only affects
298 newly-added instantiators. Existing instantiators in glyphs and image
299 specifiers will not be affected.
301 (console_type, list))
304 Lisp_Object *imlist = get_image_conversion_list (console_type);
306 /* Check the list to make sure that it only has valid entries. */
308 EXTERNAL_LIST_LOOP (tail, list)
310 Lisp_Object mapping = XCAR (tail);
312 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
313 if (!CONSP (mapping) ||
314 !CONSP (XCDR (mapping)) ||
315 (!NILP (XCDR (XCDR (mapping))) &&
316 (!CONSP (XCDR (XCDR (mapping))) ||
317 !NILP (XCDR (XCDR (XCDR (mapping)))))))
318 signal_simple_error ("Invalid mapping form", mapping);
321 Lisp_Object exp = XCAR (mapping);
322 Lisp_Object typevec = XCAR (XCDR (mapping));
323 Lisp_Object pos = Qnil;
328 CHECK_VECTOR (typevec);
329 if (!NILP (XCDR (XCDR (mapping))))
331 pos = XCAR (XCDR (XCDR (mapping)));
333 if (XINT (pos) < 0 ||
334 XINT (pos) >= XVECTOR_LENGTH (typevec))
336 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
339 newvec = Fcopy_sequence (typevec);
341 XVECTOR_DATA (newvec)[XINT (pos)] = exp;
343 image_validate (newvec);
348 *imlist = Fcopy_tree (list, Qt);
352 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
354 Return the image-conversion-list for devices of the given CONSOLE-TYPE.
355 The image-conversion-list specifies how to interpret image string
356 instantiators for the specified console type. See
357 `set-console-type-image-conversion-list' for a description of its syntax.
361 return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
364 /* Process a string instantiator according to the image-conversion-list for
365 CONSOLE_TYPE. Returns a vector. */
368 process_image_string_instantiator (Lisp_Object data,
369 Lisp_Object console_type,
374 LIST_LOOP (tail, *get_image_conversion_list (console_type))
376 Lisp_Object mapping = XCAR (tail);
377 Lisp_Object exp = XCAR (mapping);
378 Lisp_Object typevec = XCAR (XCDR (mapping));
380 /* if the result is of a type that can't be instantiated
381 (e.g. a string when we're dealing with a pointer glyph),
384 IIFORMAT_METH (decode_image_instantiator_format
385 (INSTANTIATOR_TYPE (typevec), ERROR_ME),
386 possible_dest_types, ())))
388 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
390 if (!NILP (XCDR (XCDR (mapping))))
392 int pos = XINT (XCAR (XCDR (XCDR (mapping))));
393 Lisp_Object newvec = Fcopy_sequence (typevec);
394 XVECTOR_DATA (newvec)[pos] = data;
403 signal_simple_error ("Unable to interpret glyph instantiator",
410 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
411 Lisp_Object default_)
414 int instantiator_len;
416 elt = XVECTOR_DATA (vector);
417 instantiator_len = XVECTOR_LENGTH (vector);
422 while (instantiator_len > 0)
424 if (EQ (elt[0], keyword))
427 instantiator_len -= 2;
434 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
436 return find_keyword_in_vector_or_given (vector, keyword, Qnil);
440 find_instantiator_differences (Lisp_Object new, Lisp_Object old)
442 Lisp_Object alist = Qnil;
443 Lisp_Object *elt = XVECTOR_DATA (new);
444 Lisp_Object *old_elt = XVECTOR_DATA (old);
445 int len = XVECTOR_LENGTH (new);
448 /* If the vector length has changed then consider everything
449 changed. We could try and figure out what properties have
450 disappeared or been added, but this code is only used as an
451 optimization anyway so lets not bother. */
452 if (len != XVECTOR_LENGTH (old))
457 for (len -= 2; len >= 1; len -= 2)
459 /* Keyword comparisons can be done with eq, the value must be
461 #### Note that this does not optimize re-ordering. */
462 if (!EQ (elt[len], old_elt[len])
463 || !internal_equal (elt[len+1], old_elt[len+1], 0))
464 alist = Fcons (Fcons (elt[len], elt[len+1]), alist);
468 Lisp_Object result = alist_to_tagged_vector (elt[0], alist);
470 RETURN_UNGCPRO (result);
474 DEFUN ("set-instantiator-property", Fset_instantiator_property,
476 Destructively set the property KEYWORD of INSTANTIATOR to VALUE.
477 If the property is not set then it is added to a copy of the
478 instantiator and the new instantiator returned.
479 Use `set-glyph-image' on glyphs to register instantiator changes. */
480 (instantiator, keyword, value))
485 CHECK_VECTOR (instantiator);
486 if (!KEYWORDP (keyword))
487 signal_simple_error ("instantiator property must be a keyword", keyword);
489 elt = XVECTOR_DATA (instantiator);
490 len = XVECTOR_LENGTH (instantiator);
492 for (len -= 2; len >= 1; len -= 2)
494 if (EQ (elt[len], keyword))
501 /* Didn't find it so add it. */
504 Lisp_Object alist = Qnil, result;
508 alist = tagged_vector_to_alist (instantiator);
509 alist = Fcons (Fcons (keyword, value), alist);
510 result = alist_to_tagged_vector (elt[0], alist);
512 RETURN_UNGCPRO (result);
519 check_valid_string (Lisp_Object data)
525 check_valid_vector (Lisp_Object data)
531 check_valid_face (Lisp_Object data)
537 check_valid_int (Lisp_Object data)
543 file_or_data_must_be_present (Lisp_Object instantiator)
545 if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
546 NILP (find_keyword_in_vector (instantiator, Q_data)))
547 signal_simple_error ("Must supply either :file or :data",
552 data_must_be_present (Lisp_Object instantiator)
554 if (NILP (find_keyword_in_vector (instantiator, Q_data)))
555 signal_simple_error ("Must supply :data", instantiator);
559 face_must_be_present (Lisp_Object instantiator)
561 if (NILP (find_keyword_in_vector (instantiator, Q_face)))
562 signal_simple_error ("Must supply :face", instantiator);
565 /* utility function useful in retrieving data from a file. */
568 make_string_from_file (Lisp_Object file)
570 /* This function can call lisp */
571 int count = specpdl_depth ();
572 Lisp_Object temp_buffer;
576 specbind (Qinhibit_quit, Qt);
577 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
578 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
579 GCPRO1 (temp_buffer);
580 set_buffer_internal (XBUFFER (temp_buffer));
581 Ferase_buffer (Qnil);
582 specbind (intern ("format-alist"), Qnil);
583 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
584 data = Fbuffer_substring (Qnil, Qnil, Qnil);
585 unbind_to (count, Qnil);
590 /* The following two functions are provided to make it easier for
591 the normalize methods to work with keyword-value vectors.
592 Hash tables are kind of heavyweight for this purpose.
593 (If vectors were resizable, we could avoid this problem;
594 but they're not.) An alternative approach that might be
595 more efficient but require more work is to use a type of
596 assoc-Dynarr and provide primitives for deleting elements out
597 of it. (However, you'd also have to add an unwind-protect
598 to make sure the Dynarr got freed in case of an error in
599 the normalization process.) */
602 tagged_vector_to_alist (Lisp_Object vector)
604 Lisp_Object *elt = XVECTOR_DATA (vector);
605 int len = XVECTOR_LENGTH (vector);
606 Lisp_Object result = Qnil;
609 for (len -= 2; len >= 1; len -= 2)
610 result = Fcons (Fcons (elt[len], elt[len+1]), result);
616 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
618 int len = 1 + 2 * XINT (Flength (alist));
619 Lisp_Object *elt = alloca_array (Lisp_Object, len);
625 LIST_LOOP (rest, alist)
627 Lisp_Object pair = XCAR (rest);
628 elt[i] = XCAR (pair);
629 elt[i+1] = XCDR (pair);
633 return Fvector (len, elt);
636 #ifdef ERROR_CHECK_GLYPHS
638 check_instance_cache_mapper (Lisp_Object key, Lisp_Object value,
641 /* This function can GC */
642 /* value can be nil; we cache failures as well as successes */
646 VOID_TO_LISP (window, flag_closure);
647 assert (EQ (XIMAGE_INSTANCE_DOMAIN (value), window));
654 check_window_subwindow_cache (struct window* w)
658 XSETWINDOW (window, w);
660 assert (!NILP (w->subwindow_instance_cache));
661 elisp_maphash (check_instance_cache_mapper,
662 w->subwindow_instance_cache,
663 LISP_TO_VOID (window));
667 check_image_instance_structure (Lisp_Object instance)
669 /* Weird nothing images exist at startup when the console is
671 if (!NOTHING_IMAGE_INSTANCEP (instance))
673 assert (DOMAIN_LIVE_P (instance));
674 assert (VECTORP (XIMAGE_INSTANCE_INSTANTIATOR (instance)));
676 if (WINDOWP (XIMAGE_INSTANCE_DOMAIN (instance)))
677 check_window_subwindow_cache
678 (XWINDOW (XIMAGE_INSTANCE_DOMAIN (instance)));
682 /* Determine what kind of domain governs the image instance.
683 Verify that the given domain is at least as specific, and extract
684 the governing domain from it. */
686 get_image_instantiator_governing_domain (Lisp_Object instantiator,
689 int governing_domain;
691 struct image_instantiator_methods *meths =
692 decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator),
694 governing_domain = IIFORMAT_METH_OR_GIVEN (meths, governing_domain, (),
695 GOVERNING_DOMAIN_DEVICE);
697 if (governing_domain == GOVERNING_DOMAIN_WINDOW
698 && NILP (DOMAIN_WINDOW (domain)))
699 signal_simple_error_2 ("Domain for this instantiator must be resolvable to a window",
700 instantiator, domain);
701 else if (governing_domain == GOVERNING_DOMAIN_FRAME
702 && NILP (DOMAIN_FRAME (domain)))
703 signal_simple_error_2
704 ("Domain for this instantiator must be resolvable to a frame",
705 instantiator, domain);
707 if (governing_domain == GOVERNING_DOMAIN_WINDOW)
708 domain = DOMAIN_WINDOW (domain);
709 else if (governing_domain == GOVERNING_DOMAIN_FRAME)
710 domain = DOMAIN_FRAME (domain);
711 else if (governing_domain == GOVERNING_DOMAIN_DEVICE)
712 domain = DOMAIN_DEVICE (domain);
720 normalize_image_instantiator (Lisp_Object instantiator,
722 Lisp_Object dest_mask)
724 if (IMAGE_INSTANCEP (instantiator))
727 if (STRINGP (instantiator))
728 instantiator = process_image_string_instantiator (instantiator, contype,
730 /* Subsequent validation will pick this up. */
731 if (!VECTORP (instantiator))
733 /* We have to always store the actual pixmap data and not the
734 filename even though this is a potential memory pig. We have to
735 do this because it is quite possible that we will need to
736 instantiate a new instance of the pixmap and the file will no
737 longer exist (e.g. w3 pixmaps are almost always from temporary
741 struct image_instantiator_methods *meths;
743 GCPRO1 (instantiator);
745 meths = decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator),
747 RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
748 (instantiator, contype, dest_mask),
754 instantiate_image_instantiator (Lisp_Object governing_domain,
756 Lisp_Object instantiator,
757 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
758 int dest_mask, Lisp_Object glyph)
760 Lisp_Object ii = allocate_image_instance (governing_domain,
761 IMAGE_INSTANCEP (domain) ?
762 domain : glyph, instantiator);
763 Lisp_Image_Instance* p = XIMAGE_INSTANCE (ii);
764 struct image_instantiator_methods *meths, *device_meths;
768 if (!valid_image_instantiator_format_p (INSTANTIATOR_TYPE (instantiator),
769 DOMAIN_DEVICE (governing_domain)))
771 ("Image instantiator format is invalid in this locale.",
774 meths = decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator),
776 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
777 pointer_bg, dest_mask, domain));
779 /* Now do device specific instantiation. */
780 device_meths = decode_device_ii_format (DOMAIN_DEVICE (governing_domain),
781 INSTANTIATOR_TYPE (instantiator),
784 if (!HAS_IIFORMAT_METH_P (meths, instantiate)
785 && (!device_meths || !HAS_IIFORMAT_METH_P (device_meths, instantiate)))
787 ("Don't know how to instantiate this image instantiator?",
790 /* In general native window system methods will require sane
791 geometry values, thus the instance needs to have been laid-out
792 before they get called. */
793 image_instance_layout (ii, XIMAGE_INSTANCE_WIDTH (ii),
794 XIMAGE_INSTANCE_HEIGHT (ii),
795 IMAGE_UNCHANGED_GEOMETRY,
796 IMAGE_UNCHANGED_GEOMETRY, domain);
798 MAYBE_IIFORMAT_METH (device_meths, instantiate, (ii, instantiator, pointer_fg,
799 pointer_bg, dest_mask, domain));
800 /* Do post instantiation. */
801 MAYBE_IIFORMAT_METH (meths, post_instantiate, (ii, instantiator, domain));
802 MAYBE_IIFORMAT_METH (device_meths, post_instantiate, (ii, instantiator, domain));
805 IMAGE_INSTANCE_INITIALIZED (p) = 1;
806 /* Now that we're done verify that we really are laid out. */
807 if (IMAGE_INSTANCE_LAYOUT_CHANGED (p))
808 image_instance_layout (ii, XIMAGE_INSTANCE_WIDTH (ii),
809 XIMAGE_INSTANCE_HEIGHT (ii),
810 IMAGE_UNCHANGED_GEOMETRY,
811 IMAGE_UNCHANGED_GEOMETRY, domain);
813 /* We *must* have a clean image at this point. */
814 IMAGE_INSTANCE_TEXT_CHANGED (p) = 0;
815 IMAGE_INSTANCE_SIZE_CHANGED (p) = 0;
816 IMAGE_INSTANCE_LAYOUT_CHANGED (p) = 0;
817 IMAGE_INSTANCE_DIRTYP (p) = 0;
819 assert ( XIMAGE_INSTANCE_HEIGHT (ii) >= 0
820 && XIMAGE_INSTANCE_WIDTH (ii) >= 0 );
822 ERROR_CHECK_IMAGE_INSTANCE (ii);
828 /****************************************************************************
829 * Image-Instance Object *
830 ****************************************************************************/
832 Lisp_Object Qimage_instancep;
835 mark_image_instance (Lisp_Object obj)
837 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
839 /* #### I want to check the instance here, but there are way too
840 many instances of the instance being marked while the domain is
841 dead. For instance you can get marked through an event when using
844 ERROR_CHECK_IMAGE_INSTANCE (obj);
847 mark_object (i->name);
848 mark_object (i->instantiator);
849 /* Is this legal in marking? We may get in the situation where the
850 domain has been deleted - making the instance unusable. It seems
851 better to remove the domain so that it can be finalized. */
852 if (!DOMAIN_LIVE_P (i->domain))
855 mark_object (i->domain);
857 /* We don't mark the glyph reference since that would create a
858 circularity preventing GC. Ditto the instantiator. */
859 switch (IMAGE_INSTANCE_TYPE (i))
862 mark_object (IMAGE_INSTANCE_TEXT_STRING (i));
864 case IMAGE_MONO_PIXMAP:
865 case IMAGE_COLOR_PIXMAP:
866 mark_object (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
867 mark_object (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
868 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
869 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
870 mark_object (IMAGE_INSTANCE_PIXMAP_FG (i));
871 mark_object (IMAGE_INSTANCE_PIXMAP_BG (i));
875 mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i));
876 mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i));
877 mark_object (IMAGE_INSTANCE_SUBWINDOW_FACE (i));
878 mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i));
879 mark_object (IMAGE_INSTANCE_LAYOUT_CHILDREN (i));
880 mark_object (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i));
881 mark_object (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i));
882 mark_object (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i));
883 case IMAGE_SUBWINDOW:
890 /* The image may have been previously finalized (yes that's weird,
891 see Fdelete_frame() and mark_window_as_deleted()), in which case
892 the domain will be nil, so cope with this. */
893 if (!NILP (IMAGE_INSTANCE_DEVICE (i)))
894 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (i)),
895 mark_image_instance, (i));
901 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
905 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
908 error ("printing unreadable object #<image-instance 0x%x>",
910 write_c_string ("#<image-instance (", printcharfun);
911 print_internal (Fimage_instance_type (obj), printcharfun, 0);
912 write_c_string (") ", printcharfun);
913 if (!NILP (ii->name))
915 print_internal (ii->name, printcharfun, 1);
916 write_c_string (" ", printcharfun);
918 write_c_string ("on ", printcharfun);
919 print_internal (ii->domain, printcharfun, 0);
920 write_c_string (" ", printcharfun);
921 switch (IMAGE_INSTANCE_TYPE (ii))
927 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
930 case IMAGE_MONO_PIXMAP:
931 case IMAGE_COLOR_PIXMAP:
933 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
936 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
937 s = strrchr ((char *) XSTRING_DATA (filename), '/');
939 print_internal (build_string (s + 1), printcharfun, 1);
941 print_internal (filename, printcharfun, 1);
943 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
944 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
945 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
946 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
948 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
949 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
950 write_c_string (buf, printcharfun);
951 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
952 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
954 write_c_string (" @", printcharfun);
955 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
957 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
958 write_c_string (buf, printcharfun);
961 write_c_string ("??", printcharfun);
962 write_c_string (",", printcharfun);
963 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
965 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
966 write_c_string (buf, printcharfun);
969 write_c_string ("??", printcharfun);
971 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
972 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
974 write_c_string (" (", printcharfun);
975 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
979 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
981 write_c_string ("/", printcharfun);
982 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
986 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
988 write_c_string (")", printcharfun);
993 print_internal (IMAGE_INSTANCE_WIDGET_TYPE (ii), printcharfun, 0);
995 if (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_ITEM (ii)))
997 write_c_string (" ", printcharfun);
998 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 1);
1001 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
1003 write_c_string (" face=", printcharfun);
1005 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
1009 case IMAGE_SUBWINDOW:
1010 sprintf (buf, " %dx%d", IMAGE_INSTANCE_WIDTH (ii),
1011 IMAGE_INSTANCE_HEIGHT (ii));
1012 write_c_string (buf, printcharfun);
1014 /* This is stolen from frame.c. Subwindows are strange in that they
1015 are specific to a particular frame so we want to print in their
1016 description what that frame is. */
1018 write_c_string (" on #<", printcharfun);
1020 struct frame* f = XFRAME (IMAGE_INSTANCE_FRAME (ii));
1022 if (!FRAME_LIVE_P (f))
1023 write_c_string ("dead", printcharfun);
1025 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
1028 write_c_string ("-frame>", printcharfun);
1029 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
1030 write_c_string (buf, printcharfun);
1038 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), print_image_instance,
1039 (ii, printcharfun, escapeflag));
1040 sprintf (buf, " 0x%x>", ii->header.uid);
1041 write_c_string (buf, printcharfun);
1045 finalize_image_instance (void *header, int for_disksave)
1047 Lisp_Image_Instance *i = (Lisp_Image_Instance *) header;
1049 /* objects like this exist at dump time, so don't bomb out. */
1050 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING
1052 NILP (IMAGE_INSTANCE_DEVICE (i)))
1054 if (for_disksave) finalose (i);
1056 /* We can't use the domain here, because it might have
1058 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (i)),
1059 finalize_image_instance, (i));
1061 /* Make sure we don't try this twice. */
1062 IMAGE_INSTANCE_DEVICE (i) = Qnil;
1066 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1068 Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
1069 Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
1071 ERROR_CHECK_IMAGE_INSTANCE (obj1);
1072 ERROR_CHECK_IMAGE_INSTANCE (obj2);
1074 if (!EQ (IMAGE_INSTANCE_DOMAIN (i1),
1075 IMAGE_INSTANCE_DOMAIN (i2))
1076 || IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)
1077 || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2)
1078 || IMAGE_INSTANCE_MARGIN_WIDTH (i1) !=
1079 IMAGE_INSTANCE_MARGIN_WIDTH (i2)
1080 || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2)
1081 || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2)
1082 || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (i2))
1084 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
1087 if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (i1),
1088 IMAGE_INSTANCE_INSTANTIATOR (i2),
1092 switch (IMAGE_INSTANCE_TYPE (i1))
1098 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
1099 IMAGE_INSTANCE_TEXT_STRING (i2),
1104 case IMAGE_MONO_PIXMAP:
1105 case IMAGE_COLOR_PIXMAP:
1107 if (!(IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
1108 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
1109 IMAGE_INSTANCE_PIXMAP_SLICE (i1) ==
1110 IMAGE_INSTANCE_PIXMAP_SLICE (i2) &&
1111 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
1112 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
1113 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
1114 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
1115 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
1116 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
1118 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
1119 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
1125 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
1126 IMAGE_INSTANCE_WIDGET_TYPE (i2))
1127 && IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
1128 IMAGE_INSTANCE_SUBWINDOW_ID (i2)
1130 EQ (IMAGE_INSTANCE_WIDGET_FACE (i1),
1131 IMAGE_INSTANCE_WIDGET_TYPE (i2))
1132 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1),
1133 IMAGE_INSTANCE_WIDGET_ITEMS (i2),
1135 && internal_equal (IMAGE_INSTANCE_LAYOUT_CHILDREN (i1),
1136 IMAGE_INSTANCE_LAYOUT_CHILDREN (i2),
1138 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
1139 IMAGE_INSTANCE_WIDGET_PROPS (i2),
1141 && internal_equal (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i1),
1142 IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i2),
1144 && internal_equal (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i1),
1145 IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i2),
1151 case IMAGE_SUBWINDOW:
1152 if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
1153 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
1161 return DEVMETH_OR_GIVEN (DOMAIN_XDEVICE (i1->domain),
1162 image_instance_equal, (i1, i2, depth), 1);
1165 /* Image instance domain manipulators. We can't error check in these
1166 otherwise we get into infinite recursion. */
1168 image_instance_device (Lisp_Object instance)
1170 return XIMAGE_INSTANCE_DEVICE (instance);
1174 image_instance_frame (Lisp_Object instance)
1176 return XIMAGE_INSTANCE_FRAME (instance);
1180 image_instance_window (Lisp_Object instance)
1182 return DOMAIN_WINDOW (XIMAGE_INSTANCE_DOMAIN (instance));
1186 image_instance_live_p (Lisp_Object instance)
1188 return DOMAIN_LIVE_P (XIMAGE_INSTANCE_DOMAIN (instance));
1191 static unsigned long
1192 image_instance_hash (Lisp_Object obj, int depth)
1194 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
1195 unsigned long hash = HASH5 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)),
1196 IMAGE_INSTANCE_WIDTH (i),
1197 IMAGE_INSTANCE_MARGIN_WIDTH (i),
1198 IMAGE_INSTANCE_HEIGHT (i),
1199 internal_hash (IMAGE_INSTANCE_INSTANTIATOR (i),
1202 ERROR_CHECK_IMAGE_INSTANCE (obj);
1204 switch (IMAGE_INSTANCE_TYPE (i))
1210 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
1214 case IMAGE_MONO_PIXMAP:
1215 case IMAGE_COLOR_PIXMAP:
1217 hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i),
1218 IMAGE_INSTANCE_PIXMAP_SLICE (i),
1219 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
1224 /* We need the hash to be equivalent to what should be
1227 LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)),
1228 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
1229 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1),
1230 internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i),
1232 case IMAGE_SUBWINDOW:
1233 hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBWINDOW_ID (i));
1240 return HASH2 (hash, DEVMETH_OR_GIVEN
1241 (XDEVICE (image_instance_device (obj)),
1242 image_instance_hash, (i, depth),
1246 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
1247 mark_image_instance, print_image_instance,
1248 finalize_image_instance, image_instance_equal,
1249 image_instance_hash, 0,
1250 Lisp_Image_Instance);
1253 allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent,
1254 Lisp_Object instantiator)
1256 Lisp_Image_Instance *lp =
1257 alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance);
1261 /* It's not possible to simply keep a record of the domain in which
1262 the instance was instantiated. This is because caching may mean
1263 that the domain becomes invalid but the instance remains
1264 valid. However, the only truly relevant domain is the domain in
1265 which the instance is cached since this is the one that will be
1266 common to the instances. */
1267 lp->domain = governing_domain;
1268 /* The cache domain is not quite sufficient since the domain can get
1269 deleted before the image instance does. We need to know the
1270 domain device in order to finalize the image instance
1271 properly. We therefore record the device also. */
1272 lp->device = DOMAIN_DEVICE (governing_domain);
1273 lp->type = IMAGE_NOTHING;
1277 lp->width = IMAGE_UNSPECIFIED_GEOMETRY;
1278 lp->margin_width = 0;
1279 lp->height = IMAGE_UNSPECIFIED_GEOMETRY;
1280 lp->parent = parent;
1281 lp->instantiator = instantiator;
1282 /* So that layouts get done. */
1283 lp->layout_changed = 1;
1284 lp->initialized = 0;
1286 XSETIMAGE_INSTANCE (val, lp);
1287 MARK_GLYPHS_CHANGED;
1292 static enum image_instance_type
1293 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
1295 if (ERRB_EQ (errb, ERROR_ME))
1296 CHECK_SYMBOL (type);
1298 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
1299 if (EQ (type, Qtext)) return IMAGE_TEXT;
1300 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
1301 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
1302 if (EQ (type, Qpointer)) return IMAGE_POINTER;
1303 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
1304 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
1306 maybe_signal_simple_error ("Invalid image-instance type", type,
1309 return IMAGE_UNKNOWN; /* not reached */
1313 encode_image_instance_type (enum image_instance_type type)
1317 case IMAGE_NOTHING: return Qnothing;
1318 case IMAGE_TEXT: return Qtext;
1319 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
1320 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
1321 case IMAGE_POINTER: return Qpointer;
1322 case IMAGE_SUBWINDOW: return Qsubwindow;
1323 case IMAGE_WIDGET: return Qwidget;
1328 return Qnil; /* not reached */
1332 decode_image_instance_type_list (Lisp_Object list)
1342 enum image_instance_type type =
1343 decode_image_instance_type (list, ERROR_ME);
1344 return image_instance_type_to_mask (type);
1347 EXTERNAL_LIST_LOOP (rest, list)
1349 enum image_instance_type type =
1350 decode_image_instance_type (XCAR (rest), ERROR_ME);
1351 mask |= image_instance_type_to_mask (type);
1358 encode_image_instance_type_list (int mask)
1361 Lisp_Object result = Qnil;
1367 result = Fcons (encode_image_instance_type
1368 ((enum image_instance_type) count), result);
1372 return Fnreverse (result);
1376 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1377 int desired_dest_mask)
1382 (emacs_doprnt_string_lisp_2
1384 "No compatible image-instance types given: wanted one of %s, got %s",
1386 encode_image_instance_type_list (desired_dest_mask),
1387 encode_image_instance_type_list (given_dest_mask)),
1392 valid_image_instance_type_p (Lisp_Object type)
1394 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1397 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1398 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1399 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1400 'pointer, 'subwindow, and 'widget, depending on how XEmacs was compiled.
1402 (image_instance_type))
1404 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1407 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1408 Return a list of valid image-instance types.
1412 return Fcopy_sequence (Vimage_instance_type_list);
1416 decode_error_behavior_flag (Lisp_Object noerror)
1418 if (NILP (noerror)) return ERROR_ME;
1419 else if (EQ (noerror, Qt)) return ERROR_ME_NOT;
1420 else return ERROR_ME_WARN;
1424 encode_error_behavior_flag (Error_behavior errb)
1426 if (ERRB_EQ (errb, ERROR_ME))
1428 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1432 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1437 /* Recurse up the hierarchy looking for the topmost glyph. This means
1438 that instances in layouts will inherit face properties from their
1440 Lisp_Object image_instance_parent_glyph (Lisp_Image_Instance* ii)
1442 if (IMAGE_INSTANCEP (IMAGE_INSTANCE_PARENT (ii)))
1444 return image_instance_parent_glyph
1445 (XIMAGE_INSTANCE (IMAGE_INSTANCE_PARENT (ii)));
1447 return IMAGE_INSTANCE_PARENT (ii);
1451 make_image_instance_1 (Lisp_Object data, Lisp_Object domain,
1452 Lisp_Object dest_types)
1455 struct gcpro gcpro1;
1457 Lisp_Object governing_domain;
1459 if (IMAGE_INSTANCEP (data))
1460 signal_simple_error ("Image instances not allowed here", data);
1461 image_validate (data);
1462 domain = decode_domain (domain);
1463 /* instantiate_image_instantiator() will abort if given an
1464 image instance ... */
1465 dest_mask = decode_image_instance_type_list (dest_types);
1466 data = normalize_image_instantiator (data,
1467 DEVICE_TYPE (DOMAIN_XDEVICE (domain)),
1468 make_int (dest_mask));
1470 /* After normalizing the data, it's always either an image instance (which
1471 we filtered out above) or a vector. */
1472 if (EQ (INSTANTIATOR_TYPE (data), Qinherit))
1473 signal_simple_error ("Inheritance not allowed here", data);
1475 get_image_instantiator_governing_domain (data, domain);
1476 ii = instantiate_image_instantiator (governing_domain, domain, data,
1477 Qnil, Qnil, dest_mask, Qnil);
1478 RETURN_UNGCPRO (ii);
1481 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1482 Return a new `image-instance' object.
1484 Image-instance objects encapsulate the way a particular image (pixmap,
1485 etc.) is displayed on a particular device. In most circumstances, you
1486 do not need to directly create image instances; use a glyph instead.
1487 However, it may occasionally be useful to explicitly create image
1488 instances, if you want more control over the instantiation process.
1490 DATA is an image instantiator, which describes the image; see
1491 `make-image-specifier' for a description of the allowed values.
1493 DEST-TYPES should be a list of allowed image instance types that can
1494 be generated. The recognized image instance types are
1497 Nothing is displayed.
1499 Displayed as text. The foreground and background colors and the
1500 font of the text are specified independent of the pixmap. Typically
1501 these attributes will come from the face of the surrounding text,
1502 unless a face is specified for the glyph in which the image appears.
1504 Displayed as a mono pixmap (a pixmap with only two colors where the
1505 foreground and background can be specified independent of the pixmap;
1506 typically the pixmap assumes the foreground and background colors of
1507 the text around it, unless a face is specified for the glyph in which
1510 Displayed as a color pixmap.
1512 Used as the mouse pointer for a window.
1514 A child window that is treated as an image. This allows (e.g.)
1515 another program to be responsible for drawing into the window.
1517 A child window that contains a window-system widget, e.g. a push
1518 button, text field, or slider.
1520 The DEST-TYPES list is unordered. If multiple destination types are
1521 possible for a given instantiator, the "most natural" type for the
1522 instantiator's format is chosen. (For XBM, the most natural types are
1523 `mono-pixmap', followed by `color-pixmap', followed by `pointer'. For
1524 the other normal image formats, the most natural types are
1525 `color-pixmap', followed by `mono-pixmap', followed by `pointer'. For
1526 the string and formatted-string formats, the most natural types are
1527 `text', followed by `mono-pixmap' (not currently implemented),
1528 followed by `color-pixmap' (not currently implemented). For MS
1529 Windows resources, the most natural type for pointer resources is
1530 `pointer', and for the others it's `color-pixmap'. The other formats
1531 can only be instantiated as one type. (If you want to control more
1532 specifically the order of the types into which an image is
1533 instantiated, just call `make-image-instance' repeatedly until it
1534 succeeds, passing less and less preferred destination types each
1537 See `make-image-specifier' for a description of the different image
1538 instantiator formats.
1540 If DEST-TYPES is omitted, all possible types are allowed.
1542 DOMAIN specifies the domain to which the image instance will be attached.
1543 This domain is termed the \"governing domain\". The type of the governing
1544 domain depends on the image instantiator format. (Although, more correctly,
1545 it should probably depend on the image instance type.) For example, pixmap
1546 image instances are specific to a device, but widget image instances are
1547 specific to a particular XEmacs window because in order to display such a
1548 widget when two windows onto the same buffer want to display the widget,
1549 two separate underlying widgets must be created. (That's because a widget
1550 is actually a child window-system window, and all window-system windows have
1551 a unique existence on the screen.) This means that the governing domain for
1552 a pixmap image instance will be some device (most likely, the only existing
1553 device), whereas the governing domain for a widget image instance will be
1556 If you specify an overly general DOMAIN (e.g. a frame when a window was
1557 wanted), an error is signaled. If you specify an overly specific DOMAIN
1558 \(e.g. a window when a device was wanted), the corresponding general domain
1559 is fetched and used instead. For `make-image-instance', it makes no
1560 difference whether you specify an overly specific domain or the properly
1561 general domain derived from it. However, it does matter when creating an
1562 image instance by instantiating a specifier or glyph (e.g. with
1563 `glyph-image-instance'), because the more specific domain causes spec lookup
1564 to start there and proceed to more general domains. (It would also matter
1565 when creating an image instance with an instantiator format of `inherit',
1566 but we currently disallow this. #### We should fix this.)
1568 If omitted, DOMAIN defaults to the selected window.
1570 NOERROR controls what happens when the image cannot be generated.
1571 If nil, an error message is generated. If t, no messages are
1572 generated and this function returns nil. If anything else, a warning
1573 message is generated and this function returns nil.
1575 (data, domain, dest_types, noerror))
1577 Error_behavior errb = decode_error_behavior_flag (noerror);
1579 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1581 3, data, domain, dest_types);
1584 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1585 Return non-nil if OBJECT is an image instance.
1589 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1592 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1593 Return the type of the given image instance.
1594 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1595 'color-pixmap, 'pointer, or 'subwindow.
1599 CHECK_IMAGE_INSTANCE (image_instance);
1600 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1601 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1604 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1605 Return the name of the given image instance.
1609 CHECK_IMAGE_INSTANCE (image_instance);
1610 return XIMAGE_INSTANCE_NAME (image_instance);
1613 DEFUN ("image-instance-domain", Fimage_instance_domain, 1, 1, 0, /*
1614 Return the governing domain of the given image instance.
1615 The governing domain of an image instance is the domain that the image
1616 instance is specific to. It is NOT necessarily the domain that was
1617 given to the call to `specifier-instance' that resulted in the creation
1618 of this image instance. See `make-image-instance' for more information
1619 on governing domains.
1623 CHECK_IMAGE_INSTANCE (image_instance);
1624 return XIMAGE_INSTANCE_DOMAIN (image_instance);
1627 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1628 Return the string of the given image instance.
1629 This will only be non-nil for text image instances and widgets.
1633 CHECK_IMAGE_INSTANCE (image_instance);
1634 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1635 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1636 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1637 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1642 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1643 Return the given property of the given image instance.
1644 Returns nil if the property or the property method do not exist for
1645 the image instance in the domain.
1647 (image_instance, prop))
1649 Lisp_Image_Instance* ii;
1650 Lisp_Object type, ret;
1651 struct image_instantiator_methods* meths;
1653 CHECK_IMAGE_INSTANCE (image_instance);
1654 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1655 CHECK_SYMBOL (prop);
1656 ii = XIMAGE_INSTANCE (image_instance);
1658 /* ... then try device specific methods ... */
1659 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1660 meths = decode_device_ii_format (image_instance_device (image_instance),
1661 type, ERROR_ME_NOT);
1662 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1664 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1668 /* ... then format specific methods ... */
1669 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1670 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1672 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1680 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1681 Return the file name from which IMAGE-INSTANCE was read, if known.
1685 CHECK_IMAGE_INSTANCE (image_instance);
1686 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1688 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1690 case IMAGE_MONO_PIXMAP:
1691 case IMAGE_COLOR_PIXMAP:
1693 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1700 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1701 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1705 CHECK_IMAGE_INSTANCE (image_instance);
1706 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1708 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1710 case IMAGE_MONO_PIXMAP:
1711 case IMAGE_COLOR_PIXMAP:
1713 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1720 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1721 Return the depth of the image instance.
1722 This is 0 for a bitmap, or a positive integer for a pixmap.
1726 CHECK_IMAGE_INSTANCE (image_instance);
1727 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1729 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1731 case IMAGE_MONO_PIXMAP:
1732 case IMAGE_COLOR_PIXMAP:
1734 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1741 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1742 Return the height of the image instance, in pixels.
1746 CHECK_IMAGE_INSTANCE (image_instance);
1747 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1749 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1751 case IMAGE_MONO_PIXMAP:
1752 case IMAGE_COLOR_PIXMAP:
1754 case IMAGE_SUBWINDOW:
1756 return make_int (XIMAGE_INSTANCE_HEIGHT (image_instance));
1763 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1764 Return the width of the image instance, in pixels.
1768 CHECK_IMAGE_INSTANCE (image_instance);
1769 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1771 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1773 case IMAGE_MONO_PIXMAP:
1774 case IMAGE_COLOR_PIXMAP:
1776 case IMAGE_SUBWINDOW:
1778 return make_int (XIMAGE_INSTANCE_WIDTH (image_instance));
1785 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1786 Return the X coordinate of the image instance's hotspot, if known.
1787 This is a point relative to the origin of the pixmap. When an image is
1788 used as a mouse pointer, the hotspot is the point on the image that sits
1789 over the location that the pointer points to. This is, for example, the
1790 tip of the arrow or the center of the crosshairs.
1791 This will always be nil for a non-pointer image instance.
1795 CHECK_IMAGE_INSTANCE (image_instance);
1796 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1798 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1800 case IMAGE_MONO_PIXMAP:
1801 case IMAGE_COLOR_PIXMAP:
1803 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1810 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1811 Return the Y coordinate of the image instance's hotspot, if known.
1812 This is a point relative to the origin of the pixmap. When an image is
1813 used as a mouse pointer, the hotspot is the point on the image that sits
1814 over the location that the pointer points to. This is, for example, the
1815 tip of the arrow or the center of the crosshairs.
1816 This will always be nil for a non-pointer image instance.
1820 CHECK_IMAGE_INSTANCE (image_instance);
1821 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1823 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1825 case IMAGE_MONO_PIXMAP:
1826 case IMAGE_COLOR_PIXMAP:
1828 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1835 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1836 Return the foreground color of IMAGE-INSTANCE, if applicable.
1837 This will be a color instance or nil. (It will only be non-nil for
1838 colorized mono pixmaps and for pointers.)
1842 CHECK_IMAGE_INSTANCE (image_instance);
1843 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1845 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1847 case IMAGE_MONO_PIXMAP:
1848 case IMAGE_COLOR_PIXMAP:
1850 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1853 return FACE_FOREGROUND (
1854 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1855 XIMAGE_INSTANCE_FRAME
1863 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1864 Return the background color of IMAGE-INSTANCE, if applicable.
1865 This will be a color instance or nil. (It will only be non-nil for
1866 colorized mono pixmaps and for pointers.)
1870 CHECK_IMAGE_INSTANCE (image_instance);
1871 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1873 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1875 case IMAGE_MONO_PIXMAP:
1876 case IMAGE_COLOR_PIXMAP:
1878 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1881 return FACE_BACKGROUND (
1882 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1883 XIMAGE_INSTANCE_FRAME
1892 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1893 Make the image instance be displayed in the given colors.
1894 This function returns a new image instance that is exactly like the
1895 specified one except that (if possible) the foreground and background
1896 colors and as specified. Currently, this only does anything if the image
1897 instance is a mono pixmap; otherwise, the same image instance is returned.
1899 (image_instance, foreground, background))
1904 CHECK_IMAGE_INSTANCE (image_instance);
1905 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1906 CHECK_COLOR_INSTANCE (foreground);
1907 CHECK_COLOR_INSTANCE (background);
1909 device = image_instance_device (image_instance);
1910 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1911 return image_instance;
1913 /* #### There should be a copy_image_instance(), which calls a
1914 device-specific method to copy the window-system subobject. */
1915 new = allocate_image_instance (XIMAGE_INSTANCE_DOMAIN (image_instance),
1917 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1918 /* note that if this method returns non-zero, this method MUST
1919 copy any window-system resources, so that when one image instance is
1920 freed, the other one is not hosed. */
1921 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1923 return image_instance;
1928 /************************************************************************/
1929 /* Geometry calculations */
1930 /************************************************************************/
1932 /* Find out desired geometry of the image instance. If there is no
1933 special function then just return the width and / or height. */
1935 image_instance_query_geometry (Lisp_Object image_instance,
1936 int* width, int* height,
1937 enum image_instance_geometry disp,
1940 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1942 struct image_instantiator_methods* meths;
1943 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1945 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1946 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1948 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1950 IIFORMAT_METH (meths, query_geometry, (image_instance, width, height,
1956 *width = IMAGE_INSTANCE_WIDTH (ii);
1958 *height = IMAGE_INSTANCE_HEIGHT (ii);
1962 /* Layout the image instance using the provided dimensions. Layout
1963 widgets are going to do different kinds of calculations to
1964 determine what size to give things so we could make the layout
1965 function relatively simple to take account of that. An alternative
1966 approach is to consider separately the two cases, one where you
1967 don't mind what size you have (normal widgets) and one where you
1968 want to specify something (layout widgets). */
1970 image_instance_layout (Lisp_Object image_instance,
1971 int width, int height,
1972 int xoffset, int yoffset,
1975 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1977 struct image_instantiator_methods* meths;
1979 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1981 /* Nothing is as nothing does. */
1982 if (NOTHING_IMAGE_INSTANCEP (image_instance))
1985 /* We don't want carefully calculated offsets to be mucked up by
1987 if (xoffset != IMAGE_UNCHANGED_GEOMETRY)
1988 XIMAGE_INSTANCE_XOFFSET (image_instance) = xoffset;
1989 if (yoffset != IMAGE_UNCHANGED_GEOMETRY)
1990 XIMAGE_INSTANCE_YOFFSET (image_instance) = yoffset;
1992 assert (XIMAGE_INSTANCE_YOFFSET (image_instance) >= 0
1993 && XIMAGE_INSTANCE_XOFFSET (image_instance) >= 0);
1995 /* If geometry is unspecified then get some reasonable values for it. */
1996 if (width == IMAGE_UNSPECIFIED_GEOMETRY
1998 height == IMAGE_UNSPECIFIED_GEOMETRY)
2000 int dwidth = IMAGE_UNSPECIFIED_GEOMETRY;
2001 int dheight = IMAGE_UNSPECIFIED_GEOMETRY;
2002 /* Get the desired geometry. */
2003 image_instance_query_geometry (image_instance,
2005 IMAGE_DESIRED_GEOMETRY,
2007 /* Compare with allowed geometry. */
2008 if (width == IMAGE_UNSPECIFIED_GEOMETRY)
2010 if (height == IMAGE_UNSPECIFIED_GEOMETRY)
2014 /* If we don't have sane values then we cannot layout at this point and
2015 must just return. */
2016 if (width == IMAGE_UNSPECIFIED_GEOMETRY
2018 height == IMAGE_UNSPECIFIED_GEOMETRY)
2021 /* At this point width and height should contain sane values. Thus
2022 we set the glyph geometry and lay it out. */
2023 if (IMAGE_INSTANCE_WIDTH (ii) != width
2025 IMAGE_INSTANCE_HEIGHT (ii) != height)
2027 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
2030 IMAGE_INSTANCE_WIDTH (ii) = width;
2031 IMAGE_INSTANCE_HEIGHT (ii) = height;
2033 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
2034 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
2036 MAYBE_IIFORMAT_METH (meths, layout,
2037 (image_instance, width, height, xoffset, yoffset,
2039 /* Do not clear the dirty flag here - redisplay will do this for
2041 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0;
2044 /* Update an image instance from its changed instantiator. */
2046 update_image_instance (Lisp_Object image_instance,
2047 Lisp_Object instantiator)
2049 struct image_instantiator_methods* meths;
2050 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2052 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
2054 if (NOTHING_IMAGE_INSTANCEP (image_instance))
2057 assert (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0)
2058 || (internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0)
2059 && internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, -10)));
2061 /* If the instantiator is identical then do nothing. We must use
2062 equal here because the specifier code copies the instantiator. */
2063 if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0))
2065 /* Extract the changed properties so that device / format
2066 methods only have to cope with these. We assume that
2067 normalization has already been done. */
2068 Lisp_Object diffs = find_instantiator_differences
2070 IMAGE_INSTANCE_INSTANTIATOR (ii));
2071 Lisp_Object type = encode_image_instance_type
2072 (IMAGE_INSTANCE_TYPE (ii));
2073 struct gcpro gcpro1;
2076 /* try device specific methods first ... */
2077 meths = decode_device_ii_format (image_instance_device (image_instance),
2078 type, ERROR_ME_NOT);
2079 MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs));
2080 /* ... then format specific methods ... */
2081 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
2082 MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs));
2084 /* Instance and therefore glyph has changed so mark as dirty.
2085 If we don't do this output optimizations will assume the
2086 glyph is unchanged. */
2087 set_image_instance_dirty_p (image_instance, 1);
2088 /* Structure has changed. */
2089 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
2093 /* We should now have a consistent instantiator so keep a record of
2094 it. It is important that we don't actually update the window
2095 system widgets here - we must do that when redisplay tells us
2098 #### should we delay doing this until the display is up-to-date
2100 IMAGE_INSTANCE_INSTANTIATOR (ii) = instantiator;
2104 * Mark image instance in W as dirty if (a) W's faces have changed and
2105 * (b) GLYPH_OR_II instance in W is a string.
2107 * Return non-zero if instance has been marked dirty.
2110 invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w)
2112 if (XFRAME(WINDOW_FRAME(w))->faces_changed)
2114 Lisp_Object image = glyph_or_ii;
2116 if (GLYPHP (glyph_or_ii))
2119 XSETWINDOW (window, w);
2120 image = glyph_image_instance (glyph_or_ii, window, ERROR_ME_NOT, 1);
2123 if (TEXT_IMAGE_INSTANCEP (image))
2125 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image);
2126 IMAGE_INSTANCE_DIRTYP (ii) = 1;
2127 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
2128 if (GLYPHP (glyph_or_ii))
2129 XGLYPH_DIRTYP (glyph_or_ii) = 1;
2138 /************************************************************************/
2140 /************************************************************************/
2142 signal_image_error (const char *reason, Lisp_Object frob)
2144 signal_error (Qimage_conversion_error,
2145 list2 (build_translated_string (reason), frob));
2149 signal_image_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1)
2151 signal_error (Qimage_conversion_error,
2152 list3 (build_translated_string (reason), frob0, frob1));
2155 /****************************************************************************
2157 ****************************************************************************/
2160 nothing_possible_dest_types (void)
2162 return IMAGE_NOTHING_MASK;
2166 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2167 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2168 int dest_mask, Lisp_Object domain)
2170 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2172 if (dest_mask & IMAGE_NOTHING_MASK)
2174 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
2175 IMAGE_INSTANCE_HEIGHT (ii) = 0;
2176 IMAGE_INSTANCE_WIDTH (ii) = 0;
2179 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
2183 /****************************************************************************
2185 ****************************************************************************/
2188 inherit_validate (Lisp_Object instantiator)
2190 face_must_be_present (instantiator);
2194 inherit_normalize (Lisp_Object inst, Lisp_Object console_type,
2195 Lisp_Object dest_mask)
2199 assert (XVECTOR_LENGTH (inst) == 3);
2200 face = XVECTOR_DATA (inst)[2];
2202 inst = vector3 (Qinherit, Q_face, Fget_face (face));
2207 inherit_possible_dest_types (void)
2209 return IMAGE_MONO_PIXMAP_MASK;
2213 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2214 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2215 int dest_mask, Lisp_Object domain)
2217 /* handled specially in image_instantiate */
2222 /****************************************************************************
2224 ****************************************************************************/
2227 string_validate (Lisp_Object instantiator)
2229 data_must_be_present (instantiator);
2233 string_possible_dest_types (void)
2235 return IMAGE_TEXT_MASK;
2238 /* Called from autodetect_instantiate() */
2240 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2241 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2242 int dest_mask, Lisp_Object domain)
2244 Lisp_Object string = find_keyword_in_vector (instantiator, Q_data);
2245 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2247 /* Should never get here with a domain other than a window. */
2248 assert (!NILP (string) && WINDOWP (DOMAIN_WINDOW (domain)));
2249 if (dest_mask & IMAGE_TEXT_MASK)
2251 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
2252 IMAGE_INSTANCE_TEXT_STRING (ii) = string;
2255 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
2258 /* Sort out the size of the text that is being displayed. Calculating
2259 it dynamically allows us to change the text and still see
2260 everything. Note that the following methods are for text not string
2261 since that is what the instantiated type is. The first method is a
2262 helper that is used elsewhere for calculating text geometry. */
2264 query_string_geometry (Lisp_Object string, Lisp_Object face,
2265 int* width, int* height, int* descent, Lisp_Object domain)
2267 struct font_metric_info fm;
2268 Charset_ID charsets[NUM_LEADING_BYTES];
2269 struct face_cachel frame_cachel;
2270 struct face_cachel *cachel;
2271 Lisp_Object frame = DOMAIN_FRAME (domain);
2273 CHECK_STRING (string);
2275 /* Compute height */
2278 /* Compute string metric info */
2279 find_charsets_in_bufbyte_string (charsets,
2280 XSTRING_DATA (string),
2281 XSTRING_LENGTH (string));
2283 /* Fallback to the default face if none was provided. */
2286 reset_face_cachel (&frame_cachel);
2287 update_face_cachel_data (&frame_cachel, frame, face);
2288 cachel = &frame_cachel;
2292 cachel = WINDOW_FACE_CACHEL (DOMAIN_XWINDOW (domain),
2296 ensure_face_cachel_complete (cachel, domain, charsets);
2297 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
2299 *height = fm.ascent + fm.descent;
2300 /* #### descent only gets set if we query the height as well. */
2302 *descent = fm.descent;
2309 *width = redisplay_frame_text_width_string (XFRAME (frame),
2313 *width = redisplay_frame_text_width_string (XFRAME (frame),
2320 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain)
2322 Charset_ID charsets[NUM_LEADING_BYTES];
2323 struct face_cachel frame_cachel;
2324 struct face_cachel *cachel;
2326 Lisp_Object frame = DOMAIN_FRAME (domain);
2328 /* Compute string font info */
2329 find_charsets_in_bufbyte_string (charsets,
2330 XSTRING_DATA (string),
2331 XSTRING_LENGTH (string));
2333 reset_face_cachel (&frame_cachel);
2334 update_face_cachel_data (&frame_cachel, frame, face);
2335 cachel = &frame_cachel;
2337 ensure_face_cachel_complete (cachel, domain, charsets);
2339 for (i = 0; i < NUM_LEADING_BYTES; i++)
2343 return FACE_CACHEL_FONT (cachel,
2344 CHARSET_BY_LEADING_BYTE (i +
2350 return Qnil; /* NOT REACHED */
2354 text_query_geometry (Lisp_Object image_instance,
2355 int* width, int* height,
2356 enum image_instance_geometry disp, Lisp_Object domain)
2358 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2361 query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii),
2362 IMAGE_INSTANCE_FACE (ii),
2363 width, height, &descent, domain);
2365 /* The descent gets set as a side effect of querying the
2367 IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent;
2370 /* set the properties of a string */
2372 text_update (Lisp_Object image_instance, Lisp_Object instantiator)
2374 Lisp_Object val = find_keyword_in_vector (instantiator, Q_data);
2379 XIMAGE_INSTANCE_TEXT_STRING (image_instance) = val;
2384 /****************************************************************************
2385 * formatted-string *
2386 ****************************************************************************/
2389 formatted_string_validate (Lisp_Object instantiator)
2391 data_must_be_present (instantiator);
2395 formatted_string_possible_dest_types (void)
2397 return IMAGE_TEXT_MASK;
2401 formatted_string_instantiate (Lisp_Object image_instance,
2402 Lisp_Object instantiator,
2403 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2404 int dest_mask, Lisp_Object domain)
2406 /* #### implement this */
2407 warn_when_safe (Qunimplemented, Qnotice,
2408 "`formatted-string' not yet implemented; assuming `string'");
2410 string_instantiate (image_instance, instantiator,
2411 pointer_fg, pointer_bg, dest_mask, domain);
2415 /************************************************************************/
2416 /* pixmap file functions */
2417 /************************************************************************/
2419 /* If INSTANTIATOR refers to inline data, return Qnil.
2420 If INSTANTIATOR refers to data in a file, return the full filename
2421 if it exists; otherwise, return a cons of (filename).
2423 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
2424 keywords used to look up the file and inline data,
2425 respectively, in the instantiator. Normally these would
2426 be Q_file and Q_data, but might be different for mask data. */
2429 potential_pixmap_file_instantiator (Lisp_Object instantiator,
2430 Lisp_Object file_keyword,
2431 Lisp_Object data_keyword,
2432 Lisp_Object console_type)
2437 assert (VECTORP (instantiator));
2439 data = find_keyword_in_vector (instantiator, data_keyword);
2440 file = find_keyword_in_vector (instantiator, file_keyword);
2442 if (!NILP (file) && NILP (data))
2444 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
2445 (decode_console_type(console_type, ERROR_ME),
2446 locate_pixmap_file, (file));
2451 return Fcons (file, Qnil); /* should have been file */
2458 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
2459 Lisp_Object image_type_tag)
2461 /* This function can call lisp */
2462 Lisp_Object file = Qnil;
2463 struct gcpro gcpro1, gcpro2;
2464 Lisp_Object alist = Qnil;
2466 GCPRO2 (file, alist);
2468 /* Now, convert any file data into inline data. At the end of this,
2469 `data' will contain the inline data (if any) or Qnil, and `file'
2470 will contain the name this data was derived from (if known) or
2473 Note that if we cannot generate any regular inline data, we
2476 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2479 if (CONSP (file)) /* failure locating filename */
2480 signal_double_file_error ("Opening pixmap file",
2481 "no such file or directory",
2484 if (NILP (file)) /* no conversion necessary */
2485 RETURN_UNGCPRO (inst);
2487 alist = tagged_vector_to_alist (inst);
2490 Lisp_Object data = make_string_from_file (file);
2491 alist = remassq_no_quit (Q_file, alist);
2492 /* there can't be a :data at this point. */
2493 alist = Fcons (Fcons (Q_file, file),
2494 Fcons (Fcons (Q_data, data), alist));
2498 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
2500 RETURN_UNGCPRO (result);
2505 #ifdef HAVE_WINDOW_SYSTEM
2506 /**********************************************************************
2508 **********************************************************************/
2510 /* Check if DATA represents a valid inline XBM spec (i.e. a list
2511 of (width height bits), with checking done on the dimensions).
2512 If not, signal an error. */
2515 check_valid_xbm_inline (Lisp_Object data)
2517 Lisp_Object width, height, bits;
2519 if (!CONSP (data) ||
2520 !CONSP (XCDR (data)) ||
2521 !CONSP (XCDR (XCDR (data))) ||
2522 !NILP (XCDR (XCDR (XCDR (data)))))
2523 signal_simple_error ("Must be list of 3 elements", data);
2525 width = XCAR (data);
2526 height = XCAR (XCDR (data));
2527 bits = XCAR (XCDR (XCDR (data)));
2529 CHECK_STRING (bits);
2531 if (!NATNUMP (width))
2532 signal_simple_error ("Width must be a natural number", width);
2534 if (!NATNUMP (height))
2535 signal_simple_error ("Height must be a natural number", height);
2537 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
2538 signal_simple_error ("data is too short for width and height",
2539 vector3 (width, height, bits));
2542 /* Validate method for XBM's. */
2545 xbm_validate (Lisp_Object instantiator)
2547 file_or_data_must_be_present (instantiator);
2550 /* Given a filename that is supposed to contain XBM data, return
2551 the inline representation of it as (width height bits). Return
2552 the hotspot through XHOT and YHOT, if those pointers are not 0.
2553 If there is no hotspot, XHOT and YHOT will contain -1.
2555 If the function fails:
2557 -- if OK_IF_DATA_INVALID is set and the data was invalid,
2559 -- maybe return an error, or return Qnil.
2562 #ifdef HAVE_X_WINDOWS
2563 #include <X11/Xlib.h>
2565 #define XFree(data) free(data)
2569 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
2570 int ok_if_data_invalid)
2575 const char *filename_ext;
2577 LISP_STRING_TO_EXTERNAL (name, filename_ext, Qfile_name);
2578 result = read_bitmap_data_from_file (filename_ext, &w, &h,
2579 (unsigned char **) &data, xhot, yhot);
2581 if (result == BitmapSuccess)
2584 int len = (w + 7) / 8 * h;
2586 retval = list3 (make_int (w), make_int (h),
2587 make_ext_string (data, len, Qbinary));
2594 case BitmapOpenFailed:
2596 /* should never happen */
2597 signal_double_file_error ("Opening bitmap file",
2598 "no such file or directory",
2601 case BitmapFileInvalid:
2603 if (ok_if_data_invalid)
2605 signal_double_file_error ("Reading bitmap file",
2606 "invalid data in file",
2609 case BitmapNoMemory:
2611 signal_double_file_error ("Reading bitmap file",
2617 signal_double_file_error_2 ("Reading bitmap file",
2618 "unknown error code",
2619 make_int (result), name);
2623 return Qnil; /* not reached */
2627 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2628 Lisp_Object mask_file, Lisp_Object console_type)
2630 /* This is unclean but it's fairly standard -- a number of the
2631 bitmaps in /usr/include/X11/bitmaps use it -- so we support
2633 if (NILP (mask_file)
2634 /* don't override explicitly specified mask data. */
2635 && NILP (assq_no_quit (Q_mask_data, alist))
2638 mask_file = MAYBE_LISP_CONTYPE_METH
2639 (decode_console_type(console_type, ERROR_ME),
2640 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
2641 if (NILP (mask_file))
2642 mask_file = MAYBE_LISP_CONTYPE_METH
2643 (decode_console_type(console_type, ERROR_ME),
2644 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
2647 if (!NILP (mask_file))
2649 Lisp_Object mask_data =
2650 bitmap_to_lisp_data (mask_file, 0, 0, 0);
2651 alist = remassq_no_quit (Q_mask_file, alist);
2652 /* there can't be a :mask-data at this point. */
2653 alist = Fcons (Fcons (Q_mask_file, mask_file),
2654 Fcons (Fcons (Q_mask_data, mask_data), alist));
2660 /* Normalize method for XBM's. */
2663 xbm_normalize (Lisp_Object inst, Lisp_Object console_type,
2664 Lisp_Object dest_mask)
2666 Lisp_Object file = Qnil, mask_file = Qnil;
2667 struct gcpro gcpro1, gcpro2, gcpro3;
2668 Lisp_Object alist = Qnil;
2670 GCPRO3 (file, mask_file, alist);
2672 /* Now, convert any file data into inline data for both the regular
2673 data and the mask data. At the end of this, `data' will contain
2674 the inline data (if any) or Qnil, and `file' will contain
2675 the name this data was derived from (if known) or Qnil.
2676 Likewise for `mask_file' and `mask_data'.
2678 Note that if we cannot generate any regular inline data, we
2681 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2683 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2684 Q_mask_data, console_type);
2686 if (CONSP (file)) /* failure locating filename */
2687 signal_double_file_error ("Opening bitmap file",
2688 "no such file or directory",
2691 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2692 RETURN_UNGCPRO (inst);
2694 alist = tagged_vector_to_alist (inst);
2699 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
2700 alist = remassq_no_quit (Q_file, alist);
2701 /* there can't be a :data at this point. */
2702 alist = Fcons (Fcons (Q_file, file),
2703 Fcons (Fcons (Q_data, data), alist));
2705 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2706 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2708 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2709 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2713 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2716 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2718 RETURN_UNGCPRO (result);
2724 xbm_possible_dest_types (void)
2727 IMAGE_MONO_PIXMAP_MASK |
2728 IMAGE_COLOR_PIXMAP_MASK |
2736 /**********************************************************************
2738 **********************************************************************/
2741 xface_validate (Lisp_Object instantiator)
2743 file_or_data_must_be_present (instantiator);
2747 xface_normalize (Lisp_Object inst, Lisp_Object console_type,
2748 Lisp_Object dest_mask)
2750 /* This function can call lisp */
2751 Lisp_Object file = Qnil, mask_file = Qnil;
2752 struct gcpro gcpro1, gcpro2, gcpro3;
2753 Lisp_Object alist = Qnil;
2755 GCPRO3 (file, mask_file, alist);
2757 /* Now, convert any file data into inline data for both the regular
2758 data and the mask data. At the end of this, `data' will contain
2759 the inline data (if any) or Qnil, and `file' will contain
2760 the name this data was derived from (if known) or Qnil.
2761 Likewise for `mask_file' and `mask_data'.
2763 Note that if we cannot generate any regular inline data, we
2766 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2768 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2769 Q_mask_data, console_type);
2771 if (CONSP (file)) /* failure locating filename */
2772 signal_double_file_error ("Opening bitmap file",
2773 "no such file or directory",
2776 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2777 RETURN_UNGCPRO (inst);
2779 alist = tagged_vector_to_alist (inst);
2782 Lisp_Object data = make_string_from_file (file);
2783 alist = remassq_no_quit (Q_file, alist);
2784 /* there can't be a :data at this point. */
2785 alist = Fcons (Fcons (Q_file, file),
2786 Fcons (Fcons (Q_data, data), alist));
2789 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2792 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2794 RETURN_UNGCPRO (result);
2799 xface_possible_dest_types (void)
2802 IMAGE_MONO_PIXMAP_MASK |
2803 IMAGE_COLOR_PIXMAP_MASK |
2807 #endif /* HAVE_XFACE */
2812 /**********************************************************************
2814 **********************************************************************/
2817 /* Gtk has to be gratuitously different, eh? */
2819 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2821 return (make_string_from_file (name));
2825 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2831 LISP_STRING_TO_EXTERNAL (name, fname, Qfile_name);
2832 result = XpmReadFileToData (fname, &data);
2834 if (result == XpmSuccess)
2836 Lisp_Object retval = Qnil;
2837 struct buffer *old_buffer = current_buffer;
2838 Lisp_Object temp_buffer =
2839 Fget_buffer_create (build_string (" *pixmap conversion*"));
2841 int height, width, ncolors;
2842 struct gcpro gcpro1, gcpro2, gcpro3;
2843 int speccount = specpdl_depth ();
2845 GCPRO3 (name, retval, temp_buffer);
2847 specbind (Qinhibit_quit, Qt);
2848 set_buffer_internal (XBUFFER (temp_buffer));
2849 Ferase_buffer (Qnil);
2851 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2852 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2854 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2855 for (elt = 0; elt <= width + ncolors; elt++)
2857 buffer_insert_c_string (current_buffer, "\"");
2858 buffer_insert_c_string (current_buffer, data[elt]);
2860 if (elt < width + ncolors)
2861 buffer_insert_c_string (current_buffer, "\",\r");
2863 buffer_insert_c_string (current_buffer, "\"};\r");
2866 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2869 set_buffer_internal (old_buffer);
2870 unbind_to (speccount, Qnil);
2872 RETURN_UNGCPRO (retval);
2877 case XpmFileInvalid:
2879 if (ok_if_data_invalid)
2881 signal_image_error ("invalid XPM data in file", name);
2885 signal_double_file_error ("Reading pixmap file",
2886 "out of memory", name);
2890 /* should never happen? */
2891 signal_double_file_error ("Opening pixmap file",
2892 "no such file or directory", name);
2896 signal_double_file_error_2 ("Parsing pixmap file",
2897 "unknown error code",
2898 make_int (result), name);
2903 return Qnil; /* not reached */
2905 #endif /* !HAVE_GTK */
2908 check_valid_xpm_color_symbols (Lisp_Object data)
2912 for (rest = data; !NILP (rest); rest = XCDR (rest))
2914 if (!CONSP (rest) ||
2915 !CONSP (XCAR (rest)) ||
2916 !STRINGP (XCAR (XCAR (rest))) ||
2917 (!STRINGP (XCDR (XCAR (rest))) &&
2918 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2919 signal_simple_error ("Invalid color symbol alist", data);
2924 xpm_validate (Lisp_Object instantiator)
2926 file_or_data_must_be_present (instantiator);
2929 Lisp_Object Vxpm_color_symbols;
2932 evaluate_xpm_color_symbols (void)
2934 Lisp_Object rest, results = Qnil;
2935 struct gcpro gcpro1, gcpro2;
2937 GCPRO2 (rest, results);
2938 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2940 Lisp_Object name, value, cons;
2946 CHECK_STRING (name);
2947 value = XCDR (cons);
2949 value = XCAR (value);
2950 value = Feval (value);
2953 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2955 ("Result from xpm-color-symbols eval must be nil, string, or color",
2957 results = Fcons (Fcons (name, value), results);
2959 UNGCPRO; /* no more evaluation */
2964 xpm_normalize (Lisp_Object inst, Lisp_Object console_type,
2965 Lisp_Object dest_mask)
2967 Lisp_Object file = Qnil;
2968 Lisp_Object color_symbols;
2969 struct gcpro gcpro1, gcpro2;
2970 Lisp_Object alist = Qnil;
2972 GCPRO2 (file, alist);
2974 /* Now, convert any file data into inline data. At the end of this,
2975 `data' will contain the inline data (if any) or Qnil, and
2976 `file' will contain the name this data was derived from (if
2979 Note that if we cannot generate any regular inline data, we
2982 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2985 if (CONSP (file)) /* failure locating filename */
2986 signal_double_file_error ("Opening pixmap file",
2987 "no such file or directory",
2990 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2993 if (NILP (file) && !UNBOUNDP (color_symbols))
2994 /* no conversion necessary */
2995 RETURN_UNGCPRO (inst);
2997 alist = tagged_vector_to_alist (inst);
3001 Lisp_Object data = pixmap_to_lisp_data (file, 0);
3002 alist = remassq_no_quit (Q_file, alist);
3003 /* there can't be a :data at this point. */
3004 alist = Fcons (Fcons (Q_file, file),
3005 Fcons (Fcons (Q_data, data), alist));
3008 if (UNBOUNDP (color_symbols))
3010 color_symbols = evaluate_xpm_color_symbols ();
3011 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
3016 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
3018 RETURN_UNGCPRO (result);
3023 xpm_possible_dest_types (void)
3026 IMAGE_MONO_PIXMAP_MASK |
3027 IMAGE_COLOR_PIXMAP_MASK |
3031 #endif /* HAVE_XPM */
3034 /****************************************************************************
3035 * Image Specifier Object *
3036 ****************************************************************************/
3038 DEFINE_SPECIFIER_TYPE (image);
3041 image_create (Lisp_Object obj)
3043 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3045 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
3046 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
3047 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
3051 image_mark (Lisp_Object obj)
3053 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3055 mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
3056 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
3060 instantiator_eq_equal (Lisp_Object obj1, Lisp_Object obj2)
3062 if (EQ (obj1, obj2))
3065 else if (CONSP (obj1) && CONSP (obj2))
3067 return instantiator_eq_equal (XCAR (obj1), XCAR (obj2))
3069 instantiator_eq_equal (XCDR (obj1), XCDR (obj2));
3075 instantiator_eq_hash (Lisp_Object obj)
3079 /* no point in worrying about tail recursion, since we're not
3081 return HASH2 (instantiator_eq_hash (XCAR (obj)),
3082 instantiator_eq_hash (XCDR (obj)));
3084 return LISP_HASH (obj);
3087 /* We need a special hash table for storing image instances. */
3089 make_image_instance_cache_hash_table (void)
3091 return make_general_lisp_hash_table
3092 (instantiator_eq_hash, instantiator_eq_equal,
3094 HASH_TABLE_KEY_CAR_VALUE_WEAK);
3098 image_instantiate_cache_result (Lisp_Object locative)
3100 /* locative = (instance instantiator . subtable)
3102 So we are using the instantiator as the key and the instance as
3103 the value. Since the hashtable is key-weak this means that the
3104 image instance will stay around as long as the instantiator stays
3105 around. The instantiator is stored in the `image' slot of the
3106 glyph, so as long as the glyph is marked the instantiator will be
3107 as well and hence the cached image instance also.*/
3108 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
3109 free_cons (XCONS (XCDR (locative)));
3110 free_cons (XCONS (locative));
3114 /* Given a specification for an image, return an instance of
3115 the image which matches the given instantiator and which can be
3116 displayed in the given domain. */
3119 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
3120 Lisp_Object domain, Lisp_Object instantiator,
3123 Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
3124 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
3125 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
3127 if (IMAGE_INSTANCEP (instantiator))
3129 /* make sure that the image instance's governing domain and type are
3131 Lisp_Object governing_domain = XIMAGE_INSTANCE_DOMAIN (instantiator);
3133 if ((DEVICEP (governing_domain)
3134 && EQ (governing_domain, DOMAIN_DEVICE (domain)))
3135 || (FRAMEP (governing_domain)
3136 && EQ (governing_domain, DOMAIN_FRAME (domain)))
3137 || (WINDOWP (governing_domain)
3138 && EQ (governing_domain, DOMAIN_WINDOW (domain))))
3141 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
3142 if (mask & dest_mask)
3143 return instantiator;
3145 signal_simple_error ("Type of image instance not allowed here",
3149 signal_simple_error_2 ("Wrong domain for image instance",
3150 instantiator, domain);
3152 /* How ugly !! An image instanciator that uses a kludgy syntax to snarf in
3153 face properties. There's a design flaw here. -- didier */
3154 else if (VECTORP (instantiator)
3155 && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit))
3157 assert (XVECTOR_LENGTH (instantiator) == 3);
3158 return (FACE_PROPERTY_INSTANCE
3159 (Fget_face (XVECTOR_DATA (instantiator)[2]),
3160 Qbackground_pixmap, domain, 1, depth));
3164 Lisp_Object instance = Qnil;
3165 Lisp_Object subtable = Qnil;
3166 /* #### Should this be GCPRO'd? */
3167 Lisp_Object hash_key = Qnil;
3168 Lisp_Object pointer_fg = Qnil;
3169 Lisp_Object pointer_bg = Qnil;
3170 Lisp_Object governing_domain =
3171 get_image_instantiator_governing_domain (instantiator, domain);
3172 struct gcpro gcpro1;
3176 /* We have to put subwindow, widget and text image instances in
3177 a per-window cache so that we can see the same glyph in
3178 different windows. We use governing_domain to determine the type
3179 of image_instance that will be created. */
3183 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
3184 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
3185 hash_key = list4 (glyph, INSTANTIATOR_TYPE (instantiator),
3186 pointer_fg, pointer_bg);
3189 /* We cannot simply key on the glyph since fallbacks could use
3190 the same glyph but have a totally different instantiator
3191 type. Thus we key on the glyph and the type (but not any
3192 other parts of the instantiator. */
3193 hash_key = list2 (glyph, INSTANTIATOR_TYPE (instantiator));
3195 /* First look in the device cache. */
3196 if (DEVICEP (governing_domain))
3198 subtable = Fgethash (make_int (dest_mask),
3199 XDEVICE (governing_domain)->
3200 image_instance_cache,
3202 if (UNBOUNDP (subtable))
3204 /* For the image instance cache, we do comparisons with
3205 EQ rather than with EQUAL, as we do for color and
3206 font names. The reasons are:
3208 1) pixmap data can be very long, and thus the hashing
3209 and comparing will take awhile.
3211 2) It's not so likely that we'll run into things that
3212 are EQUAL but not EQ (that can happen a lot with
3213 faces, because their specifiers are copied around);
3214 but pixmaps tend not to be in faces.
3216 However, if the image-instance could be a pointer, we
3217 have to use EQUAL because we massaged the
3218 instantiator into a cons3 also containing the
3219 foreground and background of the pointer face. */
3220 subtable = make_image_instance_cache_hash_table ();
3222 Fputhash (make_int (dest_mask), subtable,
3223 XDEVICE (governing_domain)->image_instance_cache);
3224 instance = Qunbound;
3228 instance = Fgethash (hash_key, subtable, Qunbound);
3231 else if (WINDOWP (governing_domain))
3233 /* Subwindows have a per-window cache and have to be treated
3237 XWINDOW (governing_domain)->subwindow_instance_cache,
3241 abort (); /* We're not allowed anything else currently. */
3243 /* If we don't have an instance at this point then create
3245 if (UNBOUNDP (instance))
3247 Lisp_Object locative =
3249 noseeum_cons (hash_key,
3250 DEVICEP (governing_domain) ? subtable
3251 : XWINDOW (governing_domain)
3252 ->subwindow_instance_cache));
3253 int speccount = specpdl_depth ();
3255 /* Make sure we cache the failures, too. Use an
3256 unwind-protect to catch such errors. If we fail, the
3257 unwind-protect records nil in the hash table. If we
3258 succeed, we change the car of the locative to the
3259 resulting instance, which gets recorded instead. */
3260 record_unwind_protect (image_instantiate_cache_result,
3263 instantiate_image_instantiator (governing_domain,
3264 domain, instantiator,
3265 pointer_fg, pointer_bg,
3268 /* We need a per-frame cache for redisplay. */
3269 cache_subwindow_instance_in_frame_maybe (instance);
3271 Fsetcar (locative, instance);
3272 #ifdef ERROR_CHECK_GLYPHS
3273 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
3274 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
3275 assert (EQ (XIMAGE_INSTANCE_FRAME (instance),
3276 DOMAIN_FRAME (domain)));
3278 unbind_to (speccount, Qnil);
3279 #ifdef ERROR_CHECK_GLYPHS
3280 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
3281 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
3282 assert (EQ (Fgethash (hash_key,
3283 XWINDOW (governing_domain)
3284 ->subwindow_instance_cache,
3285 Qunbound), instance));
3288 else if (NILP (instance))
3289 signal_simple_error ("Can't instantiate image (probably cached)",
3291 /* We found an instance. However, because we are using the glyph
3292 as the hash key instead of the instantiator, the current
3293 instantiator may not be the same as the original. Thus we
3294 must update the instance based on the new
3295 instantiator. Preserving instance identity like this is
3296 important to stop excessive window system widget creation and
3297 deletion - and hence flashing. */
3300 /* #### This function should be able to cope with *all*
3301 changes to the instantiator, but currently only copes
3302 with the most used properties. This means that it is
3303 possible to make changes that don't get reflected in the
3305 update_image_instance (instance, instantiator);
3306 free_list (hash_key);
3309 #ifdef ERROR_CHECK_GLYPHS
3310 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
3311 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
3312 assert (EQ (XIMAGE_INSTANCE_FRAME (instance),
3313 DOMAIN_FRAME (domain)));
3315 ERROR_CHECK_IMAGE_INSTANCE (instance);
3316 RETURN_UNGCPRO (instance);
3320 return Qnil; /* not reached */
3323 /* Validate an image instantiator. */
3326 image_validate (Lisp_Object instantiator)
3328 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
3330 else if (VECTORP (instantiator))
3332 Lisp_Object *elt = XVECTOR_DATA (instantiator);
3333 int instantiator_len = XVECTOR_LENGTH (instantiator);
3334 struct image_instantiator_methods *meths;
3335 Lisp_Object already_seen = Qnil;
3336 struct gcpro gcpro1;
3339 if (instantiator_len < 1)
3340 signal_simple_error ("Vector length must be at least 1",
3343 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
3344 if (!(instantiator_len & 1))
3346 ("Must have alternating keyword/value pairs", instantiator);
3348 GCPRO1 (already_seen);
3350 for (i = 1; i < instantiator_len; i += 2)
3352 Lisp_Object keyword = elt[i];
3353 Lisp_Object value = elt[i+1];
3356 CHECK_SYMBOL (keyword);
3357 if (!SYMBOL_IS_KEYWORD (keyword))
3358 signal_simple_error ("Symbol must begin with a colon", keyword);
3360 for (j = 0; j < Dynarr_length (meths->keywords); j++)
3361 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
3364 if (j == Dynarr_length (meths->keywords))
3365 signal_simple_error ("Unrecognized keyword", keyword);
3367 if (!Dynarr_at (meths->keywords, j).multiple_p)
3369 if (!NILP (memq_no_quit (keyword, already_seen)))
3371 ("Keyword may not appear more than once", keyword);
3372 already_seen = Fcons (keyword, already_seen);
3375 (Dynarr_at (meths->keywords, j).validate) (value);
3380 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
3383 signal_simple_error ("Must be string or vector", instantiator);
3387 image_after_change (Lisp_Object specifier, Lisp_Object locale)
3389 Lisp_Object attachee =
3390 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
3391 Lisp_Object property =
3392 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
3393 if (FACEP (attachee))
3395 face_property_was_changed (attachee, property, locale);
3396 if (BUFFERP (locale))
3397 XBUFFER (locale)->buffer_local_face_property = 1;
3399 else if (GLYPHP (attachee))
3400 glyph_property_was_changed (attachee, property, locale);
3404 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
3405 Lisp_Object property)
3407 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3409 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
3410 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
3414 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
3415 Lisp_Object tag_set, Lisp_Object instantiator)
3417 Lisp_Object possible_console_types = Qnil;
3419 Lisp_Object retlist = Qnil;
3420 struct gcpro gcpro1, gcpro2;
3422 LIST_LOOP (rest, Vconsole_type_list)
3424 Lisp_Object contype = XCAR (rest);
3425 if (!NILP (memq_no_quit (contype, tag_set)))
3426 possible_console_types = Fcons (contype, possible_console_types);
3429 if (XINT (Flength (possible_console_types)) > 1)
3430 /* two conflicting console types specified */
3433 if (NILP (possible_console_types))
3434 possible_console_types = Vconsole_type_list;
3436 GCPRO2 (retlist, possible_console_types);
3438 LIST_LOOP (rest, possible_console_types)
3440 Lisp_Object contype = XCAR (rest);
3441 Lisp_Object newinst = call_with_suspended_errors
3442 ((lisp_fn_t) normalize_image_instantiator,
3443 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
3444 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
3446 if (!NILP (newinst))
3449 if (NILP (memq_no_quit (contype, tag_set)))
3450 newtag = Fcons (contype, tag_set);
3453 retlist = Fcons (Fcons (newtag, newinst), retlist);
3462 /* Copy an image instantiator. We can't use Fcopy_tree since widgets
3463 may contain circular references which would send Fcopy_tree into
3466 image_copy_vector_instantiator (Lisp_Object instantiator)
3469 struct image_instantiator_methods *meths;
3471 int instantiator_len;
3473 CHECK_VECTOR (instantiator);
3475 instantiator = Fcopy_sequence (instantiator);
3476 elt = XVECTOR_DATA (instantiator);
3477 instantiator_len = XVECTOR_LENGTH (instantiator);
3479 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
3481 for (i = 1; i < instantiator_len; i += 2)
3484 Lisp_Object keyword = elt[i];
3485 Lisp_Object value = elt[i+1];
3487 /* Find the keyword entry. */
3488 for (j = 0; j < Dynarr_length (meths->keywords); j++)
3490 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
3494 /* Only copy keyword values that should be copied. */
3495 if (Dynarr_at (meths->keywords, j).copy_p
3497 (CONSP (value) || VECTORP (value)))
3499 elt [i+1] = Fcopy_tree (value, Qt);
3503 return instantiator;
3507 image_copy_instantiator (Lisp_Object arg)
3512 rest = arg = Fcopy_sequence (arg);
3513 while (CONSP (rest))
3515 Lisp_Object elt = XCAR (rest);
3517 XCAR (rest) = Fcopy_tree (elt, Qt);
3518 else if (VECTORP (elt))
3519 XCAR (rest) = image_copy_vector_instantiator (elt);
3520 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
3521 XCDR (rest) = Fcopy_tree (XCDR (rest), Qt);
3525 else if (VECTORP (arg))
3527 arg = image_copy_vector_instantiator (arg);
3532 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
3533 Return non-nil if OBJECT is an image specifier.
3534 See `make-image-specifier' for a description of image instantiators.
3538 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
3542 /****************************************************************************
3544 ****************************************************************************/
3547 mark_glyph (Lisp_Object obj)
3549 Lisp_Glyph *glyph = XGLYPH (obj);
3551 mark_object (glyph->image);
3552 mark_object (glyph->contrib_p);
3553 mark_object (glyph->baseline);
3554 mark_object (glyph->face);
3556 return glyph->plist;
3560 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3562 Lisp_Glyph *glyph = XGLYPH (obj);
3566 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
3568 write_c_string ("#<glyph (", printcharfun);
3569 print_internal (Fglyph_type (obj), printcharfun, 0);
3570 write_c_string (") ", printcharfun);
3571 print_internal (glyph->image, printcharfun, 1);
3572 sprintf (buf, "0x%x>", glyph->header.uid);
3573 write_c_string (buf, printcharfun);
3576 /* Glyphs are equal if all of their display attributes are equal. We
3577 don't compare names or doc-strings, because that would make equal
3580 This isn't concerned with "unspecified" attributes, that's what
3581 #'glyph-differs-from-default-p is for. */
3583 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3585 Lisp_Glyph *g1 = XGLYPH (obj1);
3586 Lisp_Glyph *g2 = XGLYPH (obj2);
3590 return (internal_equal (g1->image, g2->image, depth) &&
3591 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
3592 internal_equal (g1->baseline, g2->baseline, depth) &&
3593 internal_equal (g1->face, g2->face, depth) &&
3594 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
3597 static unsigned long
3598 glyph_hash (Lisp_Object obj, int depth)
3602 /* No need to hash all of the elements; that would take too long.
3603 Just hash the most common ones. */
3604 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
3605 internal_hash (XGLYPH (obj)->face, depth));
3609 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
3611 Lisp_Glyph *g = XGLYPH (obj);
3613 if (EQ (prop, Qimage)) return g->image;
3614 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
3615 if (EQ (prop, Qbaseline)) return g->baseline;
3616 if (EQ (prop, Qface)) return g->face;
3618 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
3622 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3624 if (EQ (prop, Qimage) ||
3625 EQ (prop, Qcontrib_p) ||
3626 EQ (prop, Qbaseline))
3629 if (EQ (prop, Qface))
3631 XGLYPH (obj)->face = Fget_face (value);
3635 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
3640 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
3642 if (EQ (prop, Qimage) ||
3643 EQ (prop, Qcontrib_p) ||
3644 EQ (prop, Qbaseline))
3647 if (EQ (prop, Qface))
3649 XGLYPH (obj)->face = Qnil;
3653 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
3657 glyph_plist (Lisp_Object obj)
3659 Lisp_Glyph *glyph = XGLYPH (obj);
3660 Lisp_Object result = glyph->plist;
3662 result = cons3 (Qface, glyph->face, result);
3663 result = cons3 (Qbaseline, glyph->baseline, result);
3664 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
3665 result = cons3 (Qimage, glyph->image, result);
3670 static const struct lrecord_description glyph_description[] = {
3671 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) },
3672 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) },
3673 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) },
3674 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) },
3675 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) },
3679 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
3680 mark_glyph, print_glyph, 0,
3681 glyph_equal, glyph_hash, glyph_description,
3682 glyph_getprop, glyph_putprop,
3683 glyph_remprop, glyph_plist,
3687 allocate_glyph (enum glyph_type type,
3688 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
3689 Lisp_Object locale))
3691 /* This function can GC */
3692 Lisp_Object obj = Qnil;
3693 Lisp_Glyph *g = alloc_lcrecord_type (Lisp_Glyph, &lrecord_glyph);
3696 g->image = Fmake_specifier (Qimage); /* This function can GC */
3701 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3702 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
3703 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
3704 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK;
3707 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3708 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
3711 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3712 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK
3713 | IMAGE_COLOR_PIXMAP_MASK;
3719 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
3720 /* We're getting enough reports of odd behavior in this area it seems */
3721 /* best to GCPRO everything. */
3723 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3724 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3725 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3726 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3728 GCPRO4 (obj, tem1, tem2, tem3);
3730 set_specifier_fallback (g->image, tem1);
3731 g->contrib_p = Fmake_specifier (Qboolean);
3732 set_specifier_fallback (g->contrib_p, tem2);
3733 /* #### should have a specifier for the following */
3734 g->baseline = Fmake_specifier (Qgeneric);
3735 set_specifier_fallback (g->baseline, tem3);
3738 g->after_change = after_change;
3741 set_image_attached_to (g->image, obj, Qimage);
3748 static enum glyph_type
3749 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3752 return GLYPH_BUFFER;
3754 if (ERRB_EQ (errb, ERROR_ME))
3755 CHECK_SYMBOL (type);
3757 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3758 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3759 if (EQ (type, Qicon)) return GLYPH_ICON;
3761 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3763 return GLYPH_UNKNOWN;
3767 valid_glyph_type_p (Lisp_Object type)
3769 return !NILP (memq_no_quit (type, Vglyph_type_list));
3772 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3773 Given a GLYPH-TYPE, return non-nil if it is valid.
3774 Valid types are `buffer', `pointer', and `icon'.
3778 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3781 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3782 Return a list of valid glyph types.
3786 return Fcopy_sequence (Vglyph_type_list);
3789 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3790 Create and return a new uninitialized glyph of type TYPE.
3792 TYPE specifies the type of the glyph; this should be one of `buffer',
3793 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3794 specifies in which contexts the glyph can be used, and controls the
3795 allowable image types into which the glyph's image can be
3798 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3799 extent, in the modeline, and in the toolbar. Their image can be
3800 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3803 `pointer' glyphs can be used to specify the mouse pointer. Their
3804 image can be instantiated as `pointer'.
3806 `icon' glyphs can be used to specify the icon used when a frame is
3807 iconified. Their image can be instantiated as `mono-pixmap' and
3812 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3813 return allocate_glyph (typeval, 0);
3816 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3817 Return non-nil if OBJECT is a glyph.
3819 A glyph is an object used for pixmaps, widgets and the like. It is used
3820 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3821 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3822 buttons, and the like. Much more detailed information can be found at
3823 `make-glyph'. Its image is described using an image specifier --
3824 see `make-image-specifier'. See also `make-image-instance' for further
3829 return GLYPHP (object) ? Qt : Qnil;
3832 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3833 Return the type of the given glyph.
3834 The return value will be one of 'buffer, 'pointer, or 'icon.
3838 CHECK_GLYPH (glyph);
3839 switch (XGLYPH_TYPE (glyph))
3842 case GLYPH_BUFFER: return Qbuffer;
3843 case GLYPH_POINTER: return Qpointer;
3844 case GLYPH_ICON: return Qicon;
3849 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3850 Error_behavior errb, int no_quit)
3852 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3854 /* This can never return Qunbound. All glyphs have 'nothing as
3856 Lisp_Object image_instance = specifier_instance (specifier, Qunbound,
3857 domain, errb, no_quit, 0,
3859 assert (!UNBOUNDP (image_instance));
3860 ERROR_CHECK_IMAGE_INSTANCE (image_instance);
3862 return image_instance;
3866 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window)
3868 Lisp_Object instance = glyph_or_image;
3870 if (GLYPHP (glyph_or_image))
3871 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3876 /*****************************************************************************
3879 Return the width of the given GLYPH on the given WINDOW.
3880 Calculations are done based on recursively querying the geometry of
3881 the associated image instances.
3882 ****************************************************************************/
3884 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain)
3886 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3888 if (!IMAGE_INSTANCEP (instance))
3891 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3892 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3893 IMAGE_UNSPECIFIED_GEOMETRY,
3894 IMAGE_UNCHANGED_GEOMETRY,
3895 IMAGE_UNCHANGED_GEOMETRY, domain);
3897 return XIMAGE_INSTANCE_WIDTH (instance);
3900 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3901 Return the width of GLYPH on WINDOW.
3902 This may not be exact as it does not take into account all of the context
3903 that redisplay will.
3907 XSETWINDOW (window, decode_window (window));
3908 CHECK_GLYPH (glyph);
3910 return make_int (glyph_width (glyph, window));
3914 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain)
3916 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3918 if (!IMAGE_INSTANCEP (instance))
3921 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3922 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3923 IMAGE_UNSPECIFIED_GEOMETRY,
3924 IMAGE_UNCHANGED_GEOMETRY,
3925 IMAGE_UNCHANGED_GEOMETRY, domain);
3927 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3928 return XIMAGE_INSTANCE_TEXT_ASCENT (instance);
3930 return XIMAGE_INSTANCE_HEIGHT (instance);
3934 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain)
3936 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3938 if (!IMAGE_INSTANCEP (instance))
3941 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3942 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3943 IMAGE_UNSPECIFIED_GEOMETRY,
3944 IMAGE_UNCHANGED_GEOMETRY,
3945 IMAGE_UNCHANGED_GEOMETRY, domain);
3947 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3948 return XIMAGE_INSTANCE_TEXT_DESCENT (instance);
3953 /* strictly a convenience function. */
3955 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain)
3957 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3960 if (!IMAGE_INSTANCEP (instance))
3963 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3964 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3965 IMAGE_UNSPECIFIED_GEOMETRY,
3966 IMAGE_UNCHANGED_GEOMETRY,
3967 IMAGE_UNCHANGED_GEOMETRY, domain);
3969 return XIMAGE_INSTANCE_HEIGHT (instance);
3972 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3973 Return the ascent value of GLYPH on WINDOW.
3974 This may not be exact as it does not take into account all of the context
3975 that redisplay will.
3979 XSETWINDOW (window, decode_window (window));
3980 CHECK_GLYPH (glyph);
3982 return make_int (glyph_ascent (glyph, window));
3985 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3986 Return the descent value of GLYPH on WINDOW.
3987 This may not be exact as it does not take into account all of the context
3988 that redisplay will.
3992 XSETWINDOW (window, decode_window (window));
3993 CHECK_GLYPH (glyph);
3995 return make_int (glyph_descent (glyph, window));
3998 /* This is redundant but I bet a lot of people expect it to exist. */
3999 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
4000 Return the height of GLYPH on WINDOW.
4001 This may not be exact as it does not take into account all of the context
4002 that redisplay will.
4006 XSETWINDOW (window, decode_window (window));
4007 CHECK_GLYPH (glyph);
4009 return make_int (glyph_height (glyph, window));
4013 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty)
4015 Lisp_Object instance = glyph_or_image;
4017 if (!NILP (glyph_or_image))
4019 if (GLYPHP (glyph_or_image))
4021 instance = glyph_image_instance (glyph_or_image, window,
4023 XGLYPH_DIRTYP (glyph_or_image) = dirty;
4026 if (!IMAGE_INSTANCEP (instance))
4029 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
4034 set_image_instance_dirty_p (Lisp_Object instance, int dirty)
4036 if (IMAGE_INSTANCEP (instance))
4038 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
4039 /* Now cascade up the hierarchy. */
4040 set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance),
4043 else if (GLYPHP (instance))
4045 XGLYPH_DIRTYP (instance) = dirty;
4049 /* #### do we need to cache this info to speed things up? */
4052 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
4054 if (!GLYPHP (glyph))
4058 Lisp_Object retval =
4059 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
4060 /* #### look into ERROR_ME_NOT */
4061 Qunbound, domain, ERROR_ME_NOT,
4063 if (!NILP (retval) && !INTP (retval))
4065 else if (INTP (retval))
4067 if (XINT (retval) < 0)
4069 if (XINT (retval) > 100)
4070 retval = make_int (100);
4077 glyph_face (Lisp_Object glyph, Lisp_Object domain)
4079 /* #### Domain parameter not currently used but it will be */
4080 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
4084 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
4086 if (!GLYPHP (glyph))
4089 return !NILP (specifier_instance_no_quit
4090 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
4091 /* #### look into ERROR_ME_NOT */
4092 ERROR_ME_NOT, 0, Qzero));
4096 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
4099 if (XGLYPH (glyph)->after_change)
4100 (XGLYPH (glyph)->after_change) (glyph, property, locale);
4104 glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height,
4105 enum image_instance_geometry disp, Lisp_Object domain)
4107 Lisp_Object instance = glyph_or_image;
4109 if (GLYPHP (glyph_or_image))
4110 instance = glyph_image_instance (glyph_or_image, domain, ERROR_ME_NOT, 1);
4112 image_instance_query_geometry (instance, width, height, disp, domain);
4116 glyph_do_layout (Lisp_Object glyph_or_image, int width, int height,
4117 int xoffset, int yoffset, Lisp_Object domain)
4119 Lisp_Object instance = glyph_or_image;
4121 if (GLYPHP (glyph_or_image))
4122 instance = glyph_image_instance (glyph_or_image, domain, ERROR_ME_NOT, 1);
4124 image_instance_layout (instance, width, height, xoffset, yoffset, domain);
4128 /*****************************************************************************
4129 * glyph cachel functions *
4130 *****************************************************************************/
4132 /* #### All of this is 95% copied from face cachels. Consider
4135 Why do we need glyph_cachels? Simply because a glyph_cachel captures
4136 per-window information about a particular glyph. A glyph itself is
4137 not created in any particular context, so if we were to rely on a
4138 glyph to tell us about its dirtiness we would not be able to reset
4139 the dirty flag after redisplaying it as it may exist in other
4140 contexts. When we have redisplayed we need to know which glyphs to
4141 reset the dirty flags on - the glyph_cachels give us a nice list we
4142 can iterate through doing this. */
4144 mark_glyph_cachels (glyph_cachel_dynarr *elements)
4151 for (elt = 0; elt < Dynarr_length (elements); elt++)
4153 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
4154 mark_object (cachel->glyph);
4159 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
4160 struct glyph_cachel *cachel)
4162 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)
4163 || XGLYPH_DIRTYP (cachel->glyph)
4164 || XFRAME(WINDOW_FRAME(w))->faces_changed)
4166 Lisp_Object window, instance;
4168 XSETWINDOW (window, w);
4170 cachel->glyph = glyph;
4171 /* Speed things up slightly by grabbing the glyph instantiation
4172 and passing it to the size functions. */
4173 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
4175 if (!IMAGE_INSTANCEP (instance))
4178 /* Mark text instance of the glyph dirty if faces have changed,
4179 because its geometry might have changed. */
4180 invalidate_glyph_geometry_maybe (instance, w);
4182 /* #### Do the following 2 lines buy us anything? --kkm */
4183 XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance);
4184 cachel->dirty = XGLYPH_DIRTYP (glyph);
4185 cachel->width = glyph_width (instance, window);
4186 cachel->ascent = glyph_ascent (instance, window);
4187 cachel->descent = glyph_descent (instance, window);
4190 cachel->updated = 1;
4194 add_glyph_cachel (struct window *w, Lisp_Object glyph)
4196 struct glyph_cachel new_cachel;
4199 new_cachel.glyph = Qnil;
4201 update_glyph_cachel_data (w, glyph, &new_cachel);
4202 Dynarr_add (w->glyph_cachels, new_cachel);
4206 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
4213 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4215 struct glyph_cachel *cachel =
4216 Dynarr_atp (w->glyph_cachels, elt);
4218 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
4220 update_glyph_cachel_data (w, glyph, cachel);
4225 /* If we didn't find the glyph, add it and then return its index. */
4226 add_glyph_cachel (w, glyph);
4231 reset_glyph_cachels (struct window *w)
4233 Dynarr_reset (w->glyph_cachels);
4234 get_glyph_cachel_index (w, Vcontinuation_glyph);
4235 get_glyph_cachel_index (w, Vtruncation_glyph);
4236 get_glyph_cachel_index (w, Vhscroll_glyph);
4237 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
4238 get_glyph_cachel_index (w, Voctal_escape_glyph);
4239 get_glyph_cachel_index (w, Vinvisible_text_glyph);
4243 mark_glyph_cachels_as_not_updated (struct window *w)
4247 /* We need to have a dirty flag to tell if the glyph has changed.
4248 We can check to see if each glyph variable is actually a
4249 completely different glyph, though. */
4250 #define FROB(glyph_obj, gindex) \
4251 update_glyph_cachel_data (w, glyph_obj, \
4252 Dynarr_atp (w->glyph_cachels, gindex))
4254 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
4255 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
4256 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
4257 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
4258 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
4259 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
4262 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4264 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
4268 /* Unset the dirty bit on all the glyph cachels that have it. */
4270 mark_glyph_cachels_as_clean (struct window* w)
4274 XSETWINDOW (window, w);
4275 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4277 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt);
4279 set_glyph_dirty_p (cachel->glyph, window, 0);
4283 #ifdef MEMORY_USAGE_STATS
4286 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
4287 struct overhead_stats *ovstats)
4292 total += Dynarr_memory_usage (glyph_cachels, ovstats);
4297 #endif /* MEMORY_USAGE_STATS */
4301 /*****************************************************************************
4302 * subwindow cachel functions *
4303 *****************************************************************************/
4304 /* Subwindows are curious in that you have to physically unmap them to
4305 not display them. It is problematic deciding what to do in
4306 redisplay. We have two caches - a per-window instance cache that
4307 keeps track of subwindows on a window, these are linked to their
4308 instantiator in the hashtable and when the instantiator goes away
4309 we want the instance to go away also. However we also have a
4310 per-frame instance cache that we use to determine if a subwindow is
4311 obscuring an area that we want to clear. We need to be able to flip
4312 through this quickly so a hashtable is not suitable hence the
4313 subwindow_cachels. This is a weak list so unreference instances
4314 will get deleted properly. */
4316 /* redisplay in general assumes that drawing something will erase
4317 what was there before. unfortunately this does not apply to
4318 subwindows that need to be specifically unmapped in order to
4319 disappear. we take a brute force approach - on the basis that its
4320 cheap - and unmap all subwindows in a display line */
4322 /* Put new instances in the frame subwindow cache. This is less costly than
4323 doing it every time something gets mapped, and deleted instances will be
4324 removed automatically. */
4326 cache_subwindow_instance_in_frame_maybe (Lisp_Object instance)
4328 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (instance);
4329 if (!NILP (DOMAIN_FRAME (IMAGE_INSTANCE_DOMAIN (ii))))
4331 struct frame* f = DOMAIN_XFRAME (IMAGE_INSTANCE_DOMAIN (ii));
4332 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))
4333 = Fcons (instance, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
4337 /* Unmap and finalize all subwindow instances in the frame cache. This
4338 is necessary because GC will not guarantee the order things get
4339 deleted in and moreover, frame finalization deletes the window
4340 system windows before deleting XEmacs windows, and hence
4343 unmap_subwindow_instance_cache_mapper (Lisp_Object key, Lisp_Object value,
4346 /* value can be nil; we cache failures as well as successes */
4349 struct frame* f = XFRAME (XIMAGE_INSTANCE_FRAME (value));
4350 unmap_subwindow (value);
4353 /* In case GC doesn't catch up fast enough, remove from the frame
4354 cache also. Otherwise code that checks the sanity of the instance
4356 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))
4357 = delq_no_quit (value,
4358 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
4359 finalize_image_instance (XIMAGE_INSTANCE (value), 0);
4366 finalize_all_subwindow_instances (struct window *w)
4368 if (!NILP (w->next)) finalize_all_subwindow_instances (XWINDOW (w->next));
4369 if (!NILP (w->vchild)) finalize_all_subwindow_instances (XWINDOW (w->vchild));
4370 if (!NILP (w->hchild)) finalize_all_subwindow_instances (XWINDOW (w->hchild));
4372 elisp_maphash (unmap_subwindow_instance_cache_mapper,
4373 w->subwindow_instance_cache, (void*)1);
4377 free_frame_subwindow_instances (struct frame* f)
4379 /* Make sure all instances are finalized. We have to do this via the
4380 instance cache since some instances may be extant but not
4381 displayed (and hence not in the frame cache). */
4382 finalize_all_subwindow_instances (XWINDOW (f->root_window));
4385 /* Unmap all instances in the frame cache. */
4387 reset_frame_subwindow_instance_cache (struct frame* f)
4391 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
4393 Lisp_Object value = XCAR (rest);
4394 unmap_subwindow (value);
4398 /*****************************************************************************
4399 * subwindow exposure ignorance *
4400 *****************************************************************************/
4401 /* when we unmap subwindows the associated window system will generate
4402 expose events. This we do not want as redisplay already copes with
4403 the repainting necessary. Worse, we can get in an endless cycle of
4404 redisplay if we are not careful. Thus we keep a per-frame list of
4405 expose events that are going to come and ignore them as
4408 struct expose_ignore_blocktype
4410 Blocktype_declare (struct expose_ignore);
4411 } *the_expose_ignore_blocktype;
4414 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
4416 struct expose_ignore *ei, *prev;
4417 /* the ignore list is FIFO so we should generally get a match with
4418 the first element in the list */
4419 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next)
4421 /* Checking for exact matches just isn't good enough as we
4422 might get exposures for partially obscured subwindows, thus
4423 we have to check for overlaps. Being conservative, we will
4424 check for exposures wholly contained by the subwindow - this
4425 might give us what we want.*/
4426 if (ei->x <= (unsigned) x && ei->y <= (unsigned) y
4427 && ei->x + ei->width >= (unsigned) (x + width)
4428 && ei->y + ei->height >= (unsigned) (y + height))
4430 #ifdef DEBUG_WIDGETS
4431 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n",
4432 x, y, width, height, ei->x, ei->y, ei->width, ei->height);
4435 f->subwindow_exposures = ei->next;
4437 prev->next = ei->next;
4439 if (ei == f->subwindow_exposures_tail)
4440 f->subwindow_exposures_tail = prev;
4442 Blocktype_free (the_expose_ignore_blocktype, ei);
4451 register_ignored_expose (struct frame* f, int x, int y, int width, int height)
4453 if (!hold_ignored_expose_registration)
4455 struct expose_ignore *ei;
4457 ei = Blocktype_alloc (the_expose_ignore_blocktype);
4463 ei->height = height;
4465 /* we have to add the exposure to the end of the list, since we
4466 want to check the oldest events first. for speed we keep a record
4467 of the end so that we can add right to it. */
4468 if (f->subwindow_exposures_tail)
4470 f->subwindow_exposures_tail->next = ei;
4472 if (!f->subwindow_exposures)
4474 f->subwindow_exposures = ei;
4476 f->subwindow_exposures_tail = ei;
4480 /****************************************************************************
4481 find_matching_subwindow
4483 See if there is a subwindow that completely encloses the requested
4485 ****************************************************************************/
4486 int find_matching_subwindow (struct frame* f, int x, int y, int width, int height)
4490 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
4492 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest));
4494 if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii)
4496 IMAGE_INSTANCE_DISPLAY_X (ii) <= (unsigned) x
4498 IMAGE_INSTANCE_DISPLAY_Y (ii) <= (unsigned) y
4500 IMAGE_INSTANCE_DISPLAY_X (ii)
4501 + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) >= (unsigned) (x + width)
4503 IMAGE_INSTANCE_DISPLAY_Y (ii)
4504 + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) >= (unsigned) (y + height))
4513 /*****************************************************************************
4514 * subwindow functions *
4515 *****************************************************************************/
4517 /* Update the displayed characteristics of a subwindow. This function
4518 should generally only get called if the subwindow is actually
4521 redisplay_subwindow (Lisp_Object subwindow)
4523 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4524 int count = specpdl_depth ();
4526 /* The update method is allowed to call eval. Since it is quite
4527 common for this function to get called from somewhere in
4528 redisplay we need to make sure that quits are ignored. Otherwise
4529 Fsignal will abort. */
4530 specbind (Qinhibit_quit, Qt);
4532 ERROR_CHECK_IMAGE_INSTANCE (subwindow);
4534 if (WIDGET_IMAGE_INSTANCEP (subwindow))
4536 if (image_instance_changed (subwindow))
4537 redisplay_widget (subwindow);
4538 /* Reset the changed flags. */
4539 IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0;
4540 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0;
4541 IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii) = 0;
4542 IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0;
4544 else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW
4546 !NILP (IMAGE_INSTANCE_FRAME (ii)))
4548 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain),
4549 redisplay_subwindow, (ii));
4552 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0;
4553 /* This function is typically called by redisplay just before
4554 outputting the information to the screen. Thus we record a hash
4555 of the output to determine whether on-screen is the same as
4556 recorded structure. This approach has limitations in there is a
4557 good chance that hash values will be different for the same
4558 visual appearance. However, we would rather that then the other
4559 way round - it simply means that we will get more displays than
4560 we might need. We can get better hashing by making the depth
4561 negative - currently it will recurse down 7 levels.*/
4562 IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow,
4563 IMAGE_INSTANCE_HASH_DEPTH);
4565 unbind_to (count, Qnil);
4568 /* Determine whether an image_instance has changed structurally and
4569 hence needs redisplaying in some way.
4571 #### This should just look at the instantiator differences when we
4572 get rid of the stored items altogether. In fact we should probably
4573 store the new instantiator as well as the old - as we do with
4574 gui_items currently - and then pick-up the new on the next
4575 redisplay. This would obviate the need for any of this trickery
4578 image_instance_changed (Lisp_Object subwindow)
4580 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4582 if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) !=
4583 IMAGE_INSTANCE_DISPLAY_HASH (ii))
4585 /* #### I think there is probably a bug here. This gets called for
4586 layouts - and yet the pending items are always nil for
4587 layouts. We are saved by layout optimization, but I'm undecided
4588 as to what the correct fix is. */
4589 else if (WIDGET_IMAGE_INSTANCEP (subwindow)
4590 && (!internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (ii),
4591 IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii), 0)
4592 || !NILP (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii))
4593 || IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii)))
4599 /* Update all the subwindows on a frame. */
4601 update_widget_instances (Lisp_Object frame)
4606 /* Its possible for the preceding callback to have deleted the
4607 frame, so cope with this. */
4608 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
4611 CHECK_FRAME (frame);
4614 /* If we get called we know something has changed. */
4615 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
4617 Lisp_Object widget = XCAR (rest);
4619 if (XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (widget)
4621 image_instance_changed (widget))
4623 set_image_instance_dirty_p (widget, 1);
4624 MARK_FRAME_GLYPHS_CHANGED (f);
4629 /* remove a subwindow from its frame */
4630 void unmap_subwindow (Lisp_Object subwindow)
4632 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4635 ERROR_CHECK_IMAGE_INSTANCE (subwindow);
4637 if (!image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii))
4638 & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK)
4640 !IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii))
4643 #ifdef DEBUG_WIDGETS
4644 stderr_out ("unmapping subwindow %p\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
4646 f = XFRAME (IMAGE_INSTANCE_FRAME (ii));
4648 /* make sure we don't get expose events */
4649 register_ignored_expose (f, IMAGE_INSTANCE_DISPLAY_X (ii),
4650 IMAGE_INSTANCE_DISPLAY_Y (ii),
4651 IMAGE_INSTANCE_DISPLAY_WIDTH (ii),
4652 IMAGE_INSTANCE_DISPLAY_HEIGHT (ii));
4653 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4655 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)),
4656 unmap_subwindow, (ii));
4659 /* show a subwindow in its frame */
4660 void map_subwindow (Lisp_Object subwindow, int x, int y,
4661 struct display_glyph_area *dga)
4663 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4666 ERROR_CHECK_IMAGE_INSTANCE (subwindow);
4668 if (!image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii))
4669 & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK))
4672 #ifdef DEBUG_WIDGETS
4673 stderr_out ("mapping subwindow %p, %dx%d@%d+%d\n",
4674 IMAGE_INSTANCE_SUBWINDOW_ID (ii),
4675 dga->width, dga->height, x, y);
4677 f = XFRAME (IMAGE_INSTANCE_FRAME (ii));
4678 IMAGE_INSTANCE_DISPLAY_X (ii) = x;
4679 IMAGE_INSTANCE_DISPLAY_Y (ii) = y;
4680 IMAGE_INSTANCE_DISPLAY_WIDTH (ii) = dga->width;
4681 IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) = dga->height;
4683 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain),
4684 map_subwindow, (ii, x, y, dga));
4685 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
4689 subwindow_possible_dest_types (void)
4691 return IMAGE_SUBWINDOW_MASK;
4695 subwindow_governing_domain (void)
4697 return GOVERNING_DOMAIN_WINDOW;
4700 /* Partially instantiate a subwindow. */
4702 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
4703 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
4704 int dest_mask, Lisp_Object domain)
4706 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
4707 Lisp_Object device = image_instance_device (image_instance);
4708 Lisp_Object frame = DOMAIN_FRAME (domain);
4709 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
4710 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
4713 signal_simple_error ("No selected frame", device);
4715 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
4716 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
4719 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
4720 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4725 if (XINT (width) > 1)
4727 IMAGE_INSTANCE_WIDTH (ii) = w;
4728 IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0;
4734 if (XINT (height) > 1)
4736 IMAGE_INSTANCE_HEIGHT (ii) = h;
4737 IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0;
4741 /* This is just a backup in case no-one has assigned a suitable geometry.
4742 #### It should really query the enclose window for geometry. */
4744 subwindow_query_geometry (Lisp_Object image_instance, int* width,
4745 int* height, enum image_instance_geometry disp,
4748 if (width) *width = 20;
4749 if (height) *height = 20;
4752 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
4753 Return non-nil if OBJECT is a subwindow.
4757 CHECK_IMAGE_INSTANCE (object);
4758 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
4761 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
4762 Return the window id of SUBWINDOW as a number.
4766 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4767 return make_int ((EMACS_INT) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow));
4770 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
4771 Resize SUBWINDOW to WIDTH x HEIGHT.
4772 If a value is nil that parameter is not changed.
4774 (subwindow, width, height))
4777 Lisp_Image_Instance* ii;
4779 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4780 ii = XIMAGE_INSTANCE (subwindow);
4783 neww = IMAGE_INSTANCE_WIDTH (ii);
4785 neww = XINT (width);
4788 newh = IMAGE_INSTANCE_HEIGHT (ii);
4790 newh = XINT (height);
4792 /* The actual resizing gets done asynchronously by
4793 update_subwindow. */
4794 IMAGE_INSTANCE_HEIGHT (ii) = newh;
4795 IMAGE_INSTANCE_WIDTH (ii) = neww;
4796 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
4801 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
4802 Generate a Map event for SUBWINDOW.
4806 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4808 map_subwindow (subwindow, 0, 0);
4814 /*****************************************************************************
4816 *****************************************************************************/
4818 /* Get the display tables for use currently on window W with face
4819 FACE. #### This will have to be redone. */
4822 get_display_tables (struct window *w, face_index findex,
4823 Lisp_Object *face_table, Lisp_Object *window_table)
4826 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
4830 tem = noseeum_cons (tem, Qnil);
4832 tem = w->display_table;
4836 tem = noseeum_cons (tem, Qnil);
4837 *window_table = tem;
4841 display_table_entry (Emchar ch, Lisp_Object face_table,
4842 Lisp_Object window_table)
4846 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
4847 for (tail = face_table; 1; tail = XCDR (tail))
4852 if (!NILP (window_table))
4854 tail = window_table;
4855 window_table = Qnil;
4860 table = XCAR (tail);
4862 if (VECTORP (table))
4864 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
4865 return XVECTOR_DATA (table)[ch];
4869 else if (CHAR_TABLEP (table)
4870 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
4872 return get_char_table (ch, XCHAR_TABLE (table));
4874 else if (CHAR_TABLEP (table)
4875 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
4877 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
4883 else if (RANGE_TABLEP (table))
4885 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
4896 /*****************************************************************************
4897 * timeouts for animated glyphs *
4898 *****************************************************************************/
4899 static Lisp_Object Qglyph_animated_timeout_handler;
4901 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /*
4902 Callback function for updating animated images.
4907 CHECK_WEAK_LIST (arg);
4909 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg))))
4911 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg));
4913 if (IMAGE_INSTANCEP (value))
4915 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value);
4917 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value)
4919 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1
4921 !disable_animated_pixmaps)
4923 /* Increment the index of the image slice we are currently
4925 IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
4926 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
4927 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
4928 /* We might need to kick redisplay at this point - but we
4930 MARK_DEVICE_FRAMES_GLYPHS_CHANGED
4931 (XDEVICE (image_instance_device (value)));
4932 /* Cascade dirtiness so that we can have an animated glyph in a layout
4934 set_image_instance_dirty_p (value, 1);
4941 Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image)
4943 Lisp_Object ret = Qnil;
4945 if (tickms > 0 && IMAGE_INSTANCEP (image))
4947 double ms = ((double)tickms) / 1000.0;
4948 struct gcpro gcpro1;
4949 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE);
4952 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil);
4954 ret = Fadd_timeout (make_float (ms),
4955 Qglyph_animated_timeout_handler,
4956 holder, make_float (ms));
4963 void disable_glyph_animated_timeout (int i)
4968 Fdisable_timeout (id);
4972 /*****************************************************************************
4974 *****************************************************************************/
4977 syms_of_glyphs (void)
4979 INIT_LRECORD_IMPLEMENTATION (glyph);
4980 INIT_LRECORD_IMPLEMENTATION (image_instance);
4982 /* image instantiators */
4984 DEFSUBR (Fimage_instantiator_format_list);
4985 DEFSUBR (Fvalid_image_instantiator_format_p);
4986 DEFSUBR (Fset_console_type_image_conversion_list);
4987 DEFSUBR (Fconsole_type_image_conversion_list);
4989 DEFKEYWORD (Q_file);
4990 DEFKEYWORD (Q_data);
4991 DEFKEYWORD (Q_face);
4992 DEFKEYWORD (Q_pixel_height);
4993 DEFKEYWORD (Q_pixel_width);
4996 DEFKEYWORD (Q_color_symbols);
4998 #ifdef HAVE_WINDOW_SYSTEM
4999 DEFKEYWORD (Q_mask_file);
5000 DEFKEYWORD (Q_mask_data);
5001 DEFKEYWORD (Q_hotspot_x);
5002 DEFKEYWORD (Q_hotspot_y);
5003 DEFKEYWORD (Q_foreground);
5004 DEFKEYWORD (Q_background);
5006 /* image specifiers */
5008 DEFSUBR (Fimage_specifier_p);
5009 /* Qimage in general.c */
5011 /* image instances */
5013 defsymbol (&Qimage_instancep, "image-instance-p");
5015 DEFSYMBOL (Qnothing_image_instance_p);
5016 DEFSYMBOL (Qtext_image_instance_p);
5017 DEFSYMBOL (Qmono_pixmap_image_instance_p);
5018 DEFSYMBOL (Qcolor_pixmap_image_instance_p);
5019 DEFSYMBOL (Qpointer_image_instance_p);
5020 DEFSYMBOL (Qwidget_image_instance_p);
5021 DEFSYMBOL (Qsubwindow_image_instance_p);
5023 DEFSUBR (Fmake_image_instance);
5024 DEFSUBR (Fimage_instance_p);
5025 DEFSUBR (Fimage_instance_type);
5026 DEFSUBR (Fvalid_image_instance_type_p);
5027 DEFSUBR (Fimage_instance_type_list);
5028 DEFSUBR (Fimage_instance_name);
5029 DEFSUBR (Fimage_instance_domain);
5030 DEFSUBR (Fimage_instance_string);
5031 DEFSUBR (Fimage_instance_file_name);
5032 DEFSUBR (Fimage_instance_mask_file_name);
5033 DEFSUBR (Fimage_instance_depth);
5034 DEFSUBR (Fimage_instance_height);
5035 DEFSUBR (Fimage_instance_width);
5036 DEFSUBR (Fimage_instance_hotspot_x);
5037 DEFSUBR (Fimage_instance_hotspot_y);
5038 DEFSUBR (Fimage_instance_foreground);
5039 DEFSUBR (Fimage_instance_background);
5040 DEFSUBR (Fimage_instance_property);
5041 DEFSUBR (Fcolorize_image_instance);
5043 DEFSUBR (Fsubwindowp);
5044 DEFSUBR (Fimage_instance_subwindow_id);
5045 DEFSUBR (Fresize_subwindow);
5046 DEFSUBR (Fforce_subwindow_map);
5048 /* Qnothing defined as part of the "nothing" image-instantiator
5050 /* Qtext defined in general.c */
5051 DEFSYMBOL (Qmono_pixmap);
5052 DEFSYMBOL (Qcolor_pixmap);
5053 /* Qpointer defined in general.c */
5057 DEFSYMBOL (Qglyphp);
5058 DEFSYMBOL (Qcontrib_p);
5059 DEFSYMBOL (Qbaseline);
5061 DEFSYMBOL (Qbuffer_glyph_p);
5062 DEFSYMBOL (Qpointer_glyph_p);
5063 DEFSYMBOL (Qicon_glyph_p);
5065 DEFSYMBOL (Qconst_glyph_variable);
5067 DEFSUBR (Fglyph_type);
5068 DEFSUBR (Fvalid_glyph_type_p);
5069 DEFSUBR (Fglyph_type_list);
5071 DEFSUBR (Fmake_glyph_internal);
5072 DEFSUBR (Fglyph_width);
5073 DEFSUBR (Fglyph_ascent);
5074 DEFSUBR (Fglyph_descent);
5075 DEFSUBR (Fglyph_height);
5076 DEFSUBR (Fset_instantiator_property);
5078 /* Qbuffer defined in general.c. */
5079 /* Qpointer defined above */
5081 /* Unfortunately, timeout handlers must be lisp functions. This is
5082 for animated glyphs. */
5083 DEFSYMBOL (Qglyph_animated_timeout_handler);
5084 DEFSUBR (Fglyph_animated_timeout_handler);
5087 DEFERROR_STANDARD (Qimage_conversion_error, Qio_error);
5090 static const struct lrecord_description image_specifier_description[] = {
5091 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee) },
5092 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee_property) },
5097 specifier_type_create_image (void)
5099 /* image specifiers */
5101 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
5103 SPECIFIER_HAS_METHOD (image, create);
5104 SPECIFIER_HAS_METHOD (image, mark);
5105 SPECIFIER_HAS_METHOD (image, instantiate);
5106 SPECIFIER_HAS_METHOD (image, validate);
5107 SPECIFIER_HAS_METHOD (image, after_change);
5108 SPECIFIER_HAS_METHOD (image, going_to_add);
5109 SPECIFIER_HAS_METHOD (image, copy_instantiator);
5113 reinit_specifier_type_create_image (void)
5115 REINITIALIZE_SPECIFIER_TYPE (image);
5119 static const struct lrecord_description iike_description_1[] = {
5120 { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) },
5124 static const struct struct_description iike_description = {
5125 sizeof (ii_keyword_entry),
5129 static const struct lrecord_description iiked_description_1[] = {
5130 XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description),
5134 static const struct struct_description iiked_description = {
5135 sizeof (ii_keyword_entry_dynarr),
5139 static const struct lrecord_description iife_description_1[] = {
5140 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) },
5141 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) },
5142 { XD_STRUCT_PTR, offsetof (image_instantiator_format_entry, meths), 1, &iim_description },
5146 static const struct struct_description iife_description = {
5147 sizeof (image_instantiator_format_entry),
5151 static const struct lrecord_description iifed_description_1[] = {
5152 XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description),
5156 static const struct struct_description iifed_description = {
5157 sizeof (image_instantiator_format_entry_dynarr),
5161 static const struct lrecord_description iim_description_1[] = {
5162 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) },
5163 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) },
5164 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, keywords), 1, &iiked_description },
5165 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, consoles), 1, &cted_description },
5169 const struct struct_description iim_description = {
5170 sizeof (struct image_instantiator_methods),
5175 image_instantiator_format_create (void)
5177 /* image instantiators */
5179 the_image_instantiator_format_entry_dynarr =
5180 Dynarr_new (image_instantiator_format_entry);
5182 Vimage_instantiator_format_list = Qnil;
5183 staticpro (&Vimage_instantiator_format_list);
5185 dump_add_root_struct_ptr (&the_image_instantiator_format_entry_dynarr, &iifed_description);
5187 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
5189 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
5190 IIFORMAT_HAS_METHOD (nothing, instantiate);
5192 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
5194 IIFORMAT_HAS_METHOD (inherit, validate);
5195 IIFORMAT_HAS_METHOD (inherit, normalize);
5196 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
5197 IIFORMAT_HAS_METHOD (inherit, instantiate);
5199 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
5201 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
5203 IIFORMAT_HAS_METHOD (string, validate);
5204 IIFORMAT_HAS_SHARED_METHOD (string, governing_domain, subwindow);
5205 IIFORMAT_HAS_METHOD (string, possible_dest_types);
5206 IIFORMAT_HAS_METHOD (string, instantiate);
5208 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
5209 /* Do this so we can set strings. */
5210 /* #### Andy, what is this? This is a bogus format and should not be
5211 visible to the user. */
5212 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text");
5213 IIFORMAT_HAS_METHOD (text, update);
5214 IIFORMAT_HAS_METHOD (text, query_geometry);
5216 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
5218 IIFORMAT_HAS_METHOD (formatted_string, validate);
5219 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
5220 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
5221 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
5223 /* Do this so pointers have geometry. */
5224 /* #### Andy, what is this? This is a bogus format and should not be
5225 visible to the user. */
5226 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (pointer, "pointer");
5227 IIFORMAT_HAS_SHARED_METHOD (pointer, query_geometry, subwindow);
5230 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
5231 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
5232 IIFORMAT_HAS_METHOD (subwindow, governing_domain);
5233 IIFORMAT_HAS_METHOD (subwindow, instantiate);
5234 IIFORMAT_HAS_METHOD (subwindow, query_geometry);
5235 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
5236 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
5238 #ifdef HAVE_WINDOW_SYSTEM
5239 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
5241 IIFORMAT_HAS_METHOD (xbm, validate);
5242 IIFORMAT_HAS_METHOD (xbm, normalize);
5243 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
5245 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
5246 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
5247 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
5248 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
5249 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
5250 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
5251 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
5252 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
5253 #endif /* HAVE_WINDOW_SYSTEM */
5256 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
5258 IIFORMAT_HAS_METHOD (xface, validate);
5259 IIFORMAT_HAS_METHOD (xface, normalize);
5260 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
5262 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
5263 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
5264 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
5265 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
5266 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
5267 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
5271 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
5273 IIFORMAT_HAS_METHOD (xpm, validate);
5274 IIFORMAT_HAS_METHOD (xpm, normalize);
5275 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
5277 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
5278 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
5279 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
5280 #endif /* HAVE_XPM */
5284 reinit_vars_of_glyphs (void)
5286 the_expose_ignore_blocktype =
5287 Blocktype_new (struct expose_ignore_blocktype);
5289 hold_ignored_expose_registration = 0;
5294 vars_of_glyphs (void)
5296 reinit_vars_of_glyphs ();
5298 Vthe_nothing_vector = vector1 (Qnothing);
5299 staticpro (&Vthe_nothing_vector);
5301 /* image instances */
5303 Vimage_instance_type_list = Fcons (Qnothing,
5304 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
5305 Qpointer, Qsubwindow, Qwidget));
5306 staticpro (&Vimage_instance_type_list);
5310 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
5311 staticpro (&Vglyph_type_list);
5313 /* The octal-escape glyph, control-arrow-glyph and
5314 invisible-text-glyph are completely initialized in glyphs.el */
5316 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
5317 What to prefix character codes displayed in octal with.
5319 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5321 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
5322 What to use as an arrow for control characters.
5324 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
5325 redisplay_glyph_changed);
5327 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
5328 What to use to indicate the presence of invisible text.
5329 This is the glyph that is displayed when an ellipsis is called for
5330 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
5331 Normally this is three dots ("...").
5333 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
5334 redisplay_glyph_changed);
5336 /* Partially initialized in glyphs.el */
5337 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
5338 What to display at the beginning of horizontally scrolled lines.
5340 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5341 #ifdef HAVE_WINDOW_SYSTEM
5347 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
5348 Definitions of logical color-names used when reading XPM files.
5349 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
5350 The COLOR-NAME should be a string, which is the name of the color to define;
5351 the FORM should evaluate to a `color' specifier object, or a string to be
5352 passed to `make-color-instance'. If a loaded XPM file references a symbolic
5353 color called COLOR-NAME, it will display as the computed color instead.
5355 The default value of this variable defines the logical color names
5356 \"foreground\" and \"background\" to be the colors of the `default' face.
5358 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
5359 #endif /* HAVE_XPM */
5364 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /*
5365 Whether animated pixmaps should be animated.
5368 disable_animated_pixmaps = 0;
5372 specifier_vars_of_glyphs (void)
5374 /* #### Can we GC here? The set_specifier_* calls definitely need */
5376 /* display tables */
5378 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
5379 *The display table currently in use.
5380 This is a specifier; use `set-specifier' to change it.
5382 Display tables are used to control how characters are displayed. Each
5383 time that redisplay processes a character, it is looked up in all the
5384 display tables that apply (obtained by calling `specifier-instance' on
5385 `current-display-table' and any overriding display tables specified in
5386 currently active faces). The first entry found that matches the
5387 character determines how the character is displayed. If there is no
5388 matching entry, the default display method is used. (Non-control
5389 characters are displayed as themselves and control characters are
5390 displayed according to the buffer-local variable `ctl-arrow'. Control
5391 characters are further affected by `control-arrow-glyph' and
5392 `octal-escape-glyph'.)
5394 Each instantiator in this specifier and the display-table specifiers
5395 in faces is a display table or a list of such tables. If a list, each
5396 table will be searched in turn for an entry matching a particular
5397 character. Each display table is one of
5399 -- a vector, specifying values for characters starting at 0
5400 -- a char table, either of type `char' or `generic'
5403 Each entry in a display table should be one of
5405 -- nil (this entry is ignored and the search continues)
5406 -- a character (use this character; if it happens to be the same as
5407 the original character, default processing happens, otherwise
5408 redisplay attempts to display this character directly;
5409 #### At some point recursive display-table lookup will be
5411 -- a string (display each character in the string directly;
5412 #### At some point recursive display-table lookup will be
5414 -- a glyph (display the glyph;
5415 #### At some point recursive display-table lookup will be
5416 implemented when a string glyph is being processed.)
5417 -- a cons of the form (format "STRING") where STRING is a printf-like
5418 spec used to process the character. #### Unfortunately no
5419 formatting directives other than %% are implemented.
5420 -- a vector (each element of the vector is processed recursively;
5421 in such a case, nil elements in the vector are simply ignored)
5423 #### At some point in the near future, display tables are likely to
5424 be expanded to include other features, such as referencing characters
5425 in particular fonts and allowing the character search to continue
5426 all the way up the chain of specifier instantiators. These features
5427 are necessary to properly display Unicode characters.
5429 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
5430 set_specifier_fallback (Vcurrent_display_table,
5431 list1 (Fcons (Qnil, Qnil)));
5432 set_specifier_caching (Vcurrent_display_table,
5433 offsetof (struct window, display_table),
5434 some_window_value_changed,
5439 complex_vars_of_glyphs (void)
5441 /* Partially initialized in glyphs-x.c, glyphs.el */
5442 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
5443 What to display at the end of truncated lines.
5445 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5447 /* Partially initialized in glyphs-x.c, glyphs.el */
5448 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
5449 What to display at the end of wrapped lines.
5451 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5453 /* Partially initialized in glyphs-x.c, glyphs.el */
5454 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
5455 The glyph used to display the XEmacs logo at startup.
5457 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);