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 obj1, Lisp_Object obj2, int depth)
678 struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
679 struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
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 #ifdef HAVE_X_WINDOWS
1604 #include <X11/Xlib.h>
1606 #define XFree(data) free(data)
1610 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
1611 int ok_if_data_invalid)
1616 CONST char *filename_ext;
1618 GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext);
1619 result = read_bitmap_data_from_file (filename_ext, &w, &h,
1622 if (result == BitmapSuccess)
1625 int len = (w + 7) / 8 * h;
1627 retval = list3 (make_int (w), make_int (h),
1628 make_ext_string (data, len, FORMAT_BINARY));
1629 XFree ((char *) data);
1635 case BitmapOpenFailed:
1637 /* should never happen */
1638 signal_double_file_error ("Opening bitmap file",
1639 "no such file or directory",
1642 case BitmapFileInvalid:
1644 if (ok_if_data_invalid)
1646 signal_double_file_error ("Reading bitmap file",
1647 "invalid data in file",
1650 case BitmapNoMemory:
1652 signal_double_file_error ("Reading bitmap file",
1658 signal_double_file_error_2 ("Reading bitmap file",
1659 "unknown error code",
1660 make_int (result), name);
1664 return Qnil; /* not reached */
1668 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
1669 Lisp_Object mask_file, Lisp_Object console_type)
1671 /* This is unclean but it's fairly standard -- a number of the
1672 bitmaps in /usr/include/X11/bitmaps use it -- so we support
1674 if (NILP (mask_file)
1675 /* don't override explicitly specified mask data. */
1676 && NILP (assq_no_quit (Q_mask_data, alist))
1679 mask_file = MAYBE_LISP_CONTYPE_METH
1680 (decode_console_type(console_type, ERROR_ME),
1681 locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
1682 if (NILP (mask_file))
1683 mask_file = MAYBE_LISP_CONTYPE_METH
1684 (decode_console_type(console_type, ERROR_ME),
1685 locate_pixmap_file, (concat2 (file, build_string ("msk"))));
1688 if (!NILP (mask_file))
1690 Lisp_Object mask_data =
1691 bitmap_to_lisp_data (mask_file, 0, 0, 0);
1692 alist = remassq_no_quit (Q_mask_file, alist);
1693 /* there can't be a :mask-data at this point. */
1694 alist = Fcons (Fcons (Q_mask_file, mask_file),
1695 Fcons (Fcons (Q_mask_data, mask_data), alist));
1701 /* Normalize method for XBM's. */
1704 xbm_normalize (Lisp_Object inst, Lisp_Object console_type)
1706 Lisp_Object file = Qnil, mask_file = Qnil;
1707 struct gcpro gcpro1, gcpro2, gcpro3;
1708 Lisp_Object alist = Qnil;
1710 GCPRO3 (file, mask_file, alist);
1712 /* Now, convert any file data into inline data for both the regular
1713 data and the mask data. At the end of this, `data' will contain
1714 the inline data (if any) or Qnil, and `file' will contain
1715 the name this data was derived from (if known) or Qnil.
1716 Likewise for `mask_file' and `mask_data'.
1718 Note that if we cannot generate any regular inline data, we
1721 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1723 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
1724 Q_mask_data, console_type);
1726 if (CONSP (file)) /* failure locating filename */
1727 signal_double_file_error ("Opening bitmap file",
1728 "no such file or directory",
1731 if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
1732 RETURN_UNGCPRO (inst);
1734 alist = tagged_vector_to_alist (inst);
1739 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
1740 alist = remassq_no_quit (Q_file, alist);
1741 /* there can't be a :data at this point. */
1742 alist = Fcons (Fcons (Q_file, file),
1743 Fcons (Fcons (Q_data, data), alist));
1745 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
1746 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
1748 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
1749 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
1753 alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
1756 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
1758 RETURN_UNGCPRO (result);
1764 xbm_possible_dest_types (void)
1767 IMAGE_MONO_PIXMAP_MASK |
1768 IMAGE_COLOR_PIXMAP_MASK |
1773 xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1774 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
1775 int dest_mask, Lisp_Object domain)
1777 Lisp_Object device= IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (image_instance));
1779 MAYBE_DEVMETH (XDEVICE (device),
1781 (image_instance, instantiator, pointer_fg,
1782 pointer_bg, dest_mask, domain));
1790 /**********************************************************************
1792 **********************************************************************/
1795 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
1800 result = XpmReadFileToData ((char *) XSTRING_DATA (name), &data);
1802 if (result == XpmSuccess)
1804 Lisp_Object retval = Qnil;
1805 struct buffer *old_buffer = current_buffer;
1806 Lisp_Object temp_buffer =
1807 Fget_buffer_create (build_string (" *pixmap conversion*"));
1809 int height, width, ncolors;
1810 struct gcpro gcpro1, gcpro2, gcpro3;
1811 int speccount = specpdl_depth ();
1813 GCPRO3 (name, retval, temp_buffer);
1815 specbind (Qinhibit_quit, Qt);
1816 set_buffer_internal (XBUFFER (temp_buffer));
1817 Ferase_buffer (Qnil);
1819 buffer_insert_c_string (current_buffer, "/* XPM */\r");
1820 buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
1822 sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
1823 for (elt = 0; elt <= width + ncolors; elt++)
1825 buffer_insert_c_string (current_buffer, "\"");
1826 buffer_insert_c_string (current_buffer, data[elt]);
1828 if (elt < width + ncolors)
1829 buffer_insert_c_string (current_buffer, "\",\r");
1831 buffer_insert_c_string (current_buffer, "\"};\r");
1834 retval = Fbuffer_substring (Qnil, Qnil, Qnil);
1837 set_buffer_internal (old_buffer);
1838 unbind_to (speccount, Qnil);
1840 RETURN_UNGCPRO (retval);
1845 case XpmFileInvalid:
1847 if (ok_if_data_invalid)
1849 signal_image_error ("invalid XPM data in file", name);
1853 signal_double_file_error ("Reading pixmap file",
1854 "out of memory", name);
1858 /* should never happen? */
1859 signal_double_file_error ("Opening pixmap file",
1860 "no such file or directory", name);
1864 signal_double_file_error_2 ("Parsing pixmap file",
1865 "unknown error code",
1866 make_int (result), name);
1871 return Qnil; /* not reached */
1875 check_valid_xpm_color_symbols (Lisp_Object data)
1879 for (rest = data; !NILP (rest); rest = XCDR (rest))
1881 if (!CONSP (rest) ||
1882 !CONSP (XCAR (rest)) ||
1883 !STRINGP (XCAR (XCAR (rest))) ||
1884 (!STRINGP (XCDR (XCAR (rest))) &&
1885 !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
1886 signal_simple_error ("Invalid color symbol alist", data);
1891 xpm_validate (Lisp_Object instantiator)
1893 file_or_data_must_be_present (instantiator);
1896 Lisp_Object Vxpm_color_symbols;
1899 evaluate_xpm_color_symbols (void)
1901 Lisp_Object rest, results = Qnil;
1902 struct gcpro gcpro1, gcpro2;
1904 GCPRO2 (rest, results);
1905 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
1907 Lisp_Object name, value, cons;
1913 CHECK_STRING (name);
1914 value = XCDR (cons);
1916 value = XCAR (value);
1917 value = Feval (value);
1920 if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
1922 ("Result from xpm-color-symbols eval must be nil, string, or color",
1924 results = Fcons (Fcons (name, value), results);
1926 UNGCPRO; /* no more evaluation */
1931 xpm_normalize (Lisp_Object inst, Lisp_Object console_type)
1933 Lisp_Object file = Qnil;
1934 Lisp_Object color_symbols;
1935 struct gcpro gcpro1, gcpro2;
1936 Lisp_Object alist = Qnil;
1938 GCPRO2 (file, alist);
1940 /* Now, convert any file data into inline data. At the end of this,
1941 `data' will contain the inline data (if any) or Qnil, and
1942 `file' will contain the name this data was derived from (if
1945 Note that if we cannot generate any regular inline data, we
1948 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
1951 if (CONSP (file)) /* failure locating filename */
1952 signal_double_file_error ("Opening pixmap file",
1953 "no such file or directory",
1956 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
1959 if (NILP (file) && !UNBOUNDP (color_symbols))
1960 /* no conversion necessary */
1961 RETURN_UNGCPRO (inst);
1963 alist = tagged_vector_to_alist (inst);
1967 Lisp_Object data = pixmap_to_lisp_data (file, 0);
1968 alist = remassq_no_quit (Q_file, alist);
1969 /* there can't be a :data at this point. */
1970 alist = Fcons (Fcons (Q_file, file),
1971 Fcons (Fcons (Q_data, data), alist));
1974 if (UNBOUNDP (color_symbols))
1976 color_symbols = evaluate_xpm_color_symbols ();
1977 alist = Fcons (Fcons (Q_color_symbols, color_symbols),
1982 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
1984 RETURN_UNGCPRO (result);
1989 xpm_possible_dest_types (void)
1992 IMAGE_MONO_PIXMAP_MASK |
1993 IMAGE_COLOR_PIXMAP_MASK |
1998 xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
1999 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2000 int dest_mask, Lisp_Object domain)
2002 Lisp_Object device= IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (image_instance));
2004 MAYBE_DEVMETH (XDEVICE (device),
2006 (image_instance, instantiator, pointer_fg,
2007 pointer_bg, dest_mask, domain));
2010 #endif /* HAVE_XPM */
2013 /****************************************************************************
2014 * Image Specifier Object *
2015 ****************************************************************************/
2017 DEFINE_SPECIFIER_TYPE (image);
2020 image_create (Lisp_Object obj)
2022 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2024 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
2025 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
2026 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
2030 image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object))
2032 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2034 markobj (IMAGE_SPECIFIER_ATTACHEE (image));
2035 markobj (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
2039 image_instantiate_cache_result (Lisp_Object locative)
2041 /* locative = (instance instantiator . subtable) */
2042 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
2043 free_cons (XCONS (XCDR (locative)));
2044 free_cons (XCONS (locative));
2048 /* Given a specification for an image, return an instance of
2049 the image which matches the given instantiator and which can be
2050 displayed in the given domain. */
2053 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
2054 Lisp_Object domain, Lisp_Object instantiator,
2057 Lisp_Object device = DFW_DEVICE (domain);
2058 struct device *d = XDEVICE (device);
2059 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
2060 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
2062 if (IMAGE_INSTANCEP (instantiator))
2064 /* make sure that the image instance's device and type are
2067 if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator)))
2070 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
2071 if (mask & dest_mask)
2072 return instantiator;
2074 signal_simple_error ("Type of image instance not allowed here",
2078 signal_simple_error_2 ("Wrong device for image instance",
2079 instantiator, device);
2081 else if (VECTORP (instantiator)
2082 && EQ (XVECTOR_DATA (instantiator)[0], Qinherit))
2084 assert (XVECTOR_LENGTH (instantiator) == 3);
2085 return (FACE_PROPERTY_INSTANCE
2086 (Fget_face (XVECTOR_DATA (instantiator)[2]),
2087 Qbackground_pixmap, domain, 0, depth));
2091 Lisp_Object instance;
2092 Lisp_Object subtable;
2093 Lisp_Object ls3 = Qnil;
2094 Lisp_Object pointer_fg = Qnil;
2095 Lisp_Object pointer_bg = Qnil;
2099 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
2100 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
2101 ls3 = list3 (instantiator, pointer_fg, pointer_bg);
2104 /* First look in the hash table. */
2105 subtable = Fgethash (make_int (dest_mask), d->image_instance_cache,
2107 if (UNBOUNDP (subtable))
2109 /* For the image instance cache, we do comparisons with EQ rather
2110 than with EQUAL, as we do for color and font names.
2113 1) pixmap data can be very long, and thus the hashing and
2114 comparing will take awhile.
2115 2) It's not so likely that we'll run into things that are EQUAL
2116 but not EQ (that can happen a lot with faces, because their
2117 specifiers are copied around); but pixmaps tend not to be
2120 However, if the image-instance could be a pointer, we have to
2121 use EQUAL because we massaged the instantiator into a cons3
2122 also containing the foreground and background of the
2126 subtable = make_lisp_hash_table (20,
2127 pointerp ? HASH_TABLE_KEY_CAR_WEAK
2128 : HASH_TABLE_KEY_WEAK,
2129 pointerp ? HASH_TABLE_EQUAL
2131 Fputhash (make_int (dest_mask), subtable,
2132 d->image_instance_cache);
2133 instance = Qunbound;
2136 instance = Fgethash (pointerp ? ls3 : instantiator,
2137 subtable, Qunbound);
2139 if (UNBOUNDP (instance))
2141 Lisp_Object locative =
2143 noseeum_cons (pointerp ? ls3 : instantiator,
2145 int speccount = specpdl_depth ();
2147 /* make sure we cache the failures, too.
2148 Use an unwind-protect to catch such errors.
2149 If we fail, the unwind-protect records nil in
2150 the hash table. If we succeed, we change the
2151 car of the locative to the resulting instance,
2152 which gets recorded instead. */
2153 record_unwind_protect (image_instantiate_cache_result,
2155 instance = instantiate_image_instantiator (device,
2158 pointer_fg, pointer_bg,
2160 Fsetcar (locative, instance);
2161 unbind_to (speccount, Qnil);
2166 if (NILP (instance))
2167 signal_simple_error ("Can't instantiate image (probably cached)",
2173 return Qnil; /* not reached */
2176 /* Validate an image instantiator. */
2179 image_validate (Lisp_Object instantiator)
2181 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
2183 else if (VECTORP (instantiator))
2185 Lisp_Object *elt = XVECTOR_DATA (instantiator);
2186 int instantiator_len = XVECTOR_LENGTH (instantiator);
2187 struct image_instantiator_methods *meths;
2188 Lisp_Object already_seen = Qnil;
2189 struct gcpro gcpro1;
2192 if (instantiator_len < 1)
2193 signal_simple_error ("Vector length must be at least 1",
2196 meths = decode_image_instantiator_format (elt[0], ERROR_ME);
2197 if (!(instantiator_len & 1))
2199 ("Must have alternating keyword/value pairs", instantiator);
2201 GCPRO1 (already_seen);
2203 for (i = 1; i < instantiator_len; i += 2)
2205 Lisp_Object keyword = elt[i];
2206 Lisp_Object value = elt[i+1];
2209 CHECK_SYMBOL (keyword);
2210 if (!SYMBOL_IS_KEYWORD (keyword))
2211 signal_simple_error ("Symbol must begin with a colon", keyword);
2213 for (j = 0; j < Dynarr_length (meths->keywords); j++)
2214 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
2217 if (j == Dynarr_length (meths->keywords))
2218 signal_simple_error ("Unrecognized keyword", keyword);
2220 if (!Dynarr_at (meths->keywords, j).multiple_p)
2222 if (!NILP (memq_no_quit (keyword, already_seen)))
2224 ("Keyword may not appear more than once", keyword);
2225 already_seen = Fcons (keyword, already_seen);
2228 (Dynarr_at (meths->keywords, j).validate) (value);
2233 MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
2236 signal_simple_error ("Must be string or vector", instantiator);
2240 image_after_change (Lisp_Object specifier, Lisp_Object locale)
2242 Lisp_Object attachee =
2243 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
2244 Lisp_Object property =
2245 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
2246 if (FACEP (attachee))
2247 face_property_was_changed (attachee, property, locale);
2248 else if (GLYPHP (attachee))
2249 glyph_property_was_changed (attachee, property, locale);
2253 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
2254 Lisp_Object property)
2256 struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
2258 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
2259 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
2263 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
2264 Lisp_Object tag_set, Lisp_Object instantiator)
2266 Lisp_Object possible_console_types = Qnil;
2268 Lisp_Object retlist = Qnil;
2269 struct gcpro gcpro1, gcpro2;
2271 LIST_LOOP (rest, Vconsole_type_list)
2273 Lisp_Object contype = XCAR (rest);
2274 if (!NILP (memq_no_quit (contype, tag_set)))
2275 possible_console_types = Fcons (contype, possible_console_types);
2278 if (XINT (Flength (possible_console_types)) > 1)
2279 /* two conflicting console types specified */
2282 if (NILP (possible_console_types))
2283 possible_console_types = Vconsole_type_list;
2285 GCPRO2 (retlist, possible_console_types);
2287 LIST_LOOP (rest, possible_console_types)
2289 Lisp_Object contype = XCAR (rest);
2290 Lisp_Object newinst = call_with_suspended_errors
2291 ((lisp_fn_t) normalize_image_instantiator,
2292 Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
2293 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
2295 if (!NILP (newinst))
2298 if (NILP (memq_no_quit (contype, tag_set)))
2299 newtag = Fcons (contype, tag_set);
2302 retlist = Fcons (Fcons (newtag, newinst), retlist);
2311 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
2312 Return non-nil if OBJECT is an image specifier.
2314 An image specifier is used for images (pixmaps and the like). It is used
2315 to describe the actual image in a glyph. It is instanced as an image-
2318 Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg',
2319 etc. This describes the format of the data describing the image. The
2320 resulting image instances also come in many types -- `mono-pixmap',
2321 `color-pixmap', `text', `pointer', etc. This refers to the behavior of
2322 the image and the sorts of places it can appear. (For example, a
2323 color-pixmap image has fixed colors specified for it, while a
2324 mono-pixmap image comes in two unspecified shades "foreground" and
2325 "background" that are determined from the face of the glyph or
2326 surrounding text; a text image appears as a string of text and has an
2327 unspecified foreground, background, and font; a pointer image behaves
2328 like a mono-pixmap image but can only be used as a mouse pointer
2329 \[mono-pixmap images cannot be used as mouse pointers]; etc.) It is
2330 important to keep the distinction between image instantiator format and
2331 image instance type in mind. Typically, a given image instantiator
2332 format can result in many different image instance types (for example,
2333 `xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer';
2334 whereas `cursor-font' can be instanced only as `pointer'), and a
2335 particular image instance type can be generated by many different
2336 image instantiator formats (e.g. `color-pixmap' can be generated by `xpm',
2337 `gif', `jpeg', etc.).
2339 See `make-image-instance' for a more detailed discussion of image
2342 An image instantiator should be a string or a vector of the form
2344 [FORMAT :KEYWORD VALUE ...]
2346 i.e. a format symbol followed by zero or more alternating keyword-value
2347 pairs. FORMAT should be one of
2350 (Don't display anything; no keywords are valid for this.
2351 Can only be instanced as `nothing'.)
2353 (Display this image as a text string. Can only be instanced
2354 as `text', although support for instancing as `mono-pixmap'
2357 (Display this image as a text string, with replaceable fields;
2358 not currently implemented.)
2360 (An X bitmap; only if X support was compiled into this XEmacs.
2361 Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2363 (An XPM pixmap; only if XPM support was compiled into this XEmacs.
2364 Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.)
2366 (An X-Face bitmap, used to encode people's faces in e-mail messages;
2367 only if X-Face support was compiled into this XEmacs. Can be
2368 instanced as `mono-pixmap', `color-pixmap', or `pointer'.)
2370 (A GIF87 or GIF89 image; only if GIF support was compiled into this
2371 XEmacs. NOTE: only the first frame of animated gifs will be displayed.
2372 Can be instanced as `color-pixmap'.)
2374 (A JPEG image; only if JPEG support was compiled into this XEmacs.
2375 Can be instanced as `color-pixmap'.)
2377 (A PNG image; only if PNG support was compiled into this XEmacs.
2378 Can be instanced as `color-pixmap'.)
2380 (A TIFF image; only if TIFF support was compiled into this XEmacs.
2381 Can be instanced as `color-pixmap'.)
2383 (One of the standard cursor-font names, such as "watch" or
2384 "right_ptr" under X. Under X, this is, more specifically, any
2385 of the standard cursor names from appendix B of the Xlib manual
2386 [also known as the file <X11/cursorfont.h>] minus the XC_ prefix.
2387 On other window systems, the valid names will be specific to the
2388 type of window system. Can only be instanced as `pointer'.)
2390 (A glyph from a font; i.e. the name of a font, and glyph index into it
2391 of the form "FONT fontname index [[mask-font] mask-index]".
2392 Currently can only be instanced as `pointer', although this should
2395 (An embedded X window; not currently implemented.)
2397 (XEmacs tries to guess what format the data is in. If X support
2398 exists, the data string will be checked to see if it names a filename.
2399 If so, and this filename contains XBM or XPM data, the appropriate
2400 sort of pixmap or pointer will be created. [This includes picking up
2401 any specified hotspot or associated mask file.] Otherwise, if `pointer'
2402 is one of the allowable image-instance types and the string names a
2403 valid cursor-font name, the image will be created as a pointer.
2404 Otherwise, the image will be displayed as text. If no X support
2405 exists, the image will always be displayed as text.)
2407 Inherit from the background-pixmap property of a face.
2409 The valid keywords are:
2412 (Inline data. For most formats above, this should be a string. For
2413 XBM images, this should be a list of three elements: width, height, and
2414 a string of bit data. This keyword is not valid for instantiator
2415 formats `nothing' and `inherit'.)
2417 (Data is contained in a file. The value is the name of this file.
2418 If both :data and :file are specified, the image is created from
2419 what is specified in :data and the string in :file becomes the
2420 value of the `image-instance-file-name' function when applied to
2421 the resulting image-instance. This keyword is not valid for
2422 instantiator formats `nothing', `string', `formatted-string',
2423 `cursor-font', `font', `autodetect', and `inherit'.)
2426 (For `xbm', `xface', `cursor-font', and `font'. These keywords
2427 allow you to explicitly specify foreground and background colors.
2428 The argument should be anything acceptable to `make-color-instance'.
2429 This will cause what would be a `mono-pixmap' to instead be colorized
2430 as a two-color color-pixmap, and specifies the foreground and/or
2431 background colors for a pointer instead of black and white.)
2433 (For `xbm' and `xface'. This specifies a mask to be used with the
2434 bitmap. The format is a list of width, height, and bits, like for
2437 (For `xbm' and `xface'. This specifies a file containing the mask data.
2438 If neither a mask file nor inline mask data is given for an XBM image,
2439 and the XBM image comes from a file, XEmacs will look for a mask file
2440 with the same name as the image file but with "Mask" or "msk"
2441 appended. For example, if you specify the XBM file "left_ptr"
2442 [usually located in "/usr/include/X11/bitmaps"], the associated
2443 mask file "left_ptrmsk" will automatically be picked up.)
2446 (For `xbm' and `xface'. These keywords specify a hotspot if the image
2447 is instantiated as a `pointer'. Note that if the XBM image file
2448 specifies a hotspot, it will automatically be picked up if no
2449 explicit hotspot is given.)
2451 (Only for `xpm'. This specifies an alist that maps strings
2452 that specify symbolic color names to the actual color to be used
2453 for that symbolic color (in the form of a string or a color-specifier
2454 object). If this is not specified, the contents of `xpm-color-symbols'
2455 are used to generate the alist.)
2457 (Only for `inherit'. This specifies the face to inherit from.)
2459 If instead of a vector, the instantiator is a string, it will be
2460 converted into a vector by looking it up according to the specs in the
2461 `console-type-image-conversion-list' (q.v.) for the console type of
2462 the domain (usually a window; sometimes a frame or device) over which
2463 the image is being instantiated.
2465 If the instantiator specifies data from a file, the data will be read
2466 in at the time that the instantiator is added to the image (which may
2467 be well before when the image is actually displayed), and the
2468 instantiator will be converted into one of the inline-data forms, with
2469 the filename retained using a :file keyword. This implies that the
2470 file must exist when the instantiator is added to the image, but does
2471 not need to exist at any other time (e.g. it may safely be a temporary
2476 return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
2480 /****************************************************************************
2482 ****************************************************************************/
2485 mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object))
2487 struct Lisp_Glyph *glyph = XGLYPH (obj);
2489 markobj (glyph->image);
2490 markobj (glyph->contrib_p);
2491 markobj (glyph->baseline);
2492 markobj (glyph->face);
2494 return glyph->plist;
2498 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
2500 struct Lisp_Glyph *glyph = XGLYPH (obj);
2504 error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
2506 write_c_string ("#<glyph (", printcharfun);
2507 print_internal (Fglyph_type (obj), printcharfun, 0);
2508 write_c_string (") ", printcharfun);
2509 print_internal (glyph->image, printcharfun, 1);
2510 sprintf (buf, "0x%x>", glyph->header.uid);
2511 write_c_string (buf, printcharfun);
2514 /* Glyphs are equal if all of their display attributes are equal. We
2515 don't compare names or doc-strings, because that would make equal
2518 This isn't concerned with "unspecified" attributes, that's what
2519 #'glyph-differs-from-default-p is for. */
2521 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
2523 struct Lisp_Glyph *g1 = XGLYPH (obj1);
2524 struct Lisp_Glyph *g2 = XGLYPH (obj2);
2528 return (internal_equal (g1->image, g2->image, depth) &&
2529 internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
2530 internal_equal (g1->baseline, g2->baseline, depth) &&
2531 internal_equal (g1->face, g2->face, depth) &&
2532 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1));
2535 static unsigned long
2536 glyph_hash (Lisp_Object obj, int depth)
2540 /* No need to hash all of the elements; that would take too long.
2541 Just hash the most common ones. */
2542 return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
2543 internal_hash (XGLYPH (obj)->face, depth));
2547 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
2549 struct Lisp_Glyph *g = XGLYPH (obj);
2551 if (EQ (prop, Qimage)) return g->image;
2552 if (EQ (prop, Qcontrib_p)) return g->contrib_p;
2553 if (EQ (prop, Qbaseline)) return g->baseline;
2554 if (EQ (prop, Qface)) return g->face;
2556 return external_plist_get (&g->plist, prop, 0, ERROR_ME);
2560 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
2562 if ((EQ (prop, Qimage)) ||
2563 (EQ (prop, Qcontrib_p)) ||
2564 (EQ (prop, Qbaseline)))
2567 if (EQ (prop, Qface))
2569 XGLYPH (obj)->face = Fget_face (value);
2573 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
2578 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
2580 if ((EQ (prop, Qimage)) ||
2581 (EQ (prop, Qcontrib_p)) ||
2582 (EQ (prop, Qbaseline)))
2585 if (EQ (prop, Qface))
2587 XGLYPH (obj)->face = Qnil;
2591 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
2595 glyph_plist (Lisp_Object obj)
2597 struct Lisp_Glyph *glyph = XGLYPH (obj);
2598 Lisp_Object result = glyph->plist;
2600 result = cons3 (Qface, glyph->face, result);
2601 result = cons3 (Qbaseline, glyph->baseline, result);
2602 result = cons3 (Qcontrib_p, glyph->contrib_p, result);
2603 result = cons3 (Qimage, glyph->image, result);
2608 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
2609 mark_glyph, print_glyph, 0,
2610 glyph_equal, glyph_hash,
2611 glyph_getprop, glyph_putprop,
2612 glyph_remprop, glyph_plist,
2616 allocate_glyph (enum glyph_type type,
2617 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
2618 Lisp_Object locale))
2620 /* This function can GC */
2621 Lisp_Object obj = Qnil;
2622 struct Lisp_Glyph *g =
2623 alloc_lcrecord_type (struct Lisp_Glyph, lrecord_glyph);
2626 g->image = Fmake_specifier (Qimage); /* This function can GC */
2630 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2631 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK | IMAGE_MONO_PIXMAP_MASK |
2632 IMAGE_COLOR_PIXMAP_MASK | IMAGE_SUBWINDOW_MASK;
2635 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2636 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
2639 XIMAGE_SPECIFIER_ALLOWED (g->image) =
2640 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK;
2646 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */
2647 /* We're getting enough reports of odd behavior in this area it seems */
2648 /* best to GCPRO everything. */
2650 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
2651 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
2652 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
2653 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2655 GCPRO4 (obj, tem1, tem2, tem3);
2657 set_specifier_fallback (g->image, tem1);
2658 g->contrib_p = Fmake_specifier (Qboolean);
2659 set_specifier_fallback (g->contrib_p, tem2);
2660 /* #### should have a specifier for the following */
2661 g->baseline = Fmake_specifier (Qgeneric);
2662 set_specifier_fallback (g->baseline, tem3);
2665 g->after_change = after_change;
2668 set_image_attached_to (g->image, obj, Qimage);
2675 static enum glyph_type
2676 decode_glyph_type (Lisp_Object type, Error_behavior errb)
2679 return GLYPH_BUFFER;
2681 if (ERRB_EQ (errb, ERROR_ME))
2682 CHECK_SYMBOL (type);
2684 if (EQ (type, Qbuffer)) return GLYPH_BUFFER;
2685 if (EQ (type, Qpointer)) return GLYPH_POINTER;
2686 if (EQ (type, Qicon)) return GLYPH_ICON;
2688 maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
2690 return GLYPH_UNKNOWN;
2694 valid_glyph_type_p (Lisp_Object type)
2696 return !NILP (memq_no_quit (type, Vglyph_type_list));
2699 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
2700 Given a GLYPH-TYPE, return non-nil if it is valid.
2701 Valid types are `buffer', `pointer', and `icon'.
2705 return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
2708 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
2709 Return a list of valid glyph types.
2713 return Fcopy_sequence (Vglyph_type_list);
2716 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
2717 Create and return a new uninitialized glyph or type TYPE.
2719 TYPE specifies the type of the glyph; this should be one of `buffer',
2720 `pointer', or `icon', and defaults to `buffer'. The type of the glyph
2721 specifies in which contexts the glyph can be used, and controls the
2722 allowable image types into which the glyph's image can be
2725 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
2726 extent, in the modeline, and in the toolbar. Their image can be
2727 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
2730 `pointer' glyphs can be used to specify the mouse pointer. Their
2731 image can be instantiated as `pointer'.
2733 `icon' glyphs can be used to specify the icon used when a frame is
2734 iconified. Their image can be instantiated as `mono-pixmap' and
2739 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
2740 return allocate_glyph (typeval, 0);
2743 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
2744 Return non-nil if OBJECT is a glyph.
2746 A glyph is an object used for pixmaps and the like. It is used
2747 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
2748 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
2749 buttons, and the like. Its image is described using an image specifier --
2750 see `image-specifier-p'.
2754 return GLYPHP (object) ? Qt : Qnil;
2757 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
2758 Return the type of the given glyph.
2759 The return value will be one of 'buffer, 'pointer, or 'icon.
2763 CHECK_GLYPH (glyph);
2764 switch (XGLYPH_TYPE (glyph))
2767 case GLYPH_BUFFER: return Qbuffer;
2768 case GLYPH_POINTER: return Qpointer;
2769 case GLYPH_ICON: return Qicon;
2773 /*****************************************************************************
2776 Return the width of the given GLYPH on the given WINDOW. If the
2777 instance is a string then the width is calculated using the font of
2778 the given FACE, unless a face is defined by the glyph itself.
2779 ****************************************************************************/
2781 glyph_width (Lisp_Object glyph, Lisp_Object frame_face,
2782 face_index window_findex, Lisp_Object window)
2784 Lisp_Object instance;
2785 Lisp_Object frame = XWINDOW (window)->frame;
2787 /* #### We somehow need to distinguish between the user causing this
2788 error condition and a bug causing it. */
2789 if (!GLYPHP (glyph))
2792 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
2794 if (!IMAGE_INSTANCEP (instance))
2797 switch (XIMAGE_INSTANCE_TYPE (instance))
2801 Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance);
2802 Lisp_Object private_face = XGLYPH_FACE(glyph);
2804 if (!NILP (private_face))
2805 return redisplay_frame_text_width_string (XFRAME (frame),
2809 if (!NILP (frame_face))
2810 return redisplay_frame_text_width_string (XFRAME (frame),
2814 return redisplay_text_width_string (XWINDOW (window),
2819 case IMAGE_MONO_PIXMAP:
2820 case IMAGE_COLOR_PIXMAP:
2822 return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance);
2827 case IMAGE_SUBWINDOW:
2828 /* #### implement me */
2837 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
2838 Return the width of GLYPH on WINDOW.
2839 This may not be exact as it does not take into account all of the context
2840 that redisplay will.
2844 XSETWINDOW (window, decode_window (window));
2845 CHECK_GLYPH (glyph);
2847 return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window));
2850 #define RETURN_ASCENT 0
2851 #define RETURN_DESCENT 1
2852 #define RETURN_HEIGHT 2
2855 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
2856 Error_behavior errb, int no_quit)
2858 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
2860 /* This can never return Qunbound. All glyphs have 'nothing as
2862 return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0,
2866 static unsigned short
2867 glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face,
2868 face_index window_findex, Lisp_Object window,
2871 Lisp_Object instance;
2872 Lisp_Object frame = XWINDOW (window)->frame;
2874 if (!GLYPHP (glyph))
2877 instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
2879 if (!IMAGE_INSTANCEP (instance))
2882 switch (XIMAGE_INSTANCE_TYPE (instance))
2886 struct font_metric_info fm;
2887 Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance);
2888 unsigned char charsets[NUM_LEADING_BYTES];
2889 struct face_cachel frame_cachel;
2890 struct face_cachel *cachel;
2892 find_charsets_in_bufbyte_string (charsets,
2893 XSTRING_DATA (string),
2894 XSTRING_LENGTH (string));
2896 if (!NILP (frame_face))
2898 reset_face_cachel (&frame_cachel);
2899 update_face_cachel_data (&frame_cachel, frame, frame_face);
2900 cachel = &frame_cachel;
2903 cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex);
2904 ensure_face_cachel_complete (cachel, window, charsets);
2906 face_cachel_charset_font_metric_info (cachel, charsets, &fm);
2910 case RETURN_ASCENT: return fm.ascent;
2911 case RETURN_DESCENT: return fm.descent;
2912 case RETURN_HEIGHT: return fm.ascent + fm.descent;
2915 return 0; /* not reached */
2919 case IMAGE_MONO_PIXMAP:
2920 case IMAGE_COLOR_PIXMAP:
2922 /* #### Ugh ugh ugh -- temporary crap */
2923 if (function == RETURN_ASCENT || function == RETURN_HEIGHT)
2924 return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance);
2931 case IMAGE_SUBWINDOW:
2932 /* #### implement me */
2942 glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face,
2943 face_index window_findex, Lisp_Object window)
2945 return glyph_height_internal (glyph, frame_face, window_findex, window,
2950 glyph_descent (Lisp_Object glyph, Lisp_Object frame_face,
2951 face_index window_findex, Lisp_Object window)
2953 return glyph_height_internal (glyph, frame_face, window_findex, window,
2957 /* strictly a convenience function. */
2959 glyph_height (Lisp_Object glyph, Lisp_Object frame_face,
2960 face_index window_findex, Lisp_Object window)
2962 return glyph_height_internal (glyph, frame_face, window_findex, window,
2966 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
2967 Return the ascent value of GLYPH on WINDOW.
2968 This may not be exact as it does not take into account all of the context
2969 that redisplay will.
2973 XSETWINDOW (window, decode_window (window));
2974 CHECK_GLYPH (glyph);
2976 return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window));
2979 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
2980 Return the descent value of GLYPH on WINDOW.
2981 This may not be exact as it does not take into account all of the context
2982 that redisplay will.
2986 XSETWINDOW (window, decode_window (window));
2987 CHECK_GLYPH (glyph);
2989 return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window));
2992 /* This is redundant but I bet a lot of people expect it to exist. */
2993 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
2994 Return the height of GLYPH on WINDOW.
2995 This may not be exact as it does not take into account all of the context
2996 that redisplay will.
3000 XSETWINDOW (window, decode_window (window));
3001 CHECK_GLYPH (glyph);
3003 return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window));
3006 #undef RETURN_ASCENT
3007 #undef RETURN_DESCENT
3008 #undef RETURN_HEIGHT
3010 /* #### do we need to cache this info to speed things up? */
3013 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
3015 if (!GLYPHP (glyph))
3019 Lisp_Object retval =
3020 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
3021 /* #### look into ERROR_ME_NOT */
3022 Qunbound, domain, ERROR_ME_NOT,
3024 if (!NILP (retval) && !INTP (retval))
3026 else if (INTP (retval))
3028 if (XINT (retval) < 0)
3030 if (XINT (retval) > 100)
3031 retval = make_int (100);
3038 glyph_face (Lisp_Object glyph, Lisp_Object domain)
3040 /* #### Domain parameter not currently used but it will be */
3041 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
3045 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
3047 if (!GLYPHP (glyph))
3050 return !NILP (specifier_instance_no_quit
3051 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
3052 /* #### look into ERROR_ME_NOT */
3053 ERROR_ME_NOT, 0, Qzero));
3057 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
3060 if (XGLYPH (glyph)->after_change)
3061 (XGLYPH (glyph)->after_change) (glyph, property, locale);
3065 /*****************************************************************************
3066 * glyph cachel functions *
3067 *****************************************************************************/
3070 #### All of this is 95% copied from face cachels.
3071 Consider consolidating.
3072 #### We need to add a dirty flag to the glyphs.
3076 mark_glyph_cachels (glyph_cachel_dynarr *elements,
3077 void (*markobj) (Lisp_Object))
3084 for (elt = 0; elt < Dynarr_length (elements); elt++)
3086 struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
3087 markobj (cachel->glyph);
3092 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
3093 struct glyph_cachel *cachel)
3095 /* #### This should be || !cachel->updated */
3096 if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph))
3100 XSETWINDOW (window, w);
3102 /* #### This could be sped up if we redid things to grab the glyph
3103 instantiation and passed it to the size functions. */
3104 cachel->glyph = glyph;
3105 cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window);
3106 cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window);
3107 cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window);
3110 cachel->updated = 1;
3114 add_glyph_cachel (struct window *w, Lisp_Object glyph)
3116 struct glyph_cachel new_cachel;
3119 new_cachel.glyph = Qnil;
3121 update_glyph_cachel_data (w, glyph, &new_cachel);
3122 Dynarr_add (w->glyph_cachels, new_cachel);
3126 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
3133 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3135 struct glyph_cachel *cachel =
3136 Dynarr_atp (w->glyph_cachels, elt);
3138 if (EQ (cachel->glyph, glyph) && !NILP (glyph))
3140 if (!cachel->updated)
3141 update_glyph_cachel_data (w, glyph, cachel);
3146 /* If we didn't find the glyph, add it and then return its index. */
3147 add_glyph_cachel (w, glyph);
3152 reset_glyph_cachels (struct window *w)
3154 Dynarr_reset (w->glyph_cachels);
3155 get_glyph_cachel_index (w, Vcontinuation_glyph);
3156 get_glyph_cachel_index (w, Vtruncation_glyph);
3157 get_glyph_cachel_index (w, Vhscroll_glyph);
3158 get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
3159 get_glyph_cachel_index (w, Voctal_escape_glyph);
3160 get_glyph_cachel_index (w, Vinvisible_text_glyph);
3164 mark_glyph_cachels_as_not_updated (struct window *w)
3168 /* We need to have a dirty flag to tell if the glyph has changed.
3169 We can check to see if each glyph variable is actually a
3170 completely different glyph, though. */
3171 #define FROB(glyph_obj, gindex) \
3172 update_glyph_cachel_data (w, glyph_obj, \
3173 Dynarr_atp (w->glyph_cachels, gindex))
3175 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
3176 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
3177 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
3178 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
3179 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
3180 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
3183 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
3184 Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
3187 #ifdef MEMORY_USAGE_STATS
3190 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
3191 struct overhead_stats *ovstats)
3196 total += Dynarr_memory_usage (glyph_cachels, ovstats);
3201 #endif /* MEMORY_USAGE_STATS */
3204 /*****************************************************************************
3206 *****************************************************************************/
3208 /* Get the display table for use currently on window W with face FACE.
3211 -- FACE's display table
3212 -- W's display table (comes from specifier `current-display-table')
3214 Ignore the specified tables if they are not valid;
3215 if no valid table is specified, return 0. */
3217 struct Lisp_Vector *
3218 get_display_table (struct window *w, face_index findex)
3222 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
3223 if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE)
3224 return XVECTOR (tem);
3226 tem = w->display_table;
3227 if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE)
3228 return XVECTOR (tem);
3234 /*****************************************************************************
3236 *****************************************************************************/
3239 syms_of_glyphs (void)
3241 /* image instantiators */
3243 DEFSUBR (Fimage_instantiator_format_list);
3244 DEFSUBR (Fvalid_image_instantiator_format_p);
3245 DEFSUBR (Fset_console_type_image_conversion_list);
3246 DEFSUBR (Fconsole_type_image_conversion_list);
3248 defkeyword (&Q_file, ":file");
3249 defkeyword (&Q_data, ":data");
3250 defkeyword (&Q_face, ":face");
3253 defkeyword (&Q_color_symbols, ":color-symbols");
3255 #ifdef HAVE_WINDOW_SYSTEM
3256 defkeyword (&Q_mask_file, ":mask-file");
3257 defkeyword (&Q_mask_data, ":mask-data");
3258 defkeyword (&Q_hotspot_x, ":hotspot-x");
3259 defkeyword (&Q_hotspot_y, ":hotspot-y");
3260 defkeyword (&Q_foreground, ":foreground");
3261 defkeyword (&Q_background, ":background");
3263 /* image specifiers */
3265 DEFSUBR (Fimage_specifier_p);
3266 /* Qimage in general.c */
3268 /* image instances */
3270 defsymbol (&Qimage_instancep, "image-instance-p");
3272 defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p");
3273 defsymbol (&Qtext_image_instance_p, "text-image-instance-p");
3274 defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p");
3275 defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p");
3276 defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p");
3277 defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p");
3279 DEFSUBR (Fmake_image_instance);
3280 DEFSUBR (Fimage_instance_p);
3281 DEFSUBR (Fimage_instance_type);
3282 DEFSUBR (Fvalid_image_instance_type_p);
3283 DEFSUBR (Fimage_instance_type_list);
3284 DEFSUBR (Fimage_instance_name);
3285 DEFSUBR (Fimage_instance_string);
3286 DEFSUBR (Fimage_instance_file_name);
3287 DEFSUBR (Fimage_instance_mask_file_name);
3288 DEFSUBR (Fimage_instance_depth);
3289 DEFSUBR (Fimage_instance_height);
3290 DEFSUBR (Fimage_instance_width);
3291 DEFSUBR (Fimage_instance_hotspot_x);
3292 DEFSUBR (Fimage_instance_hotspot_y);
3293 DEFSUBR (Fimage_instance_foreground);
3294 DEFSUBR (Fimage_instance_background);
3295 DEFSUBR (Fcolorize_image_instance);
3297 /* Qnothing defined as part of the "nothing" image-instantiator
3299 /* Qtext defined in general.c */
3300 defsymbol (&Qmono_pixmap, "mono-pixmap");
3301 defsymbol (&Qcolor_pixmap, "color-pixmap");
3302 /* Qpointer defined in general.c */
3303 defsymbol (&Qsubwindow, "subwindow");
3307 defsymbol (&Qglyphp, "glyphp");
3308 defsymbol (&Qcontrib_p, "contrib-p");
3309 defsymbol (&Qbaseline, "baseline");
3311 defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p");
3312 defsymbol (&Qpointer_glyph_p, "pointer-glyph-p");
3313 defsymbol (&Qicon_glyph_p, "icon-glyph-p");
3315 defsymbol (&Qconst_glyph_variable, "const-glyph-variable");
3317 DEFSUBR (Fglyph_type);
3318 DEFSUBR (Fvalid_glyph_type_p);
3319 DEFSUBR (Fglyph_type_list);
3321 DEFSUBR (Fmake_glyph_internal);
3322 DEFSUBR (Fglyph_width);
3323 DEFSUBR (Fglyph_ascent);
3324 DEFSUBR (Fglyph_descent);
3325 DEFSUBR (Fglyph_height);
3327 /* Qbuffer defined in general.c. */
3328 /* Qpointer defined above */
3331 deferror (&Qimage_conversion_error,
3332 "image-conversion-error",
3333 "image-conversion error", Qio_error);
3338 specifier_type_create_image (void)
3340 /* image specifiers */
3342 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
3344 SPECIFIER_HAS_METHOD (image, create);
3345 SPECIFIER_HAS_METHOD (image, mark);
3346 SPECIFIER_HAS_METHOD (image, instantiate);
3347 SPECIFIER_HAS_METHOD (image, validate);
3348 SPECIFIER_HAS_METHOD (image, after_change);
3349 SPECIFIER_HAS_METHOD (image, going_to_add);
3353 image_instantiator_format_create (void)
3355 /* image instantiators */
3357 the_image_instantiator_format_entry_dynarr =
3358 Dynarr_new (image_instantiator_format_entry);
3360 Vimage_instantiator_format_list = Qnil;
3361 staticpro (&Vimage_instantiator_format_list);
3363 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
3365 IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
3366 IIFORMAT_HAS_METHOD (nothing, instantiate);
3368 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
3370 IIFORMAT_HAS_METHOD (inherit, validate);
3371 IIFORMAT_HAS_METHOD (inherit, normalize);
3372 IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
3373 IIFORMAT_HAS_METHOD (inherit, instantiate);
3375 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
3377 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
3379 IIFORMAT_HAS_METHOD (string, validate);
3380 IIFORMAT_HAS_METHOD (string, possible_dest_types);
3381 IIFORMAT_HAS_METHOD (string, instantiate);
3383 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
3385 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
3387 IIFORMAT_HAS_METHOD (formatted_string, validate);
3388 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
3389 IIFORMAT_HAS_METHOD (formatted_string, instantiate);
3391 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
3393 #ifdef HAVE_WINDOW_SYSTEM
3394 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
3396 IIFORMAT_HAS_METHOD (xbm, validate);
3397 IIFORMAT_HAS_METHOD (xbm, normalize);
3398 IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
3399 IIFORMAT_HAS_METHOD (xbm, instantiate);
3401 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
3402 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
3403 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
3404 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
3405 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
3406 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
3407 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
3408 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
3409 #endif /* HAVE_WINDOW_SYSTEM */
3412 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
3414 IIFORMAT_HAS_METHOD (xpm, validate);
3415 IIFORMAT_HAS_METHOD (xpm, normalize);
3416 IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
3417 IIFORMAT_HAS_METHOD (xpm, instantiate);
3419 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
3420 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
3421 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
3422 #endif /* HAVE_XPM */
3426 vars_of_glyphs (void)
3428 Vthe_nothing_vector = vector1 (Qnothing);
3429 staticpro (&Vthe_nothing_vector);
3431 /* image instances */
3433 Vimage_instance_type_list = list6 (Qnothing, Qtext, Qmono_pixmap,
3434 Qcolor_pixmap, Qpointer, Qsubwindow);
3435 staticpro (&Vimage_instance_type_list);
3439 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
3440 staticpro (&Vglyph_type_list);
3442 /* The octal-escape glyph, control-arrow-glyph and
3443 invisible-text-glyph are completely initialized in glyphs.el */
3445 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
3446 What to prefix character codes displayed in octal with.
3448 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
3450 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
3451 What to use as an arrow for control characters.
3453 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
3454 redisplay_glyph_changed);
3456 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
3457 What to use to indicate the presence of invisible text.
3458 This is the glyph that is displayed when an ellipsis is called for
3459 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
3460 Normally this is three dots ("...").
3462 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
3463 redisplay_glyph_changed);
3465 /* Partially initialized in glyphs.el */
3466 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
3467 What to display at the beginning of horizontally scrolled lines.
3469 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
3474 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
3475 Definitions of logical color-names used when reading XPM files.
3476 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
3477 The COLOR-NAME should be a string, which is the name of the color to define;
3478 the FORM should evaluate to a `color' specifier object, or a string to be
3479 passed to `make-color-instance'. If a loaded XPM file references a symbolic
3480 color called COLOR-NAME, it will display as the computed color instead.
3482 The default value of this variable defines the logical color names
3483 \"foreground\" and \"background\" to be the colors of the `default' face.
3485 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
3486 #endif /* HAVE_XPM */
3490 specifier_vars_of_glyphs (void)
3492 /* #### Can we GC here? The set_specifier_* calls definitely need */
3494 /* display tables */
3496 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
3497 *The display table currently in use.
3498 This is a specifier; use `set-specifier' to change it.
3499 The display table is a vector created with `make-display-table'.
3500 The 256 elements control how to display each possible text character.
3501 Each value should be a string, a glyph, a vector or nil.
3502 If a value is a vector it must be composed only of strings and glyphs.
3503 nil means display the character in the default fashion.
3504 Faces can have their own, overriding display table.
3506 Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
3507 set_specifier_fallback (Vcurrent_display_table,
3508 list1 (Fcons (Qnil, Qnil)));
3509 set_specifier_caching (Vcurrent_display_table,
3510 slot_offset (struct window,
3512 some_window_value_changed,
3517 complex_vars_of_glyphs (void)
3519 /* Partially initialized in glyphs-x.c, glyphs.el */
3520 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
3521 What to display at the end of truncated lines.
3523 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
3525 /* Partially initialized in glyphs-x.c, glyphs.el */
3526 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
3527 What to display at the end of wrapped lines.
3529 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
3531 /* Partially initialized in glyphs-x.c, glyphs.el */
3532 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
3533 The glyph used to display the XEmacs logo at startup.
3535 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);