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
7 This file is part of XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Synched up with: Not in FSF. */
26 /* Written by Ben Wing and Chuck Thompson */
39 #include "redisplay.h"
46 Lisp_Object Qimage_conversion_error;
48 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
49 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p;
50 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p;
51 Lisp_Object Qmono_pixmap_image_instance_p;
52 Lisp_Object Qcolor_pixmap_image_instance_p;
53 Lisp_Object Qpointer_image_instance_p;
54 Lisp_Object Qsubwindow_image_instance_p;
55 Lisp_Object Qconst_glyph_variable;
56 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow;
57 Lisp_Object Q_file, Q_data, Q_face;
58 Lisp_Object Qformatted_string;
60 Lisp_Object Vcurrent_display_table;
61 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph;
62 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph;
63 Lisp_Object Vxemacs_logo;
64 Lisp_Object Vthe_nothing_vector;
65 Lisp_Object Vimage_instantiator_format_list;
66 Lisp_Object Vimage_instance_type_list;
67 Lisp_Object Vglyph_type_list;
69 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
70 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
71 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
72 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
74 #ifdef HAVE_WINDOW_SYSTEM
75 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
78 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
79 Lisp_Object Q_foreground, Q_background;
81 #define BitmapSuccess 0
82 #define BitmapOpenFailed 1
83 #define BitmapFileInvalid 2
84 #define BitmapNoMemory 3
89 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
91 Lisp_Object Q_color_symbols;
94 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
95 struct image_instantiator_format_entry
98 struct image_instantiator_methods *meths;
103 Dynarr_declare (struct image_instantiator_format_entry);
104 } image_instantiator_format_entry_dynarr;
106 image_instantiator_format_entry_dynarr *
107 the_image_instantiator_format_entry_dynarr;
109 static Lisp_Object allocate_image_instance (Lisp_Object device);
110 static void image_validate (Lisp_Object instantiator);
111 static void glyph_property_was_changed (Lisp_Object glyph,
112 Lisp_Object property,
114 EXFUN (Fimage_instance_type, 1);
115 EXFUN (Fglyph_type, 1);
118 /****************************************************************************
119 * Image Instantiators *
120 ****************************************************************************/
122 static struct image_instantiator_methods *
123 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
127 if (!SYMBOLP (format))
129 if (ERRB_EQ (errb, ERROR_ME))
130 CHECK_SYMBOL (format);
134 for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
138 Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
140 return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
143 maybe_signal_simple_error ("Invalid image-instantiator format", format,
150 valid_image_instantiator_format_p (Lisp_Object format)
152 return (decode_image_instantiator_format (format, ERROR_ME_NOT) != 0);
155 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
157 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
158 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
159 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
160 'autodetect, and 'subwindow, depending on how XEmacs was compiled.
162 (image_instantiator_format))
164 return valid_image_instantiator_format_p (image_instantiator_format) ?
168 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
170 Return a list of valid image-instantiator formats.
174 return Fcopy_sequence (Vimage_instantiator_format_list);
178 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
180 image_instantiator_methods *meths)
182 struct image_instantiator_format_entry entry;
184 entry.symbol = symbol;
186 Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
187 Vimage_instantiator_format_list =
188 Fcons (symbol, Vimage_instantiator_format_list);
192 get_image_conversion_list (Lisp_Object console_type)
194 return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
197 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
199 Set the image-conversion-list for consoles of the given TYPE.
200 The image-conversion-list specifies how image instantiators that
201 are strings should be interpreted. Each element of the list should be
202 a list of two elements (a regular expression string and a vector) or
203 a list of three elements (the preceding two plus an integer index into
204 the vector). The string is converted to the vector associated with the
205 first matching regular expression. If a vector index is specified, the
206 string itself is substituted into that position in the vector.
208 Note: The conversion above is applied when the image instantiator is
209 added to an image specifier, not when the specifier is actually
210 instantiated. Therefore, changing the image-conversion-list only affects
211 newly-added instantiators. Existing instantiators in glyphs and image
212 specifiers will not be affected.
214 (console_type, list))
217 Lisp_Object *imlist = get_image_conversion_list (console_type);
219 /* Check the list to make sure that it only has valid entries. */
221 EXTERNAL_LIST_LOOP (tail, list)
223 Lisp_Object mapping = XCAR (tail);
225 /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
226 if (!CONSP (mapping) ||
227 !CONSP (XCDR (mapping)) ||
228 (!NILP (XCDR (XCDR (mapping))) &&
229 (!CONSP (XCDR (XCDR (mapping))) ||
230 !NILP (XCDR (XCDR (XCDR (mapping)))))))
231 signal_simple_error ("Invalid mapping form", mapping);
234 Lisp_Object exp = XCAR (mapping);
235 Lisp_Object typevec = XCAR (XCDR (mapping));
236 Lisp_Object pos = Qnil;
241 CHECK_VECTOR (typevec);
242 if (!NILP (XCDR (XCDR (mapping))))
244 pos = XCAR (XCDR (XCDR (mapping)));
246 if (XINT (pos) < 0 ||
247 XINT (pos) >= XVECTOR_LENGTH (typevec))
249 (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
252 newvec = Fcopy_sequence (typevec);
254 XVECTOR_DATA (newvec)[XINT (pos)] = exp;
256 image_validate (newvec);
261 *imlist = Fcopy_tree (list, Qt);
265 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
267 Return the image-conversion-list for devices of the given TYPE.
268 The image-conversion-list specifies how to interpret image string
269 instantiators for the specified console type. See
270 `set-console-type-image-conversion-list' for a description of its syntax.
274 return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
277 /* Process a string instantiator according to the image-conversion-list for
278 CONSOLE_TYPE. Returns a vector. */
281 process_image_string_instantiator (Lisp_Object data,
282 Lisp_Object console_type,
287 LIST_LOOP (tail, *get_image_conversion_list (console_type))
289 Lisp_Object mapping = XCAR (tail);
290 Lisp_Object exp = XCAR (mapping);
291 Lisp_Object typevec = XCAR (XCDR (mapping));
293 /* if the result is of a type that can't be instantiated
294 (e.g. a string when we're dealing with a pointer glyph),
297 IIFORMAT_METH (decode_image_instantiator_format
298 (XVECTOR_DATA (typevec)[0], ERROR_ME),
299 possible_dest_types, ())))
301 if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
303 if (!NILP (XCDR (XCDR (mapping))))
305 int pos = XINT (XCAR (XCDR (XCDR (mapping))));
306 Lisp_Object newvec = Fcopy_sequence (typevec);
307 XVECTOR_DATA (newvec)[pos] = data;
316 signal_simple_error ("Unable to interpret glyph instantiator",
323 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
324 Lisp_Object default_)
327 int instantiator_len;
329 elt = XVECTOR_DATA (vector);
330 instantiator_len = XVECTOR_LENGTH (vector);
335 while (instantiator_len > 0)
337 if (EQ (elt[0], keyword))
340 instantiator_len -= 2;
347 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
349 return find_keyword_in_vector_or_given (vector, keyword, Qnil);
353 check_valid_string (Lisp_Object data)
359 check_valid_face (Lisp_Object data)
365 check_valid_int (Lisp_Object data)
371 file_or_data_must_be_present (Lisp_Object instantiator)
373 if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
374 NILP (find_keyword_in_vector (instantiator, Q_data)))
375 signal_simple_error ("Must supply either :file or :data",
380 data_must_be_present (Lisp_Object instantiator)
382 if (NILP (find_keyword_in_vector (instantiator, Q_data)))
383 signal_simple_error ("Must supply :data", instantiator);
387 face_must_be_present (Lisp_Object instantiator)
389 if (NILP (find_keyword_in_vector (instantiator, Q_face)))
390 signal_simple_error ("Must supply :face", instantiator);
393 /* utility function useful in retrieving data from a file. */
396 make_string_from_file (Lisp_Object file)
398 /* This function can call lisp */
399 int count = specpdl_depth ();
400 Lisp_Object temp_buffer;
404 specbind (Qinhibit_quit, Qt);
405 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
406 temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
407 GCPRO1 (temp_buffer);
408 set_buffer_internal (XBUFFER (temp_buffer));
409 Ferase_buffer (Qnil);
410 specbind (intern ("format-alist"), Qnil);
411 Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
412 data = Fbuffer_substring (Qnil, Qnil, Qnil);
413 unbind_to (count, Qnil);
418 /* The following two functions are provided to make it easier for
419 the normalize methods to work with keyword-value vectors.
420 Hash tables are kind of heavyweight for this purpose.
421 (If vectors were resizable, we could avoid this problem;
422 but they're not.) An alternative approach that might be
423 more efficient but require more work is to use a type of
424 assoc-Dynarr and provide primitives for deleting elements out
425 of it. (However, you'd also have to add an unwind-protect
426 to make sure the Dynarr got freed in case of an error in
427 the normalization process.) */
430 tagged_vector_to_alist (Lisp_Object vector)
432 Lisp_Object *elt = XVECTOR_DATA (vector);
433 int len = XVECTOR_LENGTH (vector);
434 Lisp_Object result = Qnil;
437 for (len -= 2; len >= 1; len -= 2)
438 result = Fcons (Fcons (elt[len], elt[len+1]), result);
444 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
446 int len = 1 + 2 * XINT (Flength (alist));
447 Lisp_Object *elt = alloca_array (Lisp_Object, len);
453 LIST_LOOP (rest, alist)
455 Lisp_Object pair = XCAR (rest);
456 elt[i] = XCAR (pair);
457 elt[i+1] = XCDR (pair);
461 return Fvector (len, elt);
465 normalize_image_instantiator (Lisp_Object instantiator,
467 Lisp_Object dest_mask)
469 if (IMAGE_INSTANCEP (instantiator))
472 if (STRINGP (instantiator))
473 instantiator = process_image_string_instantiator (instantiator, contype,
476 assert (VECTORP (instantiator));
477 /* We have to always store the actual pixmap data and not the
478 filename even though this is a potential memory pig. We have to
479 do this because it is quite possible that we will need to
480 instantiate a new instance of the pixmap and the file will no
481 longer exist (e.g. w3 pixmaps are almost always from temporary
484 struct image_instantiator_methods * meths =
485 decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
487 return IIFORMAT_METH_OR_GIVEN (meths, normalize,
488 (instantiator, contype),
494 instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain,
495 Lisp_Object instantiator,
496 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
499 Lisp_Object ii = allocate_image_instance (device);
500 struct image_instantiator_methods *meths;
504 meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0],
506 if (!HAS_IIFORMAT_METH_P (meths, instantiate))
508 ("Don't know how to instantiate this image instantiator?",
510 IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
511 pointer_bg, dest_mask, domain));
518 /****************************************************************************
519 * Image-Instance Object *
520 ****************************************************************************/
522 Lisp_Object Qimage_instancep;
525 mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object))
527 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
530 switch (IMAGE_INSTANCE_TYPE (i))
533 (markobj) (IMAGE_INSTANCE_TEXT_STRING (i));
535 case IMAGE_MONO_PIXMAP:
536 case IMAGE_COLOR_PIXMAP:
537 (markobj) (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
538 (markobj) (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
539 (markobj) (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
540 (markobj) (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
541 (markobj) (IMAGE_INSTANCE_PIXMAP_FG (i));
542 (markobj) (IMAGE_INSTANCE_PIXMAP_BG (i));
544 case IMAGE_SUBWINDOW:
545 /* #### implement me */
551 MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i, markobj));
557 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
561 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
564 error ("printing unreadable object #<image-instance 0x%x>",
566 write_c_string ("#<image-instance (", printcharfun);
567 print_internal (Fimage_instance_type (obj), printcharfun, 0);
568 write_c_string (") ", printcharfun);
569 if (!NILP (ii->name))
571 print_internal (ii->name, printcharfun, 1);
572 write_c_string (" ", printcharfun);
574 write_c_string ("on ", printcharfun);
575 print_internal (ii->device, printcharfun, 0);
576 write_c_string (" ", printcharfun);
577 switch (IMAGE_INSTANCE_TYPE (ii))
583 print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
586 case IMAGE_MONO_PIXMAP:
587 case IMAGE_COLOR_PIXMAP:
589 if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
592 Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
593 s = strrchr ((char *) XSTRING_DATA (filename), '/');
595 print_internal (build_string (s + 1), printcharfun, 1);
597 print_internal (filename, printcharfun, 1);
599 if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
600 sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
601 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
602 IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
604 sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
605 IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
606 write_c_string (buf, printcharfun);
607 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
608 !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
610 write_c_string (" @", printcharfun);
611 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
613 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
614 write_c_string (buf, printcharfun);
617 write_c_string ("??", printcharfun);
618 write_c_string (",", printcharfun);
619 if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
621 long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
622 write_c_string (buf, printcharfun);
625 write_c_string ("??", printcharfun);
627 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
628 !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
630 write_c_string (" (", printcharfun);
631 if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
635 (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
637 write_c_string ("/", printcharfun);
638 if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
642 (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
644 write_c_string (")", printcharfun);
648 case IMAGE_SUBWINDOW:
649 /* #### implement me */
656 MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance,
657 (ii, printcharfun, escapeflag));
658 sprintf (buf, " 0x%x>", ii->header.uid);
659 write_c_string (buf, printcharfun);
663 finalize_image_instance (void *header, int for_disksave)
665 struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header;
667 if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING)
668 /* objects like this exist at dump time, so don't bomb out. */
670 if (for_disksave) finalose (i);
672 MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i));
676 image_instance_equal (Lisp_Object o1, Lisp_Object o2, int depth)
678 struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (o1);
679 struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (o2);
680 struct device *d1 = XDEVICE (i1->device);
681 struct device *d2 = XDEVICE (i2->device);
685 if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2))
687 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
691 switch (IMAGE_INSTANCE_TYPE (i1))
697 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
698 IMAGE_INSTANCE_TEXT_STRING (i2),
703 case IMAGE_MONO_PIXMAP:
704 case IMAGE_COLOR_PIXMAP:
706 if (!(IMAGE_INSTANCE_PIXMAP_WIDTH (i1) ==
707 IMAGE_INSTANCE_PIXMAP_WIDTH (i2) &&
708 IMAGE_INSTANCE_PIXMAP_HEIGHT (i1) ==
709 IMAGE_INSTANCE_PIXMAP_HEIGHT (i2) &&
710 IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
711 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
712 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
713 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
714 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
715 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
716 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
717 IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
719 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
720 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
725 case IMAGE_SUBWINDOW:
726 /* #### implement me */
733 return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1);
737 image_instance_hash (Lisp_Object obj, int depth)
739 struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
740 struct device *d = XDEVICE (i->device);
741 unsigned long hash = (unsigned long) d;
743 switch (IMAGE_INSTANCE_TYPE (i))
749 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
753 case IMAGE_MONO_PIXMAP:
754 case IMAGE_COLOR_PIXMAP:
756 hash = HASH5 (hash, IMAGE_INSTANCE_PIXMAP_WIDTH (i),
757 IMAGE_INSTANCE_PIXMAP_HEIGHT (i),
758 IMAGE_INSTANCE_PIXMAP_DEPTH (i),
759 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
763 case IMAGE_SUBWINDOW:
764 /* #### implement me */
771 return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth),
775 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
776 mark_image_instance, print_image_instance,
777 finalize_image_instance, image_instance_equal,
779 struct Lisp_Image_Instance);
782 allocate_image_instance (Lisp_Object device)
784 struct Lisp_Image_Instance *lp =
785 alloc_lcrecord_type (struct Lisp_Image_Instance, lrecord_image_instance);
790 lp->type = IMAGE_NOTHING;
792 XSETIMAGE_INSTANCE (val, lp);
796 static enum image_instance_type
797 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
799 if (ERRB_EQ (errb, ERROR_ME))
802 if (EQ (type, Qnothing)) return IMAGE_NOTHING;
803 if (EQ (type, Qtext)) return IMAGE_TEXT;
804 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP;
805 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
806 if (EQ (type, Qpointer)) return IMAGE_POINTER;
807 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW;
809 maybe_signal_simple_error ("Invalid image-instance type", type,
812 return IMAGE_UNKNOWN; /* not reached */
816 encode_image_instance_type (enum image_instance_type type)
820 case IMAGE_NOTHING: return Qnothing;
821 case IMAGE_TEXT: return Qtext;
822 case IMAGE_MONO_PIXMAP: return Qmono_pixmap;
823 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
824 case IMAGE_POINTER: return Qpointer;
825 case IMAGE_SUBWINDOW: return Qsubwindow;
830 return Qnil; /* not reached */
834 image_instance_type_to_mask (enum image_instance_type type)
836 /* This depends on the fact that enums are assigned consecutive
837 integers starting at 0. (Remember that IMAGE_UNKNOWN is the
838 first enum.) I'm fairly sure this behavior in ANSI-mandated,
839 so there should be no portability problems here. */
840 return (1 << ((int) (type) - 1));
844 decode_image_instance_type_list (Lisp_Object list)
854 enum image_instance_type type =
855 decode_image_instance_type (list, ERROR_ME);
856 return image_instance_type_to_mask (type);
859 EXTERNAL_LIST_LOOP (rest, list)
861 enum image_instance_type type =
862 decode_image_instance_type (XCAR (rest), ERROR_ME);
863 mask |= image_instance_type_to_mask (type);
870 encode_image_instance_type_list (int mask)
873 Lisp_Object result = Qnil;
879 result = Fcons (encode_image_instance_type
880 ((enum image_instance_type) count), result);
884 return Fnreverse (result);
888 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
889 int desired_dest_mask)
894 (emacs_doprnt_string_lisp_2
896 "No compatible image-instance types given: wanted one of %s, got %s",
898 encode_image_instance_type_list (desired_dest_mask),
899 encode_image_instance_type_list (given_dest_mask)),
904 valid_image_instance_type_p (Lisp_Object type)
906 return !NILP (memq_no_quit (type, Vimage_instance_type_list));
909 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
910 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
911 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
912 'pointer, and 'subwindow, depending on how XEmacs was compiled.
914 (image_instance_type))
916 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
919 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
920 Return a list of valid image-instance types.
924 return Fcopy_sequence (Vimage_instance_type_list);
928 decode_error_behavior_flag (Lisp_Object no_error)
930 if (NILP (no_error)) return ERROR_ME;
931 else if (EQ (no_error, Qt)) return ERROR_ME_NOT;
932 else return ERROR_ME_WARN;
936 encode_error_behavior_flag (Error_behavior errb)
938 if (ERRB_EQ (errb, ERROR_ME))
940 else if (ERRB_EQ (errb, ERROR_ME_NOT))
944 assert (ERRB_EQ (errb, ERROR_ME_WARN));
950 make_image_instance_1 (Lisp_Object data, Lisp_Object device,
951 Lisp_Object dest_types)
957 XSETDEVICE (device, decode_device (device));
958 /* instantiate_image_instantiator() will abort if given an
959 image instance ... */
960 if (IMAGE_INSTANCEP (data))
961 signal_simple_error ("image instances not allowed here", data);
962 image_validate (data);
963 dest_mask = decode_image_instance_type_list (dest_types);
964 data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)),
965 make_int (dest_mask));
967 if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit))
968 signal_simple_error ("inheritance not allowed here", data);
969 ii = instantiate_image_instantiator (device, device, data,
970 Qnil, Qnil, dest_mask);
974 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
975 Return a new `image-instance' object.
977 Image-instance objects encapsulate the way a particular image (pixmap,
978 etc.) is displayed on a particular device. In most circumstances, you
979 do not need to directly create image instances; use a glyph instead.
980 However, it may occasionally be useful to explicitly create image
981 instances, if you want more control over the instantiation process.
983 DATA is an image instantiator, which describes the image; see
984 `image-specifier-p' for a description of the allowed values.
986 DEST-TYPES should be a list of allowed image instance types that can
987 be generated. The recognized image instance types are
990 Nothing is displayed.
992 Displayed as text. The foreground and background colors and the
993 font of the text are specified independent of the pixmap. Typically
994 these attributes will come from the face of the surrounding text,
995 unless a face is specified for the glyph in which the image appears.
997 Displayed as a mono pixmap (a pixmap with only two colors where the
998 foreground and background can be specified independent of the pixmap;
999 typically the pixmap assumes the foreground and background colors of
1000 the text around it, unless a face is specified for the glyph in which
1003 Displayed as a color pixmap.
1005 Used as the mouse pointer for a window.
1007 A child window that is treated as an image. This allows (e.g.)
1008 another program to be responsible for drawing into the window.
1009 Not currently implemented.
1011 The DEST-TYPES list is unordered. If multiple destination types
1012 are possible for a given instantiator, the "most natural" type
1013 for the instantiator's format is chosen. (For XBM, the most natural
1014 types are `mono-pixmap', followed by `color-pixmap', followed by
1015 `pointer'. For the other normal image formats, the most natural
1016 types are `color-pixmap', followed by `mono-pixmap', followed by
1017 `pointer'. For the string and formatted-string formats, the most
1018 natural types are `text', followed by `mono-pixmap' (not currently
1019 implemented), followed by `color-pixmap' (not currently implemented).
1020 The other formats can only be instantiated as one type. (If you
1021 want to control more specifically the order of the types into which
1022 an image is instantiated, just call `make-image-instance' repeatedly
1023 until it succeeds, passing less and less preferred destination types
1026 If DEST-TYPES is omitted, all possible types are allowed.
1028 NO-ERROR controls what happens when the image cannot be generated.
1029 If nil, an error message is generated. If t, no messages are
1030 generated and this function returns nil. If anything else, a warning
1031 message is generated and this function returns nil.
1033 (data, device, dest_types, no_error))
1035 Error_behavior errb = decode_error_behavior_flag (no_error);
1037 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1039 3, data, device, dest_types);
1042 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1043 Return non-nil if OBJECT is an image instance.
1047 return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1050 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1051 Return the type of the given image instance.
1052 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1053 'color-pixmap, 'pointer, or 'subwindow.
1057 CHECK_IMAGE_INSTANCE (image_instance);
1058 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1061 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1062 Return the name of the given image instance.
1066 CHECK_IMAGE_INSTANCE (image_instance);
1067 return XIMAGE_INSTANCE_NAME (image_instance);
1070 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1071 Return the string of the given image instance.
1072 This will only be non-nil for text image instances.
1076 CHECK_IMAGE_INSTANCE (image_instance);
1077 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1078 return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1083 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1084 Return the file name from which IMAGE-INSTANCE was read, if known.
1088 CHECK_IMAGE_INSTANCE (image_instance);
1090 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1092 case IMAGE_MONO_PIXMAP:
1093 case IMAGE_COLOR_PIXMAP:
1095 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1102 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1103 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1107 CHECK_IMAGE_INSTANCE (image_instance);
1109 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1111 case IMAGE_MONO_PIXMAP:
1112 case IMAGE_COLOR_PIXMAP:
1114 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1121 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1122 Return the depth of the image instance.
1123 This is 0 for a bitmap, or a positive integer for a pixmap.
1127 CHECK_IMAGE_INSTANCE (image_instance);
1129 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1131 case IMAGE_MONO_PIXMAP:
1132 case IMAGE_COLOR_PIXMAP:
1134 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1141 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1142 Return the height of the image instance, in pixels.
1146 CHECK_IMAGE_INSTANCE (image_instance);
1148 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1150 case IMAGE_MONO_PIXMAP:
1151 case IMAGE_COLOR_PIXMAP:
1153 return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance));
1160 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1161 Return the width of the image instance, in pixels.
1165 CHECK_IMAGE_INSTANCE (image_instance);
1167 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1169 case IMAGE_MONO_PIXMAP:
1170 case IMAGE_COLOR_PIXMAP:
1172 return make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance));
1179 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1180 Return the X coordinate of the image instance's hotspot, if known.
1181 This is a point relative to the origin of the pixmap. When an image is
1182 used as a mouse pointer, the hotspot is the point on the image that sits
1183 over the location that the pointer points to. This is, for example, the
1184 tip of the arrow or the center of the crosshairs.
1185 This will always be nil for a non-pointer image instance.
1189 CHECK_IMAGE_INSTANCE (image_instance);
1191 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1193 case IMAGE_MONO_PIXMAP:
1194 case IMAGE_COLOR_PIXMAP:
1196 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1203 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1204 Return the Y coordinate of the image instance's hotspot, if known.
1205 This is a point relative to the origin of the pixmap. When an image is
1206 used as a mouse pointer, the hotspot is the point on the image that sits
1207 over the location that the pointer points to. This is, for example, the
1208 tip of the arrow or the center of the crosshairs.
1209 This will always be nil for a non-pointer image instance.
1213 CHECK_IMAGE_INSTANCE (image_instance);
1215 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1217 case IMAGE_MONO_PIXMAP:
1218 case IMAGE_COLOR_PIXMAP:
1220 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1227 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1228 Return the foreground color of IMAGE-INSTANCE, if applicable.
1229 This will be a color instance or nil. (It will only be non-nil for
1230 colorized mono pixmaps and for pointers.)
1234 CHECK_IMAGE_INSTANCE (image_instance);
1236 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1238 case IMAGE_MONO_PIXMAP:
1239 case IMAGE_COLOR_PIXMAP:
1241 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1248 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1249 Return the background color of IMAGE-INSTANCE, if applicable.
1250 This will be a color instance or nil. (It will only be non-nil for
1251 colorized mono pixmaps and for pointers.)
1255 CHECK_IMAGE_INSTANCE (image_instance);
1257 switch (XIMAGE_INSTANCE_TYPE (image_instance))
1259 case IMAGE_MONO_PIXMAP:
1260 case IMAGE_COLOR_PIXMAP:
1262 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1270 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1271 Make the image instance be displayed in the given colors.
1272 This function returns a new image instance that is exactly like the
1273 specified one except that (if possible) the foreground and background
1274 colors and as specified. Currently, this only does anything if the image
1275 instance is a mono pixmap; otherwise, the same image instance is returned.
1277 (image_instance, foreground, background))
1282 CHECK_IMAGE_INSTANCE (image_instance);
1283 CHECK_COLOR_INSTANCE (foreground);
1284 CHECK_COLOR_INSTANCE (background);
1286 device = XIMAGE_INSTANCE_DEVICE (image_instance);
1287 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1288 return image_instance;
1290 new = allocate_image_instance (device);
1291 copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1292 /* note that if this method returns non-zero, this method MUST
1293 copy any window-system resources, so that when one image instance is
1294 freed, the other one is not hosed. */
1295 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1297 return image_instance;
1302 /************************************************************************/
1304 /************************************************************************/
1306 signal_image_error (CONST char *reason, Lisp_Object frob)
1308 signal_error (Qimage_conversion_error,
1309 list2 (build_translated_string (reason), frob));
1313 signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1)
1315 signal_error (Qimage_conversion_error,
1316 list3 (build_translated_string (reason), frob0, frob1));
1319 /****************************************************************************
1321 ****************************************************************************/
1324 nothing_possible_dest_types (void)
1326 return IMAGE_NOTHING_MASK;
1330 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1331 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1332 int dest_mask, Lisp_Object domain)
1334 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1336 if (dest_mask & IMAGE_NOTHING_MASK)
1337 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
1339 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
1343 /****************************************************************************
1345 ****************************************************************************/
1348 inherit_validate (Lisp_Object instantiator)
1350 face_must_be_present (instantiator);
1354 inherit_normalize (Lisp_Object inst, Lisp_Object console_type)
1358 assert (XVECTOR_LENGTH (inst) == 3);
1359 face = XVECTOR_DATA (inst)[2];
1361 inst = vector3 (Qinherit, Q_face, Fget_face (face));
1366 inherit_possible_dest_types (void)
1368 return IMAGE_MONO_PIXMAP_MASK;
1372 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1373 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1374 int dest_mask, Lisp_Object domain)
1376 /* handled specially in image_instantiate */
1381 /****************************************************************************
1383 ****************************************************************************/
1386 string_validate (Lisp_Object instantiator)
1388 data_must_be_present (instantiator);
1392 string_possible_dest_types (void)
1394 return IMAGE_TEXT_MASK;
1397 /* called from autodetect_instantiate() */
1399 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1400 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1401 int dest_mask, Lisp_Object domain)
1403 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1404 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1406 assert (!NILP (data));
1407 if (dest_mask & IMAGE_TEXT_MASK)
1409 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1410 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1413 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1417 /****************************************************************************
1418 * formatted-string *
1419 ****************************************************************************/
1422 formatted_string_validate (Lisp_Object instantiator)
1424 data_must_be_present (instantiator);
1428 formatted_string_possible_dest_types (void)
1430 return IMAGE_TEXT_MASK;
1434 formatted_string_instantiate (Lisp_Object image_instance,
1435 Lisp_Object instantiator,
1436 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1437 int dest_mask, Lisp_Object domain)
1439 Lisp_Object data = find_keyword_in_vector (instantiator, Q_data);
1440 struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
1442 assert (!NILP (data));
1443 /* #### implement this */
1444 warn_when_safe (Qunimplemented, Qnotice,
1445 "`formatted-string' not yet implemented; assuming `string'");
1446 if (dest_mask & IMAGE_TEXT_MASK)
1448 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
1449 IMAGE_INSTANCE_TEXT_STRING (ii) = data;
1452 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
1456 /************************************************************************/
1457 /* pixmap file functions */
1458 /************************************************************************/
1460 /* If INSTANTIATOR refers to inline data, return Qnil.
1461 If INSTANTIATOR refers to data in a file, return the full filename
1462 if it exists; otherwise, return a cons of (filename).
1464 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
1465 keywords used to look up the file and inline data,
1466 respectively, in the instantiator. Normally these would
1467 be Q_file and Q_data, but might be different for mask data. */
1470 potential_pixmap_file_instantiator (Lisp_Object instantiator,
1471 Lisp_Object file_keyword,
1472 Lisp_Object data_keyword,
1473 Lisp_Object console_type)
1478 assert (VECTORP (instantiator));
1480 data = find_keyword_in_vector (instantiator, data_keyword);
1481 file = find_keyword_in_vector (instantiator, file_keyword);
1483 if (!NILP (file) && NILP (data))
1485 Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
1486 (decode_console_type(console_type, ERROR_ME),
1487 locate_pixmap_file, (file));
1492 return Fcons (file, Qnil); /* should have been file */
1499 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
1500 Lisp_Object image_type_tag)
1502 /* This function can call lisp */
1503 Lisp_Object file = Qnil;
1504 struct gcpro gcpro1, gcpro2;
1505 Lisp_Object alist = Qnil;
1507 GCPRO2 (file, alist);
1509 /* Now, convert any file data into inline data. At the end of this,
1510 `data' will contain the inline data (if any) or Qnil, and `file'
1511 will contain the name this data was derived from (if known) or
1514 Note that if we cannot generate any regular inline data, we
1517 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1520 if (CONSP (file)) /* failure locating filename */
1521 signal_double_file_error ("Opening pixmap file",
1522 "no such file or directory",
1525 if (NILP (file)) /* no conversion necessary */
1526 RETURN_UNGCPRO (inst);
1528 alist = tagged_vector_to_alist (inst);
1531 Lisp_Object data = make_string_from_file (file);
1532 alist = remassq_no_quit (Q_file, alist);
1533 /* there can't be a :data at this point. */
1534 alist = Fcons (Fcons (Q_file, file),
1535 Fcons (Fcons (Q_data, data), alist));
1539 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
1541 RETURN_UNGCPRO (result);
1546 #ifdef HAVE_WINDOW_SYSTEM
1547 /**********************************************************************
1549 **********************************************************************/
1551 /* Check if DATA represents a valid inline XBM spec (i.e. a list
1552 of (width height bits), with checking done on the dimensions).
1553 If not, signal an error. */
1556 check_valid_xbm_inline (Lisp_Object data)
1558 Lisp_Object width, height, bits;
1560 if (!CONSP (data) ||
1561 !CONSP (XCDR (data)) ||
1562 !CONSP (XCDR (XCDR (data))) ||
1563 !NILP (XCDR (XCDR (XCDR (data)))))
1564 signal_simple_error ("Must be list of 3 elements", data);
1566 width = XCAR (data);
1567 height = XCAR (XCDR (data));
1568 bits = XCAR (XCDR (XCDR (data)));
1570 CHECK_STRING (bits);
1572 if (!NATNUMP (width))
1573 signal_simple_error ("Width must be a natural number", width);
1575 if (!NATNUMP (height))
1576 signal_simple_error ("Height must be a natural number", height);
1578 if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
1579 signal_simple_error ("data is too short for width and height",
1580 vector3 (width, height, bits));
1583 /* Validate method for XBM's. */
1586 xbm_validate (Lisp_Object instantiator)
1588 file_or_data_must_be_present (instantiator);
1591 /* Given a filename that is supposed to contain XBM data, return
1592 the inline representation of it as (width height bits). Return
1593 the hotspot through XHOT and YHOT, if those pointers are not 0.
1594 If there is no hotspot, XHOT and YHOT will contain -1.
1596 If the function fails:
1598 -- if OK_IF_DATA_INVALID is set and the data was invalid,
1600 -- maybe return an error, or return Qnil.
1603 #ifndef HAVE_X_WINDOWS
1604 #define XFree(data) free(data)
1608 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
1609 int ok_if_data_invalid)
1614 CONST char *filename_ext;
1616 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
1617 result = read_bitmap_data_from_file (filename_ext, &w, &h,
1620 if (result == BitmapSuccess)
1623 int len = (w + 7) / 8 * h;
1625 retval = list3 (make_int (w), make_int (h),
1626 make_ext_string (data, len, FORMAT_BINARY));
1627 XFree ((char *) data);
1633 case BitmapOpenFailed:
1635 /* should never happen */
1636 signal_double_file_error ("Opening bitmap file",
1637 "no such file or directory",
1640 case BitmapFileInvalid:
1642 if (ok_if_data_invalid)
1644 signal_double_file_error ("Reading bitmap file",
1645 "invalid data in file",
1648 case BitmapNoMemory:
1650 signal_double_file_error ("Reading bitmap file",
1656 signal_double_file_error_2 ("Reading bitmap file",
1657 "unknown error code",
1658 make_int (result), name);
1662 return Qnil; /* not reached */
1666 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
1667 Lisp_Object mask_file, Lisp_Object console_type)
1669 /* This is unclean but it's fairly standard -- a number of the
1670 bitmaps in /usr/include/X11/bitmaps use it -- so we support
1672 if (NILP (mask_file)
1673 /* don't override explicitly specified mask data. */
1674 && NILP (assq_no_quit (Q_mask_data, alist))
1677 mask_file = MAYBE_LISP_CONTYPE_METH
1678 (decode_console_type(console_type, ERROR_ME),
1679 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
1680 if (NILP (mask_file))
1681 mask_file = MAYBE_LISP_CONTYPE_METH
1682 (decode_console_type(console_type, ERROR_ME),
1683 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
1686 if (!NILP (mask_file))
1688 Lisp_Object mask_data =
1689 bitmap_to_lisp_data (mask_file, 0, 0, 0);
1690 alist = remassq_no_quit (Q_mask_file, alist);
1691 /* there can't be a :mask-data at this point. */
1692 alist = Fcons (Fcons (Q_mask_file, mask_file),
1693 Fcons (Fcons (Q_mask_data, mask_data), alist));
1699 /* Normalize method for XBM's. */
1702 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
1704 Lisp_Object file = Qnil, mask_file = Qnil;
1705 struct gcpro gcpro1, gcpro2, gcpro3;
1706 Lisp_Object alist = Qnil;
1708 GCPRO3 (file, mask_file, alist);
1710 /* Now, convert any file data into inline data for both the regular
1711 data and the mask data. At the end of this, `data' will contain
1712 the inline data (if any) or Qnil, and `file' will contain
1713 the name this data was derived from (if known) or Qnil.
1714 Likewise for `mask_file' and `mask_data'.
1716 Note that if we cannot generate any regular inline data, we
1719 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1721 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
1722 Q_mask_data, console_type);
1724 if (CONSP (file)) /* failure locating filename */
1725 signal_double_file_error ("Opening bitmap file",
1726 "no such file or directory",
1729 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
1730 RETURN_UNGCPRO (inst);
1732 alist = tagged_vector_to_alist (inst);
1737 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
1738 alist = remassq_no_quit (Q_file, alist);
1739 /* there can't be a :data at this point. */
1740 alist = Fcons (Fcons (Q_file, file),
1741 Fcons (Fcons (Q_data, data), alist));
1743 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
1744 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1746 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
1747 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1751 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
1754 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1756 RETURN_UNGCPRO (result);
1762 xbm_possible_dest_types (void)
1765 IMAGE_MONO_PIXMAP_MASK |
1766 IMAGE_COLOR_PIXMAP_MASK |
1771 xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1772 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1773 int dest_mask, Lisp_Object domain)
1775 Lisp_Object device= IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (image_instance));
1777 MAYBE_DEVMETH (XDEVICE (device),
1779 (image_instance, instantiator, pointer_fg,
1780 pointer_bg, dest_mask, domain));
1788 /**********************************************************************
1790 **********************************************************************/
1793 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
1798 result = XpmReadFileToData ((char *) XSTRING_DATA (name), &data);
1800 if (result == XpmSuccess)
1802 Lisp_Object retval = Qnil;
1803 struct buffer *old_buffer = current_buffer;
1804 Lisp_Object temp_buffer =
1805 Fget_buffer_create (build_string (" *pixmap conversion*"));
1807 int height, width, ncolors;
1808 struct gcpro gcpro1, gcpro2, gcpro3;
1809 int speccount = specpdl_depth ();
1811 GCPRO3 (name, retval, temp_buffer);
1813 specbind (Qinhibit_quit, Qt);
1814 set_buffer_internal (XBUFFER (temp_buffer));
1815 Ferase_buffer (Qnil);
1817 buffer_insert_c_string (current_buffer, "/* XPM */\r");
1818 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
1820 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
1821 for (elt = 0; elt <= width + ncolors; elt++)
1823 buffer_insert_c_string (current_buffer, "\"");
1824 buffer_insert_c_string (current_buffer, data[elt]);
1826 if (elt < width + ncolors)
1827 buffer_insert_c_string (current_buffer, "\",\r");
1829 buffer_insert_c_string (current_buffer, "\"};\r");
1832 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
1835 set_buffer_internal (old_buffer);
1836 unbind_to (speccount, Qnil);
1838 RETURN_UNGCPRO (retval);
1843 case XpmFileInvalid:
1845 if (ok_if_data_invalid)
1847 signal_image_error ("invalid XPM data in file", name);
1851 signal_double_file_error ("Reading pixmap file",
1852 "out of memory", name);
1856 /* should never happen? */
1857 signal_double_file_error ("Opening pixmap file",
1858 "no such file or directory", name);
1862 signal_double_file_error_2 ("Parsing pixmap file",
1863 "unknown error code",
1864 make_int (result), name);
1869 return Qnil; /* not reached */
1873 check_valid_xpm_color_symbols (Lisp_Object data)
1877 for (rest = data; !NILP (rest); rest = XCDR (rest))
1879 if (!CONSP (rest) ||
1880 !CONSP (XCAR (rest)) ||
1881 !STRINGP (XCAR (XCAR (rest))) ||
1882 (!STRINGP (XCDR (XCAR (rest))) &&
1883 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
1884 signal_simple_error ("Invalid color symbol alist", data);
1889 xpm_validate (Lisp_Object instantiator)
1891 file_or_data_must_be_present (instantiator);
1894 Lisp_Object Vxpm_color_symbols;
1897 evaluate_xpm_color_symbols (void)
1899 Lisp_Object rest, results = Qnil;
1900 struct gcpro gcpro1, gcpro2;
1902 GCPRO2 (rest, results);
1903 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
1905 Lisp_Object name, value, cons;
1911 CHECK_STRING (name);
1912 value = XCDR (cons);
1914 value = XCAR (value);
1915 value = Feval (value);
1918 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
1920 ("Result from xpm-color-symbols eval must be nil, string, or color",
1922 results = Fcons (Fcons (name, value), results);
1924 UNGCPRO; /* no more evaluation */
1929 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
1931 Lisp_Object file = Qnil;
1932 Lisp_Object color_symbols;
1933 struct gcpro gcpro1, gcpro2;
1934 Lisp_Object alist = Qnil;
1936 GCPRO2 (file, alist);
1938 /* Now, convert any file data into inline data. At the end of this,
1939 `data' will contain the inline data (if any) or Qnil, and
1940 `file' will contain the name this data was derived from (if
1943 Note that if we cannot generate any regular inline data, we
1946 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1949 if (CONSP (file)) /* failure locating filename */
1950 signal_double_file_error ("Opening pixmap file",
1951 "no such file or directory",
1954 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
1957 if (NILP (file) && !UNBOUNDP (color_symbols))
1958 /* no conversion necessary */
1959 RETURN_UNGCPRO (inst);
1961 alist = tagged_vector_to_alist (inst);
1965 Lisp_Object data = pixmap_to_lisp_data (file, 0);
1966 alist = remassq_no_quit (Q_file, alist);
1967 /* there can't be a :data at this point. */
1968 alist = Fcons (Fcons (Q_file, file),
1969 Fcons (Fcons (Q_data, data), alist));
1972 if (UNBOUNDP (color_symbols))
1974 color_symbols = evaluate_xpm_color_symbols ();
1975 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
1980 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1982 RETURN_UNGCPRO (result);
1987 xpm_possible_dest_types (void)
1990 IMAGE_MONO_PIXMAP_MASK |
1991 IMAGE_COLOR_PIXMAP_MASK |
1996 xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1997 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1998 int dest_mask, Lisp_Object domain)
2000 Lisp_Object device= IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (image_instance));
2002 MAYBE_DEVMETH (XDEVICE (device),
2004 (image_instance, instantiator, pointer_fg,
2005 pointer_bg, dest_mask, domain));
2008 #endif /* HAVE_XPM */
2011 /****************************************************************************
2012 * Image Specifier Object *
2013 ****************************************************************************/
2015 DEFINE_SPECIFIER_TYPE (image);
2018 image_create (Lisp_Object obj)
2020 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2022 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2023 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2024 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2028 image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
2030 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2032 ((markobj) (IMAGE_SPECIFIER_ATTACHEE (image)));
2033 ((markobj) (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)));
2037 image_instantiate_cache_result (Lisp_Object locative)
2039 /* locative = (instance instantiator . subtable) */
2040 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2041 free_cons (XCONS (XCDR (locative)));
2042 free_cons (XCONS (locative));
2046 /* Given a specification for an image, return an instance of
2047 the image which matches the given instantiator and which can be
2048 displayed in the given domain. */
2051 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2052 Lisp_Object domain, Lisp_Object instantiator,
2055 Lisp_Object device = DFW_DEVICE (domain);
2056 struct device *d = XDEVICE (device);
2057 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2058 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2060 if (IMAGE_INSTANCEP (instantiator))
2062 /* make sure that the image instance's device and type are
2065 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2068 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2069 if (mask & dest_mask)
2070 return instantiator;
2072 signal_simple_error ("Type of image instance not allowed here",
2076 signal_simple_error_2 ("Wrong device for image instance",
2077 instantiator, device);
2079 else if (VECTORP (instantiator)
2080 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2082 assert (XVECTOR_LENGTH (instantiator) == 3);
2083 return (FACE_PROPERTY_INSTANCE
2084 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2085 Qbackground_pixmap, domain, 0, depth));
2089 Lisp_Object instance;
2090 Lisp_Object subtable;
2091 Lisp_Object ls3 = Qnil;
2092 Lisp_Object pointer_fg = Qnil;
2093 Lisp_Object pointer_bg = Qnil;
2097 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2098 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2099 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2102 /* First look in the hash table. */
2103 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2105 if (UNBOUNDP (subtable))
2107 /* For the image instance cache, we do comparisons with EQ rather
2108 than with EQUAL, as we do for color and font names.
2111 1) pixmap data can be very long, and thus the hashing and
2112 comparing will take awhile.
2113 2) It's not so likely that we'll run into things that are EQUAL
2114 but not EQ (that can happen a lot with faces, because their
2115 specifiers are copied around); but pixmaps tend not to be
2118 However, if the image-instance could be a pointer, we have to
2119 use EQUAL because we massaged the instantiator into a cons3
2120 also containing the foreground and background of the
2124 subtable = make_lisp_hashtable (20,
2125 pointerp ? HASHTABLE_KEY_CAR_WEAK
2126 : HASHTABLE_KEY_WEAK,
2127 pointerp ? HASHTABLE_EQUAL
2129 Fputhash (make_int (dest_mask), subtable,
2130 d->image_instance_cache);
2131 instance = Qunbound;
2134 instance = Fgethash (pointerp ? ls3 : instantiator,
2135 subtable, Qunbound);
2137 if (UNBOUNDP (instance))
2139 Lisp_Object locative =
2141 noseeum_cons (pointerp ? ls3 : instantiator,
2143 int speccount = specpdl_depth ();
2145 /* make sure we cache the failures, too.
2146 Use an unwind-protect to catch such errors.
2147 If we fail, the unwind-protect records nil in
2148 the hash table. If we succeed, we change the
2149 car of the locative to the resulting instance,
2150 which gets recorded instead. */
2151 record_unwind_protect (image_instantiate_cache_result,
2153 instance = instantiate_image_instantiator (device,
2156 pointer_fg, pointer_bg,
2158 Fsetcar (locative, instance);
2159 unbind_to (speccount, Qnil);
2164 if (NILP (instance))
2165 signal_simple_error ("Can't instantiate image (probably cached)",
2171 return Qnil; /* not reached */
2174 /* Validate an image instantiator. */
2177 image_validate (Lisp_Object instantiator)
2179 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2181 else if (VECTORP (instantiator))
2183 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2184 int instantiator_len = XVECTOR_LENGTH (instantiator);
2185 struct image_instantiator_methods *meths;
2186 Lisp_Object already_seen = Qnil;
2187 struct gcpro gcpro1;
2190 if (instantiator_len < 1)
2191 signal_simple_error ("Vector length must be at least 1",
2194 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2195 if (!(instantiator_len & 1))
2197 ("Must have alternating keyword/value pairs", instantiator);
2199 GCPRO1 (already_seen);
2201 for (i = 1; i < instantiator_len; i += 2)
2203 Lisp_Object keyword = elt[i];
2204 Lisp_Object value = elt[i+1];
2207 CHECK_SYMBOL (keyword);
2208 if (!SYMBOL_IS_KEYWORD (keyword))
2209 signal_simple_error ("Symbol must begin with a colon", keyword);
2211 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2212 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2215 if (j == Dynarr_length (meths->keywords))
2216 signal_simple_error ("Unrecognized keyword", keyword);
2218 if (!Dynarr_at (meths->keywords, j).multiple_p)
2220 if (!NILP (memq_no_quit (keyword, already_seen)))
2222 ("Keyword may not appear more than once", keyword);
2223 already_seen = Fcons (keyword, already_seen);
2226 (Dynarr_at (meths->keywords, j).validate) (value);
2231 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2234 signal_simple_error ("Must be string or vector", instantiator);
2238 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2240 Lisp_Object attachee =
2241 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2242 Lisp_Object property =
2243 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2244 if (FACEP (attachee))
2245 face_property_was_changed (attachee, property, locale);
2246 else if (GLYPHP (attachee))
2247 glyph_property_was_changed (attachee, property, locale);
2251 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2252 Lisp_Object property)
2254 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2256 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2257 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2261 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2262 Lisp_Object tag_set, Lisp_Object instantiator)
2264 Lisp_Object possible_console_types = Qnil;
2266 Lisp_Object retlist = Qnil;
2267 struct gcpro gcpro1, gcpro2;
2269 LIST_LOOP (rest, Vconsole_type_list)
2271 Lisp_Object contype = XCAR (rest);
2272 if (!NILP (memq_no_quit (contype, tag_set)))
2273 possible_console_types = Fcons (contype, possible_console_types);
2276 if (XINT (Flength (possible_console_types)) > 1)
2277 /* two conflicting console types specified */
2280 if (NILP (possible_console_types))
2281 possible_console_types = Vconsole_type_list;
2283 GCPRO2 (retlist, possible_console_types);
2285 LIST_LOOP (rest, possible_console_types)
2287 Lisp_Object contype = XCAR (rest);
2288 Lisp_Object newinst = call_with_suspended_errors
2289 ((lisp_fn_t) normalize_image_instantiator,
2290 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2291 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2293 if (!NILP (newinst))
2296 if (NILP (memq_no_quit (contype, tag_set)))
2297 newtag = Fcons (contype, tag_set);
2300 retlist = Fcons (Fcons (newtag, newinst), retlist);
2309 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
2310 Return non-nil if OBJECT is an image specifier.
2312 An image specifier is used for images (pixmaps and the like). It is used
2313 to describe the actual image in a glyph. It is instanced as an image-
2316 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
2317 etc. This describes the format of the data describing the image. The
2318 resulting image instances also come in many types -- `mono-pixmap',
2319 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
2320 the image and the sorts of places it can appear. (For example, a
2321 color-pixmap image has fixed colors specified for it, while a
2322 mono-pixmap image comes in two unspecified shades "foreground" and
2323 "background" that are determined from the face of the glyph or
2324 surrounding text; a text image appears as a string of text and has an
2325 unspecified foreground, background, and font; a pointer image behaves
2326 like a mono-pixmap image but can only be used as a mouse pointer
2327 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
2328 important to keep the distinction between image instantiator format and
2329 image instance type in mind. Typically, a given image instantiator
2330 format can result in many different image instance types (for example,
2331 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
2332 whereas `cursor-font' can be instanced only as `pointer'), and a
2333 particular image instance type can be generated by many different
2334 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
2335 `gif', `jpeg', etc.).
2337 See `make-image-instance' for a more detailed discussion of image
2340 An image instantiator should be a string or a vector of the form
2342 [FORMAT :KEYWORD VALUE ...]
2344 i.e. a format symbol followed by zero or more alternating keyword-value
2345 pairs. FORMAT should be one of
2348 (Don't display anything; no keywords are valid for this.
2349 Can only be instanced as `nothing'.)
2351 (Display this image as a text string. Can only be instanced
2352 as `text', although support for instancing as `mono-pixmap'
2355 (Display this image as a text string, with replaceable fields;
2356 not currently implemented.)
2358 (An X bitmap; only if X support was compiled into this XEmacs.
2359 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2361 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
2362 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
2364 (An X-Face bitmap, used to encode people's faces in e-mail messages;
2365 only if X-Face support was compiled into this XEmacs. Can be
2366 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2368 (A GIF87 or GIF89 image; only if GIF support was compiled into this
2369 XEmacs. Can be instanced as `color-pixmap'.)
2371 (A JPEG image; only if JPEG support was compiled into this XEmacs.
2372 Can be instanced as `color-pixmap'.)
2374 (A PNG/GIF24 image; only if PNG support was compiled into this XEmacs.
2375 Can be instanced as `color-pixmap'.)
2377 (A TIFF image; not currently implemented.)
2379 (One of the standard cursor-font names, such as "watch" or
2380 "right_ptr" under X. Under X, this is, more specifically, any
2381 of the standard cursor names from appendix B of the Xlib manual
2382 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
2383 On other window systems, the valid names will be specific to the
2384 type of window system. Can only be instanced as `pointer'.)
2386 (A glyph from a font; i.e. the name of a font, and glyph index into it
2387 of the form "FONT fontname index [[mask-font] mask-index]".
2388 Currently can only be instanced as `pointer', although this should
2391 (An embedded X window; not currently implemented.)
2393 (XEmacs tries to guess what format the data is in. If X support
2394 exists, the data string will be checked to see if it names a filename.
2395 If so, and this filename contains XBM or XPM data, the appropriate
2396 sort of pixmap or pointer will be created. [This includes picking up
2397 any specified hotspot or associated mask file.] Otherwise, if `pointer'
2398 is one of the allowable image-instance types and the string names a
2399 valid cursor-font name, the image will be created as a pointer.
2400 Otherwise, the image will be displayed as text. If no X support
2401 exists, the image will always be displayed as text.)
2403 Inherit from the background-pixmap property of a face.
2405 The valid keywords are:
2408 (Inline data. For most formats above, this should be a string. For
2409 XBM images, this should be a list of three elements: width, height, and
2410 a string of bit data. This keyword is not valid for instantiator
2411 formats `nothing' and `inherit'.)
2413 (Data is contained in a file. The value is the name of this file.
2414 If both :data and :file are specified, the image is created from
2415 what is specified in :data and the string in :file becomes the
2416 value of the `image-instance-file-name' function when applied to
2417 the resulting image-instance. This keyword is not valid for
2418 instantiator formats `nothing', `string', `formatted-string',
2419 `cursor-font', `font', `autodetect', and `inherit'.)
2422 (For `xbm', `xface', `cursor-font', and `font'. These keywords
2423 allow you to explicitly specify foreground and background colors.
2424 The argument should be anything acceptable to `make-color-instance'.
2425 This will cause what would be a `mono-pixmap' to instead be colorized
2426 as a two-color color-pixmap, and specifies the foreground and/or
2427 background colors for a pointer instead of black and white.)
2429 (For `xbm' and `xface'. This specifies a mask to be used with the
2430 bitmap. The format is a list of width, height, and bits, like for
2433 (For `xbm' and `xface'. This specifies a file containing the mask data.
2434 If neither a mask file nor inline mask data is given for an XBM image,
2435 and the XBM image comes from a file, XEmacs will look for a mask file
2436 with the same name as the image file but with "Mask" or "msk"
2437 appended. For example, if you specify the XBM file "left_ptr"
2438 [usually located in "/usr/include/X11/bitmaps"], the associated
2439 mask file "left_ptrmsk" will automatically be picked up.)
2442 (For `xbm' and `xface'. These keywords specify a hotspot if the image
2443 is instantiated as a `pointer'. Note that if the XBM image file
2444 specifies a hotspot, it will automatically be picked up if no
2445 explicit hotspot is given.)
2447 (Only for `xpm'. This specifies an alist that maps strings
2448 that specify symbolic color names to the actual color to be used
2449 for that symbolic color (in the form of a string or a color-specifier
2450 object). If this is not specified, the contents of `xpm-color-symbols'
2451 are used to generate the alist.)
2453 (Only for `inherit'. This specifies the face to inherit from.)
2455 If instead of a vector, the instantiator is a string, it will be
2456 converted into a vector by looking it up according to the specs in the
2457 `console-type-image-conversion-list' (q.v.) for the console type of
2458 the domain (usually a window; sometimes a frame or device) over which
2459 the image is being instantiated.
2461 If the instantiator specifies data from a file, the data will be read
2462 in at the time that the instantiator is added to the image (which may
2463 be well before when the image is actually displayed), and the
2464 instantiator will be converted into one of the inline-data forms, with
2465 the filename retained using a :file keyword. This implies that the
2466 file must exist when the instantiator is added to the image, but does
2467 not need to exist at any other time (e.g. it may safely be a temporary
2472 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
2476 /****************************************************************************
2478 ****************************************************************************/
2481 mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object))
2483 struct Lisp_Glyph *glyph = XGLYPH (obj);
2485 ((markobj) (glyph->image));
2486 ((markobj) (glyph->contrib_p));
2487 ((markobj) (glyph->baseline));
2488 ((markobj) (glyph->face));
2490 return glyph->plist;
2494 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2496 struct Lisp_Glyph *glyph = XGLYPH (obj);
2500 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
2502 write_c_string ("#<glyph (", printcharfun);
2503 print_internal (Fglyph_type (obj), printcharfun, 0);
2504 write_c_string (") ", printcharfun);
2505 print_internal (glyph->image, printcharfun, 1);
2506 sprintf (buf, "0x%x>", glyph->header.uid);
2507 write_c_string (buf, printcharfun);
2510 /* Glyphs are equal if all of their display attributes are equal. We
2511 don't compare names or doc-strings, because that would make equal
2514 This isn't concerned with "unspecified" attributes, that's what
2515 #'glyph-differs-from-default-p is for. */
2517 glyph_equal (Lisp_Object o1, Lisp_Object o2, int depth)
2519 struct Lisp_Glyph *g1 = XGLYPH (o1);
2520 struct Lisp_Glyph *g2 = XGLYPH (o2);
2524 return (internal_equal (g1->image, g2->image, depth) &&
2525 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
2526 internal_equal (g1->baseline, g2->baseline, depth) &&
2527 internal_equal (g1->face, g2->face, depth) &&
2528 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
2531 static unsigned long
2532 glyph_hash (Lisp_Object obj, int depth)
2536 /* No need to hash all of the elements; that would take too long.
2537 Just hash the most common ones. */
2538 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
2539 internal_hash (XGLYPH (obj)->face, depth));
2543 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
2545 struct Lisp_Glyph *g = XGLYPH (obj);
2547 if (EQ (prop, Qimage)) return g->image;
2548 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
2549 if (EQ (prop, Qbaseline)) return g->baseline;
2550 if (EQ (prop, Qface)) return g->face;
2552 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
2556 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
2558 if ((EQ (prop, Qimage)) ||
2559 (EQ (prop, Qcontrib_p)) ||
2560 (EQ (prop, Qbaseline)))
2563 if (EQ (prop, Qface))
2565 XGLYPH (obj)->face = Fget_face (value);
2569 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
2574 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
2576 if ((EQ (prop, Qimage)) ||
2577 (EQ (prop, Qcontrib_p)) ||
2578 (EQ (prop, Qbaseline)))
2581 if (EQ (prop, Qface))
2583 XGLYPH (obj)->face = Qnil;
2587 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
2591 glyph_plist (Lisp_Object obj)
2593 struct Lisp_Glyph *glyph = XGLYPH (obj);
2594 Lisp_Object result = glyph->plist;
2596 result = cons3 (Qface, glyph->face, result);
2597 result = cons3 (Qbaseline, glyph->baseline, result);
2598 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
2599 result = cons3 (Qimage, glyph->image, result);
2604 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
2605 mark_glyph, print_glyph, 0,
2606 glyph_equal, glyph_hash,
2607 glyph_getprop, glyph_putprop,
2608 glyph_remprop, glyph_plist,
2612 allocate_glyph (enum glyph_type type,
2613 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
2614 Lisp_Object locale))
2616 /* This function can GC */
2617 Lisp_Object obj = Qnil;
2618 struct Lisp_Glyph *g =
2619 alloc_lcrecord_type (struct Lisp_Glyph, lrecord_glyph);
2622 g->image = Fmake_specifier (Qimage); /* This function can GC */
2626 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2627 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK | IMAGE_MONO_PIXMAP_MASK |
2628 IMAGE_COLOR_PIXMAP_MASK | IMAGE_SUBWINDOW_MASK;
2631 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2632 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
2635 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2636 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK;
2642 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
2643 /* We're getting enough reports of odd behavior in this area it seems */
2644 /* best to GCPRO everything. */
2646 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
2647 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
2648 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
2649 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2651 GCPRO4 (obj, tem1, tem2, tem3);
2653 set_specifier_fallback (g->image, tem1);
2654 g->contrib_p = Fmake_specifier (Qboolean);
2655 set_specifier_fallback (g->contrib_p, tem2);
2656 /* #### should have a specifier for the following */
2657 g->baseline = Fmake_specifier (Qgeneric);
2658 set_specifier_fallback (g->baseline, tem3);
2661 g->after_change = after_change;
2664 set_image_attached_to (g->image, obj, Qimage);
2671 static enum glyph_type
2672 decode_glyph_type (Lisp_Object type, Error_behavior errb)
2675 return GLYPH_BUFFER;
2677 if (ERRB_EQ (errb, ERROR_ME))
2678 CHECK_SYMBOL (type);
2680 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
2681 if (EQ (type, Qpointer)) return GLYPH_POINTER;
2682 if (EQ (type, Qicon)) return GLYPH_ICON;
2684 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
2686 return GLYPH_UNKNOWN;
2690 valid_glyph_type_p (Lisp_Object type)
2692 return !NILP (memq_no_quit (type, Vglyph_type_list));
2695 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
2696 Given a GLYPH-TYPE, return non-nil if it is valid.
2697 Valid types are `buffer', `pointer', and `icon'.
2701 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
2704 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
2705 Return a list of valid glyph types.
2709 return Fcopy_sequence (Vglyph_type_list);
2712 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
2713 Create and return a new uninitialized glyph or type TYPE.
2715 TYPE specifies the type of the glyph; this should be one of `buffer',
2716 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
2717 specifies in which contexts the glyph can be used, and controls the
2718 allowable image types into which the glyph's image can be
2721 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
2722 extent, in the modeline, and in the toolbar. Their image can be
2723 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
2726 `pointer' glyphs can be used to specify the mouse pointer. Their
2727 image can be instantiated as `pointer'.
2729 `icon' glyphs can be used to specify the icon used when a frame is
2730 iconified. Their image can be instantiated as `mono-pixmap' and
2735 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
2736 return allocate_glyph (typeval, 0);
2739 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
2740 Return non-nil if OBJECT is a glyph.
2742 A glyph is an object used for pixmaps and the like. It is used
2743 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
2744 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
2745 buttons, and the like. Its image is described using an image specifier --
2746 see `image-specifier-p'.
2750 return GLYPHP (object) ? Qt : Qnil;
2753 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
2754 Return the type of the given glyph.
2755 The return value will be one of 'buffer, 'pointer, or 'icon.
2759 CHECK_GLYPH (glyph);
2760 switch (XGLYPH_TYPE (glyph))
2762 case GLYPH_BUFFER: return Qbuffer;
2763 case GLYPH_POINTER: return Qpointer;
2764 case GLYPH_ICON: return Qicon;
2767 return Qnil; /* not reached */
2771 /*****************************************************************************
2774 Return the width of the given GLYPH on the given WINDOW. If the
2775 instance is a string then the width is calculated using the font of
2776 the given FACE, unless a face is defined by the glyph itself.
2777 ****************************************************************************/
2779 glyph_width (Lisp_Object glyph, Lisp_Object frame_face,
2780 face_index window_findex, Lisp_Object window)
2782 Lisp_Object instance;
2783 Lisp_Object frame = XWINDOW (window)->frame;
2785 /* #### We somehow need to distinguish between the user causing this
2786 error condition and a bug causing it. */
2787 if (!GLYPHP (glyph))
2790 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
2792 if (!IMAGE_INSTANCEP (instance))
2795 switch (XIMAGE_INSTANCE_TYPE (instance))
2799 Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance);
2800 Lisp_Object private_face = XGLYPH_FACE(glyph);
2802 if (!NILP (private_face))
2803 return redisplay_frame_text_width_string (XFRAME (frame),
2807 if (!NILP (frame_face))
2808 return redisplay_frame_text_width_string (XFRAME (frame),
2812 return redisplay_text_width_string (XWINDOW (window),
2817 case IMAGE_MONO_PIXMAP:
2818 case IMAGE_COLOR_PIXMAP:
2820 return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance);
2825 case IMAGE_SUBWINDOW:
2826 /* #### implement me */
2835 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
2836 Return the width of GLYPH on WINDOW.
2837 This may not be exact as it does not take into account all of the context
2838 that redisplay will.
2842 XSETWINDOW (window, decode_window (window));
2843 CHECK_GLYPH (glyph);
2845 return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window));
2848 #define RETURN_ASCENT 0
2849 #define RETURN_DESCENT 1
2850 #define RETURN_HEIGHT 2
2853 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
2854 Error_behavior errb, int no_quit)
2856 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
2858 /* This can never return Qunbound. All glyphs have 'nothing as
2860 return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0,
2864 static unsigned short
2865 glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face,
2866 face_index window_findex, Lisp_Object window,
2869 Lisp_Object instance;
2870 Lisp_Object frame = XWINDOW (window)->frame;
2872 if (!GLYPHP (glyph))
2875 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
2877 if (!IMAGE_INSTANCEP (instance))
2880 switch (XIMAGE_INSTANCE_TYPE (instance))
2884 struct font_metric_info fm;
2885 Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance);
2886 unsigned char charsets[NUM_LEADING_BYTES];
2887 struct face_cachel frame_cachel;
2888 struct face_cachel *cachel;
2890 find_charsets_in_bufbyte_string (charsets,
2891 XSTRING_DATA (string),
2892 XSTRING_LENGTH (string));
2894 if (!NILP (frame_face))
2896 reset_face_cachel (&frame_cachel);
2897 update_face_cachel_data (&frame_cachel, frame, frame_face);
2898 cachel = &frame_cachel;
2901 cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex);
2902 ensure_face_cachel_complete (cachel, window, charsets);
2904 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
2908 case RETURN_ASCENT: return fm.ascent;
2909 case RETURN_DESCENT: return fm.descent;
2910 case RETURN_HEIGHT: return fm.ascent + fm.descent;
2913 return 0; /* not reached */
2917 case IMAGE_MONO_PIXMAP:
2918 case IMAGE_COLOR_PIXMAP:
2920 /* #### Ugh ugh ugh -- temporary crap */
2921 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
2922 return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance);
2929 case IMAGE_SUBWINDOW:
2930 /* #### implement me */
2940 glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face,
2941 face_index window_findex, Lisp_Object window)
2943 return glyph_height_internal (glyph, frame_face, window_findex, window,
2948 glyph_descent (Lisp_Object glyph, Lisp_Object frame_face,
2949 face_index window_findex, Lisp_Object window)
2951 return glyph_height_internal (glyph, frame_face, window_findex, window,
2955 /* strictly a convenience function. */
2957 glyph_height (Lisp_Object glyph, Lisp_Object frame_face,
2958 face_index window_findex, Lisp_Object window)
2960 return glyph_height_internal (glyph, frame_face, window_findex, window,
2964 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
2965 Return the ascent value of GLYPH on WINDOW.
2966 This may not be exact as it does not take into account all of the context
2967 that redisplay will.
2971 XSETWINDOW (window, decode_window (window));
2972 CHECK_GLYPH (glyph);
2974 return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window));
2977 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
2978 Return the descent value of GLYPH on WINDOW.
2979 This may not be exact as it does not take into account all of the context
2980 that redisplay will.
2984 XSETWINDOW (window, decode_window (window));
2985 CHECK_GLYPH (glyph);
2987 return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window));
2990 /* This is redundant but I bet a lot of people expect it to exist. */
2991 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
2992 Return the height of GLYPH on WINDOW.
2993 This may not be exact as it does not take into account all of the context
2994 that redisplay will.
2998 XSETWINDOW (window, decode_window (window));
2999 CHECK_GLYPH (glyph);
3001 return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window));
3004 #undef RETURN_ASCENT
3005 #undef RETURN_DESCENT
3006 #undef RETURN_HEIGHT
3008 /* #### do we need to cache this info to speed things up? */
3011 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3013 if (!GLYPHP (glyph))
3017 Lisp_Object retval =
3018 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3019 /* #### look into ERROR_ME_NOT */
3020 Qunbound, domain, ERROR_ME_NOT,
3022 if (!NILP (retval) && !INTP (retval))
3024 else if (INTP (retval))
3026 if (XINT (retval) < 0)
3028 if (XINT (retval) > 100)
3029 retval = make_int (100);
3036 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3038 /* #### Domain parameter not currently used but it will be */
3039 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3043 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3045 if (!GLYPHP (glyph))
3048 return !NILP (specifier_instance_no_quit
3049 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3050 /* #### look into ERROR_ME_NOT */
3051 ERROR_ME_NOT, 0, Qzero));
3055 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3058 if (XGLYPH (glyph)->after_change)
3059 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3063 /*****************************************************************************
3064 * glyph cachel functions *
3065 *****************************************************************************/
3068 #### All of this is 95% copied from face cachels.
3069 Consider consolidating.
3070 #### We need to add a dirty flag to the glyphs.
3074 mark_glyph_cachels (glyph_cachel_dynarr *elements,
3075 void (*markobj) (Lisp_Object))
3082 for (elt = 0; elt < Dynarr_length (elements); elt++)
3084 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3085 ((markobj) (cachel->glyph));
3090 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3091 struct glyph_cachel *cachel)
3093 /* #### This should be || !cachel->updated */
3094 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph))
3098 XSETWINDOW (window, w);
3100 /* #### This could be sped up if we redid things to grab the glyph
3101 instantiation and passed it to the size functions. */
3102 cachel->glyph = glyph;
3103 cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window);
3104 cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window);
3105 cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window);
3108 cachel->updated = 1;
3112 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3114 struct glyph_cachel new_cachel;
3117 new_cachel.glyph = Qnil;
3119 update_glyph_cachel_data (w, glyph, &new_cachel);
3120 Dynarr_add (w->glyph_cachels, new_cachel);
3124 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3131 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3133 struct glyph_cachel *cachel =
3134 Dynarr_atp (w->glyph_cachels, elt);
3136 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3138 if (!cachel->updated)
3139 update_glyph_cachel_data (w, glyph, cachel);
3144 /* If we didn't find the glyph, add it and then return its index. */
3145 add_glyph_cachel (w, glyph);
3150 reset_glyph_cachels (struct window *w)
3152 Dynarr_reset (w->glyph_cachels);
3153 get_glyph_cachel_index (w, Vcontinuation_glyph);
3154 get_glyph_cachel_index (w, Vtruncation_glyph);
3155 get_glyph_cachel_index (w, Vhscroll_glyph);
3156 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3157 get_glyph_cachel_index (w, Voctal_escape_glyph);
3158 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3162 mark_glyph_cachels_as_not_updated (struct window *w)
3166 /* We need to have a dirty flag to tell if the glyph has changed.
3167 We can check to see if each glyph variable is actually a
3168 completely different glyph, though. */
3169 #define FROB(glyph_obj, gindex) \
3170 update_glyph_cachel_data (w, glyph_obj, \
3171 Dynarr_atp (w->glyph_cachels, gindex))
3173 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3174 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3175 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3176 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3177 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3178 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3181 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3182 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3185 #ifdef MEMORY_USAGE_STATS
3188 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3189 struct overhead_stats *ovstats)
3194 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3199 #endif /* MEMORY_USAGE_STATS */
3202 /*****************************************************************************
3204 *****************************************************************************/
3206 /* Get the display table for use currently on window W with face FACE.
3209 -- FACE's display table
3210 -- W's display table (comes from specifier `current-display-table')
3212 Ignore the specified tables if they are not valid;
3213 if no valid table is specified, return 0. */
3215 struct Lisp_Vector *
3216 get_display_table (struct window *w, face_index findex)
3220 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
3221 if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE)
3222 return XVECTOR (tem);
3224 tem = w->display_table;
3225 if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE)
3226 return XVECTOR (tem);
3232 /*****************************************************************************
3234 *****************************************************************************/
3237 syms_of_glyphs (void)
3239 /* image instantiators */
3241 DEFSUBR (Fimage_instantiator_format_list);
3242 DEFSUBR (Fvalid_image_instantiator_format_p);
3243 DEFSUBR (Fset_console_type_image_conversion_list);
3244 DEFSUBR (Fconsole_type_image_conversion_list);
3246 defkeyword (&Q_file, ":file");
3247 defkeyword (&Q_data, ":data");
3248 defkeyword (&Q_face, ":face");
3251 defkeyword (&Q_color_symbols, ":color-symbols");
3253 #ifdef HAVE_WINDOW_SYSTEM
3254 defkeyword (&Q_mask_file, ":mask-file");
3255 defkeyword (&Q_mask_data, ":mask-data");
3256 defkeyword (&Q_hotspot_x, ":hotspot-x");
3257 defkeyword (&Q_hotspot_y, ":hotspot-y");
3258 defkeyword (&Q_foreground, ":foreground");
3259 defkeyword (&Q_background, ":background");
3261 /* image specifiers */
3263 DEFSUBR (Fimage_specifier_p);
3264 /* Qimage in general.c */
3266 /* image instances */
3268 defsymbol (&Qimage_instancep, "image-instance-p");
3270 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
3271 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
3272 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
3273 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
3274 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
3275 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
3277 DEFSUBR (Fmake_image_instance);
3278 DEFSUBR (Fimage_instance_p);
3279 DEFSUBR (Fimage_instance_type);
3280 DEFSUBR (Fvalid_image_instance_type_p);
3281 DEFSUBR (Fimage_instance_type_list);
3282 DEFSUBR (Fimage_instance_name);
3283 DEFSUBR (Fimage_instance_string);
3284 DEFSUBR (Fimage_instance_file_name);
3285 DEFSUBR (Fimage_instance_mask_file_name);
3286 DEFSUBR (Fimage_instance_depth);
3287 DEFSUBR (Fimage_instance_height);
3288 DEFSUBR (Fimage_instance_width);
3289 DEFSUBR (Fimage_instance_hotspot_x);
3290 DEFSUBR (Fimage_instance_hotspot_y);
3291 DEFSUBR (Fimage_instance_foreground);
3292 DEFSUBR (Fimage_instance_background);
3293 DEFSUBR (Fcolorize_image_instance);
3295 /* Qnothing defined as part of the "nothing" image-instantiator
3297 /* Qtext defined in general.c */
3298 defsymbol (&Qmono_pixmap, "mono-pixmap");
3299 defsymbol (&Qcolor_pixmap, "color-pixmap");
3300 /* Qpointer defined in general.c */
3301 defsymbol (&Qsubwindow, "subwindow");
3305 defsymbol (&Qglyphp, "glyphp");
3306 defsymbol (&Qcontrib_p, "contrib-p");
3307 defsymbol (&Qbaseline, "baseline");
3309 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
3310 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
3311 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
3313 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
3315 DEFSUBR (Fglyph_type);
3316 DEFSUBR (Fvalid_glyph_type_p);
3317 DEFSUBR (Fglyph_type_list);
3319 DEFSUBR (Fmake_glyph_internal);
3320 DEFSUBR (Fglyph_width);
3321 DEFSUBR (Fglyph_ascent);
3322 DEFSUBR (Fglyph_descent);
3323 DEFSUBR (Fglyph_height);
3325 /* Qbuffer defined in general.c. */
3326 /* Qpointer defined above */
3329 deferror (&Qimage_conversion_error,
3330 "image-conversion-error",
3331 "image-conversion error", Qio_error);
3336 specifier_type_create_image (void)
3338 /* image specifiers */
3340 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
3342 SPECIFIER_HAS_METHOD (image, create);
3343 SPECIFIER_HAS_METHOD (image, mark);
3344 SPECIFIER_HAS_METHOD (image, instantiate);
3345 SPECIFIER_HAS_METHOD (image, validate);
3346 SPECIFIER_HAS_METHOD (image, after_change);
3347 SPECIFIER_HAS_METHOD (image, going_to_add);
3351 image_instantiator_format_create (void)
3353 /* image instantiators */
3355 the_image_instantiator_format_entry_dynarr =
3356 Dynarr_new (image_instantiator_format_entry);
3358 Vimage_instantiator_format_list = Qnil;
3359 staticpro (&Vimage_instantiator_format_list);
3361 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
3363 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
3364 IIFORMAT_HAS_METHOD (nothing, instantiate);
3366 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
3368 IIFORMAT_HAS_METHOD (inherit, validate);
3369 IIFORMAT_HAS_METHOD (inherit, normalize);
3370 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
3371 IIFORMAT_HAS_METHOD (inherit, instantiate);
3373 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
3375 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
3377 IIFORMAT_HAS_METHOD (string, validate);
3378 IIFORMAT_HAS_METHOD (string, possible_dest_types);
3379 IIFORMAT_HAS_METHOD (string, instantiate);
3381 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
3383 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
3385 IIFORMAT_HAS_METHOD (formatted_string, validate);
3386 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
3387 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
3389 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
3391 #ifdef HAVE_WINDOW_SYSTEM
3392 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
3394 IIFORMAT_HAS_METHOD (xbm, validate);
3395 IIFORMAT_HAS_METHOD (xbm, normalize);
3396 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
3397 IIFORMAT_HAS_METHOD (xbm, instantiate);
3399 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
3400 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
3401 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
3402 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
3403 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
3404 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
3405 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
3406 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
3407 #endif /* HAVE_WINDOW_SYSTEM */
3410 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
3412 IIFORMAT_HAS_METHOD (xpm, validate);
3413 IIFORMAT_HAS_METHOD (xpm, normalize);
3414 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
3415 IIFORMAT_HAS_METHOD (xpm, instantiate);
3417 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
3418 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
3419 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
3420 #endif /* HAVE_XPM */
3424 vars_of_glyphs (void)
3426 Vthe_nothing_vector = vector1 (Qnothing);
3427 staticpro (&Vthe_nothing_vector);
3429 /* image instances */
3431 Vimage_instance_type_list = list6 (Qnothing, Qtext, Qmono_pixmap,
3432 Qcolor_pixmap, Qpointer, Qsubwindow);
3433 staticpro (&Vimage_instance_type_list);
3437 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
3438 staticpro (&Vglyph_type_list);
3440 /* The octal-escape glyph, control-arrow-glyph and
3441 invisible-text-glyph are completely initialized in glyphs.el */
3443 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
3444 What to prefix character codes displayed in octal with.
3446 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
3448 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
3449 What to use as an arrow for control characters.
3451 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
3452 redisplay_glyph_changed);
3454 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
3455 What to use to indicate the presence of invisible text.
3456 This is the glyph that is displayed when an ellipsis is called for
3457 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
3458 Normally this is three dots ("...").
3460 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
3461 redisplay_glyph_changed);
3463 /* Partially initialized in glyphs.el */
3464 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
3465 What to display at the beginning of horizontally scrolled lines.
3467 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
3472 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
3473 Definitions of logical color-names used when reading XPM files.
3474 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
3475 The COLOR-NAME should be a string, which is the name of the color to define;
3476 the FORM should evaluate to a `color' specifier object, or a string to be
3477 passed to `make-color-instance'. If a loaded XPM file references a symbolic
3478 color called COLOR-NAME, it will display as the computed color instead.
3480 The default value of this variable defines the logical color names
3481 \"foreground\" and \"background\" to be the colors of the `default' face.
3483 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
3484 #endif /* HAVE_XPM */
3488 specifier_vars_of_glyphs (void)
3490 /* #### Can we GC here? The set_specifier_* calls definitely need */
3492 /* display tables */
3494 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
3495 *The display table currently in use.
3496 This is a specifier; use `set-specifier' to change it.
3497 The display table is a vector created with `make-display-table'.
3498 The 256 elements control how to display each possible text character.
3499 Each value should be a string, a glyph, a vector or nil.
3500 If a value is a vector it must be composed only of strings and glyphs.
3501 nil means display the character in the default fashion.
3502 Faces can have their own, overriding display table.
3504 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
3505 set_specifier_fallback (Vcurrent_display_table,
3506 list1 (Fcons (Qnil, Qnil)));
3507 set_specifier_caching (Vcurrent_display_table,
3508 slot_offset (struct window,
3510 some_window_value_changed,
3515 complex_vars_of_glyphs (void)
3517 /* Partially initialized in glyphs-x.c, glyphs.el */
3518 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
3519 What to display at the end of truncated lines.
3521 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
3523 /* Partially initialized in glyphs-x.c, glyphs.el */
3524 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
3525 What to display at the end of wrapped lines.
3527 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
3529 /* Partially initialized in glyphs-x.c, glyphs.el */
3530 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
3531 The glyph used to display the XEmacs logo at startup.
3533 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);