1 /* Generic glyph/image implementation + display tables
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 1995 Tinker Systems
4 Copyright (C) 1995, 1996 Ben Wing
5 Copyright (C) 1995 Sun Microsystems
6 Copyright (C) 1998, 1999, 2000 Andy Piper
8 This file is part of XEmacs.
10 XEmacs is free software; you can redistribute it and/or modify it
11 under the terms of the GNU General Public License as published by the
12 Free Software Foundation; either version 2, or (at your option) any
15 XEmacs is distributed in the hope that it will be useful, but WITHOUT
16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
20 You should have received a copy of the GNU General Public License
21 along with XEmacs; see the file COPYING. If not, write to
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 Boston, MA 02111-1307, USA. */
25 /* Synched up with: Not in FSF. */
27 /* Written by Ben Wing and Chuck Thompson. Heavily modified /
28 rewritten by Andy Piper. */
41 #include "redisplay.h"
46 #include "blocktype.h"
52 Lisp_Object Qimage_conversion_error;
54 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
55 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p;
56 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p;
57 Lisp_Object Qmono_pixmap_image_instance_p;
58 Lisp_Object Qcolor_pixmap_image_instance_p;
59 Lisp_Object Qpointer_image_instance_p;
60 Lisp_Object Qsubwindow_image_instance_p;
61 Lisp_Object Qlayout_image_instance_p;
62 Lisp_Object Qwidget_image_instance_p;
63 Lisp_Object Qconst_glyph_variable;
64 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow;
65 Lisp_Object Q_file, Q_data, Q_face, Q_pixel_width, Q_pixel_height;
66 Lisp_Object Qformatted_string;
67 Lisp_Object Vcurrent_display_table;
68 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph;
69 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph;
70 Lisp_Object Vxemacs_logo;
71 Lisp_Object Vthe_nothing_vector;
72 Lisp_Object Vimage_instantiator_format_list;
73 Lisp_Object Vimage_instance_type_list;
74 Lisp_Object Vglyph_type_list;
76 int disable_animated_pixmaps;
78 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
79 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
80 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
81 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
82 DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow);
83 DEFINE_IMAGE_INSTANTIATOR_FORMAT (text);
85 #ifdef HAVE_WINDOW_SYSTEM
86 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
89 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
90 Lisp_Object Q_foreground, Q_background;
92 #define BitmapSuccess 0
93 #define BitmapOpenFailed 1
94 #define BitmapFileInvalid 2
95 #define BitmapNoMemory 3
100 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
105 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
107 Lisp_Object Q_color_symbols;
110 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
111 struct image_instantiator_format_entry
115 struct image_instantiator_methods *meths;
120 Dynarr_declare (struct image_instantiator_format_entry);
121 } image_instantiator_format_entry_dynarr;
123 image_instantiator_format_entry_dynarr *
124 the_image_instantiator_format_entry_dynarr;
126 static Lisp_Object allocate_image_instance (Lisp_Object device, Lisp_Object glyph);
127 static void image_validate (Lisp_Object instantiator);
128 static void glyph_property_was_changed (Lisp_Object glyph,
129 Lisp_Object property,
131 static void set_image_instance_dirty_p (Lisp_Object instance, int dirty);
132 static void register_ignored_expose (struct frame* f, int x, int y, int width, int height);
133 /* Unfortunately windows and X are different. In windows BeginPaint()
134 will prevent WM_PAINT messages being generated so it is unnecessary
135 to register exposures as they will not occur. Under X they will
137 int hold_ignored_expose_registration;
139 EXFUN (Fimage_instance_type, 1);
140 EXFUN (Fglyph_type, 1);
143 /****************************************************************************
144 * Image Instantiators *
145 ****************************************************************************/
147 struct image_instantiator_methods *
148 decode_device_ii_format (Lisp_Object device, Lisp_Object format,
153 if (!SYMBOLP (format))
155 if (ERRB_EQ (errb, ERROR_ME))
156 CHECK_SYMBOL (format);
160 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
164 Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
167 Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
169 if ((NILP (d) && NILP (device))
172 EQ (CONSOLE_TYPE (XCONSOLE
173 (DEVICE_CONSOLE (XDEVICE (device)))), d)))
174 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
178 maybe_signal_simple_error ("Invalid image-instantiator format", format,
184 struct image_instantiator_methods *
185 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
187 return decode_device_ii_format (Qnil, format, errb);
191 valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale)
194 struct image_instantiator_methods* meths =
195 decode_image_instantiator_format (format, ERROR_ME_NOT);
196 Lisp_Object contype = Qnil;
197 /* mess with the locale */
198 if (!NILP (locale) && SYMBOLP (locale))
202 struct console* console = decode_console (locale);
203 contype = console ? CONSOLE_TYPE (console) : locale;
205 /* nothing is valid in all locales */
206 if (EQ (format, Qnothing))
208 /* reject unknown formats */
209 else if (NILP (contype) || !meths)
212 for (i = 0; i < Dynarr_length (meths->consoles); i++)
213 if (EQ (contype, Dynarr_at (meths->consoles, i).symbol))
218 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
220 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
221 If LOCALE is non-nil then the format is checked in that domain.
222 If LOCALE is nil the current console is used.
223 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
224 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
225 'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled.
227 (image_instantiator_format, locale))
229 return valid_image_instantiator_format_p (image_instantiator_format, locale) ?
233 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
235 Return a list of valid image-instantiator formats.
239 return Fcopy_sequence (Vimage_instantiator_format_list);
243 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol,
244 struct image_instantiator_methods *meths)
246 struct image_instantiator_format_entry entry;
248 entry.symbol = symbol;
249 entry.device = device;
251 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
252 Vimage_instantiator_format_list =
253 Fcons (symbol, Vimage_instantiator_format_list);
257 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
259 image_instantiator_methods *meths)
261 add_entry_to_device_ii_format_list (Qnil, symbol, meths);
265 get_image_conversion_list (Lisp_Object console_type)
267 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
270 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
272 Set the image-conversion-list for consoles of the given TYPE.
273 The image-conversion-list specifies how image instantiators that
274 are strings should be interpreted. Each element of the list should be
275 a list of two elements (a regular expression string and a vector) or
276 a list of three elements (the preceding two plus an integer index into
277 the vector). The string is converted to the vector associated with the
278 first matching regular expression. If a vector index is specified, the
279 string itself is substituted into that position in the vector.
281 Note: The conversion above is applied when the image instantiator is
282 added to an image specifier, not when the specifier is actually
283 instantiated. Therefore, changing the image-conversion-list only affects
284 newly-added instantiators. Existing instantiators in glyphs and image
285 specifiers will not be affected.
287 (console_type, list))
290 Lisp_Object *imlist = get_image_conversion_list (console_type);
292 /* Check the list to make sure that it only has valid entries. */
294 EXTERNAL_LIST_LOOP (tail, list)
296 Lisp_Object mapping = XCAR (tail);
298 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
299 if (!CONSP (mapping) ||
300 !CONSP (XCDR (mapping)) ||
301 (!NILP (XCDR (XCDR (mapping))) &&
302 (!CONSP (XCDR (XCDR (mapping))) ||
303 !NILP (XCDR (XCDR (XCDR (mapping)))))))
304 signal_simple_error ("Invalid mapping form", mapping);
307 Lisp_Object exp = XCAR (mapping);
308 Lisp_Object typevec = XCAR (XCDR (mapping));
309 Lisp_Object pos = Qnil;
314 CHECK_VECTOR (typevec);
315 if (!NILP (XCDR (XCDR (mapping))))
317 pos = XCAR (XCDR (XCDR (mapping)));
319 if (XINT (pos) < 0 ||
320 XINT (pos) >= XVECTOR_LENGTH (typevec))
322 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
325 newvec = Fcopy_sequence (typevec);
327 XVECTOR_DATA (newvec)[XINT (pos)] = exp;
329 image_validate (newvec);
334 *imlist = Fcopy_tree (list, Qt);
338 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
340 Return the image-conversion-list for devices of the given TYPE.
341 The image-conversion-list specifies how to interpret image string
342 instantiators for the specified console type. See
343 `set-console-type-image-conversion-list' for a description of its syntax.
347 return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
350 /* Process a string instantiator according to the image-conversion-list for
351 CONSOLE_TYPE. Returns a vector. */
354 process_image_string_instantiator (Lisp_Object data,
355 Lisp_Object console_type,
360 LIST_LOOP (tail, *get_image_conversion_list (console_type))
362 Lisp_Object mapping = XCAR (tail);
363 Lisp_Object exp = XCAR (mapping);
364 Lisp_Object typevec = XCAR (XCDR (mapping));
366 /* if the result is of a type that can't be instantiated
367 (e.g. a string when we're dealing with a pointer glyph),
370 IIFORMAT_METH (decode_image_instantiator_format
371 (XVECTOR_DATA (typevec)[0], ERROR_ME),
372 possible_dest_types, ())))
374 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
376 if (!NILP (XCDR (XCDR (mapping))))
378 int pos = XINT (XCAR (XCDR (XCDR (mapping))));
379 Lisp_Object newvec = Fcopy_sequence (typevec);
380 XVECTOR_DATA (newvec)[pos] = data;
389 signal_simple_error ("Unable to interpret glyph instantiator",
396 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
397 Lisp_Object default_)
400 int instantiator_len;
402 elt = XVECTOR_DATA (vector);
403 instantiator_len = XVECTOR_LENGTH (vector);
408 while (instantiator_len > 0)
410 if (EQ (elt[0], keyword))
413 instantiator_len -= 2;
420 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
422 return find_keyword_in_vector_or_given (vector, keyword, Qnil);
426 check_valid_string (Lisp_Object data)
432 check_valid_vector (Lisp_Object data)
438 check_valid_face (Lisp_Object data)
444 check_valid_int (Lisp_Object data)
450 file_or_data_must_be_present (Lisp_Object instantiator)
452 if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
453 NILP (find_keyword_in_vector (instantiator, Q_data)))
454 signal_simple_error ("Must supply either :file or :data",
459 data_must_be_present (Lisp_Object instantiator)
461 if (NILP (find_keyword_in_vector (instantiator, Q_data)))
462 signal_simple_error ("Must supply :data", instantiator);
466 face_must_be_present (Lisp_Object instantiator)
468 if (NILP (find_keyword_in_vector (instantiator, Q_face)))
469 signal_simple_error ("Must supply :face", instantiator);
472 /* utility function useful in retrieving data from a file. */
475 make_string_from_file (Lisp_Object file)
477 /* This function can call lisp */
478 int count = specpdl_depth ();
479 Lisp_Object temp_buffer;
483 specbind (Qinhibit_quit, Qt);
484 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
485 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
486 GCPRO1 (temp_buffer);
487 set_buffer_internal (XBUFFER (temp_buffer));
488 Ferase_buffer (Qnil);
489 specbind (intern ("format-alist"), Qnil);
490 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
491 data = Fbuffer_substring (Qnil, Qnil, Qnil);
492 unbind_to (count, Qnil);
497 /* The following two functions are provided to make it easier for
498 the normalize methods to work with keyword-value vectors.
499 Hash tables are kind of heavyweight for this purpose.
500 (If vectors were resizable, we could avoid this problem;
501 but they're not.) An alternative approach that might be
502 more efficient but require more work is to use a type of
503 assoc-Dynarr and provide primitives for deleting elements out
504 of it. (However, you'd also have to add an unwind-protect
505 to make sure the Dynarr got freed in case of an error in
506 the normalization process.) */
509 tagged_vector_to_alist (Lisp_Object vector)
511 Lisp_Object *elt = XVECTOR_DATA (vector);
512 int len = XVECTOR_LENGTH (vector);
513 Lisp_Object result = Qnil;
516 for (len -= 2; len >= 1; len -= 2)
517 result = Fcons (Fcons (elt[len], elt[len+1]), result);
523 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
525 int len = 1 + 2 * XINT (Flength (alist));
526 Lisp_Object *elt = alloca_array (Lisp_Object, len);
532 LIST_LOOP (rest, alist)
534 Lisp_Object pair = XCAR (rest);
535 elt[i] = XCAR (pair);
536 elt[i+1] = XCDR (pair);
540 return Fvector (len, elt);
544 normalize_image_instantiator (Lisp_Object instantiator,
546 Lisp_Object dest_mask)
548 if (IMAGE_INSTANCEP (instantiator))
551 if (STRINGP (instantiator))
552 instantiator = process_image_string_instantiator (instantiator, contype,
555 assert (VECTORP (instantiator));
556 /* We have to always store the actual pixmap data and not the
557 filename even though this is a potential memory pig. We have to
558 do this because it is quite possible that we will need to
559 instantiate a new instance of the pixmap and the file will no
560 longer exist (e.g. w3 pixmaps are almost always from temporary
564 struct image_instantiator_methods *meths;
566 GCPRO1 (instantiator);
568 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
570 RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
571 (instantiator, contype),
577 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
578 Lisp_Object instantiator,
579 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
580 int dest_mask, Lisp_Object glyph)
582 Lisp_Object ii = allocate_image_instance (device, glyph);
583 Lisp_Image_Instance* p = XIMAGE_INSTANCE (ii);
584 struct image_instantiator_methods *meths;
589 if (!valid_image_instantiator_format_p (XVECTOR_DATA (instantiator)[0], device))
591 ("Image instantiator format is invalid in this locale.",
594 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
596 methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate);
597 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
598 pointer_bg, dest_mask, domain));
600 /* now do device specific instantiation */
601 meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0],
604 if (!methp && (!meths || !HAS_IIFORMAT_METH_P (meths, instantiate)))
606 ("Don't know how to instantiate this image instantiator?",
608 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
609 pointer_bg, dest_mask, domain));
612 /* Some code may have already laid out the widget, if not then do it
614 if (IMAGE_INSTANCE_LAYOUT_CHANGED (p))
615 image_instance_layout (ii, IMAGE_UNSPECIFIED_GEOMETRY,
616 IMAGE_UNSPECIFIED_GEOMETRY, domain);
618 /* We *must* have a clean image at this point. */
619 IMAGE_INSTANCE_TEXT_CHANGED (p) = 0;
620 IMAGE_INSTANCE_SIZE_CHANGED (p) = 0;
621 IMAGE_INSTANCE_LAYOUT_CHANGED (p) = 0;
622 IMAGE_INSTANCE_DIRTYP (p) = 0;
628 /****************************************************************************
629 * Image-Instance Object *
630 ****************************************************************************/
632 Lisp_Object Qimage_instancep;
635 mark_image_instance (Lisp_Object obj)
637 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
639 mark_object (i->name);
640 /* We don't mark the glyph reference since that would create a
641 circularity preventing GC. */
642 switch (IMAGE_INSTANCE_TYPE (i))
645 mark_object (IMAGE_INSTANCE_TEXT_STRING (i));
647 case IMAGE_MONO_PIXMAP:
648 case IMAGE_COLOR_PIXMAP:
649 mark_object (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
650 mark_object (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
651 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
652 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
653 mark_object (IMAGE_INSTANCE_PIXMAP_FG (i));
654 mark_object (IMAGE_INSTANCE_PIXMAP_BG (i));
659 mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i));
660 mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i));
661 mark_object (IMAGE_INSTANCE_WIDGET_FACE (i));
662 mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i));
663 case IMAGE_SUBWINDOW:
664 mark_object (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
671 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i));
677 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
681 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
684 error ("printing unreadable object #<image-instance 0x%x>",
686 write_c_string ("#<image-instance (", printcharfun);
687 print_internal (Fimage_instance_type (obj), printcharfun, 0);
688 write_c_string (") ", printcharfun);
689 if (!NILP (ii->name))
691 print_internal (ii->name, printcharfun, 1);
692 write_c_string (" ", printcharfun);
694 write_c_string ("on ", printcharfun);
695 print_internal (ii->device, printcharfun, 0);
696 write_c_string (" ", printcharfun);
697 switch (IMAGE_INSTANCE_TYPE (ii))
703 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
706 case IMAGE_MONO_PIXMAP:
707 case IMAGE_COLOR_PIXMAP:
709 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
712 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
713 s = strrchr ((char *) XSTRING_DATA (filename), '/');
715 print_internal (build_string (s + 1), printcharfun, 1);
717 print_internal (filename, printcharfun, 1);
719 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
720 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
721 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
722 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
724 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
725 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
726 write_c_string (buf, printcharfun);
727 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
728 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
730 write_c_string (" @", printcharfun);
731 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
733 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
734 write_c_string (buf, printcharfun);
737 write_c_string ("??", printcharfun);
738 write_c_string (",", printcharfun);
739 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
741 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
742 write_c_string (buf, printcharfun);
745 write_c_string ("??", printcharfun);
747 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
748 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
750 write_c_string (" (", printcharfun);
751 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
755 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
757 write_c_string ("/", printcharfun);
758 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
762 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
764 write_c_string (")", printcharfun);
769 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
771 write_c_string (" (", printcharfun);
773 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
774 write_c_string (")", printcharfun);
777 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
778 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0);
780 case IMAGE_SUBWINDOW:
782 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
783 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
784 write_c_string (buf, printcharfun);
786 /* This is stolen from frame.c. Subwindows are strange in that they
787 are specific to a particular frame so we want to print in their
788 description what that frame is. */
790 write_c_string (" on #<", printcharfun);
792 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
794 if (!FRAME_LIVE_P (f))
795 write_c_string ("dead", printcharfun);
797 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
800 write_c_string ("-frame ", printcharfun);
802 write_c_string (">", printcharfun);
803 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
804 write_c_string (buf, printcharfun);
812 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
813 (ii, printcharfun, escapeflag));
814 sprintf (buf, " 0x%x>", ii->header.uid);
815 write_c_string (buf, printcharfun);
819 finalize_image_instance (void *header, int for_disksave)
821 Lisp_Image_Instance *i = (Lisp_Image_Instance *) header;
823 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
824 /* objects like this exist at dump time, so don't bomb out. */
826 if (for_disksave) finalose (i);
828 /* do this so that the cachels get reset */
829 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
831 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW
833 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
835 MARK_FRAME_SUBWINDOWS_CHANGED
836 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
839 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
843 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
845 Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
846 Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
847 struct device *d1 = XDEVICE (i1->device);
848 struct device *d2 = XDEVICE (i2->device);
852 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)
853 || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2)
854 || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2)
855 || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2)
856 || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (i2))
858 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
862 switch (IMAGE_INSTANCE_TYPE (i1))
868 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
869 IMAGE_INSTANCE_TEXT_STRING (i2),
874 case IMAGE_MONO_PIXMAP:
875 case IMAGE_COLOR_PIXMAP:
877 if (!(IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
878 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
879 IMAGE_INSTANCE_PIXMAP_SLICE (i1) ==
880 IMAGE_INSTANCE_PIXMAP_SLICE (i2) &&
881 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
882 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
883 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
884 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
885 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
886 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
888 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
889 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
896 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
897 IMAGE_INSTANCE_WIDGET_TYPE (i2))
898 && IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
899 IMAGE_INSTANCE_SUBWINDOW_ID (i2)
900 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1),
901 IMAGE_INSTANCE_WIDGET_ITEMS (i2),
903 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
904 IMAGE_INSTANCE_WIDGET_PROPS (i2),
910 case IMAGE_SUBWINDOW:
911 if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
912 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
920 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
924 image_instance_hash (Lisp_Object obj, int depth)
926 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
927 struct device *d = XDEVICE (i->device);
928 unsigned long hash = HASH3 ((unsigned long) d,
929 IMAGE_INSTANCE_WIDTH (i),
930 IMAGE_INSTANCE_HEIGHT (i));
932 switch (IMAGE_INSTANCE_TYPE (i))
938 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
942 case IMAGE_MONO_PIXMAP:
943 case IMAGE_COLOR_PIXMAP:
945 hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i),
946 IMAGE_INSTANCE_PIXMAP_SLICE (i),
947 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
954 internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1),
955 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
956 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1));
957 case IMAGE_SUBWINDOW:
958 hash = HASH2 (hash, (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
965 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
969 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
970 mark_image_instance, print_image_instance,
971 finalize_image_instance, image_instance_equal,
972 image_instance_hash, 0,
973 Lisp_Image_Instance);
976 allocate_image_instance (Lisp_Object device, Lisp_Object glyph)
978 Lisp_Image_Instance *lp =
979 alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance);
984 lp->type = IMAGE_NOTHING;
991 /* So that layouts get done. */
992 lp->layout_changed = 1;
994 XSETIMAGE_INSTANCE (val, lp);
1000 static enum image_instance_type
1001 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
1003 if (ERRB_EQ (errb, ERROR_ME))
1004 CHECK_SYMBOL (type);
1006 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
1007 if (EQ (type, Qtext)) return IMAGE_TEXT;
1008 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
1009 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
1010 if (EQ (type, Qpointer)) return IMAGE_POINTER;
1011 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
1012 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
1013 if (EQ (type, Qlayout)) return IMAGE_LAYOUT;
1015 maybe_signal_simple_error ("Invalid image-instance type", type,
1018 return IMAGE_UNKNOWN; /* not reached */
1022 encode_image_instance_type (enum image_instance_type type)
1026 case IMAGE_NOTHING: return Qnothing;
1027 case IMAGE_TEXT: return Qtext;
1028 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
1029 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
1030 case IMAGE_POINTER: return Qpointer;
1031 case IMAGE_SUBWINDOW: return Qsubwindow;
1032 case IMAGE_WIDGET: return Qwidget;
1033 case IMAGE_LAYOUT: return Qlayout;
1038 return Qnil; /* not reached */
1042 image_instance_type_to_mask (enum image_instance_type type)
1044 /* This depends on the fact that enums are assigned consecutive
1045 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
1046 first enum.) I'm fairly sure this behavior is ANSI-mandated,
1047 so there should be no portability problems here. */
1048 return (1 << ((int) (type) - 1));
1052 decode_image_instance_type_list (Lisp_Object list)
1062 enum image_instance_type type =
1063 decode_image_instance_type (list, ERROR_ME);
1064 return image_instance_type_to_mask (type);
1067 EXTERNAL_LIST_LOOP (rest, list)
1069 enum image_instance_type type =
1070 decode_image_instance_type (XCAR (rest), ERROR_ME);
1071 mask |= image_instance_type_to_mask (type);
1078 encode_image_instance_type_list (int mask)
1081 Lisp_Object result = Qnil;
1087 result = Fcons (encode_image_instance_type
1088 ((enum image_instance_type) count), result);
1092 return Fnreverse (result);
1096 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1097 int desired_dest_mask)
1102 (emacs_doprnt_string_lisp_2
1104 "No compatible image-instance types given: wanted one of %s, got %s",
1106 encode_image_instance_type_list (desired_dest_mask),
1107 encode_image_instance_type_list (given_dest_mask)),
1112 valid_image_instance_type_p (Lisp_Object type)
1114 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1117 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1118 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1119 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1120 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1122 (image_instance_type))
1124 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1127 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1128 Return a list of valid image-instance types.
1132 return Fcopy_sequence (Vimage_instance_type_list);
1136 decode_error_behavior_flag (Lisp_Object no_error)
1138 if (NILP (no_error)) return ERROR_ME;
1139 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1140 else return ERROR_ME_WARN;
1144 encode_error_behavior_flag (Error_behavior errb)
1146 if (ERRB_EQ (errb, ERROR_ME))
1148 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1152 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1157 /* Recurse up the hierarchy looking for the topmost glyph. This means
1158 that instances in layouts will inherit face properties from their
1160 Lisp_Object image_instance_parent_glyph (Lisp_Image_Instance* ii)
1162 if (IMAGE_INSTANCEP (IMAGE_INSTANCE_PARENT (ii)))
1164 return image_instance_parent_glyph
1165 (XIMAGE_INSTANCE (IMAGE_INSTANCE_PARENT (ii)));
1167 return IMAGE_INSTANCE_PARENT (ii);
1171 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1172 Lisp_Object dest_types)
1175 struct gcpro gcpro1;
1178 XSETDEVICE (device, decode_device (device));
1179 /* instantiate_image_instantiator() will abort if given an
1180 image instance ... */
1181 if (IMAGE_INSTANCEP (data))
1182 signal_simple_error ("Image instances not allowed here", data);
1183 image_validate (data);
1184 dest_mask = decode_image_instance_type_list (dest_types);
1185 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1186 make_int (dest_mask));
1188 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1189 signal_simple_error ("Inheritance not allowed here", data);
1190 ii = instantiate_image_instantiator (device, device, data,
1191 Qnil, Qnil, dest_mask, Qnil);
1192 RETURN_UNGCPRO (ii);
1195 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1196 Return a new `image-instance' object.
1198 Image-instance objects encapsulate the way a particular image (pixmap,
1199 etc.) is displayed on a particular device. In most circumstances, you
1200 do not need to directly create image instances; use a glyph instead.
1201 However, it may occasionally be useful to explicitly create image
1202 instances, if you want more control over the instantiation process.
1204 DATA is an image instantiator, which describes the image; see
1205 `image-specifier-p' for a description of the allowed values.
1207 DEST-TYPES should be a list of allowed image instance types that can
1208 be generated. The recognized image instance types are
1211 Nothing is displayed.
1213 Displayed as text. The foreground and background colors and the
1214 font of the text are specified independent of the pixmap. Typically
1215 these attributes will come from the face of the surrounding text,
1216 unless a face is specified for the glyph in which the image appears.
1218 Displayed as a mono pixmap (a pixmap with only two colors where the
1219 foreground and background can be specified independent of the pixmap;
1220 typically the pixmap assumes the foreground and background colors of
1221 the text around it, unless a face is specified for the glyph in which
1224 Displayed as a color pixmap.
1226 Used as the mouse pointer for a window.
1228 A child window that is treated as an image. This allows (e.g.)
1229 another program to be responsible for drawing into the window.
1231 A child window that contains a window-system widget, e.g. a push
1234 The DEST-TYPES list is unordered. If multiple destination types
1235 are possible for a given instantiator, the "most natural" type
1236 for the instantiator's format is chosen. (For XBM, the most natural
1237 types are `mono-pixmap', followed by `color-pixmap', followed by
1238 `pointer'. For the other normal image formats, the most natural
1239 types are `color-pixmap', followed by `mono-pixmap', followed by
1240 `pointer'. For the string and formatted-string formats, the most
1241 natural types are `text', followed by `mono-pixmap' (not currently
1242 implemented), followed by `color-pixmap' (not currently implemented).
1243 The other formats can only be instantiated as one type. (If you
1244 want to control more specifically the order of the types into which
1245 an image is instantiated, just call `make-image-instance' repeatedly
1246 until it succeeds, passing less and less preferred destination types
1249 If DEST-TYPES is omitted, all possible types are allowed.
1251 NO-ERROR controls what happens when the image cannot be generated.
1252 If nil, an error message is generated. If t, no messages are
1253 generated and this function returns nil. If anything else, a warning
1254 message is generated and this function returns nil.
1256 (data, device, dest_types, no_error))
1258 Error_behavior errb = decode_error_behavior_flag (no_error);
1260 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1262 3, data, device, dest_types);
1265 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1266 Return non-nil if OBJECT is an image instance.
1270 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1273 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1274 Return the type of the given image instance.
1275 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1276 'color-pixmap, 'pointer, or 'subwindow.
1280 CHECK_IMAGE_INSTANCE (image_instance);
1281 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1284 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1285 Return the name of the given image instance.
1289 CHECK_IMAGE_INSTANCE (image_instance);
1290 return XIMAGE_INSTANCE_NAME (image_instance);
1293 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1294 Return the string of the given image instance.
1295 This will only be non-nil for text image instances and widgets.
1299 CHECK_IMAGE_INSTANCE (image_instance);
1300 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1301 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1302 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1303 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1308 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1309 Return the given property of the given image instance.
1310 Returns nil if the property or the property method do not exist for
1311 the image instance in the domain.
1313 (image_instance, prop))
1315 Lisp_Image_Instance* ii;
1316 Lisp_Object type, ret;
1317 struct image_instantiator_methods* meths;
1319 CHECK_IMAGE_INSTANCE (image_instance);
1320 CHECK_SYMBOL (prop);
1321 ii = XIMAGE_INSTANCE (image_instance);
1323 /* ... then try device specific methods ... */
1324 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1325 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1326 type, ERROR_ME_NOT);
1327 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1329 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1333 /* ... then format specific methods ... */
1334 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1335 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1337 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1345 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1346 Set the given property of the given image instance.
1347 Does nothing if the property or the property method do not exist for
1348 the image instance in the domain.
1350 (image_instance, prop, val))
1352 Lisp_Image_Instance* ii;
1353 Lisp_Object type, ret;
1354 struct image_instantiator_methods* meths;
1356 CHECK_IMAGE_INSTANCE (image_instance);
1357 CHECK_SYMBOL (prop);
1358 ii = XIMAGE_INSTANCE (image_instance);
1359 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1360 /* try device specific methods first ... */
1361 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1362 type, ERROR_ME_NOT);
1363 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1366 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1372 /* ... then format specific methods ... */
1373 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1374 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1377 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1387 /* Make sure the image instance gets redisplayed. */
1388 set_image_instance_dirty_p (image_instance, 1);
1389 /* Force the glyph to be laid out again. */
1390 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
1392 MARK_SUBWINDOWS_STATE_CHANGED;
1393 MARK_GLYPHS_CHANGED;
1398 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1399 Return the file name from which IMAGE-INSTANCE was read, if known.
1403 CHECK_IMAGE_INSTANCE (image_instance);
1405 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1407 case IMAGE_MONO_PIXMAP:
1408 case IMAGE_COLOR_PIXMAP:
1410 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1417 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1418 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1422 CHECK_IMAGE_INSTANCE (image_instance);
1424 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1426 case IMAGE_MONO_PIXMAP:
1427 case IMAGE_COLOR_PIXMAP:
1429 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1436 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1437 Return the depth of the image instance.
1438 This is 0 for a bitmap, or a positive integer for a pixmap.
1442 CHECK_IMAGE_INSTANCE (image_instance);
1444 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1446 case IMAGE_MONO_PIXMAP:
1447 case IMAGE_COLOR_PIXMAP:
1449 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1456 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1457 Return the height of the image instance, in pixels.
1461 CHECK_IMAGE_INSTANCE (image_instance);
1463 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1465 case IMAGE_MONO_PIXMAP:
1466 case IMAGE_COLOR_PIXMAP:
1468 case IMAGE_SUBWINDOW:
1471 return make_int (XIMAGE_INSTANCE_HEIGHT (image_instance));
1478 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1479 Return the width of the image instance, in pixels.
1483 CHECK_IMAGE_INSTANCE (image_instance);
1485 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1487 case IMAGE_MONO_PIXMAP:
1488 case IMAGE_COLOR_PIXMAP:
1490 case IMAGE_SUBWINDOW:
1493 return make_int (XIMAGE_INSTANCE_WIDTH (image_instance));
1500 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1501 Return the X coordinate of the image instance's hotspot, if known.
1502 This is a point relative to the origin of the pixmap. When an image is
1503 used as a mouse pointer, the hotspot is the point on the image that sits
1504 over the location that the pointer points to. This is, for example, the
1505 tip of the arrow or the center of the crosshairs.
1506 This will always be nil for a non-pointer image instance.
1510 CHECK_IMAGE_INSTANCE (image_instance);
1512 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1514 case IMAGE_MONO_PIXMAP:
1515 case IMAGE_COLOR_PIXMAP:
1517 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1524 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1525 Return the Y coordinate of the image instance's hotspot, if known.
1526 This is a point relative to the origin of the pixmap. When an image is
1527 used as a mouse pointer, the hotspot is the point on the image that sits
1528 over the location that the pointer points to. This is, for example, the
1529 tip of the arrow or the center of the crosshairs.
1530 This will always be nil for a non-pointer image instance.
1534 CHECK_IMAGE_INSTANCE (image_instance);
1536 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1538 case IMAGE_MONO_PIXMAP:
1539 case IMAGE_COLOR_PIXMAP:
1541 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1548 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1549 Return the foreground color of IMAGE-INSTANCE, if applicable.
1550 This will be a color instance or nil. (It will only be non-nil for
1551 colorized mono pixmaps and for pointers.)
1555 CHECK_IMAGE_INSTANCE (image_instance);
1557 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1559 case IMAGE_MONO_PIXMAP:
1560 case IMAGE_COLOR_PIXMAP:
1562 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1565 return FACE_FOREGROUND (
1566 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1567 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1575 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1576 Return the background color of IMAGE-INSTANCE, if applicable.
1577 This will be a color instance or nil. (It will only be non-nil for
1578 colorized mono pixmaps and for pointers.)
1582 CHECK_IMAGE_INSTANCE (image_instance);
1584 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1586 case IMAGE_MONO_PIXMAP:
1587 case IMAGE_COLOR_PIXMAP:
1589 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1592 return FACE_BACKGROUND (
1593 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1594 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1603 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1604 Make the image instance be displayed in the given colors.
1605 This function returns a new image instance that is exactly like the
1606 specified one except that (if possible) the foreground and background
1607 colors and as specified. Currently, this only does anything if the image
1608 instance is a mono pixmap; otherwise, the same image instance is returned.
1610 (image_instance, foreground, background))
1615 CHECK_IMAGE_INSTANCE (image_instance);
1616 CHECK_COLOR_INSTANCE (foreground);
1617 CHECK_COLOR_INSTANCE (background);
1619 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1620 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1621 return image_instance;
1623 /* #### There should be a copy_image_instance(), which calls a
1624 device-specific method to copy the window-system subobject. */
1625 new = allocate_image_instance (device, Qnil);
1626 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1627 /* note that if this method returns non-zero, this method MUST
1628 copy any window-system resources, so that when one image instance is
1629 freed, the other one is not hosed. */
1630 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1632 return image_instance;
1637 /************************************************************************/
1638 /* Geometry calculations */
1639 /************************************************************************/
1641 /* Find out desired geometry of the image instance. If there is no
1642 special function then just return the width and / or height. */
1644 image_instance_query_geometry (Lisp_Object image_instance,
1645 unsigned int* width, unsigned int* height,
1646 enum image_instance_geometry disp,
1649 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1651 struct image_instantiator_methods* meths;
1653 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1654 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1656 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1658 IIFORMAT_METH (meths, query_geometry, (image_instance, width, height,
1664 *width = IMAGE_INSTANCE_WIDTH (ii);
1666 *height = IMAGE_INSTANCE_HEIGHT (ii);
1670 /* Layout the image instance using the provided dimensions. Layout
1671 widgets are going to do different kinds of calculations to
1672 determine what size to give things so we could make the layout
1673 function relatively simple to take account of that. An alternative
1674 approach is to consider separately the two cases, one where you
1675 don't mind what size you have (normal widgets) and one where you
1676 want to specifiy something (layout widgets). */
1678 image_instance_layout (Lisp_Object image_instance,
1679 unsigned int width, unsigned int height,
1682 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1684 struct image_instantiator_methods* meths;
1686 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1687 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1689 /* If geometry is unspecified then get some reasonable values for it. */
1690 if (width == IMAGE_UNSPECIFIED_GEOMETRY
1692 height == IMAGE_UNSPECIFIED_GEOMETRY)
1694 unsigned int dwidth, dheight;
1696 /* Get the desired geometry. */
1697 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1699 IIFORMAT_METH (meths, query_geometry, (image_instance, &dwidth, &dheight,
1700 IMAGE_DESIRED_GEOMETRY,
1705 dwidth = IMAGE_INSTANCE_WIDTH (ii);
1706 dheight = IMAGE_INSTANCE_HEIGHT (ii);
1709 /* Compare with allowed geometry. */
1710 if (width == IMAGE_UNSPECIFIED_GEOMETRY)
1712 if (height == IMAGE_UNSPECIFIED_GEOMETRY)
1716 /* At this point width and height should contain sane values. Thus
1717 we set the glyph geometry and lay it out. */
1718 if (IMAGE_INSTANCE_WIDTH (ii) != width
1720 IMAGE_INSTANCE_HEIGHT (ii) != height)
1722 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
1725 IMAGE_INSTANCE_WIDTH (ii) = width;
1726 IMAGE_INSTANCE_HEIGHT (ii) = height;
1728 if (meths && HAS_IIFORMAT_METH_P (meths, layout))
1730 IIFORMAT_METH (meths, layout, (image_instance, width, height, domain));
1732 /* else no change to the geometry. */
1734 /* Do not clear the dirty flag here - redisplay will do this for
1736 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0;
1740 * Mark image instance in W as dirty if (a) W's faces have changed and
1741 * (b) GLYPH_OR_II instance in W is a string.
1743 * Return non-zero if instance has been marked dirty.
1746 invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w)
1748 if (XFRAME(WINDOW_FRAME(w))->faces_changed)
1750 Lisp_Object image = glyph_or_ii;
1752 if (GLYPHP (glyph_or_ii))
1755 XSETWINDOW (window, w);
1756 image = glyph_image_instance (glyph_or_ii, window, ERROR_ME_NOT, 1);
1759 if (TEXT_IMAGE_INSTANCEP (image))
1761 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image);
1762 IMAGE_INSTANCE_DIRTYP (ii) = 1;
1763 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
1764 if (GLYPHP (glyph_or_ii))
1765 XGLYPH_DIRTYP (glyph_or_ii) = 1;
1774 /************************************************************************/
1776 /************************************************************************/
1778 signal_image_error (const char *reason, Lisp_Object frob)
1780 signal_error (Qimage_conversion_error,
1781 list2 (build_translated_string (reason), frob));
1785 signal_image_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1)
1787 signal_error (Qimage_conversion_error,
1788 list3 (build_translated_string (reason), frob0, frob1));
1791 /****************************************************************************
1793 ****************************************************************************/
1796 nothing_possible_dest_types (void)
1798 return IMAGE_NOTHING_MASK;
1802 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1803 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1804 int dest_mask, Lisp_Object domain)
1806 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1808 if (dest_mask & IMAGE_NOTHING_MASK)
1809 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1811 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1815 /****************************************************************************
1817 ****************************************************************************/
1820 inherit_validate (Lisp_Object instantiator)
1822 face_must_be_present (instantiator);
1826 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1830 assert (XVECTOR_LENGTH (inst) == 3);
1831 face = XVECTOR_DATA (inst)[2];
1833 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1838 inherit_possible_dest_types (void)
1840 return IMAGE_MONO_PIXMAP_MASK;
1844 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1845 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1846 int dest_mask, Lisp_Object domain)
1848 /* handled specially in image_instantiate */
1853 /****************************************************************************
1855 ****************************************************************************/
1858 string_validate (Lisp_Object instantiator)
1860 data_must_be_present (instantiator);
1864 string_possible_dest_types (void)
1866 return IMAGE_TEXT_MASK;
1869 /* Called from autodetect_instantiate() */
1871 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1872 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1873 int dest_mask, Lisp_Object domain)
1875 Lisp_Object string = find_keyword_in_vector (instantiator, Q_data);
1876 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1878 /* Should never get here with a domain other than a window. */
1879 assert (!NILP (string) && WINDOWP (domain));
1880 if (dest_mask & IMAGE_TEXT_MASK)
1882 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1883 IMAGE_INSTANCE_TEXT_STRING (ii) = string;
1886 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1889 /* Sort out the size of the text that is being displayed. Calculating
1890 it dynamically allows us to change the text and still see
1891 everything. Note that the following methods are for text not string
1892 since that is what the instantiated type is. The first method is a
1893 helper that is used elsewhere for calculating text geometry. */
1895 query_string_geometry (Lisp_Object string, Lisp_Object face,
1896 unsigned int* width, unsigned int* height,
1897 unsigned int* descent, Lisp_Object domain)
1899 struct font_metric_info fm;
1900 unsigned char charsets[NUM_LEADING_BYTES];
1901 struct face_cachel frame_cachel;
1902 struct face_cachel *cachel;
1903 Lisp_Object frame = FW_FRAME (domain);
1905 /* Compute height */
1908 /* Compute string metric info */
1909 find_charsets_in_bufbyte_string (charsets,
1910 XSTRING_DATA (string),
1911 XSTRING_LENGTH (string));
1913 /* Fallback to the default face if none was provided. */
1916 reset_face_cachel (&frame_cachel);
1917 update_face_cachel_data (&frame_cachel, frame, face);
1918 cachel = &frame_cachel;
1922 cachel = WINDOW_FACE_CACHEL (XWINDOW (domain), DEFAULT_INDEX);
1925 ensure_face_cachel_complete (cachel, domain, charsets);
1926 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
1928 *height = fm.ascent + fm.descent;
1929 /* #### descent only gets set if we query the height as well. */
1931 *descent = fm.descent;
1938 *width = redisplay_frame_text_width_string (XFRAME (frame),
1942 *width = redisplay_frame_text_width_string (XFRAME (frame),
1949 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain)
1951 unsigned char charsets[NUM_LEADING_BYTES];
1952 struct face_cachel frame_cachel;
1953 struct face_cachel *cachel;
1955 Lisp_Object frame = FW_FRAME (domain);
1957 /* Compute string font info */
1958 find_charsets_in_bufbyte_string (charsets,
1959 XSTRING_DATA (string),
1960 XSTRING_LENGTH (string));
1962 reset_face_cachel (&frame_cachel);
1963 update_face_cachel_data (&frame_cachel, frame, face);
1964 cachel = &frame_cachel;
1966 ensure_face_cachel_complete (cachel, domain, charsets);
1968 for (i = 0; i < NUM_LEADING_BYTES; i++)
1972 return FACE_CACHEL_FONT (cachel,
1973 CHARSET_BY_LEADING_BYTE (i +
1979 return Qnil; /* NOT REACHED */
1983 text_query_geometry (Lisp_Object image_instance,
1984 unsigned int* width, unsigned int* height,
1985 enum image_instance_geometry disp, Lisp_Object domain)
1987 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1988 unsigned int descent = 0;
1990 query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii),
1991 IMAGE_INSTANCE_FACE (ii),
1992 width, height, &descent, domain);
1994 /* The descent gets set as a side effect of querying the
1996 IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent;
1999 /* set the properties of a string */
2001 text_set_property (Lisp_Object image_instance, Lisp_Object prop,
2004 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2006 if (EQ (prop, Q_data))
2009 IMAGE_INSTANCE_TEXT_STRING (ii) = val;
2017 /****************************************************************************
2018 * formatted-string *
2019 ****************************************************************************/
2022 formatted_string_validate (Lisp_Object instantiator)
2024 data_must_be_present (instantiator);
2028 formatted_string_possible_dest_types (void)
2030 return IMAGE_TEXT_MASK;
2034 formatted_string_instantiate (Lisp_Object image_instance,
2035 Lisp_Object instantiator,
2036 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2037 int dest_mask, Lisp_Object domain)
2039 /* #### implement this */
2040 warn_when_safe (Qunimplemented, Qnotice,
2041 "`formatted-string' not yet implemented; assuming `string'");
2043 string_instantiate (image_instance, instantiator,
2044 pointer_fg, pointer_bg, dest_mask, domain);
2048 /************************************************************************/
2049 /* pixmap file functions */
2050 /************************************************************************/
2052 /* If INSTANTIATOR refers to inline data, return Qnil.
2053 If INSTANTIATOR refers to data in a file, return the full filename
2054 if it exists; otherwise, return a cons of (filename).
2056 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
2057 keywords used to look up the file and inline data,
2058 respectively, in the instantiator. Normally these would
2059 be Q_file and Q_data, but might be different for mask data. */
2062 potential_pixmap_file_instantiator (Lisp_Object instantiator,
2063 Lisp_Object file_keyword,
2064 Lisp_Object data_keyword,
2065 Lisp_Object console_type)
2070 assert (VECTORP (instantiator));
2072 data = find_keyword_in_vector (instantiator, data_keyword);
2073 file = find_keyword_in_vector (instantiator, file_keyword);
2075 if (!NILP (file) && NILP (data))
2077 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
2078 (decode_console_type(console_type, ERROR_ME),
2079 locate_pixmap_file, (file));
2084 return Fcons (file, Qnil); /* should have been file */
2091 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
2092 Lisp_Object image_type_tag)
2094 /* This function can call lisp */
2095 Lisp_Object file = Qnil;
2096 struct gcpro gcpro1, gcpro2;
2097 Lisp_Object alist = Qnil;
2099 GCPRO2 (file, alist);
2101 /* Now, convert any file data into inline data. At the end of this,
2102 `data' will contain the inline data (if any) or Qnil, and `file'
2103 will contain the name this data was derived from (if known) or
2106 Note that if we cannot generate any regular inline data, we
2109 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2112 if (CONSP (file)) /* failure locating filename */
2113 signal_double_file_error ("Opening pixmap file",
2114 "no such file or directory",
2117 if (NILP (file)) /* no conversion necessary */
2118 RETURN_UNGCPRO (inst);
2120 alist = tagged_vector_to_alist (inst);
2123 Lisp_Object data = make_string_from_file (file);
2124 alist = remassq_no_quit (Q_file, alist);
2125 /* there can't be a :data at this point. */
2126 alist = Fcons (Fcons (Q_file, file),
2127 Fcons (Fcons (Q_data, data), alist));
2131 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
2133 RETURN_UNGCPRO (result);
2138 #ifdef HAVE_WINDOW_SYSTEM
2139 /**********************************************************************
2141 **********************************************************************/
2143 /* Check if DATA represents a valid inline XBM spec (i.e. a list
2144 of (width height bits), with checking done on the dimensions).
2145 If not, signal an error. */
2148 check_valid_xbm_inline (Lisp_Object data)
2150 Lisp_Object width, height, bits;
2152 if (!CONSP (data) ||
2153 !CONSP (XCDR (data)) ||
2154 !CONSP (XCDR (XCDR (data))) ||
2155 !NILP (XCDR (XCDR (XCDR (data)))))
2156 signal_simple_error ("Must be list of 3 elements", data);
2158 width = XCAR (data);
2159 height = XCAR (XCDR (data));
2160 bits = XCAR (XCDR (XCDR (data)));
2162 CHECK_STRING (bits);
2164 if (!NATNUMP (width))
2165 signal_simple_error ("Width must be a natural number", width);
2167 if (!NATNUMP (height))
2168 signal_simple_error ("Height must be a natural number", height);
2170 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
2171 signal_simple_error ("data is too short for width and height",
2172 vector3 (width, height, bits));
2175 /* Validate method for XBM's. */
2178 xbm_validate (Lisp_Object instantiator)
2180 file_or_data_must_be_present (instantiator);
2183 /* Given a filename that is supposed to contain XBM data, return
2184 the inline representation of it as (width height bits). Return
2185 the hotspot through XHOT and YHOT, if those pointers are not 0.
2186 If there is no hotspot, XHOT and YHOT will contain -1.
2188 If the function fails:
2190 -- if OK_IF_DATA_INVALID is set and the data was invalid,
2192 -- maybe return an error, or return Qnil.
2195 #ifdef HAVE_X_WINDOWS
2196 #include <X11/Xlib.h>
2198 #define XFree(data) free(data)
2202 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
2203 int ok_if_data_invalid)
2208 const char *filename_ext;
2210 TO_EXTERNAL_FORMAT (LISP_STRING, name,
2211 C_STRING_ALLOCA, filename_ext,
2213 result = read_bitmap_data_from_file (filename_ext, &w, &h,
2216 if (result == BitmapSuccess)
2219 int len = (w + 7) / 8 * h;
2221 retval = list3 (make_int (w), make_int (h),
2222 make_ext_string (data, len, Qbinary));
2223 XFree ((char *) data);
2229 case BitmapOpenFailed:
2231 /* should never happen */
2232 signal_double_file_error ("Opening bitmap file",
2233 "no such file or directory",
2236 case BitmapFileInvalid:
2238 if (ok_if_data_invalid)
2240 signal_double_file_error ("Reading bitmap file",
2241 "invalid data in file",
2244 case BitmapNoMemory:
2246 signal_double_file_error ("Reading bitmap file",
2252 signal_double_file_error_2 ("Reading bitmap file",
2253 "unknown error code",
2254 make_int (result), name);
2258 return Qnil; /* not reached */
2262 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2263 Lisp_Object mask_file, Lisp_Object console_type)
2265 /* This is unclean but it's fairly standard -- a number of the
2266 bitmaps in /usr/include/X11/bitmaps use it -- so we support
2268 if (NILP (mask_file)
2269 /* don't override explicitly specified mask data. */
2270 && NILP (assq_no_quit (Q_mask_data, alist))
2273 mask_file = MAYBE_LISP_CONTYPE_METH
2274 (decode_console_type(console_type, ERROR_ME),
2275 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
2276 if (NILP (mask_file))
2277 mask_file = MAYBE_LISP_CONTYPE_METH
2278 (decode_console_type(console_type, ERROR_ME),
2279 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
2282 if (!NILP (mask_file))
2284 Lisp_Object mask_data =
2285 bitmap_to_lisp_data (mask_file, 0, 0, 0);
2286 alist = remassq_no_quit (Q_mask_file, alist);
2287 /* there can't be a :mask-data at this point. */
2288 alist = Fcons (Fcons (Q_mask_file, mask_file),
2289 Fcons (Fcons (Q_mask_data, mask_data), alist));
2295 /* Normalize method for XBM's. */
2298 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
2300 Lisp_Object file = Qnil, mask_file = Qnil;
2301 struct gcpro gcpro1, gcpro2, gcpro3;
2302 Lisp_Object alist = Qnil;
2304 GCPRO3 (file, mask_file, alist);
2306 /* Now, convert any file data into inline data for both the regular
2307 data and the mask data. At the end of this, `data' will contain
2308 the inline data (if any) or Qnil, and `file' will contain
2309 the name this data was derived from (if known) or Qnil.
2310 Likewise for `mask_file' and `mask_data'.
2312 Note that if we cannot generate any regular inline data, we
2315 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2317 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2318 Q_mask_data, console_type);
2320 if (CONSP (file)) /* failure locating filename */
2321 signal_double_file_error ("Opening bitmap file",
2322 "no such file or directory",
2325 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2326 RETURN_UNGCPRO (inst);
2328 alist = tagged_vector_to_alist (inst);
2333 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
2334 alist = remassq_no_quit (Q_file, alist);
2335 /* there can't be a :data at this point. */
2336 alist = Fcons (Fcons (Q_file, file),
2337 Fcons (Fcons (Q_data, data), alist));
2339 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2340 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2342 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2343 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2347 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2350 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2352 RETURN_UNGCPRO (result);
2358 xbm_possible_dest_types (void)
2361 IMAGE_MONO_PIXMAP_MASK |
2362 IMAGE_COLOR_PIXMAP_MASK |
2370 /**********************************************************************
2372 **********************************************************************/
2375 xface_validate (Lisp_Object instantiator)
2377 file_or_data_must_be_present (instantiator);
2381 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2383 /* This function can call lisp */
2384 Lisp_Object file = Qnil, mask_file = Qnil;
2385 struct gcpro gcpro1, gcpro2, gcpro3;
2386 Lisp_Object alist = Qnil;
2388 GCPRO3 (file, mask_file, alist);
2390 /* Now, convert any file data into inline data for both the regular
2391 data and the mask data. At the end of this, `data' will contain
2392 the inline data (if any) or Qnil, and `file' will contain
2393 the name this data was derived from (if known) or Qnil.
2394 Likewise for `mask_file' and `mask_data'.
2396 Note that if we cannot generate any regular inline data, we
2399 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2401 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2402 Q_mask_data, console_type);
2404 if (CONSP (file)) /* failure locating filename */
2405 signal_double_file_error ("Opening bitmap file",
2406 "no such file or directory",
2409 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2410 RETURN_UNGCPRO (inst);
2412 alist = tagged_vector_to_alist (inst);
2415 Lisp_Object data = make_string_from_file (file);
2416 alist = remassq_no_quit (Q_file, alist);
2417 /* there can't be a :data at this point. */
2418 alist = Fcons (Fcons (Q_file, file),
2419 Fcons (Fcons (Q_data, data), alist));
2422 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2425 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2427 RETURN_UNGCPRO (result);
2432 xface_possible_dest_types (void)
2435 IMAGE_MONO_PIXMAP_MASK |
2436 IMAGE_COLOR_PIXMAP_MASK |
2440 #endif /* HAVE_XFACE */
2445 /**********************************************************************
2447 **********************************************************************/
2450 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2456 TO_EXTERNAL_FORMAT (LISP_STRING, name,
2457 C_STRING_ALLOCA, fname,
2459 result = XpmReadFileToData (fname, &data);
2461 if (result == XpmSuccess)
2463 Lisp_Object retval = Qnil;
2464 struct buffer *old_buffer = current_buffer;
2465 Lisp_Object temp_buffer =
2466 Fget_buffer_create (build_string (" *pixmap conversion*"));
2468 int height, width, ncolors;
2469 struct gcpro gcpro1, gcpro2, gcpro3;
2470 int speccount = specpdl_depth ();
2472 GCPRO3 (name, retval, temp_buffer);
2474 specbind (Qinhibit_quit, Qt);
2475 set_buffer_internal (XBUFFER (temp_buffer));
2476 Ferase_buffer (Qnil);
2478 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2479 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2481 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2482 for (elt = 0; elt <= width + ncolors; elt++)
2484 buffer_insert_c_string (current_buffer, "\"");
2485 buffer_insert_c_string (current_buffer, data[elt]);
2487 if (elt < width + ncolors)
2488 buffer_insert_c_string (current_buffer, "\",\r");
2490 buffer_insert_c_string (current_buffer, "\"};\r");
2493 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2496 set_buffer_internal (old_buffer);
2497 unbind_to (speccount, Qnil);
2499 RETURN_UNGCPRO (retval);
2504 case XpmFileInvalid:
2506 if (ok_if_data_invalid)
2508 signal_image_error ("invalid XPM data in file", name);
2512 signal_double_file_error ("Reading pixmap file",
2513 "out of memory", name);
2517 /* should never happen? */
2518 signal_double_file_error ("Opening pixmap file",
2519 "no such file or directory", name);
2523 signal_double_file_error_2 ("Parsing pixmap file",
2524 "unknown error code",
2525 make_int (result), name);
2530 return Qnil; /* not reached */
2534 check_valid_xpm_color_symbols (Lisp_Object data)
2538 for (rest = data; !NILP (rest); rest = XCDR (rest))
2540 if (!CONSP (rest) ||
2541 !CONSP (XCAR (rest)) ||
2542 !STRINGP (XCAR (XCAR (rest))) ||
2543 (!STRINGP (XCDR (XCAR (rest))) &&
2544 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2545 signal_simple_error ("Invalid color symbol alist", data);
2550 xpm_validate (Lisp_Object instantiator)
2552 file_or_data_must_be_present (instantiator);
2555 Lisp_Object Vxpm_color_symbols;
2558 evaluate_xpm_color_symbols (void)
2560 Lisp_Object rest, results = Qnil;
2561 struct gcpro gcpro1, gcpro2;
2563 GCPRO2 (rest, results);
2564 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2566 Lisp_Object name, value, cons;
2572 CHECK_STRING (name);
2573 value = XCDR (cons);
2575 value = XCAR (value);
2576 value = Feval (value);
2579 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2581 ("Result from xpm-color-symbols eval must be nil, string, or color",
2583 results = Fcons (Fcons (name, value), results);
2585 UNGCPRO; /* no more evaluation */
2590 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2592 Lisp_Object file = Qnil;
2593 Lisp_Object color_symbols;
2594 struct gcpro gcpro1, gcpro2;
2595 Lisp_Object alist = Qnil;
2597 GCPRO2 (file, alist);
2599 /* Now, convert any file data into inline data. At the end of this,
2600 `data' will contain the inline data (if any) or Qnil, and
2601 `file' will contain the name this data was derived from (if
2604 Note that if we cannot generate any regular inline data, we
2607 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2610 if (CONSP (file)) /* failure locating filename */
2611 signal_double_file_error ("Opening pixmap file",
2612 "no such file or directory",
2615 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2618 if (NILP (file) && !UNBOUNDP (color_symbols))
2619 /* no conversion necessary */
2620 RETURN_UNGCPRO (inst);
2622 alist = tagged_vector_to_alist (inst);
2626 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2627 alist = remassq_no_quit (Q_file, alist);
2628 /* there can't be a :data at this point. */
2629 alist = Fcons (Fcons (Q_file, file),
2630 Fcons (Fcons (Q_data, data), alist));
2633 if (UNBOUNDP (color_symbols))
2635 color_symbols = evaluate_xpm_color_symbols ();
2636 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2641 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2643 RETURN_UNGCPRO (result);
2648 xpm_possible_dest_types (void)
2651 IMAGE_MONO_PIXMAP_MASK |
2652 IMAGE_COLOR_PIXMAP_MASK |
2656 #endif /* HAVE_XPM */
2659 /****************************************************************************
2660 * Image Specifier Object *
2661 ****************************************************************************/
2663 DEFINE_SPECIFIER_TYPE (image);
2666 image_create (Lisp_Object obj)
2668 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2670 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2671 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2672 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2676 image_mark (Lisp_Object obj)
2678 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2680 mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
2681 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2685 image_instantiate_cache_result (Lisp_Object locative)
2687 /* locative = (instance instantiator . subtable)
2689 So we are using the instantiator as the key and the instance as
2690 the value. Since the hashtable is key-weak this means that the
2691 image instance will stay around as long as the instantiator stays
2692 around. The instantiator is stored in the `image' slot of the
2693 glyph, so as long as the glyph is marked the instantiator will be
2694 as well and hence the cached image instance also.*/
2695 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2696 free_cons (XCONS (XCDR (locative)));
2697 free_cons (XCONS (locative));
2701 /* Given a specification for an image, return an instance of
2702 the image which matches the given instantiator and which can be
2703 displayed in the given domain. */
2706 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2707 Lisp_Object domain, Lisp_Object instantiator,
2710 Lisp_Object device = DFW_DEVICE (domain);
2711 struct device *d = XDEVICE (device);
2712 Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2713 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2714 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2716 if (IMAGE_INSTANCEP (instantiator))
2718 /* make sure that the image instance's device and type are
2721 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2724 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2725 if (mask & dest_mask)
2726 return instantiator;
2728 signal_simple_error ("Type of image instance not allowed here",
2732 signal_simple_error_2 ("Wrong device for image instance",
2733 instantiator, device);
2735 else if (VECTORP (instantiator)
2736 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2738 assert (XVECTOR_LENGTH (instantiator) == 3);
2739 return (FACE_PROPERTY_INSTANCE
2740 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2741 Qbackground_pixmap, domain, 0, depth));
2745 Lisp_Object instance;
2746 Lisp_Object subtable;
2747 Lisp_Object ls3 = Qnil;
2748 Lisp_Object pointer_fg = Qnil;
2749 Lisp_Object pointer_bg = Qnil;
2753 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2754 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2755 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2758 /* First look in the hash table. */
2759 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2761 if (UNBOUNDP (subtable))
2763 /* For the image instance cache, we do comparisons with EQ rather
2764 than with EQUAL, as we do for color and font names.
2767 1) pixmap data can be very long, and thus the hashing and
2768 comparing will take awhile.
2769 2) It's not so likely that we'll run into things that are EQUAL
2770 but not EQ (that can happen a lot with faces, because their
2771 specifiers are copied around); but pixmaps tend not to be
2774 However, if the image-instance could be a pointer, we have to
2775 use EQUAL because we massaged the instantiator into a cons3
2776 also containing the foreground and background of the
2780 subtable = make_lisp_hash_table (20,
2781 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2782 : HASH_TABLE_KEY_WEAK,
2783 pointerp ? HASH_TABLE_EQUAL
2785 Fputhash (make_int (dest_mask), subtable,
2786 d->image_instance_cache);
2787 instance = Qunbound;
2791 instance = Fgethash (pointerp ? ls3 : instantiator,
2792 subtable, Qunbound);
2793 /* subwindows have a per-window cache and have to be treated
2794 differently. dest_mask can be a bitwise OR of all image
2795 types so we will only catch someone possibly trying to
2796 instantiate a subwindow type thing. Unfortunately, this
2797 will occur most of the time so this probably slows things
2798 down. But with the current design I don't see anyway
2800 if (UNBOUNDP (instance)
2802 dest_mask & (IMAGE_SUBWINDOW_MASK
2806 if (!WINDOWP (domain))
2807 signal_simple_error ("Can't instantiate text or subwindow outside a window",
2809 instance = Fgethash (instantiator,
2810 XWINDOW (domain)->subwindow_instance_cache,
2815 if (UNBOUNDP (instance))
2817 Lisp_Object locative =
2819 noseeum_cons (pointerp ? ls3 : instantiator,
2821 int speccount = specpdl_depth ();
2823 /* make sure we cache the failures, too.
2824 Use an unwind-protect to catch such errors.
2825 If we fail, the unwind-protect records nil in
2826 the hash table. If we succeed, we change the
2827 car of the locative to the resulting instance,
2828 which gets recorded instead. */
2829 record_unwind_protect (image_instantiate_cache_result,
2831 instance = instantiate_image_instantiator (device,
2834 pointer_fg, pointer_bg,
2838 Fsetcar (locative, instance);
2839 /* only after the image has been instantiated do we know
2840 whether we need to put it in the per-window image instance
2842 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2844 (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2846 if (!WINDOWP (domain))
2847 signal_simple_error ("Can't instantiate subwindow outside a window",
2850 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache );
2852 unbind_to (speccount, Qnil);
2857 if (NILP (instance))
2858 signal_simple_error ("Can't instantiate image (probably cached)",
2864 return Qnil; /* not reached */
2867 /* Validate an image instantiator. */
2870 image_validate (Lisp_Object instantiator)
2872 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2874 else if (VECTORP (instantiator))
2876 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2877 int instantiator_len = XVECTOR_LENGTH (instantiator);
2878 struct image_instantiator_methods *meths;
2879 Lisp_Object already_seen = Qnil;
2880 struct gcpro gcpro1;
2883 if (instantiator_len < 1)
2884 signal_simple_error ("Vector length must be at least 1",
2887 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2888 if (!(instantiator_len & 1))
2890 ("Must have alternating keyword/value pairs", instantiator);
2892 GCPRO1 (already_seen);
2894 for (i = 1; i < instantiator_len; i += 2)
2896 Lisp_Object keyword = elt[i];
2897 Lisp_Object value = elt[i+1];
2900 CHECK_SYMBOL (keyword);
2901 if (!SYMBOL_IS_KEYWORD (keyword))
2902 signal_simple_error ("Symbol must begin with a colon", keyword);
2904 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2905 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2908 if (j == Dynarr_length (meths->keywords))
2909 signal_simple_error ("Unrecognized keyword", keyword);
2911 if (!Dynarr_at (meths->keywords, j).multiple_p)
2913 if (!NILP (memq_no_quit (keyword, already_seen)))
2915 ("Keyword may not appear more than once", keyword);
2916 already_seen = Fcons (keyword, already_seen);
2919 (Dynarr_at (meths->keywords, j).validate) (value);
2924 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2927 signal_simple_error ("Must be string or vector", instantiator);
2931 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2933 Lisp_Object attachee =
2934 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2935 Lisp_Object property =
2936 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2937 if (FACEP (attachee))
2938 face_property_was_changed (attachee, property, locale);
2939 else if (GLYPHP (attachee))
2940 glyph_property_was_changed (attachee, property, locale);
2944 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2945 Lisp_Object property)
2947 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2949 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2950 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2954 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2955 Lisp_Object tag_set, Lisp_Object instantiator)
2957 Lisp_Object possible_console_types = Qnil;
2959 Lisp_Object retlist = Qnil;
2960 struct gcpro gcpro1, gcpro2;
2962 LIST_LOOP (rest, Vconsole_type_list)
2964 Lisp_Object contype = XCAR (rest);
2965 if (!NILP (memq_no_quit (contype, tag_set)))
2966 possible_console_types = Fcons (contype, possible_console_types);
2969 if (XINT (Flength (possible_console_types)) > 1)
2970 /* two conflicting console types specified */
2973 if (NILP (possible_console_types))
2974 possible_console_types = Vconsole_type_list;
2976 GCPRO2 (retlist, possible_console_types);
2978 LIST_LOOP (rest, possible_console_types)
2980 Lisp_Object contype = XCAR (rest);
2981 Lisp_Object newinst = call_with_suspended_errors
2982 ((lisp_fn_t) normalize_image_instantiator,
2983 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2984 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2986 if (!NILP (newinst))
2989 if (NILP (memq_no_quit (contype, tag_set)))
2990 newtag = Fcons (contype, tag_set);
2993 retlist = Fcons (Fcons (newtag, newinst), retlist);
3002 /* Copy an image instantiator. We can't use Fcopy_tree since widgets
3003 may contain circular references which would send Fcopy_tree into
3006 image_copy_vector_instantiator (Lisp_Object instantiator)
3009 struct image_instantiator_methods *meths;
3011 int instantiator_len;
3013 CHECK_VECTOR (instantiator);
3015 instantiator = Fcopy_sequence (instantiator);
3016 elt = XVECTOR_DATA (instantiator);
3017 instantiator_len = XVECTOR_LENGTH (instantiator);
3019 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
3021 for (i = 1; i < instantiator_len; i += 2)
3024 Lisp_Object keyword = elt[i];
3025 Lisp_Object value = elt[i+1];
3027 /* Find the keyword entry. */
3028 for (j = 0; j < Dynarr_length (meths->keywords); j++)
3030 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
3034 /* Only copy keyword values that should be copied. */
3035 if (Dynarr_at (meths->keywords, j).copy_p
3037 (CONSP (value) || VECTORP (value)))
3039 elt [i+1] = Fcopy_tree (value, Qt);
3043 return instantiator;
3047 image_copy_instantiator (Lisp_Object arg)
3052 rest = arg = Fcopy_sequence (arg);
3053 while (CONSP (rest))
3055 Lisp_Object elt = XCAR (rest);
3057 XCAR (rest) = Fcopy_tree (elt, Qt);
3058 else if (VECTORP (elt))
3059 XCAR (rest) = image_copy_vector_instantiator (elt);
3060 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
3061 XCDR (rest) = Fcopy_tree (XCDR (rest), Qt);
3065 else if (VECTORP (arg))
3067 arg = image_copy_vector_instantiator (arg);
3072 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
3073 Return non-nil if OBJECT is an image specifier.
3075 An image specifier is used for images (pixmaps and the like). It is used
3076 to describe the actual image in a glyph. It is instanced as an image-
3079 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
3080 etc. This describes the format of the data describing the image. The
3081 resulting image instances also come in many types -- `mono-pixmap',
3082 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
3083 the image and the sorts of places it can appear. (For example, a
3084 color-pixmap image has fixed colors specified for it, while a
3085 mono-pixmap image comes in two unspecified shades "foreground" and
3086 "background" that are determined from the face of the glyph or
3087 surrounding text; a text image appears as a string of text and has an
3088 unspecified foreground, background, and font; a pointer image behaves
3089 like a mono-pixmap image but can only be used as a mouse pointer
3090 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
3091 important to keep the distinction between image instantiator format and
3092 image instance type in mind. Typically, a given image instantiator
3093 format can result in many different image instance types (for example,
3094 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
3095 whereas `cursor-font' can be instanced only as `pointer'), and a
3096 particular image instance type can be generated by many different
3097 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
3098 `gif', `jpeg', etc.).
3100 See `make-image-instance' for a more detailed discussion of image
3103 An image instantiator should be a string or a vector of the form
3105 [FORMAT :KEYWORD VALUE ...]
3107 i.e. a format symbol followed by zero or more alternating keyword-value
3108 pairs. FORMAT should be one of
3111 (Don't display anything; no keywords are valid for this.
3112 Can only be instanced as `nothing'.)
3114 (Display this image as a text string. Can only be instanced
3115 as `text', although support for instancing as `mono-pixmap'
3118 (Display this image as a text string, with replaceable fields;
3119 not currently implemented.)
3121 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
3122 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3124 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
3125 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
3127 (An X-Face bitmap, used to encode people's faces in e-mail messages;
3128 only if X-Face support was compiled into this XEmacs. Can be
3129 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3131 (A GIF87 or GIF89 image; only if GIF support was compiled into this
3132 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
3133 Can be instanced as `color-pixmap'.)
3135 (A JPEG image; only if JPEG support was compiled into this XEmacs.
3136 Can be instanced as `color-pixmap'.)
3138 (A PNG image; only if PNG support was compiled into this XEmacs.
3139 Can be instanced as `color-pixmap'.)
3141 (A TIFF image; only if TIFF support was compiled into this XEmacs.
3142 Can be instanced as `color-pixmap'.)
3144 (One of the standard cursor-font names, such as "watch" or
3145 "right_ptr" under X. Under X, this is, more specifically, any
3146 of the standard cursor names from appendix B of the Xlib manual
3147 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
3148 On other window systems, the valid names will be specific to the
3149 type of window system. Can only be instanced as `pointer'.)
3151 (A glyph from a font; i.e. the name of a font, and glyph index into it
3152 of the form "FONT fontname index [[mask-font] mask-index]".
3153 Currently can only be instanced as `pointer', although this should
3156 (An embedded windowing system window.)
3158 (A text editing widget glyph.)
3160 (A button widget glyph; either a push button, radio button or toggle button.)
3162 (A tab widget glyph; a series of user selectable tabs.)
3164 (A sliding widget glyph, for showing progress.)
3166 (A drop list of selectable items in a widget glyph, for editing text.)
3168 (A static, text-only, widget glyph; for displaying text.)
3170 (A folding widget glyph.)
3172 (XEmacs tries to guess what format the data is in. If X support
3173 exists, the data string will be checked to see if it names a filename.
3174 If so, and this filename contains XBM or XPM data, the appropriate
3175 sort of pixmap or pointer will be created. [This includes picking up
3176 any specified hotspot or associated mask file.] Otherwise, if `pointer'
3177 is one of the allowable image-instance types and the string names a
3178 valid cursor-font name, the image will be created as a pointer.
3179 Otherwise, the image will be displayed as text. If no X support
3180 exists, the image will always be displayed as text.)
3182 Inherit from the background-pixmap property of a face.
3184 The valid keywords are:
3187 (Inline data. For most formats above, this should be a string. For
3188 XBM images, this should be a list of three elements: width, height, and
3189 a string of bit data. This keyword is not valid for instantiator
3190 formats `nothing' and `inherit'.)
3192 (Data is contained in a file. The value is the name of this file.
3193 If both :data and :file are specified, the image is created from
3194 what is specified in :data and the string in :file becomes the
3195 value of the `image-instance-file-name' function when applied to
3196 the resulting image-instance. This keyword is not valid for
3197 instantiator formats `nothing', `string', `formatted-string',
3198 `cursor-font', `font', `autodetect', and `inherit'.)
3201 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
3202 allow you to explicitly specify foreground and background colors.
3203 The argument should be anything acceptable to `make-color-instance'.
3204 This will cause what would be a `mono-pixmap' to instead be colorized
3205 as a two-color color-pixmap, and specifies the foreground and/or
3206 background colors for a pointer instead of black and white.)
3208 (For `xbm' and `xface'. This specifies a mask to be used with the
3209 bitmap. The format is a list of width, height, and bits, like for
3212 (For `xbm' and `xface'. This specifies a file containing the mask data.
3213 If neither a mask file nor inline mask data is given for an XBM image,
3214 and the XBM image comes from a file, XEmacs will look for a mask file
3215 with the same name as the image file but with "Mask" or "msk"
3216 appended. For example, if you specify the XBM file "left_ptr"
3217 [usually located in "/usr/include/X11/bitmaps"], the associated
3218 mask file "left_ptrmsk" will automatically be picked up.)
3221 (For `xbm' and `xface'. These keywords specify a hotspot if the image
3222 is instantiated as a `pointer'. Note that if the XBM image file
3223 specifies a hotspot, it will automatically be picked up if no
3224 explicit hotspot is given.)
3226 (Only for `xpm'. This specifies an alist that maps strings
3227 that specify symbolic color names to the actual color to be used
3228 for that symbolic color (in the form of a string or a color-specifier
3229 object). If this is not specified, the contents of `xpm-color-symbols'
3230 are used to generate the alist.)
3232 (Only for `inherit'. This specifies the face to inherit from.
3233 For widget glyphs this also specifies the face to use for
3234 display. It defaults to gui-element-face.)
3236 Keywords accepted as menu item specs are also accepted by widget
3237 glyphs. These are `:selected', `:active', `:suffix', `:keys',
3238 `:style', `:filter', `:config', `:included', `:key-sequence',
3239 `:accelerator', `:label' and `:callback'.
3241 If instead of a vector, the instantiator is a string, it will be
3242 converted into a vector by looking it up according to the specs in the
3243 `console-type-image-conversion-list' (q.v.) for the console type of
3244 the domain (usually a window; sometimes a frame or device) over which
3245 the image is being instantiated.
3247 If the instantiator specifies data from a file, the data will be read
3248 in at the time that the instantiator is added to the image (which may
3249 be well before when the image is actually displayed), and the
3250 instantiator will be converted into one of the inline-data forms, with
3251 the filename retained using a :file keyword. This implies that the
3252 file must exist when the instantiator is added to the image, but does
3253 not need to exist at any other time (e.g. it may safely be a temporary
3258 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
3262 /****************************************************************************
3264 ****************************************************************************/
3267 mark_glyph (Lisp_Object obj)
3269 Lisp_Glyph *glyph = XGLYPH (obj);
3271 mark_object (glyph->image);
3272 mark_object (glyph->contrib_p);
3273 mark_object (glyph->baseline);
3274 mark_object (glyph->face);
3276 return glyph->plist;
3280 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3282 Lisp_Glyph *glyph = XGLYPH (obj);
3286 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
3288 write_c_string ("#<glyph (", printcharfun);
3289 print_internal (Fglyph_type (obj), printcharfun, 0);
3290 write_c_string (") ", printcharfun);
3291 print_internal (glyph->image, printcharfun, 1);
3292 sprintf (buf, "0x%x>", glyph->header.uid);
3293 write_c_string (buf, printcharfun);
3296 /* Glyphs are equal if all of their display attributes are equal. We
3297 don't compare names or doc-strings, because that would make equal
3300 This isn't concerned with "unspecified" attributes, that's what
3301 #'glyph-differs-from-default-p is for. */
3303 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3305 Lisp_Glyph *g1 = XGLYPH (obj1);
3306 Lisp_Glyph *g2 = XGLYPH (obj2);
3310 return (internal_equal (g1->image, g2->image, depth) &&
3311 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
3312 internal_equal (g1->baseline, g2->baseline, depth) &&
3313 internal_equal (g1->face, g2->face, depth) &&
3314 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
3317 static unsigned long
3318 glyph_hash (Lisp_Object obj, int depth)
3322 /* No need to hash all of the elements; that would take too long.
3323 Just hash the most common ones. */
3324 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
3325 internal_hash (XGLYPH (obj)->face, depth));
3329 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
3331 Lisp_Glyph *g = XGLYPH (obj);
3333 if (EQ (prop, Qimage)) return g->image;
3334 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
3335 if (EQ (prop, Qbaseline)) return g->baseline;
3336 if (EQ (prop, Qface)) return g->face;
3338 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
3342 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3344 if (EQ (prop, Qimage) ||
3345 EQ (prop, Qcontrib_p) ||
3346 EQ (prop, Qbaseline))
3349 if (EQ (prop, Qface))
3351 XGLYPH (obj)->face = Fget_face (value);
3355 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
3360 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
3362 if (EQ (prop, Qimage) ||
3363 EQ (prop, Qcontrib_p) ||
3364 EQ (prop, Qbaseline))
3367 if (EQ (prop, Qface))
3369 XGLYPH (obj)->face = Qnil;
3373 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
3377 glyph_plist (Lisp_Object obj)
3379 Lisp_Glyph *glyph = XGLYPH (obj);
3380 Lisp_Object result = glyph->plist;
3382 result = cons3 (Qface, glyph->face, result);
3383 result = cons3 (Qbaseline, glyph->baseline, result);
3384 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
3385 result = cons3 (Qimage, glyph->image, result);
3390 static const struct lrecord_description glyph_description[] = {
3391 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) },
3392 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) },
3393 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) },
3394 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) },
3395 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) },
3399 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
3400 mark_glyph, print_glyph, 0,
3401 glyph_equal, glyph_hash, glyph_description,
3402 glyph_getprop, glyph_putprop,
3403 glyph_remprop, glyph_plist,
3407 allocate_glyph (enum glyph_type type,
3408 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
3409 Lisp_Object locale))
3411 /* This function can GC */
3412 Lisp_Object obj = Qnil;
3413 Lisp_Glyph *g = alloc_lcrecord_type (Lisp_Glyph, &lrecord_glyph);
3416 g->image = Fmake_specifier (Qimage); /* This function can GC */
3421 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3422 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
3423 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
3424 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK
3425 | IMAGE_LAYOUT_MASK;
3428 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3429 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
3432 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3433 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK
3434 | IMAGE_COLOR_PIXMAP_MASK;
3440 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
3441 /* We're getting enough reports of odd behavior in this area it seems */
3442 /* best to GCPRO everything. */
3444 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3445 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3446 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3447 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3449 GCPRO4 (obj, tem1, tem2, tem3);
3451 set_specifier_fallback (g->image, tem1);
3452 g->contrib_p = Fmake_specifier (Qboolean);
3453 set_specifier_fallback (g->contrib_p, tem2);
3454 /* #### should have a specifier for the following */
3455 g->baseline = Fmake_specifier (Qgeneric);
3456 set_specifier_fallback (g->baseline, tem3);
3459 g->after_change = after_change;
3462 set_image_attached_to (g->image, obj, Qimage);
3469 static enum glyph_type
3470 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3473 return GLYPH_BUFFER;
3475 if (ERRB_EQ (errb, ERROR_ME))
3476 CHECK_SYMBOL (type);
3478 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3479 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3480 if (EQ (type, Qicon)) return GLYPH_ICON;
3482 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3484 return GLYPH_UNKNOWN;
3488 valid_glyph_type_p (Lisp_Object type)
3490 return !NILP (memq_no_quit (type, Vglyph_type_list));
3493 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3494 Given a GLYPH-TYPE, return non-nil if it is valid.
3495 Valid types are `buffer', `pointer', and `icon'.
3499 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3502 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3503 Return a list of valid glyph types.
3507 return Fcopy_sequence (Vglyph_type_list);
3510 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3511 Create and return a new uninitialized glyph or type TYPE.
3513 TYPE specifies the type of the glyph; this should be one of `buffer',
3514 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3515 specifies in which contexts the glyph can be used, and controls the
3516 allowable image types into which the glyph's image can be
3519 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3520 extent, in the modeline, and in the toolbar. Their image can be
3521 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3524 `pointer' glyphs can be used to specify the mouse pointer. Their
3525 image can be instantiated as `pointer'.
3527 `icon' glyphs can be used to specify the icon used when a frame is
3528 iconified. Their image can be instantiated as `mono-pixmap' and
3533 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3534 return allocate_glyph (typeval, 0);
3537 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3538 Return non-nil if OBJECT is a glyph.
3540 A glyph is an object used for pixmaps and the like. It is used
3541 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3542 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3543 buttons, and the like. Its image is described using an image specifier --
3544 see `image-specifier-p'.
3548 return GLYPHP (object) ? Qt : Qnil;
3551 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3552 Return the type of the given glyph.
3553 The return value will be one of 'buffer, 'pointer, or 'icon.
3557 CHECK_GLYPH (glyph);
3558 switch (XGLYPH_TYPE (glyph))
3561 case GLYPH_BUFFER: return Qbuffer;
3562 case GLYPH_POINTER: return Qpointer;
3563 case GLYPH_ICON: return Qicon;
3568 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3569 Error_behavior errb, int no_quit)
3571 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3573 /* This can never return Qunbound. All glyphs have 'nothing as
3575 Lisp_Object image_instance = specifier_instance (specifier, Qunbound,
3576 domain, errb, no_quit, 0,
3578 assert (!UNBOUNDP (image_instance));
3580 return image_instance;
3584 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window)
3586 Lisp_Object instance = glyph_or_image;
3588 if (GLYPHP (glyph_or_image))
3589 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3594 /*****************************************************************************
3597 Return the width of the given GLYPH on the given WINDOW.
3598 Calculations are done based on recursively querying the geometry of
3599 the associated image instances.
3600 ****************************************************************************/
3602 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain)
3604 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3606 if (!IMAGE_INSTANCEP (instance))
3609 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3610 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3611 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3613 return XIMAGE_INSTANCE_WIDTH (instance);
3616 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3617 Return the width of GLYPH on WINDOW.
3618 This may not be exact as it does not take into account all of the context
3619 that redisplay will.
3623 XSETWINDOW (window, decode_window (window));
3624 CHECK_GLYPH (glyph);
3626 return make_int (glyph_width (glyph, window));
3630 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain)
3632 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3634 if (!IMAGE_INSTANCEP (instance))
3637 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3638 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3639 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3641 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3642 return XIMAGE_INSTANCE_TEXT_ASCENT (instance);
3644 return XIMAGE_INSTANCE_HEIGHT (instance);
3648 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain)
3650 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3652 if (!IMAGE_INSTANCEP (instance))
3655 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3656 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3657 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3659 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3660 return XIMAGE_INSTANCE_TEXT_DESCENT (instance);
3665 /* strictly a convenience function. */
3667 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain)
3669 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3672 if (!IMAGE_INSTANCEP (instance))
3675 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3676 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3677 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3679 return XIMAGE_INSTANCE_HEIGHT (instance);
3682 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3683 Return the ascent value of GLYPH on WINDOW.
3684 This may not be exact as it does not take into account all of the context
3685 that redisplay will.
3689 XSETWINDOW (window, decode_window (window));
3690 CHECK_GLYPH (glyph);
3692 return make_int (glyph_ascent (glyph, window));
3695 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3696 Return the descent value of GLYPH on WINDOW.
3697 This may not be exact as it does not take into account all of the context
3698 that redisplay will.
3702 XSETWINDOW (window, decode_window (window));
3703 CHECK_GLYPH (glyph);
3705 return make_int (glyph_descent (glyph, window));
3708 /* This is redundant but I bet a lot of people expect it to exist. */
3709 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3710 Return the height of GLYPH on WINDOW.
3711 This may not be exact as it does not take into account all of the context
3712 that redisplay will.
3716 XSETWINDOW (window, decode_window (window));
3717 CHECK_GLYPH (glyph);
3719 return make_int (glyph_height (glyph, window));
3723 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty)
3725 Lisp_Object instance = glyph_or_image;
3727 if (!NILP (glyph_or_image))
3729 if (GLYPHP (glyph_or_image))
3731 instance = glyph_image_instance (glyph_or_image, window,
3733 XGLYPH_DIRTYP (glyph_or_image) = dirty;
3736 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
3741 set_image_instance_dirty_p (Lisp_Object instance, int dirty)
3743 if (IMAGE_INSTANCEP (instance))
3745 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
3746 /* Now cascade up the hierarchy. */
3747 set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance),
3750 else if (GLYPHP (instance))
3752 XGLYPH_DIRTYP (instance) = dirty;
3756 /* #### do we need to cache this info to speed things up? */
3759 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3761 if (!GLYPHP (glyph))
3765 Lisp_Object retval =
3766 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3767 /* #### look into ERROR_ME_NOT */
3768 Qunbound, domain, ERROR_ME_NOT,
3770 if (!NILP (retval) && !INTP (retval))
3772 else if (INTP (retval))
3774 if (XINT (retval) < 0)
3776 if (XINT (retval) > 100)
3777 retval = make_int (100);
3784 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3786 /* #### Domain parameter not currently used but it will be */
3787 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3791 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3793 if (!GLYPHP (glyph))
3796 return !NILP (specifier_instance_no_quit
3797 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3798 /* #### look into ERROR_ME_NOT */
3799 ERROR_ME_NOT, 0, Qzero));
3803 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3806 if (XGLYPH (glyph)->after_change)
3807 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3810 #if 0 /* Not used for now */
3812 glyph_query_geometry (Lisp_Object glyph_or_image, Lisp_Object window,
3813 unsigned int* width, unsigned int* height,
3814 enum image_instance_geometry disp, Lisp_Object domain)
3816 Lisp_Object instance = glyph_or_image;
3818 if (GLYPHP (glyph_or_image))
3819 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3821 image_instance_query_geometry (instance, width, height, disp, domain);
3825 glyph_layout (Lisp_Object glyph_or_image, Lisp_Object window,
3826 unsigned int width, unsigned int height, Lisp_Object domain)
3828 Lisp_Object instance = glyph_or_image;
3830 if (GLYPHP (glyph_or_image))
3831 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3833 image_instance_layout (instance, width, height, domain);
3838 /*****************************************************************************
3839 * glyph cachel functions *
3840 *****************************************************************************/
3842 /* #### All of this is 95% copied from face cachels. Consider
3845 Why do we need glyph_cachels? Simply because a glyph_cachel captures
3846 per-window information about a particular glyph. A glyph itself is
3847 not created in any particular context, so if we were to rely on a
3848 glyph to tell us about its dirtiness we would not be able to reset
3849 the dirty flag after redisplaying it as it may exist in other
3850 contexts. When we have redisplayed we need to know which glyphs to
3851 reset the dirty flags on - the glyph_cachels give us a nice list we
3852 can iterate through doing this. */
3854 mark_glyph_cachels (glyph_cachel_dynarr *elements)
3861 for (elt = 0; elt < Dynarr_length (elements); elt++)
3863 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3864 mark_object (cachel->glyph);
3869 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3870 struct glyph_cachel *cachel)
3872 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)
3873 || XGLYPH_DIRTYP (cachel->glyph)
3874 || XFRAME(WINDOW_FRAME(w))->faces_changed)
3876 Lisp_Object window, instance;
3878 XSETWINDOW (window, w);
3880 cachel->glyph = glyph;
3881 /* Speed things up slightly by grabbing the glyph instantiation
3882 and passing it to the size functions. */
3883 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3885 /* Mark text instance of the glyph dirty if faces have changed,
3886 because its geometry might have changed. */
3887 invalidate_glyph_geometry_maybe (instance, w);
3889 /* #### Do the following 2 lines buy us anything? --kkm */
3890 XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance);
3891 cachel->dirty = XGLYPH_DIRTYP (glyph);
3892 cachel->width = glyph_width (instance, window);
3893 cachel->ascent = glyph_ascent (instance, window);
3894 cachel->descent = glyph_descent (instance, window);
3897 cachel->updated = 1;
3901 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3903 struct glyph_cachel new_cachel;
3906 new_cachel.glyph = Qnil;
3908 update_glyph_cachel_data (w, glyph, &new_cachel);
3909 Dynarr_add (w->glyph_cachels, new_cachel);
3913 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3920 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3922 struct glyph_cachel *cachel =
3923 Dynarr_atp (w->glyph_cachels, elt);
3925 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3927 update_glyph_cachel_data (w, glyph, cachel);
3932 /* If we didn't find the glyph, add it and then return its index. */
3933 add_glyph_cachel (w, glyph);
3938 reset_glyph_cachels (struct window *w)
3940 Dynarr_reset (w->glyph_cachels);
3941 get_glyph_cachel_index (w, Vcontinuation_glyph);
3942 get_glyph_cachel_index (w, Vtruncation_glyph);
3943 get_glyph_cachel_index (w, Vhscroll_glyph);
3944 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3945 get_glyph_cachel_index (w, Voctal_escape_glyph);
3946 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3950 mark_glyph_cachels_as_not_updated (struct window *w)
3954 /* We need to have a dirty flag to tell if the glyph has changed.
3955 We can check to see if each glyph variable is actually a
3956 completely different glyph, though. */
3957 #define FROB(glyph_obj, gindex) \
3958 update_glyph_cachel_data (w, glyph_obj, \
3959 Dynarr_atp (w->glyph_cachels, gindex))
3961 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3962 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3963 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3964 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3965 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3966 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3969 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3971 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3975 /* Unset the dirty bit on all the glyph cachels that have it. */
3977 mark_glyph_cachels_as_clean (struct window* w)
3981 XSETWINDOW (window, w);
3982 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3984 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt);
3986 set_glyph_dirty_p (cachel->glyph, window, 0);
3990 #ifdef MEMORY_USAGE_STATS
3993 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3994 struct overhead_stats *ovstats)
3999 total += Dynarr_memory_usage (glyph_cachels, ovstats);
4004 #endif /* MEMORY_USAGE_STATS */
4008 /*****************************************************************************
4009 * subwindow cachel functions *
4010 *****************************************************************************/
4011 /* Subwindows are curious in that you have to physically unmap them to
4012 not display them. It is problematic deciding what to do in
4013 redisplay. We have two caches - a per-window instance cache that
4014 keeps track of subwindows on a window, these are linked to their
4015 instantiator in the hashtable and when the instantiator goes away
4016 we want the instance to go away also. However we also have a
4017 per-frame instance cache that we use to determine if a subwindow is
4018 obscuring an area that we want to clear. We need to be able to flip
4019 through this quickly so a hashtable is not suitable hence the
4020 subwindow_cachels. The question is should we just not mark
4021 instances in the subwindow_cachels or should we try and invalidate
4022 the cache at suitable points in redisplay? If we don't invalidate
4023 the cache it will fill up with crud that will only get removed when
4024 the frame is deleted. So invalidation is good, the question is when
4025 and whether we mark as well. Go for the simple option - don't mark,
4026 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
4029 mark_subwindow_cachels (subwindow_cachel_dynarr *elements)
4036 for (elt = 0; elt < Dynarr_length (elements); elt++)
4038 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
4039 mark_object (cachel->subwindow);
4044 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
4045 struct subwindow_cachel *cachel)
4047 cachel->subwindow = subwindow;
4048 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
4049 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
4050 cachel->updated = 1;
4054 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
4056 struct subwindow_cachel new_cachel;
4059 new_cachel.subwindow = Qnil;
4062 new_cachel.being_displayed=0;
4064 update_subwindow_cachel_data (f, subwindow, &new_cachel);
4065 Dynarr_add (f->subwindow_cachels, new_cachel);
4069 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
4076 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4078 struct subwindow_cachel *cachel =
4079 Dynarr_atp (f->subwindow_cachels, elt);
4081 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
4083 if (!cachel->updated)
4084 update_subwindow_cachel_data (f, subwindow, cachel);
4089 /* If we didn't find the glyph, add it and then return its index. */
4090 add_subwindow_cachel (f, subwindow);
4095 update_subwindow_cachel (Lisp_Object subwindow)
4100 if (NILP (subwindow))
4103 f = XFRAME ( XIMAGE_INSTANCE_SUBWINDOW_FRAME (subwindow));
4105 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4107 struct subwindow_cachel *cachel =
4108 Dynarr_atp (f->subwindow_cachels, elt);
4110 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
4112 update_subwindow_cachel_data (f, subwindow, cachel);
4117 /* redisplay in general assumes that drawing something will erase
4118 what was there before. unfortunately this does not apply to
4119 subwindows that need to be specifically unmapped in order to
4120 disappear. we take a brute force approach - on the basis that its
4121 cheap - and unmap all subwindows in a display line */
4123 reset_subwindow_cachels (struct frame *f)
4126 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4128 struct subwindow_cachel *cachel =
4129 Dynarr_atp (f->subwindow_cachels, elt);
4131 if (!NILP (cachel->subwindow) && cachel->being_displayed)
4133 cachel->updated = 1;
4134 /* #### This is not optimal as update_subwindow will search
4135 the cachels for ourselves as well. We could easily optimize. */
4136 unmap_subwindow (cachel->subwindow);
4139 Dynarr_reset (f->subwindow_cachels);
4143 mark_subwindow_cachels_as_not_updated (struct frame *f)
4147 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4148 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
4153 /*****************************************************************************
4154 * subwindow exposure ignorance *
4155 *****************************************************************************/
4156 /* when we unmap subwindows the associated window system will generate
4157 expose events. This we do not want as redisplay already copes with
4158 the repainting necessary. Worse, we can get in an endless cycle of
4159 redisplay if we are not careful. Thus we keep a per-frame list of
4160 expose events that are going to come and ignore them as
4163 struct expose_ignore_blocktype
4165 Blocktype_declare (struct expose_ignore);
4166 } *the_expose_ignore_blocktype;
4169 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
4171 struct expose_ignore *ei, *prev;
4172 /* the ignore list is FIFO so we should generally get a match with
4173 the first element in the list */
4174 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next)
4176 /* Checking for exact matches just isn't good enough as we
4177 mighte get exposures for partially obscure subwindows, thus
4178 we have to check for overlaps. Being conservative we will
4179 check for exposures wholly contained by the subwindow, this
4180 might give us what we want.*/
4181 if (ei->x <= x && ei->y <= y
4182 && ei->x + ei->width >= x + width
4183 && ei->y + ei->height >= y + height)
4185 #ifdef DEBUG_WIDGETS
4186 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n",
4187 x, y, width, height, ei->x, ei->y, ei->width, ei->height);
4190 f->subwindow_exposures = ei->next;
4192 prev->next = ei->next;
4194 if (ei == f->subwindow_exposures_tail)
4195 f->subwindow_exposures_tail = prev;
4197 Blocktype_free (the_expose_ignore_blocktype, ei);
4206 register_ignored_expose (struct frame* f, int x, int y, int width, int height)
4208 if (!hold_ignored_expose_registration)
4210 struct expose_ignore *ei;
4212 ei = Blocktype_alloc (the_expose_ignore_blocktype);
4218 ei->height = height;
4220 /* we have to add the exposure to the end of the list, since we
4221 want to check the oldest events first. for speed we keep a record
4222 of the end so that we can add right to it. */
4223 if (f->subwindow_exposures_tail)
4225 f->subwindow_exposures_tail->next = ei;
4227 if (!f->subwindow_exposures)
4229 f->subwindow_exposures = ei;
4231 f->subwindow_exposures_tail = ei;
4235 /****************************************************************************
4236 find_matching_subwindow
4238 See if there is a subwindow that completely encloses the requested
4240 ****************************************************************************/
4241 int find_matching_subwindow (struct frame* f, int x, int y, int width, int height)
4245 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4247 struct subwindow_cachel *cachel =
4248 Dynarr_atp (f->subwindow_cachels, elt);
4250 if (cachel->being_displayed
4252 cachel->x <= x && cachel->y <= y
4254 cachel->x + cachel->width >= x + width
4256 cachel->y + cachel->height >= y + height)
4265 /*****************************************************************************
4266 * subwindow functions *
4267 *****************************************************************************/
4269 /* Update the displayed characteristics of a subwindow. This function
4270 should generally only get called if the subwindow is actually
4271 dirty. The only other time it gets called is if subwindow state
4272 changed, when we can't actually tell whether its going to be dirty
4274 #### I suspect what we should really do is re-evaluate all the
4275 gui slots that could affect this and then mark the instance as
4276 dirty. Right now, updating everything is safe but expensive. */
4278 update_subwindow (Lisp_Object subwindow)
4280 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4281 int count = specpdl_depth ();
4283 /* The update method is allowed to call eval. Since it is quite
4284 common for this function to get called from somewhere in
4285 redisplay we need to make sure that quits are ignored. Otherwise
4286 Fsignal will abort. */
4287 specbind (Qinhibit_quit, Qt);
4289 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4291 IMAGE_INSTANCE_TYPE (ii) == IMAGE_LAYOUT)
4293 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET)
4294 update_widget (subwindow);
4295 /* Reset the changed flags. */
4296 IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0;
4297 IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii) = 0;
4298 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0;
4299 IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0;
4301 else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW
4303 !NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4305 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
4308 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0;
4310 unbind_to (count, Qnil);
4313 /* Update all the subwindows on a frame. */
4315 update_frame_subwindows (struct frame *f)
4319 /* #### Checking all of these might be overkill now that we update
4320 subwindows in the actual redisplay code. */
4321 if (f->subwindows_changed || f->subwindows_state_changed || f->faces_changed)
4322 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4324 struct subwindow_cachel *cachel =
4325 Dynarr_atp (f->subwindow_cachels, elt);
4327 if (cachel->being_displayed
4329 /* We only want to update if something has really
4331 (f->subwindows_state_changed
4333 XIMAGE_INSTANCE_DIRTYP (cachel->subwindow)))
4335 update_subwindow (cachel->subwindow);
4340 /* remove a subwindow from its frame */
4341 void unmap_subwindow (Lisp_Object subwindow)
4343 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4345 struct subwindow_cachel* cachel;
4348 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4350 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4352 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4354 #ifdef DEBUG_WIDGETS
4355 stderr_out ("unmapping subwindow %d\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
4357 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4358 elt = get_subwindow_cachel_index (f, subwindow);
4359 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4361 /* make sure we don't get expose events */
4362 register_ignored_expose (f, cachel->x, cachel->y, cachel->width, cachel->height);
4365 cachel->being_displayed = 0;
4366 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4368 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
4371 /* show a subwindow in its frame */
4372 void map_subwindow (Lisp_Object subwindow, int x, int y,
4373 struct display_glyph_area *dga)
4375 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4377 struct subwindow_cachel* cachel;
4380 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4382 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4384 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4387 #ifdef DEBUG_WIDGETS
4388 stderr_out ("mapping subwindow %d, %dx%d@%d+%d\n",
4389 IMAGE_INSTANCE_SUBWINDOW_ID (ii),
4390 dga->width, dga->height, x, y);
4392 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4393 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
4394 elt = get_subwindow_cachel_index (f, subwindow);
4395 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4398 cachel->width = dga->width;
4399 cachel->height = dga->height;
4400 cachel->being_displayed = 1;
4402 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y, dga));
4406 subwindow_possible_dest_types (void)
4408 return IMAGE_SUBWINDOW_MASK;
4411 /* Partially instantiate a subwindow. */
4413 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
4414 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
4415 int dest_mask, Lisp_Object domain)
4417 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
4418 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
4419 Lisp_Object frame = FW_FRAME (domain);
4420 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
4421 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
4424 signal_simple_error ("No selected frame", device);
4426 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
4427 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
4430 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
4431 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4432 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
4434 /* #### This stuff may get overidden by the widget code and is
4435 actually really dumb now that we have dynamic geometry
4436 calculations. What should really happen is that the subwindow
4437 should query its child for an appropriate geometry. */
4439 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
4444 if (XINT (width) > 1)
4446 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
4449 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
4454 if (XINT (height) > 1)
4456 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
4460 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
4461 Return non-nil if OBJECT is a subwindow.
4465 CHECK_IMAGE_INSTANCE (object);
4466 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
4469 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
4470 Return the window id of SUBWINDOW as a number.
4474 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4475 return make_int ((int) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow));
4478 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
4479 Resize SUBWINDOW to WIDTH x HEIGHT.
4480 If a value is nil that parameter is not changed.
4482 (subwindow, width, height))
4485 Lisp_Image_Instance* ii;
4487 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4488 ii = XIMAGE_INSTANCE (subwindow);
4491 neww = IMAGE_INSTANCE_WIDTH (ii);
4493 neww = XINT (width);
4496 newh = IMAGE_INSTANCE_HEIGHT (ii);
4498 newh = XINT (height);
4500 /* The actual resizing gets done asychronously by
4501 update_subwindow. */
4502 IMAGE_INSTANCE_HEIGHT (ii) = newh;
4503 IMAGE_INSTANCE_WIDTH (ii) = neww;
4504 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
4506 /* need to update the cachels as redisplay will not do this */
4507 update_subwindow_cachel (subwindow);
4512 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
4513 Generate a Map event for SUBWINDOW.
4517 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4519 map_subwindow (subwindow, 0, 0);
4525 /*****************************************************************************
4527 *****************************************************************************/
4529 /* Get the display tables for use currently on window W with face
4530 FACE. #### This will have to be redone. */
4533 get_display_tables (struct window *w, face_index findex,
4534 Lisp_Object *face_table, Lisp_Object *window_table)
4537 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
4541 tem = noseeum_cons (tem, Qnil);
4543 tem = w->display_table;
4547 tem = noseeum_cons (tem, Qnil);
4548 *window_table = tem;
4552 display_table_entry (Emchar ch, Lisp_Object face_table,
4553 Lisp_Object window_table)
4557 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
4558 for (tail = face_table; 1; tail = XCDR (tail))
4563 if (!NILP (window_table))
4565 tail = window_table;
4566 window_table = Qnil;
4571 table = XCAR (tail);
4573 if (VECTORP (table))
4575 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
4576 return XVECTOR_DATA (table)[ch];
4580 else if (CHAR_TABLEP (table)
4581 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
4583 return get_char_table (ch, XCHAR_TABLE (table));
4585 else if (CHAR_TABLEP (table)
4586 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
4588 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
4594 else if (RANGE_TABLEP (table))
4596 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
4607 /*****************************************************************************
4608 * timeouts for animated glyphs *
4609 *****************************************************************************/
4610 static Lisp_Object Qglyph_animated_timeout_handler;
4612 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /*
4613 Callback function for updating animated images.
4618 CHECK_WEAK_LIST (arg);
4620 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg))))
4622 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg));
4624 if (IMAGE_INSTANCEP (value))
4626 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value);
4628 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value)
4630 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1
4632 !disable_animated_pixmaps)
4634 /* Increment the index of the image slice we are currently
4636 IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
4637 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
4638 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
4639 /* We might need to kick redisplay at this point - but we
4641 MARK_DEVICE_FRAMES_GLYPHS_CHANGED
4642 (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)));
4643 /* Cascade dirtiness so that we can have an animated glyph in a layout
4645 set_image_instance_dirty_p (value, 1);
4652 Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image)
4654 Lisp_Object ret = Qnil;
4656 if (tickms > 0 && IMAGE_INSTANCEP (image))
4658 double ms = ((double)tickms) / 1000.0;
4659 struct gcpro gcpro1;
4660 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE);
4663 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil);
4665 ret = Fadd_timeout (make_float (ms),
4666 Qglyph_animated_timeout_handler,
4667 holder, make_float (ms));
4674 void disable_glyph_animated_timeout (int i)
4679 Fdisable_timeout (id);
4683 /*****************************************************************************
4685 *****************************************************************************/
4688 syms_of_glyphs (void)
4690 INIT_LRECORD_IMPLEMENTATION (glyph);
4691 INIT_LRECORD_IMPLEMENTATION (image_instance);
4693 /* image instantiators */
4695 DEFSUBR (Fimage_instantiator_format_list);
4696 DEFSUBR (Fvalid_image_instantiator_format_p);
4697 DEFSUBR (Fset_console_type_image_conversion_list);
4698 DEFSUBR (Fconsole_type_image_conversion_list);
4700 defkeyword (&Q_file, ":file");
4701 defkeyword (&Q_data, ":data");
4702 defkeyword (&Q_face, ":face");
4703 defkeyword (&Q_pixel_height, ":pixel-height");
4704 defkeyword (&Q_pixel_width, ":pixel-width");
4707 defkeyword (&Q_color_symbols, ":color-symbols");
4709 #ifdef HAVE_WINDOW_SYSTEM
4710 defkeyword (&Q_mask_file, ":mask-file");
4711 defkeyword (&Q_mask_data, ":mask-data");
4712 defkeyword (&Q_hotspot_x, ":hotspot-x");
4713 defkeyword (&Q_hotspot_y, ":hotspot-y");
4714 defkeyword (&Q_foreground, ":foreground");
4715 defkeyword (&Q_background, ":background");
4717 /* image specifiers */
4719 DEFSUBR (Fimage_specifier_p);
4720 /* Qimage in general.c */
4722 /* image instances */
4724 defsymbol (&Qimage_instancep, "image-instance-p");
4726 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
4727 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
4728 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
4729 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
4730 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
4731 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
4732 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
4733 defsymbol (&Qlayout_image_instance_p, "layout-image-instance-p");
4735 DEFSUBR (Fmake_image_instance);
4736 DEFSUBR (Fimage_instance_p);
4737 DEFSUBR (Fimage_instance_type);
4738 DEFSUBR (Fvalid_image_instance_type_p);
4739 DEFSUBR (Fimage_instance_type_list);
4740 DEFSUBR (Fimage_instance_name);
4741 DEFSUBR (Fimage_instance_string);
4742 DEFSUBR (Fimage_instance_file_name);
4743 DEFSUBR (Fimage_instance_mask_file_name);
4744 DEFSUBR (Fimage_instance_depth);
4745 DEFSUBR (Fimage_instance_height);
4746 DEFSUBR (Fimage_instance_width);
4747 DEFSUBR (Fimage_instance_hotspot_x);
4748 DEFSUBR (Fimage_instance_hotspot_y);
4749 DEFSUBR (Fimage_instance_foreground);
4750 DEFSUBR (Fimage_instance_background);
4751 DEFSUBR (Fimage_instance_property);
4752 DEFSUBR (Fset_image_instance_property);
4753 DEFSUBR (Fcolorize_image_instance);
4755 DEFSUBR (Fsubwindowp);
4756 DEFSUBR (Fimage_instance_subwindow_id);
4757 DEFSUBR (Fresize_subwindow);
4758 DEFSUBR (Fforce_subwindow_map);
4760 /* Qnothing defined as part of the "nothing" image-instantiator
4762 /* Qtext defined in general.c */
4763 defsymbol (&Qmono_pixmap, "mono-pixmap");
4764 defsymbol (&Qcolor_pixmap, "color-pixmap");
4765 /* Qpointer defined in general.c */
4769 defsymbol (&Qglyphp, "glyphp");
4770 defsymbol (&Qcontrib_p, "contrib-p");
4771 defsymbol (&Qbaseline, "baseline");
4773 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4774 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4775 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4777 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4779 DEFSUBR (Fglyph_type);
4780 DEFSUBR (Fvalid_glyph_type_p);
4781 DEFSUBR (Fglyph_type_list);
4783 DEFSUBR (Fmake_glyph_internal);
4784 DEFSUBR (Fglyph_width);
4785 DEFSUBR (Fglyph_ascent);
4786 DEFSUBR (Fglyph_descent);
4787 DEFSUBR (Fglyph_height);
4789 /* Qbuffer defined in general.c. */
4790 /* Qpointer defined above */
4792 /* Unfortunately, timeout handlers must be lisp functions. This is
4793 for animated glyphs. */
4794 defsymbol (&Qglyph_animated_timeout_handler,
4795 "glyph-animated-timeout-handler");
4796 DEFSUBR (Fglyph_animated_timeout_handler);
4799 deferror (&Qimage_conversion_error,
4800 "image-conversion-error",
4801 "image-conversion error", Qio_error);
4805 static const struct lrecord_description image_specifier_description[] = {
4806 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee) },
4807 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee_property) },
4812 specifier_type_create_image (void)
4814 /* image specifiers */
4816 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4818 SPECIFIER_HAS_METHOD (image, create);
4819 SPECIFIER_HAS_METHOD (image, mark);
4820 SPECIFIER_HAS_METHOD (image, instantiate);
4821 SPECIFIER_HAS_METHOD (image, validate);
4822 SPECIFIER_HAS_METHOD (image, after_change);
4823 SPECIFIER_HAS_METHOD (image, going_to_add);
4824 SPECIFIER_HAS_METHOD (image, copy_instantiator);
4828 reinit_specifier_type_create_image (void)
4830 REINITIALIZE_SPECIFIER_TYPE (image);
4834 static const struct lrecord_description iike_description_1[] = {
4835 { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) },
4839 static const struct struct_description iike_description = {
4840 sizeof (ii_keyword_entry),
4844 static const struct lrecord_description iiked_description_1[] = {
4845 XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description),
4849 static const struct struct_description iiked_description = {
4850 sizeof (ii_keyword_entry_dynarr),
4854 static const struct lrecord_description iife_description_1[] = {
4855 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) },
4856 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) },
4857 { XD_STRUCT_PTR, offsetof (image_instantiator_format_entry, meths), 1, &iim_description },
4861 static const struct struct_description iife_description = {
4862 sizeof (image_instantiator_format_entry),
4866 static const struct lrecord_description iifed_description_1[] = {
4867 XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description),
4871 static const struct struct_description iifed_description = {
4872 sizeof (image_instantiator_format_entry_dynarr),
4876 static const struct lrecord_description iim_description_1[] = {
4877 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) },
4878 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) },
4879 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, keywords), 1, &iiked_description },
4880 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, consoles), 1, &cted_description },
4884 const struct struct_description iim_description = {
4885 sizeof(struct image_instantiator_methods),
4890 image_instantiator_format_create (void)
4892 /* image instantiators */
4894 the_image_instantiator_format_entry_dynarr =
4895 Dynarr_new (image_instantiator_format_entry);
4897 Vimage_instantiator_format_list = Qnil;
4898 staticpro (&Vimage_instantiator_format_list);
4900 dumpstruct (&the_image_instantiator_format_entry_dynarr, &iifed_description);
4902 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
4904 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
4905 IIFORMAT_HAS_METHOD (nothing, instantiate);
4907 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
4909 IIFORMAT_HAS_METHOD (inherit, validate);
4910 IIFORMAT_HAS_METHOD (inherit, normalize);
4911 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
4912 IIFORMAT_HAS_METHOD (inherit, instantiate);
4914 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
4916 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
4918 IIFORMAT_HAS_METHOD (string, validate);
4919 IIFORMAT_HAS_METHOD (string, possible_dest_types);
4920 IIFORMAT_HAS_METHOD (string, instantiate);
4922 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4923 /* Do this so we can set strings. */
4924 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text");
4925 IIFORMAT_HAS_METHOD (text, set_property);
4926 IIFORMAT_HAS_METHOD (text, query_geometry);
4928 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4930 IIFORMAT_HAS_METHOD (formatted_string, validate);
4931 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4932 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
4933 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
4936 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
4937 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
4938 IIFORMAT_HAS_METHOD (subwindow, instantiate);
4939 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
4940 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
4942 #ifdef HAVE_WINDOW_SYSTEM
4943 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4945 IIFORMAT_HAS_METHOD (xbm, validate);
4946 IIFORMAT_HAS_METHOD (xbm, normalize);
4947 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4949 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4950 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4951 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4952 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4953 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4954 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4955 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4956 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4957 #endif /* HAVE_WINDOW_SYSTEM */
4960 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
4962 IIFORMAT_HAS_METHOD (xface, validate);
4963 IIFORMAT_HAS_METHOD (xface, normalize);
4964 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
4966 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
4967 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
4968 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
4969 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
4970 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
4971 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
4975 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
4977 IIFORMAT_HAS_METHOD (xpm, validate);
4978 IIFORMAT_HAS_METHOD (xpm, normalize);
4979 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
4981 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
4982 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
4983 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
4984 #endif /* HAVE_XPM */
4988 reinit_vars_of_glyphs (void)
4990 the_expose_ignore_blocktype =
4991 Blocktype_new (struct expose_ignore_blocktype);
4993 hold_ignored_expose_registration = 0;
4998 vars_of_glyphs (void)
5000 reinit_vars_of_glyphs ();
5002 Vthe_nothing_vector = vector1 (Qnothing);
5003 staticpro (&Vthe_nothing_vector);
5005 /* image instances */
5007 Vimage_instance_type_list = Fcons (Qnothing,
5008 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
5009 Qpointer, Qsubwindow, Qwidget));
5010 staticpro (&Vimage_instance_type_list);
5014 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
5015 staticpro (&Vglyph_type_list);
5017 /* The octal-escape glyph, control-arrow-glyph and
5018 invisible-text-glyph are completely initialized in glyphs.el */
5020 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
5021 What to prefix character codes displayed in octal with.
5023 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5025 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
5026 What to use as an arrow for control characters.
5028 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
5029 redisplay_glyph_changed);
5031 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
5032 What to use to indicate the presence of invisible text.
5033 This is the glyph that is displayed when an ellipsis is called for
5034 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
5035 Normally this is three dots ("...").
5037 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
5038 redisplay_glyph_changed);
5040 /* Partially initialized in glyphs.el */
5041 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
5042 What to display at the beginning of horizontally scrolled lines.
5044 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5045 #ifdef HAVE_WINDOW_SYSTEM
5051 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
5052 Definitions of logical color-names used when reading XPM files.
5053 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
5054 The COLOR-NAME should be a string, which is the name of the color to define;
5055 the FORM should evaluate to a `color' specifier object, or a string to be
5056 passed to `make-color-instance'. If a loaded XPM file references a symbolic
5057 color called COLOR-NAME, it will display as the computed color instead.
5059 The default value of this variable defines the logical color names
5060 \"foreground\" and \"background\" to be the colors of the `default' face.
5062 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
5063 #endif /* HAVE_XPM */
5068 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /*
5069 Whether animated pixmaps should be animated.
5072 disable_animated_pixmaps = 0;
5076 specifier_vars_of_glyphs (void)
5078 /* #### Can we GC here? The set_specifier_* calls definitely need */
5080 /* display tables */
5082 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
5083 *The display table currently in use.
5084 This is a specifier; use `set-specifier' to change it.
5085 The display table is a vector created with `make-display-table'.
5086 The 256 elements control how to display each possible text character.
5087 Each value should be a string, a glyph, a vector or nil.
5088 If a value is a vector it must be composed only of strings and glyphs.
5089 nil means display the character in the default fashion.
5090 Faces can have their own, overriding display table.
5092 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
5093 set_specifier_fallback (Vcurrent_display_table,
5094 list1 (Fcons (Qnil, Qnil)));
5095 set_specifier_caching (Vcurrent_display_table,
5096 offsetof (struct window, display_table),
5097 some_window_value_changed,
5102 complex_vars_of_glyphs (void)
5104 /* Partially initialized in glyphs-x.c, glyphs.el */
5105 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
5106 What to display at the end of truncated lines.
5108 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5110 /* Partially initialized in glyphs-x.c, glyphs.el */
5111 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
5112 What to display at the end of wrapped lines.
5114 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5116 /* Partially initialized in glyphs-x.c, glyphs.el */
5117 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
5118 The glyph used to display the XEmacs logo at startup.
5120 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);