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 (xpm);
96 Lisp_Object Q_color_symbols;
99 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
100 struct image_instantiator_format_entry
104 struct image_instantiator_methods *meths;
109 Dynarr_declare (struct image_instantiator_format_entry);
110 } image_instantiator_format_entry_dynarr;
112 image_instantiator_format_entry_dynarr *
113 the_image_instantiator_format_entry_dynarr;
115 static Lisp_Object allocate_image_instance (Lisp_Object device);
116 static void image_validate (Lisp_Object instantiator);
117 static void glyph_property_was_changed (Lisp_Object glyph,
118 Lisp_Object property,
120 EXFUN (Fimage_instance_type, 1);
121 EXFUN (Fglyph_type, 1);
124 /****************************************************************************
125 * Image Instantiators *
126 ****************************************************************************/
128 struct image_instantiator_methods *
129 decode_device_ii_format (Lisp_Object device, Lisp_Object format,
134 if (!SYMBOLP (format))
136 if (ERRB_EQ (errb, ERROR_ME))
137 CHECK_SYMBOL (format);
141 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
145 Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
148 Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
150 if ((NILP (d) && NILP (device))
153 EQ (CONSOLE_TYPE (XCONSOLE
154 (DEVICE_CONSOLE (XDEVICE (device)))), d)))
155 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
159 maybe_signal_simple_error ("Invalid image-instantiator format", format,
165 struct image_instantiator_methods *
166 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
168 return decode_device_ii_format (Qnil, format, errb);
172 valid_image_instantiator_format_p (Lisp_Object format)
174 return (decode_image_instantiator_format (format, ERROR_ME_NOT) != 0);
177 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
179 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
180 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
181 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
182 'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled.
184 (image_instantiator_format))
186 return valid_image_instantiator_format_p (image_instantiator_format) ?
190 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
192 Return a list of valid image-instantiator formats.
196 return Fcopy_sequence (Vimage_instantiator_format_list);
200 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol,
201 struct image_instantiator_methods *meths)
203 struct image_instantiator_format_entry entry;
205 entry.symbol = symbol;
206 entry.device = device;
208 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
209 Vimage_instantiator_format_list =
210 Fcons (symbol, Vimage_instantiator_format_list);
214 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
216 image_instantiator_methods *meths)
218 add_entry_to_device_ii_format_list (Qnil, symbol, meths);
222 get_image_conversion_list (Lisp_Object console_type)
224 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
227 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
229 Set the image-conversion-list for consoles of the given TYPE.
230 The image-conversion-list specifies how image instantiators that
231 are strings should be interpreted. Each element of the list should be
232 a list of two elements (a regular expression string and a vector) or
233 a list of three elements (the preceding two plus an integer index into
234 the vector). The string is converted to the vector associated with the
235 first matching regular expression. If a vector index is specified, the
236 string itself is substituted into that position in the vector.
238 Note: The conversion above is applied when the image instantiator is
239 added to an image specifier, not when the specifier is actually
240 instantiated. Therefore, changing the image-conversion-list only affects
241 newly-added instantiators. Existing instantiators in glyphs and image
242 specifiers will not be affected.
244 (console_type, list))
247 Lisp_Object *imlist = get_image_conversion_list (console_type);
249 /* Check the list to make sure that it only has valid entries. */
251 EXTERNAL_LIST_LOOP (tail, list)
253 Lisp_Object mapping = XCAR (tail);
255 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
256 if (!CONSP (mapping) ||
257 !CONSP (XCDR (mapping)) ||
258 (!NILP (XCDR (XCDR (mapping))) &&
259 (!CONSP (XCDR (XCDR (mapping))) ||
260 !NILP (XCDR (XCDR (XCDR (mapping)))))))
261 signal_simple_error ("Invalid mapping form", mapping);
264 Lisp_Object exp = XCAR (mapping);
265 Lisp_Object typevec = XCAR (XCDR (mapping));
266 Lisp_Object pos = Qnil;
271 CHECK_VECTOR (typevec);
272 if (!NILP (XCDR (XCDR (mapping))))
274 pos = XCAR (XCDR (XCDR (mapping)));
276 if (XINT (pos) < 0 ||
277 XINT (pos) >= XVECTOR_LENGTH (typevec))
279 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
282 newvec = Fcopy_sequence (typevec);
284 XVECTOR_DATA (newvec)[XINT (pos)] = exp;
286 image_validate (newvec);
291 *imlist = Fcopy_tree (list, Qt);
295 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
297 Return the image-conversion-list for devices of the given TYPE.
298 The image-conversion-list specifies how to interpret image string
299 instantiators for the specified console type. See
300 `set-console-type-image-conversion-list' for a description of its syntax.
304 return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
307 /* Process a string instantiator according to the image-conversion-list for
308 CONSOLE_TYPE. Returns a vector. */
311 process_image_string_instantiator (Lisp_Object data,
312 Lisp_Object console_type,
317 LIST_LOOP (tail, *get_image_conversion_list (console_type))
319 Lisp_Object mapping = XCAR (tail);
320 Lisp_Object exp = XCAR (mapping);
321 Lisp_Object typevec = XCAR (XCDR (mapping));
323 /* if the result is of a type that can't be instantiated
324 (e.g. a string when we're dealing with a pointer glyph),
327 IIFORMAT_METH (decode_image_instantiator_format
328 (XVECTOR_DATA (typevec)[0], ERROR_ME),
329 possible_dest_types, ())))
331 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
333 if (!NILP (XCDR (XCDR (mapping))))
335 int pos = XINT (XCAR (XCDR (XCDR (mapping))));
336 Lisp_Object newvec = Fcopy_sequence (typevec);
337 XVECTOR_DATA (newvec)[pos] = data;
346 signal_simple_error ("Unable to interpret glyph instantiator",
353 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
354 Lisp_Object default_)
357 int instantiator_len;
359 elt = XVECTOR_DATA (vector);
360 instantiator_len = XVECTOR_LENGTH (vector);
365 while (instantiator_len > 0)
367 if (EQ (elt[0], keyword))
370 instantiator_len -= 2;
377 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
379 return find_keyword_in_vector_or_given (vector, keyword, Qnil);
383 check_valid_string (Lisp_Object data)
389 check_valid_vector (Lisp_Object data)
395 check_valid_face (Lisp_Object data)
401 check_valid_int (Lisp_Object data)
407 file_or_data_must_be_present (Lisp_Object instantiator)
409 if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
410 NILP (find_keyword_in_vector (instantiator, Q_data)))
411 signal_simple_error ("Must supply either :file or :data",
416 data_must_be_present (Lisp_Object instantiator)
418 if (NILP (find_keyword_in_vector (instantiator, Q_data)))
419 signal_simple_error ("Must supply :data", instantiator);
423 face_must_be_present (Lisp_Object instantiator)
425 if (NILP (find_keyword_in_vector (instantiator, Q_face)))
426 signal_simple_error ("Must supply :face", instantiator);
429 /* utility function useful in retrieving data from a file. */
432 make_string_from_file (Lisp_Object file)
434 /* This function can call lisp */
435 int count = specpdl_depth ();
436 Lisp_Object temp_buffer;
440 specbind (Qinhibit_quit, Qt);
441 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
442 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
443 GCPRO1 (temp_buffer);
444 set_buffer_internal (XBUFFER (temp_buffer));
445 Ferase_buffer (Qnil);
446 specbind (intern ("format-alist"), Qnil);
447 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
448 data = Fbuffer_substring (Qnil, Qnil, Qnil);
449 unbind_to (count, Qnil);
454 /* The following two functions are provided to make it easier for
455 the normalize methods to work with keyword-value vectors.
456 Hash tables are kind of heavyweight for this purpose.
457 (If vectors were resizable, we could avoid this problem;
458 but they're not.) An alternative approach that might be
459 more efficient but require more work is to use a type of
460 assoc-Dynarr and provide primitives for deleting elements out
461 of it. (However, you'd also have to add an unwind-protect
462 to make sure the Dynarr got freed in case of an error in
463 the normalization process.) */
466 tagged_vector_to_alist (Lisp_Object vector)
468 Lisp_Object *elt = XVECTOR_DATA (vector);
469 int len = XVECTOR_LENGTH (vector);
470 Lisp_Object result = Qnil;
473 for (len -= 2; len >= 1; len -= 2)
474 result = Fcons (Fcons (elt[len], elt[len+1]), result);
480 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
482 int len = 1 + 2 * XINT (Flength (alist));
483 Lisp_Object *elt = alloca_array (Lisp_Object, len);
489 LIST_LOOP (rest, alist)
491 Lisp_Object pair = XCAR (rest);
492 elt[i] = XCAR (pair);
493 elt[i+1] = XCDR (pair);
497 return Fvector (len, elt);
501 normalize_image_instantiator (Lisp_Object instantiator,
503 Lisp_Object dest_mask)
505 if (IMAGE_INSTANCEP (instantiator))
508 if (STRINGP (instantiator))
509 instantiator = process_image_string_instantiator (instantiator, contype,
512 assert (VECTORP (instantiator));
513 /* We have to always store the actual pixmap data and not the
514 filename even though this is a potential memory pig. We have to
515 do this because it is quite possible that we will need to
516 instantiate a new instance of the pixmap and the file will no
517 longer exist (e.g. w3 pixmaps are almost always from temporary
521 struct image_instantiator_methods *meths;
523 GCPRO1 (instantiator);
525 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
527 RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
528 (instantiator, contype),
534 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
535 Lisp_Object instantiator,
536 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
539 Lisp_Object ii = allocate_image_instance (device);
540 struct image_instantiator_methods *meths;
545 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
547 methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate);
548 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
549 pointer_bg, dest_mask, domain));
551 /* now do device specific instantiation */
552 meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0],
555 if (!methp && (!meths || !HAS_IIFORMAT_METH_P (meths, instantiate)))
557 ("Don't know how to instantiate this image instantiator?",
559 MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
560 pointer_bg, dest_mask, domain));
567 /****************************************************************************
568 * Image-Instance Object *
569 ****************************************************************************/
571 Lisp_Object Qimage_instancep;
574 mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
576 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
579 switch (IMAGE_INSTANCE_TYPE (i))
582 markobj (IMAGE_INSTANCE_TEXT_STRING (i));
584 case IMAGE_MONO_PIXMAP:
585 case IMAGE_COLOR_PIXMAP:
586 markobj (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
587 markobj (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
588 markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
589 markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
590 markobj (IMAGE_INSTANCE_PIXMAP_FG (i));
591 markobj (IMAGE_INSTANCE_PIXMAP_BG (i));
595 markobj (IMAGE_INSTANCE_WIDGET_TYPE (i));
596 markobj (IMAGE_INSTANCE_WIDGET_PROPS (i));
597 markobj (IMAGE_INSTANCE_WIDGET_FACE (i));
598 mark_gui_item (&IMAGE_INSTANCE_WIDGET_ITEM (i), markobj);
599 case IMAGE_SUBWINDOW:
600 markobj (IMAGE_INSTANCE_SUBWINDOW_FRAME (i));
607 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i, markobj));
613 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
617 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
620 error ("printing unreadable object #<image-instance 0x%x>",
622 write_c_string ("#<image-instance (", printcharfun);
623 print_internal (Fimage_instance_type (obj), printcharfun, 0);
624 write_c_string (") ", printcharfun);
625 if (!NILP (ii->name))
627 print_internal (ii->name, printcharfun, 1);
628 write_c_string (" ", printcharfun);
630 write_c_string ("on ", printcharfun);
631 print_internal (ii->device, printcharfun, 0);
632 write_c_string (" ", printcharfun);
633 switch (IMAGE_INSTANCE_TYPE (ii))
639 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
642 case IMAGE_MONO_PIXMAP:
643 case IMAGE_COLOR_PIXMAP:
645 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
648 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
649 s = strrchr ((char *) XSTRING_DATA (filename), '/');
651 print_internal (build_string (s + 1), printcharfun, 1);
653 print_internal (filename, printcharfun, 1);
655 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
656 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
657 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
658 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
660 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
661 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
662 write_c_string (buf, printcharfun);
663 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
664 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
666 write_c_string (" @", printcharfun);
667 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
669 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
670 write_c_string (buf, printcharfun);
673 write_c_string ("??", printcharfun);
674 write_c_string (",", printcharfun);
675 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
677 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
678 write_c_string (buf, printcharfun);
681 write_c_string ("??", printcharfun);
683 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
684 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
686 write_c_string (" (", printcharfun);
687 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
691 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
693 write_c_string ("/", printcharfun);
694 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
698 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
700 write_c_string (")", printcharfun);
705 if (!NILP (IMAGE_INSTANCE_WIDGET_CALLBACK (ii)))
707 print_internal (IMAGE_INSTANCE_WIDGET_CALLBACK (ii), printcharfun, 0);
708 write_c_string (", ", printcharfun);
710 if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
712 write_c_string (" (", printcharfun);
714 (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
715 write_c_string (")", printcharfun);
718 if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii)))
719 print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0);
721 case IMAGE_SUBWINDOW:
722 sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii),
723 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii));
724 write_c_string (buf, printcharfun);
726 /* This is stolen from frame.c. Subwindows are strange in that they
727 are specific to a particular frame so we want to print in their
728 description what that frame is. */
730 write_c_string (" on #<", printcharfun);
732 struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
734 if (!FRAME_LIVE_P (f))
735 write_c_string ("dead", printcharfun);
737 write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
740 write_c_string ("-frame ", printcharfun);
742 write_c_string (">", printcharfun);
743 sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
744 write_c_string (buf, printcharfun);
752 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
753 (ii, printcharfun, escapeflag));
754 sprintf (buf, " 0x%x>", ii->header.uid);
755 write_c_string (buf, printcharfun);
759 finalize_image_instance (void *header, int for_disksave)
761 struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header;
763 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
764 /* objects like this exist at dump time, so don't bomb out. */
766 if (for_disksave) finalose (i);
768 /* do this so that the cachels get reset */
769 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET
771 IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW)
773 MARK_FRAME_GLYPHS_CHANGED
774 (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)));
777 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
781 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
783 struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
784 struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
785 struct device *d1 = XDEVICE (i1->device);
786 struct device *d2 = XDEVICE (i2->device);
790 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2))
792 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
796 switch (IMAGE_INSTANCE_TYPE (i1))
802 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
803 IMAGE_INSTANCE_TEXT_STRING (i2),
808 case IMAGE_MONO_PIXMAP:
809 case IMAGE_COLOR_PIXMAP:
811 if (!(IMAGE_INSTANCE_PIXMAP_WIDTH (i1) ==
812 IMAGE_INSTANCE_PIXMAP_WIDTH (i2) &&
813 IMAGE_INSTANCE_PIXMAP_HEIGHT (i1) ==
814 IMAGE_INSTANCE_PIXMAP_HEIGHT (i2) &&
815 IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
816 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
817 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
818 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
819 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
820 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
821 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
822 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
824 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
825 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
831 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
832 IMAGE_INSTANCE_WIDGET_TYPE (i2)) &&
833 EQ (IMAGE_INSTANCE_WIDGET_CALLBACK (i1),
834 IMAGE_INSTANCE_WIDGET_CALLBACK (i2))
835 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
836 IMAGE_INSTANCE_WIDGET_PROPS (i2),
838 && internal_equal (IMAGE_INSTANCE_WIDGET_TEXT (i1),
839 IMAGE_INSTANCE_WIDGET_TEXT (i2),
842 case IMAGE_SUBWINDOW:
843 if (!(IMAGE_INSTANCE_SUBWINDOW_WIDTH (i1) ==
844 IMAGE_INSTANCE_SUBWINDOW_WIDTH (i2) &&
845 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i1) ==
846 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i2) &&
847 IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
848 IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
856 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
860 image_instance_hash (Lisp_Object obj, int depth)
862 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
863 struct device *d = XDEVICE (i->device);
864 unsigned long hash = (unsigned long) d;
866 switch (IMAGE_INSTANCE_TYPE (i))
872 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
876 case IMAGE_MONO_PIXMAP:
877 case IMAGE_COLOR_PIXMAP:
879 hash = HASH5 (hash, IMAGE_INSTANCE_PIXMAP_WIDTH (i),
880 IMAGE_INSTANCE_PIXMAP_HEIGHT (i),
881 IMAGE_INSTANCE_PIXMAP_DEPTH (i),
882 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
888 internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1),
889 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
890 internal_hash (IMAGE_INSTANCE_WIDGET_CALLBACK (i), depth + 1));
891 case IMAGE_SUBWINDOW:
892 hash = HASH4 (hash, IMAGE_INSTANCE_SUBWINDOW_WIDTH (i),
893 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i),
894 (int) IMAGE_INSTANCE_SUBWINDOW_ID (i));
901 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
905 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
906 mark_image_instance, print_image_instance,
907 finalize_image_instance, image_instance_equal,
909 struct Lisp_Image_Instance);
912 allocate_image_instance (Lisp_Object device)
914 struct Lisp_Image_Instance *lp =
915 alloc_lcrecord_type (struct Lisp_Image_Instance, lrecord_image_instance);
920 lp->type = IMAGE_NOTHING;
922 XSETIMAGE_INSTANCE (val, lp);
926 static enum image_instance_type
927 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
929 if (ERRB_EQ (errb, ERROR_ME))
932 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
933 if (EQ (type, Qtext)) return IMAGE_TEXT;
934 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
935 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
936 if (EQ (type, Qpointer)) return IMAGE_POINTER;
937 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
938 if (EQ (type, Qwidget)) return IMAGE_WIDGET;
940 maybe_signal_simple_error ("Invalid image-instance type", type,
943 return IMAGE_UNKNOWN; /* not reached */
947 encode_image_instance_type (enum image_instance_type type)
951 case IMAGE_NOTHING: return Qnothing;
952 case IMAGE_TEXT: return Qtext;
953 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
954 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
955 case IMAGE_POINTER: return Qpointer;
956 case IMAGE_SUBWINDOW: return Qsubwindow;
957 case IMAGE_WIDGET: return Qwidget;
962 return Qnil; /* not reached */
966 image_instance_type_to_mask (enum image_instance_type type)
968 /* This depends on the fact that enums are assigned consecutive
969 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
970 first enum.) I'm fairly sure this behavior in ANSI-mandated,
971 so there should be no portability problems here. */
972 return (1 << ((int) (type) - 1));
976 decode_image_instance_type_list (Lisp_Object list)
986 enum image_instance_type type =
987 decode_image_instance_type (list, ERROR_ME);
988 return image_instance_type_to_mask (type);
991 EXTERNAL_LIST_LOOP (rest, list)
993 enum image_instance_type type =
994 decode_image_instance_type (XCAR (rest), ERROR_ME);
995 mask |= image_instance_type_to_mask (type);
1002 encode_image_instance_type_list (int mask)
1005 Lisp_Object result = Qnil;
1011 result = Fcons (encode_image_instance_type
1012 ((enum image_instance_type) count), result);
1016 return Fnreverse (result);
1020 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1021 int desired_dest_mask)
1026 (emacs_doprnt_string_lisp_2
1028 "No compatible image-instance types given: wanted one of %s, got %s",
1030 encode_image_instance_type_list (desired_dest_mask),
1031 encode_image_instance_type_list (given_dest_mask)),
1036 valid_image_instance_type_p (Lisp_Object type)
1038 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1041 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1042 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1043 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1044 'pointer, and 'subwindow, depending on how XEmacs was compiled.
1046 (image_instance_type))
1048 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1051 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1052 Return a list of valid image-instance types.
1056 return Fcopy_sequence (Vimage_instance_type_list);
1060 decode_error_behavior_flag (Lisp_Object no_error)
1062 if (NILP (no_error)) return ERROR_ME;
1063 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
1064 else return ERROR_ME_WARN;
1068 encode_error_behavior_flag (Error_behavior errb)
1070 if (ERRB_EQ (errb, ERROR_ME))
1072 else if (ERRB_EQ (errb, ERROR_ME_NOT))
1076 assert (ERRB_EQ (errb, ERROR_ME_WARN));
1082 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
1083 Lisp_Object dest_types)
1086 struct gcpro gcpro1;
1089 XSETDEVICE (device, decode_device (device));
1090 /* instantiate_image_instantiator() will abort if given an
1091 image instance ... */
1092 if (IMAGE_INSTANCEP (data))
1093 signal_simple_error ("Image instances not allowed here", data);
1094 image_validate (data);
1095 dest_mask = decode_image_instance_type_list (dest_types);
1096 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
1097 make_int (dest_mask));
1099 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
1100 signal_simple_error ("Inheritance not allowed here", data);
1101 ii = instantiate_image_instantiator (device, device, data,
1102 Qnil, Qnil, dest_mask);
1103 RETURN_UNGCPRO (ii);
1106 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1107 Return a new `image-instance' object.
1109 Image-instance objects encapsulate the way a particular image (pixmap,
1110 etc.) is displayed on a particular device. In most circumstances, you
1111 do not need to directly create image instances; use a glyph instead.
1112 However, it may occasionally be useful to explicitly create image
1113 instances, if you want more control over the instantiation process.
1115 DATA is an image instantiator, which describes the image; see
1116 `image-specifier-p' for a description of the allowed values.
1118 DEST-TYPES should be a list of allowed image instance types that can
1119 be generated. The recognized image instance types are
1122 Nothing is displayed.
1124 Displayed as text. The foreground and background colors and the
1125 font of the text are specified independent of the pixmap. Typically
1126 these attributes will come from the face of the surrounding text,
1127 unless a face is specified for the glyph in which the image appears.
1129 Displayed as a mono pixmap (a pixmap with only two colors where the
1130 foreground and background can be specified independent of the pixmap;
1131 typically the pixmap assumes the foreground and background colors of
1132 the text around it, unless a face is specified for the glyph in which
1135 Displayed as a color pixmap.
1137 Used as the mouse pointer for a window.
1139 A child window that is treated as an image. This allows (e.g.)
1140 another program to be responsible for drawing into the window.
1141 Not currently implemented.
1143 The DEST-TYPES list is unordered. If multiple destination types
1144 are possible for a given instantiator, the "most natural" type
1145 for the instantiator's format is chosen. (For XBM, the most natural
1146 types are `mono-pixmap', followed by `color-pixmap', followed by
1147 `pointer'. For the other normal image formats, the most natural
1148 types are `color-pixmap', followed by `mono-pixmap', followed by
1149 `pointer'. For the string and formatted-string formats, the most
1150 natural types are `text', followed by `mono-pixmap' (not currently
1151 implemented), followed by `color-pixmap' (not currently implemented).
1152 The other formats can only be instantiated as one type. (If you
1153 want to control more specifically the order of the types into which
1154 an image is instantiated, just call `make-image-instance' repeatedly
1155 until it succeeds, passing less and less preferred destination types
1158 If DEST-TYPES is omitted, all possible types are allowed.
1160 NO-ERROR controls what happens when the image cannot be generated.
1161 If nil, an error message is generated. If t, no messages are
1162 generated and this function returns nil. If anything else, a warning
1163 message is generated and this function returns nil.
1165 (data, device, dest_types, no_error))
1167 Error_behavior errb = decode_error_behavior_flag (no_error);
1169 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1171 3, data, device, dest_types);
1174 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1175 Return non-nil if OBJECT is an image instance.
1179 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1182 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1183 Return the type of the given image instance.
1184 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1185 'color-pixmap, 'pointer, or 'subwindow.
1189 CHECK_IMAGE_INSTANCE (image_instance);
1190 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1193 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1194 Return the name of the given image instance.
1198 CHECK_IMAGE_INSTANCE (image_instance);
1199 return XIMAGE_INSTANCE_NAME (image_instance);
1202 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1203 Return the string of the given image instance.
1204 This will only be non-nil for text image instances and widgets.
1208 CHECK_IMAGE_INSTANCE (image_instance);
1209 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1210 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1211 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1212 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1217 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1218 Return the given property of the given image instance.
1219 Returns nil if the property or the property method do not exist for
1220 the image instance in the domain.
1222 (image_instance, prop))
1224 struct Lisp_Image_Instance* ii;
1225 Lisp_Object type, ret;
1226 struct image_instantiator_methods* meths;
1228 CHECK_IMAGE_INSTANCE (image_instance);
1229 CHECK_SYMBOL (prop);
1230 ii = XIMAGE_INSTANCE (image_instance);
1232 /* ... then try device specific methods ... */
1233 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1234 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1235 type, ERROR_ME_NOT);
1236 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1238 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1242 /* ... then format specific methods ... */
1243 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1244 if (meths && HAS_IIFORMAT_METH_P (meths, property)
1246 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1254 DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /*
1255 Set the given property of the given image instance.
1256 Does nothing if the property or the property method do not exist for
1257 the image instance in the domain.
1259 (image_instance, prop, val))
1261 struct Lisp_Image_Instance* ii;
1262 Lisp_Object type, ret;
1263 struct image_instantiator_methods* meths;
1265 CHECK_IMAGE_INSTANCE (image_instance);
1266 CHECK_SYMBOL (prop);
1267 ii = XIMAGE_INSTANCE (image_instance);
1268 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1269 /* try device specific methods first ... */
1270 meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii),
1271 type, ERROR_ME_NOT);
1272 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1275 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1279 /* ... then format specific methods ... */
1280 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1281 if (meths && HAS_IIFORMAT_METH_P (meths, set_property)
1284 IIFORMAT_METH (meths, set_property, (image_instance, prop, val))))
1292 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1293 Return the file name from which IMAGE-INSTANCE was read, if known.
1297 CHECK_IMAGE_INSTANCE (image_instance);
1299 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1301 case IMAGE_MONO_PIXMAP:
1302 case IMAGE_COLOR_PIXMAP:
1304 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1311 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1312 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1316 CHECK_IMAGE_INSTANCE (image_instance);
1318 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1320 case IMAGE_MONO_PIXMAP:
1321 case IMAGE_COLOR_PIXMAP:
1323 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1330 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1331 Return the depth of the image instance.
1332 This is 0 for a bitmap, or a positive integer for a pixmap.
1336 CHECK_IMAGE_INSTANCE (image_instance);
1338 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1340 case IMAGE_MONO_PIXMAP:
1341 case IMAGE_COLOR_PIXMAP:
1343 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1350 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1351 Return the height of the image instance, in pixels.
1355 CHECK_IMAGE_INSTANCE (image_instance);
1357 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1359 case IMAGE_MONO_PIXMAP:
1360 case IMAGE_COLOR_PIXMAP:
1362 return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance));
1364 case IMAGE_SUBWINDOW:
1366 return make_int (XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (image_instance));
1373 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1374 Return the width of the image instance, in pixels.
1378 CHECK_IMAGE_INSTANCE (image_instance);
1380 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1382 case IMAGE_MONO_PIXMAP:
1383 case IMAGE_COLOR_PIXMAP:
1385 return make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance));
1387 case IMAGE_SUBWINDOW:
1389 return make_int (XIMAGE_INSTANCE_SUBWINDOW_WIDTH (image_instance));
1396 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1397 Return the X coordinate of the image instance's hotspot, if known.
1398 This is a point relative to the origin of the pixmap. When an image is
1399 used as a mouse pointer, the hotspot is the point on the image that sits
1400 over the location that the pointer points to. This is, for example, the
1401 tip of the arrow or the center of the crosshairs.
1402 This will always be nil for a non-pointer image instance.
1406 CHECK_IMAGE_INSTANCE (image_instance);
1408 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1410 case IMAGE_MONO_PIXMAP:
1411 case IMAGE_COLOR_PIXMAP:
1413 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1420 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1421 Return the Y coordinate of the image instance's hotspot, if known.
1422 This is a point relative to the origin of the pixmap. When an image is
1423 used as a mouse pointer, the hotspot is the point on the image that sits
1424 over the location that the pointer points to. This is, for example, the
1425 tip of the arrow or the center of the crosshairs.
1426 This will always be nil for a non-pointer image instance.
1430 CHECK_IMAGE_INSTANCE (image_instance);
1432 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1434 case IMAGE_MONO_PIXMAP:
1435 case IMAGE_COLOR_PIXMAP:
1437 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1444 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1445 Return the foreground color of IMAGE-INSTANCE, if applicable.
1446 This will be a color instance or nil. (It will only be non-nil for
1447 colorized mono pixmaps and for pointers.)
1451 CHECK_IMAGE_INSTANCE (image_instance);
1453 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1455 case IMAGE_MONO_PIXMAP:
1456 case IMAGE_COLOR_PIXMAP:
1458 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1461 return FACE_FOREGROUND (
1462 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1463 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1471 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1472 Return the background color of IMAGE-INSTANCE, if applicable.
1473 This will be a color instance or nil. (It will only be non-nil for
1474 colorized mono pixmaps and for pointers.)
1478 CHECK_IMAGE_INSTANCE (image_instance);
1480 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1482 case IMAGE_MONO_PIXMAP:
1483 case IMAGE_COLOR_PIXMAP:
1485 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1488 return FACE_BACKGROUND (
1489 XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1490 XIMAGE_INSTANCE_SUBWINDOW_FRAME
1499 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1500 Make the image instance be displayed in the given colors.
1501 This function returns a new image instance that is exactly like the
1502 specified one except that (if possible) the foreground and background
1503 colors and as specified. Currently, this only does anything if the image
1504 instance is a mono pixmap; otherwise, the same image instance is returned.
1506 (image_instance, foreground, background))
1511 CHECK_IMAGE_INSTANCE (image_instance);
1512 CHECK_COLOR_INSTANCE (foreground);
1513 CHECK_COLOR_INSTANCE (background);
1515 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1516 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1517 return image_instance;
1519 new = allocate_image_instance (device);
1520 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1521 /* note that if this method returns non-zero, this method MUST
1522 copy any window-system resources, so that when one image instance is
1523 freed, the other one is not hosed. */
1524 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1526 return image_instance;
1531 /************************************************************************/
1533 /************************************************************************/
1535 signal_image_error (CONST char *reason, Lisp_Object frob)
1537 signal_error (Qimage_conversion_error,
1538 list2 (build_translated_string (reason), frob));
1542 signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1)
1544 signal_error (Qimage_conversion_error,
1545 list3 (build_translated_string (reason), frob0, frob1));
1548 /****************************************************************************
1550 ****************************************************************************/
1553 nothing_possible_dest_types (void)
1555 return IMAGE_NOTHING_MASK;
1559 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1560 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1561 int dest_mask, Lisp_Object domain)
1563 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1565 if (dest_mask & IMAGE_NOTHING_MASK)
1566 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1568 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1572 /****************************************************************************
1574 ****************************************************************************/
1577 inherit_validate (Lisp_Object instantiator)
1579 face_must_be_present (instantiator);
1583 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1587 assert (XVECTOR_LENGTH (inst) == 3);
1588 face = XVECTOR_DATA (inst)[2];
1590 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1595 inherit_possible_dest_types (void)
1597 return IMAGE_MONO_PIXMAP_MASK;
1601 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1602 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1603 int dest_mask, Lisp_Object domain)
1605 /* handled specially in image_instantiate */
1610 /****************************************************************************
1612 ****************************************************************************/
1615 string_validate (Lisp_Object instantiator)
1617 data_must_be_present (instantiator);
1621 string_possible_dest_types (void)
1623 return IMAGE_TEXT_MASK;
1626 /* called from autodetect_instantiate() */
1628 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1629 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1630 int dest_mask, Lisp_Object domain)
1632 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1633 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1635 assert (!NILP (data));
1636 if (dest_mask & IMAGE_TEXT_MASK)
1638 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1639 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1642 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1646 /****************************************************************************
1647 * formatted-string *
1648 ****************************************************************************/
1651 formatted_string_validate (Lisp_Object instantiator)
1653 data_must_be_present (instantiator);
1657 formatted_string_possible_dest_types (void)
1659 return IMAGE_TEXT_MASK;
1663 formatted_string_instantiate (Lisp_Object image_instance,
1664 Lisp_Object instantiator,
1665 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1666 int dest_mask, Lisp_Object domain)
1668 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1669 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1671 assert (!NILP (data));
1672 /* #### implement this */
1673 warn_when_safe (Qunimplemented, Qnotice,
1674 "`formatted-string' not yet implemented; assuming `string'");
1675 if (dest_mask & IMAGE_TEXT_MASK)
1677 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1678 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1681 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1685 /************************************************************************/
1686 /* pixmap file functions */
1687 /************************************************************************/
1689 /* If INSTANTIATOR refers to inline data, return Qnil.
1690 If INSTANTIATOR refers to data in a file, return the full filename
1691 if it exists; otherwise, return a cons of (filename).
1693 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
1694 keywords used to look up the file and inline data,
1695 respectively, in the instantiator. Normally these would
1696 be Q_file and Q_data, but might be different for mask data. */
1699 potential_pixmap_file_instantiator (Lisp_Object instantiator,
1700 Lisp_Object file_keyword,
1701 Lisp_Object data_keyword,
1702 Lisp_Object console_type)
1707 assert (VECTORP (instantiator));
1709 data = find_keyword_in_vector (instantiator, data_keyword);
1710 file = find_keyword_in_vector (instantiator, file_keyword);
1712 if (!NILP (file) && NILP (data))
1714 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
1715 (decode_console_type(console_type, ERROR_ME),
1716 locate_pixmap_file, (file));
1721 return Fcons (file, Qnil); /* should have been file */
1728 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
1729 Lisp_Object image_type_tag)
1731 /* This function can call lisp */
1732 Lisp_Object file = Qnil;
1733 struct gcpro gcpro1, gcpro2;
1734 Lisp_Object alist = Qnil;
1736 GCPRO2 (file, alist);
1738 /* Now, convert any file data into inline data. At the end of this,
1739 `data' will contain the inline data (if any) or Qnil, and `file'
1740 will contain the name this data was derived from (if known) or
1743 Note that if we cannot generate any regular inline data, we
1746 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1749 if (CONSP (file)) /* failure locating filename */
1750 signal_double_file_error ("Opening pixmap file",
1751 "no such file or directory",
1754 if (NILP (file)) /* no conversion necessary */
1755 RETURN_UNGCPRO (inst);
1757 alist = tagged_vector_to_alist (inst);
1760 Lisp_Object data = make_string_from_file (file);
1761 alist = remassq_no_quit (Q_file, alist);
1762 /* there can't be a :data at this point. */
1763 alist = Fcons (Fcons (Q_file, file),
1764 Fcons (Fcons (Q_data, data), alist));
1768 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
1770 RETURN_UNGCPRO (result);
1775 #ifdef HAVE_WINDOW_SYSTEM
1776 /**********************************************************************
1778 **********************************************************************/
1780 /* Check if DATA represents a valid inline XBM spec (i.e. a list
1781 of (width height bits), with checking done on the dimensions).
1782 If not, signal an error. */
1785 check_valid_xbm_inline (Lisp_Object data)
1787 Lisp_Object width, height, bits;
1789 if (!CONSP (data) ||
1790 !CONSP (XCDR (data)) ||
1791 !CONSP (XCDR (XCDR (data))) ||
1792 !NILP (XCDR (XCDR (XCDR (data)))))
1793 signal_simple_error ("Must be list of 3 elements", data);
1795 width = XCAR (data);
1796 height = XCAR (XCDR (data));
1797 bits = XCAR (XCDR (XCDR (data)));
1799 CHECK_STRING (bits);
1801 if (!NATNUMP (width))
1802 signal_simple_error ("Width must be a natural number", width);
1804 if (!NATNUMP (height))
1805 signal_simple_error ("Height must be a natural number", height);
1807 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
1808 signal_simple_error ("data is too short for width and height",
1809 vector3 (width, height, bits));
1812 /* Validate method for XBM's. */
1815 xbm_validate (Lisp_Object instantiator)
1817 file_or_data_must_be_present (instantiator);
1820 /* Given a filename that is supposed to contain XBM data, return
1821 the inline representation of it as (width height bits). Return
1822 the hotspot through XHOT and YHOT, if those pointers are not 0.
1823 If there is no hotspot, XHOT and YHOT will contain -1.
1825 If the function fails:
1827 -- if OK_IF_DATA_INVALID is set and the data was invalid,
1829 -- maybe return an error, or return Qnil.
1832 #ifdef HAVE_X_WINDOWS
1833 #include <X11/Xlib.h>
1835 #define XFree(data) free(data)
1839 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
1840 int ok_if_data_invalid)
1845 CONST char *filename_ext;
1847 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
1848 result = read_bitmap_data_from_file (filename_ext, &w, &h,
1851 if (result == BitmapSuccess)
1854 int len = (w + 7) / 8 * h;
1856 retval = list3 (make_int (w), make_int (h),
1857 make_ext_string (data, len, FORMAT_BINARY));
1858 XFree ((char *) data);
1864 case BitmapOpenFailed:
1866 /* should never happen */
1867 signal_double_file_error ("Opening bitmap file",
1868 "no such file or directory",
1871 case BitmapFileInvalid:
1873 if (ok_if_data_invalid)
1875 signal_double_file_error ("Reading bitmap file",
1876 "invalid data in file",
1879 case BitmapNoMemory:
1881 signal_double_file_error ("Reading bitmap file",
1887 signal_double_file_error_2 ("Reading bitmap file",
1888 "unknown error code",
1889 make_int (result), name);
1893 return Qnil; /* not reached */
1897 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
1898 Lisp_Object mask_file, Lisp_Object console_type)
1900 /* This is unclean but it's fairly standard -- a number of the
1901 bitmaps in /usr/include/X11/bitmaps use it -- so we support
1903 if (NILP (mask_file)
1904 /* don't override explicitly specified mask data. */
1905 && NILP (assq_no_quit (Q_mask_data, alist))
1908 mask_file = MAYBE_LISP_CONTYPE_METH
1909 (decode_console_type(console_type, ERROR_ME),
1910 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
1911 if (NILP (mask_file))
1912 mask_file = MAYBE_LISP_CONTYPE_METH
1913 (decode_console_type(console_type, ERROR_ME),
1914 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
1917 if (!NILP (mask_file))
1919 Lisp_Object mask_data =
1920 bitmap_to_lisp_data (mask_file, 0, 0, 0);
1921 alist = remassq_no_quit (Q_mask_file, alist);
1922 /* there can't be a :mask-data at this point. */
1923 alist = Fcons (Fcons (Q_mask_file, mask_file),
1924 Fcons (Fcons (Q_mask_data, mask_data), alist));
1930 /* Normalize method for XBM's. */
1933 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
1935 Lisp_Object file = Qnil, mask_file = Qnil;
1936 struct gcpro gcpro1, gcpro2, gcpro3;
1937 Lisp_Object alist = Qnil;
1939 GCPRO3 (file, mask_file, alist);
1941 /* Now, convert any file data into inline data for both the regular
1942 data and the mask data. At the end of this, `data' will contain
1943 the inline data (if any) or Qnil, and `file' will contain
1944 the name this data was derived from (if known) or Qnil.
1945 Likewise for `mask_file' and `mask_data'.
1947 Note that if we cannot generate any regular inline data, we
1950 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1952 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
1953 Q_mask_data, console_type);
1955 if (CONSP (file)) /* failure locating filename */
1956 signal_double_file_error ("Opening bitmap file",
1957 "no such file or directory",
1960 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
1961 RETURN_UNGCPRO (inst);
1963 alist = tagged_vector_to_alist (inst);
1968 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
1969 alist = remassq_no_quit (Q_file, alist);
1970 /* there can't be a :data at this point. */
1971 alist = Fcons (Fcons (Q_file, file),
1972 Fcons (Fcons (Q_data, data), alist));
1974 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
1975 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1977 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
1978 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1982 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
1985 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1987 RETURN_UNGCPRO (result);
1993 xbm_possible_dest_types (void)
1996 IMAGE_MONO_PIXMAP_MASK |
1997 IMAGE_COLOR_PIXMAP_MASK |
2006 /**********************************************************************
2008 **********************************************************************/
2011 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2017 GET_C_STRING_FILENAME_DATA_ALLOCA (name, fname);
2018 result = XpmReadFileToData (fname, &data);
2020 if (result == XpmSuccess)
2022 Lisp_Object retval = Qnil;
2023 struct buffer *old_buffer = current_buffer;
2024 Lisp_Object temp_buffer =
2025 Fget_buffer_create (build_string (" *pixmap conversion*"));
2027 int height, width, ncolors;
2028 struct gcpro gcpro1, gcpro2, gcpro3;
2029 int speccount = specpdl_depth ();
2031 GCPRO3 (name, retval, temp_buffer);
2033 specbind (Qinhibit_quit, Qt);
2034 set_buffer_internal (XBUFFER (temp_buffer));
2035 Ferase_buffer (Qnil);
2037 buffer_insert_c_string (current_buffer, "/* XPM */\r");
2038 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2040 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2041 for (elt = 0; elt <= width + ncolors; elt++)
2043 buffer_insert_c_string (current_buffer, "\"");
2044 buffer_insert_c_string (current_buffer, data[elt]);
2046 if (elt < width + ncolors)
2047 buffer_insert_c_string (current_buffer, "\",\r");
2049 buffer_insert_c_string (current_buffer, "\"};\r");
2052 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2055 set_buffer_internal (old_buffer);
2056 unbind_to (speccount, Qnil);
2058 RETURN_UNGCPRO (retval);
2063 case XpmFileInvalid:
2065 if (ok_if_data_invalid)
2067 signal_image_error ("invalid XPM data in file", name);
2071 signal_double_file_error ("Reading pixmap file",
2072 "out of memory", name);
2076 /* should never happen? */
2077 signal_double_file_error ("Opening pixmap file",
2078 "no such file or directory", name);
2082 signal_double_file_error_2 ("Parsing pixmap file",
2083 "unknown error code",
2084 make_int (result), name);
2089 return Qnil; /* not reached */
2093 check_valid_xpm_color_symbols (Lisp_Object data)
2097 for (rest = data; !NILP (rest); rest = XCDR (rest))
2099 if (!CONSP (rest) ||
2100 !CONSP (XCAR (rest)) ||
2101 !STRINGP (XCAR (XCAR (rest))) ||
2102 (!STRINGP (XCDR (XCAR (rest))) &&
2103 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2104 signal_simple_error ("Invalid color symbol alist", data);
2109 xpm_validate (Lisp_Object instantiator)
2111 file_or_data_must_be_present (instantiator);
2114 Lisp_Object Vxpm_color_symbols;
2117 evaluate_xpm_color_symbols (void)
2119 Lisp_Object rest, results = Qnil;
2120 struct gcpro gcpro1, gcpro2;
2122 GCPRO2 (rest, results);
2123 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2125 Lisp_Object name, value, cons;
2131 CHECK_STRING (name);
2132 value = XCDR (cons);
2134 value = XCAR (value);
2135 value = Feval (value);
2138 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2140 ("Result from xpm-color-symbols eval must be nil, string, or color",
2142 results = Fcons (Fcons (name, value), results);
2144 UNGCPRO; /* no more evaluation */
2149 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
2151 Lisp_Object file = Qnil;
2152 Lisp_Object color_symbols;
2153 struct gcpro gcpro1, gcpro2;
2154 Lisp_Object alist = Qnil;
2156 GCPRO2 (file, alist);
2158 /* Now, convert any file data into inline data. At the end of this,
2159 `data' will contain the inline data (if any) or Qnil, and
2160 `file' will contain the name this data was derived from (if
2163 Note that if we cannot generate any regular inline data, we
2166 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2169 if (CONSP (file)) /* failure locating filename */
2170 signal_double_file_error ("Opening pixmap file",
2171 "no such file or directory",
2174 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2177 if (NILP (file) && !UNBOUNDP (color_symbols))
2178 /* no conversion necessary */
2179 RETURN_UNGCPRO (inst);
2181 alist = tagged_vector_to_alist (inst);
2185 Lisp_Object data = pixmap_to_lisp_data (file, 0);
2186 alist = remassq_no_quit (Q_file, alist);
2187 /* there can't be a :data at this point. */
2188 alist = Fcons (Fcons (Q_file, file),
2189 Fcons (Fcons (Q_data, data), alist));
2192 if (UNBOUNDP (color_symbols))
2194 color_symbols = evaluate_xpm_color_symbols ();
2195 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
2200 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
2202 RETURN_UNGCPRO (result);
2207 xpm_possible_dest_types (void)
2210 IMAGE_MONO_PIXMAP_MASK |
2211 IMAGE_COLOR_PIXMAP_MASK |
2215 #endif /* HAVE_XPM */
2218 /****************************************************************************
2219 * Image Specifier Object *
2220 ****************************************************************************/
2222 DEFINE_SPECIFIER_TYPE (image);
2225 image_create (Lisp_Object obj)
2227 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2229 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2230 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2231 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2235 image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
2237 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2239 markobj (IMAGE_SPECIFIER_ATTACHEE (image));
2240 markobj (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2244 image_instantiate_cache_result (Lisp_Object locative)
2246 /* locative = (instance instantiator . subtable) */
2247 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2248 free_cons (XCONS (XCDR (locative)));
2249 free_cons (XCONS (locative));
2253 /* Given a specification for an image, return an instance of
2254 the image which matches the given instantiator and which can be
2255 displayed in the given domain. */
2258 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2259 Lisp_Object domain, Lisp_Object instantiator,
2262 Lisp_Object device = DFW_DEVICE (domain);
2263 struct device *d = XDEVICE (device);
2264 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2265 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2267 if (IMAGE_INSTANCEP (instantiator))
2269 /* make sure that the image instance's device and type are
2272 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2275 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2276 if (mask & dest_mask)
2277 return instantiator;
2279 signal_simple_error ("Type of image instance not allowed here",
2283 signal_simple_error_2 ("Wrong device for image instance",
2284 instantiator, device);
2286 else if (VECTORP (instantiator)
2287 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2289 assert (XVECTOR_LENGTH (instantiator) == 3);
2290 return (FACE_PROPERTY_INSTANCE
2291 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2292 Qbackground_pixmap, domain, 0, depth));
2296 Lisp_Object instance;
2297 Lisp_Object subtable;
2298 Lisp_Object ls3 = Qnil;
2299 Lisp_Object pointer_fg = Qnil;
2300 Lisp_Object pointer_bg = Qnil;
2304 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2305 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2306 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2309 /* First look in the hash table. */
2310 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2312 if (UNBOUNDP (subtable))
2314 /* For the image instance cache, we do comparisons with EQ rather
2315 than with EQUAL, as we do for color and font names.
2318 1) pixmap data can be very long, and thus the hashing and
2319 comparing will take awhile.
2320 2) It's not so likely that we'll run into things that are EQUAL
2321 but not EQ (that can happen a lot with faces, because their
2322 specifiers are copied around); but pixmaps tend not to be
2325 However, if the image-instance could be a pointer, we have to
2326 use EQUAL because we massaged the instantiator into a cons3
2327 also containing the foreground and background of the
2331 subtable = make_lisp_hash_table (20,
2332 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2333 : HASH_TABLE_KEY_WEAK,
2334 pointerp ? HASH_TABLE_EQUAL
2336 Fputhash (make_int (dest_mask), subtable,
2337 d->image_instance_cache);
2338 instance = Qunbound;
2342 instance = Fgethash (pointerp ? ls3 : instantiator,
2343 subtable, Qunbound);
2344 /* subwindows have a per-window cache and have to be treated
2345 differently. dest_mask can be a bitwise OR of all image
2346 types so we will only catch someone possibly trying to
2347 instantiate a subwindow type thing. Unfortunately, this
2348 will occur most of the time so this probably slows things
2349 down. But with the current design I don't see anyway
2351 if (UNBOUNDP (instance)
2353 dest_mask & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2355 if (!WINDOWP (domain))
2356 signal_simple_error ("Can't instantiate subwindow outside a window",
2358 instance = Fgethash (instantiator,
2359 XWINDOW (domain)->subwindow_instance_cache,
2364 if (UNBOUNDP (instance))
2366 Lisp_Object locative =
2368 noseeum_cons (pointerp ? ls3 : instantiator,
2370 int speccount = specpdl_depth ();
2372 /* make sure we cache the failures, too.
2373 Use an unwind-protect to catch such errors.
2374 If we fail, the unwind-protect records nil in
2375 the hash table. If we succeed, we change the
2376 car of the locative to the resulting instance,
2377 which gets recorded instead. */
2378 record_unwind_protect (image_instantiate_cache_result,
2380 instance = instantiate_image_instantiator (device,
2383 pointer_fg, pointer_bg,
2386 Fsetcar (locative, instance);
2387 /* only after the image has been instantiated do we know
2388 whether we need to put it in the per-window image instance
2390 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
2392 (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
2394 if (!WINDOWP (domain))
2395 signal_simple_error ("Can't instantiate subwindow outside a window",
2398 Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache );
2400 unbind_to (speccount, Qnil);
2405 if (NILP (instance))
2406 signal_simple_error ("Can't instantiate image (probably cached)",
2412 return Qnil; /* not reached */
2415 /* Validate an image instantiator. */
2418 image_validate (Lisp_Object instantiator)
2420 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2422 else if (VECTORP (instantiator))
2424 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2425 int instantiator_len = XVECTOR_LENGTH (instantiator);
2426 struct image_instantiator_methods *meths;
2427 Lisp_Object already_seen = Qnil;
2428 struct gcpro gcpro1;
2431 if (instantiator_len < 1)
2432 signal_simple_error ("Vector length must be at least 1",
2435 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2436 if (!(instantiator_len & 1))
2438 ("Must have alternating keyword/value pairs", instantiator);
2440 GCPRO1 (already_seen);
2442 for (i = 1; i < instantiator_len; i += 2)
2444 Lisp_Object keyword = elt[i];
2445 Lisp_Object value = elt[i+1];
2448 CHECK_SYMBOL (keyword);
2449 if (!SYMBOL_IS_KEYWORD (keyword))
2450 signal_simple_error ("Symbol must begin with a colon", keyword);
2452 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2453 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2456 if (j == Dynarr_length (meths->keywords))
2457 signal_simple_error ("Unrecognized keyword", keyword);
2459 if (!Dynarr_at (meths->keywords, j).multiple_p)
2461 if (!NILP (memq_no_quit (keyword, already_seen)))
2463 ("Keyword may not appear more than once", keyword);
2464 already_seen = Fcons (keyword, already_seen);
2467 (Dynarr_at (meths->keywords, j).validate) (value);
2472 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2475 signal_simple_error ("Must be string or vector", instantiator);
2479 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2481 Lisp_Object attachee =
2482 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2483 Lisp_Object property =
2484 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2485 if (FACEP (attachee))
2486 face_property_was_changed (attachee, property, locale);
2487 else if (GLYPHP (attachee))
2488 glyph_property_was_changed (attachee, property, locale);
2492 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2493 Lisp_Object property)
2495 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2497 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2498 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2502 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2503 Lisp_Object tag_set, Lisp_Object instantiator)
2505 Lisp_Object possible_console_types = Qnil;
2507 Lisp_Object retlist = Qnil;
2508 struct gcpro gcpro1, gcpro2;
2510 LIST_LOOP (rest, Vconsole_type_list)
2512 Lisp_Object contype = XCAR (rest);
2513 if (!NILP (memq_no_quit (contype, tag_set)))
2514 possible_console_types = Fcons (contype, possible_console_types);
2517 if (XINT (Flength (possible_console_types)) > 1)
2518 /* two conflicting console types specified */
2521 if (NILP (possible_console_types))
2522 possible_console_types = Vconsole_type_list;
2524 GCPRO2 (retlist, possible_console_types);
2526 LIST_LOOP (rest, possible_console_types)
2528 Lisp_Object contype = XCAR (rest);
2529 Lisp_Object newinst = call_with_suspended_errors
2530 ((lisp_fn_t) normalize_image_instantiator,
2531 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2532 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2534 if (!NILP (newinst))
2537 if (NILP (memq_no_quit (contype, tag_set)))
2538 newtag = Fcons (contype, tag_set);
2541 retlist = Fcons (Fcons (newtag, newinst), retlist);
2550 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
2551 Return non-nil if OBJECT is an image specifier.
2553 An image specifier is used for images (pixmaps and the like). It is used
2554 to describe the actual image in a glyph. It is instanced as an image-
2557 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
2558 etc. This describes the format of the data describing the image. The
2559 resulting image instances also come in many types -- `mono-pixmap',
2560 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
2561 the image and the sorts of places it can appear. (For example, a
2562 color-pixmap image has fixed colors specified for it, while a
2563 mono-pixmap image comes in two unspecified shades "foreground" and
2564 "background" that are determined from the face of the glyph or
2565 surrounding text; a text image appears as a string of text and has an
2566 unspecified foreground, background, and font; a pointer image behaves
2567 like a mono-pixmap image but can only be used as a mouse pointer
2568 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
2569 important to keep the distinction between image instantiator format and
2570 image instance type in mind. Typically, a given image instantiator
2571 format can result in many different image instance types (for example,
2572 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
2573 whereas `cursor-font' can be instanced only as `pointer'), and a
2574 particular image instance type can be generated by many different
2575 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
2576 `gif', `jpeg', etc.).
2578 See `make-image-instance' for a more detailed discussion of image
2581 An image instantiator should be a string or a vector of the form
2583 [FORMAT :KEYWORD VALUE ...]
2585 i.e. a format symbol followed by zero or more alternating keyword-value
2586 pairs. FORMAT should be one of
2589 (Don't display anything; no keywords are valid for this.
2590 Can only be instanced as `nothing'.)
2592 (Display this image as a text string. Can only be instanced
2593 as `text', although support for instancing as `mono-pixmap'
2596 (Display this image as a text string, with replaceable fields;
2597 not currently implemented.)
2599 (An X bitmap; only if X or Windows support was compiled into this XEmacs.
2600 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2602 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
2603 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
2605 (An X-Face bitmap, used to encode people's faces in e-mail messages;
2606 only if X-Face support was compiled into this XEmacs. Can be
2607 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2609 (A GIF87 or GIF89 image; only if GIF support was compiled into this
2610 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
2611 Can be instanced as `color-pixmap'.)
2613 (A JPEG image; only if JPEG support was compiled into this XEmacs.
2614 Can be instanced as `color-pixmap'.)
2616 (A PNG image; only if PNG support was compiled into this XEmacs.
2617 Can be instanced as `color-pixmap'.)
2619 (A TIFF image; only if TIFF support was compiled into this XEmacs.
2620 Can be instanced as `color-pixmap'.)
2622 (One of the standard cursor-font names, such as "watch" or
2623 "right_ptr" under X. Under X, this is, more specifically, any
2624 of the standard cursor names from appendix B of the Xlib manual
2625 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
2626 On other window systems, the valid names will be specific to the
2627 type of window system. Can only be instanced as `pointer'.)
2629 (A glyph from a font; i.e. the name of a font, and glyph index into it
2630 of the form "FONT fontname index [[mask-font] mask-index]".
2631 Currently can only be instanced as `pointer', although this should
2634 (An embedded X window; not currently implemented.)
2636 (A widget control, for instance text field or radio button.)
2638 (XEmacs tries to guess what format the data is in. If X support
2639 exists, the data string will be checked to see if it names a filename.
2640 If so, and this filename contains XBM or XPM data, the appropriate
2641 sort of pixmap or pointer will be created. [This includes picking up
2642 any specified hotspot or associated mask file.] Otherwise, if `pointer'
2643 is one of the allowable image-instance types and the string names a
2644 valid cursor-font name, the image will be created as a pointer.
2645 Otherwise, the image will be displayed as text. If no X support
2646 exists, the image will always be displayed as text.)
2648 Inherit from the background-pixmap property of a face.
2650 The valid keywords are:
2653 (Inline data. For most formats above, this should be a string. For
2654 XBM images, this should be a list of three elements: width, height, and
2655 a string of bit data. This keyword is not valid for instantiator
2656 formats `nothing' and `inherit'.)
2658 (Data is contained in a file. The value is the name of this file.
2659 If both :data and :file are specified, the image is created from
2660 what is specified in :data and the string in :file becomes the
2661 value of the `image-instance-file-name' function when applied to
2662 the resulting image-instance. This keyword is not valid for
2663 instantiator formats `nothing', `string', `formatted-string',
2664 `cursor-font', `font', `autodetect', and `inherit'.)
2667 (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords
2668 allow you to explicitly specify foreground and background colors.
2669 The argument should be anything acceptable to `make-color-instance'.
2670 This will cause what would be a `mono-pixmap' to instead be colorized
2671 as a two-color color-pixmap, and specifies the foreground and/or
2672 background colors for a pointer instead of black and white.)
2674 (For `xbm' and `xface'. This specifies a mask to be used with the
2675 bitmap. The format is a list of width, height, and bits, like for
2678 (For `xbm' and `xface'. This specifies a file containing the mask data.
2679 If neither a mask file nor inline mask data is given for an XBM image,
2680 and the XBM image comes from a file, XEmacs will look for a mask file
2681 with the same name as the image file but with "Mask" or "msk"
2682 appended. For example, if you specify the XBM file "left_ptr"
2683 [usually located in "/usr/include/X11/bitmaps"], the associated
2684 mask file "left_ptrmsk" will automatically be picked up.)
2687 (For `xbm' and `xface'. These keywords specify a hotspot if the image
2688 is instantiated as a `pointer'. Note that if the XBM image file
2689 specifies a hotspot, it will automatically be picked up if no
2690 explicit hotspot is given.)
2692 (Only for `xpm'. This specifies an alist that maps strings
2693 that specify symbolic color names to the actual color to be used
2694 for that symbolic color (in the form of a string or a color-specifier
2695 object). If this is not specified, the contents of `xpm-color-symbols'
2696 are used to generate the alist.)
2698 (Only for `inherit'. This specifies the face to inherit from.)
2700 If instead of a vector, the instantiator is a string, it will be
2701 converted into a vector by looking it up according to the specs in the
2702 `console-type-image-conversion-list' (q.v.) for the console type of
2703 the domain (usually a window; sometimes a frame or device) over which
2704 the image is being instantiated.
2706 If the instantiator specifies data from a file, the data will be read
2707 in at the time that the instantiator is added to the image (which may
2708 be well before when the image is actually displayed), and the
2709 instantiator will be converted into one of the inline-data forms, with
2710 the filename retained using a :file keyword. This implies that the
2711 file must exist when the instantiator is added to the image, but does
2712 not need to exist at any other time (e.g. it may safely be a temporary
2717 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
2721 /****************************************************************************
2723 ****************************************************************************/
2726 mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object))
2728 struct Lisp_Glyph *glyph = XGLYPH (obj);
2730 markobj (glyph->image);
2731 markobj (glyph->contrib_p);
2732 markobj (glyph->baseline);
2733 markobj (glyph->face);
2735 return glyph->plist;
2739 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2741 struct Lisp_Glyph *glyph = XGLYPH (obj);
2745 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
2747 write_c_string ("#<glyph (", printcharfun);
2748 print_internal (Fglyph_type (obj), printcharfun, 0);
2749 write_c_string (") ", printcharfun);
2750 print_internal (glyph->image, printcharfun, 1);
2751 sprintf (buf, "0x%x>", glyph->header.uid);
2752 write_c_string (buf, printcharfun);
2755 /* Glyphs are equal if all of their display attributes are equal. We
2756 don't compare names or doc-strings, because that would make equal
2759 This isn't concerned with "unspecified" attributes, that's what
2760 #'glyph-differs-from-default-p is for. */
2762 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
2764 struct Lisp_Glyph *g1 = XGLYPH (obj1);
2765 struct Lisp_Glyph *g2 = XGLYPH (obj2);
2769 return (internal_equal (g1->image, g2->image, depth) &&
2770 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
2771 internal_equal (g1->baseline, g2->baseline, depth) &&
2772 internal_equal (g1->face, g2->face, depth) &&
2773 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
2776 static unsigned long
2777 glyph_hash (Lisp_Object obj, int depth)
2781 /* No need to hash all of the elements; that would take too long.
2782 Just hash the most common ones. */
2783 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
2784 internal_hash (XGLYPH (obj)->face, depth));
2788 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
2790 struct Lisp_Glyph *g = XGLYPH (obj);
2792 if (EQ (prop, Qimage)) return g->image;
2793 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
2794 if (EQ (prop, Qbaseline)) return g->baseline;
2795 if (EQ (prop, Qface)) return g->face;
2797 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
2801 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
2803 if ((EQ (prop, Qimage)) ||
2804 (EQ (prop, Qcontrib_p)) ||
2805 (EQ (prop, Qbaseline)))
2808 if (EQ (prop, Qface))
2810 XGLYPH (obj)->face = Fget_face (value);
2814 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
2819 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
2821 if ((EQ (prop, Qimage)) ||
2822 (EQ (prop, Qcontrib_p)) ||
2823 (EQ (prop, Qbaseline)))
2826 if (EQ (prop, Qface))
2828 XGLYPH (obj)->face = Qnil;
2832 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
2836 glyph_plist (Lisp_Object obj)
2838 struct Lisp_Glyph *glyph = XGLYPH (obj);
2839 Lisp_Object result = glyph->plist;
2841 result = cons3 (Qface, glyph->face, result);
2842 result = cons3 (Qbaseline, glyph->baseline, result);
2843 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
2844 result = cons3 (Qimage, glyph->image, result);
2849 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
2850 mark_glyph, print_glyph, 0,
2851 glyph_equal, glyph_hash,
2852 glyph_getprop, glyph_putprop,
2853 glyph_remprop, glyph_plist,
2857 allocate_glyph (enum glyph_type type,
2858 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
2859 Lisp_Object locale))
2861 /* This function can GC */
2862 Lisp_Object obj = Qnil;
2863 struct Lisp_Glyph *g =
2864 alloc_lcrecord_type (struct Lisp_Glyph, lrecord_glyph);
2867 g->image = Fmake_specifier (Qimage); /* This function can GC */
2871 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2872 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
2873 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
2874 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK;
2877 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2878 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
2881 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2882 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK;
2888 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
2889 /* We're getting enough reports of odd behavior in this area it seems */
2890 /* best to GCPRO everything. */
2892 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
2893 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
2894 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
2895 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2897 GCPRO4 (obj, tem1, tem2, tem3);
2899 set_specifier_fallback (g->image, tem1);
2900 g->contrib_p = Fmake_specifier (Qboolean);
2901 set_specifier_fallback (g->contrib_p, tem2);
2902 /* #### should have a specifier for the following */
2903 g->baseline = Fmake_specifier (Qgeneric);
2904 set_specifier_fallback (g->baseline, tem3);
2907 g->after_change = after_change;
2910 set_image_attached_to (g->image, obj, Qimage);
2917 static enum glyph_type
2918 decode_glyph_type (Lisp_Object type, Error_behavior errb)
2921 return GLYPH_BUFFER;
2923 if (ERRB_EQ (errb, ERROR_ME))
2924 CHECK_SYMBOL (type);
2926 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
2927 if (EQ (type, Qpointer)) return GLYPH_POINTER;
2928 if (EQ (type, Qicon)) return GLYPH_ICON;
2930 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
2932 return GLYPH_UNKNOWN;
2936 valid_glyph_type_p (Lisp_Object type)
2938 return !NILP (memq_no_quit (type, Vglyph_type_list));
2941 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
2942 Given a GLYPH-TYPE, return non-nil if it is valid.
2943 Valid types are `buffer', `pointer', and `icon'.
2947 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
2950 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
2951 Return a list of valid glyph types.
2955 return Fcopy_sequence (Vglyph_type_list);
2958 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
2959 Create and return a new uninitialized glyph or type TYPE.
2961 TYPE specifies the type of the glyph; this should be one of `buffer',
2962 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
2963 specifies in which contexts the glyph can be used, and controls the
2964 allowable image types into which the glyph's image can be
2967 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
2968 extent, in the modeline, and in the toolbar. Their image can be
2969 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
2972 `pointer' glyphs can be used to specify the mouse pointer. Their
2973 image can be instantiated as `pointer'.
2975 `icon' glyphs can be used to specify the icon used when a frame is
2976 iconified. Their image can be instantiated as `mono-pixmap' and
2981 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
2982 return allocate_glyph (typeval, 0);
2985 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
2986 Return non-nil if OBJECT is a glyph.
2988 A glyph is an object used for pixmaps and the like. It is used
2989 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
2990 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
2991 buttons, and the like. Its image is described using an image specifier --
2992 see `image-specifier-p'.
2996 return GLYPHP (object) ? Qt : Qnil;
2999 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3000 Return the type of the given glyph.
3001 The return value will be one of 'buffer, 'pointer, or 'icon.
3005 CHECK_GLYPH (glyph);
3006 switch (XGLYPH_TYPE (glyph))
3009 case GLYPH_BUFFER: return Qbuffer;
3010 case GLYPH_POINTER: return Qpointer;
3011 case GLYPH_ICON: return Qicon;
3015 /*****************************************************************************
3018 Return the width of the given GLYPH on the given WINDOW. If the
3019 instance is a string then the width is calculated using the font of
3020 the given FACE, unless a face is defined by the glyph itself.
3021 ****************************************************************************/
3023 glyph_width (Lisp_Object glyph, Lisp_Object frame_face,
3024 face_index window_findex, Lisp_Object window)
3026 Lisp_Object instance;
3027 Lisp_Object frame = XWINDOW (window)->frame;
3029 /* #### We somehow need to distinguish between the user causing this
3030 error condition and a bug causing it. */
3031 if (!GLYPHP (glyph))
3034 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3036 if (!IMAGE_INSTANCEP (instance))
3039 switch (XIMAGE_INSTANCE_TYPE (instance))
3043 Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance);
3044 Lisp_Object private_face = XGLYPH_FACE(glyph);
3046 if (!NILP (private_face))
3047 return redisplay_frame_text_width_string (XFRAME (frame),
3051 if (!NILP (frame_face))
3052 return redisplay_frame_text_width_string (XFRAME (frame),
3056 return redisplay_text_width_string (XWINDOW (window),
3061 case IMAGE_MONO_PIXMAP:
3062 case IMAGE_COLOR_PIXMAP:
3064 return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance);
3069 case IMAGE_SUBWINDOW:
3071 return XIMAGE_INSTANCE_SUBWINDOW_WIDTH (instance);
3079 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3080 Return the width of GLYPH on WINDOW.
3081 This may not be exact as it does not take into account all of the context
3082 that redisplay will.
3086 XSETWINDOW (window, decode_window (window));
3087 CHECK_GLYPH (glyph);
3089 return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window));
3092 #define RETURN_ASCENT 0
3093 #define RETURN_DESCENT 1
3094 #define RETURN_HEIGHT 2
3097 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3098 Error_behavior errb, int no_quit)
3100 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3102 /* This can never return Qunbound. All glyphs have 'nothing as
3104 return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0,
3108 static unsigned short
3109 glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face,
3110 face_index window_findex, Lisp_Object window,
3113 Lisp_Object instance;
3114 Lisp_Object frame = XWINDOW (window)->frame;
3116 if (!GLYPHP (glyph))
3119 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
3121 if (!IMAGE_INSTANCEP (instance))
3124 switch (XIMAGE_INSTANCE_TYPE (instance))
3128 struct font_metric_info fm;
3129 Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance);
3130 unsigned char charsets[NUM_LEADING_BYTES];
3131 struct face_cachel frame_cachel;
3132 struct face_cachel *cachel;
3134 find_charsets_in_bufbyte_string (charsets,
3135 XSTRING_DATA (string),
3136 XSTRING_LENGTH (string));
3138 if (!NILP (frame_face))
3140 reset_face_cachel (&frame_cachel);
3141 update_face_cachel_data (&frame_cachel, frame, frame_face);
3142 cachel = &frame_cachel;
3145 cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex);
3146 ensure_face_cachel_complete (cachel, window, charsets);
3148 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
3152 case RETURN_ASCENT: return fm.ascent;
3153 case RETURN_DESCENT: return fm.descent;
3154 case RETURN_HEIGHT: return fm.ascent + fm.descent;
3157 return 0; /* not reached */
3161 case IMAGE_MONO_PIXMAP:
3162 case IMAGE_COLOR_PIXMAP:
3164 /* #### Ugh ugh ugh -- temporary crap */
3165 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3166 return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance);
3173 case IMAGE_SUBWINDOW:
3175 /* #### Ugh ugh ugh -- temporary crap */
3176 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
3177 return XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (instance);
3188 glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face,
3189 face_index window_findex, Lisp_Object window)
3191 return glyph_height_internal (glyph, frame_face, window_findex, window,
3196 glyph_descent (Lisp_Object glyph, Lisp_Object frame_face,
3197 face_index window_findex, Lisp_Object window)
3199 return glyph_height_internal (glyph, frame_face, window_findex, window,
3203 /* strictly a convenience function. */
3205 glyph_height (Lisp_Object glyph, Lisp_Object frame_face,
3206 face_index window_findex, Lisp_Object window)
3208 return glyph_height_internal (glyph, frame_face, window_findex, window,
3212 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3213 Return the ascent value of GLYPH on WINDOW.
3214 This may not be exact as it does not take into account all of the context
3215 that redisplay will.
3219 XSETWINDOW (window, decode_window (window));
3220 CHECK_GLYPH (glyph);
3222 return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window));
3225 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3226 Return the descent value of GLYPH on WINDOW.
3227 This may not be exact as it does not take into account all of the context
3228 that redisplay will.
3232 XSETWINDOW (window, decode_window (window));
3233 CHECK_GLYPH (glyph);
3235 return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window));
3238 /* This is redundant but I bet a lot of people expect it to exist. */
3239 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3240 Return the height of GLYPH on WINDOW.
3241 This may not be exact as it does not take into account all of the context
3242 that redisplay will.
3246 XSETWINDOW (window, decode_window (window));
3247 CHECK_GLYPH (glyph);
3249 return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window));
3252 #undef RETURN_ASCENT
3253 #undef RETURN_DESCENT
3254 #undef RETURN_HEIGHT
3256 /* #### do we need to cache this info to speed things up? */
3259 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3261 if (!GLYPHP (glyph))
3265 Lisp_Object retval =
3266 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3267 /* #### look into ERROR_ME_NOT */
3268 Qunbound, domain, ERROR_ME_NOT,
3270 if (!NILP (retval) && !INTP (retval))
3272 else if (INTP (retval))
3274 if (XINT (retval) < 0)
3276 if (XINT (retval) > 100)
3277 retval = make_int (100);
3284 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3286 /* #### Domain parameter not currently used but it will be */
3287 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3291 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3293 if (!GLYPHP (glyph))
3296 return !NILP (specifier_instance_no_quit
3297 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3298 /* #### look into ERROR_ME_NOT */
3299 ERROR_ME_NOT, 0, Qzero));
3303 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3306 if (XGLYPH (glyph)->after_change)
3307 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3311 /*****************************************************************************
3312 * glyph cachel functions *
3313 *****************************************************************************/
3316 #### All of this is 95% copied from face cachels.
3317 Consider consolidating.
3318 #### We need to add a dirty flag to the glyphs.
3322 mark_glyph_cachels (glyph_cachel_dynarr *elements,
3323 void (*markobj) (Lisp_Object))
3330 for (elt = 0; elt < Dynarr_length (elements); elt++)
3332 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3333 markobj (cachel->glyph);
3338 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3339 struct glyph_cachel *cachel)
3341 /* #### This should be || !cachel->updated */
3342 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph))
3346 XSETWINDOW (window, w);
3348 /* #### This could be sped up if we redid things to grab the glyph
3349 instantiation and passed it to the size functions. */
3350 cachel->glyph = glyph;
3351 cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window);
3352 cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window);
3353 cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window);
3356 cachel->updated = 1;
3360 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3362 struct glyph_cachel new_cachel;
3365 new_cachel.glyph = Qnil;
3367 update_glyph_cachel_data (w, glyph, &new_cachel);
3368 Dynarr_add (w->glyph_cachels, new_cachel);
3372 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3379 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3381 struct glyph_cachel *cachel =
3382 Dynarr_atp (w->glyph_cachels, elt);
3384 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3386 if (!cachel->updated)
3387 update_glyph_cachel_data (w, glyph, cachel);
3392 /* If we didn't find the glyph, add it and then return its index. */
3393 add_glyph_cachel (w, glyph);
3398 reset_glyph_cachels (struct window *w)
3400 Dynarr_reset (w->glyph_cachels);
3401 get_glyph_cachel_index (w, Vcontinuation_glyph);
3402 get_glyph_cachel_index (w, Vtruncation_glyph);
3403 get_glyph_cachel_index (w, Vhscroll_glyph);
3404 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3405 get_glyph_cachel_index (w, Voctal_escape_glyph);
3406 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3410 mark_glyph_cachels_as_not_updated (struct window *w)
3414 /* We need to have a dirty flag to tell if the glyph has changed.
3415 We can check to see if each glyph variable is actually a
3416 completely different glyph, though. */
3417 #define FROB(glyph_obj, gindex) \
3418 update_glyph_cachel_data (w, glyph_obj, \
3419 Dynarr_atp (w->glyph_cachels, gindex))
3421 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3422 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3423 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3424 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3425 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3426 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3429 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3430 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3433 #ifdef MEMORY_USAGE_STATS
3436 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3437 struct overhead_stats *ovstats)
3442 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3447 #endif /* MEMORY_USAGE_STATS */
3451 /*****************************************************************************
3452 * subwindow cachel functions *
3453 *****************************************************************************/
3454 /* subwindows are curious in that you have to physically unmap them to
3455 not display them. It is problematic deciding what to do in
3456 redisplay. We have two caches - a per-window instance cache that
3457 keeps track of subwindows on a window, these are linked to their
3458 instantiator in the hashtable and when the instantiator goes away
3459 we want the instance to go away also. However we also have a
3460 per-frame instance cache that we use to determine if a subwindow is
3461 obscuring an area that we want to clear. We need to be able to flip
3462 through this quickly so a hashtable is not suitable hence the
3463 subwindow_cachels. The question is should we just not mark
3464 instances in the subwindow_cachelsnor should we try and invalidate
3465 the cache at suitable points in redisplay? If we don't invalidate
3466 the cache it will fill up with crud that will only get removed when
3467 the frame is deleted. So invalidation is good, the question is when
3468 and whether we mark as well. Go for the simple option - don't mark,
3469 MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */
3472 mark_subwindow_cachels (subwindow_cachel_dynarr *elements,
3473 void (*markobj) (Lisp_Object))
3480 for (elt = 0; elt < Dynarr_length (elements); elt++)
3482 struct subwindow_cachel *cachel = Dynarr_atp (elements, elt);
3483 markobj (cachel->subwindow);
3488 update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow,
3489 struct subwindow_cachel *cachel)
3491 if (NILP (cachel->subwindow) || !EQ (cachel->subwindow, subwindow))
3493 cachel->subwindow = subwindow;
3494 cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3495 cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3498 cachel->updated = 1;
3502 add_subwindow_cachel (struct frame *f, Lisp_Object subwindow)
3504 struct subwindow_cachel new_cachel;
3507 new_cachel.subwindow = Qnil;
3510 new_cachel.being_displayed=0;
3512 update_subwindow_cachel_data (f, subwindow, &new_cachel);
3513 Dynarr_add (f->subwindow_cachels, new_cachel);
3517 get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow)
3524 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3526 struct subwindow_cachel *cachel =
3527 Dynarr_atp (f->subwindow_cachels, elt);
3529 if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow))
3531 if (!cachel->updated)
3532 update_subwindow_cachel_data (f, subwindow, cachel);
3537 /* If we didn't find the glyph, add it and then return its index. */
3538 add_subwindow_cachel (f, subwindow);
3543 reset_subwindow_cachels (struct frame *f)
3545 Dynarr_reset (f->subwindow_cachels);
3549 mark_subwindow_cachels_as_not_updated (struct frame *f)
3553 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3554 Dynarr_atp (f->subwindow_cachels, elt)->updated = 0;
3558 /*****************************************************************************
3559 * subwindow functions *
3560 *****************************************************************************/
3562 /* update the displayed characteristics of a subwindow */
3564 update_subwindow (Lisp_Object subwindow)
3566 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3568 if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3570 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3573 MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii));
3577 update_frame_subwindows (struct frame *f)
3581 if (f->subwindows_changed || f->glyphs_changed)
3582 for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++)
3584 struct subwindow_cachel *cachel =
3585 Dynarr_atp (f->subwindow_cachels, elt);
3587 if (cachel->being_displayed)
3589 update_subwindow (cachel->subwindow);
3594 /* remove a subwindow from its frame */
3595 void unmap_subwindow (Lisp_Object subwindow)
3597 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3599 struct subwindow_cachel* cachel;
3602 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3604 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3606 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3609 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3610 elt = get_subwindow_cachel_index (f, subwindow);
3611 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3615 cachel->being_displayed = 0;
3616 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3618 MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii));
3621 /* show a subwindow in its frame */
3622 void map_subwindow (Lisp_Object subwindow, int x, int y)
3624 struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
3626 struct subwindow_cachel* cachel;
3629 if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET
3631 IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW)
3633 NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))
3636 f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii));
3637 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
3638 elt = get_subwindow_cachel_index (f, subwindow);
3639 cachel = Dynarr_atp (f->subwindow_cachels, elt);
3642 cachel->being_displayed = 1;
3644 MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y));
3648 subwindow_possible_dest_types (void)
3650 return IMAGE_SUBWINDOW_MASK;
3653 /* Partially instantiate a subwindow. */
3655 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
3656 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
3657 int dest_mask, Lisp_Object domain)
3659 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
3660 Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii);
3661 Lisp_Object frame = FW_FRAME (domain);
3662 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
3663 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
3666 signal_simple_error ("No selected frame", device);
3668 if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
3669 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
3672 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
3673 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = Qnil;
3674 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
3675 IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame;
3677 /* this stuff may get overidden by the widget code */
3679 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20;
3684 if (XINT (width) > 1)
3686 IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w;
3689 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20;
3694 if (XINT (height) > 1)
3696 IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h;
3700 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
3701 Return non-nil if OBJECT is a subwindow.
3705 CHECK_IMAGE_INSTANCE (object);
3706 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
3709 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
3710 Return the window id of SUBWINDOW as a number.
3714 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3715 return make_int ((int) (XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)));
3718 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
3719 Resize SUBWINDOW to WIDTH x HEIGHT.
3720 If a value is nil that parameter is not changed.
3722 (subwindow, width, height))
3726 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3729 neww = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow);
3731 neww = XINT (width);
3734 newh = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow);
3736 newh = XINT (height);
3739 MAYBE_DEVMETH (XDEVICE (XIMAGE_INSTANCE_DEVICE (subwindow)),
3740 resize_subwindow, (XIMAGE_INSTANCE (subwindow), neww, newh));
3742 XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow) = newh;
3743 XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow) = neww;
3748 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
3749 Generate a Map event for SUBWINDOW.
3753 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
3755 map_subwindow (subwindow, 0, 0);
3761 /*****************************************************************************
3763 *****************************************************************************/
3765 /* Get the display tables for use currently on window W with face
3766 FACE. #### This will have to be redone. */
3769 get_display_tables (struct window *w, face_index findex,
3770 Lisp_Object *face_table, Lisp_Object *window_table)
3773 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
3777 tem = noseeum_cons (tem, Qnil);
3779 tem = w->display_table;
3783 tem = noseeum_cons (tem, Qnil);
3784 *window_table = tem;
3788 display_table_entry (Emchar ch, Lisp_Object face_table,
3789 Lisp_Object window_table)
3793 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
3794 for (tail = face_table; 1; tail = XCDR (tail))
3799 if (!NILP (window_table))
3801 tail = window_table;
3802 window_table = Qnil;
3807 table = XCAR (tail);
3809 if (VECTORP (table))
3811 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
3812 return XVECTOR_DATA (table)[ch];
3816 else if (CHAR_TABLEP (table)
3817 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
3819 return get_char_table (ch, XCHAR_TABLE (table));
3821 else if (CHAR_TABLEP (table)
3822 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
3824 Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
3830 else if (RANGE_TABLEP (table))
3832 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
3843 /*****************************************************************************
3845 *****************************************************************************/
3848 syms_of_glyphs (void)
3850 /* image instantiators */
3852 DEFSUBR (Fimage_instantiator_format_list);
3853 DEFSUBR (Fvalid_image_instantiator_format_p);
3854 DEFSUBR (Fset_console_type_image_conversion_list);
3855 DEFSUBR (Fconsole_type_image_conversion_list);
3857 defkeyword (&Q_file, ":file");
3858 defkeyword (&Q_data, ":data");
3859 defkeyword (&Q_face, ":face");
3860 defkeyword (&Q_pixel_height, ":pixel-height");
3861 defkeyword (&Q_pixel_width, ":pixel-width");
3864 defkeyword (&Q_color_symbols, ":color-symbols");
3866 #ifdef HAVE_WINDOW_SYSTEM
3867 defkeyword (&Q_mask_file, ":mask-file");
3868 defkeyword (&Q_mask_data, ":mask-data");
3869 defkeyword (&Q_hotspot_x, ":hotspot-x");
3870 defkeyword (&Q_hotspot_y, ":hotspot-y");
3871 defkeyword (&Q_foreground, ":foreground");
3872 defkeyword (&Q_background, ":background");
3874 /* image specifiers */
3876 DEFSUBR (Fimage_specifier_p);
3877 /* Qimage in general.c */
3879 /* image instances */
3881 defsymbol (&Qimage_instancep, "image-instance-p");
3883 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
3884 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
3885 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
3886 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
3887 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
3888 defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p");
3889 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
3891 DEFSUBR (Fmake_image_instance);
3892 DEFSUBR (Fimage_instance_p);
3893 DEFSUBR (Fimage_instance_type);
3894 DEFSUBR (Fvalid_image_instance_type_p);
3895 DEFSUBR (Fimage_instance_type_list);
3896 DEFSUBR (Fimage_instance_name);
3897 DEFSUBR (Fimage_instance_string);
3898 DEFSUBR (Fimage_instance_file_name);
3899 DEFSUBR (Fimage_instance_mask_file_name);
3900 DEFSUBR (Fimage_instance_depth);
3901 DEFSUBR (Fimage_instance_height);
3902 DEFSUBR (Fimage_instance_width);
3903 DEFSUBR (Fimage_instance_hotspot_x);
3904 DEFSUBR (Fimage_instance_hotspot_y);
3905 DEFSUBR (Fimage_instance_foreground);
3906 DEFSUBR (Fimage_instance_background);
3907 DEFSUBR (Fimage_instance_property);
3908 DEFSUBR (Fset_image_instance_property);
3909 DEFSUBR (Fcolorize_image_instance);
3911 DEFSUBR (Fsubwindowp);
3912 DEFSUBR (Fimage_instance_subwindow_id);
3913 DEFSUBR (Fresize_subwindow);
3914 DEFSUBR (Fforce_subwindow_map);
3916 /* Qnothing defined as part of the "nothing" image-instantiator
3918 /* Qtext defined in general.c */
3919 defsymbol (&Qmono_pixmap, "mono-pixmap");
3920 defsymbol (&Qcolor_pixmap, "color-pixmap");
3921 /* Qpointer defined in general.c */
3925 defsymbol (&Qglyphp, "glyphp");
3926 defsymbol (&Qcontrib_p, "contrib-p");
3927 defsymbol (&Qbaseline, "baseline");
3929 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
3930 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
3931 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
3933 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
3935 DEFSUBR (Fglyph_type);
3936 DEFSUBR (Fvalid_glyph_type_p);
3937 DEFSUBR (Fglyph_type_list);
3939 DEFSUBR (Fmake_glyph_internal);
3940 DEFSUBR (Fglyph_width);
3941 DEFSUBR (Fglyph_ascent);
3942 DEFSUBR (Fglyph_descent);
3943 DEFSUBR (Fglyph_height);
3945 /* Qbuffer defined in general.c. */
3946 /* Qpointer defined above */
3949 deferror (&Qimage_conversion_error,
3950 "image-conversion-error",
3951 "image-conversion error", Qio_error);
3956 specifier_type_create_image (void)
3958 /* image specifiers */
3960 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
3962 SPECIFIER_HAS_METHOD (image, create);
3963 SPECIFIER_HAS_METHOD (image, mark);
3964 SPECIFIER_HAS_METHOD (image, instantiate);
3965 SPECIFIER_HAS_METHOD (image, validate);
3966 SPECIFIER_HAS_METHOD (image, after_change);
3967 SPECIFIER_HAS_METHOD (image, going_to_add);
3971 image_instantiator_format_create (void)
3973 /* image instantiators */
3975 the_image_instantiator_format_entry_dynarr =
3976 Dynarr_new (image_instantiator_format_entry);
3978 Vimage_instantiator_format_list = Qnil;
3979 staticpro (&Vimage_instantiator_format_list);
3981 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
3983 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
3984 IIFORMAT_HAS_METHOD (nothing, instantiate);
3986 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
3988 IIFORMAT_HAS_METHOD (inherit, validate);
3989 IIFORMAT_HAS_METHOD (inherit, normalize);
3990 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
3991 IIFORMAT_HAS_METHOD (inherit, instantiate);
3993 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
3995 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
3997 IIFORMAT_HAS_METHOD (string, validate);
3998 IIFORMAT_HAS_METHOD (string, possible_dest_types);
3999 IIFORMAT_HAS_METHOD (string, instantiate);
4001 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
4003 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
4005 IIFORMAT_HAS_METHOD (formatted_string, validate);
4006 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
4007 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
4009 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
4012 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
4013 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
4014 IIFORMAT_HAS_METHOD (subwindow, instantiate);
4015 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
4016 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
4018 #ifdef HAVE_WINDOW_SYSTEM
4019 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
4021 IIFORMAT_HAS_METHOD (xbm, validate);
4022 IIFORMAT_HAS_METHOD (xbm, normalize);
4023 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
4025 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
4026 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
4027 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
4028 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
4029 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
4030 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
4031 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
4032 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
4033 #endif /* HAVE_WINDOW_SYSTEM */
4036 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
4038 IIFORMAT_HAS_METHOD (xpm, validate);
4039 IIFORMAT_HAS_METHOD (xpm, normalize);
4040 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
4042 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
4043 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
4044 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
4045 #endif /* HAVE_XPM */
4049 vars_of_glyphs (void)
4051 Vthe_nothing_vector = vector1 (Qnothing);
4052 staticpro (&Vthe_nothing_vector);
4054 /* image instances */
4056 Vimage_instance_type_list = Fcons (Qnothing,
4057 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
4058 Qpointer, Qsubwindow, Qwidget));
4059 staticpro (&Vimage_instance_type_list);
4063 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
4064 staticpro (&Vglyph_type_list);
4066 /* The octal-escape glyph, control-arrow-glyph and
4067 invisible-text-glyph are completely initialized in glyphs.el */
4069 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
4070 What to prefix character codes displayed in octal with.
4072 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4074 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
4075 What to use as an arrow for control characters.
4077 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
4078 redisplay_glyph_changed);
4080 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
4081 What to use to indicate the presence of invisible text.
4082 This is the glyph that is displayed when an ellipsis is called for
4083 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
4084 Normally this is three dots ("...").
4086 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
4087 redisplay_glyph_changed);
4089 /* Partially initialized in glyphs.el */
4090 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
4091 What to display at the beginning of horizontally scrolled lines.
4093 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4094 #ifdef HAVE_WINDOW_SYSTEM
4100 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
4101 Definitions of logical color-names used when reading XPM files.
4102 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
4103 The COLOR-NAME should be a string, which is the name of the color to define;
4104 the FORM should evaluate to a `color' specifier object, or a string to be
4105 passed to `make-color-instance'. If a loaded XPM file references a symbolic
4106 color called COLOR-NAME, it will display as the computed color instead.
4108 The default value of this variable defines the logical color names
4109 \"foreground\" and \"background\" to be the colors of the `default' face.
4111 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
4112 #endif /* HAVE_XPM */
4116 specifier_vars_of_glyphs (void)
4118 /* #### Can we GC here? The set_specifier_* calls definitely need */
4120 /* display tables */
4122 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
4123 *The display table currently in use.
4124 This is a specifier; use `set-specifier' to change it.
4125 The display table is a vector created with `make-display-table'.
4126 The 256 elements control how to display each possible text character.
4127 Each value should be a string, a glyph, a vector or nil.
4128 If a value is a vector it must be composed only of strings and glyphs.
4129 nil means display the character in the default fashion.
4130 Faces can have their own, overriding display table.
4132 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
4133 set_specifier_fallback (Vcurrent_display_table,
4134 list1 (Fcons (Qnil, Qnil)));
4135 set_specifier_caching (Vcurrent_display_table,
4136 slot_offset (struct window,
4138 some_window_value_changed,
4143 complex_vars_of_glyphs (void)
4145 /* Partially initialized in glyphs-x.c, glyphs.el */
4146 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
4147 What to display at the end of truncated lines.
4149 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4151 /* Partially initialized in glyphs-x.c, glyphs.el */
4152 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
4153 What to display at the end of wrapped lines.
4155 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
4157 /* Partially initialized in glyphs-x.c, glyphs.el */
4158 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
4159 The glyph used to display the XEmacs logo at startup.
4161 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);