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 Qupdate_widget_instances;
63 Lisp_Object Qwidget_image_instance_p;
64 Lisp_Object Qconst_glyph_variable;
65 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow;
66 Lisp_Object Q_file, Q_data, Q_face, Q_pixel_width, Q_pixel_height;
67 Lisp_Object Qformatted_string;
68 Lisp_Object Vcurrent_display_table;
69 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph;
70 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph;
71 Lisp_Object Vxemacs_logo;
72 Lisp_Object Vthe_nothing_vector;
73 Lisp_Object Vimage_instantiator_format_list;
74 Lisp_Object Vimage_instance_type_list;
75 Lisp_Object Vglyph_type_list;
77 int disable_animated_pixmaps;
79 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
80 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
81 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
82 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
83 DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow);
84 DEFINE_IMAGE_INSTANTIATOR_FORMAT (text);
86 #ifdef HAVE_WINDOW_SYSTEM
87 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
90 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
91 Lisp_Object Q_foreground, Q_background;
93 #define BitmapSuccess 0
94 #define BitmapOpenFailed 1
95 #define BitmapFileInvalid 2
96 #define BitmapNoMemory 3
101 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
106 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
108 Lisp_Object Q_color_symbols;
111 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
112 struct image_instantiator_format_entry
116 struct image_instantiator_methods *meths;
121 Dynarr_declare (struct image_instantiator_format_entry);
122 } image_instantiator_format_entry_dynarr;
124 image_instantiator_format_entry_dynarr *
125 the_image_instantiator_format_entry_dynarr;
127 static Lisp_Object allocate_image_instance (Lisp_Object device, Lisp_Object glyph);
128 static void image_validate (Lisp_Object instantiator);
129 static void glyph_property_was_changed (Lisp_Object glyph,
130 Lisp_Object property,
132 static void set_image_instance_dirty_p (Lisp_Object instance, int dirty);
133 static void register_ignored_expose (struct frame* f, int x, int y, int width, int height);
134 /* Unfortunately windows and X are different. In windows BeginPaint()
135 will prevent WM_PAINT messages being generated so it is unnecessary
136 to register exposures as they will not occur. Under X they will
138 int hold_ignored_expose_registration;
140 EXFUN (Fimage_instance_type, 1);
141 EXFUN (Fglyph_type, 1);
142 EXFUN (Fnext_window, 4);
145 /****************************************************************************
146 * Image Instantiators *
147 ****************************************************************************/
149 struct image_instantiator_methods *
150 decode_device_ii_format (Lisp_Object device, Lisp_Object format,
155 if (!SYMBOLP (format))
157 if (ERRB_EQ (errb, ERROR_ME))
158 CHECK_SYMBOL (format);
162 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
166 Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
169 Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
171 if ((NILP (d) && NILP (device))
174 EQ (CONSOLE_TYPE (XCONSOLE
175 (DEVICE_CONSOLE (XDEVICE (device)))), d)))
176 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
180 maybe_signal_simple_error ("Invalid image-instantiator format", format,
186 struct image_instantiator_methods *
187 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
189 return decode_device_ii_format (Qnil, format, errb);
193 valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale)
196 struct image_instantiator_methods* meths =
197 decode_image_instantiator_format (format, ERROR_ME_NOT);
198 Lisp_Object contype = Qnil;
199 /* mess with the locale */
200 if (!NILP (locale) && SYMBOLP (locale))
204 struct console* console = decode_console (locale);
205 contype = console ? CONSOLE_TYPE (console) : locale;
207 /* nothing is valid in all locales */
208 if (EQ (format, Qnothing))
210 /* reject unknown formats */
211 else if (NILP (contype) || !meths)
214 for (i = 0; i < Dynarr_length (meths->consoles); i++)
215 if (EQ (contype, Dynarr_at (meths->consoles, i).symbol))
220 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
222 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
223 If LOCALE is non-nil then the format is checked in that domain.
224 If LOCALE is nil the current console is used.
225 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
226 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
227 'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled.
229 (image_instantiator_format, locale))
231 return valid_image_instantiator_format_p (image_instantiator_format, locale) ?
235 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
237 Return a list of valid image-instantiator formats.
241 return Fcopy_sequence (Vimage_instantiator_format_list);
245 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol,
246 struct image_instantiator_methods *meths)
248 struct image_instantiator_format_entry entry;
250 entry.symbol = symbol;
251 entry.device = device;
253 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
254 Vimage_instantiator_format_list =
255 Fcons (symbol, Vimage_instantiator_format_list);
259 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
261 image_instantiator_methods *meths)
263 add_entry_to_device_ii_format_list (Qnil, symbol, meths);
267 get_image_conversion_list (Lisp_Object console_type)
269 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
272 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
274 Set the image-conversion-list for consoles of the given TYPE.
275 The image-conversion-list specifies how image instantiators that
276 are strings should be interpreted. Each element of the list should be
277 a list of two elements (a regular expression string and a vector) or
278 a list of three elements (the preceding two plus an integer index into
279 the vector). The string is converted to the vector associated with the
280 first matching regular expression. If a vector index is specified, the
281 string itself is substituted into that position in the vector.
283 Note: The conversion above is applied when the image instantiator is
284 added to an image specifier, not when the specifier is actually
285 instantiated. Therefore, changing the image-conversion-list only affects
286 newly-added instantiators. Existing instantiators in glyphs and image
287 specifiers will not be affected.
289 (console_type, list))
292 Lisp_Object *imlist = get_image_conversion_list (console_type);
294 /* Check the list to make sure that it only has valid entries. */
296 EXTERNAL_LIST_LOOP (tail, list)
298 Lisp_Object mapping = XCAR (tail);
300 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
301 if (!CONSP (mapping) ||
302 !CONSP (XCDR (mapping)) ||
303 (!NILP (XCDR (XCDR (mapping))) &&
304 (!CONSP (XCDR (XCDR (mapping))) ||
305 !NILP (XCDR (XCDR (XCDR (mapping)))))))
306 signal_simple_error ("Invalid mapping form", mapping);
309 Lisp_Object exp = XCAR (mapping);
310 Lisp_Object typevec = XCAR (XCDR (mapping));
311 Lisp_Object pos = Qnil;
316 CHECK_VECTOR (typevec);
317 if (!NILP (XCDR (XCDR (mapping))))
319 pos = XCAR (XCDR (XCDR (mapping)));
321 if (XINT (pos) < 0 ||
322 XINT (pos) >= XVECTOR_LENGTH (typevec))
324 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
327 newvec = Fcopy_sequence (typevec);
329 XVECTOR_DATA (newvec)[XINT (pos)] = exp;
331 image_validate (newvec);
336 *imlist = Fcopy_tree (list, Qt);
340 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
342 Return the image-conversion-list for devices of the given TYPE.
343 The image-conversion-list specifies how to interpret image string
344 instantiators for the specified console type. See
345 `set-console-type-image-conversion-list' for a description of its syntax.
349 return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
352 /* Process a string instantiator according to the image-conversion-list for
353 CONSOLE_TYPE. Returns a vector. */
356 process_image_string_instantiator (Lisp_Object data,
357 Lisp_Object console_type,
362 LIST_LOOP (tail, *get_image_conversion_list (console_type))
364 Lisp_Object mapping = XCAR (tail);
365 Lisp_Object exp = XCAR (mapping);
366 Lisp_Object typevec = XCAR (XCDR (mapping));
368 /* if the result is of a type that can't be instantiated
369 (e.g. a string when we're dealing with a pointer glyph),
372 IIFORMAT_METH (decode_image_instantiator_format
373 (XVECTOR_DATA (typevec)[0], ERROR_ME),
374 possible_dest_types, ())))
376 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
378 if (!NILP (XCDR (XCDR (mapping))))
380 int pos = XINT (XCAR (XCDR (XCDR (mapping))));
381 Lisp_Object newvec = Fcopy_sequence (typevec);
382 XVECTOR_DATA (newvec)[pos] = data;
391 signal_simple_error ("Unable to interpret glyph instantiator",
398 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
399 Lisp_Object default_)
402 int instantiator_len;
404 elt = XVECTOR_DATA (vector);
405 instantiator_len = XVECTOR_LENGTH (vector);
410 while (instantiator_len > 0)
412 if (EQ (elt[0], keyword))
415 instantiator_len -= 2;
422 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
424 return find_keyword_in_vector_or_given (vector, keyword, Qnil);
428 check_valid_string (Lisp_Object data)
434 check_valid_vector (Lisp_Object data)
440 check_valid_face (Lisp_Object data)
446 check_valid_int (Lisp_Object data)
452 file_or_data_must_be_present (Lisp_Object instantiator)
454 if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
455 NILP (find_keyword_in_vector (instantiator, Q_data)))
456 signal_simple_error ("Must supply either :file or :data",
461 data_must_be_present (Lisp_Object instantiator)
463 if (NILP (find_keyword_in_vector (instantiator, Q_data)))
464 signal_simple_error ("Must supply :data", instantiator);
468 face_must_be_present (Lisp_Object instantiator)
470 if (NILP (find_keyword_in_vector (instantiator, Q_face)))
471 signal_simple_error ("Must supply :face", instantiator);
474 /* utility function useful in retrieving data from a file. */
477 make_string_from_file (Lisp_Object file)
479 /* This function can call lisp */
480 int count = specpdl_depth ();
481 Lisp_Object temp_buffer;
485 specbind (Qinhibit_quit, Qt);
486 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
487 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
488 GCPRO1 (temp_buffer);
489 set_buffer_internal (XBUFFER (temp_buffer));
490 Ferase_buffer (Qnil);
491 specbind (intern ("format-alist"), Qnil);
492 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
493 data = Fbuffer_substring (Qnil, Qnil, Qnil);
494 unbind_to (count, Qnil);
499 /* The following two functions are provided to make it easier for
500 the normalize methods to work with keyword-value vectors.
501 Hash tables are kind of heavyweight for this purpose.
502 (If vectors were resizable, we could avoid this problem;
503 but they're not.) An alternative approach that might be
504 more efficient but require more work is to use a type of
505 assoc-Dynarr and provide primitives for deleting elements out
506 of it. (However, you'd also have to add an unwind-protect
507 to make sure the Dynarr got freed in case of an error in
508 the normalization process.) */
511 tagged_vector_to_alist (Lisp_Object vector)
513 Lisp_Object *elt = XVECTOR_DATA (vector);
514 int len = XVECTOR_LENGTH (vector);
515 Lisp_Object result = Qnil;
518 for (len -= 2; len >= 1; len -= 2)
519 result = Fcons (Fcons (elt[len], elt[len+1]), result);
525 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
527 int len = 1 + 2 * XINT (Flength (alist));
528 Lisp_Object *elt = alloca_array (Lisp_Object, len);
534 LIST_LOOP (rest, alist)
536 Lisp_Object pair = XCAR (rest);
537 elt[i] = XCAR (pair);
538 elt[i+1] = XCDR (pair);
542 return Fvector (len, elt);
546 normalize_image_instantiator (Lisp_Object instantiator,
548 Lisp_Object dest_mask)
550 if (IMAGE_INSTANCEP (instantiator))
553 if (STRINGP (instantiator))
554 instantiator = process_image_string_instantiator (instantiator, contype,
557 assert (VECTORP (instantiator));
558 /* We have to always store the actual pixmap data and not the
559 filename even though this is a potential memory pig. We have to
560 do this because it is quite possible that we will need to
561 instantiate a new instance of the pixmap and the file will no
562 longer exist (e.g. w3 pixmaps are almost always from temporary
566 struct image_instantiator_methods *meths;
568 GCPRO1 (instantiator);
570 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
572 RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
573 (instantiator, contype),
579 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
580 Lisp_Object instantiator,
581 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
582 int dest_mask, Lisp_Object glyph)
584 Lisp_Object ii = allocate_image_instance (device, glyph);
585 Lisp_Image_Instance* p = XIMAGE_INSTANCE (ii);
586 struct image_instantiator_methods *meths;
591 if (!valid_image_instantiator_format_p (XVECTOR_DATA (instantiator)[0], device))
593 ("Image instantiator format is invalid in this locale.",
596 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
598 methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate);
599 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
600 pointer_bg, dest_mask, domain));
602 /* now do device specific instantiation */
603 meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0],
606 if (!methp && (!meths || !HAS_IIFORMAT_METH_P (meths, instantiate)))
608 ("Don't know how to instantiate this image instantiator?",
610 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
611 pointer_bg, dest_mask, domain));
614 /* Some code may have already laid out the widget, if not then do it
616 if (IMAGE_INSTANCE_LAYOUT_CHANGED (p))
617 image_instance_layout (ii, IMAGE_UNSPECIFIED_GEOMETRY,
618 IMAGE_UNSPECIFIED_GEOMETRY, domain);
620 /* We *must* have a clean image at this point. */
621 IMAGE_INSTANCE_TEXT_CHANGED (p) = 0;
622 IMAGE_INSTANCE_SIZE_CHANGED (p) = 0;
623 IMAGE_INSTANCE_LAYOUT_CHANGED (p) = 0;
624 IMAGE_INSTANCE_DIRTYP (p) = 0;
630 /****************************************************************************
631 * Image-Instance Object *
632 ****************************************************************************/
634 Lisp_Object Qimage_instancep;
637 mark_image_instance (Lisp_Object obj)
639 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
641 mark_object (i->name);
642 /* We don't mark the glyph reference since that would create a
643 circularity preventing GC. */
644 switch (IMAGE_INSTANCE_TYPE (i))
647 mark_object (IMAGE_INSTANCE_TEXT_STRING (i));
649 case IMAGE_MONO_PIXMAP:
650 case IMAGE_COLOR_PIXMAP:
651 mark_object (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
652 mark_object (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
653 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
654 mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
655 mark_object (IMAGE_INSTANCE_PIXMAP_FG (i));
656 mark_object (IMAGE_INSTANCE_PIXMAP_BG (i));
661 mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i));
662 mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i));
663 mark_object (IMAGE_INSTANCE_WIDGET_FACE (i));
664 mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i));
665 mark_object (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i));
666 mark_object (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i));
667 mark_object (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i));
668 case IMAGE_SUBWINDOW:
669 mark_object (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
676 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i));
682 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
686 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
689 error ("printing unreadable object #<image-instance 0x%x>",
691 write_c_string ("#<image-instance (", printcharfun);
692 print_internal (Fimage_instance_type (obj), printcharfun, 0);
693 write_c_string (") ", printcharfun);
694 if (!NILP (ii->name))
696 print_internal (ii->name, printcharfun, 1);
697 write_c_string (" ", printcharfun);
699 write_c_string ("on ", printcharfun);
700 print_internal (ii->device, printcharfun, 0);
701 write_c_string (" ", printcharfun);
702 switch (IMAGE_INSTANCE_TYPE (ii))
708 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
711 case IMAGE_MONO_PIXMAP:
712 case IMAGE_COLOR_PIXMAP:
714 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
717 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
718 s = strrchr ((char *) XSTRING_DATA (filename), '/');
720 print_internal (build_string (s + 1), printcharfun, 1);
722 print_internal (filename, printcharfun, 1);
724 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
725 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
726 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
727 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
729 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
730 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
731 write_c_string (buf, printcharfun);
732 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
733 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
735 write_c_string (" @", printcharfun);
736 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
738 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
739 write_c_string (buf, printcharfun);
742 write_c_string ("??", printcharfun);
743 write_c_string (",", printcharfun);
744 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
746 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
747 write_c_string (buf, printcharfun);
750 write_c_string ("??", printcharfun);
752 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
753 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
755 write_c_string (" (", printcharfun);
756 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
760 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
762 write_c_string ("/", printcharfun);
763 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
767 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
769 write_c_string (")", printcharfun);
774 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
776 write_c_string (" (", printcharfun);
778 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
779 write_c_string (")", printcharfun);
782 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
783 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0);
785 case IMAGE_SUBWINDOW:
787 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
788 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
789 write_c_string (buf, printcharfun);
791 /* This is stolen from frame.c. Subwindows are strange in that they
792 are specific to a particular frame so we want to print in their
793 description what that frame is. */
795 write_c_string (" on #<", printcharfun);
797 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
799 if (!FRAME_LIVE_P (f))
800 write_c_string ("dead", printcharfun);
802 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
805 write_c_string ("-frame ", printcharfun);
807 write_c_string (">", printcharfun);
808 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
809 write_c_string (buf, printcharfun);
817 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
818 (ii, printcharfun, escapeflag));
819 sprintf (buf, " 0x%x>", ii->header.uid);
820 write_c_string (buf, printcharfun);
824 finalize_image_instance (void *header, int for_disksave)
826 Lisp_Image_Instance *i = (Lisp_Image_Instance *) header;
828 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
829 /* objects like this exist at dump time, so don't bomb out. */
831 if (for_disksave) finalose (i);
833 /* do this so that the cachels get reset */
834 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
836 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW
838 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
840 MARK_FRAME_SUBWINDOWS_CHANGED
841 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
844 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
848 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
850 Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
851 Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
852 struct device *d1 = XDEVICE (i1->device);
853 struct device *d2 = XDEVICE (i2->device);
857 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)
858 || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2)
859 || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2)
860 || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2)
861 || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (i2))
863 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
867 switch (IMAGE_INSTANCE_TYPE (i1))
873 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
874 IMAGE_INSTANCE_TEXT_STRING (i2),
879 case IMAGE_MONO_PIXMAP:
880 case IMAGE_COLOR_PIXMAP:
882 if (!(IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
883 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
884 IMAGE_INSTANCE_PIXMAP_SLICE (i1) ==
885 IMAGE_INSTANCE_PIXMAP_SLICE (i2) &&
886 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
887 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
888 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
889 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
890 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
891 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
893 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
894 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
901 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
902 IMAGE_INSTANCE_WIDGET_TYPE (i2))
903 && IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
904 IMAGE_INSTANCE_SUBWINDOW_ID (i2)
906 EQ (IMAGE_INSTANCE_WIDGET_FACE (i1),
907 IMAGE_INSTANCE_WIDGET_TYPE (i2))
908 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1),
909 IMAGE_INSTANCE_WIDGET_ITEMS (i2),
911 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
912 IMAGE_INSTANCE_WIDGET_PROPS (i2),
914 && internal_equal (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i1),
915 IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i2),
917 && internal_equal (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i1),
918 IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i2),
924 case IMAGE_SUBWINDOW:
925 if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
926 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
934 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
938 full_list_hash (Lisp_Object obj, int depth)
940 unsigned long hash = 0;
944 return internal_hash (obj, depth + 1);
946 LIST_LOOP (rest, obj)
948 hash = HASH2 (internal_hash (XCAR (rest), depth + 1), hash);
954 image_instance_hash (Lisp_Object obj, int depth)
956 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
957 struct device *d = XDEVICE (i->device);
958 unsigned long hash = HASH3 ((unsigned long) d,
959 IMAGE_INSTANCE_WIDTH (i),
960 IMAGE_INSTANCE_HEIGHT (i));
962 switch (IMAGE_INSTANCE_TYPE (i))
968 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
972 case IMAGE_MONO_PIXMAP:
973 case IMAGE_COLOR_PIXMAP:
975 hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i),
976 IMAGE_INSTANCE_PIXMAP_SLICE (i),
977 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
983 /* We need the hash to be equivalent to what should be
986 LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)),
987 full_list_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
989 (NILP (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i))
990 ? IMAGE_INSTANCE_WIDGET_ITEMS (i)
991 : IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i),
993 case IMAGE_SUBWINDOW:
994 hash = HASH2 (hash, (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
1001 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
1005 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
1006 mark_image_instance, print_image_instance,
1007 finalize_image_instance, image_instance_equal,
1008 image_instance_hash, 0,
1009 Lisp_Image_Instance);
1012 allocate_image_instance (Lisp_Object device, Lisp_Object glyph)
1014 Lisp_Image_Instance *lp =
1015 alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance);
1019 lp->device = device;
1020 lp->type = IMAGE_NOTHING;
1027 /* So that layouts get done. */
1028 lp->layout_changed = 1;
1030 XSETIMAGE_INSTANCE (val, lp);
1031 MARK_GLYPHS_CHANGED;
1036 static enum image_instance_type
1037 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
1039 if (ERRB_EQ (errb, ERROR_ME))
1040 CHECK_SYMBOL (type);
1042 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
1043 if (EQ (type, Qtext)) return IMAGE_TEXT;
1044 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
1045 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
1046 if (EQ (type, Qpointer)) return IMAGE_POINTER;
1047 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
1048 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
1049 if (EQ (type, Qlayout)) return IMAGE_LAYOUT;
1051 maybe_signal_simple_error ("Invalid image-instance type", type,
1054 return IMAGE_UNKNOWN; /* not reached */
1058 encode_image_instance_type (enum image_instance_type type)
1062 case IMAGE_NOTHING: return Qnothing;
1063 case IMAGE_TEXT: return Qtext;
1064 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
1065 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
1066 case IMAGE_POINTER: return Qpointer;
1067 case IMAGE_SUBWINDOW: return Qsubwindow;
1068 case IMAGE_WIDGET: return Qwidget;
1069 case IMAGE_LAYOUT: return Qlayout;
1074 return Qnil; /* not reached */
1078 image_instance_type_to_mask (enum image_instance_type type)
1080 /* This depends on the fact that enums are assigned consecutive
1081 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
1082 first enum.) I'm fairly sure this behavior is ANSI-mandated,
1083 so there should be no portability problems here. */
1084 return (1 << ((int) (type) - 1));
1088 decode_image_instance_type_list (Lisp_Object list)
1098 enum image_instance_type type =
1099 decode_image_instance_type (list, ERROR_ME);
1100 return image_instance_type_to_mask (type);
1103 EXTERNAL_LIST_LOOP (rest, list)
1105 enum image_instance_type type =
1106 decode_image_instance_type (XCAR (rest), ERROR_ME);
1107 mask |= image_instance_type_to_mask (type);
1114 encode_image_instance_type_list (int mask)
1117 Lisp_Object result = Qnil;
1123 result = Fcons (encode_image_instance_type
1124 ((enum image_instance_type) count), result);
1128 return Fnreverse (result);
1132 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1133 int desired_dest_mask)
1138 (emacs_doprnt_string_lisp_2
1140 "No compatible image-instance types given: wanted one of %s, got %s",
1142 encode_image_instance_type_list (desired_dest_mask),
1143 encode_image_instance_type_list (given_dest_mask)),
1148 valid_image_instance_type_p (Lisp_Object type)
1150 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1153 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1154 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1155 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1156 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1158 (image_instance_type))
1160 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1163 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1164 Return a list of valid image-instance types.
1168 return Fcopy_sequence (Vimage_instance_type_list);
1172 decode_error_behavior_flag (Lisp_Object no_error)
1174 if (NILP (no_error)) return ERROR_ME;
1175 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1176 else return ERROR_ME_WARN;
1180 encode_error_behavior_flag (Error_behavior errb)
1182 if (ERRB_EQ (errb, ERROR_ME))
1184 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1188 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1193 /* Recurse up the hierarchy looking for the topmost glyph. This means
1194 that instances in layouts will inherit face properties from their
1196 Lisp_Object image_instance_parent_glyph (Lisp_Image_Instance* ii)
1198 if (IMAGE_INSTANCEP (IMAGE_INSTANCE_PARENT (ii)))
1200 return image_instance_parent_glyph
1201 (XIMAGE_INSTANCE (IMAGE_INSTANCE_PARENT (ii)));
1203 return IMAGE_INSTANCE_PARENT (ii);
1207 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1208 Lisp_Object dest_types)
1211 struct gcpro gcpro1;
1214 XSETDEVICE (device, decode_device (device));
1215 /* instantiate_image_instantiator() will abort if given an
1216 image instance ... */
1217 if (IMAGE_INSTANCEP (data))
1218 signal_simple_error ("Image instances not allowed here", data);
1219 image_validate (data);
1220 dest_mask = decode_image_instance_type_list (dest_types);
1221 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1222 make_int (dest_mask));
1224 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1225 signal_simple_error ("Inheritance not allowed here", data);
1226 ii = instantiate_image_instantiator (device, device, data,
1227 Qnil, Qnil, dest_mask, Qnil);
1228 RETURN_UNGCPRO (ii);
1231 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1232 Return a new `image-instance' object.
1234 Image-instance objects encapsulate the way a particular image (pixmap,
1235 etc.) is displayed on a particular device. In most circumstances, you
1236 do not need to directly create image instances; use a glyph instead.
1237 However, it may occasionally be useful to explicitly create image
1238 instances, if you want more control over the instantiation process.
1240 DATA is an image instantiator, which describes the image; see
1241 `image-specifier-p' for a description of the allowed values.
1243 DEST-TYPES should be a list of allowed image instance types that can
1244 be generated. The recognized image instance types are
1247 Nothing is displayed.
1249 Displayed as text. The foreground and background colors and the
1250 font of the text are specified independent of the pixmap. Typically
1251 these attributes will come from the face of the surrounding text,
1252 unless a face is specified for the glyph in which the image appears.
1254 Displayed as a mono pixmap (a pixmap with only two colors where the
1255 foreground and background can be specified independent of the pixmap;
1256 typically the pixmap assumes the foreground and background colors of
1257 the text around it, unless a face is specified for the glyph in which
1260 Displayed as a color pixmap.
1262 Used as the mouse pointer for a window.
1264 A child window that is treated as an image. This allows (e.g.)
1265 another program to be responsible for drawing into the window.
1267 A child window that contains a window-system widget, e.g. a push
1270 The DEST-TYPES list is unordered. If multiple destination types
1271 are possible for a given instantiator, the "most natural" type
1272 for the instantiator's format is chosen. (For XBM, the most natural
1273 types are `mono-pixmap', followed by `color-pixmap', followed by
1274 `pointer'. For the other normal image formats, the most natural
1275 types are `color-pixmap', followed by `mono-pixmap', followed by
1276 `pointer'. For the string and formatted-string formats, the most
1277 natural types are `text', followed by `mono-pixmap' (not currently
1278 implemented), followed by `color-pixmap' (not currently implemented).
1279 The other formats can only be instantiated as one type. (If you
1280 want to control more specifically the order of the types into which
1281 an image is instantiated, just call `make-image-instance' repeatedly
1282 until it succeeds, passing less and less preferred destination types
1285 If DEST-TYPES is omitted, all possible types are allowed.
1287 NO-ERROR controls what happens when the image cannot be generated.
1288 If nil, an error message is generated. If t, no messages are
1289 generated and this function returns nil. If anything else, a warning
1290 message is generated and this function returns nil.
1292 (data, device, dest_types, no_error))
1294 Error_behavior errb = decode_error_behavior_flag (no_error);
1296 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1298 3, data, device, dest_types);
1301 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1302 Return non-nil if OBJECT is an image instance.
1306 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1309 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1310 Return the type of the given image instance.
1311 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1312 'color-pixmap, 'pointer, or 'subwindow.
1316 CHECK_IMAGE_INSTANCE (image_instance);
1317 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1320 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1321 Return the name of the given image instance.
1325 CHECK_IMAGE_INSTANCE (image_instance);
1326 return XIMAGE_INSTANCE_NAME (image_instance);
1329 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1330 Return the string of the given image instance.
1331 This will only be non-nil for text image instances and widgets.
1335 CHECK_IMAGE_INSTANCE (image_instance);
1336 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1337 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1338 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1339 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1344 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1345 Return the given property of the given image instance.
1346 Returns nil if the property or the property method do not exist for
1347 the image instance in the domain.
1349 (image_instance, prop))
1351 Lisp_Image_Instance* ii;
1352 Lisp_Object type, ret;
1353 struct image_instantiator_methods* meths;
1355 CHECK_IMAGE_INSTANCE (image_instance);
1356 CHECK_SYMBOL (prop);
1357 ii = XIMAGE_INSTANCE (image_instance);
1359 /* ... then try device specific methods ... */
1360 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1361 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1362 type, ERROR_ME_NOT);
1363 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1365 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1369 /* ... then format specific methods ... */
1370 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1371 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1373 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1381 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1382 Set the given property of the given image instance.
1383 Does nothing if the property or the property method do not exist for
1384 the image instance in the domain.
1386 (image_instance, prop, val))
1388 Lisp_Image_Instance* ii;
1389 Lisp_Object type, ret;
1390 struct image_instantiator_methods* meths;
1392 CHECK_IMAGE_INSTANCE (image_instance);
1393 CHECK_SYMBOL (prop);
1394 ii = XIMAGE_INSTANCE (image_instance);
1395 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1396 /* try device specific methods first ... */
1397 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1398 type, ERROR_ME_NOT);
1399 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1402 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1408 /* ... then format specific methods ... */
1409 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1410 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1413 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1423 /* Make sure the image instance gets redisplayed. */
1424 set_image_instance_dirty_p (image_instance, 1);
1425 /* Force the glyph to be laid out again. */
1426 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
1428 MARK_SUBWINDOWS_STATE_CHANGED;
1429 MARK_GLYPHS_CHANGED;
1434 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1435 Return the file name from which IMAGE-INSTANCE was read, if known.
1439 CHECK_IMAGE_INSTANCE (image_instance);
1441 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1443 case IMAGE_MONO_PIXMAP:
1444 case IMAGE_COLOR_PIXMAP:
1446 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1453 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1454 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1458 CHECK_IMAGE_INSTANCE (image_instance);
1460 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1462 case IMAGE_MONO_PIXMAP:
1463 case IMAGE_COLOR_PIXMAP:
1465 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1472 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1473 Return the depth of the image instance.
1474 This is 0 for a bitmap, or a positive integer for a pixmap.
1478 CHECK_IMAGE_INSTANCE (image_instance);
1480 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1482 case IMAGE_MONO_PIXMAP:
1483 case IMAGE_COLOR_PIXMAP:
1485 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1492 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1493 Return the height of the image instance, in pixels.
1497 CHECK_IMAGE_INSTANCE (image_instance);
1499 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1501 case IMAGE_MONO_PIXMAP:
1502 case IMAGE_COLOR_PIXMAP:
1504 case IMAGE_SUBWINDOW:
1507 return make_int (XIMAGE_INSTANCE_HEIGHT (image_instance));
1514 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1515 Return the width of the image instance, in pixels.
1519 CHECK_IMAGE_INSTANCE (image_instance);
1521 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1523 case IMAGE_MONO_PIXMAP:
1524 case IMAGE_COLOR_PIXMAP:
1526 case IMAGE_SUBWINDOW:
1529 return make_int (XIMAGE_INSTANCE_WIDTH (image_instance));
1536 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1537 Return the X coordinate of the image instance's hotspot, if known.
1538 This is a point relative to the origin of the pixmap. When an image is
1539 used as a mouse pointer, the hotspot is the point on the image that sits
1540 over the location that the pointer points to. This is, for example, the
1541 tip of the arrow or the center of the crosshairs.
1542 This will always be nil for a non-pointer image instance.
1546 CHECK_IMAGE_INSTANCE (image_instance);
1548 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1550 case IMAGE_MONO_PIXMAP:
1551 case IMAGE_COLOR_PIXMAP:
1553 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1560 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1561 Return the Y coordinate of the image instance's hotspot, if known.
1562 This is a point relative to the origin of the pixmap. When an image is
1563 used as a mouse pointer, the hotspot is the point on the image that sits
1564 over the location that the pointer points to. This is, for example, the
1565 tip of the arrow or the center of the crosshairs.
1566 This will always be nil for a non-pointer image instance.
1570 CHECK_IMAGE_INSTANCE (image_instance);
1572 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1574 case IMAGE_MONO_PIXMAP:
1575 case IMAGE_COLOR_PIXMAP:
1577 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1584 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1585 Return the foreground color of IMAGE-INSTANCE, if applicable.
1586 This will be a color instance or nil. (It will only be non-nil for
1587 colorized mono pixmaps and for pointers.)
1591 CHECK_IMAGE_INSTANCE (image_instance);
1593 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1595 case IMAGE_MONO_PIXMAP:
1596 case IMAGE_COLOR_PIXMAP:
1598 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1601 return FACE_FOREGROUND (
1602 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1603 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1611 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1612 Return the background color of IMAGE-INSTANCE, if applicable.
1613 This will be a color instance or nil. (It will only be non-nil for
1614 colorized mono pixmaps and for pointers.)
1618 CHECK_IMAGE_INSTANCE (image_instance);
1620 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1622 case IMAGE_MONO_PIXMAP:
1623 case IMAGE_COLOR_PIXMAP:
1625 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1628 return FACE_BACKGROUND (
1629 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1630 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1639 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1640 Make the image instance be displayed in the given colors.
1641 This function returns a new image instance that is exactly like the
1642 specified one except that (if possible) the foreground and background
1643 colors and as specified. Currently, this only does anything if the image
1644 instance is a mono pixmap; otherwise, the same image instance is returned.
1646 (image_instance, foreground, background))
1651 CHECK_IMAGE_INSTANCE (image_instance);
1652 CHECK_COLOR_INSTANCE (foreground);
1653 CHECK_COLOR_INSTANCE (background);
1655 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1656 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1657 return image_instance;
1659 /* #### There should be a copy_image_instance(), which calls a
1660 device-specific method to copy the window-system subobject. */
1661 new = allocate_image_instance (device, Qnil);
1662 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1663 /* note that if this method returns non-zero, this method MUST
1664 copy any window-system resources, so that when one image instance is
1665 freed, the other one is not hosed. */
1666 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1668 return image_instance;
1673 /************************************************************************/
1674 /* Geometry calculations */
1675 /************************************************************************/
1677 /* Find out desired geometry of the image instance. If there is no
1678 special function then just return the width and / or height. */
1680 image_instance_query_geometry (Lisp_Object image_instance,
1681 unsigned int* width, unsigned int* height,
1682 enum image_instance_geometry disp,
1685 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1687 struct image_instantiator_methods* meths;
1689 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1690 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1692 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1694 IIFORMAT_METH (meths, query_geometry, (image_instance, width, height,
1700 *width = IMAGE_INSTANCE_WIDTH (ii);
1702 *height = IMAGE_INSTANCE_HEIGHT (ii);
1706 /* Layout the image instance using the provided dimensions. Layout
1707 widgets are going to do different kinds of calculations to
1708 determine what size to give things so we could make the layout
1709 function relatively simple to take account of that. An alternative
1710 approach is to consider separately the two cases, one where you
1711 don't mind what size you have (normal widgets) and one where you
1712 want to specifiy something (layout widgets). */
1714 image_instance_layout (Lisp_Object image_instance,
1715 unsigned int width, unsigned int height,
1718 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1720 struct image_instantiator_methods* meths;
1722 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1723 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1725 /* If geometry is unspecified then get some reasonable values for it. */
1726 if (width == IMAGE_UNSPECIFIED_GEOMETRY
1728 height == IMAGE_UNSPECIFIED_GEOMETRY)
1730 unsigned int dwidth, dheight;
1732 /* Get the desired geometry. */
1733 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1735 IIFORMAT_METH (meths, query_geometry, (image_instance, &dwidth, &dheight,
1736 IMAGE_DESIRED_GEOMETRY,
1741 dwidth = IMAGE_INSTANCE_WIDTH (ii);
1742 dheight = IMAGE_INSTANCE_HEIGHT (ii);
1745 /* Compare with allowed geometry. */
1746 if (width == IMAGE_UNSPECIFIED_GEOMETRY)
1748 if (height == IMAGE_UNSPECIFIED_GEOMETRY)
1752 /* At this point width and height should contain sane values. Thus
1753 we set the glyph geometry and lay it out. */
1754 if (IMAGE_INSTANCE_WIDTH (ii) != width
1756 IMAGE_INSTANCE_HEIGHT (ii) != height)
1758 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
1761 IMAGE_INSTANCE_WIDTH (ii) = width;
1762 IMAGE_INSTANCE_HEIGHT (ii) = height;
1764 if (meths && HAS_IIFORMAT_METH_P (meths, layout))
1766 IIFORMAT_METH (meths, layout, (image_instance, width, height, domain));
1768 /* else no change to the geometry. */
1770 /* Do not clear the dirty flag here - redisplay will do this for
1772 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0;
1776 * Mark image instance in W as dirty if (a) W's faces have changed and
1777 * (b) GLYPH_OR_II instance in W is a string.
1779 * Return non-zero if instance has been marked dirty.
1782 invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w)
1784 if (XFRAME(WINDOW_FRAME(w))->faces_changed)
1786 Lisp_Object image = glyph_or_ii;
1788 if (GLYPHP (glyph_or_ii))
1791 XSETWINDOW (window, w);
1792 image = glyph_image_instance (glyph_or_ii, window, ERROR_ME_NOT, 1);
1795 if (TEXT_IMAGE_INSTANCEP (image))
1797 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image);
1798 IMAGE_INSTANCE_DIRTYP (ii) = 1;
1799 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
1800 if (GLYPHP (glyph_or_ii))
1801 XGLYPH_DIRTYP (glyph_or_ii) = 1;
1810 /************************************************************************/
1812 /************************************************************************/
1814 signal_image_error (const char *reason, Lisp_Object frob)
1816 signal_error (Qimage_conversion_error,
1817 list2 (build_translated_string (reason), frob));
1821 signal_image_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1)
1823 signal_error (Qimage_conversion_error,
1824 list3 (build_translated_string (reason), frob0, frob1));
1827 /****************************************************************************
1829 ****************************************************************************/
1832 nothing_possible_dest_types (void)
1834 return IMAGE_NOTHING_MASK;
1838 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1839 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1840 int dest_mask, Lisp_Object domain)
1842 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1844 if (dest_mask & IMAGE_NOTHING_MASK)
1845 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1847 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1851 /****************************************************************************
1853 ****************************************************************************/
1856 inherit_validate (Lisp_Object instantiator)
1858 face_must_be_present (instantiator);
1862 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1866 assert (XVECTOR_LENGTH (inst) == 3);
1867 face = XVECTOR_DATA (inst)[2];
1869 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1874 inherit_possible_dest_types (void)
1876 return IMAGE_MONO_PIXMAP_MASK;
1880 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1881 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1882 int dest_mask, Lisp_Object domain)
1884 /* handled specially in image_instantiate */
1889 /****************************************************************************
1891 ****************************************************************************/
1894 string_validate (Lisp_Object instantiator)
1896 data_must_be_present (instantiator);
1900 string_possible_dest_types (void)
1902 return IMAGE_TEXT_MASK;
1905 /* Called from autodetect_instantiate() */
1907 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1908 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1909 int dest_mask, Lisp_Object domain)
1911 Lisp_Object string = find_keyword_in_vector (instantiator, Q_data);
1912 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1914 /* Should never get here with a domain other than a window. */
1915 assert (!NILP (string) && WINDOWP (domain));
1916 if (dest_mask & IMAGE_TEXT_MASK)
1918 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1919 IMAGE_INSTANCE_TEXT_STRING (ii) = string;
1922 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1925 /* Sort out the size of the text that is being displayed. Calculating
1926 it dynamically allows us to change the text and still see
1927 everything. Note that the following methods are for text not string
1928 since that is what the instantiated type is. The first method is a
1929 helper that is used elsewhere for calculating text geometry. */
1931 query_string_geometry (Lisp_Object string, Lisp_Object face,
1932 unsigned int* width, unsigned int* height,
1933 unsigned int* descent, Lisp_Object domain)
1935 struct font_metric_info fm;
1936 unsigned char charsets[NUM_LEADING_BYTES];
1937 struct face_cachel frame_cachel;
1938 struct face_cachel *cachel;
1939 Lisp_Object frame = FW_FRAME (domain);
1941 /* Compute height */
1944 /* Compute string metric info */
1945 find_charsets_in_bufbyte_string (charsets,
1946 XSTRING_DATA (string),
1947 XSTRING_LENGTH (string));
1949 /* Fallback to the default face if none was provided. */
1952 reset_face_cachel (&frame_cachel);
1953 update_face_cachel_data (&frame_cachel, frame, face);
1954 cachel = &frame_cachel;
1958 cachel = WINDOW_FACE_CACHEL (XWINDOW (domain), DEFAULT_INDEX);
1961 ensure_face_cachel_complete (cachel, domain, charsets);
1962 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
1964 *height = fm.ascent + fm.descent;
1965 /* #### descent only gets set if we query the height as well. */
1967 *descent = fm.descent;
1974 *width = redisplay_frame_text_width_string (XFRAME (frame),
1978 *width = redisplay_frame_text_width_string (XFRAME (frame),
1985 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain)
1987 unsigned char charsets[NUM_LEADING_BYTES];
1988 struct face_cachel frame_cachel;
1989 struct face_cachel *cachel;
1991 Lisp_Object frame = FW_FRAME (domain);
1993 /* Compute string font info */
1994 find_charsets_in_bufbyte_string (charsets,
1995 XSTRING_DATA (string),
1996 XSTRING_LENGTH (string));
1998 reset_face_cachel (&frame_cachel);
1999 update_face_cachel_data (&frame_cachel, frame, face);
2000 cachel = &frame_cachel;
2002 ensure_face_cachel_complete (cachel, domain, charsets);
2004 for (i = 0; i < NUM_LEADING_BYTES; i++)
2008 return FACE_CACHEL_FONT (cachel,
2009 CHARSET_BY_LEADING_BYTE (i +
2015 return Qnil; /* NOT REACHED */
2019 text_query_geometry (Lisp_Object image_instance,
2020 unsigned int* width, unsigned int* height,
2021 enum image_instance_geometry disp, Lisp_Object domain)
2023 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2024 unsigned int descent = 0;
2026 query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii),
2027 IMAGE_INSTANCE_FACE (ii),
2028 width, height, &descent, domain);
2030 /* The descent gets set as a side effect of querying the
2032 IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent;
2035 /* set the properties of a string */
2037 text_set_property (Lisp_Object image_instance, Lisp_Object prop,
2040 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2042 if (EQ (prop, Q_data))
2045 IMAGE_INSTANCE_TEXT_STRING (ii) = val;
2053 /****************************************************************************
2054 * formatted-string *
2055 ****************************************************************************/
2058 formatted_string_validate (Lisp_Object instantiator)
2060 data_must_be_present (instantiator);
2064 formatted_string_possible_dest_types (void)
2066 return IMAGE_TEXT_MASK;
2070 formatted_string_instantiate (Lisp_Object image_instance,
2071 Lisp_Object instantiator,
2072 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2073 int dest_mask, Lisp_Object domain)
2075 /* #### implement this */
2076 warn_when_safe (Qunimplemented, Qnotice,
2077 "`formatted-string' not yet implemented; assuming `string'");
2079 string_instantiate (image_instance, instantiator,
2080 pointer_fg, pointer_bg, dest_mask, domain);
2084 /************************************************************************/
2085 /* pixmap file functions */
2086 /************************************************************************/
2088 /* If INSTANTIATOR refers to inline data, return Qnil.
2089 If INSTANTIATOR refers to data in a file, return the full filename
2090 if it exists; otherwise, return a cons of (filename).
2092 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
2093 keywords used to look up the file and inline data,
2094 respectively, in the instantiator. Normally these would
2095 be Q_file and Q_data, but might be different for mask data. */
2098 potential_pixmap_file_instantiator (Lisp_Object instantiator,
2099 Lisp_Object file_keyword,
2100 Lisp_Object data_keyword,
2101 Lisp_Object console_type)
2106 assert (VECTORP (instantiator));
2108 data = find_keyword_in_vector (instantiator, data_keyword);
2109 file = find_keyword_in_vector (instantiator, file_keyword);
2111 if (!NILP (file) && NILP (data))
2113 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
2114 (decode_console_type(console_type, ERROR_ME),
2115 locate_pixmap_file, (file));
2120 return Fcons (file, Qnil); /* should have been file */
2127 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
2128 Lisp_Object image_type_tag)
2130 /* This function can call lisp */
2131 Lisp_Object file = Qnil;
2132 struct gcpro gcpro1, gcpro2;
2133 Lisp_Object alist = Qnil;
2135 GCPRO2 (file, alist);
2137 /* Now, convert any file data into inline data. At the end of this,
2138 `data' will contain the inline data (if any) or Qnil, and `file'
2139 will contain the name this data was derived from (if known) or
2142 Note that if we cannot generate any regular inline data, we
2145 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2148 if (CONSP (file)) /* failure locating filename */
2149 signal_double_file_error ("Opening pixmap file",
2150 "no such file or directory",
2153 if (NILP (file)) /* no conversion necessary */
2154 RETURN_UNGCPRO (inst);
2156 alist = tagged_vector_to_alist (inst);
2159 Lisp_Object data = make_string_from_file (file);
2160 alist = remassq_no_quit (Q_file, alist);
2161 /* there can't be a :data at this point. */
2162 alist = Fcons (Fcons (Q_file, file),
2163 Fcons (Fcons (Q_data, data), alist));
2167 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
2169 RETURN_UNGCPRO (result);
2174 #ifdef HAVE_WINDOW_SYSTEM
2175 /**********************************************************************
2177 **********************************************************************/
2179 /* Check if DATA represents a valid inline XBM spec (i.e. a list
2180 of (width height bits), with checking done on the dimensions).
2181 If not, signal an error. */
2184 check_valid_xbm_inline (Lisp_Object data)
2186 Lisp_Object width, height, bits;
2188 if (!CONSP (data) ||
2189 !CONSP (XCDR (data)) ||
2190 !CONSP (XCDR (XCDR (data))) ||
2191 !NILP (XCDR (XCDR (XCDR (data)))))
2192 signal_simple_error ("Must be list of 3 elements", data);
2194 width = XCAR (data);
2195 height = XCAR (XCDR (data));
2196 bits = XCAR (XCDR (XCDR (data)));
2198 CHECK_STRING (bits);
2200 if (!NATNUMP (width))
2201 signal_simple_error ("Width must be a natural number", width);
2203 if (!NATNUMP (height))
2204 signal_simple_error ("Height must be a natural number", height);
2206 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
2207 signal_simple_error ("data is too short for width and height",
2208 vector3 (width, height, bits));
2211 /* Validate method for XBM's. */
2214 xbm_validate (Lisp_Object instantiator)
2216 file_or_data_must_be_present (instantiator);
2219 /* Given a filename that is supposed to contain XBM data, return
2220 the inline representation of it as (width height bits). Return
2221 the hotspot through XHOT and YHOT, if those pointers are not 0.
2222 If there is no hotspot, XHOT and YHOT will contain -1.
2224 If the function fails:
2226 -- if OK_IF_DATA_INVALID is set and the data was invalid,
2228 -- maybe return an error, or return Qnil.
2231 #ifdef HAVE_X_WINDOWS
2232 #include <X11/Xlib.h>
2234 #define XFree(data) free(data)
2238 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
2239 int ok_if_data_invalid)
2244 const char *filename_ext;
2246 TO_EXTERNAL_FORMAT (LISP_STRING, name,
2247 C_STRING_ALLOCA, filename_ext,
2249 result = read_bitmap_data_from_file (filename_ext, &w, &h,
2252 if (result == BitmapSuccess)
2255 int len = (w + 7) / 8 * h;
2257 retval = list3 (make_int (w), make_int (h),
2258 make_ext_string (data, len, Qbinary));
2259 XFree ((char *) data);
2265 case BitmapOpenFailed:
2267 /* should never happen */
2268 signal_double_file_error ("Opening bitmap file",
2269 "no such file or directory",
2272 case BitmapFileInvalid:
2274 if (ok_if_data_invalid)
2276 signal_double_file_error ("Reading bitmap file",
2277 "invalid data in file",
2280 case BitmapNoMemory:
2282 signal_double_file_error ("Reading bitmap file",
2288 signal_double_file_error_2 ("Reading bitmap file",
2289 "unknown error code",
2290 make_int (result), name);
2294 return Qnil; /* not reached */
2298 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2299 Lisp_Object mask_file, Lisp_Object console_type)
2301 /* This is unclean but it's fairly standard -- a number of the
2302 bitmaps in /usr/include/X11/bitmaps use it -- so we support
2304 if (NILP (mask_file)
2305 /* don't override explicitly specified mask data. */
2306 && NILP (assq_no_quit (Q_mask_data, alist))
2309 mask_file = MAYBE_LISP_CONTYPE_METH
2310 (decode_console_type(console_type, ERROR_ME),
2311 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
2312 if (NILP (mask_file))
2313 mask_file = MAYBE_LISP_CONTYPE_METH
2314 (decode_console_type(console_type, ERROR_ME),
2315 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
2318 if (!NILP (mask_file))
2320 Lisp_Object mask_data =
2321 bitmap_to_lisp_data (mask_file, 0, 0, 0);
2322 alist = remassq_no_quit (Q_mask_file, alist);
2323 /* there can't be a :mask-data at this point. */
2324 alist = Fcons (Fcons (Q_mask_file, mask_file),
2325 Fcons (Fcons (Q_mask_data, mask_data), alist));
2331 /* Normalize method for XBM's. */
2334 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
2336 Lisp_Object file = Qnil, mask_file = Qnil;
2337 struct gcpro gcpro1, gcpro2, gcpro3;
2338 Lisp_Object alist = Qnil;
2340 GCPRO3 (file, mask_file, alist);
2342 /* Now, convert any file data into inline data for both the regular
2343 data and the mask data. At the end of this, `data' will contain
2344 the inline data (if any) or Qnil, and `file' will contain
2345 the name this data was derived from (if known) or Qnil.
2346 Likewise for `mask_file' and `mask_data'.
2348 Note that if we cannot generate any regular inline data, we
2351 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2353 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2354 Q_mask_data, console_type);
2356 if (CONSP (file)) /* failure locating filename */
2357 signal_double_file_error ("Opening bitmap file",
2358 "no such file or directory",
2361 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2362 RETURN_UNGCPRO (inst);
2364 alist = tagged_vector_to_alist (inst);
2369 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
2370 alist = remassq_no_quit (Q_file, alist);
2371 /* there can't be a :data at this point. */
2372 alist = Fcons (Fcons (Q_file, file),
2373 Fcons (Fcons (Q_data, data), alist));
2375 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2376 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2378 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2379 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2383 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2386 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2388 RETURN_UNGCPRO (result);
2394 xbm_possible_dest_types (void)
2397 IMAGE_MONO_PIXMAP_MASK |
2398 IMAGE_COLOR_PIXMAP_MASK |
2406 /**********************************************************************
2408 **********************************************************************/
2411 xface_validate (Lisp_Object instantiator)
2413 file_or_data_must_be_present (instantiator);
2417 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2419 /* This function can call lisp */
2420 Lisp_Object file = Qnil, mask_file = Qnil;
2421 struct gcpro gcpro1, gcpro2, gcpro3;
2422 Lisp_Object alist = Qnil;
2424 GCPRO3 (file, mask_file, alist);
2426 /* Now, convert any file data into inline data for both the regular
2427 data and the mask data. At the end of this, `data' will contain
2428 the inline data (if any) or Qnil, and `file' will contain
2429 the name this data was derived from (if known) or Qnil.
2430 Likewise for `mask_file' and `mask_data'.
2432 Note that if we cannot generate any regular inline data, we
2435 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2437 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2438 Q_mask_data, console_type);
2440 if (CONSP (file)) /* failure locating filename */
2441 signal_double_file_error ("Opening bitmap file",
2442 "no such file or directory",
2445 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2446 RETURN_UNGCPRO (inst);
2448 alist = tagged_vector_to_alist (inst);
2451 Lisp_Object data = make_string_from_file (file);
2452 alist = remassq_no_quit (Q_file, alist);
2453 /* there can't be a :data at this point. */
2454 alist = Fcons (Fcons (Q_file, file),
2455 Fcons (Fcons (Q_data, data), alist));
2458 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2461 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2463 RETURN_UNGCPRO (result);
2468 xface_possible_dest_types (void)
2471 IMAGE_MONO_PIXMAP_MASK |
2472 IMAGE_COLOR_PIXMAP_MASK |
2476 #endif /* HAVE_XFACE */
2481 /**********************************************************************
2483 **********************************************************************/
2486 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2492 TO_EXTERNAL_FORMAT (LISP_STRING, name,
2493 C_STRING_ALLOCA, fname,
2495 result = XpmReadFileToData (fname, &data);
2497 if (result == XpmSuccess)
2499 Lisp_Object retval = Qnil;
2500 struct buffer *old_buffer = current_buffer;
2501 Lisp_Object temp_buffer =
2502 Fget_buffer_create (build_string (" *pixmap conversion*"));
2504 int height, width, ncolors;
2505 struct gcpro gcpro1, gcpro2, gcpro3;
2506 int speccount = specpdl_depth ();
2508 GCPRO3 (name, retval, temp_buffer);
2510 specbind (Qinhibit_quit, Qt);
2511 set_buffer_internal (XBUFFER (temp_buffer));
2512 Ferase_buffer (Qnil);
2514 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2515 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2517 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2518 for (elt = 0; elt <= width + ncolors; elt++)
2520 buffer_insert_c_string (current_buffer, "\"");
2521 buffer_insert_c_string (current_buffer, data[elt]);
2523 if (elt < width + ncolors)
2524 buffer_insert_c_string (current_buffer, "\",\r");
2526 buffer_insert_c_string (current_buffer, "\"};\r");
2529 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2532 set_buffer_internal (old_buffer);
2533 unbind_to (speccount, Qnil);
2535 RETURN_UNGCPRO (retval);
2540 case XpmFileInvalid:
2542 if (ok_if_data_invalid)
2544 signal_image_error ("invalid XPM data in file", name);
2548 signal_double_file_error ("Reading pixmap file",
2549 "out of memory", name);
2553 /* should never happen? */
2554 signal_double_file_error ("Opening pixmap file",
2555 "no such file or directory", name);
2559 signal_double_file_error_2 ("Parsing pixmap file",
2560 "unknown error code",
2561 make_int (result), name);
2566 return Qnil; /* not reached */
2570 check_valid_xpm_color_symbols (Lisp_Object data)
2574 for (rest = data; !NILP (rest); rest = XCDR (rest))
2576 if (!CONSP (rest) ||
2577 !CONSP (XCAR (rest)) ||
2578 !STRINGP (XCAR (XCAR (rest))) ||
2579 (!STRINGP (XCDR (XCAR (rest))) &&
2580 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2581 signal_simple_error ("Invalid color symbol alist", data);
2586 xpm_validate (Lisp_Object instantiator)
2588 file_or_data_must_be_present (instantiator);
2591 Lisp_Object Vxpm_color_symbols;
2594 evaluate_xpm_color_symbols (void)
2596 Lisp_Object rest, results = Qnil;
2597 struct gcpro gcpro1, gcpro2;
2599 GCPRO2 (rest, results);
2600 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2602 Lisp_Object name, value, cons;
2608 CHECK_STRING (name);
2609 value = XCDR (cons);
2611 value = XCAR (value);
2612 value = Feval (value);
2615 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2617 ("Result from xpm-color-symbols eval must be nil, string, or color",
2619 results = Fcons (Fcons (name, value), results);
2621 UNGCPRO; /* no more evaluation */
2626 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2628 Lisp_Object file = Qnil;
2629 Lisp_Object color_symbols;
2630 struct gcpro gcpro1, gcpro2;
2631 Lisp_Object alist = Qnil;
2633 GCPRO2 (file, alist);
2635 /* Now, convert any file data into inline data. At the end of this,
2636 `data' will contain the inline data (if any) or Qnil, and
2637 `file' will contain the name this data was derived from (if
2640 Note that if we cannot generate any regular inline data, we
2643 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2646 if (CONSP (file)) /* failure locating filename */
2647 signal_double_file_error ("Opening pixmap file",
2648 "no such file or directory",
2651 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2654 if (NILP (file) && !UNBOUNDP (color_symbols))
2655 /* no conversion necessary */
2656 RETURN_UNGCPRO (inst);
2658 alist = tagged_vector_to_alist (inst);
2662 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2663 alist = remassq_no_quit (Q_file, alist);
2664 /* there can't be a :data at this point. */
2665 alist = Fcons (Fcons (Q_file, file),
2666 Fcons (Fcons (Q_data, data), alist));
2669 if (UNBOUNDP (color_symbols))
2671 color_symbols = evaluate_xpm_color_symbols ();
2672 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2677 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2679 RETURN_UNGCPRO (result);
2684 xpm_possible_dest_types (void)
2687 IMAGE_MONO_PIXMAP_MASK |
2688 IMAGE_COLOR_PIXMAP_MASK |
2692 #endif /* HAVE_XPM */
2695 /****************************************************************************
2696 * Image Specifier Object *
2697 ****************************************************************************/
2699 DEFINE_SPECIFIER_TYPE (image);
2702 image_create (Lisp_Object obj)
2704 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2706 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2707 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2708 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2712 image_mark (Lisp_Object obj)
2714 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2716 mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
2717 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2721 image_instantiate_cache_result (Lisp_Object locative)
2723 /* locative = (instance instantiator . subtable)
2725 So we are using the instantiator as the key and the instance as
2726 the value. Since the hashtable is key-weak this means that the
2727 image instance will stay around as long as the instantiator stays
2728 around. The instantiator is stored in the `image' slot of the
2729 glyph, so as long as the glyph is marked the instantiator will be
2730 as well and hence the cached image instance also.*/
2731 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2732 free_cons (XCONS (XCDR (locative)));
2733 free_cons (XCONS (locative));
2737 /* Given a specification for an image, return an instance of
2738 the image which matches the given instantiator and which can be
2739 displayed in the given domain. */
2742 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2743 Lisp_Object domain, Lisp_Object instantiator,
2746 Lisp_Object device = DFW_DEVICE (domain);
2747 struct device *d = XDEVICE (device);
2748 Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2749 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2750 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2752 if (IMAGE_INSTANCEP (instantiator))
2754 /* make sure that the image instance's device and type are
2757 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2760 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2761 if (mask & dest_mask)
2762 return instantiator;
2764 signal_simple_error ("Type of image instance not allowed here",
2768 signal_simple_error_2 ("Wrong device for image instance",
2769 instantiator, device);
2771 else if (VECTORP (instantiator)
2772 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2774 assert (XVECTOR_LENGTH (instantiator) == 3);
2775 return (FACE_PROPERTY_INSTANCE
2776 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2777 Qbackground_pixmap, domain, 0, depth));
2781 Lisp_Object instance;
2782 Lisp_Object subtable;
2783 Lisp_Object ls3 = Qnil;
2784 Lisp_Object pointer_fg = Qnil;
2785 Lisp_Object pointer_bg = Qnil;
2787 if (dest_mask & (IMAGE_SUBWINDOW_MASK
2791 if (!WINDOWP (domain))
2792 signal_simple_error ("Can't instantiate text or subwindow outside a window",
2794 else if ((dest_mask & (IMAGE_SUBWINDOW_MASK
2795 | IMAGE_WIDGET_MASK))
2796 && MINI_WINDOW_P (XWINDOW (domain)))
2797 domain = Fnext_window (domain, Qnil, Qnil, Qnil);
2802 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2803 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2804 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2807 /* First look in the hash table. */
2808 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2810 if (UNBOUNDP (subtable))
2812 /* For the image instance cache, we do comparisons with EQ rather
2813 than with EQUAL, as we do for color and font names.
2816 1) pixmap data can be very long, and thus the hashing and
2817 comparing will take awhile.
2818 2) It's not so likely that we'll run into things that are EQUAL
2819 but not EQ (that can happen a lot with faces, because their
2820 specifiers are copied around); but pixmaps tend not to be
2823 However, if the image-instance could be a pointer, we have to
2824 use EQUAL because we massaged the instantiator into a cons3
2825 also containing the foreground and background of the
2829 subtable = make_lisp_hash_table (20,
2830 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2831 : HASH_TABLE_KEY_WEAK,
2832 pointerp ? HASH_TABLE_EQUAL
2834 Fputhash (make_int (dest_mask), subtable,
2835 d->image_instance_cache);
2836 instance = Qunbound;
2840 instance = Fgethash (pointerp ? ls3 : instantiator,
2841 subtable, Qunbound);
2842 /* subwindows have a per-window cache and have to be treated
2843 differently. dest_mask can be a bitwise OR of all image
2844 types so we will only catch someone possibly trying to
2845 instantiate a subwindow type thing. Unfortunately, this
2846 will occur most of the time so this probably slows things
2847 down. But with the current design I don't see anyway
2849 if (UNBOUNDP (instance)
2851 dest_mask & (IMAGE_SUBWINDOW_MASK
2855 instance = Fgethash (instantiator,
2856 XWINDOW (domain)->subwindow_instance_cache,
2861 if (UNBOUNDP (instance))
2863 Lisp_Object locative =
2865 noseeum_cons (pointerp ? ls3 : instantiator,
2867 int speccount = specpdl_depth ();
2869 /* make sure we cache the failures, too.
2870 Use an unwind-protect to catch such errors.
2871 If we fail, the unwind-protect records nil in
2872 the hash table. If we succeed, we change the
2873 car of the locative to the resulting instance,
2874 which gets recorded instead. */
2875 record_unwind_protect (image_instantiate_cache_result,
2877 instance = instantiate_image_instantiator (device,
2880 pointer_fg, pointer_bg,
2884 Fsetcar (locative, instance);
2885 /* only after the image has been instantiated do we know
2886 whether we need to put it in the per-window image instance
2888 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2890 (IMAGE_SUBWINDOW_MASK
2892 | IMAGE_TEXT_MASK ))
2894 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache);
2896 unbind_to (speccount, Qnil);
2901 if (NILP (instance))
2902 signal_simple_error ("Can't instantiate image (probably cached)",
2908 return Qnil; /* not reached */
2911 /* Validate an image instantiator. */
2914 image_validate (Lisp_Object instantiator)
2916 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2918 else if (VECTORP (instantiator))
2920 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2921 int instantiator_len = XVECTOR_LENGTH (instantiator);
2922 struct image_instantiator_methods *meths;
2923 Lisp_Object already_seen = Qnil;
2924 struct gcpro gcpro1;
2927 if (instantiator_len < 1)
2928 signal_simple_error ("Vector length must be at least 1",
2931 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2932 if (!(instantiator_len & 1))
2934 ("Must have alternating keyword/value pairs", instantiator);
2936 GCPRO1 (already_seen);
2938 for (i = 1; i < instantiator_len; i += 2)
2940 Lisp_Object keyword = elt[i];
2941 Lisp_Object value = elt[i+1];
2944 CHECK_SYMBOL (keyword);
2945 if (!SYMBOL_IS_KEYWORD (keyword))
2946 signal_simple_error ("Symbol must begin with a colon", keyword);
2948 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2949 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2952 if (j == Dynarr_length (meths->keywords))
2953 signal_simple_error ("Unrecognized keyword", keyword);
2955 if (!Dynarr_at (meths->keywords, j).multiple_p)
2957 if (!NILP (memq_no_quit (keyword, already_seen)))
2959 ("Keyword may not appear more than once", keyword);
2960 already_seen = Fcons (keyword, already_seen);
2963 (Dynarr_at (meths->keywords, j).validate) (value);
2968 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2971 signal_simple_error ("Must be string or vector", instantiator);
2975 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2977 Lisp_Object attachee =
2978 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2979 Lisp_Object property =
2980 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2981 if (FACEP (attachee))
2982 face_property_was_changed (attachee, property, locale);
2983 else if (GLYPHP (attachee))
2984 glyph_property_was_changed (attachee, property, locale);
2988 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2989 Lisp_Object property)
2991 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2993 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2994 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2998 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2999 Lisp_Object tag_set, Lisp_Object instantiator)
3001 Lisp_Object possible_console_types = Qnil;
3003 Lisp_Object retlist = Qnil;
3004 struct gcpro gcpro1, gcpro2;
3006 LIST_LOOP (rest, Vconsole_type_list)
3008 Lisp_Object contype = XCAR (rest);
3009 if (!NILP (memq_no_quit (contype, tag_set)))
3010 possible_console_types = Fcons (contype, possible_console_types);
3013 if (XINT (Flength (possible_console_types)) > 1)
3014 /* two conflicting console types specified */
3017 if (NILP (possible_console_types))
3018 possible_console_types = Vconsole_type_list;
3020 GCPRO2 (retlist, possible_console_types);
3022 LIST_LOOP (rest, possible_console_types)
3024 Lisp_Object contype = XCAR (rest);
3025 Lisp_Object newinst = call_with_suspended_errors
3026 ((lisp_fn_t) normalize_image_instantiator,
3027 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
3028 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
3030 if (!NILP (newinst))
3033 if (NILP (memq_no_quit (contype, tag_set)))
3034 newtag = Fcons (contype, tag_set);
3037 retlist = Fcons (Fcons (newtag, newinst), retlist);
3046 /* Copy an image instantiator. We can't use Fcopy_tree since widgets
3047 may contain circular references which would send Fcopy_tree into
3050 image_copy_vector_instantiator (Lisp_Object instantiator)
3053 struct image_instantiator_methods *meths;
3055 int instantiator_len;
3057 CHECK_VECTOR (instantiator);
3059 instantiator = Fcopy_sequence (instantiator);
3060 elt = XVECTOR_DATA (instantiator);
3061 instantiator_len = XVECTOR_LENGTH (instantiator);
3063 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
3065 for (i = 1; i < instantiator_len; i += 2)
3068 Lisp_Object keyword = elt[i];
3069 Lisp_Object value = elt[i+1];
3071 /* Find the keyword entry. */
3072 for (j = 0; j < Dynarr_length (meths->keywords); j++)
3074 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
3078 /* Only copy keyword values that should be copied. */
3079 if (Dynarr_at (meths->keywords, j).copy_p
3081 (CONSP (value) || VECTORP (value)))
3083 elt [i+1] = Fcopy_tree (value, Qt);
3087 return instantiator;
3091 image_copy_instantiator (Lisp_Object arg)
3096 rest = arg = Fcopy_sequence (arg);
3097 while (CONSP (rest))
3099 Lisp_Object elt = XCAR (rest);
3101 XCAR (rest) = Fcopy_tree (elt, Qt);
3102 else if (VECTORP (elt))
3103 XCAR (rest) = image_copy_vector_instantiator (elt);
3104 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
3105 XCDR (rest) = Fcopy_tree (XCDR (rest), Qt);
3109 else if (VECTORP (arg))
3111 arg = image_copy_vector_instantiator (arg);
3116 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
3117 Return non-nil if OBJECT is an image specifier.
3119 An image specifier is used for images (pixmaps and the like). It is used
3120 to describe the actual image in a glyph. It is instanced as an image-
3123 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
3124 etc. This describes the format of the data describing the image. The
3125 resulting image instances also come in many types -- `mono-pixmap',
3126 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
3127 the image and the sorts of places it can appear. (For example, a
3128 color-pixmap image has fixed colors specified for it, while a
3129 mono-pixmap image comes in two unspecified shades "foreground" and
3130 "background" that are determined from the face of the glyph or
3131 surrounding text; a text image appears as a string of text and has an
3132 unspecified foreground, background, and font; a pointer image behaves
3133 like a mono-pixmap image but can only be used as a mouse pointer
3134 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
3135 important to keep the distinction between image instantiator format and
3136 image instance type in mind. Typically, a given image instantiator
3137 format can result in many different image instance types (for example,
3138 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
3139 whereas `cursor-font' can be instanced only as `pointer'), and a
3140 particular image instance type can be generated by many different
3141 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
3142 `gif', `jpeg', etc.).
3144 See `make-image-instance' for a more detailed discussion of image
3147 An image instantiator should be a string or a vector of the form
3149 [FORMAT :KEYWORD VALUE ...]
3151 i.e. a format symbol followed by zero or more alternating keyword-value
3152 pairs. FORMAT should be one of
3155 (Don't display anything; no keywords are valid for this.
3156 Can only be instanced as `nothing'.)
3158 (Display this image as a text string. Can only be instanced
3159 as `text', although support for instancing as `mono-pixmap'
3162 (Display this image as a text string, with replaceable fields;
3163 not currently implemented.)
3165 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
3166 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3168 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
3169 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
3171 (An X-Face bitmap, used to encode people's faces in e-mail messages;
3172 only if X-Face support was compiled into this XEmacs. Can be
3173 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3175 (A GIF87 or GIF89 image; only if GIF support was compiled into this
3176 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
3177 Can be instanced as `color-pixmap'.)
3179 (A JPEG image; only if JPEG support was compiled into this XEmacs.
3180 Can be instanced as `color-pixmap'.)
3182 (A PNG image; only if PNG support was compiled into this XEmacs.
3183 Can be instanced as `color-pixmap'.)
3185 (A TIFF image; only if TIFF support was compiled into this XEmacs.
3186 Can be instanced as `color-pixmap'.)
3188 (One of the standard cursor-font names, such as "watch" or
3189 "right_ptr" under X. Under X, this is, more specifically, any
3190 of the standard cursor names from appendix B of the Xlib manual
3191 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
3192 On other window systems, the valid names will be specific to the
3193 type of window system. Can only be instanced as `pointer'.)
3195 (A glyph from a font; i.e. the name of a font, and glyph index into it
3196 of the form "FONT fontname index [[mask-font] mask-index]".
3197 Currently can only be instanced as `pointer', although this should
3200 (An embedded windowing system window.)
3202 (A text editing widget glyph.)
3204 (A button widget glyph; either a push button, radio button or toggle button.)
3206 (A tab widget glyph; a series of user selectable tabs.)
3208 (A sliding widget glyph, for showing progress.)
3210 (A drop list of selectable items in a widget glyph, for editing text.)
3212 (A static, text-only, widget glyph; for displaying text.)
3214 (A folding widget glyph.)
3216 (XEmacs tries to guess what format the data is in. If X support
3217 exists, the data string will be checked to see if it names a filename.
3218 If so, and this filename contains XBM or XPM data, the appropriate
3219 sort of pixmap or pointer will be created. [This includes picking up
3220 any specified hotspot or associated mask file.] Otherwise, if `pointer'
3221 is one of the allowable image-instance types and the string names a
3222 valid cursor-font name, the image will be created as a pointer.
3223 Otherwise, the image will be displayed as text. If no X support
3224 exists, the image will always be displayed as text.)
3226 Inherit from the background-pixmap property of a face.
3228 The valid keywords are:
3231 (Inline data. For most formats above, this should be a string. For
3232 XBM images, this should be a list of three elements: width, height, and
3233 a string of bit data. This keyword is not valid for instantiator
3234 formats `nothing' and `inherit'.)
3236 (Data is contained in a file. The value is the name of this file.
3237 If both :data and :file are specified, the image is created from
3238 what is specified in :data and the string in :file becomes the
3239 value of the `image-instance-file-name' function when applied to
3240 the resulting image-instance. This keyword is not valid for
3241 instantiator formats `nothing', `string', `formatted-string',
3242 `cursor-font', `font', `autodetect', and `inherit'.)
3245 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
3246 allow you to explicitly specify foreground and background colors.
3247 The argument should be anything acceptable to `make-color-instance'.
3248 This will cause what would be a `mono-pixmap' to instead be colorized
3249 as a two-color color-pixmap, and specifies the foreground and/or
3250 background colors for a pointer instead of black and white.)
3252 (For `xbm' and `xface'. This specifies a mask to be used with the
3253 bitmap. The format is a list of width, height, and bits, like for
3256 (For `xbm' and `xface'. This specifies a file containing the mask data.
3257 If neither a mask file nor inline mask data is given for an XBM image,
3258 and the XBM image comes from a file, XEmacs will look for a mask file
3259 with the same name as the image file but with "Mask" or "msk"
3260 appended. For example, if you specify the XBM file "left_ptr"
3261 [usually located in "/usr/include/X11/bitmaps"], the associated
3262 mask file "left_ptrmsk" will automatically be picked up.)
3265 (For `xbm' and `xface'. These keywords specify a hotspot if the image
3266 is instantiated as a `pointer'. Note that if the XBM image file
3267 specifies a hotspot, it will automatically be picked up if no
3268 explicit hotspot is given.)
3270 (Only for `xpm'. This specifies an alist that maps strings
3271 that specify symbolic color names to the actual color to be used
3272 for that symbolic color (in the form of a string or a color-specifier
3273 object). If this is not specified, the contents of `xpm-color-symbols'
3274 are used to generate the alist.)
3276 (Only for `inherit'. This specifies the face to inherit from.
3277 For widget glyphs this also specifies the face to use for
3278 display. It defaults to gui-element-face.)
3280 Keywords accepted as menu item specs are also accepted by widget
3281 glyphs. These are `:selected', `:active', `:suffix', `:keys',
3282 `:style', `:filter', `:config', `:included', `:key-sequence',
3283 `:accelerator', `:label' and `:callback'.
3285 If instead of a vector, the instantiator is a string, it will be
3286 converted into a vector by looking it up according to the specs in the
3287 `console-type-image-conversion-list' (q.v.) for the console type of
3288 the domain (usually a window; sometimes a frame or device) over which
3289 the image is being instantiated.
3291 If the instantiator specifies data from a file, the data will be read
3292 in at the time that the instantiator is added to the image (which may
3293 be well before when the image is actually displayed), and the
3294 instantiator will be converted into one of the inline-data forms, with
3295 the filename retained using a :file keyword. This implies that the
3296 file must exist when the instantiator is added to the image, but does
3297 not need to exist at any other time (e.g. it may safely be a temporary
3302 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
3306 /****************************************************************************
3308 ****************************************************************************/
3311 mark_glyph (Lisp_Object obj)
3313 Lisp_Glyph *glyph = XGLYPH (obj);
3315 mark_object (glyph->image);
3316 mark_object (glyph->contrib_p);
3317 mark_object (glyph->baseline);
3318 mark_object (glyph->face);
3320 return glyph->plist;
3324 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3326 Lisp_Glyph *glyph = XGLYPH (obj);
3330 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
3332 write_c_string ("#<glyph (", printcharfun);
3333 print_internal (Fglyph_type (obj), printcharfun, 0);
3334 write_c_string (") ", printcharfun);
3335 print_internal (glyph->image, printcharfun, 1);
3336 sprintf (buf, "0x%x>", glyph->header.uid);
3337 write_c_string (buf, printcharfun);
3340 /* Glyphs are equal if all of their display attributes are equal. We
3341 don't compare names or doc-strings, because that would make equal
3344 This isn't concerned with "unspecified" attributes, that's what
3345 #'glyph-differs-from-default-p is for. */
3347 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3349 Lisp_Glyph *g1 = XGLYPH (obj1);
3350 Lisp_Glyph *g2 = XGLYPH (obj2);
3354 return (internal_equal (g1->image, g2->image, depth) &&
3355 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
3356 internal_equal (g1->baseline, g2->baseline, depth) &&
3357 internal_equal (g1->face, g2->face, depth) &&
3358 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
3361 static unsigned long
3362 glyph_hash (Lisp_Object obj, int depth)
3366 /* No need to hash all of the elements; that would take too long.
3367 Just hash the most common ones. */
3368 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
3369 internal_hash (XGLYPH (obj)->face, depth));
3373 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
3375 Lisp_Glyph *g = XGLYPH (obj);
3377 if (EQ (prop, Qimage)) return g->image;
3378 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
3379 if (EQ (prop, Qbaseline)) return g->baseline;
3380 if (EQ (prop, Qface)) return g->face;
3382 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
3386 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3388 if (EQ (prop, Qimage) ||
3389 EQ (prop, Qcontrib_p) ||
3390 EQ (prop, Qbaseline))
3393 if (EQ (prop, Qface))
3395 XGLYPH (obj)->face = Fget_face (value);
3399 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
3404 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
3406 if (EQ (prop, Qimage) ||
3407 EQ (prop, Qcontrib_p) ||
3408 EQ (prop, Qbaseline))
3411 if (EQ (prop, Qface))
3413 XGLYPH (obj)->face = Qnil;
3417 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
3421 glyph_plist (Lisp_Object obj)
3423 Lisp_Glyph *glyph = XGLYPH (obj);
3424 Lisp_Object result = glyph->plist;
3426 result = cons3 (Qface, glyph->face, result);
3427 result = cons3 (Qbaseline, glyph->baseline, result);
3428 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
3429 result = cons3 (Qimage, glyph->image, result);
3434 static const struct lrecord_description glyph_description[] = {
3435 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) },
3436 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) },
3437 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) },
3438 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) },
3439 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) },
3443 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
3444 mark_glyph, print_glyph, 0,
3445 glyph_equal, glyph_hash, glyph_description,
3446 glyph_getprop, glyph_putprop,
3447 glyph_remprop, glyph_plist,
3451 allocate_glyph (enum glyph_type type,
3452 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
3453 Lisp_Object locale))
3455 /* This function can GC */
3456 Lisp_Object obj = Qnil;
3457 Lisp_Glyph *g = alloc_lcrecord_type (Lisp_Glyph, &lrecord_glyph);
3460 g->image = Fmake_specifier (Qimage); /* This function can GC */
3465 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3466 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
3467 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
3468 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK
3469 | IMAGE_LAYOUT_MASK;
3472 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3473 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
3476 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3477 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK
3478 | IMAGE_COLOR_PIXMAP_MASK;
3484 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
3485 /* We're getting enough reports of odd behavior in this area it seems */
3486 /* best to GCPRO everything. */
3488 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3489 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3490 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3491 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3493 GCPRO4 (obj, tem1, tem2, tem3);
3495 set_specifier_fallback (g->image, tem1);
3496 g->contrib_p = Fmake_specifier (Qboolean);
3497 set_specifier_fallback (g->contrib_p, tem2);
3498 /* #### should have a specifier for the following */
3499 g->baseline = Fmake_specifier (Qgeneric);
3500 set_specifier_fallback (g->baseline, tem3);
3503 g->after_change = after_change;
3506 set_image_attached_to (g->image, obj, Qimage);
3513 static enum glyph_type
3514 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3517 return GLYPH_BUFFER;
3519 if (ERRB_EQ (errb, ERROR_ME))
3520 CHECK_SYMBOL (type);
3522 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3523 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3524 if (EQ (type, Qicon)) return GLYPH_ICON;
3526 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3528 return GLYPH_UNKNOWN;
3532 valid_glyph_type_p (Lisp_Object type)
3534 return !NILP (memq_no_quit (type, Vglyph_type_list));
3537 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3538 Given a GLYPH-TYPE, return non-nil if it is valid.
3539 Valid types are `buffer', `pointer', and `icon'.
3543 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3546 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3547 Return a list of valid glyph types.
3551 return Fcopy_sequence (Vglyph_type_list);
3554 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3555 Create and return a new uninitialized glyph or type TYPE.
3557 TYPE specifies the type of the glyph; this should be one of `buffer',
3558 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3559 specifies in which contexts the glyph can be used, and controls the
3560 allowable image types into which the glyph's image can be
3563 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3564 extent, in the modeline, and in the toolbar. Their image can be
3565 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3568 `pointer' glyphs can be used to specify the mouse pointer. Their
3569 image can be instantiated as `pointer'.
3571 `icon' glyphs can be used to specify the icon used when a frame is
3572 iconified. Their image can be instantiated as `mono-pixmap' and
3577 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3578 return allocate_glyph (typeval, 0);
3581 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3582 Return non-nil if OBJECT is a glyph.
3584 A glyph is an object used for pixmaps and the like. It is used
3585 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3586 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3587 buttons, and the like. Its image is described using an image specifier --
3588 see `image-specifier-p'.
3592 return GLYPHP (object) ? Qt : Qnil;
3595 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3596 Return the type of the given glyph.
3597 The return value will be one of 'buffer, 'pointer, or 'icon.
3601 CHECK_GLYPH (glyph);
3602 switch (XGLYPH_TYPE (glyph))
3605 case GLYPH_BUFFER: return Qbuffer;
3606 case GLYPH_POINTER: return Qpointer;
3607 case GLYPH_ICON: return Qicon;
3612 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3613 Error_behavior errb, int no_quit)
3615 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3617 /* This can never return Qunbound. All glyphs have 'nothing as
3619 Lisp_Object image_instance = specifier_instance (specifier, Qunbound,
3620 domain, errb, no_quit, 0,
3622 assert (!UNBOUNDP (image_instance));
3624 return image_instance;
3628 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window)
3630 Lisp_Object instance = glyph_or_image;
3632 if (GLYPHP (glyph_or_image))
3633 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3638 /*****************************************************************************
3641 Return the width of the given GLYPH on the given WINDOW.
3642 Calculations are done based on recursively querying the geometry of
3643 the associated image instances.
3644 ****************************************************************************/
3646 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain)
3648 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3650 if (!IMAGE_INSTANCEP (instance))
3653 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3654 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3655 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3657 return XIMAGE_INSTANCE_WIDTH (instance);
3660 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3661 Return the width of GLYPH on WINDOW.
3662 This may not be exact as it does not take into account all of the context
3663 that redisplay will.
3667 XSETWINDOW (window, decode_window (window));
3668 CHECK_GLYPH (glyph);
3670 return make_int (glyph_width (glyph, window));
3674 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain)
3676 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3678 if (!IMAGE_INSTANCEP (instance))
3681 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3682 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3683 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3685 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3686 return XIMAGE_INSTANCE_TEXT_ASCENT (instance);
3688 return XIMAGE_INSTANCE_HEIGHT (instance);
3692 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain)
3694 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3696 if (!IMAGE_INSTANCEP (instance))
3699 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3700 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3701 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3703 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3704 return XIMAGE_INSTANCE_TEXT_DESCENT (instance);
3709 /* strictly a convenience function. */
3711 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain)
3713 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3716 if (!IMAGE_INSTANCEP (instance))
3719 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3720 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3721 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3723 return XIMAGE_INSTANCE_HEIGHT (instance);
3726 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3727 Return the ascent value of GLYPH on WINDOW.
3728 This may not be exact as it does not take into account all of the context
3729 that redisplay will.
3733 XSETWINDOW (window, decode_window (window));
3734 CHECK_GLYPH (glyph);
3736 return make_int (glyph_ascent (glyph, window));
3739 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3740 Return the descent value of GLYPH on WINDOW.
3741 This may not be exact as it does not take into account all of the context
3742 that redisplay will.
3746 XSETWINDOW (window, decode_window (window));
3747 CHECK_GLYPH (glyph);
3749 return make_int (glyph_descent (glyph, window));
3752 /* This is redundant but I bet a lot of people expect it to exist. */
3753 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3754 Return the height of GLYPH on WINDOW.
3755 This may not be exact as it does not take into account all of the context
3756 that redisplay will.
3760 XSETWINDOW (window, decode_window (window));
3761 CHECK_GLYPH (glyph);
3763 return make_int (glyph_height (glyph, window));
3767 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty)
3769 Lisp_Object instance = glyph_or_image;
3771 if (!NILP (glyph_or_image))
3773 if (GLYPHP (glyph_or_image))
3775 instance = glyph_image_instance (glyph_or_image, window,
3777 XGLYPH_DIRTYP (glyph_or_image) = dirty;
3780 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
3785 set_image_instance_dirty_p (Lisp_Object instance, int dirty)
3787 if (IMAGE_INSTANCEP (instance))
3789 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
3790 /* Now cascade up the hierarchy. */
3791 set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance),
3794 else if (GLYPHP (instance))
3796 XGLYPH_DIRTYP (instance) = dirty;
3800 /* #### do we need to cache this info to speed things up? */
3803 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3805 if (!GLYPHP (glyph))
3809 Lisp_Object retval =
3810 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3811 /* #### look into ERROR_ME_NOT */
3812 Qunbound, domain, ERROR_ME_NOT,
3814 if (!NILP (retval) && !INTP (retval))
3816 else if (INTP (retval))
3818 if (XINT (retval) < 0)
3820 if (XINT (retval) > 100)
3821 retval = make_int (100);
3828 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3830 /* #### Domain parameter not currently used but it will be */
3831 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3835 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3837 if (!GLYPHP (glyph))
3840 return !NILP (specifier_instance_no_quit
3841 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3842 /* #### look into ERROR_ME_NOT */
3843 ERROR_ME_NOT, 0, Qzero));
3847 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3850 if (XGLYPH (glyph)->after_change)
3851 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3854 #if 0 /* Not used for now */
3856 glyph_query_geometry (Lisp_Object glyph_or_image, Lisp_Object window,
3857 unsigned int* width, unsigned int* height,
3858 enum image_instance_geometry disp, Lisp_Object domain)
3860 Lisp_Object instance = glyph_or_image;
3862 if (GLYPHP (glyph_or_image))
3863 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3865 image_instance_query_geometry (instance, width, height, disp, domain);
3869 glyph_layout (Lisp_Object glyph_or_image, Lisp_Object window,
3870 unsigned int width, unsigned int height, Lisp_Object domain)
3872 Lisp_Object instance = glyph_or_image;
3874 if (GLYPHP (glyph_or_image))
3875 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3877 image_instance_layout (instance, width, height, domain);
3882 /*****************************************************************************
3883 * glyph cachel functions *
3884 *****************************************************************************/
3886 /* #### All of this is 95% copied from face cachels. Consider
3889 Why do we need glyph_cachels? Simply because a glyph_cachel captures
3890 per-window information about a particular glyph. A glyph itself is
3891 not created in any particular context, so if we were to rely on a
3892 glyph to tell us about its dirtiness we would not be able to reset
3893 the dirty flag after redisplaying it as it may exist in other
3894 contexts. When we have redisplayed we need to know which glyphs to
3895 reset the dirty flags on - the glyph_cachels give us a nice list we
3896 can iterate through doing this. */
3898 mark_glyph_cachels (glyph_cachel_dynarr *elements)
3905 for (elt = 0; elt < Dynarr_length (elements); elt++)
3907 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3908 mark_object (cachel->glyph);
3913 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3914 struct glyph_cachel *cachel)
3916 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)
3917 || XGLYPH_DIRTYP (cachel->glyph)
3918 || XFRAME(WINDOW_FRAME(w))->faces_changed)
3920 Lisp_Object window, instance;
3922 XSETWINDOW (window, w);
3924 cachel->glyph = glyph;
3925 /* Speed things up slightly by grabbing the glyph instantiation
3926 and passing it to the size functions. */
3927 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3929 /* Mark text instance of the glyph dirty if faces have changed,
3930 because its geometry might have changed. */
3931 invalidate_glyph_geometry_maybe (instance, w);
3933 /* #### Do the following 2 lines buy us anything? --kkm */
3934 XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance);
3935 cachel->dirty = XGLYPH_DIRTYP (glyph);
3936 cachel->width = glyph_width (instance, window);
3937 cachel->ascent = glyph_ascent (instance, window);
3938 cachel->descent = glyph_descent (instance, window);
3941 cachel->updated = 1;
3945 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3947 struct glyph_cachel new_cachel;
3950 new_cachel.glyph = Qnil;
3952 update_glyph_cachel_data (w, glyph, &new_cachel);
3953 Dynarr_add (w->glyph_cachels, new_cachel);
3957 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3964 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3966 struct glyph_cachel *cachel =
3967 Dynarr_atp (w->glyph_cachels, elt);
3969 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3971 update_glyph_cachel_data (w, glyph, cachel);
3976 /* If we didn't find the glyph, add it and then return its index. */
3977 add_glyph_cachel (w, glyph);
3982 reset_glyph_cachels (struct window *w)
3984 Dynarr_reset (w->glyph_cachels);
3985 get_glyph_cachel_index (w, Vcontinuation_glyph);
3986 get_glyph_cachel_index (w, Vtruncation_glyph);
3987 get_glyph_cachel_index (w, Vhscroll_glyph);
3988 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3989 get_glyph_cachel_index (w, Voctal_escape_glyph);
3990 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3994 mark_glyph_cachels_as_not_updated (struct window *w)
3998 /* We need to have a dirty flag to tell if the glyph has changed.
3999 We can check to see if each glyph variable is actually a
4000 completely different glyph, though. */
4001 #define FROB(glyph_obj, gindex) \
4002 update_glyph_cachel_data (w, glyph_obj, \
4003 Dynarr_atp (w->glyph_cachels, gindex))
4005 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
4006 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
4007 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
4008 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
4009 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
4010 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
4013 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4015 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
4019 /* Unset the dirty bit on all the glyph cachels that have it. */
4021 mark_glyph_cachels_as_clean (struct window* w)
4025 XSETWINDOW (window, w);
4026 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4028 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt);
4030 set_glyph_dirty_p (cachel->glyph, window, 0);
4034 #ifdef MEMORY_USAGE_STATS
4037 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
4038 struct overhead_stats *ovstats)
4043 total += Dynarr_memory_usage (glyph_cachels, ovstats);
4048 #endif /* MEMORY_USAGE_STATS */
4052 /*****************************************************************************
4053 * subwindow cachel functions *
4054 *****************************************************************************/
4055 /* Subwindows are curious in that you have to physically unmap them to
4056 not display them. It is problematic deciding what to do in
4057 redisplay. We have two caches - a per-window instance cache that
4058 keeps track of subwindows on a window, these are linked to their
4059 instantiator in the hashtable and when the instantiator goes away
4060 we want the instance to go away also. However we also have a
4061 per-frame instance cache that we use to determine if a subwindow is
4062 obscuring an area that we want to clear. We need to be able to flip
4063 through this quickly so a hashtable is not suitable hence the
4064 subwindow_cachels. The question is should we just not mark
4065 instances in the subwindow_cachels or should we try and invalidate
4066 the cache at suitable points in redisplay? If we don't invalidate
4067 the cache it will fill up with crud that will only get removed when
4068 the frame is deleted. So invalidation is good, the question is when
4069 and whether we mark as well. Go for the simple option - don't mark,
4070 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
4073 mark_subwindow_cachels (subwindow_cachel_dynarr *elements)
4080 for (elt = 0; elt < Dynarr_length (elements); elt++)
4082 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
4083 mark_object (cachel->subwindow);
4088 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
4089 struct subwindow_cachel *cachel)
4091 cachel->subwindow = subwindow;
4092 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
4093 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
4094 cachel->updated = 1;
4098 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
4100 struct subwindow_cachel new_cachel;
4103 new_cachel.subwindow = Qnil;
4106 new_cachel.being_displayed=0;
4108 update_subwindow_cachel_data (f, subwindow, &new_cachel);
4109 Dynarr_add (f->subwindow_cachels, new_cachel);
4113 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
4120 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4122 struct subwindow_cachel *cachel =
4123 Dynarr_atp (f->subwindow_cachels, elt);
4125 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
4127 if (!cachel->updated)
4128 update_subwindow_cachel_data (f, subwindow, cachel);
4133 /* If we didn't find the glyph, add it and then return its index. */
4134 add_subwindow_cachel (f, subwindow);
4139 update_subwindow_cachel (Lisp_Object subwindow)
4144 if (NILP (subwindow))
4147 f = XFRAME ( XIMAGE_INSTANCE_SUBWINDOW_FRAME (subwindow));
4149 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4151 struct subwindow_cachel *cachel =
4152 Dynarr_atp (f->subwindow_cachels, elt);
4154 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
4156 update_subwindow_cachel_data (f, subwindow, cachel);
4161 /* redisplay in general assumes that drawing something will erase
4162 what was there before. unfortunately this does not apply to
4163 subwindows that need to be specifically unmapped in order to
4164 disappear. we take a brute force approach - on the basis that its
4165 cheap - and unmap all subwindows in a display line */
4167 reset_subwindow_cachels (struct frame *f)
4170 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4172 struct subwindow_cachel *cachel =
4173 Dynarr_atp (f->subwindow_cachels, elt);
4175 if (!NILP (cachel->subwindow) && cachel->being_displayed)
4177 cachel->updated = 1;
4178 /* #### This is not optimal as update_subwindow will search
4179 the cachels for ourselves as well. We could easily optimize. */
4180 unmap_subwindow (cachel->subwindow);
4183 Dynarr_reset (f->subwindow_cachels);
4187 mark_subwindow_cachels_as_not_updated (struct frame *f)
4191 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4192 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
4197 /*****************************************************************************
4198 * subwindow exposure ignorance *
4199 *****************************************************************************/
4200 /* when we unmap subwindows the associated window system will generate
4201 expose events. This we do not want as redisplay already copes with
4202 the repainting necessary. Worse, we can get in an endless cycle of
4203 redisplay if we are not careful. Thus we keep a per-frame list of
4204 expose events that are going to come and ignore them as
4207 struct expose_ignore_blocktype
4209 Blocktype_declare (struct expose_ignore);
4210 } *the_expose_ignore_blocktype;
4213 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
4215 struct expose_ignore *ei, *prev;
4216 /* the ignore list is FIFO so we should generally get a match with
4217 the first element in the list */
4218 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next)
4220 /* Checking for exact matches just isn't good enough as we
4221 mighte get exposures for partially obscure subwindows, thus
4222 we have to check for overlaps. Being conservative we will
4223 check for exposures wholly contained by the subwindow, this
4224 might give us what we want.*/
4225 if (ei->x <= x && ei->y <= y
4226 && ei->x + ei->width >= x + width
4227 && ei->y + ei->height >= y + height)
4229 #ifdef DEBUG_WIDGETS
4230 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n",
4231 x, y, width, height, ei->x, ei->y, ei->width, ei->height);
4234 f->subwindow_exposures = ei->next;
4236 prev->next = ei->next;
4238 if (ei == f->subwindow_exposures_tail)
4239 f->subwindow_exposures_tail = prev;
4241 Blocktype_free (the_expose_ignore_blocktype, ei);
4250 register_ignored_expose (struct frame* f, int x, int y, int width, int height)
4252 if (!hold_ignored_expose_registration)
4254 struct expose_ignore *ei;
4256 ei = Blocktype_alloc (the_expose_ignore_blocktype);
4262 ei->height = height;
4264 /* we have to add the exposure to the end of the list, since we
4265 want to check the oldest events first. for speed we keep a record
4266 of the end so that we can add right to it. */
4267 if (f->subwindow_exposures_tail)
4269 f->subwindow_exposures_tail->next = ei;
4271 if (!f->subwindow_exposures)
4273 f->subwindow_exposures = ei;
4275 f->subwindow_exposures_tail = ei;
4279 /****************************************************************************
4280 find_matching_subwindow
4282 See if there is a subwindow that completely encloses the requested
4284 ****************************************************************************/
4285 int find_matching_subwindow (struct frame* f, int x, int y, int width, int height)
4289 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4291 struct subwindow_cachel *cachel =
4292 Dynarr_atp (f->subwindow_cachels, elt);
4294 if (cachel->being_displayed
4296 cachel->x <= x && cachel->y <= y
4298 cachel->x + cachel->width >= x + width
4300 cachel->y + cachel->height >= y + height)
4309 /*****************************************************************************
4310 * subwindow functions *
4311 *****************************************************************************/
4313 /* Update the displayed characteristics of a subwindow. This function
4314 should generally only get called if the subwindow is actually
4317 update_subwindow (Lisp_Object subwindow)
4319 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4320 int count = specpdl_depth ();
4321 unsigned long display_hash = internal_hash (subwindow,
4322 IMAGE_INSTANCE_HASH_DEPTH);
4324 /* The update method is allowed to call eval. Since it is quite
4325 common for this function to get called from somewhere in
4326 redisplay we need to make sure that quits are ignored. Otherwise
4327 Fsignal will abort. */
4328 specbind (Qinhibit_quit, Qt);
4330 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4332 IMAGE_INSTANCE_TYPE (ii) == IMAGE_LAYOUT)
4334 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4336 (display_hash != IMAGE_INSTANCE_DISPLAY_HASH (ii)
4338 IMAGE_INSTANCE_DISPLAY_HASH (ii) == 0))
4340 update_widget (subwindow);
4342 /* Reset the changed flags. */
4343 IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0;
4344 IMAGE_INSTANCE_WIDGET_PERCENT_CHANGED (ii) = 0;
4345 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0;
4346 IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0;
4348 else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW
4350 !NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4352 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
4355 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0;
4356 /* This function is typically called by redisplay just before
4357 outputting the information to the screen. Thus we record a hash
4358 of the output to determine whether on-screen is the same as
4359 recorded structure. This approach has limitations in there is a
4360 good chance that hash values will be different for the same
4361 visual appearance. However, we would rather that then the other
4362 way round - it simply means that we will get more displays than
4363 we might need. We can get better hashing by making the depth
4364 negative - currently it will recurse down 5 levels.*/
4365 IMAGE_INSTANCE_DISPLAY_HASH (ii) = display_hash;
4367 unbind_to (count, Qnil);
4370 /* Update all the subwindows on a frame. */
4371 DEFUN ("update-widget-instances", Fupdate_widget_instances,1, 1, 0, /*
4372 Given a FRAME, re-evaluate the display hash code for all widgets in the frame.
4379 CHECK_FRAME (frame);
4382 /* If we get called we know something has changed. */
4383 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4385 struct subwindow_cachel *cachel =
4386 Dynarr_atp (f->subwindow_cachels, elt);
4388 if (cachel->being_displayed &&
4389 XIMAGE_INSTANCE_TYPE (cachel->subwindow)
4392 /* If a subwindow hash changed mark it so that redisplay
4394 if (internal_hash (cachel->subwindow,
4395 IMAGE_INSTANCE_HASH_DEPTH) !=
4396 XIMAGE_INSTANCE_DISPLAY_HASH (cachel->subwindow))
4398 set_image_instance_dirty_p (cachel->subwindow, 1);
4399 MARK_FRAME_GLYPHS_CHANGED (f);
4406 /* remove a subwindow from its frame */
4407 void unmap_subwindow (Lisp_Object subwindow)
4409 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4411 struct subwindow_cachel* cachel;
4414 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4416 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4418 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4420 #ifdef DEBUG_WIDGETS
4421 stderr_out ("unmapping subwindow %d\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
4423 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4424 elt = get_subwindow_cachel_index (f, subwindow);
4425 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4427 /* make sure we don't get expose events */
4428 register_ignored_expose (f, cachel->x, cachel->y, cachel->width, cachel->height);
4431 cachel->being_displayed = 0;
4432 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4434 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
4437 /* show a subwindow in its frame */
4438 void map_subwindow (Lisp_Object subwindow, int x, int y,
4439 struct display_glyph_area *dga)
4441 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4443 struct subwindow_cachel* cachel;
4446 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4448 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4450 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4453 #ifdef DEBUG_WIDGETS
4454 stderr_out ("mapping subwindow %d, %dx%d@%d+%d\n",
4455 IMAGE_INSTANCE_SUBWINDOW_ID (ii),
4456 dga->width, dga->height, x, y);
4458 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4459 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
4460 elt = get_subwindow_cachel_index (f, subwindow);
4461 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4464 cachel->width = dga->width;
4465 cachel->height = dga->height;
4466 cachel->being_displayed = 1;
4468 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y, dga));
4472 subwindow_possible_dest_types (void)
4474 return IMAGE_SUBWINDOW_MASK;
4477 /* Partially instantiate a subwindow. */
4479 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
4480 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
4481 int dest_mask, Lisp_Object domain)
4483 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
4484 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
4485 Lisp_Object frame = FW_FRAME (domain);
4486 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
4487 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
4490 signal_simple_error ("No selected frame", device);
4492 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
4493 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
4496 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
4497 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4498 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
4500 /* #### This stuff may get overidden by the widget code and is
4501 actually really dumb now that we have dynamic geometry
4502 calculations. What should really happen is that the subwindow
4503 should query its child for an appropriate geometry. */
4507 if (XINT (width) > 1)
4509 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
4512 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
4517 if (XINT (height) > 1)
4519 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
4522 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
4525 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
4526 Return non-nil if OBJECT is a subwindow.
4530 CHECK_IMAGE_INSTANCE (object);
4531 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
4534 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
4535 Return the window id of SUBWINDOW as a number.
4539 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4540 return make_int ((int) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow));
4543 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
4544 Resize SUBWINDOW to WIDTH x HEIGHT.
4545 If a value is nil that parameter is not changed.
4547 (subwindow, width, height))
4550 Lisp_Image_Instance* ii;
4552 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4553 ii = XIMAGE_INSTANCE (subwindow);
4556 neww = IMAGE_INSTANCE_WIDTH (ii);
4558 neww = XINT (width);
4561 newh = IMAGE_INSTANCE_HEIGHT (ii);
4563 newh = XINT (height);
4565 /* The actual resizing gets done asychronously by
4566 update_subwindow. */
4567 IMAGE_INSTANCE_HEIGHT (ii) = newh;
4568 IMAGE_INSTANCE_WIDTH (ii) = neww;
4569 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
4571 /* need to update the cachels as redisplay will not do this */
4572 update_subwindow_cachel (subwindow);
4577 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
4578 Generate a Map event for SUBWINDOW.
4582 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4584 map_subwindow (subwindow, 0, 0);
4590 /*****************************************************************************
4592 *****************************************************************************/
4594 /* Get the display tables for use currently on window W with face
4595 FACE. #### This will have to be redone. */
4598 get_display_tables (struct window *w, face_index findex,
4599 Lisp_Object *face_table, Lisp_Object *window_table)
4602 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
4606 tem = noseeum_cons (tem, Qnil);
4608 tem = w->display_table;
4612 tem = noseeum_cons (tem, Qnil);
4613 *window_table = tem;
4617 display_table_entry (Emchar ch, Lisp_Object face_table,
4618 Lisp_Object window_table)
4622 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
4623 for (tail = face_table; 1; tail = XCDR (tail))
4628 if (!NILP (window_table))
4630 tail = window_table;
4631 window_table = Qnil;
4636 table = XCAR (tail);
4638 if (VECTORP (table))
4640 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
4641 return XVECTOR_DATA (table)[ch];
4645 else if (CHAR_TABLEP (table)
4646 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
4648 return get_char_table (ch, XCHAR_TABLE (table));
4650 else if (CHAR_TABLEP (table)
4651 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
4653 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
4659 else if (RANGE_TABLEP (table))
4661 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
4672 /*****************************************************************************
4673 * timeouts for animated glyphs *
4674 *****************************************************************************/
4675 static Lisp_Object Qglyph_animated_timeout_handler;
4677 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /*
4678 Callback function for updating animated images.
4683 CHECK_WEAK_LIST (arg);
4685 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg))))
4687 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg));
4689 if (IMAGE_INSTANCEP (value))
4691 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value);
4693 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value)
4695 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1
4697 !disable_animated_pixmaps)
4699 /* Increment the index of the image slice we are currently
4701 IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
4702 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
4703 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
4704 /* We might need to kick redisplay at this point - but we
4706 MARK_DEVICE_FRAMES_GLYPHS_CHANGED
4707 (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)));
4708 /* Cascade dirtiness so that we can have an animated glyph in a layout
4710 set_image_instance_dirty_p (value, 1);
4717 Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image)
4719 Lisp_Object ret = Qnil;
4721 if (tickms > 0 && IMAGE_INSTANCEP (image))
4723 double ms = ((double)tickms) / 1000.0;
4724 struct gcpro gcpro1;
4725 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE);
4728 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil);
4730 ret = Fadd_timeout (make_float (ms),
4731 Qglyph_animated_timeout_handler,
4732 holder, make_float (ms));
4739 void disable_glyph_animated_timeout (int i)
4744 Fdisable_timeout (id);
4748 /*****************************************************************************
4750 *****************************************************************************/
4753 syms_of_glyphs (void)
4755 INIT_LRECORD_IMPLEMENTATION (glyph);
4756 INIT_LRECORD_IMPLEMENTATION (image_instance);
4758 /* image instantiators */
4760 DEFSUBR (Fimage_instantiator_format_list);
4761 DEFSUBR (Fvalid_image_instantiator_format_p);
4762 DEFSUBR (Fset_console_type_image_conversion_list);
4763 DEFSUBR (Fconsole_type_image_conversion_list);
4764 DEFSUBR (Fupdate_widget_instances);
4766 defkeyword (&Q_file, ":file");
4767 defkeyword (&Q_data, ":data");
4768 defkeyword (&Q_face, ":face");
4769 defkeyword (&Q_pixel_height, ":pixel-height");
4770 defkeyword (&Q_pixel_width, ":pixel-width");
4773 defkeyword (&Q_color_symbols, ":color-symbols");
4775 #ifdef HAVE_WINDOW_SYSTEM
4776 defkeyword (&Q_mask_file, ":mask-file");
4777 defkeyword (&Q_mask_data, ":mask-data");
4778 defkeyword (&Q_hotspot_x, ":hotspot-x");
4779 defkeyword (&Q_hotspot_y, ":hotspot-y");
4780 defkeyword (&Q_foreground, ":foreground");
4781 defkeyword (&Q_background, ":background");
4783 /* image specifiers */
4785 DEFSUBR (Fimage_specifier_p);
4786 /* Qimage in general.c */
4788 /* image instances */
4790 defsymbol (&Qimage_instancep, "image-instance-p");
4792 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
4793 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
4794 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
4795 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
4796 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
4797 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
4798 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
4799 defsymbol (&Qlayout_image_instance_p, "layout-image-instance-p");
4800 defsymbol (&Qupdate_widget_instances, "update-widget-instances");
4802 DEFSUBR (Fmake_image_instance);
4803 DEFSUBR (Fimage_instance_p);
4804 DEFSUBR (Fimage_instance_type);
4805 DEFSUBR (Fvalid_image_instance_type_p);
4806 DEFSUBR (Fimage_instance_type_list);
4807 DEFSUBR (Fimage_instance_name);
4808 DEFSUBR (Fimage_instance_string);
4809 DEFSUBR (Fimage_instance_file_name);
4810 DEFSUBR (Fimage_instance_mask_file_name);
4811 DEFSUBR (Fimage_instance_depth);
4812 DEFSUBR (Fimage_instance_height);
4813 DEFSUBR (Fimage_instance_width);
4814 DEFSUBR (Fimage_instance_hotspot_x);
4815 DEFSUBR (Fimage_instance_hotspot_y);
4816 DEFSUBR (Fimage_instance_foreground);
4817 DEFSUBR (Fimage_instance_background);
4818 DEFSUBR (Fimage_instance_property);
4819 DEFSUBR (Fset_image_instance_property);
4820 DEFSUBR (Fcolorize_image_instance);
4822 DEFSUBR (Fsubwindowp);
4823 DEFSUBR (Fimage_instance_subwindow_id);
4824 DEFSUBR (Fresize_subwindow);
4825 DEFSUBR (Fforce_subwindow_map);
4827 /* Qnothing defined as part of the "nothing" image-instantiator
4829 /* Qtext defined in general.c */
4830 defsymbol (&Qmono_pixmap, "mono-pixmap");
4831 defsymbol (&Qcolor_pixmap, "color-pixmap");
4832 /* Qpointer defined in general.c */
4836 defsymbol (&Qglyphp, "glyphp");
4837 defsymbol (&Qcontrib_p, "contrib-p");
4838 defsymbol (&Qbaseline, "baseline");
4840 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4841 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4842 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4844 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4846 DEFSUBR (Fglyph_type);
4847 DEFSUBR (Fvalid_glyph_type_p);
4848 DEFSUBR (Fglyph_type_list);
4850 DEFSUBR (Fmake_glyph_internal);
4851 DEFSUBR (Fglyph_width);
4852 DEFSUBR (Fglyph_ascent);
4853 DEFSUBR (Fglyph_descent);
4854 DEFSUBR (Fglyph_height);
4856 /* Qbuffer defined in general.c. */
4857 /* Qpointer defined above */
4859 /* Unfortunately, timeout handlers must be lisp functions. This is
4860 for animated glyphs. */
4861 defsymbol (&Qglyph_animated_timeout_handler,
4862 "glyph-animated-timeout-handler");
4863 DEFSUBR (Fglyph_animated_timeout_handler);
4866 deferror (&Qimage_conversion_error,
4867 "image-conversion-error",
4868 "image-conversion error", Qio_error);
4872 static const struct lrecord_description image_specifier_description[] = {
4873 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee) },
4874 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee_property) },
4879 specifier_type_create_image (void)
4881 /* image specifiers */
4883 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4885 SPECIFIER_HAS_METHOD (image, create);
4886 SPECIFIER_HAS_METHOD (image, mark);
4887 SPECIFIER_HAS_METHOD (image, instantiate);
4888 SPECIFIER_HAS_METHOD (image, validate);
4889 SPECIFIER_HAS_METHOD (image, after_change);
4890 SPECIFIER_HAS_METHOD (image, going_to_add);
4891 SPECIFIER_HAS_METHOD (image, copy_instantiator);
4895 reinit_specifier_type_create_image (void)
4897 REINITIALIZE_SPECIFIER_TYPE (image);
4901 static const struct lrecord_description iike_description_1[] = {
4902 { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) },
4906 static const struct struct_description iike_description = {
4907 sizeof (ii_keyword_entry),
4911 static const struct lrecord_description iiked_description_1[] = {
4912 XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description),
4916 static const struct struct_description iiked_description = {
4917 sizeof (ii_keyword_entry_dynarr),
4921 static const struct lrecord_description iife_description_1[] = {
4922 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) },
4923 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) },
4924 { XD_STRUCT_PTR, offsetof (image_instantiator_format_entry, meths), 1, &iim_description },
4928 static const struct struct_description iife_description = {
4929 sizeof (image_instantiator_format_entry),
4933 static const struct lrecord_description iifed_description_1[] = {
4934 XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description),
4938 static const struct struct_description iifed_description = {
4939 sizeof (image_instantiator_format_entry_dynarr),
4943 static const struct lrecord_description iim_description_1[] = {
4944 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) },
4945 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) },
4946 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, keywords), 1, &iiked_description },
4947 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, consoles), 1, &cted_description },
4951 const struct struct_description iim_description = {
4952 sizeof(struct image_instantiator_methods),
4957 image_instantiator_format_create (void)
4959 /* image instantiators */
4961 the_image_instantiator_format_entry_dynarr =
4962 Dynarr_new (image_instantiator_format_entry);
4964 Vimage_instantiator_format_list = Qnil;
4965 staticpro (&Vimage_instantiator_format_list);
4967 dumpstruct (&the_image_instantiator_format_entry_dynarr, &iifed_description);
4969 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
4971 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
4972 IIFORMAT_HAS_METHOD (nothing, instantiate);
4974 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
4976 IIFORMAT_HAS_METHOD (inherit, validate);
4977 IIFORMAT_HAS_METHOD (inherit, normalize);
4978 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
4979 IIFORMAT_HAS_METHOD (inherit, instantiate);
4981 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
4983 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
4985 IIFORMAT_HAS_METHOD (string, validate);
4986 IIFORMAT_HAS_METHOD (string, possible_dest_types);
4987 IIFORMAT_HAS_METHOD (string, instantiate);
4989 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4990 /* Do this so we can set strings. */
4991 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text");
4992 IIFORMAT_HAS_METHOD (text, set_property);
4993 IIFORMAT_HAS_METHOD (text, query_geometry);
4995 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4997 IIFORMAT_HAS_METHOD (formatted_string, validate);
4998 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4999 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
5000 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
5003 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
5004 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
5005 IIFORMAT_HAS_METHOD (subwindow, instantiate);
5006 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
5007 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
5009 #ifdef HAVE_WINDOW_SYSTEM
5010 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
5012 IIFORMAT_HAS_METHOD (xbm, validate);
5013 IIFORMAT_HAS_METHOD (xbm, normalize);
5014 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
5016 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
5017 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
5018 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
5019 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
5020 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
5021 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
5022 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
5023 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
5024 #endif /* HAVE_WINDOW_SYSTEM */
5027 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
5029 IIFORMAT_HAS_METHOD (xface, validate);
5030 IIFORMAT_HAS_METHOD (xface, normalize);
5031 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
5033 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
5034 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
5035 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
5036 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
5037 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
5038 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
5042 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
5044 IIFORMAT_HAS_METHOD (xpm, validate);
5045 IIFORMAT_HAS_METHOD (xpm, normalize);
5046 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
5048 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
5049 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
5050 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
5051 #endif /* HAVE_XPM */
5055 reinit_vars_of_glyphs (void)
5057 the_expose_ignore_blocktype =
5058 Blocktype_new (struct expose_ignore_blocktype);
5060 hold_ignored_expose_registration = 0;
5065 vars_of_glyphs (void)
5067 reinit_vars_of_glyphs ();
5069 Vthe_nothing_vector = vector1 (Qnothing);
5070 staticpro (&Vthe_nothing_vector);
5072 /* image instances */
5074 Vimage_instance_type_list = Fcons (Qnothing,
5075 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
5076 Qpointer, Qsubwindow, Qwidget));
5077 staticpro (&Vimage_instance_type_list);
5081 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
5082 staticpro (&Vglyph_type_list);
5084 /* The octal-escape glyph, control-arrow-glyph and
5085 invisible-text-glyph are completely initialized in glyphs.el */
5087 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
5088 What to prefix character codes displayed in octal with.
5090 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5092 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
5093 What to use as an arrow for control characters.
5095 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
5096 redisplay_glyph_changed);
5098 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
5099 What to use to indicate the presence of invisible text.
5100 This is the glyph that is displayed when an ellipsis is called for
5101 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
5102 Normally this is three dots ("...").
5104 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
5105 redisplay_glyph_changed);
5107 /* Partially initialized in glyphs.el */
5108 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
5109 What to display at the beginning of horizontally scrolled lines.
5111 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5112 #ifdef HAVE_WINDOW_SYSTEM
5118 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
5119 Definitions of logical color-names used when reading XPM files.
5120 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
5121 The COLOR-NAME should be a string, which is the name of the color to define;
5122 the FORM should evaluate to a `color' specifier object, or a string to be
5123 passed to `make-color-instance'. If a loaded XPM file references a symbolic
5124 color called COLOR-NAME, it will display as the computed color instead.
5126 The default value of this variable defines the logical color names
5127 \"foreground\" and \"background\" to be the colors of the `default' face.
5129 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
5130 #endif /* HAVE_XPM */
5135 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /*
5136 Whether animated pixmaps should be animated.
5139 disable_animated_pixmaps = 0;
5143 specifier_vars_of_glyphs (void)
5145 /* #### Can we GC here? The set_specifier_* calls definitely need */
5147 /* display tables */
5149 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
5150 *The display table currently in use.
5151 This is a specifier; use `set-specifier' to change it.
5152 The display table is a vector created with `make-display-table'.
5153 The 256 elements control how to display each possible text character.
5154 Each value should be a string, a glyph, a vector or nil.
5155 If a value is a vector it must be composed only of strings and glyphs.
5156 nil means display the character in the default fashion.
5157 Faces can have their own, overriding display table.
5159 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
5160 set_specifier_fallback (Vcurrent_display_table,
5161 list1 (Fcons (Qnil, Qnil)));
5162 set_specifier_caching (Vcurrent_display_table,
5163 offsetof (struct window, display_table),
5164 some_window_value_changed,
5169 complex_vars_of_glyphs (void)
5171 /* Partially initialized in glyphs-x.c, glyphs.el */
5172 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
5173 What to display at the end of truncated lines.
5175 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5177 /* Partially initialized in glyphs-x.c, glyphs.el */
5178 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
5179 What to display at the end of wrapped lines.
5181 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5183 /* Partially initialized in glyphs-x.c, glyphs.el */
5184 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
5185 The glyph used to display the XEmacs logo at startup.
5187 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);