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 print_internal (IMAGE_INSTANCE_WIDGET_TYPE (ii), printcharfun, 0);
776 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
778 write_c_string (" ", printcharfun);
779 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 1);
782 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
784 write_c_string (" face=", printcharfun);
786 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
790 case IMAGE_SUBWINDOW:
792 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
793 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
794 write_c_string (buf, printcharfun);
796 /* This is stolen from frame.c. Subwindows are strange in that they
797 are specific to a particular frame so we want to print in their
798 description what that frame is. */
800 write_c_string (" on #<", printcharfun);
802 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
804 if (!FRAME_LIVE_P (f))
805 write_c_string ("dead", printcharfun);
807 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
810 write_c_string ("-frame>", printcharfun);
811 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
812 write_c_string (buf, printcharfun);
820 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
821 (ii, printcharfun, escapeflag));
822 sprintf (buf, " 0x%x>", ii->header.uid);
823 write_c_string (buf, printcharfun);
827 finalize_image_instance (void *header, int for_disksave)
829 Lisp_Image_Instance *i = (Lisp_Image_Instance *) header;
831 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
832 /* objects like this exist at dump time, so don't bomb out. */
834 if (for_disksave) finalose (i);
836 /* do this so that the cachels get reset */
837 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
839 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW
841 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
843 MARK_FRAME_SUBWINDOWS_CHANGED
844 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
847 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
851 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
853 Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
854 Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
855 struct device *d1 = XDEVICE (i1->device);
856 struct device *d2 = XDEVICE (i2->device);
860 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)
861 || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2)
862 || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2)
863 || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2)
864 || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (i2))
866 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
870 switch (IMAGE_INSTANCE_TYPE (i1))
876 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
877 IMAGE_INSTANCE_TEXT_STRING (i2),
882 case IMAGE_MONO_PIXMAP:
883 case IMAGE_COLOR_PIXMAP:
885 if (!(IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
886 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
887 IMAGE_INSTANCE_PIXMAP_SLICE (i1) ==
888 IMAGE_INSTANCE_PIXMAP_SLICE (i2) &&
889 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
890 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
891 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
892 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
893 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
894 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
896 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
897 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
904 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
905 IMAGE_INSTANCE_WIDGET_TYPE (i2))
906 && IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
907 IMAGE_INSTANCE_SUBWINDOW_ID (i2)
909 EQ (IMAGE_INSTANCE_WIDGET_FACE (i1),
910 IMAGE_INSTANCE_WIDGET_TYPE (i2))
911 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1),
912 IMAGE_INSTANCE_WIDGET_ITEMS (i2),
914 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
915 IMAGE_INSTANCE_WIDGET_PROPS (i2),
917 && internal_equal (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i1),
918 IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i2),
920 && internal_equal (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i1),
921 IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i2),
927 case IMAGE_SUBWINDOW:
928 if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
929 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
937 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
941 /* internal_hash will not go very far down a list because of the way
942 its written. For items we need to hash all elements so we provide
943 our own list hashing function. */
945 full_list_hash (Lisp_Object obj, int depth)
947 unsigned long hash = 0;
951 return internal_hash (obj, depth + 1);
953 hash = LISP_HASH (XCAR (obj));
954 LIST_LOOP (rest, XCDR (obj))
956 hash = HASH2 (hash, internal_hash (XCAR (rest), depth + 1));
963 image_instance_hash (Lisp_Object obj, int depth)
965 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
966 struct device *d = XDEVICE (i->device);
967 unsigned long hash = HASH3 ((unsigned long) d,
968 IMAGE_INSTANCE_WIDTH (i),
969 IMAGE_INSTANCE_HEIGHT (i));
971 switch (IMAGE_INSTANCE_TYPE (i))
977 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
981 case IMAGE_MONO_PIXMAP:
982 case IMAGE_COLOR_PIXMAP:
984 hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i),
985 IMAGE_INSTANCE_PIXMAP_SLICE (i),
986 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
992 /* We need the hash to be equivalent to what should be
995 LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)),
996 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
997 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1));
998 case IMAGE_SUBWINDOW:
999 hash = HASH2 (hash, (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
1006 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
1010 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
1011 mark_image_instance, print_image_instance,
1012 finalize_image_instance, image_instance_equal,
1013 image_instance_hash, 0,
1014 Lisp_Image_Instance);
1017 allocate_image_instance (Lisp_Object device, Lisp_Object glyph)
1019 Lisp_Image_Instance *lp =
1020 alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance);
1024 lp->device = device;
1025 lp->type = IMAGE_NOTHING;
1032 /* So that layouts get done. */
1033 lp->layout_changed = 1;
1035 XSETIMAGE_INSTANCE (val, lp);
1036 MARK_GLYPHS_CHANGED;
1041 static enum image_instance_type
1042 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
1044 if (ERRB_EQ (errb, ERROR_ME))
1045 CHECK_SYMBOL (type);
1047 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
1048 if (EQ (type, Qtext)) return IMAGE_TEXT;
1049 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
1050 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
1051 if (EQ (type, Qpointer)) return IMAGE_POINTER;
1052 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
1053 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
1054 if (EQ (type, Qlayout)) return IMAGE_LAYOUT;
1056 maybe_signal_simple_error ("Invalid image-instance type", type,
1059 return IMAGE_UNKNOWN; /* not reached */
1063 encode_image_instance_type (enum image_instance_type type)
1067 case IMAGE_NOTHING: return Qnothing;
1068 case IMAGE_TEXT: return Qtext;
1069 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
1070 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
1071 case IMAGE_POINTER: return Qpointer;
1072 case IMAGE_SUBWINDOW: return Qsubwindow;
1073 case IMAGE_WIDGET: return Qwidget;
1074 case IMAGE_LAYOUT: return Qlayout;
1079 return Qnil; /* not reached */
1083 image_instance_type_to_mask (enum image_instance_type type)
1085 /* This depends on the fact that enums are assigned consecutive
1086 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
1087 first enum.) I'm fairly sure this behavior is ANSI-mandated,
1088 so there should be no portability problems here. */
1089 return (1 << ((int) (type) - 1));
1093 decode_image_instance_type_list (Lisp_Object list)
1103 enum image_instance_type type =
1104 decode_image_instance_type (list, ERROR_ME);
1105 return image_instance_type_to_mask (type);
1108 EXTERNAL_LIST_LOOP (rest, list)
1110 enum image_instance_type type =
1111 decode_image_instance_type (XCAR (rest), ERROR_ME);
1112 mask |= image_instance_type_to_mask (type);
1119 encode_image_instance_type_list (int mask)
1122 Lisp_Object result = Qnil;
1128 result = Fcons (encode_image_instance_type
1129 ((enum image_instance_type) count), result);
1133 return Fnreverse (result);
1137 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1138 int desired_dest_mask)
1143 (emacs_doprnt_string_lisp_2
1145 "No compatible image-instance types given: wanted one of %s, got %s",
1147 encode_image_instance_type_list (desired_dest_mask),
1148 encode_image_instance_type_list (given_dest_mask)),
1153 valid_image_instance_type_p (Lisp_Object type)
1155 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1158 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1159 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1160 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1161 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1163 (image_instance_type))
1165 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1168 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1169 Return a list of valid image-instance types.
1173 return Fcopy_sequence (Vimage_instance_type_list);
1177 decode_error_behavior_flag (Lisp_Object no_error)
1179 if (NILP (no_error)) return ERROR_ME;
1180 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1181 else return ERROR_ME_WARN;
1185 encode_error_behavior_flag (Error_behavior errb)
1187 if (ERRB_EQ (errb, ERROR_ME))
1189 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1193 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1198 /* Recurse up the hierarchy looking for the topmost glyph. This means
1199 that instances in layouts will inherit face properties from their
1201 Lisp_Object image_instance_parent_glyph (Lisp_Image_Instance* ii)
1203 if (IMAGE_INSTANCEP (IMAGE_INSTANCE_PARENT (ii)))
1205 return image_instance_parent_glyph
1206 (XIMAGE_INSTANCE (IMAGE_INSTANCE_PARENT (ii)));
1208 return IMAGE_INSTANCE_PARENT (ii);
1212 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1213 Lisp_Object dest_types)
1216 struct gcpro gcpro1;
1219 XSETDEVICE (device, decode_device (device));
1220 /* instantiate_image_instantiator() will abort if given an
1221 image instance ... */
1222 if (IMAGE_INSTANCEP (data))
1223 signal_simple_error ("Image instances not allowed here", data);
1224 image_validate (data);
1225 dest_mask = decode_image_instance_type_list (dest_types);
1226 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1227 make_int (dest_mask));
1229 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1230 signal_simple_error ("Inheritance not allowed here", data);
1231 ii = instantiate_image_instantiator (device, device, data,
1232 Qnil, Qnil, dest_mask, Qnil);
1233 RETURN_UNGCPRO (ii);
1236 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1237 Return a new `image-instance' object.
1239 Image-instance objects encapsulate the way a particular image (pixmap,
1240 etc.) is displayed on a particular device. In most circumstances, you
1241 do not need to directly create image instances; use a glyph instead.
1242 However, it may occasionally be useful to explicitly create image
1243 instances, if you want more control over the instantiation process.
1245 DATA is an image instantiator, which describes the image; see
1246 `image-specifier-p' for a description of the allowed values.
1248 DEST-TYPES should be a list of allowed image instance types that can
1249 be generated. The recognized image instance types are
1252 Nothing is displayed.
1254 Displayed as text. The foreground and background colors and the
1255 font of the text are specified independent of the pixmap. Typically
1256 these attributes will come from the face of the surrounding text,
1257 unless a face is specified for the glyph in which the image appears.
1259 Displayed as a mono pixmap (a pixmap with only two colors where the
1260 foreground and background can be specified independent of the pixmap;
1261 typically the pixmap assumes the foreground and background colors of
1262 the text around it, unless a face is specified for the glyph in which
1265 Displayed as a color pixmap.
1267 Used as the mouse pointer for a window.
1269 A child window that is treated as an image. This allows (e.g.)
1270 another program to be responsible for drawing into the window.
1272 A child window that contains a window-system widget, e.g. a push
1275 The DEST-TYPES list is unordered. If multiple destination types
1276 are possible for a given instantiator, the "most natural" type
1277 for the instantiator's format is chosen. (For XBM, the most natural
1278 types are `mono-pixmap', followed by `color-pixmap', followed by
1279 `pointer'. For the other normal image formats, the most natural
1280 types are `color-pixmap', followed by `mono-pixmap', followed by
1281 `pointer'. For the string and formatted-string formats, the most
1282 natural types are `text', followed by `mono-pixmap' (not currently
1283 implemented), followed by `color-pixmap' (not currently implemented).
1284 The other formats can only be instantiated as one type. (If you
1285 want to control more specifically the order of the types into which
1286 an image is instantiated, just call `make-image-instance' repeatedly
1287 until it succeeds, passing less and less preferred destination types
1290 If DEST-TYPES is omitted, all possible types are allowed.
1292 NO-ERROR controls what happens when the image cannot be generated.
1293 If nil, an error message is generated. If t, no messages are
1294 generated and this function returns nil. If anything else, a warning
1295 message is generated and this function returns nil.
1297 (data, device, dest_types, no_error))
1299 Error_behavior errb = decode_error_behavior_flag (no_error);
1301 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1303 3, data, device, dest_types);
1306 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1307 Return non-nil if OBJECT is an image instance.
1311 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1314 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1315 Return the type of the given image instance.
1316 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1317 'color-pixmap, 'pointer, or 'subwindow.
1321 CHECK_IMAGE_INSTANCE (image_instance);
1322 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1325 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1326 Return the name of the given image instance.
1330 CHECK_IMAGE_INSTANCE (image_instance);
1331 return XIMAGE_INSTANCE_NAME (image_instance);
1334 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1335 Return the string of the given image instance.
1336 This will only be non-nil for text image instances and widgets.
1340 CHECK_IMAGE_INSTANCE (image_instance);
1341 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1342 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1343 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1344 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1349 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1350 Return the given property of the given image instance.
1351 Returns nil if the property or the property method do not exist for
1352 the image instance in the domain.
1354 (image_instance, prop))
1356 Lisp_Image_Instance* ii;
1357 Lisp_Object type, ret;
1358 struct image_instantiator_methods* meths;
1360 CHECK_IMAGE_INSTANCE (image_instance);
1361 CHECK_SYMBOL (prop);
1362 ii = XIMAGE_INSTANCE (image_instance);
1364 /* ... then try device specific methods ... */
1365 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1366 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1367 type, ERROR_ME_NOT);
1368 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1370 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1374 /* ... then format specific methods ... */
1375 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1376 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1378 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1386 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1387 Set the given property of the given image instance.
1388 Does nothing if the property or the property method do not exist for
1389 the image instance in the domain.
1391 (image_instance, prop, val))
1393 Lisp_Image_Instance* ii;
1394 Lisp_Object type, ret;
1395 struct image_instantiator_methods* meths;
1397 CHECK_IMAGE_INSTANCE (image_instance);
1398 CHECK_SYMBOL (prop);
1399 ii = XIMAGE_INSTANCE (image_instance);
1400 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1401 /* try device specific methods first ... */
1402 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1403 type, ERROR_ME_NOT);
1404 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1407 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1413 /* ... then format specific methods ... */
1414 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1415 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1418 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1428 /* Make sure the image instance gets redisplayed. */
1429 set_image_instance_dirty_p (image_instance, 1);
1430 /* Force the glyph to be laid out again. */
1431 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
1433 MARK_SUBWINDOWS_STATE_CHANGED;
1434 MARK_GLYPHS_CHANGED;
1439 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1440 Return the file name from which IMAGE-INSTANCE was read, if known.
1444 CHECK_IMAGE_INSTANCE (image_instance);
1446 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1448 case IMAGE_MONO_PIXMAP:
1449 case IMAGE_COLOR_PIXMAP:
1451 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1458 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1459 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1463 CHECK_IMAGE_INSTANCE (image_instance);
1465 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1467 case IMAGE_MONO_PIXMAP:
1468 case IMAGE_COLOR_PIXMAP:
1470 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1477 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1478 Return the depth of the image instance.
1479 This is 0 for a bitmap, or a positive integer for a pixmap.
1483 CHECK_IMAGE_INSTANCE (image_instance);
1485 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1487 case IMAGE_MONO_PIXMAP:
1488 case IMAGE_COLOR_PIXMAP:
1490 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1497 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1498 Return the height of the image instance, in pixels.
1502 CHECK_IMAGE_INSTANCE (image_instance);
1504 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1506 case IMAGE_MONO_PIXMAP:
1507 case IMAGE_COLOR_PIXMAP:
1509 case IMAGE_SUBWINDOW:
1512 return make_int (XIMAGE_INSTANCE_HEIGHT (image_instance));
1519 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1520 Return the width of the image instance, in pixels.
1524 CHECK_IMAGE_INSTANCE (image_instance);
1526 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1528 case IMAGE_MONO_PIXMAP:
1529 case IMAGE_COLOR_PIXMAP:
1531 case IMAGE_SUBWINDOW:
1534 return make_int (XIMAGE_INSTANCE_WIDTH (image_instance));
1541 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1542 Return the X coordinate of the image instance's hotspot, if known.
1543 This is a point relative to the origin of the pixmap. When an image is
1544 used as a mouse pointer, the hotspot is the point on the image that sits
1545 over the location that the pointer points to. This is, for example, the
1546 tip of the arrow or the center of the crosshairs.
1547 This will always be nil for a non-pointer image instance.
1551 CHECK_IMAGE_INSTANCE (image_instance);
1553 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1555 case IMAGE_MONO_PIXMAP:
1556 case IMAGE_COLOR_PIXMAP:
1558 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1565 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1566 Return the Y coordinate of the image instance's hotspot, if known.
1567 This is a point relative to the origin of the pixmap. When an image is
1568 used as a mouse pointer, the hotspot is the point on the image that sits
1569 over the location that the pointer points to. This is, for example, the
1570 tip of the arrow or the center of the crosshairs.
1571 This will always be nil for a non-pointer image instance.
1575 CHECK_IMAGE_INSTANCE (image_instance);
1577 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1579 case IMAGE_MONO_PIXMAP:
1580 case IMAGE_COLOR_PIXMAP:
1582 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1589 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1590 Return the foreground color of IMAGE-INSTANCE, if applicable.
1591 This will be a color instance or nil. (It will only be non-nil for
1592 colorized mono pixmaps and for pointers.)
1596 CHECK_IMAGE_INSTANCE (image_instance);
1598 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1600 case IMAGE_MONO_PIXMAP:
1601 case IMAGE_COLOR_PIXMAP:
1603 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1606 return FACE_FOREGROUND (
1607 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1608 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1616 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1617 Return the background color of IMAGE-INSTANCE, if applicable.
1618 This will be a color instance or nil. (It will only be non-nil for
1619 colorized mono pixmaps and for pointers.)
1623 CHECK_IMAGE_INSTANCE (image_instance);
1625 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1627 case IMAGE_MONO_PIXMAP:
1628 case IMAGE_COLOR_PIXMAP:
1630 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1633 return FACE_BACKGROUND (
1634 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1635 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1644 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1645 Make the image instance be displayed in the given colors.
1646 This function returns a new image instance that is exactly like the
1647 specified one except that (if possible) the foreground and background
1648 colors and as specified. Currently, this only does anything if the image
1649 instance is a mono pixmap; otherwise, the same image instance is returned.
1651 (image_instance, foreground, background))
1656 CHECK_IMAGE_INSTANCE (image_instance);
1657 CHECK_COLOR_INSTANCE (foreground);
1658 CHECK_COLOR_INSTANCE (background);
1660 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1661 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1662 return image_instance;
1664 /* #### There should be a copy_image_instance(), which calls a
1665 device-specific method to copy the window-system subobject. */
1666 new = allocate_image_instance (device, Qnil);
1667 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1668 /* note that if this method returns non-zero, this method MUST
1669 copy any window-system resources, so that when one image instance is
1670 freed, the other one is not hosed. */
1671 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1673 return image_instance;
1678 /************************************************************************/
1679 /* Geometry calculations */
1680 /************************************************************************/
1682 /* Find out desired geometry of the image instance. If there is no
1683 special function then just return the width and / or height. */
1685 image_instance_query_geometry (Lisp_Object image_instance,
1686 unsigned int* width, unsigned int* height,
1687 enum image_instance_geometry disp,
1690 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1692 struct image_instantiator_methods* meths;
1694 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1695 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1697 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1699 IIFORMAT_METH (meths, query_geometry, (image_instance, width, height,
1705 *width = IMAGE_INSTANCE_WIDTH (ii);
1707 *height = IMAGE_INSTANCE_HEIGHT (ii);
1711 /* Layout the image instance using the provided dimensions. Layout
1712 widgets are going to do different kinds of calculations to
1713 determine what size to give things so we could make the layout
1714 function relatively simple to take account of that. An alternative
1715 approach is to consider separately the two cases, one where you
1716 don't mind what size you have (normal widgets) and one where you
1717 want to specifiy something (layout widgets). */
1719 image_instance_layout (Lisp_Object image_instance,
1720 unsigned int width, unsigned int height,
1723 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1725 struct image_instantiator_methods* meths;
1727 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1728 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1730 /* If geometry is unspecified then get some reasonable values for it. */
1731 if (width == IMAGE_UNSPECIFIED_GEOMETRY
1733 height == IMAGE_UNSPECIFIED_GEOMETRY)
1735 unsigned int dwidth, dheight;
1737 /* Get the desired geometry. */
1738 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1740 IIFORMAT_METH (meths, query_geometry, (image_instance, &dwidth, &dheight,
1741 IMAGE_DESIRED_GEOMETRY,
1746 dwidth = IMAGE_INSTANCE_WIDTH (ii);
1747 dheight = IMAGE_INSTANCE_HEIGHT (ii);
1750 /* Compare with allowed geometry. */
1751 if (width == IMAGE_UNSPECIFIED_GEOMETRY)
1753 if (height == IMAGE_UNSPECIFIED_GEOMETRY)
1757 /* At this point width and height should contain sane values. Thus
1758 we set the glyph geometry and lay it out. */
1759 if (IMAGE_INSTANCE_WIDTH (ii) != width
1761 IMAGE_INSTANCE_HEIGHT (ii) != height)
1763 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
1766 IMAGE_INSTANCE_WIDTH (ii) = width;
1767 IMAGE_INSTANCE_HEIGHT (ii) = height;
1769 if (meths && HAS_IIFORMAT_METH_P (meths, layout))
1771 IIFORMAT_METH (meths, layout, (image_instance, width, height, domain));
1773 /* else no change to the geometry. */
1775 /* Do not clear the dirty flag here - redisplay will do this for
1777 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0;
1781 * Mark image instance in W as dirty if (a) W's faces have changed and
1782 * (b) GLYPH_OR_II instance in W is a string.
1784 * Return non-zero if instance has been marked dirty.
1787 invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w)
1789 if (XFRAME(WINDOW_FRAME(w))->faces_changed)
1791 Lisp_Object image = glyph_or_ii;
1793 if (GLYPHP (glyph_or_ii))
1796 XSETWINDOW (window, w);
1797 image = glyph_image_instance (glyph_or_ii, window, ERROR_ME_NOT, 1);
1800 if (TEXT_IMAGE_INSTANCEP (image))
1802 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image);
1803 IMAGE_INSTANCE_DIRTYP (ii) = 1;
1804 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
1805 if (GLYPHP (glyph_or_ii))
1806 XGLYPH_DIRTYP (glyph_or_ii) = 1;
1815 /************************************************************************/
1817 /************************************************************************/
1819 signal_image_error (const char *reason, Lisp_Object frob)
1821 signal_error (Qimage_conversion_error,
1822 list2 (build_translated_string (reason), frob));
1826 signal_image_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1)
1828 signal_error (Qimage_conversion_error,
1829 list3 (build_translated_string (reason), frob0, frob1));
1832 /****************************************************************************
1834 ****************************************************************************/
1837 nothing_possible_dest_types (void)
1839 return IMAGE_NOTHING_MASK;
1843 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1844 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1845 int dest_mask, Lisp_Object domain)
1847 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1849 if (dest_mask & IMAGE_NOTHING_MASK)
1850 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1852 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1856 /****************************************************************************
1858 ****************************************************************************/
1861 inherit_validate (Lisp_Object instantiator)
1863 face_must_be_present (instantiator);
1867 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1871 assert (XVECTOR_LENGTH (inst) == 3);
1872 face = XVECTOR_DATA (inst)[2];
1874 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1879 inherit_possible_dest_types (void)
1881 return IMAGE_MONO_PIXMAP_MASK;
1885 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1886 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1887 int dest_mask, Lisp_Object domain)
1889 /* handled specially in image_instantiate */
1894 /****************************************************************************
1896 ****************************************************************************/
1899 string_validate (Lisp_Object instantiator)
1901 data_must_be_present (instantiator);
1905 string_possible_dest_types (void)
1907 return IMAGE_TEXT_MASK;
1910 /* Called from autodetect_instantiate() */
1912 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1913 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1914 int dest_mask, Lisp_Object domain)
1916 Lisp_Object string = find_keyword_in_vector (instantiator, Q_data);
1917 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1919 /* Should never get here with a domain other than a window. */
1920 assert (!NILP (string) && WINDOWP (domain));
1921 if (dest_mask & IMAGE_TEXT_MASK)
1923 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1924 IMAGE_INSTANCE_TEXT_STRING (ii) = string;
1927 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1930 /* Sort out the size of the text that is being displayed. Calculating
1931 it dynamically allows us to change the text and still see
1932 everything. Note that the following methods are for text not string
1933 since that is what the instantiated type is. The first method is a
1934 helper that is used elsewhere for calculating text geometry. */
1936 query_string_geometry (Lisp_Object string, Lisp_Object face,
1937 unsigned int* width, unsigned int* height,
1938 unsigned int* descent, Lisp_Object domain)
1940 struct font_metric_info fm;
1941 unsigned char charsets[NUM_LEADING_BYTES];
1942 struct face_cachel frame_cachel;
1943 struct face_cachel *cachel;
1944 Lisp_Object frame = FW_FRAME (domain);
1946 /* Compute height */
1949 /* Compute string metric info */
1950 find_charsets_in_bufbyte_string (charsets,
1951 XSTRING_DATA (string),
1952 XSTRING_LENGTH (string));
1954 /* Fallback to the default face if none was provided. */
1957 reset_face_cachel (&frame_cachel);
1958 update_face_cachel_data (&frame_cachel, frame, face);
1959 cachel = &frame_cachel;
1963 cachel = WINDOW_FACE_CACHEL (XWINDOW (domain), DEFAULT_INDEX);
1966 ensure_face_cachel_complete (cachel, domain, charsets);
1967 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
1969 *height = fm.ascent + fm.descent;
1970 /* #### descent only gets set if we query the height as well. */
1972 *descent = fm.descent;
1979 *width = redisplay_frame_text_width_string (XFRAME (frame),
1983 *width = redisplay_frame_text_width_string (XFRAME (frame),
1990 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain)
1992 unsigned char charsets[NUM_LEADING_BYTES];
1993 struct face_cachel frame_cachel;
1994 struct face_cachel *cachel;
1996 Lisp_Object frame = FW_FRAME (domain);
1998 /* Compute string font info */
1999 find_charsets_in_bufbyte_string (charsets,
2000 XSTRING_DATA (string),
2001 XSTRING_LENGTH (string));
2003 reset_face_cachel (&frame_cachel);
2004 update_face_cachel_data (&frame_cachel, frame, face);
2005 cachel = &frame_cachel;
2007 ensure_face_cachel_complete (cachel, domain, charsets);
2009 for (i = 0; i < NUM_LEADING_BYTES; i++)
2013 return FACE_CACHEL_FONT (cachel,
2014 CHARSET_BY_LEADING_BYTE (i +
2020 return Qnil; /* NOT REACHED */
2024 text_query_geometry (Lisp_Object image_instance,
2025 unsigned int* width, unsigned int* height,
2026 enum image_instance_geometry disp, Lisp_Object domain)
2028 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2029 unsigned int descent = 0;
2031 query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii),
2032 IMAGE_INSTANCE_FACE (ii),
2033 width, height, &descent, domain);
2035 /* The descent gets set as a side effect of querying the
2037 IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent;
2040 /* set the properties of a string */
2042 text_set_property (Lisp_Object image_instance, Lisp_Object prop,
2045 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2047 if (EQ (prop, Q_data))
2050 IMAGE_INSTANCE_TEXT_STRING (ii) = val;
2058 /****************************************************************************
2059 * formatted-string *
2060 ****************************************************************************/
2063 formatted_string_validate (Lisp_Object instantiator)
2065 data_must_be_present (instantiator);
2069 formatted_string_possible_dest_types (void)
2071 return IMAGE_TEXT_MASK;
2075 formatted_string_instantiate (Lisp_Object image_instance,
2076 Lisp_Object instantiator,
2077 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2078 int dest_mask, Lisp_Object domain)
2080 /* #### implement this */
2081 warn_when_safe (Qunimplemented, Qnotice,
2082 "`formatted-string' not yet implemented; assuming `string'");
2084 string_instantiate (image_instance, instantiator,
2085 pointer_fg, pointer_bg, dest_mask, domain);
2089 /************************************************************************/
2090 /* pixmap file functions */
2091 /************************************************************************/
2093 /* If INSTANTIATOR refers to inline data, return Qnil.
2094 If INSTANTIATOR refers to data in a file, return the full filename
2095 if it exists; otherwise, return a cons of (filename).
2097 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
2098 keywords used to look up the file and inline data,
2099 respectively, in the instantiator. Normally these would
2100 be Q_file and Q_data, but might be different for mask data. */
2103 potential_pixmap_file_instantiator (Lisp_Object instantiator,
2104 Lisp_Object file_keyword,
2105 Lisp_Object data_keyword,
2106 Lisp_Object console_type)
2111 assert (VECTORP (instantiator));
2113 data = find_keyword_in_vector (instantiator, data_keyword);
2114 file = find_keyword_in_vector (instantiator, file_keyword);
2116 if (!NILP (file) && NILP (data))
2118 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
2119 (decode_console_type(console_type, ERROR_ME),
2120 locate_pixmap_file, (file));
2125 return Fcons (file, Qnil); /* should have been file */
2132 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
2133 Lisp_Object image_type_tag)
2135 /* This function can call lisp */
2136 Lisp_Object file = Qnil;
2137 struct gcpro gcpro1, gcpro2;
2138 Lisp_Object alist = Qnil;
2140 GCPRO2 (file, alist);
2142 /* Now, convert any file data into inline data. At the end of this,
2143 `data' will contain the inline data (if any) or Qnil, and `file'
2144 will contain the name this data was derived from (if known) or
2147 Note that if we cannot generate any regular inline data, we
2150 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2153 if (CONSP (file)) /* failure locating filename */
2154 signal_double_file_error ("Opening pixmap file",
2155 "no such file or directory",
2158 if (NILP (file)) /* no conversion necessary */
2159 RETURN_UNGCPRO (inst);
2161 alist = tagged_vector_to_alist (inst);
2164 Lisp_Object data = make_string_from_file (file);
2165 alist = remassq_no_quit (Q_file, alist);
2166 /* there can't be a :data at this point. */
2167 alist = Fcons (Fcons (Q_file, file),
2168 Fcons (Fcons (Q_data, data), alist));
2172 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
2174 RETURN_UNGCPRO (result);
2179 #ifdef HAVE_WINDOW_SYSTEM
2180 /**********************************************************************
2182 **********************************************************************/
2184 /* Check if DATA represents a valid inline XBM spec (i.e. a list
2185 of (width height bits), with checking done on the dimensions).
2186 If not, signal an error. */
2189 check_valid_xbm_inline (Lisp_Object data)
2191 Lisp_Object width, height, bits;
2193 if (!CONSP (data) ||
2194 !CONSP (XCDR (data)) ||
2195 !CONSP (XCDR (XCDR (data))) ||
2196 !NILP (XCDR (XCDR (XCDR (data)))))
2197 signal_simple_error ("Must be list of 3 elements", data);
2199 width = XCAR (data);
2200 height = XCAR (XCDR (data));
2201 bits = XCAR (XCDR (XCDR (data)));
2203 CHECK_STRING (bits);
2205 if (!NATNUMP (width))
2206 signal_simple_error ("Width must be a natural number", width);
2208 if (!NATNUMP (height))
2209 signal_simple_error ("Height must be a natural number", height);
2211 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
2212 signal_simple_error ("data is too short for width and height",
2213 vector3 (width, height, bits));
2216 /* Validate method for XBM's. */
2219 xbm_validate (Lisp_Object instantiator)
2221 file_or_data_must_be_present (instantiator);
2224 /* Given a filename that is supposed to contain XBM data, return
2225 the inline representation of it as (width height bits). Return
2226 the hotspot through XHOT and YHOT, if those pointers are not 0.
2227 If there is no hotspot, XHOT and YHOT will contain -1.
2229 If the function fails:
2231 -- if OK_IF_DATA_INVALID is set and the data was invalid,
2233 -- maybe return an error, or return Qnil.
2236 #ifdef HAVE_X_WINDOWS
2237 #include <X11/Xlib.h>
2239 #define XFree(data) free(data)
2243 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
2244 int ok_if_data_invalid)
2249 const char *filename_ext;
2251 TO_EXTERNAL_FORMAT (LISP_STRING, name,
2252 C_STRING_ALLOCA, filename_ext,
2254 result = read_bitmap_data_from_file (filename_ext, &w, &h,
2257 if (result == BitmapSuccess)
2260 int len = (w + 7) / 8 * h;
2262 retval = list3 (make_int (w), make_int (h),
2263 make_ext_string (data, len, Qbinary));
2264 XFree ((char *) data);
2270 case BitmapOpenFailed:
2272 /* should never happen */
2273 signal_double_file_error ("Opening bitmap file",
2274 "no such file or directory",
2277 case BitmapFileInvalid:
2279 if (ok_if_data_invalid)
2281 signal_double_file_error ("Reading bitmap file",
2282 "invalid data in file",
2285 case BitmapNoMemory:
2287 signal_double_file_error ("Reading bitmap file",
2293 signal_double_file_error_2 ("Reading bitmap file",
2294 "unknown error code",
2295 make_int (result), name);
2299 return Qnil; /* not reached */
2303 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2304 Lisp_Object mask_file, Lisp_Object console_type)
2306 /* This is unclean but it's fairly standard -- a number of the
2307 bitmaps in /usr/include/X11/bitmaps use it -- so we support
2309 if (NILP (mask_file)
2310 /* don't override explicitly specified mask data. */
2311 && NILP (assq_no_quit (Q_mask_data, alist))
2314 mask_file = MAYBE_LISP_CONTYPE_METH
2315 (decode_console_type(console_type, ERROR_ME),
2316 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
2317 if (NILP (mask_file))
2318 mask_file = MAYBE_LISP_CONTYPE_METH
2319 (decode_console_type(console_type, ERROR_ME),
2320 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
2323 if (!NILP (mask_file))
2325 Lisp_Object mask_data =
2326 bitmap_to_lisp_data (mask_file, 0, 0, 0);
2327 alist = remassq_no_quit (Q_mask_file, alist);
2328 /* there can't be a :mask-data at this point. */
2329 alist = Fcons (Fcons (Q_mask_file, mask_file),
2330 Fcons (Fcons (Q_mask_data, mask_data), alist));
2336 /* Normalize method for XBM's. */
2339 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
2341 Lisp_Object file = Qnil, mask_file = Qnil;
2342 struct gcpro gcpro1, gcpro2, gcpro3;
2343 Lisp_Object alist = Qnil;
2345 GCPRO3 (file, mask_file, alist);
2347 /* Now, convert any file data into inline data for both the regular
2348 data and the mask data. At the end of this, `data' will contain
2349 the inline data (if any) or Qnil, and `file' will contain
2350 the name this data was derived from (if known) or Qnil.
2351 Likewise for `mask_file' and `mask_data'.
2353 Note that if we cannot generate any regular inline data, we
2356 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2358 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2359 Q_mask_data, console_type);
2361 if (CONSP (file)) /* failure locating filename */
2362 signal_double_file_error ("Opening bitmap file",
2363 "no such file or directory",
2366 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2367 RETURN_UNGCPRO (inst);
2369 alist = tagged_vector_to_alist (inst);
2374 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
2375 alist = remassq_no_quit (Q_file, alist);
2376 /* there can't be a :data at this point. */
2377 alist = Fcons (Fcons (Q_file, file),
2378 Fcons (Fcons (Q_data, data), alist));
2380 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2381 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2383 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2384 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2388 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2391 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2393 RETURN_UNGCPRO (result);
2399 xbm_possible_dest_types (void)
2402 IMAGE_MONO_PIXMAP_MASK |
2403 IMAGE_COLOR_PIXMAP_MASK |
2411 /**********************************************************************
2413 **********************************************************************/
2416 xface_validate (Lisp_Object instantiator)
2418 file_or_data_must_be_present (instantiator);
2422 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2424 /* This function can call lisp */
2425 Lisp_Object file = Qnil, mask_file = Qnil;
2426 struct gcpro gcpro1, gcpro2, gcpro3;
2427 Lisp_Object alist = Qnil;
2429 GCPRO3 (file, mask_file, alist);
2431 /* Now, convert any file data into inline data for both the regular
2432 data and the mask data. At the end of this, `data' will contain
2433 the inline data (if any) or Qnil, and `file' will contain
2434 the name this data was derived from (if known) or Qnil.
2435 Likewise for `mask_file' and `mask_data'.
2437 Note that if we cannot generate any regular inline data, we
2440 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2442 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2443 Q_mask_data, console_type);
2445 if (CONSP (file)) /* failure locating filename */
2446 signal_double_file_error ("Opening bitmap file",
2447 "no such file or directory",
2450 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2451 RETURN_UNGCPRO (inst);
2453 alist = tagged_vector_to_alist (inst);
2456 Lisp_Object data = make_string_from_file (file);
2457 alist = remassq_no_quit (Q_file, alist);
2458 /* there can't be a :data at this point. */
2459 alist = Fcons (Fcons (Q_file, file),
2460 Fcons (Fcons (Q_data, data), alist));
2463 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2466 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2468 RETURN_UNGCPRO (result);
2473 xface_possible_dest_types (void)
2476 IMAGE_MONO_PIXMAP_MASK |
2477 IMAGE_COLOR_PIXMAP_MASK |
2481 #endif /* HAVE_XFACE */
2486 /**********************************************************************
2488 **********************************************************************/
2491 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2497 TO_EXTERNAL_FORMAT (LISP_STRING, name,
2498 C_STRING_ALLOCA, fname,
2500 result = XpmReadFileToData (fname, &data);
2502 if (result == XpmSuccess)
2504 Lisp_Object retval = Qnil;
2505 struct buffer *old_buffer = current_buffer;
2506 Lisp_Object temp_buffer =
2507 Fget_buffer_create (build_string (" *pixmap conversion*"));
2509 int height, width, ncolors;
2510 struct gcpro gcpro1, gcpro2, gcpro3;
2511 int speccount = specpdl_depth ();
2513 GCPRO3 (name, retval, temp_buffer);
2515 specbind (Qinhibit_quit, Qt);
2516 set_buffer_internal (XBUFFER (temp_buffer));
2517 Ferase_buffer (Qnil);
2519 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2520 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2522 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2523 for (elt = 0; elt <= width + ncolors; elt++)
2525 buffer_insert_c_string (current_buffer, "\"");
2526 buffer_insert_c_string (current_buffer, data[elt]);
2528 if (elt < width + ncolors)
2529 buffer_insert_c_string (current_buffer, "\",\r");
2531 buffer_insert_c_string (current_buffer, "\"};\r");
2534 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2537 set_buffer_internal (old_buffer);
2538 unbind_to (speccount, Qnil);
2540 RETURN_UNGCPRO (retval);
2545 case XpmFileInvalid:
2547 if (ok_if_data_invalid)
2549 signal_image_error ("invalid XPM data in file", name);
2553 signal_double_file_error ("Reading pixmap file",
2554 "out of memory", name);
2558 /* should never happen? */
2559 signal_double_file_error ("Opening pixmap file",
2560 "no such file or directory", name);
2564 signal_double_file_error_2 ("Parsing pixmap file",
2565 "unknown error code",
2566 make_int (result), name);
2571 return Qnil; /* not reached */
2575 check_valid_xpm_color_symbols (Lisp_Object data)
2579 for (rest = data; !NILP (rest); rest = XCDR (rest))
2581 if (!CONSP (rest) ||
2582 !CONSP (XCAR (rest)) ||
2583 !STRINGP (XCAR (XCAR (rest))) ||
2584 (!STRINGP (XCDR (XCAR (rest))) &&
2585 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2586 signal_simple_error ("Invalid color symbol alist", data);
2591 xpm_validate (Lisp_Object instantiator)
2593 file_or_data_must_be_present (instantiator);
2596 Lisp_Object Vxpm_color_symbols;
2599 evaluate_xpm_color_symbols (void)
2601 Lisp_Object rest, results = Qnil;
2602 struct gcpro gcpro1, gcpro2;
2604 GCPRO2 (rest, results);
2605 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2607 Lisp_Object name, value, cons;
2613 CHECK_STRING (name);
2614 value = XCDR (cons);
2616 value = XCAR (value);
2617 value = Feval (value);
2620 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2622 ("Result from xpm-color-symbols eval must be nil, string, or color",
2624 results = Fcons (Fcons (name, value), results);
2626 UNGCPRO; /* no more evaluation */
2631 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2633 Lisp_Object file = Qnil;
2634 Lisp_Object color_symbols;
2635 struct gcpro gcpro1, gcpro2;
2636 Lisp_Object alist = Qnil;
2638 GCPRO2 (file, alist);
2640 /* Now, convert any file data into inline data. At the end of this,
2641 `data' will contain the inline data (if any) or Qnil, and
2642 `file' will contain the name this data was derived from (if
2645 Note that if we cannot generate any regular inline data, we
2648 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2651 if (CONSP (file)) /* failure locating filename */
2652 signal_double_file_error ("Opening pixmap file",
2653 "no such file or directory",
2656 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2659 if (NILP (file) && !UNBOUNDP (color_symbols))
2660 /* no conversion necessary */
2661 RETURN_UNGCPRO (inst);
2663 alist = tagged_vector_to_alist (inst);
2667 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2668 alist = remassq_no_quit (Q_file, alist);
2669 /* there can't be a :data at this point. */
2670 alist = Fcons (Fcons (Q_file, file),
2671 Fcons (Fcons (Q_data, data), alist));
2674 if (UNBOUNDP (color_symbols))
2676 color_symbols = evaluate_xpm_color_symbols ();
2677 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2682 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2684 RETURN_UNGCPRO (result);
2689 xpm_possible_dest_types (void)
2692 IMAGE_MONO_PIXMAP_MASK |
2693 IMAGE_COLOR_PIXMAP_MASK |
2697 #endif /* HAVE_XPM */
2700 /****************************************************************************
2701 * Image Specifier Object *
2702 ****************************************************************************/
2704 DEFINE_SPECIFIER_TYPE (image);
2707 image_create (Lisp_Object obj)
2709 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2711 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2712 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2713 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2717 image_mark (Lisp_Object obj)
2719 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2721 mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
2722 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2726 image_instantiate_cache_result (Lisp_Object locative)
2728 /* locative = (instance instantiator . subtable)
2730 So we are using the instantiator as the key and the instance as
2731 the value. Since the hashtable is key-weak this means that the
2732 image instance will stay around as long as the instantiator stays
2733 around. The instantiator is stored in the `image' slot of the
2734 glyph, so as long as the glyph is marked the instantiator will be
2735 as well and hence the cached image instance also.*/
2736 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2737 free_cons (XCONS (XCDR (locative)));
2738 free_cons (XCONS (locative));
2742 /* Given a specification for an image, return an instance of
2743 the image which matches the given instantiator and which can be
2744 displayed in the given domain. */
2747 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2748 Lisp_Object domain, Lisp_Object instantiator,
2751 Lisp_Object device = DFW_DEVICE (domain);
2752 struct device *d = XDEVICE (device);
2753 Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2754 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2755 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2757 if (IMAGE_INSTANCEP (instantiator))
2759 /* make sure that the image instance's device and type are
2762 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2765 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2766 if (mask & dest_mask)
2767 return instantiator;
2769 signal_simple_error ("Type of image instance not allowed here",
2773 signal_simple_error_2 ("Wrong device for image instance",
2774 instantiator, device);
2776 else if (VECTORP (instantiator)
2777 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2779 assert (XVECTOR_LENGTH (instantiator) == 3);
2780 return (FACE_PROPERTY_INSTANCE
2781 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2782 Qbackground_pixmap, domain, 0, depth));
2786 Lisp_Object instance;
2787 Lisp_Object subtable;
2788 Lisp_Object ls3 = Qnil;
2789 Lisp_Object pointer_fg = Qnil;
2790 Lisp_Object pointer_bg = Qnil;
2792 /* We have to put subwindow, widget and text image instances in
2793 a per-window cache so that we can see the same glyph in
2794 different windows. Unfortunately we do not know the type of
2795 image_instance until after it has been created. We thus need
2796 to be really careful how we place things. */
2800 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2801 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2802 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2805 /* First look in the hash table. */
2806 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2808 if (UNBOUNDP (subtable))
2810 /* For the image instance cache, we do comparisons with EQ rather
2811 than with EQUAL, as we do for color and font names.
2814 1) pixmap data can be very long, and thus the hashing and
2815 comparing will take awhile.
2816 2) It's not so likely that we'll run into things that are EQUAL
2817 but not EQ (that can happen a lot with faces, because their
2818 specifiers are copied around); but pixmaps tend not to be
2821 However, if the image-instance could be a pointer, we have to
2822 use EQUAL because we massaged the instantiator into a cons3
2823 also containing the foreground and background of the
2827 subtable = make_lisp_hash_table (20,
2828 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2829 : HASH_TABLE_KEY_WEAK,
2830 pointerp ? HASH_TABLE_EQUAL
2832 Fputhash (make_int (dest_mask), subtable,
2833 d->image_instance_cache);
2834 instance = Qunbound;
2838 instance = Fgethash (pointerp ? ls3 : instantiator,
2839 subtable, Qunbound);
2840 /* subwindows have a per-window cache and have to be treated
2841 differently. dest_mask can be a bitwise OR of all image
2842 types so we will only catch someone possibly trying to
2843 instantiate a subwindow type thing. Unfortunately, this
2844 will occur most of the time so this probably slows things
2845 down. But with the current design I don't see anyway
2847 if (UNBOUNDP (instance)
2849 dest_mask & (IMAGE_SUBWINDOW_MASK
2853 && WINDOWP (domain))
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
2893 | IMAGE_TEXT_MASK ))
2895 #ifdef ERROR_CHECK_GLYPHS
2896 if (XIMAGE_INSTANCE_TYPE (instance) != IMAGE_TEXT)
2897 assert (EQ (XIMAGE_INSTANCE_SUBWINDOW_FRAME (instance),
2898 FW_FRAME (domain)));
2900 if (!WINDOWP (domain))
2901 signal_simple_error ("Can't instantiate text or subwindow outside a window",
2903 #ifdef ERROR_CHECK_GLYPHS
2904 if (XIMAGE_INSTANCE_TYPE (instance) != IMAGE_TEXT)
2905 assert (EQ (XIMAGE_INSTANCE_SUBWINDOW_FRAME (instance),
2906 FW_FRAME (domain)));
2908 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache);
2910 unbind_to (speccount, Qnil);
2911 #ifdef ERROR_CHECK_GLYPHS
2912 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2914 (IMAGE_SUBWINDOW_MASK
2917 | IMAGE_TEXT_MASK ))
2918 assert (EQ (Fgethash ((pointerp ? ls3 : instantiator),
2919 XWINDOW (domain)->subwindow_instance_cache,
2920 Qunbound), instance));
2926 if (NILP (instance))
2927 signal_simple_error ("Can't instantiate image (probably cached)",
2929 #ifdef ERROR_CHECK_GLYPHS
2930 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2931 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2932 assert (EQ (XIMAGE_INSTANCE_SUBWINDOW_FRAME (instance),
2933 FW_FRAME (domain)));
2939 return Qnil; /* not reached */
2942 /* Validate an image instantiator. */
2945 image_validate (Lisp_Object instantiator)
2947 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2949 else if (VECTORP (instantiator))
2951 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2952 int instantiator_len = XVECTOR_LENGTH (instantiator);
2953 struct image_instantiator_methods *meths;
2954 Lisp_Object already_seen = Qnil;
2955 struct gcpro gcpro1;
2958 if (instantiator_len < 1)
2959 signal_simple_error ("Vector length must be at least 1",
2962 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2963 if (!(instantiator_len & 1))
2965 ("Must have alternating keyword/value pairs", instantiator);
2967 GCPRO1 (already_seen);
2969 for (i = 1; i < instantiator_len; i += 2)
2971 Lisp_Object keyword = elt[i];
2972 Lisp_Object value = elt[i+1];
2975 CHECK_SYMBOL (keyword);
2976 if (!SYMBOL_IS_KEYWORD (keyword))
2977 signal_simple_error ("Symbol must begin with a colon", keyword);
2979 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2980 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2983 if (j == Dynarr_length (meths->keywords))
2984 signal_simple_error ("Unrecognized keyword", keyword);
2986 if (!Dynarr_at (meths->keywords, j).multiple_p)
2988 if (!NILP (memq_no_quit (keyword, already_seen)))
2990 ("Keyword may not appear more than once", keyword);
2991 already_seen = Fcons (keyword, already_seen);
2994 (Dynarr_at (meths->keywords, j).validate) (value);
2999 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
3002 signal_simple_error ("Must be string or vector", instantiator);
3006 image_after_change (Lisp_Object specifier, Lisp_Object locale)
3008 Lisp_Object attachee =
3009 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
3010 Lisp_Object property =
3011 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
3012 if (FACEP (attachee))
3013 face_property_was_changed (attachee, property, locale);
3014 else if (GLYPHP (attachee))
3015 glyph_property_was_changed (attachee, property, locale);
3019 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
3020 Lisp_Object property)
3022 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3024 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
3025 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
3029 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
3030 Lisp_Object tag_set, Lisp_Object instantiator)
3032 Lisp_Object possible_console_types = Qnil;
3034 Lisp_Object retlist = Qnil;
3035 struct gcpro gcpro1, gcpro2;
3037 LIST_LOOP (rest, Vconsole_type_list)
3039 Lisp_Object contype = XCAR (rest);
3040 if (!NILP (memq_no_quit (contype, tag_set)))
3041 possible_console_types = Fcons (contype, possible_console_types);
3044 if (XINT (Flength (possible_console_types)) > 1)
3045 /* two conflicting console types specified */
3048 if (NILP (possible_console_types))
3049 possible_console_types = Vconsole_type_list;
3051 GCPRO2 (retlist, possible_console_types);
3053 LIST_LOOP (rest, possible_console_types)
3055 Lisp_Object contype = XCAR (rest);
3056 Lisp_Object newinst = call_with_suspended_errors
3057 ((lisp_fn_t) normalize_image_instantiator,
3058 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
3059 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
3061 if (!NILP (newinst))
3064 if (NILP (memq_no_quit (contype, tag_set)))
3065 newtag = Fcons (contype, tag_set);
3068 retlist = Fcons (Fcons (newtag, newinst), retlist);
3077 /* Copy an image instantiator. We can't use Fcopy_tree since widgets
3078 may contain circular references which would send Fcopy_tree into
3081 image_copy_vector_instantiator (Lisp_Object instantiator)
3084 struct image_instantiator_methods *meths;
3086 int instantiator_len;
3088 CHECK_VECTOR (instantiator);
3090 instantiator = Fcopy_sequence (instantiator);
3091 elt = XVECTOR_DATA (instantiator);
3092 instantiator_len = XVECTOR_LENGTH (instantiator);
3094 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
3096 for (i = 1; i < instantiator_len; i += 2)
3099 Lisp_Object keyword = elt[i];
3100 Lisp_Object value = elt[i+1];
3102 /* Find the keyword entry. */
3103 for (j = 0; j < Dynarr_length (meths->keywords); j++)
3105 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
3109 /* Only copy keyword values that should be copied. */
3110 if (Dynarr_at (meths->keywords, j).copy_p
3112 (CONSP (value) || VECTORP (value)))
3114 elt [i+1] = Fcopy_tree (value, Qt);
3118 return instantiator;
3122 image_copy_instantiator (Lisp_Object arg)
3127 rest = arg = Fcopy_sequence (arg);
3128 while (CONSP (rest))
3130 Lisp_Object elt = XCAR (rest);
3132 XCAR (rest) = Fcopy_tree (elt, Qt);
3133 else if (VECTORP (elt))
3134 XCAR (rest) = image_copy_vector_instantiator (elt);
3135 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
3136 XCDR (rest) = Fcopy_tree (XCDR (rest), Qt);
3140 else if (VECTORP (arg))
3142 arg = image_copy_vector_instantiator (arg);
3147 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
3148 Return non-nil if OBJECT is an image specifier.
3150 An image specifier is used for images (pixmaps and the like). It is used
3151 to describe the actual image in a glyph. It is instanced as an image-
3154 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
3155 etc. This describes the format of the data describing the image. The
3156 resulting image instances also come in many types -- `mono-pixmap',
3157 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
3158 the image and the sorts of places it can appear. (For example, a
3159 color-pixmap image has fixed colors specified for it, while a
3160 mono-pixmap image comes in two unspecified shades "foreground" and
3161 "background" that are determined from the face of the glyph or
3162 surrounding text; a text image appears as a string of text and has an
3163 unspecified foreground, background, and font; a pointer image behaves
3164 like a mono-pixmap image but can only be used as a mouse pointer
3165 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
3166 important to keep the distinction between image instantiator format and
3167 image instance type in mind. Typically, a given image instantiator
3168 format can result in many different image instance types (for example,
3169 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
3170 whereas `cursor-font' can be instanced only as `pointer'), and a
3171 particular image instance type can be generated by many different
3172 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
3173 `gif', `jpeg', etc.).
3175 See `make-image-instance' for a more detailed discussion of image
3178 An image instantiator should be a string or a vector of the form
3180 [FORMAT :KEYWORD VALUE ...]
3182 i.e. a format symbol followed by zero or more alternating keyword-value
3183 pairs. FORMAT should be one of
3186 (Don't display anything; no keywords are valid for this.
3187 Can only be instanced as `nothing'.)
3189 (Display this image as a text string. Can only be instanced
3190 as `text', although support for instancing as `mono-pixmap'
3193 (Display this image as a text string, with replaceable fields;
3194 not currently implemented.)
3196 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
3197 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3199 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
3200 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
3202 (An X-Face bitmap, used to encode people's faces in e-mail messages;
3203 only if X-Face support was compiled into this XEmacs. Can be
3204 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
3206 (A GIF87 or GIF89 image; only if GIF support was compiled into this
3207 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
3208 Can be instanced as `color-pixmap'.)
3210 (A JPEG image; only if JPEG support was compiled into this XEmacs.
3211 Can be instanced as `color-pixmap'.)
3213 (A PNG image; only if PNG support was compiled into this XEmacs.
3214 Can be instanced as `color-pixmap'.)
3216 (A TIFF image; only if TIFF support was compiled into this XEmacs.
3217 Can be instanced as `color-pixmap'.)
3219 (One of the standard cursor-font names, such as "watch" or
3220 "right_ptr" under X. Under X, this is, more specifically, any
3221 of the standard cursor names from appendix B of the Xlib manual
3222 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
3223 On other window systems, the valid names will be specific to the
3224 type of window system. Can only be instanced as `pointer'.)
3226 (A glyph from a font; i.e. the name of a font, and glyph index into it
3227 of the form "FONT fontname index [[mask-font] mask-index]".
3228 Currently can only be instanced as `pointer', although this should
3231 (An embedded windowing system window.)
3233 (A text editing widget glyph.)
3235 (A button widget glyph; either a push button, radio button or toggle button.)
3237 (A tab widget glyph; a series of user selectable tabs.)
3239 (A sliding widget glyph, for showing progress.)
3241 (A drop list of selectable items in a widget glyph, for editing text.)
3243 (A static, text-only, widget glyph; for displaying text.)
3245 (A folding widget glyph.)
3247 (XEmacs tries to guess what format the data is in. If X support
3248 exists, the data string will be checked to see if it names a filename.
3249 If so, and this filename contains XBM or XPM data, the appropriate
3250 sort of pixmap or pointer will be created. [This includes picking up
3251 any specified hotspot or associated mask file.] Otherwise, if `pointer'
3252 is one of the allowable image-instance types and the string names a
3253 valid cursor-font name, the image will be created as a pointer.
3254 Otherwise, the image will be displayed as text. If no X support
3255 exists, the image will always be displayed as text.)
3257 Inherit from the background-pixmap property of a face.
3259 The valid keywords are:
3262 (Inline data. For most formats above, this should be a string. For
3263 XBM images, this should be a list of three elements: width, height, and
3264 a string of bit data. This keyword is not valid for instantiator
3265 formats `nothing' and `inherit'.)
3267 (Data is contained in a file. The value is the name of this file.
3268 If both :data and :file are specified, the image is created from
3269 what is specified in :data and the string in :file becomes the
3270 value of the `image-instance-file-name' function when applied to
3271 the resulting image-instance. This keyword is not valid for
3272 instantiator formats `nothing', `string', `formatted-string',
3273 `cursor-font', `font', `autodetect', and `inherit'.)
3276 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
3277 allow you to explicitly specify foreground and background colors.
3278 The argument should be anything acceptable to `make-color-instance'.
3279 This will cause what would be a `mono-pixmap' to instead be colorized
3280 as a two-color color-pixmap, and specifies the foreground and/or
3281 background colors for a pointer instead of black and white.)
3283 (For `xbm' and `xface'. This specifies a mask to be used with the
3284 bitmap. The format is a list of width, height, and bits, like for
3287 (For `xbm' and `xface'. This specifies a file containing the mask data.
3288 If neither a mask file nor inline mask data is given for an XBM image,
3289 and the XBM image comes from a file, XEmacs will look for a mask file
3290 with the same name as the image file but with "Mask" or "msk"
3291 appended. For example, if you specify the XBM file "left_ptr"
3292 [usually located in "/usr/include/X11/bitmaps"], the associated
3293 mask file "left_ptrmsk" will automatically be picked up.)
3296 (For `xbm' and `xface'. These keywords specify a hotspot if the image
3297 is instantiated as a `pointer'. Note that if the XBM image file
3298 specifies a hotspot, it will automatically be picked up if no
3299 explicit hotspot is given.)
3301 (Only for `xpm'. This specifies an alist that maps strings
3302 that specify symbolic color names to the actual color to be used
3303 for that symbolic color (in the form of a string or a color-specifier
3304 object). If this is not specified, the contents of `xpm-color-symbols'
3305 are used to generate the alist.)
3307 (Only for `inherit'. This specifies the face to inherit from.
3308 For widget glyphs this also specifies the face to use for
3309 display. It defaults to gui-element-face.)
3311 Keywords accepted as menu item specs are also accepted by widget
3312 glyphs. These are `:selected', `:active', `:suffix', `:keys',
3313 `:style', `:filter', `:config', `:included', `:key-sequence',
3314 `:accelerator', `:label' and `:callback'.
3316 If instead of a vector, the instantiator is a string, it will be
3317 converted into a vector by looking it up according to the specs in the
3318 `console-type-image-conversion-list' (q.v.) for the console type of
3319 the domain (usually a window; sometimes a frame or device) over which
3320 the image is being instantiated.
3322 If the instantiator specifies data from a file, the data will be read
3323 in at the time that the instantiator is added to the image (which may
3324 be well before when the image is actually displayed), and the
3325 instantiator will be converted into one of the inline-data forms, with
3326 the filename retained using a :file keyword. This implies that the
3327 file must exist when the instantiator is added to the image, but does
3328 not need to exist at any other time (e.g. it may safely be a temporary
3333 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
3337 /****************************************************************************
3339 ****************************************************************************/
3342 mark_glyph (Lisp_Object obj)
3344 Lisp_Glyph *glyph = XGLYPH (obj);
3346 mark_object (glyph->image);
3347 mark_object (glyph->contrib_p);
3348 mark_object (glyph->baseline);
3349 mark_object (glyph->face);
3351 return glyph->plist;
3355 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3357 Lisp_Glyph *glyph = XGLYPH (obj);
3361 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
3363 write_c_string ("#<glyph (", printcharfun);
3364 print_internal (Fglyph_type (obj), printcharfun, 0);
3365 write_c_string (") ", printcharfun);
3366 print_internal (glyph->image, printcharfun, 1);
3367 sprintf (buf, "0x%x>", glyph->header.uid);
3368 write_c_string (buf, printcharfun);
3371 /* Glyphs are equal if all of their display attributes are equal. We
3372 don't compare names or doc-strings, because that would make equal
3375 This isn't concerned with "unspecified" attributes, that's what
3376 #'glyph-differs-from-default-p is for. */
3378 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3380 Lisp_Glyph *g1 = XGLYPH (obj1);
3381 Lisp_Glyph *g2 = XGLYPH (obj2);
3385 return (internal_equal (g1->image, g2->image, depth) &&
3386 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
3387 internal_equal (g1->baseline, g2->baseline, depth) &&
3388 internal_equal (g1->face, g2->face, depth) &&
3389 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
3392 static unsigned long
3393 glyph_hash (Lisp_Object obj, int depth)
3397 /* No need to hash all of the elements; that would take too long.
3398 Just hash the most common ones. */
3399 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
3400 internal_hash (XGLYPH (obj)->face, depth));
3404 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
3406 Lisp_Glyph *g = XGLYPH (obj);
3408 if (EQ (prop, Qimage)) return g->image;
3409 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
3410 if (EQ (prop, Qbaseline)) return g->baseline;
3411 if (EQ (prop, Qface)) return g->face;
3413 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
3417 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3419 if (EQ (prop, Qimage) ||
3420 EQ (prop, Qcontrib_p) ||
3421 EQ (prop, Qbaseline))
3424 if (EQ (prop, Qface))
3426 XGLYPH (obj)->face = Fget_face (value);
3430 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
3435 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
3437 if (EQ (prop, Qimage) ||
3438 EQ (prop, Qcontrib_p) ||
3439 EQ (prop, Qbaseline))
3442 if (EQ (prop, Qface))
3444 XGLYPH (obj)->face = Qnil;
3448 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
3452 glyph_plist (Lisp_Object obj)
3454 Lisp_Glyph *glyph = XGLYPH (obj);
3455 Lisp_Object result = glyph->plist;
3457 result = cons3 (Qface, glyph->face, result);
3458 result = cons3 (Qbaseline, glyph->baseline, result);
3459 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
3460 result = cons3 (Qimage, glyph->image, result);
3465 static const struct lrecord_description glyph_description[] = {
3466 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) },
3467 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) },
3468 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) },
3469 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) },
3470 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) },
3474 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
3475 mark_glyph, print_glyph, 0,
3476 glyph_equal, glyph_hash, glyph_description,
3477 glyph_getprop, glyph_putprop,
3478 glyph_remprop, glyph_plist,
3482 allocate_glyph (enum glyph_type type,
3483 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
3484 Lisp_Object locale))
3486 /* This function can GC */
3487 Lisp_Object obj = Qnil;
3488 Lisp_Glyph *g = alloc_lcrecord_type (Lisp_Glyph, &lrecord_glyph);
3491 g->image = Fmake_specifier (Qimage); /* This function can GC */
3496 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3497 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
3498 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
3499 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK
3500 | IMAGE_LAYOUT_MASK;
3503 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3504 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
3507 XIMAGE_SPECIFIER_ALLOWED (g->image) =
3508 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK
3509 | IMAGE_COLOR_PIXMAP_MASK;
3515 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
3516 /* We're getting enough reports of odd behavior in this area it seems */
3517 /* best to GCPRO everything. */
3519 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3520 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3521 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3522 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3524 GCPRO4 (obj, tem1, tem2, tem3);
3526 set_specifier_fallback (g->image, tem1);
3527 g->contrib_p = Fmake_specifier (Qboolean);
3528 set_specifier_fallback (g->contrib_p, tem2);
3529 /* #### should have a specifier for the following */
3530 g->baseline = Fmake_specifier (Qgeneric);
3531 set_specifier_fallback (g->baseline, tem3);
3534 g->after_change = after_change;
3537 set_image_attached_to (g->image, obj, Qimage);
3544 static enum glyph_type
3545 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3548 return GLYPH_BUFFER;
3550 if (ERRB_EQ (errb, ERROR_ME))
3551 CHECK_SYMBOL (type);
3553 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3554 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3555 if (EQ (type, Qicon)) return GLYPH_ICON;
3557 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3559 return GLYPH_UNKNOWN;
3563 valid_glyph_type_p (Lisp_Object type)
3565 return !NILP (memq_no_quit (type, Vglyph_type_list));
3568 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3569 Given a GLYPH-TYPE, return non-nil if it is valid.
3570 Valid types are `buffer', `pointer', and `icon'.
3574 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3577 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3578 Return a list of valid glyph types.
3582 return Fcopy_sequence (Vglyph_type_list);
3585 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3586 Create and return a new uninitialized glyph or type TYPE.
3588 TYPE specifies the type of the glyph; this should be one of `buffer',
3589 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3590 specifies in which contexts the glyph can be used, and controls the
3591 allowable image types into which the glyph's image can be
3594 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3595 extent, in the modeline, and in the toolbar. Their image can be
3596 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3599 `pointer' glyphs can be used to specify the mouse pointer. Their
3600 image can be instantiated as `pointer'.
3602 `icon' glyphs can be used to specify the icon used when a frame is
3603 iconified. Their image can be instantiated as `mono-pixmap' and
3608 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3609 return allocate_glyph (typeval, 0);
3612 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3613 Return non-nil if OBJECT is a glyph.
3615 A glyph is an object used for pixmaps and the like. It is used
3616 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3617 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3618 buttons, and the like. Its image is described using an image specifier --
3619 see `image-specifier-p'.
3623 return GLYPHP (object) ? Qt : Qnil;
3626 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3627 Return the type of the given glyph.
3628 The return value will be one of 'buffer, 'pointer, or 'icon.
3632 CHECK_GLYPH (glyph);
3633 switch (XGLYPH_TYPE (glyph))
3636 case GLYPH_BUFFER: return Qbuffer;
3637 case GLYPH_POINTER: return Qpointer;
3638 case GLYPH_ICON: return Qicon;
3643 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3644 Error_behavior errb, int no_quit)
3646 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3648 /* This can never return Qunbound. All glyphs have 'nothing as
3650 Lisp_Object image_instance = specifier_instance (specifier, Qunbound,
3651 domain, errb, no_quit, 0,
3653 assert (!UNBOUNDP (image_instance));
3655 return image_instance;
3659 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window)
3661 Lisp_Object instance = glyph_or_image;
3663 if (GLYPHP (glyph_or_image))
3664 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3669 /*****************************************************************************
3672 Return the width of the given GLYPH on the given WINDOW.
3673 Calculations are done based on recursively querying the geometry of
3674 the associated image instances.
3675 ****************************************************************************/
3677 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain)
3679 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3681 if (!IMAGE_INSTANCEP (instance))
3684 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3685 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3686 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3688 return XIMAGE_INSTANCE_WIDTH (instance);
3691 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3692 Return the width of GLYPH on WINDOW.
3693 This may not be exact as it does not take into account all of the context
3694 that redisplay will.
3698 XSETWINDOW (window, decode_window (window));
3699 CHECK_GLYPH (glyph);
3701 return make_int (glyph_width (glyph, window));
3705 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain)
3707 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3709 if (!IMAGE_INSTANCEP (instance))
3712 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3713 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3714 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3716 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3717 return XIMAGE_INSTANCE_TEXT_ASCENT (instance);
3719 return XIMAGE_INSTANCE_HEIGHT (instance);
3723 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain)
3725 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3727 if (!IMAGE_INSTANCEP (instance))
3730 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3731 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3732 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3734 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3735 return XIMAGE_INSTANCE_TEXT_DESCENT (instance);
3740 /* strictly a convenience function. */
3742 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain)
3744 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3747 if (!IMAGE_INSTANCEP (instance))
3750 if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3751 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3752 IMAGE_UNSPECIFIED_GEOMETRY, domain);
3754 return XIMAGE_INSTANCE_HEIGHT (instance);
3757 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3758 Return the ascent value of GLYPH on WINDOW.
3759 This may not be exact as it does not take into account all of the context
3760 that redisplay will.
3764 XSETWINDOW (window, decode_window (window));
3765 CHECK_GLYPH (glyph);
3767 return make_int (glyph_ascent (glyph, window));
3770 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3771 Return the descent value of GLYPH on WINDOW.
3772 This may not be exact as it does not take into account all of the context
3773 that redisplay will.
3777 XSETWINDOW (window, decode_window (window));
3778 CHECK_GLYPH (glyph);
3780 return make_int (glyph_descent (glyph, window));
3783 /* This is redundant but I bet a lot of people expect it to exist. */
3784 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3785 Return the height of GLYPH on WINDOW.
3786 This may not be exact as it does not take into account all of the context
3787 that redisplay will.
3791 XSETWINDOW (window, decode_window (window));
3792 CHECK_GLYPH (glyph);
3794 return make_int (glyph_height (glyph, window));
3798 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty)
3800 Lisp_Object instance = glyph_or_image;
3802 if (!NILP (glyph_or_image))
3804 if (GLYPHP (glyph_or_image))
3806 instance = glyph_image_instance (glyph_or_image, window,
3808 XGLYPH_DIRTYP (glyph_or_image) = dirty;
3811 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
3816 set_image_instance_dirty_p (Lisp_Object instance, int dirty)
3818 if (IMAGE_INSTANCEP (instance))
3820 XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
3821 /* Now cascade up the hierarchy. */
3822 set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance),
3825 else if (GLYPHP (instance))
3827 XGLYPH_DIRTYP (instance) = dirty;
3831 /* #### do we need to cache this info to speed things up? */
3834 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3836 if (!GLYPHP (glyph))
3840 Lisp_Object retval =
3841 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3842 /* #### look into ERROR_ME_NOT */
3843 Qunbound, domain, ERROR_ME_NOT,
3845 if (!NILP (retval) && !INTP (retval))
3847 else if (INTP (retval))
3849 if (XINT (retval) < 0)
3851 if (XINT (retval) > 100)
3852 retval = make_int (100);
3859 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3861 /* #### Domain parameter not currently used but it will be */
3862 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3866 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3868 if (!GLYPHP (glyph))
3871 return !NILP (specifier_instance_no_quit
3872 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3873 /* #### look into ERROR_ME_NOT */
3874 ERROR_ME_NOT, 0, Qzero));
3878 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3881 if (XGLYPH (glyph)->after_change)
3882 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3885 #if 0 /* Not used for now */
3887 glyph_query_geometry (Lisp_Object glyph_or_image, Lisp_Object window,
3888 unsigned int* width, unsigned int* height,
3889 enum image_instance_geometry disp, Lisp_Object domain)
3891 Lisp_Object instance = glyph_or_image;
3893 if (GLYPHP (glyph_or_image))
3894 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3896 image_instance_query_geometry (instance, width, height, disp, domain);
3900 glyph_layout (Lisp_Object glyph_or_image, Lisp_Object window,
3901 unsigned int width, unsigned int height, Lisp_Object domain)
3903 Lisp_Object instance = glyph_or_image;
3905 if (GLYPHP (glyph_or_image))
3906 instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3908 image_instance_layout (instance, width, height, domain);
3913 /*****************************************************************************
3914 * glyph cachel functions *
3915 *****************************************************************************/
3917 /* #### All of this is 95% copied from face cachels. Consider
3920 Why do we need glyph_cachels? Simply because a glyph_cachel captures
3921 per-window information about a particular glyph. A glyph itself is
3922 not created in any particular context, so if we were to rely on a
3923 glyph to tell us about its dirtiness we would not be able to reset
3924 the dirty flag after redisplaying it as it may exist in other
3925 contexts. When we have redisplayed we need to know which glyphs to
3926 reset the dirty flags on - the glyph_cachels give us a nice list we
3927 can iterate through doing this. */
3929 mark_glyph_cachels (glyph_cachel_dynarr *elements)
3936 for (elt = 0; elt < Dynarr_length (elements); elt++)
3938 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3939 mark_object (cachel->glyph);
3944 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3945 struct glyph_cachel *cachel)
3947 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)
3948 || XGLYPH_DIRTYP (cachel->glyph)
3949 || XFRAME(WINDOW_FRAME(w))->faces_changed)
3951 Lisp_Object window, instance;
3953 XSETWINDOW (window, w);
3955 cachel->glyph = glyph;
3956 /* Speed things up slightly by grabbing the glyph instantiation
3957 and passing it to the size functions. */
3958 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3960 /* Mark text instance of the glyph dirty if faces have changed,
3961 because its geometry might have changed. */
3962 invalidate_glyph_geometry_maybe (instance, w);
3964 /* #### Do the following 2 lines buy us anything? --kkm */
3965 XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance);
3966 cachel->dirty = XGLYPH_DIRTYP (glyph);
3967 cachel->width = glyph_width (instance, window);
3968 cachel->ascent = glyph_ascent (instance, window);
3969 cachel->descent = glyph_descent (instance, window);
3972 cachel->updated = 1;
3976 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3978 struct glyph_cachel new_cachel;
3981 new_cachel.glyph = Qnil;
3983 update_glyph_cachel_data (w, glyph, &new_cachel);
3984 Dynarr_add (w->glyph_cachels, new_cachel);
3988 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3995 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3997 struct glyph_cachel *cachel =
3998 Dynarr_atp (w->glyph_cachels, elt);
4000 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
4002 update_glyph_cachel_data (w, glyph, cachel);
4007 /* If we didn't find the glyph, add it and then return its index. */
4008 add_glyph_cachel (w, glyph);
4013 reset_glyph_cachels (struct window *w)
4015 Dynarr_reset (w->glyph_cachels);
4016 get_glyph_cachel_index (w, Vcontinuation_glyph);
4017 get_glyph_cachel_index (w, Vtruncation_glyph);
4018 get_glyph_cachel_index (w, Vhscroll_glyph);
4019 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
4020 get_glyph_cachel_index (w, Voctal_escape_glyph);
4021 get_glyph_cachel_index (w, Vinvisible_text_glyph);
4025 mark_glyph_cachels_as_not_updated (struct window *w)
4029 /* We need to have a dirty flag to tell if the glyph has changed.
4030 We can check to see if each glyph variable is actually a
4031 completely different glyph, though. */
4032 #define FROB(glyph_obj, gindex) \
4033 update_glyph_cachel_data (w, glyph_obj, \
4034 Dynarr_atp (w->glyph_cachels, gindex))
4036 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
4037 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
4038 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
4039 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
4040 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
4041 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
4044 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4046 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
4050 /* Unset the dirty bit on all the glyph cachels that have it. */
4052 mark_glyph_cachels_as_clean (struct window* w)
4056 XSETWINDOW (window, w);
4057 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4059 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt);
4061 set_glyph_dirty_p (cachel->glyph, window, 0);
4065 #ifdef MEMORY_USAGE_STATS
4068 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
4069 struct overhead_stats *ovstats)
4074 total += Dynarr_memory_usage (glyph_cachels, ovstats);
4079 #endif /* MEMORY_USAGE_STATS */
4083 /*****************************************************************************
4084 * subwindow cachel functions *
4085 *****************************************************************************/
4086 /* Subwindows are curious in that you have to physically unmap them to
4087 not display them. It is problematic deciding what to do in
4088 redisplay. We have two caches - a per-window instance cache that
4089 keeps track of subwindows on a window, these are linked to their
4090 instantiator in the hashtable and when the instantiator goes away
4091 we want the instance to go away also. However we also have a
4092 per-frame instance cache that we use to determine if a subwindow is
4093 obscuring an area that we want to clear. We need to be able to flip
4094 through this quickly so a hashtable is not suitable hence the
4095 subwindow_cachels. The question is should we just not mark
4096 instances in the subwindow_cachels or should we try and invalidate
4097 the cache at suitable points in redisplay? If we don't invalidate
4098 the cache it will fill up with crud that will only get removed when
4099 the frame is deleted. So invalidation is good, the question is when
4100 and whether we mark as well. Go for the simple option - don't mark,
4101 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
4104 mark_subwindow_cachels (subwindow_cachel_dynarr *elements)
4111 for (elt = 0; elt < Dynarr_length (elements); elt++)
4113 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
4114 mark_object (cachel->subwindow);
4119 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
4120 struct subwindow_cachel *cachel)
4122 cachel->subwindow = subwindow;
4123 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
4124 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
4125 cachel->updated = 1;
4129 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
4131 struct subwindow_cachel new_cachel;
4134 new_cachel.subwindow = Qnil;
4137 new_cachel.being_displayed=0;
4139 update_subwindow_cachel_data (f, subwindow, &new_cachel);
4140 Dynarr_add (f->subwindow_cachels, new_cachel);
4144 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
4151 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4153 struct subwindow_cachel *cachel =
4154 Dynarr_atp (f->subwindow_cachels, elt);
4156 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
4158 if (!cachel->updated)
4159 update_subwindow_cachel_data (f, subwindow, cachel);
4164 /* If we didn't find the glyph, add it and then return its index. */
4165 add_subwindow_cachel (f, subwindow);
4170 update_subwindow_cachel (Lisp_Object subwindow)
4175 if (NILP (subwindow))
4178 f = XFRAME ( XIMAGE_INSTANCE_SUBWINDOW_FRAME (subwindow));
4180 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4182 struct subwindow_cachel *cachel =
4183 Dynarr_atp (f->subwindow_cachels, elt);
4185 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
4187 update_subwindow_cachel_data (f, subwindow, cachel);
4192 /* redisplay in general assumes that drawing something will erase
4193 what was there before. unfortunately this does not apply to
4194 subwindows that need to be specifically unmapped in order to
4195 disappear. we take a brute force approach - on the basis that its
4196 cheap - and unmap all subwindows in a display line */
4198 reset_subwindow_cachels (struct frame *f)
4201 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4203 struct subwindow_cachel *cachel =
4204 Dynarr_atp (f->subwindow_cachels, elt);
4206 if (!NILP (cachel->subwindow) && cachel->being_displayed)
4208 cachel->updated = 1;
4209 /* #### This is not optimal as update_subwindow will search
4210 the cachels for ourselves as well. We could easily optimize. */
4211 unmap_subwindow (cachel->subwindow);
4214 Dynarr_reset (f->subwindow_cachels);
4218 mark_subwindow_cachels_as_not_updated (struct frame *f)
4222 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4223 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
4228 /*****************************************************************************
4229 * subwindow exposure ignorance *
4230 *****************************************************************************/
4231 /* when we unmap subwindows the associated window system will generate
4232 expose events. This we do not want as redisplay already copes with
4233 the repainting necessary. Worse, we can get in an endless cycle of
4234 redisplay if we are not careful. Thus we keep a per-frame list of
4235 expose events that are going to come and ignore them as
4238 struct expose_ignore_blocktype
4240 Blocktype_declare (struct expose_ignore);
4241 } *the_expose_ignore_blocktype;
4244 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
4246 struct expose_ignore *ei, *prev;
4247 /* the ignore list is FIFO so we should generally get a match with
4248 the first element in the list */
4249 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next)
4251 /* Checking for exact matches just isn't good enough as we
4252 mighte get exposures for partially obscure subwindows, thus
4253 we have to check for overlaps. Being conservative we will
4254 check for exposures wholly contained by the subwindow, this
4255 might give us what we want.*/
4256 if (ei->x <= x && ei->y <= y
4257 && ei->x + ei->width >= x + width
4258 && ei->y + ei->height >= y + height)
4260 #ifdef DEBUG_WIDGETS
4261 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n",
4262 x, y, width, height, ei->x, ei->y, ei->width, ei->height);
4265 f->subwindow_exposures = ei->next;
4267 prev->next = ei->next;
4269 if (ei == f->subwindow_exposures_tail)
4270 f->subwindow_exposures_tail = prev;
4272 Blocktype_free (the_expose_ignore_blocktype, ei);
4281 register_ignored_expose (struct frame* f, int x, int y, int width, int height)
4283 if (!hold_ignored_expose_registration)
4285 struct expose_ignore *ei;
4287 ei = Blocktype_alloc (the_expose_ignore_blocktype);
4293 ei->height = height;
4295 /* we have to add the exposure to the end of the list, since we
4296 want to check the oldest events first. for speed we keep a record
4297 of the end so that we can add right to it. */
4298 if (f->subwindow_exposures_tail)
4300 f->subwindow_exposures_tail->next = ei;
4302 if (!f->subwindow_exposures)
4304 f->subwindow_exposures = ei;
4306 f->subwindow_exposures_tail = ei;
4310 /****************************************************************************
4311 find_matching_subwindow
4313 See if there is a subwindow that completely encloses the requested
4315 ****************************************************************************/
4316 int find_matching_subwindow (struct frame* f, int x, int y, int width, int height)
4320 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4322 struct subwindow_cachel *cachel =
4323 Dynarr_atp (f->subwindow_cachels, elt);
4325 if (cachel->being_displayed
4327 cachel->x <= x && cachel->y <= y
4329 cachel->x + cachel->width >= x + width
4331 cachel->y + cachel->height >= y + height)
4340 /*****************************************************************************
4341 * subwindow functions *
4342 *****************************************************************************/
4344 /* Update the displayed characteristics of a subwindow. This function
4345 should generally only get called if the subwindow is actually
4348 update_subwindow (Lisp_Object subwindow)
4350 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4351 int count = specpdl_depth ();
4353 /* The update method is allowed to call eval. Since it is quite
4354 common for this function to get called from somewhere in
4355 redisplay we need to make sure that quits are ignored. Otherwise
4356 Fsignal will abort. */
4357 specbind (Qinhibit_quit, Qt);
4359 if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4361 IMAGE_INSTANCE_TYPE (ii) == IMAGE_LAYOUT)
4363 if (image_instance_changed (subwindow))
4364 update_widget (subwindow);
4365 /* Reset the changed flags. */
4366 IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0;
4367 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0;
4368 IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0;
4370 else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW
4372 !NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4374 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
4377 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0;
4378 /* This function is typically called by redisplay just before
4379 outputting the information to the screen. Thus we record a hash
4380 of the output to determine whether on-screen is the same as
4381 recorded structure. This approach has limitations in there is a
4382 good chance that hash values will be different for the same
4383 visual appearance. However, we would rather that then the other
4384 way round - it simply means that we will get more displays than
4385 we might need. We can get better hashing by making the depth
4386 negative - currently it will recurse down 7 levels.*/
4387 IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow,
4388 IMAGE_INSTANCE_HASH_DEPTH);
4390 unbind_to (count, Qnil);
4394 image_instance_changed (Lisp_Object subwindow)
4396 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4398 if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) !=
4399 IMAGE_INSTANCE_DISPLAY_HASH (ii))
4401 else if ((WIDGET_IMAGE_INSTANCEP (subwindow)
4402 || LAYOUT_IMAGE_INSTANCEP (subwindow))
4403 && !internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (ii),
4404 IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii), 0))
4410 /* Update all the subwindows on a frame. */
4411 DEFUN ("update-widget-instances", Fupdate_widget_instances,1, 1, 0, /*
4412 Given a FRAME, re-evaluate the display hash code for all widgets in the frame.
4419 CHECK_FRAME (frame);
4422 /* If we get called we know something has changed. */
4423 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
4425 struct subwindow_cachel *cachel =
4426 Dynarr_atp (f->subwindow_cachels, elt);
4428 if (cachel->being_displayed &&
4429 image_instance_changed (cachel->subwindow))
4431 set_image_instance_dirty_p (cachel->subwindow, 1);
4432 MARK_FRAME_GLYPHS_CHANGED (f);
4438 /* remove a subwindow from its frame */
4439 void unmap_subwindow (Lisp_Object subwindow)
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)))
4452 #ifdef DEBUG_WIDGETS
4453 stderr_out ("unmapping subwindow %d\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
4455 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4456 elt = get_subwindow_cachel_index (f, subwindow);
4457 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4459 /* make sure we don't get expose events */
4460 register_ignored_expose (f, cachel->x, cachel->y, cachel->width, cachel->height);
4463 cachel->being_displayed = 0;
4464 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4466 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
4469 /* show a subwindow in its frame */
4470 void map_subwindow (Lisp_Object subwindow, int x, int y,
4471 struct display_glyph_area *dga)
4473 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4475 struct subwindow_cachel* cachel;
4478 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
4480 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
4482 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
4485 #ifdef DEBUG_WIDGETS
4486 stderr_out ("mapping subwindow %d, %dx%d@%d+%d\n",
4487 IMAGE_INSTANCE_SUBWINDOW_ID (ii),
4488 dga->width, dga->height, x, y);
4490 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
4491 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
4492 elt = get_subwindow_cachel_index (f, subwindow);
4493 cachel = Dynarr_atp (f->subwindow_cachels, elt);
4496 cachel->width = dga->width;
4497 cachel->height = dga->height;
4498 cachel->being_displayed = 1;
4500 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y, dga));
4504 subwindow_possible_dest_types (void)
4506 return IMAGE_SUBWINDOW_MASK;
4509 /* Partially instantiate a subwindow. */
4511 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
4512 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
4513 int dest_mask, Lisp_Object domain)
4515 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
4516 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
4517 Lisp_Object frame = FW_FRAME (domain);
4518 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
4519 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
4522 signal_simple_error ("No selected frame", device);
4524 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
4525 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
4528 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
4529 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4530 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
4532 /* #### This stuff may get overidden by the widget code and is
4533 actually really dumb now that we have dynamic geometry
4534 calculations. What should really happen is that the subwindow
4535 should query its child for an appropriate geometry. */
4539 if (XINT (width) > 1)
4541 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
4544 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
4549 if (XINT (height) > 1)
4551 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
4554 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
4557 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
4558 Return non-nil if OBJECT is a subwindow.
4562 CHECK_IMAGE_INSTANCE (object);
4563 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
4566 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
4567 Return the window id of SUBWINDOW as a number.
4571 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4572 return make_int ((int) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow));
4575 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
4576 Resize SUBWINDOW to WIDTH x HEIGHT.
4577 If a value is nil that parameter is not changed.
4579 (subwindow, width, height))
4582 Lisp_Image_Instance* ii;
4584 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4585 ii = XIMAGE_INSTANCE (subwindow);
4588 neww = IMAGE_INSTANCE_WIDTH (ii);
4590 neww = XINT (width);
4593 newh = IMAGE_INSTANCE_HEIGHT (ii);
4595 newh = XINT (height);
4597 /* The actual resizing gets done asychronously by
4598 update_subwindow. */
4599 IMAGE_INSTANCE_HEIGHT (ii) = newh;
4600 IMAGE_INSTANCE_WIDTH (ii) = neww;
4601 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
4603 /* need to update the cachels as redisplay will not do this */
4604 update_subwindow_cachel (subwindow);
4609 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
4610 Generate a Map event for SUBWINDOW.
4614 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4616 map_subwindow (subwindow, 0, 0);
4622 /*****************************************************************************
4624 *****************************************************************************/
4626 /* Get the display tables for use currently on window W with face
4627 FACE. #### This will have to be redone. */
4630 get_display_tables (struct window *w, face_index findex,
4631 Lisp_Object *face_table, Lisp_Object *window_table)
4634 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
4638 tem = noseeum_cons (tem, Qnil);
4640 tem = w->display_table;
4644 tem = noseeum_cons (tem, Qnil);
4645 *window_table = tem;
4649 display_table_entry (Emchar ch, Lisp_Object face_table,
4650 Lisp_Object window_table)
4654 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
4655 for (tail = face_table; 1; tail = XCDR (tail))
4660 if (!NILP (window_table))
4662 tail = window_table;
4663 window_table = Qnil;
4668 table = XCAR (tail);
4670 if (VECTORP (table))
4672 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
4673 return XVECTOR_DATA (table)[ch];
4677 else if (CHAR_TABLEP (table)
4678 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
4680 return get_char_table (ch, XCHAR_TABLE (table));
4682 else if (CHAR_TABLEP (table)
4683 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
4685 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
4691 else if (RANGE_TABLEP (table))
4693 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
4704 /*****************************************************************************
4705 * timeouts for animated glyphs *
4706 *****************************************************************************/
4707 static Lisp_Object Qglyph_animated_timeout_handler;
4709 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /*
4710 Callback function for updating animated images.
4715 CHECK_WEAK_LIST (arg);
4717 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg))))
4719 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg));
4721 if (IMAGE_INSTANCEP (value))
4723 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value);
4725 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value)
4727 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1
4729 !disable_animated_pixmaps)
4731 /* Increment the index of the image slice we are currently
4733 IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
4734 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
4735 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
4736 /* We might need to kick redisplay at this point - but we
4738 MARK_DEVICE_FRAMES_GLYPHS_CHANGED
4739 (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)));
4740 /* Cascade dirtiness so that we can have an animated glyph in a layout
4742 set_image_instance_dirty_p (value, 1);
4749 Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image)
4751 Lisp_Object ret = Qnil;
4753 if (tickms > 0 && IMAGE_INSTANCEP (image))
4755 double ms = ((double)tickms) / 1000.0;
4756 struct gcpro gcpro1;
4757 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE);
4760 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil);
4762 ret = Fadd_timeout (make_float (ms),
4763 Qglyph_animated_timeout_handler,
4764 holder, make_float (ms));
4771 void disable_glyph_animated_timeout (int i)
4776 Fdisable_timeout (id);
4780 /*****************************************************************************
4782 *****************************************************************************/
4785 syms_of_glyphs (void)
4787 INIT_LRECORD_IMPLEMENTATION (glyph);
4788 INIT_LRECORD_IMPLEMENTATION (image_instance);
4790 /* image instantiators */
4792 DEFSUBR (Fimage_instantiator_format_list);
4793 DEFSUBR (Fvalid_image_instantiator_format_p);
4794 DEFSUBR (Fset_console_type_image_conversion_list);
4795 DEFSUBR (Fconsole_type_image_conversion_list);
4796 DEFSUBR (Fupdate_widget_instances);
4798 defkeyword (&Q_file, ":file");
4799 defkeyword (&Q_data, ":data");
4800 defkeyword (&Q_face, ":face");
4801 defkeyword (&Q_pixel_height, ":pixel-height");
4802 defkeyword (&Q_pixel_width, ":pixel-width");
4805 defkeyword (&Q_color_symbols, ":color-symbols");
4807 #ifdef HAVE_WINDOW_SYSTEM
4808 defkeyword (&Q_mask_file, ":mask-file");
4809 defkeyword (&Q_mask_data, ":mask-data");
4810 defkeyword (&Q_hotspot_x, ":hotspot-x");
4811 defkeyword (&Q_hotspot_y, ":hotspot-y");
4812 defkeyword (&Q_foreground, ":foreground");
4813 defkeyword (&Q_background, ":background");
4815 /* image specifiers */
4817 DEFSUBR (Fimage_specifier_p);
4818 /* Qimage in general.c */
4820 /* image instances */
4822 defsymbol (&Qimage_instancep, "image-instance-p");
4824 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
4825 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
4826 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
4827 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
4828 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
4829 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
4830 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
4831 defsymbol (&Qlayout_image_instance_p, "layout-image-instance-p");
4832 defsymbol (&Qupdate_widget_instances, "update-widget-instances");
4834 DEFSUBR (Fmake_image_instance);
4835 DEFSUBR (Fimage_instance_p);
4836 DEFSUBR (Fimage_instance_type);
4837 DEFSUBR (Fvalid_image_instance_type_p);
4838 DEFSUBR (Fimage_instance_type_list);
4839 DEFSUBR (Fimage_instance_name);
4840 DEFSUBR (Fimage_instance_string);
4841 DEFSUBR (Fimage_instance_file_name);
4842 DEFSUBR (Fimage_instance_mask_file_name);
4843 DEFSUBR (Fimage_instance_depth);
4844 DEFSUBR (Fimage_instance_height);
4845 DEFSUBR (Fimage_instance_width);
4846 DEFSUBR (Fimage_instance_hotspot_x);
4847 DEFSUBR (Fimage_instance_hotspot_y);
4848 DEFSUBR (Fimage_instance_foreground);
4849 DEFSUBR (Fimage_instance_background);
4850 DEFSUBR (Fimage_instance_property);
4851 DEFSUBR (Fset_image_instance_property);
4852 DEFSUBR (Fcolorize_image_instance);
4854 DEFSUBR (Fsubwindowp);
4855 DEFSUBR (Fimage_instance_subwindow_id);
4856 DEFSUBR (Fresize_subwindow);
4857 DEFSUBR (Fforce_subwindow_map);
4859 /* Qnothing defined as part of the "nothing" image-instantiator
4861 /* Qtext defined in general.c */
4862 defsymbol (&Qmono_pixmap, "mono-pixmap");
4863 defsymbol (&Qcolor_pixmap, "color-pixmap");
4864 /* Qpointer defined in general.c */
4868 defsymbol (&Qglyphp, "glyphp");
4869 defsymbol (&Qcontrib_p, "contrib-p");
4870 defsymbol (&Qbaseline, "baseline");
4872 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4873 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4874 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4876 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4878 DEFSUBR (Fglyph_type);
4879 DEFSUBR (Fvalid_glyph_type_p);
4880 DEFSUBR (Fglyph_type_list);
4882 DEFSUBR (Fmake_glyph_internal);
4883 DEFSUBR (Fglyph_width);
4884 DEFSUBR (Fglyph_ascent);
4885 DEFSUBR (Fglyph_descent);
4886 DEFSUBR (Fglyph_height);
4888 /* Qbuffer defined in general.c. */
4889 /* Qpointer defined above */
4891 /* Unfortunately, timeout handlers must be lisp functions. This is
4892 for animated glyphs. */
4893 defsymbol (&Qglyph_animated_timeout_handler,
4894 "glyph-animated-timeout-handler");
4895 DEFSUBR (Fglyph_animated_timeout_handler);
4898 deferror (&Qimage_conversion_error,
4899 "image-conversion-error",
4900 "image-conversion error", Qio_error);
4904 static const struct lrecord_description image_specifier_description[] = {
4905 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee) },
4906 { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee_property) },
4911 specifier_type_create_image (void)
4913 /* image specifiers */
4915 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4917 SPECIFIER_HAS_METHOD (image, create);
4918 SPECIFIER_HAS_METHOD (image, mark);
4919 SPECIFIER_HAS_METHOD (image, instantiate);
4920 SPECIFIER_HAS_METHOD (image, validate);
4921 SPECIFIER_HAS_METHOD (image, after_change);
4922 SPECIFIER_HAS_METHOD (image, going_to_add);
4923 SPECIFIER_HAS_METHOD (image, copy_instantiator);
4927 reinit_specifier_type_create_image (void)
4929 REINITIALIZE_SPECIFIER_TYPE (image);
4933 static const struct lrecord_description iike_description_1[] = {
4934 { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) },
4938 static const struct struct_description iike_description = {
4939 sizeof (ii_keyword_entry),
4943 static const struct lrecord_description iiked_description_1[] = {
4944 XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description),
4948 static const struct struct_description iiked_description = {
4949 sizeof (ii_keyword_entry_dynarr),
4953 static const struct lrecord_description iife_description_1[] = {
4954 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) },
4955 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) },
4956 { XD_STRUCT_PTR, offsetof (image_instantiator_format_entry, meths), 1, &iim_description },
4960 static const struct struct_description iife_description = {
4961 sizeof (image_instantiator_format_entry),
4965 static const struct lrecord_description iifed_description_1[] = {
4966 XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description),
4970 static const struct struct_description iifed_description = {
4971 sizeof (image_instantiator_format_entry_dynarr),
4975 static const struct lrecord_description iim_description_1[] = {
4976 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) },
4977 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) },
4978 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, keywords), 1, &iiked_description },
4979 { XD_STRUCT_PTR, offsetof (struct image_instantiator_methods, consoles), 1, &cted_description },
4983 const struct struct_description iim_description = {
4984 sizeof(struct image_instantiator_methods),
4989 image_instantiator_format_create (void)
4991 /* image instantiators */
4993 the_image_instantiator_format_entry_dynarr =
4994 Dynarr_new (image_instantiator_format_entry);
4996 Vimage_instantiator_format_list = Qnil;
4997 staticpro (&Vimage_instantiator_format_list);
4999 dumpstruct (&the_image_instantiator_format_entry_dynarr, &iifed_description);
5001 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
5003 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
5004 IIFORMAT_HAS_METHOD (nothing, instantiate);
5006 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
5008 IIFORMAT_HAS_METHOD (inherit, validate);
5009 IIFORMAT_HAS_METHOD (inherit, normalize);
5010 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
5011 IIFORMAT_HAS_METHOD (inherit, instantiate);
5013 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
5015 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
5017 IIFORMAT_HAS_METHOD (string, validate);
5018 IIFORMAT_HAS_METHOD (string, possible_dest_types);
5019 IIFORMAT_HAS_METHOD (string, instantiate);
5021 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
5022 /* Do this so we can set strings. */
5023 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text");
5024 IIFORMAT_HAS_METHOD (text, set_property);
5025 IIFORMAT_HAS_METHOD (text, query_geometry);
5027 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
5029 IIFORMAT_HAS_METHOD (formatted_string, validate);
5030 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
5031 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
5032 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
5035 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
5036 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
5037 IIFORMAT_HAS_METHOD (subwindow, instantiate);
5038 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
5039 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
5041 #ifdef HAVE_WINDOW_SYSTEM
5042 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
5044 IIFORMAT_HAS_METHOD (xbm, validate);
5045 IIFORMAT_HAS_METHOD (xbm, normalize);
5046 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
5048 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
5049 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
5050 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
5051 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
5052 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
5053 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
5054 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
5055 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
5056 #endif /* HAVE_WINDOW_SYSTEM */
5059 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
5061 IIFORMAT_HAS_METHOD (xface, validate);
5062 IIFORMAT_HAS_METHOD (xface, normalize);
5063 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
5065 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
5066 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
5067 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
5068 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
5069 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
5070 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
5074 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
5076 IIFORMAT_HAS_METHOD (xpm, validate);
5077 IIFORMAT_HAS_METHOD (xpm, normalize);
5078 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
5080 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
5081 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
5082 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
5083 #endif /* HAVE_XPM */
5087 reinit_vars_of_glyphs (void)
5089 the_expose_ignore_blocktype =
5090 Blocktype_new (struct expose_ignore_blocktype);
5092 hold_ignored_expose_registration = 0;
5097 vars_of_glyphs (void)
5099 reinit_vars_of_glyphs ();
5101 Vthe_nothing_vector = vector1 (Qnothing);
5102 staticpro (&Vthe_nothing_vector);
5104 /* image instances */
5106 Vimage_instance_type_list = Fcons (Qnothing,
5107 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
5108 Qpointer, Qsubwindow, Qwidget));
5109 staticpro (&Vimage_instance_type_list);
5113 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
5114 staticpro (&Vglyph_type_list);
5116 /* The octal-escape glyph, control-arrow-glyph and
5117 invisible-text-glyph are completely initialized in glyphs.el */
5119 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
5120 What to prefix character codes displayed in octal with.
5122 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5124 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
5125 What to use as an arrow for control characters.
5127 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
5128 redisplay_glyph_changed);
5130 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
5131 What to use to indicate the presence of invisible text.
5132 This is the glyph that is displayed when an ellipsis is called for
5133 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
5134 Normally this is three dots ("...").
5136 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
5137 redisplay_glyph_changed);
5139 /* Partially initialized in glyphs.el */
5140 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
5141 What to display at the beginning of horizontally scrolled lines.
5143 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5144 #ifdef HAVE_WINDOW_SYSTEM
5150 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
5151 Definitions of logical color-names used when reading XPM files.
5152 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
5153 The COLOR-NAME should be a string, which is the name of the color to define;
5154 the FORM should evaluate to a `color' specifier object, or a string to be
5155 passed to `make-color-instance'. If a loaded XPM file references a symbolic
5156 color called COLOR-NAME, it will display as the computed color instead.
5158 The default value of this variable defines the logical color names
5159 \"foreground\" and \"background\" to be the colors of the `default' face.
5161 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
5162 #endif /* HAVE_XPM */
5167 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /*
5168 Whether animated pixmaps should be animated.
5171 disable_animated_pixmaps = 0;
5175 specifier_vars_of_glyphs (void)
5177 /* #### Can we GC here? The set_specifier_* calls definitely need */
5179 /* display tables */
5181 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
5182 *The display table currently in use.
5183 This is a specifier; use `set-specifier' to change it.
5184 The display table is a vector created with `make-display-table'.
5185 The 256 elements control how to display each possible text character.
5186 Each value should be a string, a glyph, a vector or nil.
5187 If a value is a vector it must be composed only of strings and glyphs.
5188 nil means display the character in the default fashion.
5189 Faces can have their own, overriding display table.
5191 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
5192 set_specifier_fallback (Vcurrent_display_table,
5193 list1 (Fcons (Qnil, Qnil)));
5194 set_specifier_caching (Vcurrent_display_table,
5195 offsetof (struct window, display_table),
5196 some_window_value_changed,
5201 complex_vars_of_glyphs (void)
5203 /* Partially initialized in glyphs-x.c, glyphs.el */
5204 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
5205 What to display at the end of truncated lines.
5207 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5209 /* Partially initialized in glyphs-x.c, glyphs.el */
5210 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
5211 What to display at the end of wrapped lines.
5213 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5215 /* Partially initialized in glyphs-x.c, glyphs.el */
5216 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
5217 The glyph used to display the XEmacs logo at startup.
5219 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);