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,
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 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
2930 mark_glyph, print_glyph, 0,
2931 glyph_equal, glyph_hash,
2932 glyph_getprop, glyph_putprop,
2933 glyph_remprop, glyph_plist,
2937 allocate_glyph (enum glyph_type type,
2938 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
2939 Lisp_Object locale))
2941 /* This function can GC */
2942 Lisp_Object obj = Qnil;
2943 struct Lisp_Glyph *g =
2944 alloc_lcrecord_type (struct Lisp_Glyph, &lrecord_glyph);
2947 g->image = Fmake_specifier (Qimage); /* This function can GC */
2951 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2952 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
2953 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
2954 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK;
2957 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2958 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
2961 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2962 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK;
2968 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
2969 /* We're getting enough reports of odd behavior in this area it seems */
2970 /* best to GCPRO everything. */
2972 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
2973 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
2974 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
2975 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2977 GCPRO4 (obj, tem1, tem2, tem3);
2979 set_specifier_fallback (g->image, tem1);
2980 g->contrib_p = Fmake_specifier (Qboolean);
2981 set_specifier_fallback (g->contrib_p, tem2);
2982 /* #### should have a specifier for the following */
2983 g->baseline = Fmake_specifier (Qgeneric);
2984 set_specifier_fallback (g->baseline, tem3);
2987 g->after_change = after_change;
2990 set_image_attached_to (g->image, obj, Qimage);
2997 static enum glyph_type
2998 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3001 return GLYPH_BUFFER;
3003 if (ERRB_EQ (errb, ERROR_ME))
3004 CHECK_SYMBOL (type);
3006 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
3007 if (EQ (type, Qpointer)) return GLYPH_POINTER;
3008 if (EQ (type, Qicon)) return GLYPH_ICON;
3010 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3012 return GLYPH_UNKNOWN;
3016 valid_glyph_type_p (Lisp_Object type)
3018 return !NILP (memq_no_quit (type, Vglyph_type_list));
3021 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3022 Given a GLYPH-TYPE, return non-nil if it is valid.
3023 Valid types are `buffer', `pointer', and `icon'.
3027 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3030 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3031 Return a list of valid glyph types.
3035 return Fcopy_sequence (Vglyph_type_list);
3038 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3039 Create and return a new uninitialized glyph or type TYPE.
3041 TYPE specifies the type of the glyph; this should be one of `buffer',
3042 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
3043 specifies in which contexts the glyph can be used, and controls the
3044 allowable image types into which the glyph's image can be
3047 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3048 extent, in the modeline, and in the toolbar. Their image can be
3049 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3052 `pointer' glyphs can be used to specify the mouse pointer. Their
3053 image can be instantiated as `pointer'.
3055 `icon' glyphs can be used to specify the icon used when a frame is
3056 iconified. Their image can be instantiated as `mono-pixmap' and
3061 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3062 return allocate_glyph (typeval, 0);
3065 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3066 Return non-nil if OBJECT is a glyph.
3068 A glyph is an object used for pixmaps and the like. It is used
3069 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3070 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3071 buttons, and the like. Its image is described using an image specifier --
3072 see `image-specifier-p'.
3076 return GLYPHP (object) ? Qt : Qnil;
3079 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3080 Return the type of the given glyph.
3081 The return value will be one of 'buffer, 'pointer, or 'icon.
3085 CHECK_GLYPH (glyph);
3086 switch (XGLYPH_TYPE (glyph))
3089 case GLYPH_BUFFER: return Qbuffer;
3090 case GLYPH_POINTER: return Qpointer;
3091 case GLYPH_ICON: return Qicon;
3095 /*****************************************************************************
3098 Return the width of the given GLYPH on the given WINDOW. If the
3099 instance is a string then the width is calculated using the font of
3100 the given FACE, unless a face is defined by the glyph itself.
3101 ****************************************************************************/
3103 glyph_width (Lisp_Object glyph, Lisp_Object frame_face,
3104 face_index window_findex, Lisp_Object window)
3106 Lisp_Object instance;
3107 Lisp_Object frame = XWINDOW (window)->frame;
3109 /* #### We somehow need to distinguish between the user causing this
3110 error condition and a bug causing it. */
3111 if (!GLYPHP (glyph))
3114 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3116 if (!IMAGE_INSTANCEP (instance))
3119 switch (XIMAGE_INSTANCE_TYPE (instance))
3123 Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance);
3124 Lisp_Object private_face = XGLYPH_FACE(glyph);
3126 if (!NILP (private_face))
3127 return redisplay_frame_text_width_string (XFRAME (frame),
3131 if (!NILP (frame_face))
3132 return redisplay_frame_text_width_string (XFRAME (frame),
3136 return redisplay_text_width_string (XWINDOW (window),
3141 case IMAGE_MONO_PIXMAP:
3142 case IMAGE_COLOR_PIXMAP:
3144 return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance);
3149 case IMAGE_SUBWINDOW:
3151 return XIMAGE_INSTANCE_SUBWINDOW_WIDTH (instance);
3159 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3160 Return the width of GLYPH on WINDOW.
3161 This may not be exact as it does not take into account all of the context
3162 that redisplay will.
3166 XSETWINDOW (window, decode_window (window));
3167 CHECK_GLYPH (glyph);
3169 return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window));
3172 #define RETURN_ASCENT 0
3173 #define RETURN_DESCENT 1
3174 #define RETURN_HEIGHT 2
3177 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3178 Error_behavior errb, int no_quit)
3180 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3182 /* This can never return Qunbound. All glyphs have 'nothing as
3184 return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0,
3188 static unsigned short
3189 glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face,
3190 face_index window_findex, Lisp_Object window,
3193 Lisp_Object instance;
3194 Lisp_Object frame = XWINDOW (window)->frame;
3196 if (!GLYPHP (glyph))
3199 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3201 if (!IMAGE_INSTANCEP (instance))
3204 switch (XIMAGE_INSTANCE_TYPE (instance))
3208 struct font_metric_info fm;
3209 Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance);
3210 unsigned char charsets[NUM_LEADING_BYTES];
3211 struct face_cachel frame_cachel;
3212 struct face_cachel *cachel;
3214 find_charsets_in_bufbyte_string (charsets,
3215 XSTRING_DATA (string),
3216 XSTRING_LENGTH (string));
3218 if (!NILP (frame_face))
3220 reset_face_cachel (&frame_cachel);
3221 update_face_cachel_data (&frame_cachel, frame, frame_face);
3222 cachel = &frame_cachel;
3225 cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex);
3226 ensure_face_cachel_complete (cachel, window, charsets);
3228 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
3232 case RETURN_ASCENT: return fm.ascent;
3233 case RETURN_DESCENT: return fm.descent;
3234 case RETURN_HEIGHT: return fm.ascent + fm.descent;
3237 return 0; /* not reached */
3241 case IMAGE_MONO_PIXMAP:
3242 case IMAGE_COLOR_PIXMAP:
3244 /* #### Ugh ugh ugh -- temporary crap */
3245 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3246 return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance);
3253 case IMAGE_SUBWINDOW:
3255 /* #### Ugh ugh ugh -- temporary crap */
3256 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3257 return XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (instance);
3268 glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face,
3269 face_index window_findex, Lisp_Object window)
3271 return glyph_height_internal (glyph, frame_face, window_findex, window,
3276 glyph_descent (Lisp_Object glyph, Lisp_Object frame_face,
3277 face_index window_findex, Lisp_Object window)
3279 return glyph_height_internal (glyph, frame_face, window_findex, window,
3283 /* strictly a convenience function. */
3285 glyph_height (Lisp_Object glyph, Lisp_Object frame_face,
3286 face_index window_findex, Lisp_Object window)
3288 return glyph_height_internal (glyph, frame_face, window_findex, window,
3292 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3293 Return the ascent value of GLYPH on WINDOW.
3294 This may not be exact as it does not take into account all of the context
3295 that redisplay will.
3299 XSETWINDOW (window, decode_window (window));
3300 CHECK_GLYPH (glyph);
3302 return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window));
3305 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3306 Return the descent value of GLYPH on WINDOW.
3307 This may not be exact as it does not take into account all of the context
3308 that redisplay will.
3312 XSETWINDOW (window, decode_window (window));
3313 CHECK_GLYPH (glyph);
3315 return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window));
3318 /* This is redundant but I bet a lot of people expect it to exist. */
3319 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3320 Return the height of GLYPH on WINDOW.
3321 This may not be exact as it does not take into account all of the context
3322 that redisplay will.
3326 XSETWINDOW (window, decode_window (window));
3327 CHECK_GLYPH (glyph);
3329 return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window));
3332 #undef RETURN_ASCENT
3333 #undef RETURN_DESCENT
3334 #undef RETURN_HEIGHT
3336 /* #### do we need to cache this info to speed things up? */
3339 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3341 if (!GLYPHP (glyph))
3345 Lisp_Object retval =
3346 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3347 /* #### look into ERROR_ME_NOT */
3348 Qunbound, domain, ERROR_ME_NOT,
3350 if (!NILP (retval) && !INTP (retval))
3352 else if (INTP (retval))
3354 if (XINT (retval) < 0)
3356 if (XINT (retval) > 100)
3357 retval = make_int (100);
3364 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3366 /* #### Domain parameter not currently used but it will be */
3367 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3371 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3373 if (!GLYPHP (glyph))
3376 return !NILP (specifier_instance_no_quit
3377 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3378 /* #### look into ERROR_ME_NOT */
3379 ERROR_ME_NOT, 0, Qzero));
3383 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3386 if (XGLYPH (glyph)->after_change)
3387 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3391 /*****************************************************************************
3392 * glyph cachel functions *
3393 *****************************************************************************/
3396 #### All of this is 95% copied from face cachels.
3397 Consider consolidating.
3398 #### We need to add a dirty flag to the glyphs.
3402 mark_glyph_cachels (glyph_cachel_dynarr *elements,
3403 void (*markobj) (Lisp_Object))
3410 for (elt = 0; elt < Dynarr_length (elements); elt++)
3412 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3413 markobj (cachel->glyph);
3418 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3419 struct glyph_cachel *cachel)
3421 /* #### This should be || !cachel->updated */
3422 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph))
3426 XSETWINDOW (window, w);
3428 /* #### This could be sped up if we redid things to grab the glyph
3429 instantiation and passed it to the size functions. */
3430 cachel->glyph = glyph;
3431 cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window);
3432 cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window);
3433 cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window);
3436 cachel->updated = 1;
3440 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3442 struct glyph_cachel new_cachel;
3445 new_cachel.glyph = Qnil;
3447 update_glyph_cachel_data (w, glyph, &new_cachel);
3448 Dynarr_add (w->glyph_cachels, new_cachel);
3452 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3459 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3461 struct glyph_cachel *cachel =
3462 Dynarr_atp (w->glyph_cachels, elt);
3464 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3466 if (!cachel->updated)
3467 update_glyph_cachel_data (w, glyph, cachel);
3472 /* If we didn't find the glyph, add it and then return its index. */
3473 add_glyph_cachel (w, glyph);
3478 reset_glyph_cachels (struct window *w)
3480 Dynarr_reset (w->glyph_cachels);
3481 get_glyph_cachel_index (w, Vcontinuation_glyph);
3482 get_glyph_cachel_index (w, Vtruncation_glyph);
3483 get_glyph_cachel_index (w, Vhscroll_glyph);
3484 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3485 get_glyph_cachel_index (w, Voctal_escape_glyph);
3486 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3490 mark_glyph_cachels_as_not_updated (struct window *w)
3494 /* We need to have a dirty flag to tell if the glyph has changed.
3495 We can check to see if each glyph variable is actually a
3496 completely different glyph, though. */
3497 #define FROB(glyph_obj, gindex) \
3498 update_glyph_cachel_data (w, glyph_obj, \
3499 Dynarr_atp (w->glyph_cachels, gindex))
3501 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3502 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3503 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3504 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3505 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3506 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3509 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3510 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3513 #ifdef MEMORY_USAGE_STATS
3516 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3517 struct overhead_stats *ovstats)
3522 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3527 #endif /* MEMORY_USAGE_STATS */
3531 /*****************************************************************************
3532 * subwindow cachel functions *
3533 *****************************************************************************/
3534 /* subwindows are curious in that you have to physically unmap them to
3535 not display them. It is problematic deciding what to do in
3536 redisplay. We have two caches - a per-window instance cache that
3537 keeps track of subwindows on a window, these are linked to their
3538 instantiator in the hashtable and when the instantiator goes away
3539 we want the instance to go away also. However we also have a
3540 per-frame instance cache that we use to determine if a subwindow is
3541 obscuring an area that we want to clear. We need to be able to flip
3542 through this quickly so a hashtable is not suitable hence the
3543 subwindow_cachels. The question is should we just not mark
3544 instances in the subwindow_cachelsnor should we try and invalidate
3545 the cache at suitable points in redisplay? If we don't invalidate
3546 the cache it will fill up with crud that will only get removed when
3547 the frame is deleted. So invalidation is good, the question is when
3548 and whether we mark as well. Go for the simple option - don't mark,
3549 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
3552 mark_subwindow_cachels (subwindow_cachel_dynarr *elements,
3553 void (*markobj) (Lisp_Object))
3560 for (elt = 0; elt < Dynarr_length (elements); elt++)
3562 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
3563 markobj (cachel->subwindow);
3568 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
3569 struct subwindow_cachel *cachel)
3571 if (NILP (cachel->subwindow) || !EQ (cachel->subwindow, subwindow))
3573 cachel->subwindow = subwindow;
3574 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3575 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3578 cachel->updated = 1;
3582 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
3584 struct subwindow_cachel new_cachel;
3587 new_cachel.subwindow = Qnil;
3590 new_cachel.being_displayed=0;
3592 update_subwindow_cachel_data (f, subwindow, &new_cachel);
3593 Dynarr_add (f->subwindow_cachels, new_cachel);
3597 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
3604 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3606 struct subwindow_cachel *cachel =
3607 Dynarr_atp (f->subwindow_cachels, elt);
3609 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
3611 if (!cachel->updated)
3612 update_subwindow_cachel_data (f, subwindow, cachel);
3617 /* If we didn't find the glyph, add it and then return its index. */
3618 add_subwindow_cachel (f, subwindow);
3622 /* redisplay in general assumes that drawing something will erase
3623 what was there before. unfortunately this does not apply to
3624 subwindows that need to be specifically unmapped in order to
3625 disappear. we take a brute force approach - on the basis that its
3626 cheap - and unmap all subwindows in a display line */
3628 reset_subwindow_cachels (struct frame *f)
3631 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3633 struct subwindow_cachel *cachel =
3634 Dynarr_atp (f->subwindow_cachels, elt);
3636 if (!NILP (cachel->subwindow) && cachel->being_displayed)
3638 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (cachel->subwindow);
3639 MAYBE_DEVMETH (XDEVICE (f->device), unmap_subwindow, (ii));
3642 Dynarr_reset (f->subwindow_cachels);
3646 mark_subwindow_cachels_as_not_updated (struct frame *f)
3650 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3651 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
3655 /*****************************************************************************
3656 * subwindow functions *
3657 *****************************************************************************/
3659 /* update the displayed characteristics of a subwindow */
3661 update_subwindow (Lisp_Object subwindow)
3663 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3665 if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3667 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3670 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
3674 update_frame_subwindows (struct frame *f)
3678 if (f->subwindows_changed || f->glyphs_changed)
3679 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3681 struct subwindow_cachel *cachel =
3682 Dynarr_atp (f->subwindow_cachels, elt);
3684 if (cachel->being_displayed)
3686 update_subwindow (cachel->subwindow);
3691 /* remove a subwindow from its frame */
3692 void unmap_subwindow (Lisp_Object subwindow)
3694 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3696 struct subwindow_cachel* cachel;
3699 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3701 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3703 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3706 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3707 elt = get_subwindow_cachel_index (f, subwindow);
3708 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3712 cachel->being_displayed = 0;
3713 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3715 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
3718 /* show a subwindow in its frame */
3719 void map_subwindow (Lisp_Object subwindow, int x, int y)
3721 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3723 struct subwindow_cachel* cachel;
3726 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3728 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3730 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3733 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3734 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
3735 elt = get_subwindow_cachel_index (f, subwindow);
3736 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3739 cachel->being_displayed = 1;
3741 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y));
3745 subwindow_possible_dest_types (void)
3747 return IMAGE_SUBWINDOW_MASK;
3750 /* Partially instantiate a subwindow. */
3752 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
3753 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
3754 int dest_mask, Lisp_Object domain)
3756 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
3757 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
3758 Lisp_Object frame = FW_FRAME (domain);
3759 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
3760 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
3763 signal_simple_error ("No selected frame", device);
3765 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
3766 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
3769 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
3770 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = Qnil;
3771 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3772 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
3774 /* this stuff may get overidden by the widget code */
3776 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
3781 if (XINT (width) > 1)
3783 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
3786 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
3791 if (XINT (height) > 1)
3793 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
3797 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
3798 Return non-nil if OBJECT is a subwindow.
3802 CHECK_IMAGE_INSTANCE (object);
3803 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
3806 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
3807 Return the window id of SUBWINDOW as a number.
3811 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3812 return make_int ((int) (XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)));
3815 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
3816 Resize SUBWINDOW to WIDTH x HEIGHT.
3817 If a value is nil that parameter is not changed.
3819 (subwindow, width, height))
3823 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3826 neww = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3828 neww = XINT (width);
3831 newh = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3833 newh = XINT (height);
3836 MAYBE_DEVMETH (XDEVICE (XIMAGE_INSTANCE_DEVICE (subwindow)),
3837 resize_subwindow, (XIMAGE_INSTANCE (subwindow), neww, newh));
3839 XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow) = newh;
3840 XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow) = neww;
3845 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
3846 Generate a Map event for SUBWINDOW.
3850 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3852 map_subwindow (subwindow, 0, 0);
3858 /*****************************************************************************
3860 *****************************************************************************/
3862 /* Get the display tables for use currently on window W with face
3863 FACE. #### This will have to be redone. */
3866 get_display_tables (struct window *w, face_index findex,
3867 Lisp_Object *face_table, Lisp_Object *window_table)
3870 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
3874 tem = noseeum_cons (tem, Qnil);
3876 tem = w->display_table;
3880 tem = noseeum_cons (tem, Qnil);
3881 *window_table = tem;
3885 display_table_entry (Emchar ch, Lisp_Object face_table,
3886 Lisp_Object window_table)
3890 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
3891 for (tail = face_table; 1; tail = XCDR (tail))
3896 if (!NILP (window_table))
3898 tail = window_table;
3899 window_table = Qnil;
3904 table = XCAR (tail);
3906 if (VECTORP (table))
3908 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
3909 return XVECTOR_DATA (table)[ch];
3913 else if (CHAR_TABLEP (table)
3914 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
3916 return get_char_table (ch, XCHAR_TABLE (table));
3918 else if (CHAR_TABLEP (table)
3919 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
3921 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
3927 else if (RANGE_TABLEP (table))
3929 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
3940 /*****************************************************************************
3942 *****************************************************************************/
3945 syms_of_glyphs (void)
3947 /* image instantiators */
3949 DEFSUBR (Fimage_instantiator_format_list);
3950 DEFSUBR (Fvalid_image_instantiator_format_p);
3951 DEFSUBR (Fset_console_type_image_conversion_list);
3952 DEFSUBR (Fconsole_type_image_conversion_list);
3954 defkeyword (&Q_file, ":file");
3955 defkeyword (&Q_data, ":data");
3956 defkeyword (&Q_face, ":face");
3957 defkeyword (&Q_pixel_height, ":pixel-height");
3958 defkeyword (&Q_pixel_width, ":pixel-width");
3961 defkeyword (&Q_color_symbols, ":color-symbols");
3963 #ifdef HAVE_WINDOW_SYSTEM
3964 defkeyword (&Q_mask_file, ":mask-file");
3965 defkeyword (&Q_mask_data, ":mask-data");
3966 defkeyword (&Q_hotspot_x, ":hotspot-x");
3967 defkeyword (&Q_hotspot_y, ":hotspot-y");
3968 defkeyword (&Q_foreground, ":foreground");
3969 defkeyword (&Q_background, ":background");
3971 /* image specifiers */
3973 DEFSUBR (Fimage_specifier_p);
3974 /* Qimage in general.c */
3976 /* image instances */
3978 defsymbol (&Qimage_instancep, "image-instance-p");
3980 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
3981 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
3982 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
3983 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
3984 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
3985 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
3986 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
3988 DEFSUBR (Fmake_image_instance);
3989 DEFSUBR (Fimage_instance_p);
3990 DEFSUBR (Fimage_instance_type);
3991 DEFSUBR (Fvalid_image_instance_type_p);
3992 DEFSUBR (Fimage_instance_type_list);
3993 DEFSUBR (Fimage_instance_name);
3994 DEFSUBR (Fimage_instance_string);
3995 DEFSUBR (Fimage_instance_file_name);
3996 DEFSUBR (Fimage_instance_mask_file_name);
3997 DEFSUBR (Fimage_instance_depth);
3998 DEFSUBR (Fimage_instance_height);
3999 DEFSUBR (Fimage_instance_width);
4000 DEFSUBR (Fimage_instance_hotspot_x);
4001 DEFSUBR (Fimage_instance_hotspot_y);
4002 DEFSUBR (Fimage_instance_foreground);
4003 DEFSUBR (Fimage_instance_background);
4004 DEFSUBR (Fimage_instance_property);
4005 DEFSUBR (Fset_image_instance_property);
4006 DEFSUBR (Fcolorize_image_instance);
4008 DEFSUBR (Fsubwindowp);
4009 DEFSUBR (Fimage_instance_subwindow_id);
4010 DEFSUBR (Fresize_subwindow);
4011 DEFSUBR (Fforce_subwindow_map);
4013 /* Qnothing defined as part of the "nothing" image-instantiator
4015 /* Qtext defined in general.c */
4016 defsymbol (&Qmono_pixmap, "mono-pixmap");
4017 defsymbol (&Qcolor_pixmap, "color-pixmap");
4018 /* Qpointer defined in general.c */
4022 defsymbol (&Qglyphp, "glyphp");
4023 defsymbol (&Qcontrib_p, "contrib-p");
4024 defsymbol (&Qbaseline, "baseline");
4026 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
4027 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
4028 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
4030 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
4032 DEFSUBR (Fglyph_type);
4033 DEFSUBR (Fvalid_glyph_type_p);
4034 DEFSUBR (Fglyph_type_list);
4036 DEFSUBR (Fmake_glyph_internal);
4037 DEFSUBR (Fglyph_width);
4038 DEFSUBR (Fglyph_ascent);
4039 DEFSUBR (Fglyph_descent);
4040 DEFSUBR (Fglyph_height);
4042 /* Qbuffer defined in general.c. */
4043 /* Qpointer defined above */
4046 deferror (&Qimage_conversion_error,
4047 "image-conversion-error",
4048 "image-conversion error", Qio_error);
4053 specifier_type_create_image (void)
4055 /* image specifiers */
4057 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
4059 SPECIFIER_HAS_METHOD (image, create);
4060 SPECIFIER_HAS_METHOD (image, mark);
4061 SPECIFIER_HAS_METHOD (image, instantiate);
4062 SPECIFIER_HAS_METHOD (image, validate);
4063 SPECIFIER_HAS_METHOD (image, after_change);
4064 SPECIFIER_HAS_METHOD (image, going_to_add);
4068 image_instantiator_format_create (void)
4070 /* image instantiators */
4072 the_image_instantiator_format_entry_dynarr =
4073 Dynarr_new (image_instantiator_format_entry);
4075 Vimage_instantiator_format_list = Qnil;
4076 staticpro (&Vimage_instantiator_format_list);
4078 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
4080 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
4081 IIFORMAT_HAS_METHOD (nothing, instantiate);
4083 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
4085 IIFORMAT_HAS_METHOD (inherit, validate);
4086 IIFORMAT_HAS_METHOD (inherit, normalize);
4087 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
4088 IIFORMAT_HAS_METHOD (inherit, instantiate);
4090 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
4092 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
4094 IIFORMAT_HAS_METHOD (string, validate);
4095 IIFORMAT_HAS_METHOD (string, possible_dest_types);
4096 IIFORMAT_HAS_METHOD (string, instantiate);
4098 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4100 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4102 IIFORMAT_HAS_METHOD (formatted_string, validate);
4103 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4104 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
4106 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
4109 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
4110 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
4111 IIFORMAT_HAS_METHOD (subwindow, instantiate);
4112 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
4113 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
4115 #ifdef HAVE_WINDOW_SYSTEM
4116 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4118 IIFORMAT_HAS_METHOD (xbm, validate);
4119 IIFORMAT_HAS_METHOD (xbm, normalize);
4120 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4122 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4123 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4124 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4125 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4126 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4127 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4128 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4129 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4130 #endif /* HAVE_WINDOW_SYSTEM */
4133 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
4135 IIFORMAT_HAS_METHOD (xface, validate);
4136 IIFORMAT_HAS_METHOD (xface, normalize);
4137 IIFORMAT_HAS_METHOD (xface, possible_dest_types);
4139 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
4140 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
4141 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
4142 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
4143 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
4144 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
4148 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
4150 IIFORMAT_HAS_METHOD (xpm, validate);
4151 IIFORMAT_HAS_METHOD (xpm, normalize);
4152 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
4154 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
4155 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
4156 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
4157 #endif /* HAVE_XPM */
4161 vars_of_glyphs (void)
4163 Vthe_nothing_vector = vector1 (Qnothing);
4164 staticpro (&Vthe_nothing_vector);
4166 /* image instances */
4168 Vimage_instance_type_list = Fcons (Qnothing,
4169 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
4170 Qpointer, Qsubwindow, Qwidget));
4171 staticpro (&Vimage_instance_type_list);
4175 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
4176 staticpro (&Vglyph_type_list);
4178 /* The octal-escape glyph, control-arrow-glyph and
4179 invisible-text-glyph are completely initialized in glyphs.el */
4181 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
4182 What to prefix character codes displayed in octal with.
4184 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4186 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
4187 What to use as an arrow for control characters.
4189 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
4190 redisplay_glyph_changed);
4192 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
4193 What to use to indicate the presence of invisible text.
4194 This is the glyph that is displayed when an ellipsis is called for
4195 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
4196 Normally this is three dots ("...").
4198 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
4199 redisplay_glyph_changed);
4201 /* Partially initialized in glyphs.el */
4202 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
4203 What to display at the beginning of horizontally scrolled lines.
4205 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4206 #ifdef HAVE_WINDOW_SYSTEM
4212 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
4213 Definitions of logical color-names used when reading XPM files.
4214 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
4215 The COLOR-NAME should be a string, which is the name of the color to define;
4216 the FORM should evaluate to a `color' specifier object, or a string to be
4217 passed to `make-color-instance'. If a loaded XPM file references a symbolic
4218 color called COLOR-NAME, it will display as the computed color instead.
4220 The default value of this variable defines the logical color names
4221 \"foreground\" and \"background\" to be the colors of the `default' face.
4223 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
4224 #endif /* HAVE_XPM */
4231 specifier_vars_of_glyphs (void)
4233 /* #### Can we GC here? The set_specifier_* calls definitely need */
4235 /* display tables */
4237 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
4238 *The display table currently in use.
4239 This is a specifier; use `set-specifier' to change it.
4240 The display table is a vector created with `make-display-table'.
4241 The 256 elements control how to display each possible text character.
4242 Each value should be a string, a glyph, a vector or nil.
4243 If a value is a vector it must be composed only of strings and glyphs.
4244 nil means display the character in the default fashion.
4245 Faces can have their own, overriding display table.
4247 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
4248 set_specifier_fallback (Vcurrent_display_table,
4249 list1 (Fcons (Qnil, Qnil)));
4250 set_specifier_caching (Vcurrent_display_table,
4251 slot_offset (struct window,
4253 some_window_value_changed,
4258 complex_vars_of_glyphs (void)
4260 /* Partially initialized in glyphs-x.c, glyphs.el */
4261 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
4262 What to display at the end of truncated lines.
4264 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4266 /* Partially initialized in glyphs-x.c, glyphs.el */
4267 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
4268 What to display at the end of wrapped lines.
4270 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4272 /* Partially initialized in glyphs-x.c, glyphs.el */
4273 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
4274 The glyph used to display the XEmacs logo at startup.
4276 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);