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 markobj (IMAGE_INSTANCE_WIDGET_ITEM (i));
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);
711 if (!NILP (IMAGE_INSTANCE_WIDGET_CALLBACK (ii)))
713 print_internal (IMAGE_INSTANCE_WIDGET_CALLBACK (ii), printcharfun, 0);
714 write_c_string (", ", printcharfun);
717 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
719 write_c_string (" (", printcharfun);
721 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
722 write_c_string (")", printcharfun);
725 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
726 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0);
728 case IMAGE_SUBWINDOW:
729 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
730 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
731 write_c_string (buf, printcharfun);
733 /* This is stolen from frame.c. Subwindows are strange in that they
734 are specific to a particular frame so we want to print in their
735 description what that frame is. */
737 write_c_string (" on #<", printcharfun);
739 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
741 if (!FRAME_LIVE_P (f))
742 write_c_string ("dead", printcharfun);
744 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
747 write_c_string ("-frame ", printcharfun);
749 write_c_string (">", printcharfun);
750 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
751 write_c_string (buf, printcharfun);
759 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
760 (ii, printcharfun, escapeflag));
761 sprintf (buf, " 0x%x>", ii->header.uid);
762 write_c_string (buf, printcharfun);
766 finalize_image_instance (void *header, int for_disksave)
768 struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header;
770 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
771 /* objects like this exist at dump time, so don't bomb out. */
773 if (for_disksave) finalose (i);
775 /* do this so that the cachels get reset */
776 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
778 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
780 MARK_FRAME_GLYPHS_CHANGED
781 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
784 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
788 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
790 struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
791 struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
792 struct device *d1 = XDEVICE (i1->device);
793 struct device *d2 = XDEVICE (i2->device);
797 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2))
799 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
803 switch (IMAGE_INSTANCE_TYPE (i1))
809 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
810 IMAGE_INSTANCE_TEXT_STRING (i2),
815 case IMAGE_MONO_PIXMAP:
816 case IMAGE_COLOR_PIXMAP:
818 if (!(IMAGE_INSTANCE_PIXMAP_WIDTH (i1) ==
819 IMAGE_INSTANCE_PIXMAP_WIDTH (i2) &&
820 IMAGE_INSTANCE_PIXMAP_HEIGHT (i1) ==
821 IMAGE_INSTANCE_PIXMAP_HEIGHT (i2) &&
822 IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
823 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
824 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
825 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
826 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
827 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
828 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
829 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
831 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
832 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
838 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
839 IMAGE_INSTANCE_WIDGET_TYPE (i2))
840 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEM (i1),
841 IMAGE_INSTANCE_WIDGET_ITEM (i2),
843 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
844 IMAGE_INSTANCE_WIDGET_PROPS (i2),
848 case IMAGE_SUBWINDOW:
849 if (!(IMAGE_INSTANCE_SUBWINDOW_WIDTH (i1) ==
850 IMAGE_INSTANCE_SUBWINDOW_WIDTH (i2) &&
851 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i1) ==
852 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i2) &&
853 IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
854 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
862 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
866 image_instance_hash (Lisp_Object obj, int depth)
868 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
869 struct device *d = XDEVICE (i->device);
870 unsigned long hash = (unsigned long) d;
872 switch (IMAGE_INSTANCE_TYPE (i))
878 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
882 case IMAGE_MONO_PIXMAP:
883 case IMAGE_COLOR_PIXMAP:
885 hash = HASH5 (hash, IMAGE_INSTANCE_PIXMAP_WIDTH (i),
886 IMAGE_INSTANCE_PIXMAP_HEIGHT (i),
887 IMAGE_INSTANCE_PIXMAP_DEPTH (i),
888 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
894 internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1),
895 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
896 internal_hash (IMAGE_INSTANCE_WIDGET_ITEM (i), depth + 1));
897 case IMAGE_SUBWINDOW:
898 hash = HASH4 (hash, IMAGE_INSTANCE_SUBWINDOW_WIDTH (i),
899 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i),
900 (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
907 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
911 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
912 mark_image_instance, print_image_instance,
913 finalize_image_instance, image_instance_equal,
914 image_instance_hash, 0,
915 struct Lisp_Image_Instance);
918 allocate_image_instance (Lisp_Object device)
920 struct Lisp_Image_Instance *lp =
921 alloc_lcrecord_type (struct Lisp_Image_Instance, &lrecord_image_instance);
926 lp->type = IMAGE_NOTHING;
928 XSETIMAGE_INSTANCE (val, lp);
932 static enum image_instance_type
933 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
935 if (ERRB_EQ (errb, ERROR_ME))
938 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
939 if (EQ (type, Qtext)) return IMAGE_TEXT;
940 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
941 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
942 if (EQ (type, Qpointer)) return IMAGE_POINTER;
943 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
944 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
946 maybe_signal_simple_error ("Invalid image-instance type", type,
949 return IMAGE_UNKNOWN; /* not reached */
953 encode_image_instance_type (enum image_instance_type type)
957 case IMAGE_NOTHING: return Qnothing;
958 case IMAGE_TEXT: return Qtext;
959 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
960 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
961 case IMAGE_POINTER: return Qpointer;
962 case IMAGE_SUBWINDOW: return Qsubwindow;
963 case IMAGE_WIDGET: return Qwidget;
968 return Qnil; /* not reached */
972 image_instance_type_to_mask (enum image_instance_type type)
974 /* This depends on the fact that enums are assigned consecutive
975 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
976 first enum.) I'm fairly sure this behavior in ANSI-mandated,
977 so there should be no portability problems here. */
978 return (1 << ((int) (type) - 1));
982 decode_image_instance_type_list (Lisp_Object list)
992 enum image_instance_type type =
993 decode_image_instance_type (list, ERROR_ME);
994 return image_instance_type_to_mask (type);
997 EXTERNAL_LIST_LOOP (rest, list)
999 enum image_instance_type type =
1000 decode_image_instance_type (XCAR (rest), ERROR_ME);
1001 mask |= image_instance_type_to_mask (type);
1008 encode_image_instance_type_list (int mask)
1011 Lisp_Object result = Qnil;
1017 result = Fcons (encode_image_instance_type
1018 ((enum image_instance_type) count), result);
1022 return Fnreverse (result);
1026 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1027 int desired_dest_mask)
1032 (emacs_doprnt_string_lisp_2
1034 "No compatible image-instance types given: wanted one of %s, got %s",
1036 encode_image_instance_type_list (desired_dest_mask),
1037 encode_image_instance_type_list (given_dest_mask)),
1042 valid_image_instance_type_p (Lisp_Object type)
1044 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1047 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1048 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1049 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1050 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1052 (image_instance_type))
1054 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1057 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1058 Return a list of valid image-instance types.
1062 return Fcopy_sequence (Vimage_instance_type_list);
1066 decode_error_behavior_flag (Lisp_Object no_error)
1068 if (NILP (no_error)) return ERROR_ME;
1069 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1070 else return ERROR_ME_WARN;
1074 encode_error_behavior_flag (Error_behavior errb)
1076 if (ERRB_EQ (errb, ERROR_ME))
1078 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1082 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1088 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1089 Lisp_Object dest_types)
1092 struct gcpro gcpro1;
1095 XSETDEVICE (device, decode_device (device));
1096 /* instantiate_image_instantiator() will abort if given an
1097 image instance ... */
1098 if (IMAGE_INSTANCEP (data))
1099 signal_simple_error ("Image instances not allowed here", data);
1100 image_validate (data);
1101 dest_mask = decode_image_instance_type_list (dest_types);
1102 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1103 make_int (dest_mask));
1105 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1106 signal_simple_error ("Inheritance not allowed here", data);
1107 ii = instantiate_image_instantiator (device, device, data,
1108 Qnil, Qnil, dest_mask);
1109 RETURN_UNGCPRO (ii);
1112 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1113 Return a new `image-instance' object.
1115 Image-instance objects encapsulate the way a particular image (pixmap,
1116 etc.) is displayed on a particular device. In most circumstances, you
1117 do not need to directly create image instances; use a glyph instead.
1118 However, it may occasionally be useful to explicitly create image
1119 instances, if you want more control over the instantiation process.
1121 DATA is an image instantiator, which describes the image; see
1122 `image-specifier-p' for a description of the allowed values.
1124 DEST-TYPES should be a list of allowed image instance types that can
1125 be generated. The recognized image instance types are
1128 Nothing is displayed.
1130 Displayed as text. The foreground and background colors and the
1131 font of the text are specified independent of the pixmap. Typically
1132 these attributes will come from the face of the surrounding text,
1133 unless a face is specified for the glyph in which the image appears.
1135 Displayed as a mono pixmap (a pixmap with only two colors where the
1136 foreground and background can be specified independent of the pixmap;
1137 typically the pixmap assumes the foreground and background colors of
1138 the text around it, unless a face is specified for the glyph in which
1141 Displayed as a color pixmap.
1143 Used as the mouse pointer for a window.
1145 A child window that is treated as an image. This allows (e.g.)
1146 another program to be responsible for drawing into the window.
1147 Not currently implemented.
1149 The DEST-TYPES list is unordered. If multiple destination types
1150 are possible for a given instantiator, the "most natural" type
1151 for the instantiator's format is chosen. (For XBM, the most natural
1152 types are `mono-pixmap', followed by `color-pixmap', followed by
1153 `pointer'. For the other normal image formats, the most natural
1154 types are `color-pixmap', followed by `mono-pixmap', followed by
1155 `pointer'. For the string and formatted-string formats, the most
1156 natural types are `text', followed by `mono-pixmap' (not currently
1157 implemented), followed by `color-pixmap' (not currently implemented).
1158 The other formats can only be instantiated as one type. (If you
1159 want to control more specifically the order of the types into which
1160 an image is instantiated, just call `make-image-instance' repeatedly
1161 until it succeeds, passing less and less preferred destination types
1164 If DEST-TYPES is omitted, all possible types are allowed.
1166 NO-ERROR controls what happens when the image cannot be generated.
1167 If nil, an error message is generated. If t, no messages are
1168 generated and this function returns nil. If anything else, a warning
1169 message is generated and this function returns nil.
1171 (data, device, dest_types, no_error))
1173 Error_behavior errb = decode_error_behavior_flag (no_error);
1175 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1177 3, data, device, dest_types);
1180 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1181 Return non-nil if OBJECT is an image instance.
1185 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1188 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1189 Return the type of the given image instance.
1190 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1191 'color-pixmap, 'pointer, or 'subwindow.
1195 CHECK_IMAGE_INSTANCE (image_instance);
1196 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1199 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1200 Return the name of the given image instance.
1204 CHECK_IMAGE_INSTANCE (image_instance);
1205 return XIMAGE_INSTANCE_NAME (image_instance);
1208 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1209 Return the string of the given image instance.
1210 This will only be non-nil for text image instances and widgets.
1214 CHECK_IMAGE_INSTANCE (image_instance);
1215 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1216 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1217 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1218 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1223 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1224 Return the given property of the given image instance.
1225 Returns nil if the property or the property method do not exist for
1226 the image instance in the domain.
1228 (image_instance, prop))
1230 struct Lisp_Image_Instance* ii;
1231 Lisp_Object type, ret;
1232 struct image_instantiator_methods* meths;
1234 CHECK_IMAGE_INSTANCE (image_instance);
1235 CHECK_SYMBOL (prop);
1236 ii = XIMAGE_INSTANCE (image_instance);
1238 /* ... then try device specific methods ... */
1239 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1240 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1241 type, ERROR_ME_NOT);
1242 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1244 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1248 /* ... then format specific methods ... */
1249 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1250 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1252 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1260 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1261 Set the given property of the given image instance.
1262 Does nothing if the property or the property method do not exist for
1263 the image instance in the domain.
1265 (image_instance, prop, val))
1267 struct Lisp_Image_Instance* ii;
1268 Lisp_Object type, ret;
1269 struct image_instantiator_methods* meths;
1271 CHECK_IMAGE_INSTANCE (image_instance);
1272 CHECK_SYMBOL (prop);
1273 ii = XIMAGE_INSTANCE (image_instance);
1274 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1275 /* try device specific methods first ... */
1276 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1277 type, ERROR_ME_NOT);
1278 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1281 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1285 /* ... then format specific methods ... */
1286 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1287 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1290 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1298 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1299 Return the file name from which IMAGE-INSTANCE was read, if known.
1303 CHECK_IMAGE_INSTANCE (image_instance);
1305 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1307 case IMAGE_MONO_PIXMAP:
1308 case IMAGE_COLOR_PIXMAP:
1310 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1317 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1318 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1322 CHECK_IMAGE_INSTANCE (image_instance);
1324 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1326 case IMAGE_MONO_PIXMAP:
1327 case IMAGE_COLOR_PIXMAP:
1329 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1336 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1337 Return the depth of the image instance.
1338 This is 0 for a bitmap, or a positive integer for a pixmap.
1342 CHECK_IMAGE_INSTANCE (image_instance);
1344 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1346 case IMAGE_MONO_PIXMAP:
1347 case IMAGE_COLOR_PIXMAP:
1349 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1356 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1357 Return the height of the image instance, in pixels.
1361 CHECK_IMAGE_INSTANCE (image_instance);
1363 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1365 case IMAGE_MONO_PIXMAP:
1366 case IMAGE_COLOR_PIXMAP:
1368 return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance));
1370 case IMAGE_SUBWINDOW:
1372 return make_int (XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (image_instance));
1379 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1380 Return the width of the image instance, in pixels.
1384 CHECK_IMAGE_INSTANCE (image_instance);
1386 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1388 case IMAGE_MONO_PIXMAP:
1389 case IMAGE_COLOR_PIXMAP:
1391 return make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance));
1393 case IMAGE_SUBWINDOW:
1395 return make_int (XIMAGE_INSTANCE_SUBWINDOW_WIDTH (image_instance));
1402 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1403 Return the X coordinate of the image instance's hotspot, if known.
1404 This is a point relative to the origin of the pixmap. When an image is
1405 used as a mouse pointer, the hotspot is the point on the image that sits
1406 over the location that the pointer points to. This is, for example, the
1407 tip of the arrow or the center of the crosshairs.
1408 This will always be nil for a non-pointer image instance.
1412 CHECK_IMAGE_INSTANCE (image_instance);
1414 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1416 case IMAGE_MONO_PIXMAP:
1417 case IMAGE_COLOR_PIXMAP:
1419 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1426 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1427 Return the Y coordinate of the image instance's hotspot, if known.
1428 This is a point relative to the origin of the pixmap. When an image is
1429 used as a mouse pointer, the hotspot is the point on the image that sits
1430 over the location that the pointer points to. This is, for example, the
1431 tip of the arrow or the center of the crosshairs.
1432 This will always be nil for a non-pointer image instance.
1436 CHECK_IMAGE_INSTANCE (image_instance);
1438 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1440 case IMAGE_MONO_PIXMAP:
1441 case IMAGE_COLOR_PIXMAP:
1443 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1450 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1451 Return the foreground color of IMAGE-INSTANCE, if applicable.
1452 This will be a color instance or nil. (It will only be non-nil for
1453 colorized mono pixmaps and for pointers.)
1457 CHECK_IMAGE_INSTANCE (image_instance);
1459 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1461 case IMAGE_MONO_PIXMAP:
1462 case IMAGE_COLOR_PIXMAP:
1464 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1467 return FACE_FOREGROUND (
1468 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1469 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1477 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1478 Return the background color of IMAGE-INSTANCE, if applicable.
1479 This will be a color instance or nil. (It will only be non-nil for
1480 colorized mono pixmaps and for pointers.)
1484 CHECK_IMAGE_INSTANCE (image_instance);
1486 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1488 case IMAGE_MONO_PIXMAP:
1489 case IMAGE_COLOR_PIXMAP:
1491 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1494 return FACE_BACKGROUND (
1495 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1496 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1505 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1506 Make the image instance be displayed in the given colors.
1507 This function returns a new image instance that is exactly like the
1508 specified one except that (if possible) the foreground and background
1509 colors and as specified. Currently, this only does anything if the image
1510 instance is a mono pixmap; otherwise, the same image instance is returned.
1512 (image_instance, foreground, background))
1517 CHECK_IMAGE_INSTANCE (image_instance);
1518 CHECK_COLOR_INSTANCE (foreground);
1519 CHECK_COLOR_INSTANCE (background);
1521 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1522 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1523 return image_instance;
1525 new = allocate_image_instance (device);
1526 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1527 /* note that if this method returns non-zero, this method MUST
1528 copy any window-system resources, so that when one image instance is
1529 freed, the other one is not hosed. */
1530 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1532 return image_instance;
1537 /************************************************************************/
1539 /************************************************************************/
1541 signal_image_error (CONST char *reason, Lisp_Object frob)
1543 signal_error (Qimage_conversion_error,
1544 list2 (build_translated_string (reason), frob));
1548 signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1)
1550 signal_error (Qimage_conversion_error,
1551 list3 (build_translated_string (reason), frob0, frob1));
1554 /****************************************************************************
1556 ****************************************************************************/
1559 nothing_possible_dest_types (void)
1561 return IMAGE_NOTHING_MASK;
1565 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1566 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1567 int dest_mask, Lisp_Object domain)
1569 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1571 if (dest_mask & IMAGE_NOTHING_MASK)
1572 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1574 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1578 /****************************************************************************
1580 ****************************************************************************/
1583 inherit_validate (Lisp_Object instantiator)
1585 face_must_be_present (instantiator);
1589 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1593 assert (XVECTOR_LENGTH (inst) == 3);
1594 face = XVECTOR_DATA (inst)[2];
1596 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1601 inherit_possible_dest_types (void)
1603 return IMAGE_MONO_PIXMAP_MASK;
1607 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1608 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1609 int dest_mask, Lisp_Object domain)
1611 /* handled specially in image_instantiate */
1616 /****************************************************************************
1618 ****************************************************************************/
1621 string_validate (Lisp_Object instantiator)
1623 data_must_be_present (instantiator);
1627 string_possible_dest_types (void)
1629 return IMAGE_TEXT_MASK;
1632 /* called from autodetect_instantiate() */
1634 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1635 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1636 int dest_mask, Lisp_Object domain)
1638 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1639 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1641 assert (!NILP (data));
1642 if (dest_mask & IMAGE_TEXT_MASK)
1644 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1645 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1648 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1652 /****************************************************************************
1653 * formatted-string *
1654 ****************************************************************************/
1657 formatted_string_validate (Lisp_Object instantiator)
1659 data_must_be_present (instantiator);
1663 formatted_string_possible_dest_types (void)
1665 return IMAGE_TEXT_MASK;
1669 formatted_string_instantiate (Lisp_Object image_instance,
1670 Lisp_Object instantiator,
1671 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1672 int dest_mask, Lisp_Object domain)
1674 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1675 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1677 assert (!NILP (data));
1678 /* #### implement this */
1679 warn_when_safe (Qunimplemented, Qnotice,
1680 "`formatted-string' not yet implemented; assuming `string'");
1681 if (dest_mask & IMAGE_TEXT_MASK)
1683 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1684 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1687 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1691 /************************************************************************/
1692 /* pixmap file functions */
1693 /************************************************************************/
1695 /* If INSTANTIATOR refers to inline data, return Qnil.
1696 If INSTANTIATOR refers to data in a file, return the full filename
1697 if it exists; otherwise, return a cons of (filename).
1699 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
1700 keywords used to look up the file and inline data,
1701 respectively, in the instantiator. Normally these would
1702 be Q_file and Q_data, but might be different for mask data. */
1705 potential_pixmap_file_instantiator (Lisp_Object instantiator,
1706 Lisp_Object file_keyword,
1707 Lisp_Object data_keyword,
1708 Lisp_Object console_type)
1713 assert (VECTORP (instantiator));
1715 data = find_keyword_in_vector (instantiator, data_keyword);
1716 file = find_keyword_in_vector (instantiator, file_keyword);
1718 if (!NILP (file) && NILP (data))
1720 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
1721 (decode_console_type(console_type, ERROR_ME),
1722 locate_pixmap_file, (file));
1727 return Fcons (file, Qnil); /* should have been file */
1734 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
1735 Lisp_Object image_type_tag)
1737 /* This function can call lisp */
1738 Lisp_Object file = Qnil;
1739 struct gcpro gcpro1, gcpro2;
1740 Lisp_Object alist = Qnil;
1742 GCPRO2 (file, alist);
1744 /* Now, convert any file data into inline data. At the end of this,
1745 `data' will contain the inline data (if any) or Qnil, and `file'
1746 will contain the name this data was derived from (if known) or
1749 Note that if we cannot generate any regular inline data, we
1752 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1755 if (CONSP (file)) /* failure locating filename */
1756 signal_double_file_error ("Opening pixmap file",
1757 "no such file or directory",
1760 if (NILP (file)) /* no conversion necessary */
1761 RETURN_UNGCPRO (inst);
1763 alist = tagged_vector_to_alist (inst);
1766 Lisp_Object data = make_string_from_file (file);
1767 alist = remassq_no_quit (Q_file, alist);
1768 /* there can't be a :data at this point. */
1769 alist = Fcons (Fcons (Q_file, file),
1770 Fcons (Fcons (Q_data, data), alist));
1774 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
1776 RETURN_UNGCPRO (result);
1781 #ifdef HAVE_WINDOW_SYSTEM
1782 /**********************************************************************
1784 **********************************************************************/
1786 /* Check if DATA represents a valid inline XBM spec (i.e. a list
1787 of (width height bits), with checking done on the dimensions).
1788 If not, signal an error. */
1791 check_valid_xbm_inline (Lisp_Object data)
1793 Lisp_Object width, height, bits;
1795 if (!CONSP (data) ||
1796 !CONSP (XCDR (data)) ||
1797 !CONSP (XCDR (XCDR (data))) ||
1798 !NILP (XCDR (XCDR (XCDR (data)))))
1799 signal_simple_error ("Must be list of 3 elements", data);
1801 width = XCAR (data);
1802 height = XCAR (XCDR (data));
1803 bits = XCAR (XCDR (XCDR (data)));
1805 CHECK_STRING (bits);
1807 if (!NATNUMP (width))
1808 signal_simple_error ("Width must be a natural number", width);
1810 if (!NATNUMP (height))
1811 signal_simple_error ("Height must be a natural number", height);
1813 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
1814 signal_simple_error ("data is too short for width and height",
1815 vector3 (width, height, bits));
1818 /* Validate method for XBM's. */
1821 xbm_validate (Lisp_Object instantiator)
1823 file_or_data_must_be_present (instantiator);
1826 /* Given a filename that is supposed to contain XBM data, return
1827 the inline representation of it as (width height bits). Return
1828 the hotspot through XHOT and YHOT, if those pointers are not 0.
1829 If there is no hotspot, XHOT and YHOT will contain -1.
1831 If the function fails:
1833 -- if OK_IF_DATA_INVALID is set and the data was invalid,
1835 -- maybe return an error, or return Qnil.
1838 #ifdef HAVE_X_WINDOWS
1839 #include <X11/Xlib.h>
1841 #define XFree(data) free(data)
1845 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
1846 int ok_if_data_invalid)
1851 CONST char *filename_ext;
1853 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
1854 result = read_bitmap_data_from_file (filename_ext, &w, &h,
1857 if (result == BitmapSuccess)
1860 int len = (w + 7) / 8 * h;
1862 retval = list3 (make_int (w), make_int (h),
1863 make_ext_string (data, len, FORMAT_BINARY));
1864 XFree ((char *) data);
1870 case BitmapOpenFailed:
1872 /* should never happen */
1873 signal_double_file_error ("Opening bitmap file",
1874 "no such file or directory",
1877 case BitmapFileInvalid:
1879 if (ok_if_data_invalid)
1881 signal_double_file_error ("Reading bitmap file",
1882 "invalid data in file",
1885 case BitmapNoMemory:
1887 signal_double_file_error ("Reading bitmap file",
1893 signal_double_file_error_2 ("Reading bitmap file",
1894 "unknown error code",
1895 make_int (result), name);
1899 return Qnil; /* not reached */
1903 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
1904 Lisp_Object mask_file, Lisp_Object console_type)
1906 /* This is unclean but it's fairly standard -- a number of the
1907 bitmaps in /usr/include/X11/bitmaps use it -- so we support
1909 if (NILP (mask_file)
1910 /* don't override explicitly specified mask data. */
1911 && NILP (assq_no_quit (Q_mask_data, alist))
1914 mask_file = MAYBE_LISP_CONTYPE_METH
1915 (decode_console_type(console_type, ERROR_ME),
1916 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
1917 if (NILP (mask_file))
1918 mask_file = MAYBE_LISP_CONTYPE_METH
1919 (decode_console_type(console_type, ERROR_ME),
1920 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
1923 if (!NILP (mask_file))
1925 Lisp_Object mask_data =
1926 bitmap_to_lisp_data (mask_file, 0, 0, 0);
1927 alist = remassq_no_quit (Q_mask_file, alist);
1928 /* there can't be a :mask-data at this point. */
1929 alist = Fcons (Fcons (Q_mask_file, mask_file),
1930 Fcons (Fcons (Q_mask_data, mask_data), alist));
1936 /* Normalize method for XBM's. */
1939 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
1941 Lisp_Object file = Qnil, mask_file = Qnil;
1942 struct gcpro gcpro1, gcpro2, gcpro3;
1943 Lisp_Object alist = Qnil;
1945 GCPRO3 (file, mask_file, alist);
1947 /* Now, convert any file data into inline data for both the regular
1948 data and the mask data. At the end of this, `data' will contain
1949 the inline data (if any) or Qnil, and `file' will contain
1950 the name this data was derived from (if known) or Qnil.
1951 Likewise for `mask_file' and `mask_data'.
1953 Note that if we cannot generate any regular inline data, we
1956 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1958 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
1959 Q_mask_data, console_type);
1961 if (CONSP (file)) /* failure locating filename */
1962 signal_double_file_error ("Opening bitmap file",
1963 "no such file or directory",
1966 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
1967 RETURN_UNGCPRO (inst);
1969 alist = tagged_vector_to_alist (inst);
1974 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
1975 alist = remassq_no_quit (Q_file, alist);
1976 /* there can't be a :data at this point. */
1977 alist = Fcons (Fcons (Q_file, file),
1978 Fcons (Fcons (Q_data, data), alist));
1980 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
1981 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1983 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
1984 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1988 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
1991 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1993 RETURN_UNGCPRO (result);
1999 xbm_possible_dest_types (void)
2002 IMAGE_MONO_PIXMAP_MASK |
2003 IMAGE_COLOR_PIXMAP_MASK |
2011 /**********************************************************************
2013 **********************************************************************/
2016 xface_validate (Lisp_Object instantiator)
2018 file_or_data_must_be_present (instantiator);
2022 xface_normalize (Lisp_Object inst, Lisp_Object console_type)
2024 /* This function can call lisp */
2025 Lisp_Object file = Qnil, mask_file = Qnil;
2026 struct gcpro gcpro1, gcpro2, gcpro3;
2027 Lisp_Object alist = Qnil;
2029 GCPRO3 (file, mask_file, alist);
2031 /* Now, convert any file data into inline data for both the regular
2032 data and the mask data. At the end of this, `data' will contain
2033 the inline data (if any) or Qnil, and `file' will contain
2034 the name this data was derived from (if known) or Qnil.
2035 Likewise for `mask_file' and `mask_data'.
2037 Note that if we cannot generate any regular inline data, we
2040 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2042 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2043 Q_mask_data, console_type);
2045 if (CONSP (file)) /* failure locating filename */
2046 signal_double_file_error ("Opening bitmap file",
2047 "no such file or directory",
2050 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2051 RETURN_UNGCPRO (inst);
2053 alist = tagged_vector_to_alist (inst);
2056 Lisp_Object data = make_string_from_file (file);
2057 alist = remassq_no_quit (Q_file, alist);
2058 /* there can't be a :data at this point. */
2059 alist = Fcons (Fcons (Q_file, file),
2060 Fcons (Fcons (Q_data, data), alist));
2063 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2066 Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2068 RETURN_UNGCPRO (result);
2073 xface_possible_dest_types (void)
2076 IMAGE_MONO_PIXMAP_MASK |
2077 IMAGE_COLOR_PIXMAP_MASK |
2081 #endif /* HAVE_XFACE */
2086 /**********************************************************************
2088 **********************************************************************/
2091 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2097 GET_C_STRING_FILENAME_DATA_ALLOCA (name, fname);
2098 result = XpmReadFileToData (fname, &data);
2100 if (result == XpmSuccess)
2102 Lisp_Object retval = Qnil;
2103 struct buffer *old_buffer = current_buffer;
2104 Lisp_Object temp_buffer =
2105 Fget_buffer_create (build_string (" *pixmap conversion*"));
2107 int height, width, ncolors;
2108 struct gcpro gcpro1, gcpro2, gcpro3;
2109 int speccount = specpdl_depth ();
2111 GCPRO3 (name, retval, temp_buffer);
2113 specbind (Qinhibit_quit, Qt);
2114 set_buffer_internal (XBUFFER (temp_buffer));
2115 Ferase_buffer (Qnil);
2117 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2118 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2120 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2121 for (elt = 0; elt <= width + ncolors; elt++)
2123 buffer_insert_c_string (current_buffer, "\"");
2124 buffer_insert_c_string (current_buffer, data[elt]);
2126 if (elt < width + ncolors)
2127 buffer_insert_c_string (current_buffer, "\",\r");
2129 buffer_insert_c_string (current_buffer, "\"};\r");
2132 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2135 set_buffer_internal (old_buffer);
2136 unbind_to (speccount, Qnil);
2138 RETURN_UNGCPRO (retval);
2143 case XpmFileInvalid:
2145 if (ok_if_data_invalid)
2147 signal_image_error ("invalid XPM data in file", name);
2151 signal_double_file_error ("Reading pixmap file",
2152 "out of memory", name);
2156 /* should never happen? */
2157 signal_double_file_error ("Opening pixmap file",
2158 "no such file or directory", name);
2162 signal_double_file_error_2 ("Parsing pixmap file",
2163 "unknown error code",
2164 make_int (result), name);
2169 return Qnil; /* not reached */
2173 check_valid_xpm_color_symbols (Lisp_Object data)
2177 for (rest = data; !NILP (rest); rest = XCDR (rest))
2179 if (!CONSP (rest) ||
2180 !CONSP (XCAR (rest)) ||
2181 !STRINGP (XCAR (XCAR (rest))) ||
2182 (!STRINGP (XCDR (XCAR (rest))) &&
2183 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2184 signal_simple_error ("Invalid color symbol alist", data);
2189 xpm_validate (Lisp_Object instantiator)
2191 file_or_data_must_be_present (instantiator);
2194 Lisp_Object Vxpm_color_symbols;
2197 evaluate_xpm_color_symbols (void)
2199 Lisp_Object rest, results = Qnil;
2200 struct gcpro gcpro1, gcpro2;
2202 GCPRO2 (rest, results);
2203 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2205 Lisp_Object name, value, cons;
2211 CHECK_STRING (name);
2212 value = XCDR (cons);
2214 value = XCAR (value);
2215 value = Feval (value);
2218 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2220 ("Result from xpm-color-symbols eval must be nil, string, or color",
2222 results = Fcons (Fcons (name, value), results);
2224 UNGCPRO; /* no more evaluation */
2229 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2231 Lisp_Object file = Qnil;
2232 Lisp_Object color_symbols;
2233 struct gcpro gcpro1, gcpro2;
2234 Lisp_Object alist = Qnil;
2236 GCPRO2 (file, alist);
2238 /* Now, convert any file data into inline data. At the end of this,
2239 `data' will contain the inline data (if any) or Qnil, and
2240 `file' will contain the name this data was derived from (if
2243 Note that if we cannot generate any regular inline data, we
2246 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2249 if (CONSP (file)) /* failure locating filename */
2250 signal_double_file_error ("Opening pixmap file",
2251 "no such file or directory",
2254 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2257 if (NILP (file) && !UNBOUNDP (color_symbols))
2258 /* no conversion necessary */
2259 RETURN_UNGCPRO (inst);
2261 alist = tagged_vector_to_alist (inst);
2265 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2266 alist = remassq_no_quit (Q_file, alist);
2267 /* there can't be a :data at this point. */
2268 alist = Fcons (Fcons (Q_file, file),
2269 Fcons (Fcons (Q_data, data), alist));
2272 if (UNBOUNDP (color_symbols))
2274 color_symbols = evaluate_xpm_color_symbols ();
2275 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2280 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2282 RETURN_UNGCPRO (result);
2287 xpm_possible_dest_types (void)
2290 IMAGE_MONO_PIXMAP_MASK |
2291 IMAGE_COLOR_PIXMAP_MASK |
2295 #endif /* HAVE_XPM */
2298 /****************************************************************************
2299 * Image Specifier Object *
2300 ****************************************************************************/
2302 DEFINE_SPECIFIER_TYPE (image);
2305 image_create (Lisp_Object obj)
2307 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2309 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2310 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2311 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2315 image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
2317 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2319 markobj (IMAGE_SPECIFIER_ATTACHEE (image));
2320 markobj (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2324 image_instantiate_cache_result (Lisp_Object locative)
2326 /* locative = (instance instantiator . subtable) */
2327 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2328 free_cons (XCONS (XCDR (locative)));
2329 free_cons (XCONS (locative));
2333 /* Given a specification for an image, return an instance of
2334 the image which matches the given instantiator and which can be
2335 displayed in the given domain. */
2338 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2339 Lisp_Object domain, Lisp_Object instantiator,
2342 Lisp_Object device = DFW_DEVICE (domain);
2343 struct device *d = XDEVICE (device);
2344 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2345 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2347 if (IMAGE_INSTANCEP (instantiator))
2349 /* make sure that the image instance's device and type are
2352 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2355 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2356 if (mask & dest_mask)
2357 return instantiator;
2359 signal_simple_error ("Type of image instance not allowed here",
2363 signal_simple_error_2 ("Wrong device for image instance",
2364 instantiator, device);
2366 else if (VECTORP (instantiator)
2367 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2369 assert (XVECTOR_LENGTH (instantiator) == 3);
2370 return (FACE_PROPERTY_INSTANCE
2371 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2372 Qbackground_pixmap, domain, 0, depth));
2376 Lisp_Object instance;
2377 Lisp_Object subtable;
2378 Lisp_Object ls3 = Qnil;
2379 Lisp_Object pointer_fg = Qnil;
2380 Lisp_Object pointer_bg = Qnil;
2384 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2385 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2386 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2389 /* First look in the hash table. */
2390 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2392 if (UNBOUNDP (subtable))
2394 /* For the image instance cache, we do comparisons with EQ rather
2395 than with EQUAL, as we do for color and font names.
2398 1) pixmap data can be very long, and thus the hashing and
2399 comparing will take awhile.
2400 2) It's not so likely that we'll run into things that are EQUAL
2401 but not EQ (that can happen a lot with faces, because their
2402 specifiers are copied around); but pixmaps tend not to be
2405 However, if the image-instance could be a pointer, we have to
2406 use EQUAL because we massaged the instantiator into a cons3
2407 also containing the foreground and background of the
2411 subtable = make_lisp_hash_table (20,
2412 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2413 : HASH_TABLE_KEY_WEAK,
2414 pointerp ? HASH_TABLE_EQUAL
2416 Fputhash (make_int (dest_mask), subtable,
2417 d->image_instance_cache);
2418 instance = Qunbound;
2422 instance = Fgethash (pointerp ? ls3 : instantiator,
2423 subtable, Qunbound);
2424 /* subwindows have a per-window cache and have to be treated
2425 differently. dest_mask can be a bitwise OR of all image
2426 types so we will only catch someone possibly trying to
2427 instantiate a subwindow type thing. Unfortunately, this
2428 will occur most of the time so this probably slows things
2429 down. But with the current design I don't see anyway
2431 if (UNBOUNDP (instance)
2433 dest_mask & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2435 if (!WINDOWP (domain))
2436 signal_simple_error ("Can't instantiate subwindow outside a window",
2438 instance = Fgethash (instantiator,
2439 XWINDOW (domain)->subwindow_instance_cache,
2444 if (UNBOUNDP (instance))
2446 Lisp_Object locative =
2448 noseeum_cons (pointerp ? ls3 : instantiator,
2450 int speccount = specpdl_depth ();
2452 /* make sure we cache the failures, too.
2453 Use an unwind-protect to catch such errors.
2454 If we fail, the unwind-protect records nil in
2455 the hash table. If we succeed, we change the
2456 car of the locative to the resulting instance,
2457 which gets recorded instead. */
2458 record_unwind_protect (image_instantiate_cache_result,
2460 instance = instantiate_image_instantiator (device,
2463 pointer_fg, pointer_bg,
2466 Fsetcar (locative, instance);
2467 /* only after the image has been instantiated do we know
2468 whether we need to put it in the per-window image instance
2470 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2472 (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2474 if (!WINDOWP (domain))
2475 signal_simple_error ("Can't instantiate subwindow outside a window",
2478 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache );
2480 unbind_to (speccount, Qnil);
2485 if (NILP (instance))
2486 signal_simple_error ("Can't instantiate image (probably cached)",
2492 return Qnil; /* not reached */
2495 /* Validate an image instantiator. */
2498 image_validate (Lisp_Object instantiator)
2500 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2502 else if (VECTORP (instantiator))
2504 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2505 int instantiator_len = XVECTOR_LENGTH (instantiator);
2506 struct image_instantiator_methods *meths;
2507 Lisp_Object already_seen = Qnil;
2508 struct gcpro gcpro1;
2511 if (instantiator_len < 1)
2512 signal_simple_error ("Vector length must be at least 1",
2515 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2516 if (!(instantiator_len & 1))
2518 ("Must have alternating keyword/value pairs", instantiator);
2520 GCPRO1 (already_seen);
2522 for (i = 1; i < instantiator_len; i += 2)
2524 Lisp_Object keyword = elt[i];
2525 Lisp_Object value = elt[i+1];
2528 CHECK_SYMBOL (keyword);
2529 if (!SYMBOL_IS_KEYWORD (keyword))
2530 signal_simple_error ("Symbol must begin with a colon", keyword);
2532 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2533 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2536 if (j == Dynarr_length (meths->keywords))
2537 signal_simple_error ("Unrecognized keyword", keyword);
2539 if (!Dynarr_at (meths->keywords, j).multiple_p)
2541 if (!NILP (memq_no_quit (keyword, already_seen)))
2543 ("Keyword may not appear more than once", keyword);
2544 already_seen = Fcons (keyword, already_seen);
2547 (Dynarr_at (meths->keywords, j).validate) (value);
2552 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2555 signal_simple_error ("Must be string or vector", instantiator);
2559 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2561 Lisp_Object attachee =
2562 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2563 Lisp_Object property =
2564 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2565 if (FACEP (attachee))
2566 face_property_was_changed (attachee, property, locale);
2567 else if (GLYPHP (attachee))
2568 glyph_property_was_changed (attachee, property, locale);
2572 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2573 Lisp_Object property)
2575 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2577 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2578 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2582 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2583 Lisp_Object tag_set, Lisp_Object instantiator)
2585 Lisp_Object possible_console_types = Qnil;
2587 Lisp_Object retlist = Qnil;
2588 struct gcpro gcpro1, gcpro2;
2590 LIST_LOOP (rest, Vconsole_type_list)
2592 Lisp_Object contype = XCAR (rest);
2593 if (!NILP (memq_no_quit (contype, tag_set)))
2594 possible_console_types = Fcons (contype, possible_console_types);
2597 if (XINT (Flength (possible_console_types)) > 1)
2598 /* two conflicting console types specified */
2601 if (NILP (possible_console_types))
2602 possible_console_types = Vconsole_type_list;
2604 GCPRO2 (retlist, possible_console_types);
2606 LIST_LOOP (rest, possible_console_types)
2608 Lisp_Object contype = XCAR (rest);
2609 Lisp_Object newinst = call_with_suspended_errors
2610 ((lisp_fn_t) normalize_image_instantiator,
2611 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2612 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2614 if (!NILP (newinst))
2617 if (NILP (memq_no_quit (contype, tag_set)))
2618 newtag = Fcons (contype, tag_set);
2621 retlist = Fcons (Fcons (newtag, newinst), retlist);
2630 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
2631 Return non-nil if OBJECT is an image specifier.
2633 An image specifier is used for images (pixmaps and the like). It is used
2634 to describe the actual image in a glyph. It is instanced as an image-
2637 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
2638 etc. This describes the format of the data describing the image. The
2639 resulting image instances also come in many types -- `mono-pixmap',
2640 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
2641 the image and the sorts of places it can appear. (For example, a
2642 color-pixmap image has fixed colors specified for it, while a
2643 mono-pixmap image comes in two unspecified shades "foreground" and
2644 "background" that are determined from the face of the glyph or
2645 surrounding text; a text image appears as a string of text and has an
2646 unspecified foreground, background, and font; a pointer image behaves
2647 like a mono-pixmap image but can only be used as a mouse pointer
2648 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
2649 important to keep the distinction between image instantiator format and
2650 image instance type in mind. Typically, a given image instantiator
2651 format can result in many different image instance types (for example,
2652 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
2653 whereas `cursor-font' can be instanced only as `pointer'), and a
2654 particular image instance type can be generated by many different
2655 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
2656 `gif', `jpeg', etc.).
2658 See `make-image-instance' for a more detailed discussion of image
2661 An image instantiator should be a string or a vector of the form
2663 [FORMAT :KEYWORD VALUE ...]
2665 i.e. a format symbol followed by zero or more alternating keyword-value
2666 pairs. FORMAT should be one of
2669 (Don't display anything; no keywords are valid for this.
2670 Can only be instanced as `nothing'.)
2672 (Display this image as a text string. Can only be instanced
2673 as `text', although support for instancing as `mono-pixmap'
2676 (Display this image as a text string, with replaceable fields;
2677 not currently implemented.)
2679 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
2680 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2682 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
2683 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
2685 (An X-Face bitmap, used to encode people's faces in e-mail messages;
2686 only if X-Face support was compiled into this XEmacs. Can be
2687 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2689 (A GIF87 or GIF89 image; only if GIF support was compiled into this
2690 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
2691 Can be instanced as `color-pixmap'.)
2693 (A JPEG image; only if JPEG support was compiled into this XEmacs.
2694 Can be instanced as `color-pixmap'.)
2696 (A PNG image; only if PNG support was compiled into this XEmacs.
2697 Can be instanced as `color-pixmap'.)
2699 (A TIFF image; only if TIFF support was compiled into this XEmacs.
2700 Can be instanced as `color-pixmap'.)
2702 (One of the standard cursor-font names, such as "watch" or
2703 "right_ptr" under X. Under X, this is, more specifically, any
2704 of the standard cursor names from appendix B of the Xlib manual
2705 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
2706 On other window systems, the valid names will be specific to the
2707 type of window system. Can only be instanced as `pointer'.)
2709 (A glyph from a font; i.e. the name of a font, and glyph index into it
2710 of the form "FONT fontname index [[mask-font] mask-index]".
2711 Currently can only be instanced as `pointer', although this should
2714 (An embedded X window; not currently implemented.)
2716 (A widget control, for instance text field or radio button.)
2718 (XEmacs tries to guess what format the data is in. If X support
2719 exists, the data string will be checked to see if it names a filename.
2720 If so, and this filename contains XBM or XPM data, the appropriate
2721 sort of pixmap or pointer will be created. [This includes picking up
2722 any specified hotspot or associated mask file.] Otherwise, if `pointer'
2723 is one of the allowable image-instance types and the string names a
2724 valid cursor-font name, the image will be created as a pointer.
2725 Otherwise, the image will be displayed as text. If no X support
2726 exists, the image will always be displayed as text.)
2728 Inherit from the background-pixmap property of a face.
2730 The valid keywords are:
2733 (Inline data. For most formats above, this should be a string. For
2734 XBM images, this should be a list of three elements: width, height, and
2735 a string of bit data. This keyword is not valid for instantiator
2736 formats `nothing' and `inherit'.)
2738 (Data is contained in a file. The value is the name of this file.
2739 If both :data and :file are specified, the image is created from
2740 what is specified in :data and the string in :file becomes the
2741 value of the `image-instance-file-name' function when applied to
2742 the resulting image-instance. This keyword is not valid for
2743 instantiator formats `nothing', `string', `formatted-string',
2744 `cursor-font', `font', `autodetect', and `inherit'.)
2747 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
2748 allow you to explicitly specify foreground and background colors.
2749 The argument should be anything acceptable to `make-color-instance'.
2750 This will cause what would be a `mono-pixmap' to instead be colorized
2751 as a two-color color-pixmap, and specifies the foreground and/or
2752 background colors for a pointer instead of black and white.)
2754 (For `xbm' and `xface'. This specifies a mask to be used with the
2755 bitmap. The format is a list of width, height, and bits, like for
2758 (For `xbm' and `xface'. This specifies a file containing the mask data.
2759 If neither a mask file nor inline mask data is given for an XBM image,
2760 and the XBM image comes from a file, XEmacs will look for a mask file
2761 with the same name as the image file but with "Mask" or "msk"
2762 appended. For example, if you specify the XBM file "left_ptr"
2763 [usually located in "/usr/include/X11/bitmaps"], the associated
2764 mask file "left_ptrmsk" will automatically be picked up.)
2767 (For `xbm' and `xface'. These keywords specify a hotspot if the image
2768 is instantiated as a `pointer'. Note that if the XBM image file
2769 specifies a hotspot, it will automatically be picked up if no
2770 explicit hotspot is given.)
2772 (Only for `xpm'. This specifies an alist that maps strings
2773 that specify symbolic color names to the actual color to be used
2774 for that symbolic color (in the form of a string or a color-specifier
2775 object). If this is not specified, the contents of `xpm-color-symbols'
2776 are used to generate the alist.)
2778 (Only for `inherit'. This specifies the face to inherit from.)
2780 If instead of a vector, the instantiator is a string, it will be
2781 converted into a vector by looking it up according to the specs in the
2782 `console-type-image-conversion-list' (q.v.) for the console type of
2783 the domain (usually a window; sometimes a frame or device) over which
2784 the image is being instantiated.
2786 If the instantiator specifies data from a file, the data will be read
2787 in at the time that the instantiator is added to the image (which may
2788 be well before when the image is actually displayed), and the
2789 instantiator will be converted into one of the inline-data forms, with
2790 the filename retained using a :file keyword. This implies that the
2791 file must exist when the instantiator is added to the image, but does
2792 not need to exist at any other time (e.g. it may safely be a temporary
2797 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
2801 /****************************************************************************
2803 ****************************************************************************/
2806 mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object))
2808 struct Lisp_Glyph *glyph = XGLYPH (obj);
2810 markobj (glyph->image);
2811 markobj (glyph->contrib_p);
2812 markobj (glyph->baseline);
2813 markobj (glyph->face);
2815 return glyph->plist;
2819 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2821 struct Lisp_Glyph *glyph = XGLYPH (obj);
2825 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
2827 write_c_string ("#<glyph (", printcharfun);
2828 print_internal (Fglyph_type (obj), printcharfun, 0);
2829 write_c_string (") ", printcharfun);
2830 print_internal (glyph->image, printcharfun, 1);
2831 sprintf (buf, "0x%x>", glyph->header.uid);
2832 write_c_string (buf, printcharfun);
2835 /* Glyphs are equal if all of their display attributes are equal. We
2836 don't compare names or doc-strings, because that would make equal
2839 This isn't concerned with "unspecified" attributes, that's what
2840 #'glyph-differs-from-default-p is for. */
2842 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
2844 struct Lisp_Glyph *g1 = XGLYPH (obj1);
2845 struct Lisp_Glyph *g2 = XGLYPH (obj2);
2849 return (internal_equal (g1->image, g2->image, depth) &&
2850 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
2851 internal_equal (g1->baseline, g2->baseline, depth) &&
2852 internal_equal (g1->face, g2->face, depth) &&
2853 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
2856 static unsigned long
2857 glyph_hash (Lisp_Object obj, int depth)
2861 /* No need to hash all of the elements; that would take too long.
2862 Just hash the most common ones. */
2863 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
2864 internal_hash (XGLYPH (obj)->face, depth));
2868 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
2870 struct Lisp_Glyph *g = XGLYPH (obj);
2872 if (EQ (prop, Qimage)) return g->image;
2873 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
2874 if (EQ (prop, Qbaseline)) return g->baseline;
2875 if (EQ (prop, Qface)) return g->face;
2877 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
2881 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
2883 if ((EQ (prop, Qimage)) ||
2884 (EQ (prop, Qcontrib_p)) ||
2885 (EQ (prop, Qbaseline)))
2888 if (EQ (prop, Qface))
2890 XGLYPH (obj)->face = Fget_face (value);
2894 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
2899 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
2901 if ((EQ (prop, Qimage)) ||
2902 (EQ (prop, Qcontrib_p)) ||
2903 (EQ (prop, Qbaseline)))
2906 if (EQ (prop, Qface))
2908 XGLYPH (obj)->face = Qnil;
2912 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
2916 glyph_plist (Lisp_Object obj)
2918 struct Lisp_Glyph *glyph = XGLYPH (obj);
2919 Lisp_Object result = glyph->plist;
2921 result = cons3 (Qface, glyph->face, result);
2922 result = cons3 (Qbaseline, glyph->baseline, result);
2923 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
2924 result = cons3 (Qimage, glyph->image, result);
2929 static const struct lrecord_description glyph_description[] = {
2930 { XD_LISP_OBJECT, offsetof(struct Lisp_Glyph, image), 5 },
2934 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
2935 mark_glyph, print_glyph, 0,
2936 glyph_equal, glyph_hash, glyph_description,
2937 glyph_getprop, glyph_putprop,
2938 glyph_remprop, glyph_plist,
2942 allocate_glyph (enum glyph_type type,
2943 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
2944 Lisp_Object locale))
2946 /* This function can GC */
2947 Lisp_Object obj = Qnil;
2948 struct Lisp_Glyph *g =
2949 alloc_lcrecord_type (struct Lisp_Glyph, &lrecord_glyph);
2952 g->image = Fmake_specifier (Qimage); /* This function can GC */
2956 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2957 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
2958 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
2959 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK;
2962 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2963 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
2966 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2967 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK;
2973 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
2974 /* We're getting enough reports of odd behavior in this area it seems */
2975 /* best to GCPRO everything. */
2977 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
2978 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
2979 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
2980 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2982 GCPRO4 (obj, tem1, tem2, tem3);
2984 set_specifier_fallback (g->image, tem1);
2985 g->contrib_p = Fmake_specifier (Qboolean);
2986 set_specifier_fallback (g->contrib_p, tem2);
2987 /* #### should have a specifier for the following */
2988 g->baseline = Fmake_specifier (Qgeneric);
2989 set_specifier_fallback (g->baseline, tem3);
2992 g->after_change = after_change;
2995 set_image_attached_to (g->image, obj, Qimage);
3002 static enum glyph_type
3003 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3006 return GLYPH_BUFFER;
3008 if (ERRB_EQ (errb, ERROR_ME))
3009 CHECK_SYMBOL (type);
3011 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3012 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3013 if (EQ (type, Qicon)) return GLYPH_ICON;
3015 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3017 return GLYPH_UNKNOWN;
3021 valid_glyph_type_p (Lisp_Object type)
3023 return !NILP (memq_no_quit (type, Vglyph_type_list));
3026 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3027 Given a GLYPH-TYPE, return non-nil if it is valid.
3028 Valid types are `buffer', `pointer', and `icon'.
3032 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3035 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3036 Return a list of valid glyph types.
3040 return Fcopy_sequence (Vglyph_type_list);
3043 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3044 Create and return a new uninitialized glyph or type TYPE.
3046 TYPE specifies the type of the glyph; this should be one of `buffer',
3047 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3048 specifies in which contexts the glyph can be used, and controls the
3049 allowable image types into which the glyph's image can be
3052 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3053 extent, in the modeline, and in the toolbar. Their image can be
3054 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3057 `pointer' glyphs can be used to specify the mouse pointer. Their
3058 image can be instantiated as `pointer'.
3060 `icon' glyphs can be used to specify the icon used when a frame is
3061 iconified. Their image can be instantiated as `mono-pixmap' and
3066 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3067 return allocate_glyph (typeval, 0);
3070 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3071 Return non-nil if OBJECT is a glyph.
3073 A glyph is an object used for pixmaps and the like. It is used
3074 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3075 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3076 buttons, and the like. Its image is described using an image specifier --
3077 see `image-specifier-p'.
3081 return GLYPHP (object) ? Qt : Qnil;
3084 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3085 Return the type of the given glyph.
3086 The return value will be one of 'buffer, 'pointer, or 'icon.
3090 CHECK_GLYPH (glyph);
3091 switch (XGLYPH_TYPE (glyph))
3094 case GLYPH_BUFFER: return Qbuffer;
3095 case GLYPH_POINTER: return Qpointer;
3096 case GLYPH_ICON: return Qicon;
3100 /*****************************************************************************
3103 Return the width of the given GLYPH on the given WINDOW. If the
3104 instance is a string then the width is calculated using the font of
3105 the given FACE, unless a face is defined by the glyph itself.
3106 ****************************************************************************/
3108 glyph_width (Lisp_Object glyph, Lisp_Object frame_face,
3109 face_index window_findex, Lisp_Object window)
3111 Lisp_Object instance;
3112 Lisp_Object frame = XWINDOW (window)->frame;
3114 /* #### We somehow need to distinguish between the user causing this
3115 error condition and a bug causing it. */
3116 if (!GLYPHP (glyph))
3119 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3121 if (!IMAGE_INSTANCEP (instance))
3124 switch (XIMAGE_INSTANCE_TYPE (instance))
3128 Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance);
3129 Lisp_Object private_face = XGLYPH_FACE(glyph);
3131 if (!NILP (private_face))
3132 return redisplay_frame_text_width_string (XFRAME (frame),
3136 if (!NILP (frame_face))
3137 return redisplay_frame_text_width_string (XFRAME (frame),
3141 return redisplay_text_width_string (XWINDOW (window),
3146 case IMAGE_MONO_PIXMAP:
3147 case IMAGE_COLOR_PIXMAP:
3149 return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance);
3154 case IMAGE_SUBWINDOW:
3156 return XIMAGE_INSTANCE_SUBWINDOW_WIDTH (instance);
3164 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3165 Return the width of GLYPH on WINDOW.
3166 This may not be exact as it does not take into account all of the context
3167 that redisplay will.
3171 XSETWINDOW (window, decode_window (window));
3172 CHECK_GLYPH (glyph);
3174 return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window));
3177 #define RETURN_ASCENT 0
3178 #define RETURN_DESCENT 1
3179 #define RETURN_HEIGHT 2
3182 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3183 Error_behavior errb, int no_quit)
3185 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3187 /* This can never return Qunbound. All glyphs have 'nothing as
3189 return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0,
3193 static unsigned short
3194 glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face,
3195 face_index window_findex, Lisp_Object window,
3198 Lisp_Object instance;
3199 Lisp_Object frame = XWINDOW (window)->frame;
3201 if (!GLYPHP (glyph))
3204 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3206 if (!IMAGE_INSTANCEP (instance))
3209 switch (XIMAGE_INSTANCE_TYPE (instance))
3213 struct font_metric_info fm;
3214 Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance);
3215 unsigned char charsets[NUM_LEADING_BYTES];
3216 struct face_cachel frame_cachel;
3217 struct face_cachel *cachel;
3219 find_charsets_in_bufbyte_string (charsets,
3220 XSTRING_DATA (string),
3221 XSTRING_LENGTH (string));
3223 if (!NILP (frame_face))
3225 reset_face_cachel (&frame_cachel);
3226 update_face_cachel_data (&frame_cachel, frame, frame_face);
3227 cachel = &frame_cachel;
3230 cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex);
3231 ensure_face_cachel_complete (cachel, window, charsets);
3233 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
3237 case RETURN_ASCENT: return fm.ascent;
3238 case RETURN_DESCENT: return fm.descent;
3239 case RETURN_HEIGHT: return fm.ascent + fm.descent;
3242 return 0; /* not reached */
3246 case IMAGE_MONO_PIXMAP:
3247 case IMAGE_COLOR_PIXMAP:
3249 /* #### Ugh ugh ugh -- temporary crap */
3250 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3251 return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance);
3258 case IMAGE_SUBWINDOW:
3260 /* #### Ugh ugh ugh -- temporary crap */
3261 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3262 return XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (instance);
3273 glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face,
3274 face_index window_findex, Lisp_Object window)
3276 return glyph_height_internal (glyph, frame_face, window_findex, window,
3281 glyph_descent (Lisp_Object glyph, Lisp_Object frame_face,
3282 face_index window_findex, Lisp_Object window)
3284 return glyph_height_internal (glyph, frame_face, window_findex, window,
3288 /* strictly a convenience function. */
3290 glyph_height (Lisp_Object glyph, Lisp_Object frame_face,
3291 face_index window_findex, Lisp_Object window)
3293 return glyph_height_internal (glyph, frame_face, window_findex, window,
3297 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3298 Return the ascent value of GLYPH on WINDOW.
3299 This may not be exact as it does not take into account all of the context
3300 that redisplay will.
3304 XSETWINDOW (window, decode_window (window));
3305 CHECK_GLYPH (glyph);
3307 return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window));
3310 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3311 Return the descent value of GLYPH on WINDOW.
3312 This may not be exact as it does not take into account all of the context
3313 that redisplay will.
3317 XSETWINDOW (window, decode_window (window));
3318 CHECK_GLYPH (glyph);
3320 return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window));
3323 /* This is redundant but I bet a lot of people expect it to exist. */
3324 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3325 Return the height of GLYPH on WINDOW.
3326 This may not be exact as it does not take into account all of the context
3327 that redisplay will.
3331 XSETWINDOW (window, decode_window (window));
3332 CHECK_GLYPH (glyph);
3334 return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window));
3337 #undef RETURN_ASCENT
3338 #undef RETURN_DESCENT
3339 #undef RETURN_HEIGHT
3341 /* #### do we need to cache this info to speed things up? */
3344 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3346 if (!GLYPHP (glyph))
3350 Lisp_Object retval =
3351 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3352 /* #### look into ERROR_ME_NOT */
3353 Qunbound, domain, ERROR_ME_NOT,
3355 if (!NILP (retval) && !INTP (retval))
3357 else if (INTP (retval))
3359 if (XINT (retval) < 0)
3361 if (XINT (retval) > 100)
3362 retval = make_int (100);
3369 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3371 /* #### Domain parameter not currently used but it will be */
3372 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3376 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3378 if (!GLYPHP (glyph))
3381 return !NILP (specifier_instance_no_quit
3382 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3383 /* #### look into ERROR_ME_NOT */
3384 ERROR_ME_NOT, 0, Qzero));
3388 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3391 if (XGLYPH (glyph)->after_change)
3392 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3396 /*****************************************************************************
3397 * glyph cachel functions *
3398 *****************************************************************************/
3401 #### All of this is 95% copied from face cachels.
3402 Consider consolidating.
3403 #### We need to add a dirty flag to the glyphs.
3407 mark_glyph_cachels (glyph_cachel_dynarr *elements,
3408 void (*markobj) (Lisp_Object))
3415 for (elt = 0; elt < Dynarr_length (elements); elt++)
3417 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3418 markobj (cachel->glyph);
3423 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3424 struct glyph_cachel *cachel)
3426 /* #### This should be || !cachel->updated */
3427 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph))
3431 XSETWINDOW (window, w);
3433 /* #### This could be sped up if we redid things to grab the glyph
3434 instantiation and passed it to the size functions. */
3435 cachel->glyph = glyph;
3436 cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window);
3437 cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window);
3438 cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window);
3441 cachel->updated = 1;
3445 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3447 struct glyph_cachel new_cachel;
3450 new_cachel.glyph = Qnil;
3452 update_glyph_cachel_data (w, glyph, &new_cachel);
3453 Dynarr_add (w->glyph_cachels, new_cachel);
3457 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3464 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3466 struct glyph_cachel *cachel =
3467 Dynarr_atp (w->glyph_cachels, elt);
3469 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3471 if (!cachel->updated)
3472 update_glyph_cachel_data (w, glyph, cachel);
3477 /* If we didn't find the glyph, add it and then return its index. */
3478 add_glyph_cachel (w, glyph);
3483 reset_glyph_cachels (struct window *w)
3485 Dynarr_reset (w->glyph_cachels);
3486 get_glyph_cachel_index (w, Vcontinuation_glyph);
3487 get_glyph_cachel_index (w, Vtruncation_glyph);
3488 get_glyph_cachel_index (w, Vhscroll_glyph);
3489 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3490 get_glyph_cachel_index (w, Voctal_escape_glyph);
3491 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3495 mark_glyph_cachels_as_not_updated (struct window *w)
3499 /* We need to have a dirty flag to tell if the glyph has changed.
3500 We can check to see if each glyph variable is actually a
3501 completely different glyph, though. */
3502 #define FROB(glyph_obj, gindex) \
3503 update_glyph_cachel_data (w, glyph_obj, \
3504 Dynarr_atp (w->glyph_cachels, gindex))
3506 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3507 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3508 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3509 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3510 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3511 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3514 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3515 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3518 #ifdef MEMORY_USAGE_STATS
3521 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3522 struct overhead_stats *ovstats)
3527 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3532 #endif /* MEMORY_USAGE_STATS */
3536 /*****************************************************************************
3537 * subwindow cachel functions *
3538 *****************************************************************************/
3539 /* subwindows are curious in that you have to physically unmap them to
3540 not display them. It is problematic deciding what to do in
3541 redisplay. We have two caches - a per-window instance cache that
3542 keeps track of subwindows on a window, these are linked to their
3543 instantiator in the hashtable and when the instantiator goes away
3544 we want the instance to go away also. However we also have a
3545 per-frame instance cache that we use to determine if a subwindow is
3546 obscuring an area that we want to clear. We need to be able to flip
3547 through this quickly so a hashtable is not suitable hence the
3548 subwindow_cachels. The question is should we just not mark
3549 instances in the subwindow_cachelsnor should we try and invalidate
3550 the cache at suitable points in redisplay? If we don't invalidate
3551 the cache it will fill up with crud that will only get removed when
3552 the frame is deleted. So invalidation is good, the question is when
3553 and whether we mark as well. Go for the simple option - don't mark,
3554 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
3557 mark_subwindow_cachels (subwindow_cachel_dynarr *elements,
3558 void (*markobj) (Lisp_Object))
3565 for (elt = 0; elt < Dynarr_length (elements); elt++)
3567 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
3568 markobj (cachel->subwindow);
3573 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
3574 struct subwindow_cachel *cachel)
3576 if (NILP (cachel->subwindow) || !EQ (cachel->subwindow, subwindow))
3578 cachel->subwindow = subwindow;
3579 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3580 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3583 cachel->updated = 1;
3587 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
3589 struct subwindow_cachel new_cachel;
3592 new_cachel.subwindow = Qnil;
3595 new_cachel.being_displayed=0;
3597 update_subwindow_cachel_data (f, subwindow, &new_cachel);
3598 Dynarr_add (f->subwindow_cachels, new_cachel);
3602 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
3609 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3611 struct subwindow_cachel *cachel =
3612 Dynarr_atp (f->subwindow_cachels, elt);
3614 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
3616 if (!cachel->updated)
3617 update_subwindow_cachel_data (f, subwindow, cachel);
3622 /* If we didn't find the glyph, add it and then return its index. */
3623 add_subwindow_cachel (f, subwindow);
3627 /* redisplay in general assumes that drawing something will erase
3628 what was there before. unfortunately this does not apply to
3629 subwindows that need to be specifically unmapped in order to
3630 disappear. we take a brute force approach - on the basis that its
3631 cheap - and unmap all subwindows in a display line */
3633 reset_subwindow_cachels (struct frame *f)
3636 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3638 struct subwindow_cachel *cachel =
3639 Dynarr_atp (f->subwindow_cachels, elt);
3641 if (!NILP (cachel->subwindow) && cachel->being_displayed)
3643 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (cachel->subwindow);
3644 MAYBE_DEVMETH (XDEVICE (f->device), unmap_subwindow, (ii));
3647 Dynarr_reset (f->subwindow_cachels);
3651 mark_subwindow_cachels_as_not_updated (struct frame *f)
3655 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3656 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
3660 /*****************************************************************************
3661 * subwindow functions *
3662 *****************************************************************************/
3664 /* update the displayed characteristics of a subwindow */
3666 update_subwindow (Lisp_Object subwindow)
3668 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3670 if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3672 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3675 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
3679 update_frame_subwindows (struct frame *f)
3683 if (f->subwindows_changed || f->glyphs_changed)
3684 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3686 struct subwindow_cachel *cachel =
3687 Dynarr_atp (f->subwindow_cachels, elt);
3689 if (cachel->being_displayed)
3691 update_subwindow (cachel->subwindow);
3696 /* remove a subwindow from its frame */
3697 void unmap_subwindow (Lisp_Object subwindow)
3699 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3701 struct subwindow_cachel* cachel;
3704 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3706 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3708 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3711 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3712 elt = get_subwindow_cachel_index (f, subwindow);
3713 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3717 cachel->being_displayed = 0;
3718 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3720 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
3723 /* show a subwindow in its frame */
3724 void map_subwindow (Lisp_Object subwindow, int x, int y)
3726 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3728 struct subwindow_cachel* cachel;
3731 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3733 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3735 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3738 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3739 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
3740 elt = get_subwindow_cachel_index (f, subwindow);
3741 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3744 cachel->being_displayed = 1;
3746 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y));
3750 subwindow_possible_dest_types (void)
3752 return IMAGE_SUBWINDOW_MASK;
3755 /* Partially instantiate a subwindow. */
3757 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
3758 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
3759 int dest_mask, Lisp_Object domain)
3761 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
3762 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
3763 Lisp_Object frame = FW_FRAME (domain);
3764 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
3765 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
3768 signal_simple_error ("No selected frame", device);
3770 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
3771 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
3774 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
3775 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = Qnil;
3776 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3777 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
3779 /* this stuff may get overidden by the widget code */
3781 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
3786 if (XINT (width) > 1)
3788 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
3791 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
3796 if (XINT (height) > 1)
3798 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
3802 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
3803 Return non-nil if OBJECT is a subwindow.
3807 CHECK_IMAGE_INSTANCE (object);
3808 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
3811 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
3812 Return the window id of SUBWINDOW as a number.
3816 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3817 return make_int ((int) (XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)));
3820 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
3821 Resize SUBWINDOW to WIDTH x HEIGHT.
3822 If a value is nil that parameter is not changed.
3824 (subwindow, width, height))
3828 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3831 neww = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3833 neww = XINT (width);
3836 newh = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3838 newh = XINT (height);
3841 MAYBE_DEVMETH (XDEVICE (XIMAGE_INSTANCE_DEVICE (subwindow)),
3842 resize_subwindow, (XIMAGE_INSTANCE (subwindow), neww, newh));
3844 XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow) = newh;
3845 XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow) = neww;
3850 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
3851 Generate a Map event for SUBWINDOW.
3855 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3857 map_subwindow (subwindow, 0, 0);
3863 /*****************************************************************************
3865 *****************************************************************************/
3867 /* Get the display tables for use currently on window W with face
3868 FACE. #### This will have to be redone. */
3871 get_display_tables (struct window *w, face_index findex,
3872 Lisp_Object *face_table, Lisp_Object *window_table)
3875 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
3879 tem = noseeum_cons (tem, Qnil);
3881 tem = w->display_table;
3885 tem = noseeum_cons (tem, Qnil);
3886 *window_table = tem;
3890 display_table_entry (Emchar ch, Lisp_Object face_table,
3891 Lisp_Object window_table)
3895 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
3896 for (tail = face_table; 1; tail = XCDR (tail))
3901 if (!NILP (window_table))
3903 tail = window_table;
3904 window_table = Qnil;
3909 table = XCAR (tail);
3911 if (VECTORP (table))
3913 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
3914 return XVECTOR_DATA (table)[ch];
3918 else if (CHAR_TABLEP (table)
3919 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
3921 return get_char_table (ch, XCHAR_TABLE (table));
3923 else if (CHAR_TABLEP (table)
3924 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
3926 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
3932 else if (RANGE_TABLEP (table))
3934 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
3945 /*****************************************************************************
3947 *****************************************************************************/
3950 syms_of_glyphs (void)
3952 /* image instantiators */
3954 DEFSUBR (Fimage_instantiator_format_list);
3955 DEFSUBR (Fvalid_image_instantiator_format_p);
3956 DEFSUBR (Fset_console_type_image_conversion_list);
3957 DEFSUBR (Fconsole_type_image_conversion_list);
3959 defkeyword (&Q_file, ":file");
3960 defkeyword (&Q_data, ":data");
3961 defkeyword (&Q_face, ":face");
3962 defkeyword (&Q_pixel_height, ":pixel-height");
3963 defkeyword (&Q_pixel_width, ":pixel-width");
3966 defkeyword (&Q_color_symbols, ":color-symbols");
3968 #ifdef HAVE_WINDOW_SYSTEM
3969 defkeyword (&Q_mask_file, ":mask-file");
3970 defkeyword (&Q_mask_data, ":mask-data");
3971 defkeyword (&Q_hotspot_x, ":hotspot-x");
3972 defkeyword (&Q_hotspot_y, ":hotspot-y");
3973 defkeyword (&Q_foreground, ":foreground");
3974 defkeyword (&Q_background, ":background");
3976 /* image specifiers */
3978 DEFSUBR (Fimage_specifier_p);
3979 /* Qimage in general.c */
3981 /* image instances */
3983 defsymbol (&Qimage_instancep, "image-instance-p");
3985 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
3986 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
3987 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
3988 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
3989 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
3990 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
3991 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
3993 DEFSUBR (Fmake_image_instance);
3994 DEFSUBR (Fimage_instance_p);
3995 DEFSUBR (Fimage_instance_type);
3996 DEFSUBR (Fvalid_image_instance_type_p);
3997 DEFSUBR (Fimage_instance_type_list);
3998 DEFSUBR (Fimage_instance_name);
3999 DEFSUBR (Fimage_instance_string);
4000 DEFSUBR (Fimage_instance_file_name);
4001 DEFSUBR (Fimage_instance_mask_file_name);
4002 DEFSUBR (Fimage_instance_depth);
4003 DEFSUBR (Fimage_instance_height);
4004 DEFSUBR (Fimage_instance_width);
4005 DEFSUBR (Fimage_instance_hotspot_x);
4006 DEFSUBR (Fimage_instance_hotspot_y);
4007 DEFSUBR (Fimage_instance_foreground);
4008 DEFSUBR (Fimage_instance_background);
4009 DEFSUBR (Fimage_instance_property);
4010 DEFSUBR (Fset_image_instance_property);
4011 DEFSUBR (Fcolorize_image_instance);
4013 DEFSUBR (Fsubwindowp);
4014 DEFSUBR (Fimage_instance_subwindow_id);
4015 DEFSUBR (Fresize_subwindow);
4016 DEFSUBR (Fforce_subwindow_map);
4018 /* Qnothing defined as part of the "nothing" image-instantiator
4020 /* Qtext defined in general.c */
4021 defsymbol (&Qmono_pixmap, "mono-pixmap");
4022 defsymbol (&Qcolor_pixmap, "color-pixmap");
4023 /* Qpointer defined in general.c */
4027 defsymbol (&Qglyphp, "glyphp");
4028 defsymbol (&Qcontrib_p, "contrib-p");
4029 defsymbol (&Qbaseline, "baseline");
4031 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4032 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4033 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4035 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4037 DEFSUBR (Fglyph_type);
4038 DEFSUBR (Fvalid_glyph_type_p);
4039 DEFSUBR (Fglyph_type_list);
4041 DEFSUBR (Fmake_glyph_internal);
4042 DEFSUBR (Fglyph_width);
4043 DEFSUBR (Fglyph_ascent);
4044 DEFSUBR (Fglyph_descent);
4045 DEFSUBR (Fglyph_height);
4047 /* Qbuffer defined in general.c. */
4048 /* Qpointer defined above */
4051 deferror (&Qimage_conversion_error,
4052 "image-conversion-error",
4053 "image-conversion error", Qio_error);
4058 specifier_type_create_image (void)
4060 /* image specifiers */
4062 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4064 SPECIFIER_HAS_METHOD (image, create);
4065 SPECIFIER_HAS_METHOD (image, mark);
4066 SPECIFIER_HAS_METHOD (image, instantiate);
4067 SPECIFIER_HAS_METHOD (image, validate);
4068 SPECIFIER_HAS_METHOD (image, after_change);
4069 SPECIFIER_HAS_METHOD (image, going_to_add);
4073 image_instantiator_format_create (void)
4075 /* image instantiators */
4077 the_image_instantiator_format_entry_dynarr =
4078 Dynarr_new (image_instantiator_format_entry);
4080 Vimage_instantiator_format_list = Qnil;
4081 staticpro (&Vimage_instantiator_format_list);
4083 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
4085 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
4086 IIFORMAT_HAS_METHOD (nothing, instantiate);
4088 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
4090 IIFORMAT_HAS_METHOD (inherit, validate);
4091 IIFORMAT_HAS_METHOD (inherit, normalize);
4092 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
4093 IIFORMAT_HAS_METHOD (inherit, instantiate);
4095 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
4097 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
4099 IIFORMAT_HAS_METHOD (string, validate);
4100 IIFORMAT_HAS_METHOD (string, possible_dest_types);
4101 IIFORMAT_HAS_METHOD (string, instantiate);
4103 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4105 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4107 IIFORMAT_HAS_METHOD (formatted_string, validate);
4108 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4109 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
4111 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
4114 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
4115 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
4116 IIFORMAT_HAS_METHOD (subwindow, instantiate);
4117 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
4118 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
4120 #ifdef HAVE_WINDOW_SYSTEM
4121 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4123 IIFORMAT_HAS_METHOD (xbm, validate);
4124 IIFORMAT_HAS_METHOD (xbm, normalize);
4125 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4127 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4128 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4129 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4130 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4131 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4132 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4133 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4134 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4135 #endif /* HAVE_WINDOW_SYSTEM */
4138 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
4140 IIFORMAT_HAS_METHOD (xface, validate);
4141 IIFORMAT_HAS_METHOD (xface, normalize);
4142 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
4144 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
4145 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
4146 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
4147 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
4148 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
4149 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
4153 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
4155 IIFORMAT_HAS_METHOD (xpm, validate);
4156 IIFORMAT_HAS_METHOD (xpm, normalize);
4157 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
4159 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
4160 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
4161 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
4162 #endif /* HAVE_XPM */
4166 vars_of_glyphs (void)
4168 Vthe_nothing_vector = vector1 (Qnothing);
4169 staticpro (&Vthe_nothing_vector);
4171 /* image instances */
4173 Vimage_instance_type_list = Fcons (Qnothing,
4174 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
4175 Qpointer, Qsubwindow, Qwidget));
4176 staticpro (&Vimage_instance_type_list);
4180 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
4181 staticpro (&Vglyph_type_list);
4183 /* The octal-escape glyph, control-arrow-glyph and
4184 invisible-text-glyph are completely initialized in glyphs.el */
4186 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
4187 What to prefix character codes displayed in octal with.
4189 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4191 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
4192 What to use as an arrow for control characters.
4194 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
4195 redisplay_glyph_changed);
4197 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
4198 What to use to indicate the presence of invisible text.
4199 This is the glyph that is displayed when an ellipsis is called for
4200 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
4201 Normally this is three dots ("...").
4203 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
4204 redisplay_glyph_changed);
4206 /* Partially initialized in glyphs.el */
4207 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
4208 What to display at the beginning of horizontally scrolled lines.
4210 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4211 #ifdef HAVE_WINDOW_SYSTEM
4217 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
4218 Definitions of logical color-names used when reading XPM files.
4219 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
4220 The COLOR-NAME should be a string, which is the name of the color to define;
4221 the FORM should evaluate to a `color' specifier object, or a string to be
4222 passed to `make-color-instance'. If a loaded XPM file references a symbolic
4223 color called COLOR-NAME, it will display as the computed color instead.
4225 The default value of this variable defines the logical color names
4226 \"foreground\" and \"background\" to be the colors of the `default' face.
4228 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
4229 #endif /* HAVE_XPM */
4236 specifier_vars_of_glyphs (void)
4238 /* #### Can we GC here? The set_specifier_* calls definitely need */
4240 /* display tables */
4242 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
4243 *The display table currently in use.
4244 This is a specifier; use `set-specifier' to change it.
4245 The display table is a vector created with `make-display-table'.
4246 The 256 elements control how to display each possible text character.
4247 Each value should be a string, a glyph, a vector or nil.
4248 If a value is a vector it must be composed only of strings and glyphs.
4249 nil means display the character in the default fashion.
4250 Faces can have their own, overriding display table.
4252 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
4253 set_specifier_fallback (Vcurrent_display_table,
4254 list1 (Fcons (Qnil, Qnil)));
4255 set_specifier_caching (Vcurrent_display_table,
4256 slot_offset (struct window,
4258 some_window_value_changed,
4263 complex_vars_of_glyphs (void)
4265 /* Partially initialized in glyphs-x.c, glyphs.el */
4266 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
4267 What to display at the end of truncated lines.
4269 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4271 /* Partially initialized in glyphs-x.c, glyphs.el */
4272 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
4273 What to display at the end of wrapped lines.
4275 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4277 /* Partially initialized in glyphs-x.c, glyphs.el */
4278 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
4279 The glyph used to display the XEmacs logo at startup.
4281 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);