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)
179 return (decode_image_instantiator_format (format, ERROR_ME_NOT) != 0);
182 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
184 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
185 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
186 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
187 'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled.
189 (image_instantiator_format))
191 return valid_image_instantiator_format_p (image_instantiator_format) ?
195 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
197 Return a list of valid image-instantiator formats.
201 return Fcopy_sequence (Vimage_instantiator_format_list);
205 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol,
206 struct image_instantiator_methods *meths)
208 struct image_instantiator_format_entry entry;
210 entry.symbol = symbol;
211 entry.device = device;
213 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
214 Vimage_instantiator_format_list =
215 Fcons (symbol, Vimage_instantiator_format_list);
219 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
221 image_instantiator_methods *meths)
223 add_entry_to_device_ii_format_list (Qnil, symbol, meths);
227 get_image_conversion_list (Lisp_Object console_type)
229 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
232 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
234 Set the image-conversion-list for consoles of the given TYPE.
235 The image-conversion-list specifies how image instantiators that
236 are strings should be interpreted. Each element of the list should be
237 a list of two elements (a regular expression string and a vector) or
238 a list of three elements (the preceding two plus an integer index into
239 the vector). The string is converted to the vector associated with the
240 first matching regular expression. If a vector index is specified, the
241 string itself is substituted into that position in the vector.
243 Note: The conversion above is applied when the image instantiator is
244 added to an image specifier, not when the specifier is actually
245 instantiated. Therefore, changing the image-conversion-list only affects
246 newly-added instantiators. Existing instantiators in glyphs and image
247 specifiers will not be affected.
249 (console_type, list))
252 Lisp_Object *imlist = get_image_conversion_list (console_type);
254 /* Check the list to make sure that it only has valid entries. */
256 EXTERNAL_LIST_LOOP (tail, list)
258 Lisp_Object mapping = XCAR (tail);
260 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
261 if (!CONSP (mapping) ||
262 !CONSP (XCDR (mapping)) ||
263 (!NILP (XCDR (XCDR (mapping))) &&
264 (!CONSP (XCDR (XCDR (mapping))) ||
265 !NILP (XCDR (XCDR (XCDR (mapping)))))))
266 signal_simple_error ("Invalid mapping form", mapping);
269 Lisp_Object exp = XCAR (mapping);
270 Lisp_Object typevec = XCAR (XCDR (mapping));
271 Lisp_Object pos = Qnil;
276 CHECK_VECTOR (typevec);
277 if (!NILP (XCDR (XCDR (mapping))))
279 pos = XCAR (XCDR (XCDR (mapping)));
281 if (XINT (pos) < 0 ||
282 XINT (pos) >= XVECTOR_LENGTH (typevec))
284 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
287 newvec = Fcopy_sequence (typevec);
289 XVECTOR_DATA (newvec)[XINT (pos)] = exp;
291 image_validate (newvec);
296 *imlist = Fcopy_tree (list, Qt);
300 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
302 Return the image-conversion-list for devices of the given TYPE.
303 The image-conversion-list specifies how to interpret image string
304 instantiators for the specified console type. See
305 `set-console-type-image-conversion-list' for a description of its syntax.
309 return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
312 /* Process a string instantiator according to the image-conversion-list for
313 CONSOLE_TYPE. Returns a vector. */
316 process_image_string_instantiator (Lisp_Object data,
317 Lisp_Object console_type,
322 LIST_LOOP (tail, *get_image_conversion_list (console_type))
324 Lisp_Object mapping = XCAR (tail);
325 Lisp_Object exp = XCAR (mapping);
326 Lisp_Object typevec = XCAR (XCDR (mapping));
328 /* if the result is of a type that can't be instantiated
329 (e.g. a string when we're dealing with a pointer glyph),
332 IIFORMAT_METH (decode_image_instantiator_format
333 (XVECTOR_DATA (typevec)[0], ERROR_ME),
334 possible_dest_types, ())))
336 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
338 if (!NILP (XCDR (XCDR (mapping))))
340 int pos = XINT (XCAR (XCDR (XCDR (mapping))));
341 Lisp_Object newvec = Fcopy_sequence (typevec);
342 XVECTOR_DATA (newvec)[pos] = data;
351 signal_simple_error ("Unable to interpret glyph instantiator",
358 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
359 Lisp_Object default_)
362 int instantiator_len;
364 elt = XVECTOR_DATA (vector);
365 instantiator_len = XVECTOR_LENGTH (vector);
370 while (instantiator_len > 0)
372 if (EQ (elt[0], keyword))
375 instantiator_len -= 2;
382 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
384 return find_keyword_in_vector_or_given (vector, keyword, Qnil);
388 check_valid_string (Lisp_Object data)
394 check_valid_vector (Lisp_Object data)
400 check_valid_face (Lisp_Object data)
406 check_valid_int (Lisp_Object data)
412 file_or_data_must_be_present (Lisp_Object instantiator)
414 if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
415 NILP (find_keyword_in_vector (instantiator, Q_data)))
416 signal_simple_error ("Must supply either :file or :data",
421 data_must_be_present (Lisp_Object instantiator)
423 if (NILP (find_keyword_in_vector (instantiator, Q_data)))
424 signal_simple_error ("Must supply :data", instantiator);
428 face_must_be_present (Lisp_Object instantiator)
430 if (NILP (find_keyword_in_vector (instantiator, Q_face)))
431 signal_simple_error ("Must supply :face", instantiator);
434 /* utility function useful in retrieving data from a file. */
437 make_string_from_file (Lisp_Object file)
439 /* This function can call lisp */
440 int count = specpdl_depth ();
441 Lisp_Object temp_buffer;
445 specbind (Qinhibit_quit, Qt);
446 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
447 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
448 GCPRO1 (temp_buffer);
449 set_buffer_internal (XBUFFER (temp_buffer));
450 Ferase_buffer (Qnil);
451 specbind (intern ("format-alist"), Qnil);
452 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
453 data = Fbuffer_substring (Qnil, Qnil, Qnil);
454 unbind_to (count, Qnil);
459 /* The following two functions are provided to make it easier for
460 the normalize methods to work with keyword-value vectors.
461 Hash tables are kind of heavyweight for this purpose.
462 (If vectors were resizable, we could avoid this problem;
463 but they're not.) An alternative approach that might be
464 more efficient but require more work is to use a type of
465 assoc-Dynarr and provide primitives for deleting elements out
466 of it. (However, you'd also have to add an unwind-protect
467 to make sure the Dynarr got freed in case of an error in
468 the normalization process.) */
471 tagged_vector_to_alist (Lisp_Object vector)
473 Lisp_Object *elt = XVECTOR_DATA (vector);
474 int len = XVECTOR_LENGTH (vector);
475 Lisp_Object result = Qnil;
478 for (len -= 2; len >= 1; len -= 2)
479 result = Fcons (Fcons (elt[len], elt[len+1]), result);
485 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
487 int len = 1 + 2 * XINT (Flength (alist));
488 Lisp_Object *elt = alloca_array (Lisp_Object, len);
494 LIST_LOOP (rest, alist)
496 Lisp_Object pair = XCAR (rest);
497 elt[i] = XCAR (pair);
498 elt[i+1] = XCDR (pair);
502 return Fvector (len, elt);
506 normalize_image_instantiator (Lisp_Object instantiator,
508 Lisp_Object dest_mask)
510 if (IMAGE_INSTANCEP (instantiator))
513 if (STRINGP (instantiator))
514 instantiator = process_image_string_instantiator (instantiator, contype,
517 assert (VECTORP (instantiator));
518 /* We have to always store the actual pixmap data and not the
519 filename even though this is a potential memory pig. We have to
520 do this because it is quite possible that we will need to
521 instantiate a new instance of the pixmap and the file will no
522 longer exist (e.g. w3 pixmaps are almost always from temporary
526 struct image_instantiator_methods *meths;
528 GCPRO1 (instantiator);
530 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
532 RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
533 (instantiator, contype),
539 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
540 Lisp_Object instantiator,
541 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
544 Lisp_Object ii = allocate_image_instance (device);
545 struct image_instantiator_methods *meths;
550 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
552 methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate);
553 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
554 pointer_bg, dest_mask, domain));
556 /* now do device specific instantiation */
557 meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0],
560 if (!methp && (!meths || !HAS_IIFORMAT_METH_P (meths, instantiate)))
562 ("Don't know how to instantiate this image instantiator?",
564 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
565 pointer_bg, dest_mask, domain));
572 /****************************************************************************
573 * Image-Instance Object *
574 ****************************************************************************/
576 Lisp_Object Qimage_instancep;
579 mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
581 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
584 switch (IMAGE_INSTANCE_TYPE (i))
587 markobj (IMAGE_INSTANCE_TEXT_STRING (i));
589 case IMAGE_MONO_PIXMAP:
590 case IMAGE_COLOR_PIXMAP:
591 markobj (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
592 markobj (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
593 markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
594 markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
595 markobj (IMAGE_INSTANCE_PIXMAP_FG (i));
596 markobj (IMAGE_INSTANCE_PIXMAP_BG (i));
600 markobj (IMAGE_INSTANCE_WIDGET_TYPE (i));
601 markobj (IMAGE_INSTANCE_WIDGET_PROPS (i));
602 markobj (IMAGE_INSTANCE_WIDGET_FACE (i));
603 mark_gui_item (&IMAGE_INSTANCE_WIDGET_ITEM (i), markobj);
604 case IMAGE_SUBWINDOW:
605 markobj (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
612 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i, markobj));
618 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
622 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
625 error ("printing unreadable object #<image-instance 0x%x>",
627 write_c_string ("#<image-instance (", printcharfun);
628 print_internal (Fimage_instance_type (obj), printcharfun, 0);
629 write_c_string (") ", printcharfun);
630 if (!NILP (ii->name))
632 print_internal (ii->name, printcharfun, 1);
633 write_c_string (" ", printcharfun);
635 write_c_string ("on ", printcharfun);
636 print_internal (ii->device, printcharfun, 0);
637 write_c_string (" ", printcharfun);
638 switch (IMAGE_INSTANCE_TYPE (ii))
644 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
647 case IMAGE_MONO_PIXMAP:
648 case IMAGE_COLOR_PIXMAP:
650 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
653 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
654 s = strrchr ((char *) XSTRING_DATA (filename), '/');
656 print_internal (build_string (s + 1), printcharfun, 1);
658 print_internal (filename, printcharfun, 1);
660 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
661 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
662 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
663 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
665 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
666 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
667 write_c_string (buf, printcharfun);
668 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
669 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
671 write_c_string (" @", printcharfun);
672 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
674 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
675 write_c_string (buf, printcharfun);
678 write_c_string ("??", printcharfun);
679 write_c_string (",", printcharfun);
680 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
682 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
683 write_c_string (buf, printcharfun);
686 write_c_string ("??", printcharfun);
688 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
689 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
691 write_c_string (" (", printcharfun);
692 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
696 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
698 write_c_string ("/", printcharfun);
699 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
703 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
705 write_c_string (")", printcharfun);
710 if (!NILP (IMAGE_INSTANCE_WIDGET_CALLBACK (ii)))
712 print_internal (IMAGE_INSTANCE_WIDGET_CALLBACK (ii), printcharfun, 0);
713 write_c_string (", ", printcharfun);
715 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
717 write_c_string (" (", printcharfun);
719 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
720 write_c_string (")", printcharfun);
723 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
724 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0);
726 case IMAGE_SUBWINDOW:
727 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
728 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
729 write_c_string (buf, printcharfun);
731 /* This is stolen from frame.c. Subwindows are strange in that they
732 are specific to a particular frame so we want to print in their
733 description what that frame is. */
735 write_c_string (" on #<", printcharfun);
737 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
739 if (!FRAME_LIVE_P (f))
740 write_c_string ("dead", printcharfun);
742 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
745 write_c_string ("-frame ", printcharfun);
747 write_c_string (">", printcharfun);
748 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
749 write_c_string (buf, printcharfun);
757 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
758 (ii, printcharfun, escapeflag));
759 sprintf (buf, " 0x%x>", ii->header.uid);
760 write_c_string (buf, printcharfun);
764 finalize_image_instance (void *header, int for_disksave)
766 struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header;
768 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
769 /* objects like this exist at dump time, so don't bomb out. */
771 if (for_disksave) finalose (i);
773 /* do this so that the cachels get reset */
774 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
776 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
778 MARK_FRAME_GLYPHS_CHANGED
779 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
782 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
786 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
788 struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
789 struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
790 struct device *d1 = XDEVICE (i1->device);
791 struct device *d2 = XDEVICE (i2->device);
795 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2))
797 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
801 switch (IMAGE_INSTANCE_TYPE (i1))
807 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
808 IMAGE_INSTANCE_TEXT_STRING (i2),
813 case IMAGE_MONO_PIXMAP:
814 case IMAGE_COLOR_PIXMAP:
816 if (!(IMAGE_INSTANCE_PIXMAP_WIDTH (i1) ==
817 IMAGE_INSTANCE_PIXMAP_WIDTH (i2) &&
818 IMAGE_INSTANCE_PIXMAP_HEIGHT (i1) ==
819 IMAGE_INSTANCE_PIXMAP_HEIGHT (i2) &&
820 IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
821 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
822 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
823 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
824 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
825 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
826 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
827 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
829 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
830 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
836 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
837 IMAGE_INSTANCE_WIDGET_TYPE (i2)) &&
838 EQ (IMAGE_INSTANCE_WIDGET_CALLBACK (i1),
839 IMAGE_INSTANCE_WIDGET_CALLBACK (i2))
840 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
841 IMAGE_INSTANCE_WIDGET_PROPS (i2),
843 && internal_equal (IMAGE_INSTANCE_WIDGET_TEXT (i1),
844 IMAGE_INSTANCE_WIDGET_TEXT (i2),
847 case IMAGE_SUBWINDOW:
848 if (!(IMAGE_INSTANCE_SUBWINDOW_WIDTH (i1) ==
849 IMAGE_INSTANCE_SUBWINDOW_WIDTH (i2) &&
850 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i1) ==
851 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i2) &&
852 IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
853 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
861 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
865 image_instance_hash (Lisp_Object obj, int depth)
867 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
868 struct device *d = XDEVICE (i->device);
869 unsigned long hash = (unsigned long) d;
871 switch (IMAGE_INSTANCE_TYPE (i))
877 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
881 case IMAGE_MONO_PIXMAP:
882 case IMAGE_COLOR_PIXMAP:
884 hash = HASH5 (hash, IMAGE_INSTANCE_PIXMAP_WIDTH (i),
885 IMAGE_INSTANCE_PIXMAP_HEIGHT (i),
886 IMAGE_INSTANCE_PIXMAP_DEPTH (i),
887 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
893 internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1),
894 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
895 internal_hash (IMAGE_INSTANCE_WIDGET_CALLBACK (i), depth + 1));
896 case IMAGE_SUBWINDOW:
897 hash = HASH4 (hash, IMAGE_INSTANCE_SUBWINDOW_WIDTH (i),
898 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i),
899 (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
906 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
910 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
911 mark_image_instance, print_image_instance,
912 finalize_image_instance, image_instance_equal,
914 struct Lisp_Image_Instance);
917 allocate_image_instance (Lisp_Object device)
919 struct Lisp_Image_Instance *lp =
920 alloc_lcrecord_type (struct Lisp_Image_Instance, &lrecord_image_instance);
925 lp->type = IMAGE_NOTHING;
927 XSETIMAGE_INSTANCE (val, lp);
931 static enum image_instance_type
932 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
934 if (ERRB_EQ (errb, ERROR_ME))
937 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
938 if (EQ (type, Qtext)) return IMAGE_TEXT;
939 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
940 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
941 if (EQ (type, Qpointer)) return IMAGE_POINTER;
942 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
943 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
945 maybe_signal_simple_error ("Invalid image-instance type", type,
948 return IMAGE_UNKNOWN; /* not reached */
952 encode_image_instance_type (enum image_instance_type type)
956 case IMAGE_NOTHING: return Qnothing;
957 case IMAGE_TEXT: return Qtext;
958 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
959 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
960 case IMAGE_POINTER: return Qpointer;
961 case IMAGE_SUBWINDOW: return Qsubwindow;
962 case IMAGE_WIDGET: return Qwidget;
967 return Qnil; /* not reached */
971 image_instance_type_to_mask (enum image_instance_type type)
973 /* This depends on the fact that enums are assigned consecutive
974 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
975 first enum.) I'm fairly sure this behavior in ANSI-mandated,
976 so there should be no portability problems here. */
977 return (1 << ((int) (type) - 1));
981 decode_image_instance_type_list (Lisp_Object list)
991 enum image_instance_type type =
992 decode_image_instance_type (list, ERROR_ME);
993 return image_instance_type_to_mask (type);
996 EXTERNAL_LIST_LOOP (rest, list)
998 enum image_instance_type type =
999 decode_image_instance_type (XCAR (rest), ERROR_ME);
1000 mask |= image_instance_type_to_mask (type);
1007 encode_image_instance_type_list (int mask)
1010 Lisp_Object result = Qnil;
1016 result = Fcons (encode_image_instance_type
1017 ((enum image_instance_type) count), result);
1021 return Fnreverse (result);
1025 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1026 int desired_dest_mask)
1031 (emacs_doprnt_string_lisp_2
1033 "No compatible image-instance types given: wanted one of %s, got %s",
1035 encode_image_instance_type_list (desired_dest_mask),
1036 encode_image_instance_type_list (given_dest_mask)),
1041 valid_image_instance_type_p (Lisp_Object type)
1043 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1046 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1047 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1048 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1049 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1051 (image_instance_type))
1053 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1056 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1057 Return a list of valid image-instance types.
1061 return Fcopy_sequence (Vimage_instance_type_list);
1065 decode_error_behavior_flag (Lisp_Object no_error)
1067 if (NILP (no_error)) return ERROR_ME;
1068 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1069 else return ERROR_ME_WARN;
1073 encode_error_behavior_flag (Error_behavior errb)
1075 if (ERRB_EQ (errb, ERROR_ME))
1077 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1081 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1087 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1088 Lisp_Object dest_types)
1091 struct gcpro gcpro1;
1094 XSETDEVICE (device, decode_device (device));
1095 /* instantiate_image_instantiator() will abort if given an
1096 image instance ... */
1097 if (IMAGE_INSTANCEP (data))
1098 signal_simple_error ("Image instances not allowed here", data);
1099 image_validate (data);
1100 dest_mask = decode_image_instance_type_list (dest_types);
1101 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1102 make_int (dest_mask));
1104 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1105 signal_simple_error ("Inheritance not allowed here", data);
1106 ii = instantiate_image_instantiator (device, device, data,
1107 Qnil, Qnil, dest_mask);
1108 RETURN_UNGCPRO (ii);
1111 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1112 Return a new `image-instance' object.
1114 Image-instance objects encapsulate the way a particular image (pixmap,
1115 etc.) is displayed on a particular device. In most circumstances, you
1116 do not need to directly create image instances; use a glyph instead.
1117 However, it may occasionally be useful to explicitly create image
1118 instances, if you want more control over the instantiation process.
1120 DATA is an image instantiator, which describes the image; see
1121 `image-specifier-p' for a description of the allowed values.
1123 DEST-TYPES should be a list of allowed image instance types that can
1124 be generated. The recognized image instance types are
1127 Nothing is displayed.
1129 Displayed as text. The foreground and background colors and the
1130 font of the text are specified independent of the pixmap. Typically
1131 these attributes will come from the face of the surrounding text,
1132 unless a face is specified for the glyph in which the image appears.
1134 Displayed as a mono pixmap (a pixmap with only two colors where the
1135 foreground and background can be specified independent of the pixmap;
1136 typically the pixmap assumes the foreground and background colors of
1137 the text around it, unless a face is specified for the glyph in which
1140 Displayed as a color pixmap.
1142 Used as the mouse pointer for a window.
1144 A child window that is treated as an image. This allows (e.g.)
1145 another program to be responsible for drawing into the window.
1146 Not currently implemented.
1148 The DEST-TYPES list is unordered. If multiple destination types
1149 are possible for a given instantiator, the "most natural" type
1150 for the instantiator's format is chosen. (For XBM, the most natural
1151 types are `mono-pixmap', followed by `color-pixmap', followed by
1152 `pointer'. For the other normal image formats, the most natural
1153 types are `color-pixmap', followed by `mono-pixmap', followed by
1154 `pointer'. For the string and formatted-string formats, the most
1155 natural types are `text', followed by `mono-pixmap' (not currently
1156 implemented), followed by `color-pixmap' (not currently implemented).
1157 The other formats can only be instantiated as one type. (If you
1158 want to control more specifically the order of the types into which
1159 an image is instantiated, just call `make-image-instance' repeatedly
1160 until it succeeds, passing less and less preferred destination types
1163 If DEST-TYPES is omitted, all possible types are allowed.
1165 NO-ERROR controls what happens when the image cannot be generated.
1166 If nil, an error message is generated. If t, no messages are
1167 generated and this function returns nil. If anything else, a warning
1168 message is generated and this function returns nil.
1170 (data, device, dest_types, no_error))
1172 Error_behavior errb = decode_error_behavior_flag (no_error);
1174 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1176 3, data, device, dest_types);
1179 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1180 Return non-nil if OBJECT is an image instance.
1184 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1187 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1188 Return the type of the given image instance.
1189 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1190 'color-pixmap, 'pointer, or 'subwindow.
1194 CHECK_IMAGE_INSTANCE (image_instance);
1195 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1198 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1199 Return the name of the given image instance.
1203 CHECK_IMAGE_INSTANCE (image_instance);
1204 return XIMAGE_INSTANCE_NAME (image_instance);
1207 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1208 Return the string of the given image instance.
1209 This will only be non-nil for text image instances and widgets.
1213 CHECK_IMAGE_INSTANCE (image_instance);
1214 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1215 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1216 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1217 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1222 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1223 Return the given property of the given image instance.
1224 Returns nil if the property or the property method do not exist for
1225 the image instance in the domain.
1227 (image_instance, prop))
1229 struct Lisp_Image_Instance* ii;
1230 Lisp_Object type, ret;
1231 struct image_instantiator_methods* meths;
1233 CHECK_IMAGE_INSTANCE (image_instance);
1234 CHECK_SYMBOL (prop);
1235 ii = XIMAGE_INSTANCE (image_instance);
1237 /* ... then try device specific methods ... */
1238 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1239 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1240 type, ERROR_ME_NOT);
1241 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1243 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1247 /* ... then format specific methods ... */
1248 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1249 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1251 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1259 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1260 Set the given property of the given image instance.
1261 Does nothing if the property or the property method do not exist for
1262 the image instance in the domain.
1264 (image_instance, prop, val))
1266 struct Lisp_Image_Instance* ii;
1267 Lisp_Object type, ret;
1268 struct image_instantiator_methods* meths;
1270 CHECK_IMAGE_INSTANCE (image_instance);
1271 CHECK_SYMBOL (prop);
1272 ii = XIMAGE_INSTANCE (image_instance);
1273 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1274 /* try device specific methods first ... */
1275 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1276 type, ERROR_ME_NOT);
1277 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1280 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1284 /* ... then format specific methods ... */
1285 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1286 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1289 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1297 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1298 Return the file name from which IMAGE-INSTANCE was read, if known.
1302 CHECK_IMAGE_INSTANCE (image_instance);
1304 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1306 case IMAGE_MONO_PIXMAP:
1307 case IMAGE_COLOR_PIXMAP:
1309 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1316 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1317 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1321 CHECK_IMAGE_INSTANCE (image_instance);
1323 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1325 case IMAGE_MONO_PIXMAP:
1326 case IMAGE_COLOR_PIXMAP:
1328 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1335 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1336 Return the depth of the image instance.
1337 This is 0 for a bitmap, or a positive integer for a pixmap.
1341 CHECK_IMAGE_INSTANCE (image_instance);
1343 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1345 case IMAGE_MONO_PIXMAP:
1346 case IMAGE_COLOR_PIXMAP:
1348 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1355 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1356 Return the height of the image instance, in pixels.
1360 CHECK_IMAGE_INSTANCE (image_instance);
1362 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1364 case IMAGE_MONO_PIXMAP:
1365 case IMAGE_COLOR_PIXMAP:
1367 return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance));
1369 case IMAGE_SUBWINDOW:
1371 return make_int (XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (image_instance));
1378 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1379 Return the width 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_WIDTH (image_instance));
1392 case IMAGE_SUBWINDOW:
1394 return make_int (XIMAGE_INSTANCE_SUBWINDOW_WIDTH (image_instance));
1401 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1402 Return the X coordinate of the image instance's hotspot, if known.
1403 This is a point relative to the origin of the pixmap. When an image is
1404 used as a mouse pointer, the hotspot is the point on the image that sits
1405 over the location that the pointer points to. This is, for example, the
1406 tip of the arrow or the center of the crosshairs.
1407 This will always be nil for a non-pointer image instance.
1411 CHECK_IMAGE_INSTANCE (image_instance);
1413 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1415 case IMAGE_MONO_PIXMAP:
1416 case IMAGE_COLOR_PIXMAP:
1418 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1425 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1426 Return the Y coordinate of the image instance's hotspot, if known.
1427 This is a point relative to the origin of the pixmap. When an image is
1428 used as a mouse pointer, the hotspot is the point on the image that sits
1429 over the location that the pointer points to. This is, for example, the
1430 tip of the arrow or the center of the crosshairs.
1431 This will always be nil for a non-pointer image instance.
1435 CHECK_IMAGE_INSTANCE (image_instance);
1437 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1439 case IMAGE_MONO_PIXMAP:
1440 case IMAGE_COLOR_PIXMAP:
1442 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1449 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1450 Return the foreground color of IMAGE-INSTANCE, if applicable.
1451 This will be a color instance or nil. (It will only be non-nil for
1452 colorized mono pixmaps and for pointers.)
1456 CHECK_IMAGE_INSTANCE (image_instance);
1458 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1460 case IMAGE_MONO_PIXMAP:
1461 case IMAGE_COLOR_PIXMAP:
1463 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1466 return FACE_FOREGROUND (
1467 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1468 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1476 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1477 Return the background color of IMAGE-INSTANCE, if applicable.
1478 This will be a color instance or nil. (It will only be non-nil for
1479 colorized mono pixmaps and for pointers.)
1483 CHECK_IMAGE_INSTANCE (image_instance);
1485 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1487 case IMAGE_MONO_PIXMAP:
1488 case IMAGE_COLOR_PIXMAP:
1490 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1493 return FACE_BACKGROUND (
1494 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1495 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1504 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1505 Make the image instance be displayed in the given colors.
1506 This function returns a new image instance that is exactly like the
1507 specified one except that (if possible) the foreground and background
1508 colors and as specified. Currently, this only does anything if the image
1509 instance is a mono pixmap; otherwise, the same image instance is returned.
1511 (image_instance, foreground, background))
1516 CHECK_IMAGE_INSTANCE (image_instance);
1517 CHECK_COLOR_INSTANCE (foreground);
1518 CHECK_COLOR_INSTANCE (background);
1520 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1521 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1522 return image_instance;
1524 new = allocate_image_instance (device);
1525 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1526 /* note that if this method returns non-zero, this method MUST
1527 copy any window-system resources, so that when one image instance is
1528 freed, the other one is not hosed. */
1529 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1531 return image_instance;
1536 /************************************************************************/
1538 /************************************************************************/
1540 signal_image_error (CONST char *reason, Lisp_Object frob)
1542 signal_error (Qimage_conversion_error,
1543 list2 (build_translated_string (reason), frob));
1547 signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1)
1549 signal_error (Qimage_conversion_error,
1550 list3 (build_translated_string (reason), frob0, frob1));
1553 /****************************************************************************
1555 ****************************************************************************/
1558 nothing_possible_dest_types (void)
1560 return IMAGE_NOTHING_MASK;
1564 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1565 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1566 int dest_mask, Lisp_Object domain)
1568 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1570 if (dest_mask & IMAGE_NOTHING_MASK)
1571 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1573 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1577 /****************************************************************************
1579 ****************************************************************************/
1582 inherit_validate (Lisp_Object instantiator)
1584 face_must_be_present (instantiator);
1588 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1592 assert (XVECTOR_LENGTH (inst) == 3);
1593 face = XVECTOR_DATA (inst)[2];
1595 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1600 inherit_possible_dest_types (void)
1602 return IMAGE_MONO_PIXMAP_MASK;
1606 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1607 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1608 int dest_mask, Lisp_Object domain)
1610 /* handled specially in image_instantiate */
1615 /****************************************************************************
1617 ****************************************************************************/
1620 string_validate (Lisp_Object instantiator)
1622 data_must_be_present (instantiator);
1626 string_possible_dest_types (void)
1628 return IMAGE_TEXT_MASK;
1631 /* called from autodetect_instantiate() */
1633 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1634 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1635 int dest_mask, Lisp_Object domain)
1637 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1638 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1640 assert (!NILP (data));
1641 if (dest_mask & IMAGE_TEXT_MASK)
1643 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1644 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1647 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1651 /****************************************************************************
1652 * formatted-string *
1653 ****************************************************************************/
1656 formatted_string_validate (Lisp_Object instantiator)
1658 data_must_be_present (instantiator);
1662 formatted_string_possible_dest_types (void)
1664 return IMAGE_TEXT_MASK;
1668 formatted_string_instantiate (Lisp_Object image_instance,
1669 Lisp_Object instantiator,
1670 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1671 int dest_mask, Lisp_Object domain)
1673 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1674 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1676 assert (!NILP (data));
1677 /* #### implement this */
1678 warn_when_safe (Qunimplemented, Qnotice,
1679 "`formatted-string' not yet implemented; assuming `string'");
1680 if (dest_mask & IMAGE_TEXT_MASK)
1682 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1683 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1686 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1690 /************************************************************************/
1691 /* pixmap file functions */
1692 /************************************************************************/
1694 /* If INSTANTIATOR refers to inline data, return Qnil.
1695 If INSTANTIATOR refers to data in a file, return the full filename
1696 if it exists; otherwise, return a cons of (filename).
1698 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
1699 keywords used to look up the file and inline data,
1700 respectively, in the instantiator. Normally these would
1701 be Q_file and Q_data, but might be different for mask data. */
1704 potential_pixmap_file_instantiator (Lisp_Object instantiator,
1705 Lisp_Object file_keyword,
1706 Lisp_Object data_keyword,
1707 Lisp_Object console_type)
1712 assert (VECTORP (instantiator));
1714 data = find_keyword_in_vector (instantiator, data_keyword);
1715 file = find_keyword_in_vector (instantiator, file_keyword);
1717 if (!NILP (file) && NILP (data))
1719 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
1720 (decode_console_type(console_type, ERROR_ME),
1721 locate_pixmap_file, (file));
1726 return Fcons (file, Qnil); /* should have been file */
1733 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
1734 Lisp_Object image_type_tag)
1736 /* This function can call lisp */
1737 Lisp_Object file = Qnil;
1738 struct gcpro gcpro1, gcpro2;
1739 Lisp_Object alist = Qnil;
1741 GCPRO2 (file, alist);
1743 /* Now, convert any file data into inline data. At the end of this,
1744 `data' will contain the inline data (if any) or Qnil, and `file'
1745 will contain the name this data was derived from (if known) or
1748 Note that if we cannot generate any regular inline data, we
1751 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1754 if (CONSP (file)) /* failure locating filename */
1755 signal_double_file_error ("Opening pixmap file",
1756 "no such file or directory",
1759 if (NILP (file)) /* no conversion necessary */
1760 RETURN_UNGCPRO (inst);
1762 alist = tagged_vector_to_alist (inst);
1765 Lisp_Object data = make_string_from_file (file);
1766 alist = remassq_no_quit (Q_file, alist);
1767 /* there can't be a :data at this point. */
1768 alist = Fcons (Fcons (Q_file, file),
1769 Fcons (Fcons (Q_data, data), alist));
1773 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
1775 RETURN_UNGCPRO (result);
1780 #ifdef HAVE_WINDOW_SYSTEM
1781 /**********************************************************************
1783 **********************************************************************/
1785 /* Check if DATA represents a valid inline XBM spec (i.e. a list
1786 of (width height bits), with checking done on the dimensions).
1787 If not, signal an error. */
1790 check_valid_xbm_inline (Lisp_Object data)
1792 Lisp_Object width, height, bits;
1794 if (!CONSP (data) ||
1795 !CONSP (XCDR (data)) ||
1796 !CONSP (XCDR (XCDR (data))) ||
1797 !NILP (XCDR (XCDR (XCDR (data)))))
1798 signal_simple_error ("Must be list of 3 elements", data);
1800 width = XCAR (data);
1801 height = XCAR (XCDR (data));
1802 bits = XCAR (XCDR (XCDR (data)));
1804 CHECK_STRING (bits);
1806 if (!NATNUMP (width))
1807 signal_simple_error ("Width must be a natural number", width);
1809 if (!NATNUMP (height))
1810 signal_simple_error ("Height must be a natural number", height);
1812 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
1813 signal_simple_error ("data is too short for width and height",
1814 vector3 (width, height, bits));
1817 /* Validate method for XBM's. */
1820 xbm_validate (Lisp_Object instantiator)
1822 file_or_data_must_be_present (instantiator);
1825 /* Given a filename that is supposed to contain XBM data, return
1826 the inline representation of it as (width height bits). Return
1827 the hotspot through XHOT and YHOT, if those pointers are not 0.
1828 If there is no hotspot, XHOT and YHOT will contain -1.
1830 If the function fails:
1832 -- if OK_IF_DATA_INVALID is set and the data was invalid,
1834 -- maybe return an error, or return Qnil.
1837 #ifdef HAVE_X_WINDOWS
1838 #include <X11/Xlib.h>
1840 #define XFree(data) free(data)
1844 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
1845 int ok_if_data_invalid)
1850 CONST char *filename_ext;
1852 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
1853 result = read_bitmap_data_from_file (filename_ext, &w, &h,
1856 if (result == BitmapSuccess)
1859 int len = (w + 7) / 8 * h;
1861 retval = list3 (make_int (w), make_int (h),
1862 make_ext_string (data, len, FORMAT_BINARY));
1863 XFree ((char *) data);
1869 case BitmapOpenFailed:
1871 /* should never happen */
1872 signal_double_file_error ("Opening bitmap file",
1873 "no such file or directory",
1876 case BitmapFileInvalid:
1878 if (ok_if_data_invalid)
1880 signal_double_file_error ("Reading bitmap file",
1881 "invalid data in file",
1884 case BitmapNoMemory:
1886 signal_double_file_error ("Reading bitmap file",
1892 signal_double_file_error_2 ("Reading bitmap file",
1893 "unknown error code",
1894 make_int (result), name);
1898 return Qnil; /* not reached */
1902 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
1903 Lisp_Object mask_file, Lisp_Object console_type)
1905 /* This is unclean but it's fairly standard -- a number of the
1906 bitmaps in /usr/include/X11/bitmaps use it -- so we support
1908 if (NILP (mask_file)
1909 /* don't override explicitly specified mask data. */
1910 && NILP (assq_no_quit (Q_mask_data, alist))
1913 mask_file = MAYBE_LISP_CONTYPE_METH
1914 (decode_console_type(console_type, ERROR_ME),
1915 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
1916 if (NILP (mask_file))
1917 mask_file = MAYBE_LISP_CONTYPE_METH
1918 (decode_console_type(console_type, ERROR_ME),
1919 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
1922 if (!NILP (mask_file))
1924 Lisp_Object mask_data =
1925 bitmap_to_lisp_data (mask_file, 0, 0, 0);
1926 alist = remassq_no_quit (Q_mask_file, alist);
1927 /* there can't be a :mask-data at this point. */
1928 alist = Fcons (Fcons (Q_mask_file, mask_file),
1929 Fcons (Fcons (Q_mask_data, mask_data), alist));
1935 /* Normalize method for XBM's. */
1938 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
1940 Lisp_Object file = Qnil, mask_file = Qnil;
1941 struct gcpro gcpro1, gcpro2, gcpro3;
1942 Lisp_Object alist = Qnil;
1944 GCPRO3 (file, mask_file, alist);
1946 /* Now, convert any file data into inline data for both the regular
1947 data and the mask data. At the end of this, `data' will contain
1948 the inline data (if any) or Qnil, and `file' will contain
1949 the name this data was derived from (if known) or Qnil.
1950 Likewise for `mask_file' and `mask_data'.
1952 Note that if we cannot generate any regular inline data, we
1955 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1957 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
1958 Q_mask_data, console_type);
1960 if (CONSP (file)) /* failure locating filename */
1961 signal_double_file_error ("Opening bitmap file",
1962 "no such file or directory",
1965 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
1966 RETURN_UNGCPRO (inst);
1968 alist = tagged_vector_to_alist (inst);
1973 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
1974 alist = remassq_no_quit (Q_file, alist);
1975 /* there can't be a :data at this point. */
1976 alist = Fcons (Fcons (Q_file, file),
1977 Fcons (Fcons (Q_data, data), alist));
1979 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
1980 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1982 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
1983 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1987 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
1990 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1992 RETURN_UNGCPRO (result);
1998 xbm_possible_dest_types (void)
2001 IMAGE_MONO_PIXMAP_MASK |
2002 IMAGE_COLOR_PIXMAP_MASK |
2010 /**********************************************************************
2012 **********************************************************************/
2015 xface_validate (Lisp_Object instantiator)
2017 file_or_data_must_be_present (instantiator);
2021 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2023 /* This function can call lisp */
2024 Lisp_Object file = Qnil, mask_file = Qnil;
2025 struct gcpro gcpro1, gcpro2, gcpro3;
2026 Lisp_Object alist = Qnil;
2028 GCPRO3 (file, mask_file, alist);
2030 /* Now, convert any file data into inline data for both the regular
2031 data and the mask data. At the end of this, `data' will contain
2032 the inline data (if any) or Qnil, and `file' will contain
2033 the name this data was derived from (if known) or Qnil.
2034 Likewise for `mask_file' and `mask_data'.
2036 Note that if we cannot generate any regular inline data, we
2039 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2041 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2042 Q_mask_data, console_type);
2044 if (CONSP (file)) /* failure locating filename */
2045 signal_double_file_error ("Opening bitmap file",
2046 "no such file or directory",
2049 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2050 RETURN_UNGCPRO (inst);
2052 alist = tagged_vector_to_alist (inst);
2055 Lisp_Object data = make_string_from_file (file);
2056 alist = remassq_no_quit (Q_file, alist);
2057 /* there can't be a :data at this point. */
2058 alist = Fcons (Fcons (Q_file, file),
2059 Fcons (Fcons (Q_data, data), alist));
2062 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2065 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2067 RETURN_UNGCPRO (result);
2072 xface_possible_dest_types (void)
2075 IMAGE_MONO_PIXMAP_MASK |
2076 IMAGE_COLOR_PIXMAP_MASK |
2080 #endif /* HAVE_XFACE */
2085 /**********************************************************************
2087 **********************************************************************/
2090 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2096 GET_C_STRING_FILENAME_DATA_ALLOCA (name, fname);
2097 result = XpmReadFileToData (fname, &data);
2099 if (result == XpmSuccess)
2101 Lisp_Object retval = Qnil;
2102 struct buffer *old_buffer = current_buffer;
2103 Lisp_Object temp_buffer =
2104 Fget_buffer_create (build_string (" *pixmap conversion*"));
2106 int height, width, ncolors;
2107 struct gcpro gcpro1, gcpro2, gcpro3;
2108 int speccount = specpdl_depth ();
2110 GCPRO3 (name, retval, temp_buffer);
2112 specbind (Qinhibit_quit, Qt);
2113 set_buffer_internal (XBUFFER (temp_buffer));
2114 Ferase_buffer (Qnil);
2116 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2117 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2119 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2120 for (elt = 0; elt <= width + ncolors; elt++)
2122 buffer_insert_c_string (current_buffer, "\"");
2123 buffer_insert_c_string (current_buffer, data[elt]);
2125 if (elt < width + ncolors)
2126 buffer_insert_c_string (current_buffer, "\",\r");
2128 buffer_insert_c_string (current_buffer, "\"};\r");
2131 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2134 set_buffer_internal (old_buffer);
2135 unbind_to (speccount, Qnil);
2137 RETURN_UNGCPRO (retval);
2142 case XpmFileInvalid:
2144 if (ok_if_data_invalid)
2146 signal_image_error ("invalid XPM data in file", name);
2150 signal_double_file_error ("Reading pixmap file",
2151 "out of memory", name);
2155 /* should never happen? */
2156 signal_double_file_error ("Opening pixmap file",
2157 "no such file or directory", name);
2161 signal_double_file_error_2 ("Parsing pixmap file",
2162 "unknown error code",
2163 make_int (result), name);
2168 return Qnil; /* not reached */
2172 check_valid_xpm_color_symbols (Lisp_Object data)
2176 for (rest = data; !NILP (rest); rest = XCDR (rest))
2178 if (!CONSP (rest) ||
2179 !CONSP (XCAR (rest)) ||
2180 !STRINGP (XCAR (XCAR (rest))) ||
2181 (!STRINGP (XCDR (XCAR (rest))) &&
2182 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2183 signal_simple_error ("Invalid color symbol alist", data);
2188 xpm_validate (Lisp_Object instantiator)
2190 file_or_data_must_be_present (instantiator);
2193 Lisp_Object Vxpm_color_symbols;
2196 evaluate_xpm_color_symbols (void)
2198 Lisp_Object rest, results = Qnil;
2199 struct gcpro gcpro1, gcpro2;
2201 GCPRO2 (rest, results);
2202 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2204 Lisp_Object name, value, cons;
2210 CHECK_STRING (name);
2211 value = XCDR (cons);
2213 value = XCAR (value);
2214 value = Feval (value);
2217 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2219 ("Result from xpm-color-symbols eval must be nil, string, or color",
2221 results = Fcons (Fcons (name, value), results);
2223 UNGCPRO; /* no more evaluation */
2228 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2230 Lisp_Object file = Qnil;
2231 Lisp_Object color_symbols;
2232 struct gcpro gcpro1, gcpro2;
2233 Lisp_Object alist = Qnil;
2235 GCPRO2 (file, alist);
2237 /* Now, convert any file data into inline data. At the end of this,
2238 `data' will contain the inline data (if any) or Qnil, and
2239 `file' will contain the name this data was derived from (if
2242 Note that if we cannot generate any regular inline data, we
2245 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2248 if (CONSP (file)) /* failure locating filename */
2249 signal_double_file_error ("Opening pixmap file",
2250 "no such file or directory",
2253 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2256 if (NILP (file) && !UNBOUNDP (color_symbols))
2257 /* no conversion necessary */
2258 RETURN_UNGCPRO (inst);
2260 alist = tagged_vector_to_alist (inst);
2264 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2265 alist = remassq_no_quit (Q_file, alist);
2266 /* there can't be a :data at this point. */
2267 alist = Fcons (Fcons (Q_file, file),
2268 Fcons (Fcons (Q_data, data), alist));
2271 if (UNBOUNDP (color_symbols))
2273 color_symbols = evaluate_xpm_color_symbols ();
2274 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2279 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2281 RETURN_UNGCPRO (result);
2286 xpm_possible_dest_types (void)
2289 IMAGE_MONO_PIXMAP_MASK |
2290 IMAGE_COLOR_PIXMAP_MASK |
2294 #endif /* HAVE_XPM */
2297 /****************************************************************************
2298 * Image Specifier Object *
2299 ****************************************************************************/
2301 DEFINE_SPECIFIER_TYPE (image);
2304 image_create (Lisp_Object obj)
2306 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2308 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2309 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2310 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2314 image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
2316 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2318 markobj (IMAGE_SPECIFIER_ATTACHEE (image));
2319 markobj (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2323 image_instantiate_cache_result (Lisp_Object locative)
2325 /* locative = (instance instantiator . subtable) */
2326 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2327 free_cons (XCONS (XCDR (locative)));
2328 free_cons (XCONS (locative));
2332 /* Given a specification for an image, return an instance of
2333 the image which matches the given instantiator and which can be
2334 displayed in the given domain. */
2337 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2338 Lisp_Object domain, Lisp_Object instantiator,
2341 Lisp_Object device = DFW_DEVICE (domain);
2342 struct device *d = XDEVICE (device);
2343 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2344 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2346 if (IMAGE_INSTANCEP (instantiator))
2348 /* make sure that the image instance's device and type are
2351 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2354 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2355 if (mask & dest_mask)
2356 return instantiator;
2358 signal_simple_error ("Type of image instance not allowed here",
2362 signal_simple_error_2 ("Wrong device for image instance",
2363 instantiator, device);
2365 else if (VECTORP (instantiator)
2366 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2368 assert (XVECTOR_LENGTH (instantiator) == 3);
2369 return (FACE_PROPERTY_INSTANCE
2370 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2371 Qbackground_pixmap, domain, 0, depth));
2375 Lisp_Object instance;
2376 Lisp_Object subtable;
2377 Lisp_Object ls3 = Qnil;
2378 Lisp_Object pointer_fg = Qnil;
2379 Lisp_Object pointer_bg = Qnil;
2383 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2384 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2385 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2388 /* First look in the hash table. */
2389 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2391 if (UNBOUNDP (subtable))
2393 /* For the image instance cache, we do comparisons with EQ rather
2394 than with EQUAL, as we do for color and font names.
2397 1) pixmap data can be very long, and thus the hashing and
2398 comparing will take awhile.
2399 2) It's not so likely that we'll run into things that are EQUAL
2400 but not EQ (that can happen a lot with faces, because their
2401 specifiers are copied around); but pixmaps tend not to be
2404 However, if the image-instance could be a pointer, we have to
2405 use EQUAL because we massaged the instantiator into a cons3
2406 also containing the foreground and background of the
2410 subtable = make_lisp_hash_table (20,
2411 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2412 : HASH_TABLE_KEY_WEAK,
2413 pointerp ? HASH_TABLE_EQUAL
2415 Fputhash (make_int (dest_mask), subtable,
2416 d->image_instance_cache);
2417 instance = Qunbound;
2421 instance = Fgethash (pointerp ? ls3 : instantiator,
2422 subtable, Qunbound);
2423 /* subwindows have a per-window cache and have to be treated
2424 differently. dest_mask can be a bitwise OR of all image
2425 types so we will only catch someone possibly trying to
2426 instantiate a subwindow type thing. Unfortunately, this
2427 will occur most of the time so this probably slows things
2428 down. But with the current design I don't see anyway
2430 if (UNBOUNDP (instance)
2432 dest_mask & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2434 if (!WINDOWP (domain))
2435 signal_simple_error ("Can't instantiate subwindow outside a window",
2437 instance = Fgethash (instantiator,
2438 XWINDOW (domain)->subwindow_instance_cache,
2443 if (UNBOUNDP (instance))
2445 Lisp_Object locative =
2447 noseeum_cons (pointerp ? ls3 : instantiator,
2449 int speccount = specpdl_depth ();
2451 /* make sure we cache the failures, too.
2452 Use an unwind-protect to catch such errors.
2453 If we fail, the unwind-protect records nil in
2454 the hash table. If we succeed, we change the
2455 car of the locative to the resulting instance,
2456 which gets recorded instead. */
2457 record_unwind_protect (image_instantiate_cache_result,
2459 instance = instantiate_image_instantiator (device,
2462 pointer_fg, pointer_bg,
2465 Fsetcar (locative, instance);
2466 /* only after the image has been instantiated do we know
2467 whether we need to put it in the per-window image instance
2469 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2471 (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2473 if (!WINDOWP (domain))
2474 signal_simple_error ("Can't instantiate subwindow outside a window",
2477 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache );
2479 unbind_to (speccount, Qnil);
2484 if (NILP (instance))
2485 signal_simple_error ("Can't instantiate image (probably cached)",
2491 return Qnil; /* not reached */
2494 /* Validate an image instantiator. */
2497 image_validate (Lisp_Object instantiator)
2499 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2501 else if (VECTORP (instantiator))
2503 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2504 int instantiator_len = XVECTOR_LENGTH (instantiator);
2505 struct image_instantiator_methods *meths;
2506 Lisp_Object already_seen = Qnil;
2507 struct gcpro gcpro1;
2510 if (instantiator_len < 1)
2511 signal_simple_error ("Vector length must be at least 1",
2514 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2515 if (!(instantiator_len & 1))
2517 ("Must have alternating keyword/value pairs", instantiator);
2519 GCPRO1 (already_seen);
2521 for (i = 1; i < instantiator_len; i += 2)
2523 Lisp_Object keyword = elt[i];
2524 Lisp_Object value = elt[i+1];
2527 CHECK_SYMBOL (keyword);
2528 if (!SYMBOL_IS_KEYWORD (keyword))
2529 signal_simple_error ("Symbol must begin with a colon", keyword);
2531 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2532 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2535 if (j == Dynarr_length (meths->keywords))
2536 signal_simple_error ("Unrecognized keyword", keyword);
2538 if (!Dynarr_at (meths->keywords, j).multiple_p)
2540 if (!NILP (memq_no_quit (keyword, already_seen)))
2542 ("Keyword may not appear more than once", keyword);
2543 already_seen = Fcons (keyword, already_seen);
2546 (Dynarr_at (meths->keywords, j).validate) (value);
2551 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2554 signal_simple_error ("Must be string or vector", instantiator);
2558 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2560 Lisp_Object attachee =
2561 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2562 Lisp_Object property =
2563 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2564 if (FACEP (attachee))
2565 face_property_was_changed (attachee, property, locale);
2566 else if (GLYPHP (attachee))
2567 glyph_property_was_changed (attachee, property, locale);
2571 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2572 Lisp_Object property)
2574 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2576 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2577 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2581 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2582 Lisp_Object tag_set, Lisp_Object instantiator)
2584 Lisp_Object possible_console_types = Qnil;
2586 Lisp_Object retlist = Qnil;
2587 struct gcpro gcpro1, gcpro2;
2589 LIST_LOOP (rest, Vconsole_type_list)
2591 Lisp_Object contype = XCAR (rest);
2592 if (!NILP (memq_no_quit (contype, tag_set)))
2593 possible_console_types = Fcons (contype, possible_console_types);
2596 if (XINT (Flength (possible_console_types)) > 1)
2597 /* two conflicting console types specified */
2600 if (NILP (possible_console_types))
2601 possible_console_types = Vconsole_type_list;
2603 GCPRO2 (retlist, possible_console_types);
2605 LIST_LOOP (rest, possible_console_types)
2607 Lisp_Object contype = XCAR (rest);
2608 Lisp_Object newinst = call_with_suspended_errors
2609 ((lisp_fn_t) normalize_image_instantiator,
2610 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2611 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2613 if (!NILP (newinst))
2616 if (NILP (memq_no_quit (contype, tag_set)))
2617 newtag = Fcons (contype, tag_set);
2620 retlist = Fcons (Fcons (newtag, newinst), retlist);
2629 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
2630 Return non-nil if OBJECT is an image specifier.
2632 An image specifier is used for images (pixmaps and the like). It is used
2633 to describe the actual image in a glyph. It is instanced as an image-
2636 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
2637 etc. This describes the format of the data describing the image. The
2638 resulting image instances also come in many types -- `mono-pixmap',
2639 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
2640 the image and the sorts of places it can appear. (For example, a
2641 color-pixmap image has fixed colors specified for it, while a
2642 mono-pixmap image comes in two unspecified shades "foreground" and
2643 "background" that are determined from the face of the glyph or
2644 surrounding text; a text image appears as a string of text and has an
2645 unspecified foreground, background, and font; a pointer image behaves
2646 like a mono-pixmap image but can only be used as a mouse pointer
2647 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
2648 important to keep the distinction between image instantiator format and
2649 image instance type in mind. Typically, a given image instantiator
2650 format can result in many different image instance types (for example,
2651 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
2652 whereas `cursor-font' can be instanced only as `pointer'), and a
2653 particular image instance type can be generated by many different
2654 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
2655 `gif', `jpeg', etc.).
2657 See `make-image-instance' for a more detailed discussion of image
2660 An image instantiator should be a string or a vector of the form
2662 [FORMAT :KEYWORD VALUE ...]
2664 i.e. a format symbol followed by zero or more alternating keyword-value
2665 pairs. FORMAT should be one of
2668 (Don't display anything; no keywords are valid for this.
2669 Can only be instanced as `nothing'.)
2671 (Display this image as a text string. Can only be instanced
2672 as `text', although support for instancing as `mono-pixmap'
2675 (Display this image as a text string, with replaceable fields;
2676 not currently implemented.)
2678 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
2679 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2681 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
2682 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
2684 (An X-Face bitmap, used to encode people's faces in e-mail messages;
2685 only if X-Face support was compiled into this XEmacs. Can be
2686 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2688 (A GIF87 or GIF89 image; only if GIF support was compiled into this
2689 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
2690 Can be instanced as `color-pixmap'.)
2692 (A JPEG image; only if JPEG support was compiled into this XEmacs.
2693 Can be instanced as `color-pixmap'.)
2695 (A PNG image; only if PNG support was compiled into this XEmacs.
2696 Can be instanced as `color-pixmap'.)
2698 (A TIFF image; only if TIFF support was compiled into this XEmacs.
2699 Can be instanced as `color-pixmap'.)
2701 (One of the standard cursor-font names, such as "watch" or
2702 "right_ptr" under X. Under X, this is, more specifically, any
2703 of the standard cursor names from appendix B of the Xlib manual
2704 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
2705 On other window systems, the valid names will be specific to the
2706 type of window system. Can only be instanced as `pointer'.)
2708 (A glyph from a font; i.e. the name of a font, and glyph index into it
2709 of the form "FONT fontname index [[mask-font] mask-index]".
2710 Currently can only be instanced as `pointer', although this should
2713 (An embedded X window; not currently implemented.)
2715 (A widget control, for instance text field or radio button.)
2717 (XEmacs tries to guess what format the data is in. If X support
2718 exists, the data string will be checked to see if it names a filename.
2719 If so, and this filename contains XBM or XPM data, the appropriate
2720 sort of pixmap or pointer will be created. [This includes picking up
2721 any specified hotspot or associated mask file.] Otherwise, if `pointer'
2722 is one of the allowable image-instance types and the string names a
2723 valid cursor-font name, the image will be created as a pointer.
2724 Otherwise, the image will be displayed as text. If no X support
2725 exists, the image will always be displayed as text.)
2727 Inherit from the background-pixmap property of a face.
2729 The valid keywords are:
2732 (Inline data. For most formats above, this should be a string. For
2733 XBM images, this should be a list of three elements: width, height, and
2734 a string of bit data. This keyword is not valid for instantiator
2735 formats `nothing' and `inherit'.)
2737 (Data is contained in a file. The value is the name of this file.
2738 If both :data and :file are specified, the image is created from
2739 what is specified in :data and the string in :file becomes the
2740 value of the `image-instance-file-name' function when applied to
2741 the resulting image-instance. This keyword is not valid for
2742 instantiator formats `nothing', `string', `formatted-string',
2743 `cursor-font', `font', `autodetect', and `inherit'.)
2746 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
2747 allow you to explicitly specify foreground and background colors.
2748 The argument should be anything acceptable to `make-color-instance'.
2749 This will cause what would be a `mono-pixmap' to instead be colorized
2750 as a two-color color-pixmap, and specifies the foreground and/or
2751 background colors for a pointer instead of black and white.)
2753 (For `xbm' and `xface'. This specifies a mask to be used with the
2754 bitmap. The format is a list of width, height, and bits, like for
2757 (For `xbm' and `xface'. This specifies a file containing the mask data.
2758 If neither a mask file nor inline mask data is given for an XBM image,
2759 and the XBM image comes from a file, XEmacs will look for a mask file
2760 with the same name as the image file but with "Mask" or "msk"
2761 appended. For example, if you specify the XBM file "left_ptr"
2762 [usually located in "/usr/include/X11/bitmaps"], the associated
2763 mask file "left_ptrmsk" will automatically be picked up.)
2766 (For `xbm' and `xface'. These keywords specify a hotspot if the image
2767 is instantiated as a `pointer'. Note that if the XBM image file
2768 specifies a hotspot, it will automatically be picked up if no
2769 explicit hotspot is given.)
2771 (Only for `xpm'. This specifies an alist that maps strings
2772 that specify symbolic color names to the actual color to be used
2773 for that symbolic color (in the form of a string or a color-specifier
2774 object). If this is not specified, the contents of `xpm-color-symbols'
2775 are used to generate the alist.)
2777 (Only for `inherit'. This specifies the face to inherit from.)
2779 If instead of a vector, the instantiator is a string, it will be
2780 converted into a vector by looking it up according to the specs in the
2781 `console-type-image-conversion-list' (q.v.) for the console type of
2782 the domain (usually a window; sometimes a frame or device) over which
2783 the image is being instantiated.
2785 If the instantiator specifies data from a file, the data will be read
2786 in at the time that the instantiator is added to the image (which may
2787 be well before when the image is actually displayed), and the
2788 instantiator will be converted into one of the inline-data forms, with
2789 the filename retained using a :file keyword. This implies that the
2790 file must exist when the instantiator is added to the image, but does
2791 not need to exist at any other time (e.g. it may safely be a temporary
2796 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
2800 /****************************************************************************
2802 ****************************************************************************/
2805 mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object))
2807 struct Lisp_Glyph *glyph = XGLYPH (obj);
2809 markobj (glyph->image);
2810 markobj (glyph->contrib_p);
2811 markobj (glyph->baseline);
2812 markobj (glyph->face);
2814 return glyph->plist;
2818 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2820 struct Lisp_Glyph *glyph = XGLYPH (obj);
2824 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
2826 write_c_string ("#<glyph (", printcharfun);
2827 print_internal (Fglyph_type (obj), printcharfun, 0);
2828 write_c_string (") ", printcharfun);
2829 print_internal (glyph->image, printcharfun, 1);
2830 sprintf (buf, "0x%x>", glyph->header.uid);
2831 write_c_string (buf, printcharfun);
2834 /* Glyphs are equal if all of their display attributes are equal. We
2835 don't compare names or doc-strings, because that would make equal
2838 This isn't concerned with "unspecified" attributes, that's what
2839 #'glyph-differs-from-default-p is for. */
2841 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
2843 struct Lisp_Glyph *g1 = XGLYPH (obj1);
2844 struct Lisp_Glyph *g2 = XGLYPH (obj2);
2848 return (internal_equal (g1->image, g2->image, depth) &&
2849 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
2850 internal_equal (g1->baseline, g2->baseline, depth) &&
2851 internal_equal (g1->face, g2->face, depth) &&
2852 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
2855 static unsigned long
2856 glyph_hash (Lisp_Object obj, int depth)
2860 /* No need to hash all of the elements; that would take too long.
2861 Just hash the most common ones. */
2862 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
2863 internal_hash (XGLYPH (obj)->face, depth));
2867 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
2869 struct Lisp_Glyph *g = XGLYPH (obj);
2871 if (EQ (prop, Qimage)) return g->image;
2872 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
2873 if (EQ (prop, Qbaseline)) return g->baseline;
2874 if (EQ (prop, Qface)) return g->face;
2876 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
2880 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
2882 if ((EQ (prop, Qimage)) ||
2883 (EQ (prop, Qcontrib_p)) ||
2884 (EQ (prop, Qbaseline)))
2887 if (EQ (prop, Qface))
2889 XGLYPH (obj)->face = Fget_face (value);
2893 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
2898 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
2900 if ((EQ (prop, Qimage)) ||
2901 (EQ (prop, Qcontrib_p)) ||
2902 (EQ (prop, Qbaseline)))
2905 if (EQ (prop, Qface))
2907 XGLYPH (obj)->face = Qnil;
2911 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
2915 glyph_plist (Lisp_Object obj)
2917 struct Lisp_Glyph *glyph = XGLYPH (obj);
2918 Lisp_Object result = glyph->plist;
2920 result = cons3 (Qface, glyph->face, result);
2921 result = cons3 (Qbaseline, glyph->baseline, result);
2922 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
2923 result = cons3 (Qimage, glyph->image, result);
2928 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
2929 mark_glyph, print_glyph, 0,
2930 glyph_equal, glyph_hash,
2931 glyph_getprop, glyph_putprop,
2932 glyph_remprop, glyph_plist,
2936 allocate_glyph (enum glyph_type type,
2937 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
2938 Lisp_Object locale))
2940 /* This function can GC */
2941 Lisp_Object obj = Qnil;
2942 struct Lisp_Glyph *g =
2943 alloc_lcrecord_type (struct Lisp_Glyph, &lrecord_glyph);
2946 g->image = Fmake_specifier (Qimage); /* This function can GC */
2950 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2951 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
2952 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
2953 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK;
2956 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2957 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
2960 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2961 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK;
2967 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
2968 /* We're getting enough reports of odd behavior in this area it seems */
2969 /* best to GCPRO everything. */
2971 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
2972 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
2973 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
2974 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2976 GCPRO4 (obj, tem1, tem2, tem3);
2978 set_specifier_fallback (g->image, tem1);
2979 g->contrib_p = Fmake_specifier (Qboolean);
2980 set_specifier_fallback (g->contrib_p, tem2);
2981 /* #### should have a specifier for the following */
2982 g->baseline = Fmake_specifier (Qgeneric);
2983 set_specifier_fallback (g->baseline, tem3);
2986 g->after_change = after_change;
2989 set_image_attached_to (g->image, obj, Qimage);
2996 static enum glyph_type
2997 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3000 return GLYPH_BUFFER;
3002 if (ERRB_EQ (errb, ERROR_ME))
3003 CHECK_SYMBOL (type);
3005 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3006 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3007 if (EQ (type, Qicon)) return GLYPH_ICON;
3009 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3011 return GLYPH_UNKNOWN;
3015 valid_glyph_type_p (Lisp_Object type)
3017 return !NILP (memq_no_quit (type, Vglyph_type_list));
3020 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3021 Given a GLYPH-TYPE, return non-nil if it is valid.
3022 Valid types are `buffer', `pointer', and `icon'.
3026 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3029 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3030 Return a list of valid glyph types.
3034 return Fcopy_sequence (Vglyph_type_list);
3037 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3038 Create and return a new uninitialized glyph or type TYPE.
3040 TYPE specifies the type of the glyph; this should be one of `buffer',
3041 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3042 specifies in which contexts the glyph can be used, and controls the
3043 allowable image types into which the glyph's image can be
3046 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3047 extent, in the modeline, and in the toolbar. Their image can be
3048 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3051 `pointer' glyphs can be used to specify the mouse pointer. Their
3052 image can be instantiated as `pointer'.
3054 `icon' glyphs can be used to specify the icon used when a frame is
3055 iconified. Their image can be instantiated as `mono-pixmap' and
3060 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3061 return allocate_glyph (typeval, 0);
3064 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3065 Return non-nil if OBJECT is a glyph.
3067 A glyph is an object used for pixmaps and the like. It is used
3068 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3069 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3070 buttons, and the like. Its image is described using an image specifier --
3071 see `image-specifier-p'.
3075 return GLYPHP (object) ? Qt : Qnil;
3078 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3079 Return the type of the given glyph.
3080 The return value will be one of 'buffer, 'pointer, or 'icon.
3084 CHECK_GLYPH (glyph);
3085 switch (XGLYPH_TYPE (glyph))
3088 case GLYPH_BUFFER: return Qbuffer;
3089 case GLYPH_POINTER: return Qpointer;
3090 case GLYPH_ICON: return Qicon;
3094 /*****************************************************************************
3097 Return the width of the given GLYPH on the given WINDOW. If the
3098 instance is a string then the width is calculated using the font of
3099 the given FACE, unless a face is defined by the glyph itself.
3100 ****************************************************************************/
3102 glyph_width (Lisp_Object glyph, Lisp_Object frame_face,
3103 face_index window_findex, Lisp_Object window)
3105 Lisp_Object instance;
3106 Lisp_Object frame = XWINDOW (window)->frame;
3108 /* #### We somehow need to distinguish between the user causing this
3109 error condition and a bug causing it. */
3110 if (!GLYPHP (glyph))
3113 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3115 if (!IMAGE_INSTANCEP (instance))
3118 switch (XIMAGE_INSTANCE_TYPE (instance))
3122 Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance);
3123 Lisp_Object private_face = XGLYPH_FACE(glyph);
3125 if (!NILP (private_face))
3126 return redisplay_frame_text_width_string (XFRAME (frame),
3130 if (!NILP (frame_face))
3131 return redisplay_frame_text_width_string (XFRAME (frame),
3135 return redisplay_text_width_string (XWINDOW (window),
3140 case IMAGE_MONO_PIXMAP:
3141 case IMAGE_COLOR_PIXMAP:
3143 return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance);
3148 case IMAGE_SUBWINDOW:
3150 return XIMAGE_INSTANCE_SUBWINDOW_WIDTH (instance);
3158 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3159 Return the width of GLYPH on WINDOW.
3160 This may not be exact as it does not take into account all of the context
3161 that redisplay will.
3165 XSETWINDOW (window, decode_window (window));
3166 CHECK_GLYPH (glyph);
3168 return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window));
3171 #define RETURN_ASCENT 0
3172 #define RETURN_DESCENT 1
3173 #define RETURN_HEIGHT 2
3176 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3177 Error_behavior errb, int no_quit)
3179 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3181 /* This can never return Qunbound. All glyphs have 'nothing as
3183 return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0,
3187 static unsigned short
3188 glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face,
3189 face_index window_findex, Lisp_Object window,
3192 Lisp_Object instance;
3193 Lisp_Object frame = XWINDOW (window)->frame;
3195 if (!GLYPHP (glyph))
3198 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3200 if (!IMAGE_INSTANCEP (instance))
3203 switch (XIMAGE_INSTANCE_TYPE (instance))
3207 struct font_metric_info fm;
3208 Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance);
3209 unsigned char charsets[NUM_LEADING_BYTES];
3210 struct face_cachel frame_cachel;
3211 struct face_cachel *cachel;
3213 find_charsets_in_bufbyte_string (charsets,
3214 XSTRING_DATA (string),
3215 XSTRING_LENGTH (string));
3217 if (!NILP (frame_face))
3219 reset_face_cachel (&frame_cachel);
3220 update_face_cachel_data (&frame_cachel, frame, frame_face);
3221 cachel = &frame_cachel;
3224 cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex);
3225 ensure_face_cachel_complete (cachel, window, charsets);
3227 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
3231 case RETURN_ASCENT: return fm.ascent;
3232 case RETURN_DESCENT: return fm.descent;
3233 case RETURN_HEIGHT: return fm.ascent + fm.descent;
3236 return 0; /* not reached */
3240 case IMAGE_MONO_PIXMAP:
3241 case IMAGE_COLOR_PIXMAP:
3243 /* #### Ugh ugh ugh -- temporary crap */
3244 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3245 return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance);
3252 case IMAGE_SUBWINDOW:
3254 /* #### Ugh ugh ugh -- temporary crap */
3255 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3256 return XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (instance);
3267 glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face,
3268 face_index window_findex, Lisp_Object window)
3270 return glyph_height_internal (glyph, frame_face, window_findex, window,
3275 glyph_descent (Lisp_Object glyph, Lisp_Object frame_face,
3276 face_index window_findex, Lisp_Object window)
3278 return glyph_height_internal (glyph, frame_face, window_findex, window,
3282 /* strictly a convenience function. */
3284 glyph_height (Lisp_Object glyph, Lisp_Object frame_face,
3285 face_index window_findex, Lisp_Object window)
3287 return glyph_height_internal (glyph, frame_face, window_findex, window,
3291 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3292 Return the ascent value of GLYPH on WINDOW.
3293 This may not be exact as it does not take into account all of the context
3294 that redisplay will.
3298 XSETWINDOW (window, decode_window (window));
3299 CHECK_GLYPH (glyph);
3301 return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window));
3304 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3305 Return the descent value of GLYPH on WINDOW.
3306 This may not be exact as it does not take into account all of the context
3307 that redisplay will.
3311 XSETWINDOW (window, decode_window (window));
3312 CHECK_GLYPH (glyph);
3314 return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window));
3317 /* This is redundant but I bet a lot of people expect it to exist. */
3318 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3319 Return the height of GLYPH on WINDOW.
3320 This may not be exact as it does not take into account all of the context
3321 that redisplay will.
3325 XSETWINDOW (window, decode_window (window));
3326 CHECK_GLYPH (glyph);
3328 return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window));
3331 #undef RETURN_ASCENT
3332 #undef RETURN_DESCENT
3333 #undef RETURN_HEIGHT
3335 /* #### do we need to cache this info to speed things up? */
3338 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3340 if (!GLYPHP (glyph))
3344 Lisp_Object retval =
3345 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3346 /* #### look into ERROR_ME_NOT */
3347 Qunbound, domain, ERROR_ME_NOT,
3349 if (!NILP (retval) && !INTP (retval))
3351 else if (INTP (retval))
3353 if (XINT (retval) < 0)
3355 if (XINT (retval) > 100)
3356 retval = make_int (100);
3363 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3365 /* #### Domain parameter not currently used but it will be */
3366 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3370 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3372 if (!GLYPHP (glyph))
3375 return !NILP (specifier_instance_no_quit
3376 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3377 /* #### look into ERROR_ME_NOT */
3378 ERROR_ME_NOT, 0, Qzero));
3382 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3385 if (XGLYPH (glyph)->after_change)
3386 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3390 /*****************************************************************************
3391 * glyph cachel functions *
3392 *****************************************************************************/
3395 #### All of this is 95% copied from face cachels.
3396 Consider consolidating.
3397 #### We need to add a dirty flag to the glyphs.
3401 mark_glyph_cachels (glyph_cachel_dynarr *elements,
3402 void (*markobj) (Lisp_Object))
3409 for (elt = 0; elt < Dynarr_length (elements); elt++)
3411 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3412 markobj (cachel->glyph);
3417 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3418 struct glyph_cachel *cachel)
3420 /* #### This should be || !cachel->updated */
3421 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph))
3425 XSETWINDOW (window, w);
3427 /* #### This could be sped up if we redid things to grab the glyph
3428 instantiation and passed it to the size functions. */
3429 cachel->glyph = glyph;
3430 cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window);
3431 cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window);
3432 cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window);
3435 cachel->updated = 1;
3439 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3441 struct glyph_cachel new_cachel;
3444 new_cachel.glyph = Qnil;
3446 update_glyph_cachel_data (w, glyph, &new_cachel);
3447 Dynarr_add (w->glyph_cachels, new_cachel);
3451 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3458 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3460 struct glyph_cachel *cachel =
3461 Dynarr_atp (w->glyph_cachels, elt);
3463 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3465 if (!cachel->updated)
3466 update_glyph_cachel_data (w, glyph, cachel);
3471 /* If we didn't find the glyph, add it and then return its index. */
3472 add_glyph_cachel (w, glyph);
3477 reset_glyph_cachels (struct window *w)
3479 Dynarr_reset (w->glyph_cachels);
3480 get_glyph_cachel_index (w, Vcontinuation_glyph);
3481 get_glyph_cachel_index (w, Vtruncation_glyph);
3482 get_glyph_cachel_index (w, Vhscroll_glyph);
3483 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3484 get_glyph_cachel_index (w, Voctal_escape_glyph);
3485 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3489 mark_glyph_cachels_as_not_updated (struct window *w)
3493 /* We need to have a dirty flag to tell if the glyph has changed.
3494 We can check to see if each glyph variable is actually a
3495 completely different glyph, though. */
3496 #define FROB(glyph_obj, gindex) \
3497 update_glyph_cachel_data (w, glyph_obj, \
3498 Dynarr_atp (w->glyph_cachels, gindex))
3500 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3501 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3502 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3503 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3504 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3505 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3508 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3509 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3512 #ifdef MEMORY_USAGE_STATS
3515 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3516 struct overhead_stats *ovstats)
3521 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3526 #endif /* MEMORY_USAGE_STATS */
3530 /*****************************************************************************
3531 * subwindow cachel functions *
3532 *****************************************************************************/
3533 /* subwindows are curious in that you have to physically unmap them to
3534 not display them. It is problematic deciding what to do in
3535 redisplay. We have two caches - a per-window instance cache that
3536 keeps track of subwindows on a window, these are linked to their
3537 instantiator in the hashtable and when the instantiator goes away
3538 we want the instance to go away also. However we also have a
3539 per-frame instance cache that we use to determine if a subwindow is
3540 obscuring an area that we want to clear. We need to be able to flip
3541 through this quickly so a hashtable is not suitable hence the
3542 subwindow_cachels. The question is should we just not mark
3543 instances in the subwindow_cachelsnor should we try and invalidate
3544 the cache at suitable points in redisplay? If we don't invalidate
3545 the cache it will fill up with crud that will only get removed when
3546 the frame is deleted. So invalidation is good, the question is when
3547 and whether we mark as well. Go for the simple option - don't mark,
3548 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
3551 mark_subwindow_cachels (subwindow_cachel_dynarr *elements,
3552 void (*markobj) (Lisp_Object))
3559 for (elt = 0; elt < Dynarr_length (elements); elt++)
3561 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
3562 markobj (cachel->subwindow);
3567 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
3568 struct subwindow_cachel *cachel)
3570 if (NILP (cachel->subwindow) || !EQ (cachel->subwindow, subwindow))
3572 cachel->subwindow = subwindow;
3573 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3574 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3577 cachel->updated = 1;
3581 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
3583 struct subwindow_cachel new_cachel;
3586 new_cachel.subwindow = Qnil;
3589 new_cachel.being_displayed=0;
3591 update_subwindow_cachel_data (f, subwindow, &new_cachel);
3592 Dynarr_add (f->subwindow_cachels, new_cachel);
3596 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
3603 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3605 struct subwindow_cachel *cachel =
3606 Dynarr_atp (f->subwindow_cachels, elt);
3608 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
3610 if (!cachel->updated)
3611 update_subwindow_cachel_data (f, subwindow, cachel);
3616 /* If we didn't find the glyph, add it and then return its index. */
3617 add_subwindow_cachel (f, subwindow);
3621 /* redisplay in general assumes that drawing something will erase
3622 what was there before. unfortunately this does not apply to
3623 subwindows that need to be specifically unmapped in order to
3624 disappear. we take a brute force approach - on the basis that its
3625 cheap - and unmap all subwindows in a display line */
3627 reset_subwindow_cachels (struct frame *f)
3630 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3632 struct subwindow_cachel *cachel =
3633 Dynarr_atp (f->subwindow_cachels, elt);
3635 if (!NILP (cachel->subwindow) && cachel->being_displayed)
3637 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (cachel->subwindow);
3638 MAYBE_DEVMETH (XDEVICE (f->device), unmap_subwindow, (ii));
3641 Dynarr_reset (f->subwindow_cachels);
3645 mark_subwindow_cachels_as_not_updated (struct frame *f)
3649 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3650 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
3654 /*****************************************************************************
3655 * subwindow functions *
3656 *****************************************************************************/
3658 /* update the displayed characteristics of a subwindow */
3660 update_subwindow (Lisp_Object subwindow)
3662 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3664 if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3666 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3669 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
3673 update_frame_subwindows (struct frame *f)
3677 if (f->subwindows_changed || f->glyphs_changed)
3678 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3680 struct subwindow_cachel *cachel =
3681 Dynarr_atp (f->subwindow_cachels, elt);
3683 if (cachel->being_displayed)
3685 update_subwindow (cachel->subwindow);
3690 /* remove a subwindow from its frame */
3691 void unmap_subwindow (Lisp_Object subwindow)
3693 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3695 struct subwindow_cachel* cachel;
3698 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3700 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3702 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3705 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3706 elt = get_subwindow_cachel_index (f, subwindow);
3707 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3711 cachel->being_displayed = 0;
3712 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3714 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
3717 /* show a subwindow in its frame */
3718 void map_subwindow (Lisp_Object subwindow, int x, int y)
3720 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3722 struct subwindow_cachel* cachel;
3725 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3727 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3729 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3732 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3733 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
3734 elt = get_subwindow_cachel_index (f, subwindow);
3735 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3738 cachel->being_displayed = 1;
3740 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y));
3744 subwindow_possible_dest_types (void)
3746 return IMAGE_SUBWINDOW_MASK;
3749 /* Partially instantiate a subwindow. */
3751 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
3752 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
3753 int dest_mask, Lisp_Object domain)
3755 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
3756 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
3757 Lisp_Object frame = FW_FRAME (domain);
3758 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
3759 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
3762 signal_simple_error ("No selected frame", device);
3764 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
3765 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
3768 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
3769 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = Qnil;
3770 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3771 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
3773 /* this stuff may get overidden by the widget code */
3775 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
3780 if (XINT (width) > 1)
3782 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
3785 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
3790 if (XINT (height) > 1)
3792 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
3796 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
3797 Return non-nil if OBJECT is a subwindow.
3801 CHECK_IMAGE_INSTANCE (object);
3802 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
3805 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
3806 Return the window id of SUBWINDOW as a number.
3810 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3811 return make_int ((int) (XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)));
3814 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
3815 Resize SUBWINDOW to WIDTH x HEIGHT.
3816 If a value is nil that parameter is not changed.
3818 (subwindow, width, height))
3822 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3825 neww = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3827 neww = XINT (width);
3830 newh = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3832 newh = XINT (height);
3835 MAYBE_DEVMETH (XDEVICE (XIMAGE_INSTANCE_DEVICE (subwindow)),
3836 resize_subwindow, (XIMAGE_INSTANCE (subwindow), neww, newh));
3838 XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow) = newh;
3839 XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow) = neww;
3844 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
3845 Generate a Map event for SUBWINDOW.
3849 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3851 map_subwindow (subwindow, 0, 0);
3857 /*****************************************************************************
3859 *****************************************************************************/
3861 /* Get the display tables for use currently on window W with face
3862 FACE. #### This will have to be redone. */
3865 get_display_tables (struct window *w, face_index findex,
3866 Lisp_Object *face_table, Lisp_Object *window_table)
3869 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
3873 tem = noseeum_cons (tem, Qnil);
3875 tem = w->display_table;
3879 tem = noseeum_cons (tem, Qnil);
3880 *window_table = tem;
3884 display_table_entry (Emchar ch, Lisp_Object face_table,
3885 Lisp_Object window_table)
3889 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
3890 for (tail = face_table; 1; tail = XCDR (tail))
3895 if (!NILP (window_table))
3897 tail = window_table;
3898 window_table = Qnil;
3903 table = XCAR (tail);
3905 if (VECTORP (table))
3907 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
3908 return XVECTOR_DATA (table)[ch];
3912 else if (CHAR_TABLEP (table)
3913 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
3915 return get_char_table (ch, XCHAR_TABLE (table));
3917 else if (CHAR_TABLEP (table)
3918 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
3920 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
3926 else if (RANGE_TABLEP (table))
3928 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
3939 /*****************************************************************************
3941 *****************************************************************************/
3944 syms_of_glyphs (void)
3946 /* image instantiators */
3948 DEFSUBR (Fimage_instantiator_format_list);
3949 DEFSUBR (Fvalid_image_instantiator_format_p);
3950 DEFSUBR (Fset_console_type_image_conversion_list);
3951 DEFSUBR (Fconsole_type_image_conversion_list);
3953 defkeyword (&Q_file, ":file");
3954 defkeyword (&Q_data, ":data");
3955 defkeyword (&Q_face, ":face");
3956 defkeyword (&Q_pixel_height, ":pixel-height");
3957 defkeyword (&Q_pixel_width, ":pixel-width");
3960 defkeyword (&Q_color_symbols, ":color-symbols");
3962 #ifdef HAVE_WINDOW_SYSTEM
3963 defkeyword (&Q_mask_file, ":mask-file");
3964 defkeyword (&Q_mask_data, ":mask-data");
3965 defkeyword (&Q_hotspot_x, ":hotspot-x");
3966 defkeyword (&Q_hotspot_y, ":hotspot-y");
3967 defkeyword (&Q_foreground, ":foreground");
3968 defkeyword (&Q_background, ":background");
3970 /* image specifiers */
3972 DEFSUBR (Fimage_specifier_p);
3973 /* Qimage in general.c */
3975 /* image instances */
3977 defsymbol (&Qimage_instancep, "image-instance-p");
3979 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
3980 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
3981 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
3982 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
3983 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
3984 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
3985 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
3987 DEFSUBR (Fmake_image_instance);
3988 DEFSUBR (Fimage_instance_p);
3989 DEFSUBR (Fimage_instance_type);
3990 DEFSUBR (Fvalid_image_instance_type_p);
3991 DEFSUBR (Fimage_instance_type_list);
3992 DEFSUBR (Fimage_instance_name);
3993 DEFSUBR (Fimage_instance_string);
3994 DEFSUBR (Fimage_instance_file_name);
3995 DEFSUBR (Fimage_instance_mask_file_name);
3996 DEFSUBR (Fimage_instance_depth);
3997 DEFSUBR (Fimage_instance_height);
3998 DEFSUBR (Fimage_instance_width);
3999 DEFSUBR (Fimage_instance_hotspot_x);
4000 DEFSUBR (Fimage_instance_hotspot_y);
4001 DEFSUBR (Fimage_instance_foreground);
4002 DEFSUBR (Fimage_instance_background);
4003 DEFSUBR (Fimage_instance_property);
4004 DEFSUBR (Fset_image_instance_property);
4005 DEFSUBR (Fcolorize_image_instance);
4007 DEFSUBR (Fsubwindowp);
4008 DEFSUBR (Fimage_instance_subwindow_id);
4009 DEFSUBR (Fresize_subwindow);
4010 DEFSUBR (Fforce_subwindow_map);
4012 /* Qnothing defined as part of the "nothing" image-instantiator
4014 /* Qtext defined in general.c */
4015 defsymbol (&Qmono_pixmap, "mono-pixmap");
4016 defsymbol (&Qcolor_pixmap, "color-pixmap");
4017 /* Qpointer defined in general.c */
4021 defsymbol (&Qglyphp, "glyphp");
4022 defsymbol (&Qcontrib_p, "contrib-p");
4023 defsymbol (&Qbaseline, "baseline");
4025 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4026 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4027 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4029 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4031 DEFSUBR (Fglyph_type);
4032 DEFSUBR (Fvalid_glyph_type_p);
4033 DEFSUBR (Fglyph_type_list);
4035 DEFSUBR (Fmake_glyph_internal);
4036 DEFSUBR (Fglyph_width);
4037 DEFSUBR (Fglyph_ascent);
4038 DEFSUBR (Fglyph_descent);
4039 DEFSUBR (Fglyph_height);
4041 /* Qbuffer defined in general.c. */
4042 /* Qpointer defined above */
4045 deferror (&Qimage_conversion_error,
4046 "image-conversion-error",
4047 "image-conversion error", Qio_error);
4052 specifier_type_create_image (void)
4054 /* image specifiers */
4056 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4058 SPECIFIER_HAS_METHOD (image, create);
4059 SPECIFIER_HAS_METHOD (image, mark);
4060 SPECIFIER_HAS_METHOD (image, instantiate);
4061 SPECIFIER_HAS_METHOD (image, validate);
4062 SPECIFIER_HAS_METHOD (image, after_change);
4063 SPECIFIER_HAS_METHOD (image, going_to_add);
4067 image_instantiator_format_create (void)
4069 /* image instantiators */
4071 the_image_instantiator_format_entry_dynarr =
4072 Dynarr_new (image_instantiator_format_entry);
4074 Vimage_instantiator_format_list = Qnil;
4075 staticpro (&Vimage_instantiator_format_list);
4077 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
4079 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
4080 IIFORMAT_HAS_METHOD (nothing, instantiate);
4082 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
4084 IIFORMAT_HAS_METHOD (inherit, validate);
4085 IIFORMAT_HAS_METHOD (inherit, normalize);
4086 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
4087 IIFORMAT_HAS_METHOD (inherit, instantiate);
4089 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
4091 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
4093 IIFORMAT_HAS_METHOD (string, validate);
4094 IIFORMAT_HAS_METHOD (string, possible_dest_types);
4095 IIFORMAT_HAS_METHOD (string, instantiate);
4097 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4099 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4101 IIFORMAT_HAS_METHOD (formatted_string, validate);
4102 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4103 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
4105 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
4108 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
4109 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
4110 IIFORMAT_HAS_METHOD (subwindow, instantiate);
4111 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
4112 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
4114 #ifdef HAVE_WINDOW_SYSTEM
4115 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4117 IIFORMAT_HAS_METHOD (xbm, validate);
4118 IIFORMAT_HAS_METHOD (xbm, normalize);
4119 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4121 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4122 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4123 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4124 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4125 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4126 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4127 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4128 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4129 #endif /* HAVE_WINDOW_SYSTEM */
4132 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
4134 IIFORMAT_HAS_METHOD (xface, validate);
4135 IIFORMAT_HAS_METHOD (xface, normalize);
4136 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
4138 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
4139 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
4140 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
4141 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
4142 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
4143 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
4147 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
4149 IIFORMAT_HAS_METHOD (xpm, validate);
4150 IIFORMAT_HAS_METHOD (xpm, normalize);
4151 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
4153 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
4154 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
4155 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
4156 #endif /* HAVE_XPM */
4160 vars_of_glyphs (void)
4162 Vthe_nothing_vector = vector1 (Qnothing);
4163 staticpro (&Vthe_nothing_vector);
4165 /* image instances */
4167 Vimage_instance_type_list = Fcons (Qnothing,
4168 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
4169 Qpointer, Qsubwindow, Qwidget));
4170 staticpro (&Vimage_instance_type_list);
4174 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
4175 staticpro (&Vglyph_type_list);
4177 /* The octal-escape glyph, control-arrow-glyph and
4178 invisible-text-glyph are completely initialized in glyphs.el */
4180 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
4181 What to prefix character codes displayed in octal with.
4183 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4185 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
4186 What to use as an arrow for control characters.
4188 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
4189 redisplay_glyph_changed);
4191 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
4192 What to use to indicate the presence of invisible text.
4193 This is the glyph that is displayed when an ellipsis is called for
4194 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
4195 Normally this is three dots ("...").
4197 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
4198 redisplay_glyph_changed);
4200 /* Partially initialized in glyphs.el */
4201 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
4202 What to display at the beginning of horizontally scrolled lines.
4204 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4205 #ifdef HAVE_WINDOW_SYSTEM
4211 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
4212 Definitions of logical color-names used when reading XPM files.
4213 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
4214 The COLOR-NAME should be a string, which is the name of the color to define;
4215 the FORM should evaluate to a `color' specifier object, or a string to be
4216 passed to `make-color-instance'. If a loaded XPM file references a symbolic
4217 color called COLOR-NAME, it will display as the computed color instead.
4219 The default value of this variable defines the logical color names
4220 \"foreground\" and \"background\" to be the colors of the `default' face.
4222 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
4223 #endif /* HAVE_XPM */
4230 specifier_vars_of_glyphs (void)
4232 /* #### Can we GC here? The set_specifier_* calls definitely need */
4234 /* display tables */
4236 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
4237 *The display table currently in use.
4238 This is a specifier; use `set-specifier' to change it.
4239 The display table is a vector created with `make-display-table'.
4240 The 256 elements control how to display each possible text character.
4241 Each value should be a string, a glyph, a vector or nil.
4242 If a value is a vector it must be composed only of strings and glyphs.
4243 nil means display the character in the default fashion.
4244 Faces can have their own, overriding display table.
4246 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
4247 set_specifier_fallback (Vcurrent_display_table,
4248 list1 (Fcons (Qnil, Qnil)));
4249 set_specifier_caching (Vcurrent_display_table,
4250 slot_offset (struct window,
4252 some_window_value_changed,
4257 complex_vars_of_glyphs (void)
4259 /* Partially initialized in glyphs-x.c, glyphs.el */
4260 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
4261 What to display at the end of truncated lines.
4263 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4265 /* Partially initialized in glyphs-x.c, glyphs.el */
4266 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
4267 What to display at the end of wrapped lines.
4269 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4271 /* Partially initialized in glyphs-x.c, glyphs.el */
4272 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
4273 The glyph used to display the XEmacs logo at startup.
4275 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);