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 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 */
40 #include "redisplay.h"
50 Lisp_Object Qimage_conversion_error;
52 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
53 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p;
54 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p;
55 Lisp_Object Qmono_pixmap_image_instance_p;
56 Lisp_Object Qcolor_pixmap_image_instance_p;
57 Lisp_Object Qpointer_image_instance_p;
58 Lisp_Object Qsubwindow_image_instance_p;
59 Lisp_Object Qwidget_image_instance_p;
60 Lisp_Object Qconst_glyph_variable;
61 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow;
62 Lisp_Object Q_file, Q_data, Q_face, Q_pixel_width, Q_pixel_height;
63 Lisp_Object Qformatted_string;
64 Lisp_Object Vcurrent_display_table;
65 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph;
66 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph;
67 Lisp_Object Vxemacs_logo;
68 Lisp_Object Vthe_nothing_vector;
69 Lisp_Object Vimage_instantiator_format_list;
70 Lisp_Object Vimage_instance_type_list;
71 Lisp_Object Vglyph_type_list;
73 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
74 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
75 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
76 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
77 DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow);
79 #ifdef HAVE_WINDOW_SYSTEM
80 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
83 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
84 Lisp_Object Q_foreground, Q_background;
86 #define BitmapSuccess 0
87 #define BitmapOpenFailed 1
88 #define BitmapFileInvalid 2
89 #define BitmapNoMemory 3
94 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
99 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
101 Lisp_Object Q_color_symbols;
104 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
105 struct image_instantiator_format_entry
109 struct image_instantiator_methods *meths;
114 Dynarr_declare (struct image_instantiator_format_entry);
115 } image_instantiator_format_entry_dynarr;
117 image_instantiator_format_entry_dynarr *
118 the_image_instantiator_format_entry_dynarr;
120 static Lisp_Object allocate_image_instance (Lisp_Object device);
121 static void image_validate (Lisp_Object instantiator);
122 static void glyph_property_was_changed (Lisp_Object glyph,
123 Lisp_Object property,
125 EXFUN (Fimage_instance_type, 1);
126 EXFUN (Fglyph_type, 1);
129 /****************************************************************************
130 * Image Instantiators *
131 ****************************************************************************/
133 struct image_instantiator_methods *
134 decode_device_ii_format (Lisp_Object device, Lisp_Object format,
139 if (!SYMBOLP (format))
141 if (ERRB_EQ (errb, ERROR_ME))
142 CHECK_SYMBOL (format);
146 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
150 Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
153 Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
155 if ((NILP (d) && NILP (device))
158 EQ (CONSOLE_TYPE (XCONSOLE
159 (DEVICE_CONSOLE (XDEVICE (device)))), d)))
160 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
164 maybe_signal_simple_error ("Invalid image-instantiator format", format,
170 struct image_instantiator_methods *
171 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
173 return decode_device_ii_format (Qnil, format, errb);
177 valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale)
180 struct image_instantiator_methods* meths =
181 decode_image_instantiator_format (format, ERROR_ME_NOT);
182 struct console* console = decode_console (locale);
183 Lisp_Object contype = console ? CONSOLE_TYPE (console) : locale;
184 /* nothing is valid in all locales */
185 if (EQ (format, Qnothing))
187 /* reject unknown formats */
188 else if (!console || !meths)
191 for (i = 0; i < Dynarr_length (meths->consoles); i++)
192 if (EQ (contype, Dynarr_at (meths->consoles, i).symbol))
197 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
199 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
200 If LOCALE is non-nil then the format is checked in that domain.
201 If LOCALE is nil the current console is used.
202 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
203 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
204 'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled.
206 (image_instantiator_format, locale))
208 return valid_image_instantiator_format_p (image_instantiator_format, locale) ?
212 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
214 Return a list of valid image-instantiator formats.
218 return Fcopy_sequence (Vimage_instantiator_format_list);
222 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol,
223 struct image_instantiator_methods *meths)
225 struct image_instantiator_format_entry entry;
227 entry.symbol = symbol;
228 entry.device = device;
230 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
231 Vimage_instantiator_format_list =
232 Fcons (symbol, Vimage_instantiator_format_list);
236 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
238 image_instantiator_methods *meths)
240 add_entry_to_device_ii_format_list (Qnil, symbol, meths);
244 get_image_conversion_list (Lisp_Object console_type)
246 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
249 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
251 Set the image-conversion-list for consoles of the given TYPE.
252 The image-conversion-list specifies how image instantiators that
253 are strings should be interpreted. Each element of the list should be
254 a list of two elements (a regular expression string and a vector) or
255 a list of three elements (the preceding two plus an integer index into
256 the vector). The string is converted to the vector associated with the
257 first matching regular expression. If a vector index is specified, the
258 string itself is substituted into that position in the vector.
260 Note: The conversion above is applied when the image instantiator is
261 added to an image specifier, not when the specifier is actually
262 instantiated. Therefore, changing the image-conversion-list only affects
263 newly-added instantiators. Existing instantiators in glyphs and image
264 specifiers will not be affected.
266 (console_type, list))
269 Lisp_Object *imlist = get_image_conversion_list (console_type);
271 /* Check the list to make sure that it only has valid entries. */
273 EXTERNAL_LIST_LOOP (tail, list)
275 Lisp_Object mapping = XCAR (tail);
277 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
278 if (!CONSP (mapping) ||
279 !CONSP (XCDR (mapping)) ||
280 (!NILP (XCDR (XCDR (mapping))) &&
281 (!CONSP (XCDR (XCDR (mapping))) ||
282 !NILP (XCDR (XCDR (XCDR (mapping)))))))
283 signal_simple_error ("Invalid mapping form", mapping);
286 Lisp_Object exp = XCAR (mapping);
287 Lisp_Object typevec = XCAR (XCDR (mapping));
288 Lisp_Object pos = Qnil;
293 CHECK_VECTOR (typevec);
294 if (!NILP (XCDR (XCDR (mapping))))
296 pos = XCAR (XCDR (XCDR (mapping)));
298 if (XINT (pos) < 0 ||
299 XINT (pos) >= XVECTOR_LENGTH (typevec))
301 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
304 newvec = Fcopy_sequence (typevec);
306 XVECTOR_DATA (newvec)[XINT (pos)] = exp;
308 image_validate (newvec);
313 *imlist = Fcopy_tree (list, Qt);
317 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
319 Return the image-conversion-list for devices of the given TYPE.
320 The image-conversion-list specifies how to interpret image string
321 instantiators for the specified console type. See
322 `set-console-type-image-conversion-list' for a description of its syntax.
326 return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
329 /* Process a string instantiator according to the image-conversion-list for
330 CONSOLE_TYPE. Returns a vector. */
333 process_image_string_instantiator (Lisp_Object data,
334 Lisp_Object console_type,
339 LIST_LOOP (tail, *get_image_conversion_list (console_type))
341 Lisp_Object mapping = XCAR (tail);
342 Lisp_Object exp = XCAR (mapping);
343 Lisp_Object typevec = XCAR (XCDR (mapping));
345 /* if the result is of a type that can't be instantiated
346 (e.g. a string when we're dealing with a pointer glyph),
349 IIFORMAT_METH (decode_image_instantiator_format
350 (XVECTOR_DATA (typevec)[0], ERROR_ME),
351 possible_dest_types, ())))
353 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
355 if (!NILP (XCDR (XCDR (mapping))))
357 int pos = XINT (XCAR (XCDR (XCDR (mapping))));
358 Lisp_Object newvec = Fcopy_sequence (typevec);
359 XVECTOR_DATA (newvec)[pos] = data;
368 signal_simple_error ("Unable to interpret glyph instantiator",
375 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
376 Lisp_Object default_)
379 int instantiator_len;
381 elt = XVECTOR_DATA (vector);
382 instantiator_len = XVECTOR_LENGTH (vector);
387 while (instantiator_len > 0)
389 if (EQ (elt[0], keyword))
392 instantiator_len -= 2;
399 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
401 return find_keyword_in_vector_or_given (vector, keyword, Qnil);
405 check_valid_string (Lisp_Object data)
411 check_valid_vector (Lisp_Object data)
417 check_valid_face (Lisp_Object data)
423 check_valid_int (Lisp_Object data)
429 file_or_data_must_be_present (Lisp_Object instantiator)
431 if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
432 NILP (find_keyword_in_vector (instantiator, Q_data)))
433 signal_simple_error ("Must supply either :file or :data",
438 data_must_be_present (Lisp_Object instantiator)
440 if (NILP (find_keyword_in_vector (instantiator, Q_data)))
441 signal_simple_error ("Must supply :data", instantiator);
445 face_must_be_present (Lisp_Object instantiator)
447 if (NILP (find_keyword_in_vector (instantiator, Q_face)))
448 signal_simple_error ("Must supply :face", instantiator);
451 /* utility function useful in retrieving data from a file. */
454 make_string_from_file (Lisp_Object file)
456 /* This function can call lisp */
457 int count = specpdl_depth ();
458 Lisp_Object temp_buffer;
462 specbind (Qinhibit_quit, Qt);
463 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
464 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
465 GCPRO1 (temp_buffer);
466 set_buffer_internal (XBUFFER (temp_buffer));
467 Ferase_buffer (Qnil);
468 specbind (intern ("format-alist"), Qnil);
469 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
470 data = Fbuffer_substring (Qnil, Qnil, Qnil);
471 unbind_to (count, Qnil);
476 /* The following two functions are provided to make it easier for
477 the normalize methods to work with keyword-value vectors.
478 Hash tables are kind of heavyweight for this purpose.
479 (If vectors were resizable, we could avoid this problem;
480 but they're not.) An alternative approach that might be
481 more efficient but require more work is to use a type of
482 assoc-Dynarr and provide primitives for deleting elements out
483 of it. (However, you'd also have to add an unwind-protect
484 to make sure the Dynarr got freed in case of an error in
485 the normalization process.) */
488 tagged_vector_to_alist (Lisp_Object vector)
490 Lisp_Object *elt = XVECTOR_DATA (vector);
491 int len = XVECTOR_LENGTH (vector);
492 Lisp_Object result = Qnil;
495 for (len -= 2; len >= 1; len -= 2)
496 result = Fcons (Fcons (elt[len], elt[len+1]), result);
502 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
504 int len = 1 + 2 * XINT (Flength (alist));
505 Lisp_Object *elt = alloca_array (Lisp_Object, len);
511 LIST_LOOP (rest, alist)
513 Lisp_Object pair = XCAR (rest);
514 elt[i] = XCAR (pair);
515 elt[i+1] = XCDR (pair);
519 return Fvector (len, elt);
523 normalize_image_instantiator (Lisp_Object instantiator,
525 Lisp_Object dest_mask)
527 if (IMAGE_INSTANCEP (instantiator))
530 if (STRINGP (instantiator))
531 instantiator = process_image_string_instantiator (instantiator, contype,
534 assert (VECTORP (instantiator));
535 /* We have to always store the actual pixmap data and not the
536 filename even though this is a potential memory pig. We have to
537 do this because it is quite possible that we will need to
538 instantiate a new instance of the pixmap and the file will no
539 longer exist (e.g. w3 pixmaps are almost always from temporary
543 struct image_instantiator_methods *meths;
545 GCPRO1 (instantiator);
547 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
549 RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
550 (instantiator, contype),
556 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
557 Lisp_Object instantiator,
558 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
561 Lisp_Object ii = allocate_image_instance (device);
562 struct image_instantiator_methods *meths;
567 if (!valid_image_instantiator_format_p (XVECTOR_DATA (instantiator)[0], device))
569 ("Image instantiator format is invalid in this locale.",
572 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
574 methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate);
575 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
576 pointer_bg, dest_mask, domain));
578 /* now do device specific instantiation */
579 meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0],
582 if (!methp && (!meths || !HAS_IIFORMAT_METH_P (meths, instantiate)))
584 ("Don't know how to instantiate this image instantiator?",
586 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
587 pointer_bg, dest_mask, domain));
594 /****************************************************************************
595 * Image-Instance Object *
596 ****************************************************************************/
598 Lisp_Object Qimage_instancep;
601 mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
603 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
606 switch (IMAGE_INSTANCE_TYPE (i))
609 markobj (IMAGE_INSTANCE_TEXT_STRING (i));
611 case IMAGE_MONO_PIXMAP:
612 case IMAGE_COLOR_PIXMAP:
613 markobj (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
614 markobj (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
615 markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
616 markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
617 markobj (IMAGE_INSTANCE_PIXMAP_FG (i));
618 markobj (IMAGE_INSTANCE_PIXMAP_BG (i));
622 markobj (IMAGE_INSTANCE_WIDGET_TYPE (i));
623 markobj (IMAGE_INSTANCE_WIDGET_PROPS (i));
624 markobj (IMAGE_INSTANCE_WIDGET_FACE (i));
625 markobj (IMAGE_INSTANCE_WIDGET_ITEM (i));
626 case IMAGE_SUBWINDOW:
627 markobj (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
634 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i, markobj));
640 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
644 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
647 error ("printing unreadable object #<image-instance 0x%x>",
649 write_c_string ("#<image-instance (", printcharfun);
650 print_internal (Fimage_instance_type (obj), printcharfun, 0);
651 write_c_string (") ", printcharfun);
652 if (!NILP (ii->name))
654 print_internal (ii->name, printcharfun, 1);
655 write_c_string (" ", printcharfun);
657 write_c_string ("on ", printcharfun);
658 print_internal (ii->device, printcharfun, 0);
659 write_c_string (" ", printcharfun);
660 switch (IMAGE_INSTANCE_TYPE (ii))
666 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
669 case IMAGE_MONO_PIXMAP:
670 case IMAGE_COLOR_PIXMAP:
672 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
675 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
676 s = strrchr ((char *) XSTRING_DATA (filename), '/');
678 print_internal (build_string (s + 1), printcharfun, 1);
680 print_internal (filename, printcharfun, 1);
682 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
683 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
684 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
685 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
687 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
688 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
689 write_c_string (buf, printcharfun);
690 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
691 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
693 write_c_string (" @", printcharfun);
694 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
696 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
697 write_c_string (buf, printcharfun);
700 write_c_string ("??", printcharfun);
701 write_c_string (",", printcharfun);
702 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
704 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
705 write_c_string (buf, printcharfun);
708 write_c_string ("??", printcharfun);
710 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
711 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
713 write_c_string (" (", printcharfun);
714 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
718 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
720 write_c_string ("/", printcharfun);
721 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
725 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
727 write_c_string (")", printcharfun);
733 if (!NILP (IMAGE_INSTANCE_WIDGET_CALLBACK (ii)))
735 print_internal (IMAGE_INSTANCE_WIDGET_CALLBACK (ii), printcharfun, 0);
736 write_c_string (", ", printcharfun);
739 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
741 write_c_string (" (", printcharfun);
743 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
744 write_c_string (")", printcharfun);
747 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
748 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0);
750 case IMAGE_SUBWINDOW:
751 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
752 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
753 write_c_string (buf, printcharfun);
755 /* This is stolen from frame.c. Subwindows are strange in that they
756 are specific to a particular frame so we want to print in their
757 description what that frame is. */
759 write_c_string (" on #<", printcharfun);
761 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
763 if (!FRAME_LIVE_P (f))
764 write_c_string ("dead", printcharfun);
766 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
769 write_c_string ("-frame ", printcharfun);
771 write_c_string (">", printcharfun);
772 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
773 write_c_string (buf, printcharfun);
781 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
782 (ii, printcharfun, escapeflag));
783 sprintf (buf, " 0x%x>", ii->header.uid);
784 write_c_string (buf, printcharfun);
788 finalize_image_instance (void *header, int for_disksave)
790 struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header;
792 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
793 /* objects like this exist at dump time, so don't bomb out. */
795 if (for_disksave) finalose (i);
797 /* do this so that the cachels get reset */
798 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
800 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
802 MARK_FRAME_GLYPHS_CHANGED
803 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
806 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
810 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
812 struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
813 struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
814 struct device *d1 = XDEVICE (i1->device);
815 struct device *d2 = XDEVICE (i2->device);
819 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2))
821 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
825 switch (IMAGE_INSTANCE_TYPE (i1))
831 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
832 IMAGE_INSTANCE_TEXT_STRING (i2),
837 case IMAGE_MONO_PIXMAP:
838 case IMAGE_COLOR_PIXMAP:
840 if (!(IMAGE_INSTANCE_PIXMAP_WIDTH (i1) ==
841 IMAGE_INSTANCE_PIXMAP_WIDTH (i2) &&
842 IMAGE_INSTANCE_PIXMAP_HEIGHT (i1) ==
843 IMAGE_INSTANCE_PIXMAP_HEIGHT (i2) &&
844 IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
845 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
846 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
847 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
848 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
849 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
850 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
851 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
853 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
854 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
860 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
861 IMAGE_INSTANCE_WIDGET_TYPE (i2))
862 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEM (i1),
863 IMAGE_INSTANCE_WIDGET_ITEM (i2),
865 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
866 IMAGE_INSTANCE_WIDGET_PROPS (i2),
870 case IMAGE_SUBWINDOW:
871 if (!(IMAGE_INSTANCE_SUBWINDOW_WIDTH (i1) ==
872 IMAGE_INSTANCE_SUBWINDOW_WIDTH (i2) &&
873 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i1) ==
874 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i2) &&
875 IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
876 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
884 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
888 image_instance_hash (Lisp_Object obj, int depth)
890 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
891 struct device *d = XDEVICE (i->device);
892 unsigned long hash = (unsigned long) d;
894 switch (IMAGE_INSTANCE_TYPE (i))
900 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
904 case IMAGE_MONO_PIXMAP:
905 case IMAGE_COLOR_PIXMAP:
907 hash = HASH5 (hash, IMAGE_INSTANCE_PIXMAP_WIDTH (i),
908 IMAGE_INSTANCE_PIXMAP_HEIGHT (i),
909 IMAGE_INSTANCE_PIXMAP_DEPTH (i),
910 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
916 internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1),
917 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
918 internal_hash (IMAGE_INSTANCE_WIDGET_ITEM (i), depth + 1));
919 case IMAGE_SUBWINDOW:
920 hash = HASH4 (hash, IMAGE_INSTANCE_SUBWINDOW_WIDTH (i),
921 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i),
922 (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
929 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
933 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
934 mark_image_instance, print_image_instance,
935 finalize_image_instance, image_instance_equal,
936 image_instance_hash, 0,
937 struct Lisp_Image_Instance);
940 allocate_image_instance (Lisp_Object device)
942 struct Lisp_Image_Instance *lp =
943 alloc_lcrecord_type (struct Lisp_Image_Instance, &lrecord_image_instance);
948 lp->type = IMAGE_NOTHING;
950 XSETIMAGE_INSTANCE (val, lp);
954 static enum image_instance_type
955 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
957 if (ERRB_EQ (errb, ERROR_ME))
960 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
961 if (EQ (type, Qtext)) return IMAGE_TEXT;
962 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
963 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
964 if (EQ (type, Qpointer)) return IMAGE_POINTER;
965 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
966 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
968 maybe_signal_simple_error ("Invalid image-instance type", type,
971 return IMAGE_UNKNOWN; /* not reached */
975 encode_image_instance_type (enum image_instance_type type)
979 case IMAGE_NOTHING: return Qnothing;
980 case IMAGE_TEXT: return Qtext;
981 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
982 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
983 case IMAGE_POINTER: return Qpointer;
984 case IMAGE_SUBWINDOW: return Qsubwindow;
985 case IMAGE_WIDGET: return Qwidget;
990 return Qnil; /* not reached */
994 image_instance_type_to_mask (enum image_instance_type type)
996 /* This depends on the fact that enums are assigned consecutive
997 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
998 first enum.) I'm fairly sure this behavior in ANSI-mandated,
999 so there should be no portability problems here. */
1000 return (1 << ((int) (type) - 1));
1004 decode_image_instance_type_list (Lisp_Object list)
1014 enum image_instance_type type =
1015 decode_image_instance_type (list, ERROR_ME);
1016 return image_instance_type_to_mask (type);
1019 EXTERNAL_LIST_LOOP (rest, list)
1021 enum image_instance_type type =
1022 decode_image_instance_type (XCAR (rest), ERROR_ME);
1023 mask |= image_instance_type_to_mask (type);
1030 encode_image_instance_type_list (int mask)
1033 Lisp_Object result = Qnil;
1039 result = Fcons (encode_image_instance_type
1040 ((enum image_instance_type) count), result);
1044 return Fnreverse (result);
1048 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1049 int desired_dest_mask)
1054 (emacs_doprnt_string_lisp_2
1056 "No compatible image-instance types given: wanted one of %s, got %s",
1058 encode_image_instance_type_list (desired_dest_mask),
1059 encode_image_instance_type_list (given_dest_mask)),
1064 valid_image_instance_type_p (Lisp_Object type)
1066 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1069 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1070 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1071 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1072 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1074 (image_instance_type))
1076 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1079 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1080 Return a list of valid image-instance types.
1084 return Fcopy_sequence (Vimage_instance_type_list);
1088 decode_error_behavior_flag (Lisp_Object no_error)
1090 if (NILP (no_error)) return ERROR_ME;
1091 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1092 else return ERROR_ME_WARN;
1096 encode_error_behavior_flag (Error_behavior errb)
1098 if (ERRB_EQ (errb, ERROR_ME))
1100 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1104 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1110 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1111 Lisp_Object dest_types)
1114 struct gcpro gcpro1;
1117 XSETDEVICE (device, decode_device (device));
1118 /* instantiate_image_instantiator() will abort if given an
1119 image instance ... */
1120 if (IMAGE_INSTANCEP (data))
1121 signal_simple_error ("Image instances not allowed here", data);
1122 image_validate (data);
1123 dest_mask = decode_image_instance_type_list (dest_types);
1124 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1125 make_int (dest_mask));
1127 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1128 signal_simple_error ("Inheritance not allowed here", data);
1129 ii = instantiate_image_instantiator (device, device, data,
1130 Qnil, Qnil, dest_mask);
1131 RETURN_UNGCPRO (ii);
1134 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1135 Return a new `image-instance' object.
1137 Image-instance objects encapsulate the way a particular image (pixmap,
1138 etc.) is displayed on a particular device. In most circumstances, you
1139 do not need to directly create image instances; use a glyph instead.
1140 However, it may occasionally be useful to explicitly create image
1141 instances, if you want more control over the instantiation process.
1143 DATA is an image instantiator, which describes the image; see
1144 `image-specifier-p' for a description of the allowed values.
1146 DEST-TYPES should be a list of allowed image instance types that can
1147 be generated. The recognized image instance types are
1150 Nothing is displayed.
1152 Displayed as text. The foreground and background colors and the
1153 font of the text are specified independent of the pixmap. Typically
1154 these attributes will come from the face of the surrounding text,
1155 unless a face is specified for the glyph in which the image appears.
1157 Displayed as a mono pixmap (a pixmap with only two colors where the
1158 foreground and background can be specified independent of the pixmap;
1159 typically the pixmap assumes the foreground and background colors of
1160 the text around it, unless a face is specified for the glyph in which
1163 Displayed as a color pixmap.
1165 Used as the mouse pointer for a window.
1167 A child window that is treated as an image. This allows (e.g.)
1168 another program to be responsible for drawing into the window.
1169 Not currently implemented.
1171 The DEST-TYPES list is unordered. If multiple destination types
1172 are possible for a given instantiator, the "most natural" type
1173 for the instantiator's format is chosen. (For XBM, the most natural
1174 types are `mono-pixmap', followed by `color-pixmap', followed by
1175 `pointer'. For the other normal image formats, the most natural
1176 types are `color-pixmap', followed by `mono-pixmap', followed by
1177 `pointer'. For the string and formatted-string formats, the most
1178 natural types are `text', followed by `mono-pixmap' (not currently
1179 implemented), followed by `color-pixmap' (not currently implemented).
1180 The other formats can only be instantiated as one type. (If you
1181 want to control more specifically the order of the types into which
1182 an image is instantiated, just call `make-image-instance' repeatedly
1183 until it succeeds, passing less and less preferred destination types
1186 If DEST-TYPES is omitted, all possible types are allowed.
1188 NO-ERROR controls what happens when the image cannot be generated.
1189 If nil, an error message is generated. If t, no messages are
1190 generated and this function returns nil. If anything else, a warning
1191 message is generated and this function returns nil.
1193 (data, device, dest_types, no_error))
1195 Error_behavior errb = decode_error_behavior_flag (no_error);
1197 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1199 3, data, device, dest_types);
1202 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1203 Return non-nil if OBJECT is an image instance.
1207 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1210 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1211 Return the type of the given image instance.
1212 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1213 'color-pixmap, 'pointer, or 'subwindow.
1217 CHECK_IMAGE_INSTANCE (image_instance);
1218 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1221 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1222 Return the name of the given image instance.
1226 CHECK_IMAGE_INSTANCE (image_instance);
1227 return XIMAGE_INSTANCE_NAME (image_instance);
1230 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1231 Return the string of the given image instance.
1232 This will only be non-nil for text image instances and widgets.
1236 CHECK_IMAGE_INSTANCE (image_instance);
1237 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1238 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1239 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1240 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1245 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1246 Return the given property of the given image instance.
1247 Returns nil if the property or the property method do not exist for
1248 the image instance in the domain.
1250 (image_instance, prop))
1252 struct Lisp_Image_Instance* ii;
1253 Lisp_Object type, ret;
1254 struct image_instantiator_methods* meths;
1256 CHECK_IMAGE_INSTANCE (image_instance);
1257 CHECK_SYMBOL (prop);
1258 ii = XIMAGE_INSTANCE (image_instance);
1260 /* ... then try device specific methods ... */
1261 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1262 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1263 type, ERROR_ME_NOT);
1264 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1266 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1270 /* ... then format specific methods ... */
1271 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1272 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1274 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1282 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1283 Set the given property of the given image instance.
1284 Does nothing if the property or the property method do not exist for
1285 the image instance in the domain.
1287 (image_instance, prop, val))
1289 struct Lisp_Image_Instance* ii;
1290 Lisp_Object type, ret;
1291 struct image_instantiator_methods* meths;
1293 CHECK_IMAGE_INSTANCE (image_instance);
1294 CHECK_SYMBOL (prop);
1295 ii = XIMAGE_INSTANCE (image_instance);
1296 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1297 /* try device specific methods first ... */
1298 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1299 type, ERROR_ME_NOT);
1300 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1303 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1307 /* ... then format specific methods ... */
1308 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1309 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1312 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1320 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1321 Return the file name from which IMAGE-INSTANCE was read, if known.
1325 CHECK_IMAGE_INSTANCE (image_instance);
1327 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1329 case IMAGE_MONO_PIXMAP:
1330 case IMAGE_COLOR_PIXMAP:
1332 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1339 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1340 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1344 CHECK_IMAGE_INSTANCE (image_instance);
1346 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1348 case IMAGE_MONO_PIXMAP:
1349 case IMAGE_COLOR_PIXMAP:
1351 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1358 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1359 Return the depth of the image instance.
1360 This is 0 for a bitmap, or a positive integer for a pixmap.
1364 CHECK_IMAGE_INSTANCE (image_instance);
1366 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1368 case IMAGE_MONO_PIXMAP:
1369 case IMAGE_COLOR_PIXMAP:
1371 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1378 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1379 Return the height of the image instance, in pixels.
1383 CHECK_IMAGE_INSTANCE (image_instance);
1385 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1387 case IMAGE_MONO_PIXMAP:
1388 case IMAGE_COLOR_PIXMAP:
1390 return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance));
1392 case IMAGE_SUBWINDOW:
1394 return make_int (XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (image_instance));
1401 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1402 Return the width of the image instance, in pixels.
1406 CHECK_IMAGE_INSTANCE (image_instance);
1408 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1410 case IMAGE_MONO_PIXMAP:
1411 case IMAGE_COLOR_PIXMAP:
1413 return make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance));
1415 case IMAGE_SUBWINDOW:
1417 return make_int (XIMAGE_INSTANCE_SUBWINDOW_WIDTH (image_instance));
1424 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1425 Return the X coordinate of the image instance's hotspot, if known.
1426 This is a point relative to the origin of the pixmap. When an image is
1427 used as a mouse pointer, the hotspot is the point on the image that sits
1428 over the location that the pointer points to. This is, for example, the
1429 tip of the arrow or the center of the crosshairs.
1430 This will always be nil for a non-pointer image instance.
1434 CHECK_IMAGE_INSTANCE (image_instance);
1436 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1438 case IMAGE_MONO_PIXMAP:
1439 case IMAGE_COLOR_PIXMAP:
1441 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1448 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1449 Return the Y coordinate of the image instance's hotspot, if known.
1450 This is a point relative to the origin of the pixmap. When an image is
1451 used as a mouse pointer, the hotspot is the point on the image that sits
1452 over the location that the pointer points to. This is, for example, the
1453 tip of the arrow or the center of the crosshairs.
1454 This will always be nil for a non-pointer image instance.
1458 CHECK_IMAGE_INSTANCE (image_instance);
1460 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1462 case IMAGE_MONO_PIXMAP:
1463 case IMAGE_COLOR_PIXMAP:
1465 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1472 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1473 Return the foreground color of IMAGE-INSTANCE, if applicable.
1474 This will be a color instance or nil. (It will only be non-nil for
1475 colorized mono pixmaps and for pointers.)
1479 CHECK_IMAGE_INSTANCE (image_instance);
1481 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1483 case IMAGE_MONO_PIXMAP:
1484 case IMAGE_COLOR_PIXMAP:
1486 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1489 return FACE_FOREGROUND (
1490 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1491 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1499 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1500 Return the background color of IMAGE-INSTANCE, if applicable.
1501 This will be a color instance or nil. (It will only be non-nil for
1502 colorized mono pixmaps and for pointers.)
1506 CHECK_IMAGE_INSTANCE (image_instance);
1508 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1510 case IMAGE_MONO_PIXMAP:
1511 case IMAGE_COLOR_PIXMAP:
1513 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1516 return FACE_BACKGROUND (
1517 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1518 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1527 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1528 Make the image instance be displayed in the given colors.
1529 This function returns a new image instance that is exactly like the
1530 specified one except that (if possible) the foreground and background
1531 colors and as specified. Currently, this only does anything if the image
1532 instance is a mono pixmap; otherwise, the same image instance is returned.
1534 (image_instance, foreground, background))
1539 CHECK_IMAGE_INSTANCE (image_instance);
1540 CHECK_COLOR_INSTANCE (foreground);
1541 CHECK_COLOR_INSTANCE (background);
1543 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1544 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1545 return image_instance;
1547 new = allocate_image_instance (device);
1548 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1549 /* note that if this method returns non-zero, this method MUST
1550 copy any window-system resources, so that when one image instance is
1551 freed, the other one is not hosed. */
1552 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1554 return image_instance;
1559 /************************************************************************/
1561 /************************************************************************/
1563 signal_image_error (CONST char *reason, Lisp_Object frob)
1565 signal_error (Qimage_conversion_error,
1566 list2 (build_translated_string (reason), frob));
1570 signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1)
1572 signal_error (Qimage_conversion_error,
1573 list3 (build_translated_string (reason), frob0, frob1));
1576 /****************************************************************************
1578 ****************************************************************************/
1581 nothing_possible_dest_types (void)
1583 return IMAGE_NOTHING_MASK;
1587 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1588 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1589 int dest_mask, Lisp_Object domain)
1591 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1593 if (dest_mask & IMAGE_NOTHING_MASK)
1594 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1596 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1600 /****************************************************************************
1602 ****************************************************************************/
1605 inherit_validate (Lisp_Object instantiator)
1607 face_must_be_present (instantiator);
1611 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1615 assert (XVECTOR_LENGTH (inst) == 3);
1616 face = XVECTOR_DATA (inst)[2];
1618 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1623 inherit_possible_dest_types (void)
1625 return IMAGE_MONO_PIXMAP_MASK;
1629 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1630 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1631 int dest_mask, Lisp_Object domain)
1633 /* handled specially in image_instantiate */
1638 /****************************************************************************
1640 ****************************************************************************/
1643 string_validate (Lisp_Object instantiator)
1645 data_must_be_present (instantiator);
1649 string_possible_dest_types (void)
1651 return IMAGE_TEXT_MASK;
1654 /* called from autodetect_instantiate() */
1656 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1657 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1658 int dest_mask, Lisp_Object domain)
1660 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1661 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1663 assert (!NILP (data));
1664 if (dest_mask & IMAGE_TEXT_MASK)
1666 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1667 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1670 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1674 /****************************************************************************
1675 * formatted-string *
1676 ****************************************************************************/
1679 formatted_string_validate (Lisp_Object instantiator)
1681 data_must_be_present (instantiator);
1685 formatted_string_possible_dest_types (void)
1687 return IMAGE_TEXT_MASK;
1691 formatted_string_instantiate (Lisp_Object image_instance,
1692 Lisp_Object instantiator,
1693 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1694 int dest_mask, Lisp_Object domain)
1696 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1697 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1699 assert (!NILP (data));
1700 /* #### implement this */
1701 warn_when_safe (Qunimplemented, Qnotice,
1702 "`formatted-string' not yet implemented; assuming `string'");
1703 if (dest_mask & IMAGE_TEXT_MASK)
1705 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1706 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1709 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1713 /************************************************************************/
1714 /* pixmap file functions */
1715 /************************************************************************/
1717 /* If INSTANTIATOR refers to inline data, return Qnil.
1718 If INSTANTIATOR refers to data in a file, return the full filename
1719 if it exists; otherwise, return a cons of (filename).
1721 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
1722 keywords used to look up the file and inline data,
1723 respectively, in the instantiator. Normally these would
1724 be Q_file and Q_data, but might be different for mask data. */
1727 potential_pixmap_file_instantiator (Lisp_Object instantiator,
1728 Lisp_Object file_keyword,
1729 Lisp_Object data_keyword,
1730 Lisp_Object console_type)
1735 assert (VECTORP (instantiator));
1737 data = find_keyword_in_vector (instantiator, data_keyword);
1738 file = find_keyword_in_vector (instantiator, file_keyword);
1740 if (!NILP (file) && NILP (data))
1742 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
1743 (decode_console_type(console_type, ERROR_ME),
1744 locate_pixmap_file, (file));
1749 return Fcons (file, Qnil); /* should have been file */
1756 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
1757 Lisp_Object image_type_tag)
1759 /* This function can call lisp */
1760 Lisp_Object file = Qnil;
1761 struct gcpro gcpro1, gcpro2;
1762 Lisp_Object alist = Qnil;
1764 GCPRO2 (file, alist);
1766 /* Now, convert any file data into inline data. At the end of this,
1767 `data' will contain the inline data (if any) or Qnil, and `file'
1768 will contain the name this data was derived from (if known) or
1771 Note that if we cannot generate any regular inline data, we
1774 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1777 if (CONSP (file)) /* failure locating filename */
1778 signal_double_file_error ("Opening pixmap file",
1779 "no such file or directory",
1782 if (NILP (file)) /* no conversion necessary */
1783 RETURN_UNGCPRO (inst);
1785 alist = tagged_vector_to_alist (inst);
1788 Lisp_Object data = make_string_from_file (file);
1789 alist = remassq_no_quit (Q_file, alist);
1790 /* there can't be a :data at this point. */
1791 alist = Fcons (Fcons (Q_file, file),
1792 Fcons (Fcons (Q_data, data), alist));
1796 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
1798 RETURN_UNGCPRO (result);
1803 #ifdef HAVE_WINDOW_SYSTEM
1804 /**********************************************************************
1806 **********************************************************************/
1808 /* Check if DATA represents a valid inline XBM spec (i.e. a list
1809 of (width height bits), with checking done on the dimensions).
1810 If not, signal an error. */
1813 check_valid_xbm_inline (Lisp_Object data)
1815 Lisp_Object width, height, bits;
1817 if (!CONSP (data) ||
1818 !CONSP (XCDR (data)) ||
1819 !CONSP (XCDR (XCDR (data))) ||
1820 !NILP (XCDR (XCDR (XCDR (data)))))
1821 signal_simple_error ("Must be list of 3 elements", data);
1823 width = XCAR (data);
1824 height = XCAR (XCDR (data));
1825 bits = XCAR (XCDR (XCDR (data)));
1827 CHECK_STRING (bits);
1829 if (!NATNUMP (width))
1830 signal_simple_error ("Width must be a natural number", width);
1832 if (!NATNUMP (height))
1833 signal_simple_error ("Height must be a natural number", height);
1835 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
1836 signal_simple_error ("data is too short for width and height",
1837 vector3 (width, height, bits));
1840 /* Validate method for XBM's. */
1843 xbm_validate (Lisp_Object instantiator)
1845 file_or_data_must_be_present (instantiator);
1848 /* Given a filename that is supposed to contain XBM data, return
1849 the inline representation of it as (width height bits). Return
1850 the hotspot through XHOT and YHOT, if those pointers are not 0.
1851 If there is no hotspot, XHOT and YHOT will contain -1.
1853 If the function fails:
1855 -- if OK_IF_DATA_INVALID is set and the data was invalid,
1857 -- maybe return an error, or return Qnil.
1860 #ifdef HAVE_X_WINDOWS
1861 #include <X11/Xlib.h>
1863 #define XFree(data) free(data)
1867 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
1868 int ok_if_data_invalid)
1873 CONST char *filename_ext;
1875 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
1876 result = read_bitmap_data_from_file (filename_ext, &w, &h,
1879 if (result == BitmapSuccess)
1882 int len = (w + 7) / 8 * h;
1884 retval = list3 (make_int (w), make_int (h),
1885 make_ext_string (data, len, FORMAT_BINARY));
1886 XFree ((char *) data);
1892 case BitmapOpenFailed:
1894 /* should never happen */
1895 signal_double_file_error ("Opening bitmap file",
1896 "no such file or directory",
1899 case BitmapFileInvalid:
1901 if (ok_if_data_invalid)
1903 signal_double_file_error ("Reading bitmap file",
1904 "invalid data in file",
1907 case BitmapNoMemory:
1909 signal_double_file_error ("Reading bitmap file",
1915 signal_double_file_error_2 ("Reading bitmap file",
1916 "unknown error code",
1917 make_int (result), name);
1921 return Qnil; /* not reached */
1925 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
1926 Lisp_Object mask_file, Lisp_Object console_type)
1928 /* This is unclean but it's fairly standard -- a number of the
1929 bitmaps in /usr/include/X11/bitmaps use it -- so we support
1931 if (NILP (mask_file)
1932 /* don't override explicitly specified mask data. */
1933 && NILP (assq_no_quit (Q_mask_data, alist))
1936 mask_file = MAYBE_LISP_CONTYPE_METH
1937 (decode_console_type(console_type, ERROR_ME),
1938 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
1939 if (NILP (mask_file))
1940 mask_file = MAYBE_LISP_CONTYPE_METH
1941 (decode_console_type(console_type, ERROR_ME),
1942 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
1945 if (!NILP (mask_file))
1947 Lisp_Object mask_data =
1948 bitmap_to_lisp_data (mask_file, 0, 0, 0);
1949 alist = remassq_no_quit (Q_mask_file, alist);
1950 /* there can't be a :mask-data at this point. */
1951 alist = Fcons (Fcons (Q_mask_file, mask_file),
1952 Fcons (Fcons (Q_mask_data, mask_data), alist));
1958 /* Normalize method for XBM's. */
1961 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
1963 Lisp_Object file = Qnil, mask_file = Qnil;
1964 struct gcpro gcpro1, gcpro2, gcpro3;
1965 Lisp_Object alist = Qnil;
1967 GCPRO3 (file, mask_file, alist);
1969 /* Now, convert any file data into inline data for both the regular
1970 data and the mask data. At the end of this, `data' will contain
1971 the inline data (if any) or Qnil, and `file' will contain
1972 the name this data was derived from (if known) or Qnil.
1973 Likewise for `mask_file' and `mask_data'.
1975 Note that if we cannot generate any regular inline data, we
1978 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1980 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
1981 Q_mask_data, console_type);
1983 if (CONSP (file)) /* failure locating filename */
1984 signal_double_file_error ("Opening bitmap file",
1985 "no such file or directory",
1988 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
1989 RETURN_UNGCPRO (inst);
1991 alist = tagged_vector_to_alist (inst);
1996 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
1997 alist = remassq_no_quit (Q_file, alist);
1998 /* there can't be a :data at this point. */
1999 alist = Fcons (Fcons (Q_file, file),
2000 Fcons (Fcons (Q_data, data), alist));
2002 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2003 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2005 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2006 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2010 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2013 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2015 RETURN_UNGCPRO (result);
2021 xbm_possible_dest_types (void)
2024 IMAGE_MONO_PIXMAP_MASK |
2025 IMAGE_COLOR_PIXMAP_MASK |
2033 /**********************************************************************
2035 **********************************************************************/
2038 xface_validate (Lisp_Object instantiator)
2040 file_or_data_must_be_present (instantiator);
2044 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2046 /* This function can call lisp */
2047 Lisp_Object file = Qnil, mask_file = Qnil;
2048 struct gcpro gcpro1, gcpro2, gcpro3;
2049 Lisp_Object alist = Qnil;
2051 GCPRO3 (file, mask_file, alist);
2053 /* Now, convert any file data into inline data for both the regular
2054 data and the mask data. At the end of this, `data' will contain
2055 the inline data (if any) or Qnil, and `file' will contain
2056 the name this data was derived from (if known) or Qnil.
2057 Likewise for `mask_file' and `mask_data'.
2059 Note that if we cannot generate any regular inline data, we
2062 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2064 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2065 Q_mask_data, console_type);
2067 if (CONSP (file)) /* failure locating filename */
2068 signal_double_file_error ("Opening bitmap file",
2069 "no such file or directory",
2072 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2073 RETURN_UNGCPRO (inst);
2075 alist = tagged_vector_to_alist (inst);
2078 Lisp_Object data = make_string_from_file (file);
2079 alist = remassq_no_quit (Q_file, alist);
2080 /* there can't be a :data at this point. */
2081 alist = Fcons (Fcons (Q_file, file),
2082 Fcons (Fcons (Q_data, data), alist));
2085 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2088 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2090 RETURN_UNGCPRO (result);
2095 xface_possible_dest_types (void)
2098 IMAGE_MONO_PIXMAP_MASK |
2099 IMAGE_COLOR_PIXMAP_MASK |
2103 #endif /* HAVE_XFACE */
2108 /**********************************************************************
2110 **********************************************************************/
2113 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2119 GET_C_STRING_FILENAME_DATA_ALLOCA (name, fname);
2120 result = XpmReadFileToData (fname, &data);
2122 if (result == XpmSuccess)
2124 Lisp_Object retval = Qnil;
2125 struct buffer *old_buffer = current_buffer;
2126 Lisp_Object temp_buffer =
2127 Fget_buffer_create (build_string (" *pixmap conversion*"));
2129 int height, width, ncolors;
2130 struct gcpro gcpro1, gcpro2, gcpro3;
2131 int speccount = specpdl_depth ();
2133 GCPRO3 (name, retval, temp_buffer);
2135 specbind (Qinhibit_quit, Qt);
2136 set_buffer_internal (XBUFFER (temp_buffer));
2137 Ferase_buffer (Qnil);
2139 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2140 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2142 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2143 for (elt = 0; elt <= width + ncolors; elt++)
2145 buffer_insert_c_string (current_buffer, "\"");
2146 buffer_insert_c_string (current_buffer, data[elt]);
2148 if (elt < width + ncolors)
2149 buffer_insert_c_string (current_buffer, "\",\r");
2151 buffer_insert_c_string (current_buffer, "\"};\r");
2154 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2157 set_buffer_internal (old_buffer);
2158 unbind_to (speccount, Qnil);
2160 RETURN_UNGCPRO (retval);
2165 case XpmFileInvalid:
2167 if (ok_if_data_invalid)
2169 signal_image_error ("invalid XPM data in file", name);
2173 signal_double_file_error ("Reading pixmap file",
2174 "out of memory", name);
2178 /* should never happen? */
2179 signal_double_file_error ("Opening pixmap file",
2180 "no such file or directory", name);
2184 signal_double_file_error_2 ("Parsing pixmap file",
2185 "unknown error code",
2186 make_int (result), name);
2191 return Qnil; /* not reached */
2195 check_valid_xpm_color_symbols (Lisp_Object data)
2199 for (rest = data; !NILP (rest); rest = XCDR (rest))
2201 if (!CONSP (rest) ||
2202 !CONSP (XCAR (rest)) ||
2203 !STRINGP (XCAR (XCAR (rest))) ||
2204 (!STRINGP (XCDR (XCAR (rest))) &&
2205 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2206 signal_simple_error ("Invalid color symbol alist", data);
2211 xpm_validate (Lisp_Object instantiator)
2213 file_or_data_must_be_present (instantiator);
2216 Lisp_Object Vxpm_color_symbols;
2219 evaluate_xpm_color_symbols (void)
2221 Lisp_Object rest, results = Qnil;
2222 struct gcpro gcpro1, gcpro2;
2224 GCPRO2 (rest, results);
2225 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2227 Lisp_Object name, value, cons;
2233 CHECK_STRING (name);
2234 value = XCDR (cons);
2236 value = XCAR (value);
2237 value = Feval (value);
2240 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2242 ("Result from xpm-color-symbols eval must be nil, string, or color",
2244 results = Fcons (Fcons (name, value), results);
2246 UNGCPRO; /* no more evaluation */
2251 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2253 Lisp_Object file = Qnil;
2254 Lisp_Object color_symbols;
2255 struct gcpro gcpro1, gcpro2;
2256 Lisp_Object alist = Qnil;
2258 GCPRO2 (file, alist);
2260 /* Now, convert any file data into inline data. At the end of this,
2261 `data' will contain the inline data (if any) or Qnil, and
2262 `file' will contain the name this data was derived from (if
2265 Note that if we cannot generate any regular inline data, we
2268 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2271 if (CONSP (file)) /* failure locating filename */
2272 signal_double_file_error ("Opening pixmap file",
2273 "no such file or directory",
2276 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2279 if (NILP (file) && !UNBOUNDP (color_symbols))
2280 /* no conversion necessary */
2281 RETURN_UNGCPRO (inst);
2283 alist = tagged_vector_to_alist (inst);
2287 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2288 alist = remassq_no_quit (Q_file, alist);
2289 /* there can't be a :data at this point. */
2290 alist = Fcons (Fcons (Q_file, file),
2291 Fcons (Fcons (Q_data, data), alist));
2294 if (UNBOUNDP (color_symbols))
2296 color_symbols = evaluate_xpm_color_symbols ();
2297 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2302 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2304 RETURN_UNGCPRO (result);
2309 xpm_possible_dest_types (void)
2312 IMAGE_MONO_PIXMAP_MASK |
2313 IMAGE_COLOR_PIXMAP_MASK |
2317 #endif /* HAVE_XPM */
2320 /****************************************************************************
2321 * Image Specifier Object *
2322 ****************************************************************************/
2324 DEFINE_SPECIFIER_TYPE (image);
2327 image_create (Lisp_Object obj)
2329 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2331 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2332 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2333 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2337 image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
2339 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2341 markobj (IMAGE_SPECIFIER_ATTACHEE (image));
2342 markobj (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2346 image_instantiate_cache_result (Lisp_Object locative)
2348 /* locative = (instance instantiator . subtable) */
2349 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2350 free_cons (XCONS (XCDR (locative)));
2351 free_cons (XCONS (locative));
2355 /* Given a specification for an image, return an instance of
2356 the image which matches the given instantiator and which can be
2357 displayed in the given domain. */
2360 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2361 Lisp_Object domain, Lisp_Object instantiator,
2364 Lisp_Object device = DFW_DEVICE (domain);
2365 struct device *d = XDEVICE (device);
2366 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2367 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2369 if (IMAGE_INSTANCEP (instantiator))
2371 /* make sure that the image instance's device and type are
2374 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2377 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2378 if (mask & dest_mask)
2379 return instantiator;
2381 signal_simple_error ("Type of image instance not allowed here",
2385 signal_simple_error_2 ("Wrong device for image instance",
2386 instantiator, device);
2388 else if (VECTORP (instantiator)
2389 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2391 assert (XVECTOR_LENGTH (instantiator) == 3);
2392 return (FACE_PROPERTY_INSTANCE
2393 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2394 Qbackground_pixmap, domain, 0, depth));
2398 Lisp_Object instance;
2399 Lisp_Object subtable;
2400 Lisp_Object ls3 = Qnil;
2401 Lisp_Object pointer_fg = Qnil;
2402 Lisp_Object pointer_bg = Qnil;
2406 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2407 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2408 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2411 /* First look in the hash table. */
2412 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2414 if (UNBOUNDP (subtable))
2416 /* For the image instance cache, we do comparisons with EQ rather
2417 than with EQUAL, as we do for color and font names.
2420 1) pixmap data can be very long, and thus the hashing and
2421 comparing will take awhile.
2422 2) It's not so likely that we'll run into things that are EQUAL
2423 but not EQ (that can happen a lot with faces, because their
2424 specifiers are copied around); but pixmaps tend not to be
2427 However, if the image-instance could be a pointer, we have to
2428 use EQUAL because we massaged the instantiator into a cons3
2429 also containing the foreground and background of the
2433 subtable = make_lisp_hash_table (20,
2434 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2435 : HASH_TABLE_KEY_WEAK,
2436 pointerp ? HASH_TABLE_EQUAL
2438 Fputhash (make_int (dest_mask), subtable,
2439 d->image_instance_cache);
2440 instance = Qunbound;
2444 instance = Fgethash (pointerp ? ls3 : instantiator,
2445 subtable, Qunbound);
2446 /* subwindows have a per-window cache and have to be treated
2447 differently. dest_mask can be a bitwise OR of all image
2448 types so we will only catch someone possibly trying to
2449 instantiate a subwindow type thing. Unfortunately, this
2450 will occur most of the time so this probably slows things
2451 down. But with the current design I don't see anyway
2453 if (UNBOUNDP (instance)
2455 dest_mask & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2457 if (!WINDOWP (domain))
2458 signal_simple_error ("Can't instantiate subwindow outside a window",
2460 instance = Fgethash (instantiator,
2461 XWINDOW (domain)->subwindow_instance_cache,
2466 if (UNBOUNDP (instance))
2468 Lisp_Object locative =
2470 noseeum_cons (pointerp ? ls3 : instantiator,
2472 int speccount = specpdl_depth ();
2474 /* make sure we cache the failures, too.
2475 Use an unwind-protect to catch such errors.
2476 If we fail, the unwind-protect records nil in
2477 the hash table. If we succeed, we change the
2478 car of the locative to the resulting instance,
2479 which gets recorded instead. */
2480 record_unwind_protect (image_instantiate_cache_result,
2482 instance = instantiate_image_instantiator (device,
2485 pointer_fg, pointer_bg,
2488 Fsetcar (locative, instance);
2489 /* only after the image has been instantiated do we know
2490 whether we need to put it in the per-window image instance
2492 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2494 (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2496 if (!WINDOWP (domain))
2497 signal_simple_error ("Can't instantiate subwindow outside a window",
2500 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache );
2502 unbind_to (speccount, Qnil);
2507 if (NILP (instance))
2508 signal_simple_error ("Can't instantiate image (probably cached)",
2514 return Qnil; /* not reached */
2517 /* Validate an image instantiator. */
2520 image_validate (Lisp_Object instantiator)
2522 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2524 else if (VECTORP (instantiator))
2526 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2527 int instantiator_len = XVECTOR_LENGTH (instantiator);
2528 struct image_instantiator_methods *meths;
2529 Lisp_Object already_seen = Qnil;
2530 struct gcpro gcpro1;
2533 if (instantiator_len < 1)
2534 signal_simple_error ("Vector length must be at least 1",
2537 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2538 if (!(instantiator_len & 1))
2540 ("Must have alternating keyword/value pairs", instantiator);
2542 GCPRO1 (already_seen);
2544 for (i = 1; i < instantiator_len; i += 2)
2546 Lisp_Object keyword = elt[i];
2547 Lisp_Object value = elt[i+1];
2550 CHECK_SYMBOL (keyword);
2551 if (!SYMBOL_IS_KEYWORD (keyword))
2552 signal_simple_error ("Symbol must begin with a colon", keyword);
2554 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2555 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2558 if (j == Dynarr_length (meths->keywords))
2559 signal_simple_error ("Unrecognized keyword", keyword);
2561 if (!Dynarr_at (meths->keywords, j).multiple_p)
2563 if (!NILP (memq_no_quit (keyword, already_seen)))
2565 ("Keyword may not appear more than once", keyword);
2566 already_seen = Fcons (keyword, already_seen);
2569 (Dynarr_at (meths->keywords, j).validate) (value);
2574 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2577 signal_simple_error ("Must be string or vector", instantiator);
2581 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2583 Lisp_Object attachee =
2584 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2585 Lisp_Object property =
2586 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2587 if (FACEP (attachee))
2588 face_property_was_changed (attachee, property, locale);
2589 else if (GLYPHP (attachee))
2590 glyph_property_was_changed (attachee, property, locale);
2594 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2595 Lisp_Object property)
2597 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2599 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2600 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2604 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2605 Lisp_Object tag_set, Lisp_Object instantiator)
2607 Lisp_Object possible_console_types = Qnil;
2609 Lisp_Object retlist = Qnil;
2610 struct gcpro gcpro1, gcpro2;
2612 LIST_LOOP (rest, Vconsole_type_list)
2614 Lisp_Object contype = XCAR (rest);
2615 if (!NILP (memq_no_quit (contype, tag_set)))
2616 possible_console_types = Fcons (contype, possible_console_types);
2619 if (XINT (Flength (possible_console_types)) > 1)
2620 /* two conflicting console types specified */
2623 if (NILP (possible_console_types))
2624 possible_console_types = Vconsole_type_list;
2626 GCPRO2 (retlist, possible_console_types);
2628 LIST_LOOP (rest, possible_console_types)
2630 Lisp_Object contype = XCAR (rest);
2631 Lisp_Object newinst = call_with_suspended_errors
2632 ((lisp_fn_t) normalize_image_instantiator,
2633 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2634 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2636 if (!NILP (newinst))
2639 if (NILP (memq_no_quit (contype, tag_set)))
2640 newtag = Fcons (contype, tag_set);
2643 retlist = Fcons (Fcons (newtag, newinst), retlist);
2652 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
2653 Return non-nil if OBJECT is an image specifier.
2655 An image specifier is used for images (pixmaps and the like). It is used
2656 to describe the actual image in a glyph. It is instanced as an image-
2659 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
2660 etc. This describes the format of the data describing the image. The
2661 resulting image instances also come in many types -- `mono-pixmap',
2662 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
2663 the image and the sorts of places it can appear. (For example, a
2664 color-pixmap image has fixed colors specified for it, while a
2665 mono-pixmap image comes in two unspecified shades "foreground" and
2666 "background" that are determined from the face of the glyph or
2667 surrounding text; a text image appears as a string of text and has an
2668 unspecified foreground, background, and font; a pointer image behaves
2669 like a mono-pixmap image but can only be used as a mouse pointer
2670 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
2671 important to keep the distinction between image instantiator format and
2672 image instance type in mind. Typically, a given image instantiator
2673 format can result in many different image instance types (for example,
2674 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
2675 whereas `cursor-font' can be instanced only as `pointer'), and a
2676 particular image instance type can be generated by many different
2677 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
2678 `gif', `jpeg', etc.).
2680 See `make-image-instance' for a more detailed discussion of image
2683 An image instantiator should be a string or a vector of the form
2685 [FORMAT :KEYWORD VALUE ...]
2687 i.e. a format symbol followed by zero or more alternating keyword-value
2688 pairs. FORMAT should be one of
2691 (Don't display anything; no keywords are valid for this.
2692 Can only be instanced as `nothing'.)
2694 (Display this image as a text string. Can only be instanced
2695 as `text', although support for instancing as `mono-pixmap'
2698 (Display this image as a text string, with replaceable fields;
2699 not currently implemented.)
2701 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
2702 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2704 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
2705 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
2707 (An X-Face bitmap, used to encode people's faces in e-mail messages;
2708 only if X-Face support was compiled into this XEmacs. Can be
2709 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2711 (A GIF87 or GIF89 image; only if GIF support was compiled into this
2712 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
2713 Can be instanced as `color-pixmap'.)
2715 (A JPEG image; only if JPEG support was compiled into this XEmacs.
2716 Can be instanced as `color-pixmap'.)
2718 (A PNG image; only if PNG support was compiled into this XEmacs.
2719 Can be instanced as `color-pixmap'.)
2721 (A TIFF image; only if TIFF support was compiled into this XEmacs.
2722 Can be instanced as `color-pixmap'.)
2724 (One of the standard cursor-font names, such as "watch" or
2725 "right_ptr" under X. Under X, this is, more specifically, any
2726 of the standard cursor names from appendix B of the Xlib manual
2727 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
2728 On other window systems, the valid names will be specific to the
2729 type of window system. Can only be instanced as `pointer'.)
2731 (A glyph from a font; i.e. the name of a font, and glyph index into it
2732 of the form "FONT fontname index [[mask-font] mask-index]".
2733 Currently can only be instanced as `pointer', although this should
2736 (An embedded X window; not currently implemented.)
2738 (A widget control, for instance text field or radio button.)
2740 (XEmacs tries to guess what format the data is in. If X support
2741 exists, the data string will be checked to see if it names a filename.
2742 If so, and this filename contains XBM or XPM data, the appropriate
2743 sort of pixmap or pointer will be created. [This includes picking up
2744 any specified hotspot or associated mask file.] Otherwise, if `pointer'
2745 is one of the allowable image-instance types and the string names a
2746 valid cursor-font name, the image will be created as a pointer.
2747 Otherwise, the image will be displayed as text. If no X support
2748 exists, the image will always be displayed as text.)
2750 Inherit from the background-pixmap property of a face.
2752 The valid keywords are:
2755 (Inline data. For most formats above, this should be a string. For
2756 XBM images, this should be a list of three elements: width, height, and
2757 a string of bit data. This keyword is not valid for instantiator
2758 formats `nothing' and `inherit'.)
2760 (Data is contained in a file. The value is the name of this file.
2761 If both :data and :file are specified, the image is created from
2762 what is specified in :data and the string in :file becomes the
2763 value of the `image-instance-file-name' function when applied to
2764 the resulting image-instance. This keyword is not valid for
2765 instantiator formats `nothing', `string', `formatted-string',
2766 `cursor-font', `font', `autodetect', and `inherit'.)
2769 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
2770 allow you to explicitly specify foreground and background colors.
2771 The argument should be anything acceptable to `make-color-instance'.
2772 This will cause what would be a `mono-pixmap' to instead be colorized
2773 as a two-color color-pixmap, and specifies the foreground and/or
2774 background colors for a pointer instead of black and white.)
2776 (For `xbm' and `xface'. This specifies a mask to be used with the
2777 bitmap. The format is a list of width, height, and bits, like for
2780 (For `xbm' and `xface'. This specifies a file containing the mask data.
2781 If neither a mask file nor inline mask data is given for an XBM image,
2782 and the XBM image comes from a file, XEmacs will look for a mask file
2783 with the same name as the image file but with "Mask" or "msk"
2784 appended. For example, if you specify the XBM file "left_ptr"
2785 [usually located in "/usr/include/X11/bitmaps"], the associated
2786 mask file "left_ptrmsk" will automatically be picked up.)
2789 (For `xbm' and `xface'. These keywords specify a hotspot if the image
2790 is instantiated as a `pointer'. Note that if the XBM image file
2791 specifies a hotspot, it will automatically be picked up if no
2792 explicit hotspot is given.)
2794 (Only for `xpm'. This specifies an alist that maps strings
2795 that specify symbolic color names to the actual color to be used
2796 for that symbolic color (in the form of a string or a color-specifier
2797 object). If this is not specified, the contents of `xpm-color-symbols'
2798 are used to generate the alist.)
2800 (Only for `inherit'. This specifies the face to inherit from.)
2802 If instead of a vector, the instantiator is a string, it will be
2803 converted into a vector by looking it up according to the specs in the
2804 `console-type-image-conversion-list' (q.v.) for the console type of
2805 the domain (usually a window; sometimes a frame or device) over which
2806 the image is being instantiated.
2808 If the instantiator specifies data from a file, the data will be read
2809 in at the time that the instantiator is added to the image (which may
2810 be well before when the image is actually displayed), and the
2811 instantiator will be converted into one of the inline-data forms, with
2812 the filename retained using a :file keyword. This implies that the
2813 file must exist when the instantiator is added to the image, but does
2814 not need to exist at any other time (e.g. it may safely be a temporary
2819 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
2823 /****************************************************************************
2825 ****************************************************************************/
2828 mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object))
2830 struct Lisp_Glyph *glyph = XGLYPH (obj);
2832 markobj (glyph->image);
2833 markobj (glyph->contrib_p);
2834 markobj (glyph->baseline);
2835 markobj (glyph->face);
2837 return glyph->plist;
2841 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2843 struct Lisp_Glyph *glyph = XGLYPH (obj);
2847 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
2849 write_c_string ("#<glyph (", printcharfun);
2850 print_internal (Fglyph_type (obj), printcharfun, 0);
2851 write_c_string (") ", printcharfun);
2852 print_internal (glyph->image, printcharfun, 1);
2853 sprintf (buf, "0x%x>", glyph->header.uid);
2854 write_c_string (buf, printcharfun);
2857 /* Glyphs are equal if all of their display attributes are equal. We
2858 don't compare names or doc-strings, because that would make equal
2861 This isn't concerned with "unspecified" attributes, that's what
2862 #'glyph-differs-from-default-p is for. */
2864 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
2866 struct Lisp_Glyph *g1 = XGLYPH (obj1);
2867 struct Lisp_Glyph *g2 = XGLYPH (obj2);
2871 return (internal_equal (g1->image, g2->image, depth) &&
2872 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
2873 internal_equal (g1->baseline, g2->baseline, depth) &&
2874 internal_equal (g1->face, g2->face, depth) &&
2875 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
2878 static unsigned long
2879 glyph_hash (Lisp_Object obj, int depth)
2883 /* No need to hash all of the elements; that would take too long.
2884 Just hash the most common ones. */
2885 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
2886 internal_hash (XGLYPH (obj)->face, depth));
2890 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
2892 struct Lisp_Glyph *g = XGLYPH (obj);
2894 if (EQ (prop, Qimage)) return g->image;
2895 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
2896 if (EQ (prop, Qbaseline)) return g->baseline;
2897 if (EQ (prop, Qface)) return g->face;
2899 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
2903 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
2905 if ((EQ (prop, Qimage)) ||
2906 (EQ (prop, Qcontrib_p)) ||
2907 (EQ (prop, Qbaseline)))
2910 if (EQ (prop, Qface))
2912 XGLYPH (obj)->face = Fget_face (value);
2916 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
2921 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
2923 if ((EQ (prop, Qimage)) ||
2924 (EQ (prop, Qcontrib_p)) ||
2925 (EQ (prop, Qbaseline)))
2928 if (EQ (prop, Qface))
2930 XGLYPH (obj)->face = Qnil;
2934 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
2938 glyph_plist (Lisp_Object obj)
2940 struct Lisp_Glyph *glyph = XGLYPH (obj);
2941 Lisp_Object result = glyph->plist;
2943 result = cons3 (Qface, glyph->face, result);
2944 result = cons3 (Qbaseline, glyph->baseline, result);
2945 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
2946 result = cons3 (Qimage, glyph->image, result);
2951 static const struct lrecord_description glyph_description[] = {
2952 { XD_LISP_OBJECT, offsetof(struct Lisp_Glyph, image), 5 },
2956 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
2957 mark_glyph, print_glyph, 0,
2958 glyph_equal, glyph_hash, glyph_description,
2959 glyph_getprop, glyph_putprop,
2960 glyph_remprop, glyph_plist,
2964 allocate_glyph (enum glyph_type type,
2965 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
2966 Lisp_Object locale))
2968 /* This function can GC */
2969 Lisp_Object obj = Qnil;
2970 struct Lisp_Glyph *g =
2971 alloc_lcrecord_type (struct Lisp_Glyph, &lrecord_glyph);
2974 g->image = Fmake_specifier (Qimage); /* This function can GC */
2978 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2979 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
2980 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
2981 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK;
2984 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2985 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
2988 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2989 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK;
2995 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
2996 /* We're getting enough reports of odd behavior in this area it seems */
2997 /* best to GCPRO everything. */
2999 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3000 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3001 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3002 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3004 GCPRO4 (obj, tem1, tem2, tem3);
3006 set_specifier_fallback (g->image, tem1);
3007 g->contrib_p = Fmake_specifier (Qboolean);
3008 set_specifier_fallback (g->contrib_p, tem2);
3009 /* #### should have a specifier for the following */
3010 g->baseline = Fmake_specifier (Qgeneric);
3011 set_specifier_fallback (g->baseline, tem3);
3014 g->after_change = after_change;
3017 set_image_attached_to (g->image, obj, Qimage);
3024 static enum glyph_type
3025 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3028 return GLYPH_BUFFER;
3030 if (ERRB_EQ (errb, ERROR_ME))
3031 CHECK_SYMBOL (type);
3033 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3034 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3035 if (EQ (type, Qicon)) return GLYPH_ICON;
3037 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3039 return GLYPH_UNKNOWN;
3043 valid_glyph_type_p (Lisp_Object type)
3045 return !NILP (memq_no_quit (type, Vglyph_type_list));
3048 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3049 Given a GLYPH-TYPE, return non-nil if it is valid.
3050 Valid types are `buffer', `pointer', and `icon'.
3054 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3057 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3058 Return a list of valid glyph types.
3062 return Fcopy_sequence (Vglyph_type_list);
3065 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3066 Create and return a new uninitialized glyph or type TYPE.
3068 TYPE specifies the type of the glyph; this should be one of `buffer',
3069 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3070 specifies in which contexts the glyph can be used, and controls the
3071 allowable image types into which the glyph's image can be
3074 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3075 extent, in the modeline, and in the toolbar. Their image can be
3076 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3079 `pointer' glyphs can be used to specify the mouse pointer. Their
3080 image can be instantiated as `pointer'.
3082 `icon' glyphs can be used to specify the icon used when a frame is
3083 iconified. Their image can be instantiated as `mono-pixmap' and
3088 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3089 return allocate_glyph (typeval, 0);
3092 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3093 Return non-nil if OBJECT is a glyph.
3095 A glyph is an object used for pixmaps and the like. It is used
3096 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3097 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3098 buttons, and the like. Its image is described using an image specifier --
3099 see `image-specifier-p'.
3103 return GLYPHP (object) ? Qt : Qnil;
3106 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3107 Return the type of the given glyph.
3108 The return value will be one of 'buffer, 'pointer, or 'icon.
3112 CHECK_GLYPH (glyph);
3113 switch (XGLYPH_TYPE (glyph))
3116 case GLYPH_BUFFER: return Qbuffer;
3117 case GLYPH_POINTER: return Qpointer;
3118 case GLYPH_ICON: return Qicon;
3122 /*****************************************************************************
3125 Return the width of the given GLYPH on the given WINDOW. If the
3126 instance is a string then the width is calculated using the font of
3127 the given FACE, unless a face is defined by the glyph itself.
3128 ****************************************************************************/
3130 glyph_width (Lisp_Object glyph, Lisp_Object frame_face,
3131 face_index window_findex, Lisp_Object window)
3133 Lisp_Object instance;
3134 Lisp_Object frame = XWINDOW (window)->frame;
3136 /* #### We somehow need to distinguish between the user causing this
3137 error condition and a bug causing it. */
3138 if (!GLYPHP (glyph))
3141 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3143 if (!IMAGE_INSTANCEP (instance))
3146 switch (XIMAGE_INSTANCE_TYPE (instance))
3150 Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance);
3151 Lisp_Object private_face = XGLYPH_FACE(glyph);
3153 if (!NILP (private_face))
3154 return redisplay_frame_text_width_string (XFRAME (frame),
3158 if (!NILP (frame_face))
3159 return redisplay_frame_text_width_string (XFRAME (frame),
3163 return redisplay_text_width_string (XWINDOW (window),
3168 case IMAGE_MONO_PIXMAP:
3169 case IMAGE_COLOR_PIXMAP:
3171 return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance);
3176 case IMAGE_SUBWINDOW:
3178 return XIMAGE_INSTANCE_SUBWINDOW_WIDTH (instance);
3186 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3187 Return the width of GLYPH on WINDOW.
3188 This may not be exact as it does not take into account all of the context
3189 that redisplay will.
3193 XSETWINDOW (window, decode_window (window));
3194 CHECK_GLYPH (glyph);
3196 return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window));
3199 #define RETURN_ASCENT 0
3200 #define RETURN_DESCENT 1
3201 #define RETURN_HEIGHT 2
3204 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3205 Error_behavior errb, int no_quit)
3207 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3209 /* This can never return Qunbound. All glyphs have 'nothing as
3211 return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0,
3215 static unsigned short
3216 glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face,
3217 face_index window_findex, Lisp_Object window,
3220 Lisp_Object instance;
3221 Lisp_Object frame = XWINDOW (window)->frame;
3223 if (!GLYPHP (glyph))
3226 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3228 if (!IMAGE_INSTANCEP (instance))
3231 switch (XIMAGE_INSTANCE_TYPE (instance))
3235 struct font_metric_info fm;
3236 Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance);
3237 unsigned char charsets[NUM_LEADING_BYTES];
3238 struct face_cachel frame_cachel;
3239 struct face_cachel *cachel;
3241 find_charsets_in_bufbyte_string (charsets,
3242 XSTRING_DATA (string),
3243 XSTRING_LENGTH (string));
3245 if (!NILP (frame_face))
3247 reset_face_cachel (&frame_cachel);
3248 update_face_cachel_data (&frame_cachel, frame, frame_face);
3249 cachel = &frame_cachel;
3252 cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex);
3253 ensure_face_cachel_complete (cachel, window, charsets);
3255 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
3259 case RETURN_ASCENT: return fm.ascent;
3260 case RETURN_DESCENT: return fm.descent;
3261 case RETURN_HEIGHT: return fm.ascent + fm.descent;
3264 return 0; /* not reached */
3268 case IMAGE_MONO_PIXMAP:
3269 case IMAGE_COLOR_PIXMAP:
3271 /* #### Ugh ugh ugh -- temporary crap */
3272 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3273 return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance);
3280 case IMAGE_SUBWINDOW:
3282 /* #### Ugh ugh ugh -- temporary crap */
3283 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3284 return XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (instance);
3295 glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face,
3296 face_index window_findex, Lisp_Object window)
3298 return glyph_height_internal (glyph, frame_face, window_findex, window,
3303 glyph_descent (Lisp_Object glyph, Lisp_Object frame_face,
3304 face_index window_findex, Lisp_Object window)
3306 return glyph_height_internal (glyph, frame_face, window_findex, window,
3310 /* strictly a convenience function. */
3312 glyph_height (Lisp_Object glyph, Lisp_Object frame_face,
3313 face_index window_findex, Lisp_Object window)
3315 return glyph_height_internal (glyph, frame_face, window_findex, window,
3319 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3320 Return the ascent value of GLYPH on WINDOW.
3321 This may not be exact as it does not take into account all of the context
3322 that redisplay will.
3326 XSETWINDOW (window, decode_window (window));
3327 CHECK_GLYPH (glyph);
3329 return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window));
3332 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3333 Return the descent value of GLYPH on WINDOW.
3334 This may not be exact as it does not take into account all of the context
3335 that redisplay will.
3339 XSETWINDOW (window, decode_window (window));
3340 CHECK_GLYPH (glyph);
3342 return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window));
3345 /* This is redundant but I bet a lot of people expect it to exist. */
3346 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3347 Return the height of GLYPH on WINDOW.
3348 This may not be exact as it does not take into account all of the context
3349 that redisplay will.
3353 XSETWINDOW (window, decode_window (window));
3354 CHECK_GLYPH (glyph);
3356 return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window));
3359 #undef RETURN_ASCENT
3360 #undef RETURN_DESCENT
3361 #undef RETURN_HEIGHT
3363 /* #### do we need to cache this info to speed things up? */
3366 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3368 if (!GLYPHP (glyph))
3372 Lisp_Object retval =
3373 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3374 /* #### look into ERROR_ME_NOT */
3375 Qunbound, domain, ERROR_ME_NOT,
3377 if (!NILP (retval) && !INTP (retval))
3379 else if (INTP (retval))
3381 if (XINT (retval) < 0)
3383 if (XINT (retval) > 100)
3384 retval = make_int (100);
3391 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3393 /* #### Domain parameter not currently used but it will be */
3394 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3398 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3400 if (!GLYPHP (glyph))
3403 return !NILP (specifier_instance_no_quit
3404 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3405 /* #### look into ERROR_ME_NOT */
3406 ERROR_ME_NOT, 0, Qzero));
3410 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3413 if (XGLYPH (glyph)->after_change)
3414 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3418 /*****************************************************************************
3419 * glyph cachel functions *
3420 *****************************************************************************/
3423 #### All of this is 95% copied from face cachels.
3424 Consider consolidating.
3425 #### We need to add a dirty flag to the glyphs.
3429 mark_glyph_cachels (glyph_cachel_dynarr *elements,
3430 void (*markobj) (Lisp_Object))
3437 for (elt = 0; elt < Dynarr_length (elements); elt++)
3439 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3440 markobj (cachel->glyph);
3445 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3446 struct glyph_cachel *cachel)
3448 /* #### This should be || !cachel->updated */
3449 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph))
3453 XSETWINDOW (window, w);
3455 /* #### This could be sped up if we redid things to grab the glyph
3456 instantiation and passed it to the size functions. */
3457 cachel->glyph = glyph;
3458 cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window);
3459 cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window);
3460 cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window);
3463 cachel->updated = 1;
3467 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3469 struct glyph_cachel new_cachel;
3472 new_cachel.glyph = Qnil;
3474 update_glyph_cachel_data (w, glyph, &new_cachel);
3475 Dynarr_add (w->glyph_cachels, new_cachel);
3479 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3486 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3488 struct glyph_cachel *cachel =
3489 Dynarr_atp (w->glyph_cachels, elt);
3491 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3493 if (!cachel->updated)
3494 update_glyph_cachel_data (w, glyph, cachel);
3499 /* If we didn't find the glyph, add it and then return its index. */
3500 add_glyph_cachel (w, glyph);
3505 reset_glyph_cachels (struct window *w)
3507 Dynarr_reset (w->glyph_cachels);
3508 get_glyph_cachel_index (w, Vcontinuation_glyph);
3509 get_glyph_cachel_index (w, Vtruncation_glyph);
3510 get_glyph_cachel_index (w, Vhscroll_glyph);
3511 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3512 get_glyph_cachel_index (w, Voctal_escape_glyph);
3513 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3517 mark_glyph_cachels_as_not_updated (struct window *w)
3521 /* We need to have a dirty flag to tell if the glyph has changed.
3522 We can check to see if each glyph variable is actually a
3523 completely different glyph, though. */
3524 #define FROB(glyph_obj, gindex) \
3525 update_glyph_cachel_data (w, glyph_obj, \
3526 Dynarr_atp (w->glyph_cachels, gindex))
3528 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3529 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3530 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3531 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3532 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3533 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3536 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3537 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3540 #ifdef MEMORY_USAGE_STATS
3543 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3544 struct overhead_stats *ovstats)
3549 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3554 #endif /* MEMORY_USAGE_STATS */
3558 /*****************************************************************************
3559 * subwindow cachel functions *
3560 *****************************************************************************/
3561 /* subwindows are curious in that you have to physically unmap them to
3562 not display them. It is problematic deciding what to do in
3563 redisplay. We have two caches - a per-window instance cache that
3564 keeps track of subwindows on a window, these are linked to their
3565 instantiator in the hashtable and when the instantiator goes away
3566 we want the instance to go away also. However we also have a
3567 per-frame instance cache that we use to determine if a subwindow is
3568 obscuring an area that we want to clear. We need to be able to flip
3569 through this quickly so a hashtable is not suitable hence the
3570 subwindow_cachels. The question is should we just not mark
3571 instances in the subwindow_cachelsnor should we try and invalidate
3572 the cache at suitable points in redisplay? If we don't invalidate
3573 the cache it will fill up with crud that will only get removed when
3574 the frame is deleted. So invalidation is good, the question is when
3575 and whether we mark as well. Go for the simple option - don't mark,
3576 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
3579 mark_subwindow_cachels (subwindow_cachel_dynarr *elements,
3580 void (*markobj) (Lisp_Object))
3587 for (elt = 0; elt < Dynarr_length (elements); elt++)
3589 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
3590 markobj (cachel->subwindow);
3595 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
3596 struct subwindow_cachel *cachel)
3598 if (NILP (cachel->subwindow) || !EQ (cachel->subwindow, subwindow))
3600 cachel->subwindow = subwindow;
3601 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3602 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3605 cachel->updated = 1;
3609 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
3611 struct subwindow_cachel new_cachel;
3614 new_cachel.subwindow = Qnil;
3617 new_cachel.being_displayed=0;
3619 update_subwindow_cachel_data (f, subwindow, &new_cachel);
3620 Dynarr_add (f->subwindow_cachels, new_cachel);
3624 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
3631 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3633 struct subwindow_cachel *cachel =
3634 Dynarr_atp (f->subwindow_cachels, elt);
3636 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
3638 if (!cachel->updated)
3639 update_subwindow_cachel_data (f, subwindow, cachel);
3644 /* If we didn't find the glyph, add it and then return its index. */
3645 add_subwindow_cachel (f, subwindow);
3649 /* redisplay in general assumes that drawing something will erase
3650 what was there before. unfortunately this does not apply to
3651 subwindows that need to be specifically unmapped in order to
3652 disappear. we take a brute force approach - on the basis that its
3653 cheap - and unmap all subwindows in a display line */
3655 reset_subwindow_cachels (struct frame *f)
3658 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3660 struct subwindow_cachel *cachel =
3661 Dynarr_atp (f->subwindow_cachels, elt);
3663 if (!NILP (cachel->subwindow) && cachel->being_displayed)
3665 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (cachel->subwindow);
3666 MAYBE_DEVMETH (XDEVICE (f->device), unmap_subwindow, (ii));
3669 Dynarr_reset (f->subwindow_cachels);
3673 mark_subwindow_cachels_as_not_updated (struct frame *f)
3677 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3678 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
3682 /*****************************************************************************
3683 * subwindow functions *
3684 *****************************************************************************/
3686 /* update the displayed characteristics of a subwindow */
3688 update_subwindow (Lisp_Object subwindow)
3690 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3692 if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3694 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3697 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
3701 update_frame_subwindows (struct frame *f)
3705 if (f->subwindows_changed || f->glyphs_changed)
3706 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3708 struct subwindow_cachel *cachel =
3709 Dynarr_atp (f->subwindow_cachels, elt);
3711 if (cachel->being_displayed)
3713 update_subwindow (cachel->subwindow);
3718 /* remove a subwindow from its frame */
3719 void unmap_subwindow (Lisp_Object subwindow)
3721 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3723 struct subwindow_cachel* cachel;
3726 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3728 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3730 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3733 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3734 elt = get_subwindow_cachel_index (f, subwindow);
3735 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3739 cachel->being_displayed = 0;
3740 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3742 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
3745 /* show a subwindow in its frame */
3746 void map_subwindow (Lisp_Object subwindow, int x, int y)
3748 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3750 struct subwindow_cachel* cachel;
3753 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3755 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3757 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3760 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3761 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
3762 elt = get_subwindow_cachel_index (f, subwindow);
3763 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3766 cachel->being_displayed = 1;
3768 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y));
3772 subwindow_possible_dest_types (void)
3774 return IMAGE_SUBWINDOW_MASK;
3777 /* Partially instantiate a subwindow. */
3779 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
3780 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
3781 int dest_mask, Lisp_Object domain)
3783 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
3784 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
3785 Lisp_Object frame = FW_FRAME (domain);
3786 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
3787 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
3790 signal_simple_error ("No selected frame", device);
3792 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
3793 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
3796 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
3797 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = Qnil;
3798 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3799 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
3801 /* this stuff may get overidden by the widget code */
3803 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
3808 if (XINT (width) > 1)
3810 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
3813 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
3818 if (XINT (height) > 1)
3820 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
3824 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
3825 Return non-nil if OBJECT is a subwindow.
3829 CHECK_IMAGE_INSTANCE (object);
3830 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
3833 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
3834 Return the window id of SUBWINDOW as a number.
3838 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3839 return make_int ((int) (XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)));
3842 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
3843 Resize SUBWINDOW to WIDTH x HEIGHT.
3844 If a value is nil that parameter is not changed.
3846 (subwindow, width, height))
3850 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3853 neww = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3855 neww = XINT (width);
3858 newh = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3860 newh = XINT (height);
3863 MAYBE_DEVMETH (XDEVICE (XIMAGE_INSTANCE_DEVICE (subwindow)),
3864 resize_subwindow, (XIMAGE_INSTANCE (subwindow), neww, newh));
3866 XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow) = newh;
3867 XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow) = neww;
3872 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
3873 Generate a Map event for SUBWINDOW.
3877 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3879 map_subwindow (subwindow, 0, 0);
3885 /*****************************************************************************
3887 *****************************************************************************/
3889 /* Get the display tables for use currently on window W with face
3890 FACE. #### This will have to be redone. */
3893 get_display_tables (struct window *w, face_index findex,
3894 Lisp_Object *face_table, Lisp_Object *window_table)
3897 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
3901 tem = noseeum_cons (tem, Qnil);
3903 tem = w->display_table;
3907 tem = noseeum_cons (tem, Qnil);
3908 *window_table = tem;
3912 display_table_entry (Emchar ch, Lisp_Object face_table,
3913 Lisp_Object window_table)
3917 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
3918 for (tail = face_table; 1; tail = XCDR (tail))
3923 if (!NILP (window_table))
3925 tail = window_table;
3926 window_table = Qnil;
3931 table = XCAR (tail);
3933 if (VECTORP (table))
3935 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
3936 return XVECTOR_DATA (table)[ch];
3940 else if (CHAR_TABLEP (table)
3941 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
3943 return get_char_table (ch, XCHAR_TABLE (table));
3945 else if (CHAR_TABLEP (table)
3946 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
3948 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
3954 else if (RANGE_TABLEP (table))
3956 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
3967 /*****************************************************************************
3969 *****************************************************************************/
3972 syms_of_glyphs (void)
3974 /* image instantiators */
3976 DEFSUBR (Fimage_instantiator_format_list);
3977 DEFSUBR (Fvalid_image_instantiator_format_p);
3978 DEFSUBR (Fset_console_type_image_conversion_list);
3979 DEFSUBR (Fconsole_type_image_conversion_list);
3981 defkeyword (&Q_file, ":file");
3982 defkeyword (&Q_data, ":data");
3983 defkeyword (&Q_face, ":face");
3984 defkeyword (&Q_pixel_height, ":pixel-height");
3985 defkeyword (&Q_pixel_width, ":pixel-width");
3988 defkeyword (&Q_color_symbols, ":color-symbols");
3990 #ifdef HAVE_WINDOW_SYSTEM
3991 defkeyword (&Q_mask_file, ":mask-file");
3992 defkeyword (&Q_mask_data, ":mask-data");
3993 defkeyword (&Q_hotspot_x, ":hotspot-x");
3994 defkeyword (&Q_hotspot_y, ":hotspot-y");
3995 defkeyword (&Q_foreground, ":foreground");
3996 defkeyword (&Q_background, ":background");
3998 /* image specifiers */
4000 DEFSUBR (Fimage_specifier_p);
4001 /* Qimage in general.c */
4003 /* image instances */
4005 defsymbol (&Qimage_instancep, "image-instance-p");
4007 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
4008 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
4009 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
4010 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
4011 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
4012 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
4013 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
4015 DEFSUBR (Fmake_image_instance);
4016 DEFSUBR (Fimage_instance_p);
4017 DEFSUBR (Fimage_instance_type);
4018 DEFSUBR (Fvalid_image_instance_type_p);
4019 DEFSUBR (Fimage_instance_type_list);
4020 DEFSUBR (Fimage_instance_name);
4021 DEFSUBR (Fimage_instance_string);
4022 DEFSUBR (Fimage_instance_file_name);
4023 DEFSUBR (Fimage_instance_mask_file_name);
4024 DEFSUBR (Fimage_instance_depth);
4025 DEFSUBR (Fimage_instance_height);
4026 DEFSUBR (Fimage_instance_width);
4027 DEFSUBR (Fimage_instance_hotspot_x);
4028 DEFSUBR (Fimage_instance_hotspot_y);
4029 DEFSUBR (Fimage_instance_foreground);
4030 DEFSUBR (Fimage_instance_background);
4031 DEFSUBR (Fimage_instance_property);
4032 DEFSUBR (Fset_image_instance_property);
4033 DEFSUBR (Fcolorize_image_instance);
4035 DEFSUBR (Fsubwindowp);
4036 DEFSUBR (Fimage_instance_subwindow_id);
4037 DEFSUBR (Fresize_subwindow);
4038 DEFSUBR (Fforce_subwindow_map);
4040 /* Qnothing defined as part of the "nothing" image-instantiator
4042 /* Qtext defined in general.c */
4043 defsymbol (&Qmono_pixmap, "mono-pixmap");
4044 defsymbol (&Qcolor_pixmap, "color-pixmap");
4045 /* Qpointer defined in general.c */
4049 defsymbol (&Qglyphp, "glyphp");
4050 defsymbol (&Qcontrib_p, "contrib-p");
4051 defsymbol (&Qbaseline, "baseline");
4053 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4054 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4055 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4057 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4059 DEFSUBR (Fglyph_type);
4060 DEFSUBR (Fvalid_glyph_type_p);
4061 DEFSUBR (Fglyph_type_list);
4063 DEFSUBR (Fmake_glyph_internal);
4064 DEFSUBR (Fglyph_width);
4065 DEFSUBR (Fglyph_ascent);
4066 DEFSUBR (Fglyph_descent);
4067 DEFSUBR (Fglyph_height);
4069 /* Qbuffer defined in general.c. */
4070 /* Qpointer defined above */
4073 deferror (&Qimage_conversion_error,
4074 "image-conversion-error",
4075 "image-conversion error", Qio_error);
4080 specifier_type_create_image (void)
4082 /* image specifiers */
4084 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4086 SPECIFIER_HAS_METHOD (image, create);
4087 SPECIFIER_HAS_METHOD (image, mark);
4088 SPECIFIER_HAS_METHOD (image, instantiate);
4089 SPECIFIER_HAS_METHOD (image, validate);
4090 SPECIFIER_HAS_METHOD (image, after_change);
4091 SPECIFIER_HAS_METHOD (image, going_to_add);
4095 image_instantiator_format_create (void)
4097 /* image instantiators */
4099 the_image_instantiator_format_entry_dynarr =
4100 Dynarr_new (image_instantiator_format_entry);
4102 Vimage_instantiator_format_list = Qnil;
4103 staticpro (&Vimage_instantiator_format_list);
4105 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
4107 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
4108 IIFORMAT_HAS_METHOD (nothing, instantiate);
4110 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
4112 IIFORMAT_HAS_METHOD (inherit, validate);
4113 IIFORMAT_HAS_METHOD (inherit, normalize);
4114 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
4115 IIFORMAT_HAS_METHOD (inherit, instantiate);
4117 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
4119 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
4121 IIFORMAT_HAS_METHOD (string, validate);
4122 IIFORMAT_HAS_METHOD (string, possible_dest_types);
4123 IIFORMAT_HAS_METHOD (string, instantiate);
4125 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4127 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4129 IIFORMAT_HAS_METHOD (formatted_string, validate);
4130 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4131 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
4132 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
4135 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
4136 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
4137 IIFORMAT_HAS_METHOD (subwindow, instantiate);
4138 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
4139 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
4141 #ifdef HAVE_WINDOW_SYSTEM
4142 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4144 IIFORMAT_HAS_METHOD (xbm, validate);
4145 IIFORMAT_HAS_METHOD (xbm, normalize);
4146 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4148 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4149 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4150 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4151 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4152 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4153 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4154 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4155 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4156 #endif /* HAVE_WINDOW_SYSTEM */
4159 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
4161 IIFORMAT_HAS_METHOD (xface, validate);
4162 IIFORMAT_HAS_METHOD (xface, normalize);
4163 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
4165 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
4166 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
4167 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
4168 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
4169 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
4170 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
4174 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
4176 IIFORMAT_HAS_METHOD (xpm, validate);
4177 IIFORMAT_HAS_METHOD (xpm, normalize);
4178 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
4180 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
4181 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
4182 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
4183 #endif /* HAVE_XPM */
4187 vars_of_glyphs (void)
4189 Vthe_nothing_vector = vector1 (Qnothing);
4190 staticpro (&Vthe_nothing_vector);
4192 /* image instances */
4194 Vimage_instance_type_list = Fcons (Qnothing,
4195 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
4196 Qpointer, Qsubwindow, Qwidget));
4197 staticpro (&Vimage_instance_type_list);
4201 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
4202 staticpro (&Vglyph_type_list);
4204 /* The octal-escape glyph, control-arrow-glyph and
4205 invisible-text-glyph are completely initialized in glyphs.el */
4207 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
4208 What to prefix character codes displayed in octal with.
4210 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4212 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
4213 What to use as an arrow for control characters.
4215 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
4216 redisplay_glyph_changed);
4218 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
4219 What to use to indicate the presence of invisible text.
4220 This is the glyph that is displayed when an ellipsis is called for
4221 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
4222 Normally this is three dots ("...").
4224 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
4225 redisplay_glyph_changed);
4227 /* Partially initialized in glyphs.el */
4228 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
4229 What to display at the beginning of horizontally scrolled lines.
4231 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4232 #ifdef HAVE_WINDOW_SYSTEM
4238 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
4239 Definitions of logical color-names used when reading XPM files.
4240 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
4241 The COLOR-NAME should be a string, which is the name of the color to define;
4242 the FORM should evaluate to a `color' specifier object, or a string to be
4243 passed to `make-color-instance'. If a loaded XPM file references a symbolic
4244 color called COLOR-NAME, it will display as the computed color instead.
4246 The default value of this variable defines the logical color names
4247 \"foreground\" and \"background\" to be the colors of the `default' face.
4249 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
4250 #endif /* HAVE_XPM */
4257 specifier_vars_of_glyphs (void)
4259 /* #### Can we GC here? The set_specifier_* calls definitely need */
4261 /* display tables */
4263 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
4264 *The display table currently in use.
4265 This is a specifier; use `set-specifier' to change it.
4266 The display table is a vector created with `make-display-table'.
4267 The 256 elements control how to display each possible text character.
4268 Each value should be a string, a glyph, a vector or nil.
4269 If a value is a vector it must be composed only of strings and glyphs.
4270 nil means display the character in the default fashion.
4271 Faces can have their own, overriding display table.
4273 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
4274 set_specifier_fallback (Vcurrent_display_table,
4275 list1 (Fcons (Qnil, Qnil)));
4276 set_specifier_caching (Vcurrent_display_table,
4277 slot_offset (struct window,
4279 some_window_value_changed,
4284 complex_vars_of_glyphs (void)
4286 /* Partially initialized in glyphs-x.c, glyphs.el */
4287 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
4288 What to display at the end of truncated lines.
4290 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4292 /* Partially initialized in glyphs-x.c, glyphs.el */
4293 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
4294 What to display at the end of wrapped lines.
4296 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4298 /* Partially initialized in glyphs-x.c, glyphs.el */
4299 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
4300 The glyph used to display the XEmacs logo at startup.
4302 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);