update.
[chise/xemacs-chise.git-] / src / glyphs.c
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, 2000 Ben Wing
5    Copyright (C) 1995 Sun Microsystems
6    Copyright (C) 1998, 1999, 2000 Andy Piper
7
8 This file is part of XEmacs.
9
10 XEmacs is free software; you can redistribute it and/or modify it
11 under the terms of the GNU General Public License as published by the
12 Free Software Foundation; either version 2, or (at your option) any
13 later version.
14
15 XEmacs is distributed in the hope that it will be useful, but WITHOUT
16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
17 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
18 for more details.
19
20 You should have received a copy of the GNU General Public License
21 along with XEmacs; see the file COPYING.  If not, write to
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 Boston, MA 02111-1307, USA.  */
24
25 /* Synched up with: Not in FSF. */
26
27 /* Written by Ben Wing and Chuck Thompson. Heavily modified /
28    rewritten by Andy Piper. */
29
30 #include <config.h>
31 #include "lisp.h"
32
33 #include "blocktype.h"
34 #include "buffer.h"
35 #include "chartab.h"
36 #include "device.h"
37 #include "elhash.h"
38 #include "faces.h"
39 #include "frame.h"
40 #include "glyphs.h"
41 #include "insdel.h"
42 #include "objects.h"
43 #include "opaque.h"
44 #include "rangetab.h"
45 #include "redisplay.h"
46 #include "specifier.h"
47 #include "window.h"
48
49 #if defined (HAVE_XPM) && !defined (HAVE_GTK)
50 #include <X11/xpm.h>
51 #endif
52
53 Lisp_Object Qimage_conversion_error;
54
55 Lisp_Object Qglyphp, Qcontrib_p, Qbaseline;
56 Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p;
57 Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p;
58 Lisp_Object Qmono_pixmap_image_instance_p;
59 Lisp_Object Qcolor_pixmap_image_instance_p;
60 Lisp_Object Qpointer_image_instance_p;
61 Lisp_Object Qsubwindow_image_instance_p;
62 Lisp_Object Qwidget_image_instance_p;
63 Lisp_Object Qconst_glyph_variable;
64 Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow;
65 Lisp_Object Q_file, Q_data, Q_face, Q_pixel_width, Q_pixel_height;
66 Lisp_Object Qformatted_string;
67 Lisp_Object Vcurrent_display_table;
68 Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph;
69 Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph;
70 Lisp_Object Vxemacs_logo;
71 Lisp_Object Vthe_nothing_vector;
72 Lisp_Object Vimage_instantiator_format_list;
73 Lisp_Object Vimage_instance_type_list;
74 Lisp_Object Vglyph_type_list;
75
76 int disable_animated_pixmaps;
77
78 DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing);
79 DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit);
80 DEFINE_IMAGE_INSTANTIATOR_FORMAT (string);
81 DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string);
82 DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow);
83 DEFINE_IMAGE_INSTANTIATOR_FORMAT (text);
84 DEFINE_IMAGE_INSTANTIATOR_FORMAT (pointer);
85
86 #ifdef HAVE_WINDOW_SYSTEM
87 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm);
88 Lisp_Object Qxbm;
89
90 Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y;
91 Lisp_Object Q_foreground, Q_background;
92 #ifndef BitmapSuccess
93 #define BitmapSuccess           0
94 #define BitmapOpenFailed        1
95 #define BitmapFileInvalid       2
96 #define BitmapNoMemory          3
97 #endif
98 #endif
99
100 #ifdef HAVE_XFACE
101 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface);
102 Lisp_Object Qxface;
103 #endif
104
105 #ifdef HAVE_XPM
106 DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm);
107 Lisp_Object Qxpm;
108 Lisp_Object Q_color_symbols;
109 #endif
110
111 typedef struct image_instantiator_format_entry image_instantiator_format_entry;
112 struct image_instantiator_format_entry
113 {
114   Lisp_Object symbol;
115   Lisp_Object device;
116   struct image_instantiator_methods *meths;
117 };
118
119 typedef struct
120 {
121   Dynarr_declare (struct image_instantiator_format_entry);
122 } image_instantiator_format_entry_dynarr;
123
124 /* This contains one entry per format, per device it's defined on. */
125 image_instantiator_format_entry_dynarr *
126   the_image_instantiator_format_entry_dynarr;
127
128 static Lisp_Object allocate_image_instance (Lisp_Object governing_domain,
129                                             Lisp_Object parent,
130                                             Lisp_Object instantiator);
131 static void image_validate (Lisp_Object instantiator);
132 static void glyph_property_was_changed (Lisp_Object glyph,
133                                         Lisp_Object property,
134                                         Lisp_Object locale);
135 static void set_image_instance_dirty_p (Lisp_Object instance, int dirty);
136 static void register_ignored_expose (struct frame* f, int x, int y, int width, int height);
137 static void cache_subwindow_instance_in_frame_maybe (Lisp_Object instance);
138 static void update_image_instance (Lisp_Object image_instance,
139                                    Lisp_Object instantiator);
140 /* Unfortunately windows and X are different. In windows BeginPaint()
141    will prevent WM_PAINT messages being generated so it is unnecessary
142    to register exposures as they will not occur. Under X they will
143    always occur. */
144 int hold_ignored_expose_registration;
145
146 EXFUN (Fimage_instance_type, 1);
147 EXFUN (Fglyph_type, 1);
148 EXFUN (Fnext_window, 4);
149
150 \f
151 /****************************************************************************
152  *                          Image Instantiators                             *
153  ****************************************************************************/
154
155 struct image_instantiator_methods *
156 decode_device_ii_format (Lisp_Object device, Lisp_Object format,
157                          Error_behavior errb)
158 {
159   int i;
160
161   if (!SYMBOLP (format))
162     {
163       if (ERRB_EQ (errb, ERROR_ME))
164         CHECK_SYMBOL (format);
165       return 0;
166     }
167
168   for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr);
169        i++)
170     {
171       if ( EQ (format,
172                Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
173                symbol) )
174         {
175           Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i).
176             device;
177           if ((NILP (d) && NILP (device))
178               ||
179               (!NILP (device) &&
180                EQ (CONSOLE_TYPE (XCONSOLE
181                                  (DEVICE_CONSOLE (XDEVICE (device)))), d)))
182             return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths;
183         }
184     }
185
186   maybe_signal_simple_error ("Invalid image-instantiator format", format,
187                              Qimage, errb);
188
189   return 0;
190 }
191
192 struct image_instantiator_methods *
193 decode_image_instantiator_format (Lisp_Object format, Error_behavior errb)
194 {
195   return decode_device_ii_format (Qnil, format, errb);
196 }
197
198 static int
199 valid_image_instantiator_format_p (Lisp_Object format, Lisp_Object locale)
200 {
201   int i;
202   struct image_instantiator_methods* meths =
203     decode_image_instantiator_format (format, ERROR_ME_NOT);
204   Lisp_Object contype = Qnil;
205   /* mess with the locale */
206   if (!NILP (locale) && SYMBOLP (locale))
207     contype = locale;
208   else
209     {
210       struct console* console = decode_console (locale);
211       contype = console ? CONSOLE_TYPE (console) : locale;
212     }
213   /* nothing is valid in all locales */
214   if (EQ (format, Qnothing))
215     return 1;
216   /* reject unknown formats */
217   else if (NILP (contype) || !meths)
218     return 0;
219
220   for (i = 0; i < Dynarr_length (meths->consoles); i++)
221     if (EQ (contype, Dynarr_at (meths->consoles, i).symbol))
222       return 1;
223   return 0;
224 }
225
226 DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p,
227        1, 2, 0, /*
228 Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid.
229 If LOCALE is non-nil then the format is checked in that locale.
230 If LOCALE is nil the current console is used.
231
232 Valid formats are some subset of 'nothing, 'string, 'formatted-string,
233 'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font,
234 'autodetect, 'subwindow, 'inherit, 'mswindows-resource, 'bmp,
235 'native-layout, 'layout, 'label, 'tab-control, 'tree-view,
236 'progress-gauge, 'scrollbar, 'combo-box, 'edit-field, 'button,
237 'widget, 'pointer, and 'text, depending on how XEmacs was compiled.
238 */
239        (image_instantiator_format, locale))
240 {
241   return valid_image_instantiator_format_p (image_instantiator_format,
242                                             locale) ?
243     Qt : Qnil;
244 }
245
246 DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list,
247        0, 0, 0, /*
248 Return a list of valid image-instantiator formats.
249 */
250        ())
251 {
252   return Fcopy_sequence (Vimage_instantiator_format_list);
253 }
254
255 void
256 add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol,
257                                     struct image_instantiator_methods *meths)
258 {
259   struct image_instantiator_format_entry entry;
260
261   entry.symbol = symbol;
262   entry.device = device;
263   entry.meths = meths;
264   Dynarr_add (the_image_instantiator_format_entry_dynarr, entry);
265   if (NILP (memq_no_quit (symbol, Vimage_instantiator_format_list)))
266     Vimage_instantiator_format_list =
267       Fcons (symbol, Vimage_instantiator_format_list);
268 }
269
270 void
271 add_entry_to_image_instantiator_format_list (Lisp_Object symbol,
272                                              struct
273                                              image_instantiator_methods *meths)
274 {
275   add_entry_to_device_ii_format_list (Qnil, symbol, meths);
276 }
277
278 static Lisp_Object *
279 get_image_conversion_list (Lisp_Object console_type)
280 {
281   return &decode_console_type (console_type, ERROR_ME)->image_conversion_list;
282 }
283
284 DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list,
285        2, 2, 0, /*
286 Set the image-conversion-list for consoles of the given CONSOLE-TYPE.
287 The image-conversion-list specifies how image instantiators that
288 are strings should be interpreted.  Each element of the list should be
289 a list of two elements (a regular expression string and a vector) or
290 a list of three elements (the preceding two plus an integer index into
291 the vector).  The string is converted to the vector associated with the
292 first matching regular expression.  If a vector index is specified, the
293 string itself is substituted into that position in the vector.
294
295 Note: The conversion above is applied when the image instantiator is
296 added to an image specifier, not when the specifier is actually
297 instantiated.  Therefore, changing the image-conversion-list only affects
298 newly-added instantiators.  Existing instantiators in glyphs and image
299 specifiers will not be affected.
300 */
301        (console_type, list))
302 {
303   Lisp_Object tail;
304   Lisp_Object *imlist = get_image_conversion_list (console_type);
305
306   /* Check the list to make sure that it only has valid entries. */
307
308   EXTERNAL_LIST_LOOP (tail, list)
309     {
310       Lisp_Object mapping = XCAR (tail);
311
312       /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */
313       if (!CONSP (mapping) ||
314           !CONSP (XCDR (mapping)) ||
315           (!NILP (XCDR (XCDR (mapping))) &&
316            (!CONSP (XCDR (XCDR (mapping))) ||
317             !NILP (XCDR (XCDR (XCDR (mapping)))))))
318         signal_simple_error ("Invalid mapping form", mapping);
319       else
320         {
321           Lisp_Object exp = XCAR (mapping);
322           Lisp_Object typevec = XCAR (XCDR (mapping));
323           Lisp_Object pos = Qnil;
324           Lisp_Object newvec;
325           struct gcpro gcpro1;
326
327           CHECK_STRING (exp);
328           CHECK_VECTOR (typevec);
329           if (!NILP (XCDR (XCDR (mapping))))
330             {
331               pos = XCAR (XCDR (XCDR (mapping)));
332               CHECK_INT (pos);
333               if (XINT (pos) < 0 ||
334                   XINT (pos) >= XVECTOR_LENGTH (typevec))
335                 args_out_of_range_3
336                   (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1));
337             }
338
339           newvec = Fcopy_sequence (typevec);
340           if (INTP (pos))
341             XVECTOR_DATA (newvec)[XINT (pos)] = exp;
342           GCPRO1 (newvec);
343           image_validate (newvec);
344           UNGCPRO;
345         }
346     }
347
348   *imlist = Fcopy_tree (list, Qt);
349   return list;
350 }
351
352 DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list,
353        1, 1, 0, /*
354 Return the image-conversion-list for devices of the given CONSOLE-TYPE.
355 The image-conversion-list specifies how to interpret image string
356 instantiators for the specified console type.  See
357 `set-console-type-image-conversion-list' for a description of its syntax.
358 */
359        (console_type))
360 {
361   return Fcopy_tree (*get_image_conversion_list (console_type), Qt);
362 }
363
364 /* Process a string instantiator according to the image-conversion-list for
365    CONSOLE_TYPE.  Returns a vector. */
366
367 static Lisp_Object
368 process_image_string_instantiator (Lisp_Object data,
369                                    Lisp_Object console_type,
370                                    int dest_mask)
371 {
372   Lisp_Object tail;
373
374   LIST_LOOP (tail, *get_image_conversion_list (console_type))
375     {
376       Lisp_Object mapping = XCAR (tail);
377       Lisp_Object exp = XCAR (mapping);
378       Lisp_Object typevec = XCAR (XCDR (mapping));
379
380       /* if the result is of a type that can't be instantiated
381          (e.g. a string when we're dealing with a pointer glyph),
382          skip it. */
383       if (!(dest_mask &
384             IIFORMAT_METH (decode_image_instantiator_format
385                            (INSTANTIATOR_TYPE (typevec), ERROR_ME),
386                            possible_dest_types, ())))
387         continue;
388       if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0)
389         {
390           if (!NILP (XCDR (XCDR (mapping))))
391             {
392               int pos = XINT (XCAR (XCDR (XCDR (mapping))));
393               Lisp_Object newvec = Fcopy_sequence (typevec);
394               XVECTOR_DATA (newvec)[pos] = data;
395               return newvec;
396             }
397           else
398             return typevec;
399         }
400     }
401
402   /* Oh well. */
403   signal_simple_error ("Unable to interpret glyph instantiator",
404                        data);
405
406   return Qnil;
407 }
408
409 Lisp_Object
410 find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword,
411                                  Lisp_Object default_)
412 {
413   Lisp_Object *elt;
414   int instantiator_len;
415
416   elt = XVECTOR_DATA (vector);
417   instantiator_len = XVECTOR_LENGTH (vector);
418
419   elt++;
420   instantiator_len--;
421
422   while (instantiator_len > 0)
423     {
424       if (EQ (elt[0], keyword))
425         return elt[1];
426       elt += 2;
427       instantiator_len -= 2;
428     }
429
430   return default_;
431 }
432
433 Lisp_Object
434 find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword)
435 {
436   return find_keyword_in_vector_or_given (vector, keyword, Qnil);
437 }
438
439 static Lisp_Object
440 find_instantiator_differences (Lisp_Object new, Lisp_Object old)
441 {
442   Lisp_Object alist = Qnil;
443   Lisp_Object *elt = XVECTOR_DATA (new);
444   Lisp_Object *old_elt = XVECTOR_DATA (old);
445   int len = XVECTOR_LENGTH (new);
446   struct gcpro gcpro1;
447
448   /* If the vector length has changed then consider everything
449      changed. We could try and figure out what properties have
450      disappeared or been added, but this code is only used as an
451      optimization anyway so lets not bother. */
452   if (len != XVECTOR_LENGTH (old))
453     return new;
454
455   GCPRO1 (alist);
456
457   for (len -= 2; len >= 1; len -= 2)
458     {
459       /* Keyword comparisons can be done with eq, the value must be
460          done with equal.
461          #### Note that this does not optimize re-ordering. */
462       if (!EQ (elt[len], old_elt[len])
463           || !internal_equal (elt[len+1], old_elt[len+1], 0))
464         alist = Fcons (Fcons (elt[len], elt[len+1]), alist);
465      }
466
467   {
468     Lisp_Object result = alist_to_tagged_vector (elt[0], alist);
469     free_alist (alist);
470     RETURN_UNGCPRO (result);
471   }
472 }
473
474 DEFUN ("set-instantiator-property", Fset_instantiator_property,
475        3, 3, 0, /*
476 Destructively set the property KEYWORD of INSTANTIATOR to VALUE.
477 If the property is not set then it is added to a copy of the
478 instantiator and the new instantiator returned.
479 Use `set-glyph-image' on glyphs to register instantiator changes.  */
480        (instantiator, keyword, value))
481 {
482   Lisp_Object *elt;
483   int len;
484
485   CHECK_VECTOR (instantiator);
486   if (!KEYWORDP (keyword))
487     signal_simple_error ("instantiator property must be a keyword", keyword);
488
489   elt = XVECTOR_DATA (instantiator);
490   len = XVECTOR_LENGTH (instantiator);
491
492   for (len -= 2; len >= 1; len -= 2)
493     {
494       if (EQ (elt[len], keyword))
495         {
496           elt[len+1] = value;
497           break;
498         }
499     }
500
501   /* Didn't find it so add it. */
502   if (len < 1)
503   {
504     Lisp_Object alist = Qnil, result;
505     struct gcpro gcpro1;
506
507     GCPRO1 (alist);
508     alist = tagged_vector_to_alist (instantiator);
509     alist = Fcons (Fcons (keyword, value), alist);
510     result = alist_to_tagged_vector (elt[0], alist);
511     free_alist (alist);
512     RETURN_UNGCPRO (result);
513   }
514
515   return instantiator;
516 }
517
518 void
519 check_valid_string (Lisp_Object data)
520 {
521   CHECK_STRING (data);
522 }
523
524 void
525 check_valid_vector (Lisp_Object data)
526 {
527   CHECK_VECTOR (data);
528 }
529
530 void
531 check_valid_face (Lisp_Object data)
532 {
533   Fget_face (data);
534 }
535
536 void
537 check_valid_int (Lisp_Object data)
538 {
539   CHECK_INT (data);
540 }
541
542 void
543 file_or_data_must_be_present (Lisp_Object instantiator)
544 {
545   if (NILP (find_keyword_in_vector (instantiator, Q_file)) &&
546       NILP (find_keyword_in_vector (instantiator, Q_data)))
547     signal_simple_error ("Must supply either :file or :data",
548                          instantiator);
549 }
550
551 void
552 data_must_be_present (Lisp_Object instantiator)
553 {
554   if (NILP (find_keyword_in_vector (instantiator, Q_data)))
555     signal_simple_error ("Must supply :data", instantiator);
556 }
557
558 static void
559 face_must_be_present (Lisp_Object instantiator)
560 {
561   if (NILP (find_keyword_in_vector (instantiator, Q_face)))
562     signal_simple_error ("Must supply :face", instantiator);
563 }
564
565 /* utility function useful in retrieving data from a file. */
566
567 Lisp_Object
568 make_string_from_file (Lisp_Object file)
569 {
570   /* This function can call lisp */
571   int count = specpdl_depth ();
572   Lisp_Object temp_buffer;
573   struct gcpro gcpro1;
574   Lisp_Object data;
575
576   specbind (Qinhibit_quit, Qt);
577   record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
578   temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*"));
579   GCPRO1 (temp_buffer);
580   set_buffer_internal (XBUFFER (temp_buffer));
581   Ferase_buffer (Qnil);
582   specbind (intern ("format-alist"), Qnil);
583   Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil);
584   data = Fbuffer_substring (Qnil, Qnil, Qnil);
585   unbind_to (count, Qnil);
586   UNGCPRO;
587   return data;
588 }
589
590 /* The following two functions are provided to make it easier for
591    the normalize methods to work with keyword-value vectors.
592    Hash tables are kind of heavyweight for this purpose.
593    (If vectors were resizable, we could avoid this problem;
594    but they're not.) An alternative approach that might be
595    more efficient but require more work is to use a type of
596    assoc-Dynarr and provide primitives for deleting elements out
597    of it. (However, you'd also have to add an unwind-protect
598    to make sure the Dynarr got freed in case of an error in
599    the normalization process.) */
600
601 Lisp_Object
602 tagged_vector_to_alist (Lisp_Object vector)
603 {
604   Lisp_Object *elt = XVECTOR_DATA (vector);
605   int len = XVECTOR_LENGTH (vector);
606   Lisp_Object result = Qnil;
607
608   assert (len & 1);
609   for (len -= 2; len >= 1; len -= 2)
610     result = Fcons (Fcons (elt[len], elt[len+1]), result);
611
612   return result;
613 }
614
615 Lisp_Object
616 alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist)
617 {
618   int len = 1 + 2 * XINT (Flength (alist));
619   Lisp_Object *elt = alloca_array (Lisp_Object, len);
620   int i;
621   Lisp_Object rest;
622
623   i = 0;
624   elt[i++] = tag;
625   LIST_LOOP (rest, alist)
626     {
627       Lisp_Object pair = XCAR (rest);
628       elt[i] = XCAR (pair);
629       elt[i+1] = XCDR (pair);
630       i += 2;
631     }
632
633   return Fvector (len, elt);
634 }
635
636 #ifdef ERROR_CHECK_GLYPHS
637 static int
638 check_instance_cache_mapper (Lisp_Object key, Lisp_Object value,
639                              void *flag_closure)
640 {
641   /* This function can GC */
642   /* value can be nil; we cache failures as well as successes */
643   if (!NILP (value))
644     {
645       Lisp_Object window;
646       VOID_TO_LISP (window, flag_closure);
647       assert (EQ (XIMAGE_INSTANCE_DOMAIN (value), window));
648     }
649
650   return 0;
651 }
652
653 void
654 check_window_subwindow_cache (struct window* w)
655 {
656   Lisp_Object window;
657
658   XSETWINDOW (window, w);
659
660   assert (!NILP (w->subwindow_instance_cache));
661   elisp_maphash (check_instance_cache_mapper,
662                  w->subwindow_instance_cache,
663                  LISP_TO_VOID (window));
664 }
665
666 void
667 check_image_instance_structure (Lisp_Object instance)
668 {
669   /* Weird nothing images exist at startup when the console is
670      deleted. */
671   if (!NOTHING_IMAGE_INSTANCEP (instance))
672     {
673       assert (DOMAIN_LIVE_P (instance));
674       assert (VECTORP (XIMAGE_INSTANCE_INSTANTIATOR (instance)));
675     }
676   if (WINDOWP (XIMAGE_INSTANCE_DOMAIN (instance)))
677     check_window_subwindow_cache
678       (XWINDOW (XIMAGE_INSTANCE_DOMAIN (instance)));
679 }
680 #endif
681
682 /* Determine what kind of domain governs the image instance.
683    Verify that the given domain is at least as specific, and extract
684    the governing domain from it. */
685 static Lisp_Object
686 get_image_instantiator_governing_domain (Lisp_Object instantiator,
687                                          Lisp_Object domain)
688 {
689   int governing_domain;
690
691   struct image_instantiator_methods *meths =
692     decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator),
693                                       ERROR_ME);
694   governing_domain = IIFORMAT_METH_OR_GIVEN (meths, governing_domain, (),
695                                              GOVERNING_DOMAIN_DEVICE);
696
697   if (governing_domain == GOVERNING_DOMAIN_WINDOW
698       && NILP (DOMAIN_WINDOW (domain)))
699     signal_simple_error_2 ("Domain for this instantiator must be resolvable to a window",
700                            instantiator, domain);
701   else if (governing_domain == GOVERNING_DOMAIN_FRAME
702            && NILP (DOMAIN_FRAME (domain)))
703     signal_simple_error_2
704       ("Domain for this instantiator must be resolvable to a frame",
705        instantiator, domain);
706
707   if (governing_domain == GOVERNING_DOMAIN_WINDOW)
708     domain = DOMAIN_WINDOW (domain);
709   else if (governing_domain == GOVERNING_DOMAIN_FRAME)
710     domain = DOMAIN_FRAME (domain);
711   else if (governing_domain == GOVERNING_DOMAIN_DEVICE)
712     domain = DOMAIN_DEVICE (domain);
713   else
714     abort ();
715
716   return domain;
717 }
718
719 Lisp_Object
720 normalize_image_instantiator (Lisp_Object instantiator,
721                               Lisp_Object contype,
722                               Lisp_Object dest_mask)
723 {
724   if (IMAGE_INSTANCEP (instantiator))
725     return instantiator;
726
727   if (STRINGP (instantiator))
728     instantiator = process_image_string_instantiator (instantiator, contype,
729                                                       XINT (dest_mask));
730   /* Subsequent validation will pick this up. */
731   if (!VECTORP (instantiator))
732     return instantiator;
733   /* We have to always store the actual pixmap data and not the
734      filename even though this is a potential memory pig.  We have to
735      do this because it is quite possible that we will need to
736      instantiate a new instance of the pixmap and the file will no
737      longer exist (e.g. w3 pixmaps are almost always from temporary
738      files). */
739   {
740     struct gcpro gcpro1;
741     struct image_instantiator_methods *meths;
742
743     GCPRO1 (instantiator);
744
745     meths = decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator),
746                                               ERROR_ME);
747     RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize,
748                                             (instantiator, contype, dest_mask),
749                                             instantiator));
750   }
751 }
752
753 static Lisp_Object
754 instantiate_image_instantiator (Lisp_Object governing_domain,
755                                 Lisp_Object domain,
756                                 Lisp_Object instantiator,
757                                 Lisp_Object pointer_fg, Lisp_Object pointer_bg,
758                                 int dest_mask, Lisp_Object glyph)
759 {
760   Lisp_Object ii = allocate_image_instance (governing_domain,
761                                             IMAGE_INSTANCEP (domain) ?
762                                             domain : glyph, instantiator);
763   Lisp_Image_Instance* p = XIMAGE_INSTANCE (ii);
764   struct image_instantiator_methods *meths, *device_meths;
765   struct gcpro gcpro1;
766
767   GCPRO1 (ii);
768   if (!valid_image_instantiator_format_p (INSTANTIATOR_TYPE (instantiator),
769                                           DOMAIN_DEVICE (governing_domain)))
770     signal_simple_error
771       ("Image instantiator format is invalid in this locale.",
772        instantiator);
773
774   meths = decode_image_instantiator_format (INSTANTIATOR_TYPE (instantiator),
775                                             ERROR_ME);
776   MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg,
777                                             pointer_bg, dest_mask, domain));
778
779   /* Now do device specific instantiation. */
780   device_meths = decode_device_ii_format (DOMAIN_DEVICE (governing_domain),
781                                           INSTANTIATOR_TYPE (instantiator),
782                                           ERROR_ME_NOT);
783
784   if (!HAS_IIFORMAT_METH_P (meths, instantiate)
785       && (!device_meths || !HAS_IIFORMAT_METH_P (device_meths, instantiate)))
786     signal_simple_error
787       ("Don't know how to instantiate this image instantiator?",
788        instantiator);
789
790   /* In general native window system methods will require sane
791      geometry values, thus the instance needs to have been laid-out
792      before they get called. */
793   image_instance_layout (ii, XIMAGE_INSTANCE_WIDTH (ii),
794                          XIMAGE_INSTANCE_HEIGHT (ii),
795                          IMAGE_UNCHANGED_GEOMETRY,
796                          IMAGE_UNCHANGED_GEOMETRY, domain);
797
798   MAYBE_IIFORMAT_METH (device_meths, instantiate, (ii, instantiator, pointer_fg,
799                                                    pointer_bg, dest_mask, domain));
800   /* Do post instantiation. */
801   MAYBE_IIFORMAT_METH (meths, post_instantiate, (ii, instantiator, domain));
802   MAYBE_IIFORMAT_METH (device_meths, post_instantiate, (ii, instantiator, domain));
803
804   /* We're done. */
805   IMAGE_INSTANCE_INITIALIZED (p) = 1;
806   /* Now that we're done verify that we really are laid out. */
807   if (IMAGE_INSTANCE_LAYOUT_CHANGED (p))
808     image_instance_layout (ii, XIMAGE_INSTANCE_WIDTH (ii),
809                            XIMAGE_INSTANCE_HEIGHT (ii),
810                            IMAGE_UNCHANGED_GEOMETRY,
811                            IMAGE_UNCHANGED_GEOMETRY, domain);
812
813   /* We *must* have a clean image at this point. */
814   IMAGE_INSTANCE_TEXT_CHANGED (p) = 0;
815   IMAGE_INSTANCE_SIZE_CHANGED (p) = 0;
816   IMAGE_INSTANCE_LAYOUT_CHANGED (p) = 0;
817   IMAGE_INSTANCE_DIRTYP (p) = 0;
818
819   assert ( XIMAGE_INSTANCE_HEIGHT (ii) >= 0
820            && XIMAGE_INSTANCE_WIDTH (ii) >= 0 );
821
822   ERROR_CHECK_IMAGE_INSTANCE (ii);
823
824   RETURN_UNGCPRO (ii);
825 }
826
827 \f
828 /****************************************************************************
829  *                          Image-Instance Object                           *
830  ****************************************************************************/
831
832 Lisp_Object Qimage_instancep;
833
834 static Lisp_Object
835 mark_image_instance (Lisp_Object obj)
836 {
837   Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
838
839   /* #### I want to check the instance here, but there are way too
840      many instances of the instance being marked while the domain is
841      dead. For instance you can get marked through an event when using
842      callback_ex.*/
843 #if 0
844   ERROR_CHECK_IMAGE_INSTANCE (obj);
845 #endif
846
847   mark_object (i->name);
848   mark_object (i->instantiator);
849   /* Is this legal in marking? We may get in the situation where the
850      domain has been deleted - making the instance unusable. It seems
851      better to remove the domain so that it can be finalized. */
852   if (!DOMAIN_LIVE_P (i->domain))
853     i->domain = Qnil;
854   else
855     mark_object (i->domain);
856
857   /* We don't mark the glyph reference since that would create a
858      circularity preventing GC. Ditto the instantiator. */
859   switch (IMAGE_INSTANCE_TYPE (i))
860     {
861     case IMAGE_TEXT:
862       mark_object (IMAGE_INSTANCE_TEXT_STRING (i));
863       break;
864     case IMAGE_MONO_PIXMAP:
865     case IMAGE_COLOR_PIXMAP:
866       mark_object (IMAGE_INSTANCE_PIXMAP_FILENAME (i));
867       mark_object (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i));
868       mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i));
869       mark_object (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i));
870       mark_object (IMAGE_INSTANCE_PIXMAP_FG (i));
871       mark_object (IMAGE_INSTANCE_PIXMAP_BG (i));
872       break;
873
874     case IMAGE_WIDGET:
875       mark_object (IMAGE_INSTANCE_WIDGET_TYPE (i));
876       mark_object (IMAGE_INSTANCE_WIDGET_PROPS (i));
877       mark_object (IMAGE_INSTANCE_SUBWINDOW_FACE (i));
878       mark_object (IMAGE_INSTANCE_WIDGET_ITEMS (i));
879       mark_object (IMAGE_INSTANCE_LAYOUT_CHILDREN (i));
880       mark_object (IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (i));
881       mark_object (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i));
882       mark_object (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i));
883     case IMAGE_SUBWINDOW:
884       break;
885
886     default:
887       break;
888     }
889
890   /* The image may have been previously finalized (yes that's weird,
891      see Fdelete_frame() and mark_window_as_deleted()), in which case
892      the domain will be nil, so cope with this. */
893   if (!NILP (IMAGE_INSTANCE_DEVICE (i)))
894     MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (i)),
895                    mark_image_instance, (i));
896
897   return i->device;
898 }
899
900 static void
901 print_image_instance (Lisp_Object obj, Lisp_Object printcharfun,
902                       int escapeflag)
903 {
904   char buf[100];
905   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj);
906
907   if (print_readably)
908     error ("printing unreadable object #<image-instance 0x%x>",
909            ii->header.uid);
910   write_c_string ("#<image-instance (", printcharfun);
911   print_internal (Fimage_instance_type (obj), printcharfun, 0);
912   write_c_string (") ", printcharfun);
913   if (!NILP (ii->name))
914     {
915       print_internal (ii->name, printcharfun, 1);
916       write_c_string (" ", printcharfun);
917     }
918   write_c_string ("on ", printcharfun);
919   print_internal (ii->domain, printcharfun, 0);
920   write_c_string (" ", printcharfun);
921   switch (IMAGE_INSTANCE_TYPE (ii))
922     {
923     case IMAGE_NOTHING:
924       break;
925
926     case IMAGE_TEXT:
927       print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1);
928       break;
929
930     case IMAGE_MONO_PIXMAP:
931     case IMAGE_COLOR_PIXMAP:
932     case IMAGE_POINTER:
933       if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii)))
934         {
935           char *s;
936           Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii);
937           s = strrchr ((char *) XSTRING_DATA (filename), '/');
938           if (s)
939             print_internal (build_string (s + 1), printcharfun, 1);
940           else
941             print_internal (filename, printcharfun, 1);
942         }
943       if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1)
944         sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
945                  IMAGE_INSTANCE_PIXMAP_HEIGHT (ii),
946                  IMAGE_INSTANCE_PIXMAP_DEPTH (ii));
947       else
948         sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii),
949                  IMAGE_INSTANCE_PIXMAP_HEIGHT (ii));
950       write_c_string (buf, printcharfun);
951       if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ||
952           !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
953         {
954           write_c_string (" @", printcharfun);
955           if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)))
956             {
957               long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)));
958               write_c_string (buf, printcharfun);
959             }
960           else
961             write_c_string ("??", printcharfun);
962           write_c_string (",", printcharfun);
963           if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)))
964             {
965               long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)));
966               write_c_string (buf, printcharfun);
967             }
968           else
969             write_c_string ("??", printcharfun);
970         }
971       if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) ||
972           !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
973         {
974           write_c_string (" (", printcharfun);
975           if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)))
976             {
977               print_internal
978                 (XCOLOR_INSTANCE
979                  (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0);
980             }
981           write_c_string ("/", printcharfun);
982           if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii)))
983             {
984               print_internal
985                 (XCOLOR_INSTANCE
986                  (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0);
987             }
988           write_c_string (")", printcharfun);
989         }
990       break;
991
992     case IMAGE_WIDGET:
993       print_internal (IMAGE_INSTANCE_WIDGET_TYPE (ii), printcharfun, 0);
994
995       if (GUI_ITEMP (IMAGE_INSTANCE_WIDGET_ITEM (ii)))
996         {
997           write_c_string (" ", printcharfun);
998           print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 1);
999         }
1000
1001       if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii)))
1002         {
1003           write_c_string (" face=", printcharfun);
1004           print_internal
1005             (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0);
1006         }
1007       /* fallthrough */
1008
1009     case IMAGE_SUBWINDOW:
1010       sprintf (buf, " %dx%d", IMAGE_INSTANCE_WIDTH (ii),
1011                IMAGE_INSTANCE_HEIGHT (ii));
1012       write_c_string (buf, printcharfun);
1013
1014       /* This is stolen from frame.c.  Subwindows are strange in that they
1015          are specific to a particular frame so we want to print in their
1016          description what that frame is. */
1017
1018       write_c_string (" on #<", printcharfun);
1019       {
1020         struct frame* f  = XFRAME (IMAGE_INSTANCE_FRAME (ii));
1021
1022         if (!FRAME_LIVE_P (f))
1023           write_c_string ("dead", printcharfun);
1024         else
1025           write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))),
1026                           printcharfun);
1027       }
1028       write_c_string ("-frame>", printcharfun);
1029       sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
1030       write_c_string (buf, printcharfun);
1031
1032       break;
1033
1034     default:
1035       abort ();
1036     }
1037
1038   MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), print_image_instance,
1039                  (ii, printcharfun, escapeflag));
1040   sprintf (buf, " 0x%x>", ii->header.uid);
1041   write_c_string (buf, printcharfun);
1042 }
1043
1044 static void
1045 finalize_image_instance (void *header, int for_disksave)
1046 {
1047   Lisp_Image_Instance *i = (Lisp_Image_Instance *) header;
1048
1049   /* objects like this exist at dump time, so don't bomb out. */
1050   if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING
1051       ||
1052       NILP (IMAGE_INSTANCE_DEVICE (i)))
1053     return;
1054   if (for_disksave) finalose (i);
1055
1056   /* We can't use the domain here, because it might have
1057      disappeared. */
1058   MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (i)),
1059                  finalize_image_instance, (i));
1060
1061   /* Make sure we don't try this twice. */
1062   IMAGE_INSTANCE_DEVICE (i) = Qnil;
1063 }
1064
1065 static int
1066 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
1067 {
1068   Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1);
1069   Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2);
1070
1071   ERROR_CHECK_IMAGE_INSTANCE (obj1);
1072   ERROR_CHECK_IMAGE_INSTANCE (obj2);
1073
1074   if (!EQ (IMAGE_INSTANCE_DOMAIN (i1),
1075            IMAGE_INSTANCE_DOMAIN (i2))
1076       || IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)
1077       || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2)
1078       || IMAGE_INSTANCE_MARGIN_WIDTH (i1) !=
1079       IMAGE_INSTANCE_MARGIN_WIDTH (i2)
1080       || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2)
1081       || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2)
1082       || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (i2))
1083     return 0;
1084   if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2),
1085                        depth + 1))
1086     return 0;
1087   if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (i1),
1088                        IMAGE_INSTANCE_INSTANTIATOR (i2),
1089                        depth + 1))
1090     return 0;
1091
1092   switch (IMAGE_INSTANCE_TYPE (i1))
1093     {
1094     case IMAGE_NOTHING:
1095       break;
1096
1097     case IMAGE_TEXT:
1098       if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1),
1099                            IMAGE_INSTANCE_TEXT_STRING (i2),
1100                            depth + 1))
1101         return 0;
1102       break;
1103
1104     case IMAGE_MONO_PIXMAP:
1105     case IMAGE_COLOR_PIXMAP:
1106     case IMAGE_POINTER:
1107       if (!(IMAGE_INSTANCE_PIXMAP_DEPTH (i1) ==
1108             IMAGE_INSTANCE_PIXMAP_DEPTH (i2) &&
1109             IMAGE_INSTANCE_PIXMAP_SLICE (i1) ==
1110             IMAGE_INSTANCE_PIXMAP_SLICE (i2) &&
1111             EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1),
1112                 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) &&
1113             EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1),
1114                 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) &&
1115             internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1),
1116                             IMAGE_INSTANCE_PIXMAP_FILENAME (i2),
1117                             depth + 1) &&
1118             internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1),
1119                             IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2),
1120                             depth + 1)))
1121         return 0;
1122       break;
1123
1124     case IMAGE_WIDGET:
1125       if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1),
1126                 IMAGE_INSTANCE_WIDGET_TYPE (i2))
1127             && IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
1128             IMAGE_INSTANCE_SUBWINDOW_ID (i2)
1129             &&
1130             EQ (IMAGE_INSTANCE_WIDGET_FACE (i1),
1131                 IMAGE_INSTANCE_WIDGET_TYPE (i2))
1132             && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1),
1133                                IMAGE_INSTANCE_WIDGET_ITEMS (i2),
1134                                depth + 1)
1135             && internal_equal (IMAGE_INSTANCE_LAYOUT_CHILDREN (i1),
1136                                IMAGE_INSTANCE_LAYOUT_CHILDREN (i2),
1137                                depth + 1)
1138             && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1),
1139                                IMAGE_INSTANCE_WIDGET_PROPS (i2),
1140                                depth + 1)
1141             && internal_equal (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i1),
1142                                IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i2),
1143                                depth + 1)
1144             && internal_equal (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i1),
1145                                IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i2),
1146                                depth + 1)
1147             ))
1148         return 0;
1149       break;
1150
1151     case IMAGE_SUBWINDOW:
1152       if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) ==
1153             IMAGE_INSTANCE_SUBWINDOW_ID (i2)))
1154         return 0;
1155       break;
1156
1157     default:
1158       abort ();
1159     }
1160
1161   return DEVMETH_OR_GIVEN (DOMAIN_XDEVICE (i1->domain),
1162                            image_instance_equal, (i1, i2, depth), 1);
1163 }
1164
1165 /* Image instance domain manipulators. We can't error check in these
1166    otherwise we get into infinite recursion. */
1167 Lisp_Object
1168 image_instance_device (Lisp_Object instance)
1169 {
1170   return XIMAGE_INSTANCE_DEVICE (instance);
1171 }
1172
1173 Lisp_Object
1174 image_instance_frame (Lisp_Object instance)
1175 {
1176   return XIMAGE_INSTANCE_FRAME (instance);
1177 }
1178
1179 Lisp_Object
1180 image_instance_window (Lisp_Object instance)
1181 {
1182   return DOMAIN_WINDOW (XIMAGE_INSTANCE_DOMAIN (instance));
1183 }
1184
1185 int
1186 image_instance_live_p (Lisp_Object instance)
1187 {
1188   return DOMAIN_LIVE_P (XIMAGE_INSTANCE_DOMAIN (instance));
1189 }
1190
1191 static unsigned long
1192 image_instance_hash (Lisp_Object obj, int depth)
1193 {
1194   Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj);
1195   unsigned long hash = HASH5 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)),
1196                               IMAGE_INSTANCE_WIDTH (i),
1197                               IMAGE_INSTANCE_MARGIN_WIDTH (i),
1198                               IMAGE_INSTANCE_HEIGHT (i),
1199                               internal_hash (IMAGE_INSTANCE_INSTANTIATOR (i),
1200                                              depth + 1));
1201
1202   ERROR_CHECK_IMAGE_INSTANCE (obj);
1203
1204   switch (IMAGE_INSTANCE_TYPE (i))
1205     {
1206     case IMAGE_NOTHING:
1207       break;
1208
1209     case IMAGE_TEXT:
1210       hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i),
1211                                          depth + 1));
1212       break;
1213
1214     case IMAGE_MONO_PIXMAP:
1215     case IMAGE_COLOR_PIXMAP:
1216     case IMAGE_POINTER:
1217       hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i),
1218                     IMAGE_INSTANCE_PIXMAP_SLICE (i),
1219                     internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i),
1220                                    depth + 1));
1221       break;
1222
1223     case IMAGE_WIDGET:
1224       /* We need the hash to be equivalent to what should be
1225          displayed. */
1226       hash = HASH5 (hash,
1227                     LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)),
1228                     internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1),
1229                     internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1),
1230                     internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i),
1231                                    depth + 1));
1232     case IMAGE_SUBWINDOW:
1233       hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBWINDOW_ID (i));
1234       break;
1235
1236     default:
1237       abort ();
1238     }
1239
1240   return HASH2 (hash, DEVMETH_OR_GIVEN
1241                 (XDEVICE (image_instance_device (obj)),
1242                  image_instance_hash, (i, depth),
1243                  0));
1244 }
1245
1246 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance,
1247                                mark_image_instance, print_image_instance,
1248                                finalize_image_instance, image_instance_equal,
1249                                image_instance_hash, 0,
1250                                Lisp_Image_Instance);
1251
1252 static Lisp_Object
1253 allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent,
1254                          Lisp_Object instantiator)
1255 {
1256   Lisp_Image_Instance *lp =
1257     alloc_lcrecord_type (Lisp_Image_Instance, &lrecord_image_instance);
1258   Lisp_Object val;
1259
1260   zero_lcrecord (lp);
1261   /* It's not possible to simply keep a record of the domain in which
1262      the instance was instantiated. This is because caching may mean
1263      that the domain becomes invalid but the instance remains
1264      valid. However, the only truly relevant domain is the domain in
1265      which the instance is cached since this is the one that will be
1266      common to the instances. */
1267   lp->domain = governing_domain;
1268   /* The cache domain is not quite sufficient since the domain can get
1269      deleted before the image instance does. We need to know the
1270      domain device in order to finalize the image instance
1271      properly. We therefore record the device also. */
1272   lp->device = DOMAIN_DEVICE (governing_domain);
1273   lp->type = IMAGE_NOTHING;
1274   lp->name = Qnil;
1275   lp->x_offset = 0;
1276   lp->y_offset = 0;
1277   lp->width = IMAGE_UNSPECIFIED_GEOMETRY;
1278   lp->margin_width = 0;
1279   lp->height = IMAGE_UNSPECIFIED_GEOMETRY;
1280   lp->parent = parent;
1281   lp->instantiator = instantiator;
1282   /* So that layouts get done. */
1283   lp->layout_changed = 1;
1284   lp->initialized = 0;
1285
1286   XSETIMAGE_INSTANCE (val, lp);
1287   MARK_GLYPHS_CHANGED;
1288
1289   return val;
1290 }
1291
1292 static enum image_instance_type
1293 decode_image_instance_type (Lisp_Object type, Error_behavior errb)
1294 {
1295   if (ERRB_EQ (errb, ERROR_ME))
1296     CHECK_SYMBOL (type);
1297
1298   if (EQ (type, Qnothing))      return IMAGE_NOTHING;
1299   if (EQ (type, Qtext))         return IMAGE_TEXT;
1300   if (EQ (type, Qmono_pixmap))  return IMAGE_MONO_PIXMAP;
1301   if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP;
1302   if (EQ (type, Qpointer))      return IMAGE_POINTER;
1303   if (EQ (type, Qsubwindow))    return IMAGE_SUBWINDOW;
1304   if (EQ (type, Qwidget))    return IMAGE_WIDGET;
1305
1306   maybe_signal_simple_error ("Invalid image-instance type", type,
1307                              Qimage, errb);
1308
1309   return IMAGE_UNKNOWN; /* not reached */
1310 }
1311
1312 static Lisp_Object
1313 encode_image_instance_type (enum image_instance_type type)
1314 {
1315   switch (type)
1316     {
1317     case IMAGE_NOTHING:      return Qnothing;
1318     case IMAGE_TEXT:         return Qtext;
1319     case IMAGE_MONO_PIXMAP:  return Qmono_pixmap;
1320     case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap;
1321     case IMAGE_POINTER:      return Qpointer;
1322     case IMAGE_SUBWINDOW:    return Qsubwindow;
1323     case IMAGE_WIDGET:    return Qwidget;
1324     default:
1325       abort ();
1326     }
1327
1328   return Qnil; /* not reached */
1329 }
1330
1331 static int
1332 decode_image_instance_type_list (Lisp_Object list)
1333 {
1334   Lisp_Object rest;
1335   int mask = 0;
1336
1337   if (NILP (list))
1338     return ~0;
1339
1340   if (!CONSP (list))
1341     {
1342       enum image_instance_type type =
1343         decode_image_instance_type (list, ERROR_ME);
1344       return image_instance_type_to_mask (type);
1345     }
1346
1347   EXTERNAL_LIST_LOOP (rest, list)
1348     {
1349       enum image_instance_type type =
1350         decode_image_instance_type (XCAR (rest), ERROR_ME);
1351       mask |= image_instance_type_to_mask (type);
1352     }
1353
1354   return mask;
1355 }
1356
1357 static Lisp_Object
1358 encode_image_instance_type_list (int mask)
1359 {
1360   int count = 0;
1361   Lisp_Object result = Qnil;
1362
1363   while (mask)
1364     {
1365       count++;
1366       if (mask & 1)
1367         result = Fcons (encode_image_instance_type
1368                         ((enum image_instance_type) count), result);
1369       mask >>= 1;
1370     }
1371
1372   return Fnreverse (result);
1373 }
1374
1375 DOESNT_RETURN
1376 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask,
1377                           int desired_dest_mask)
1378 {
1379   signal_error
1380     (Qerror,
1381      list2
1382      (emacs_doprnt_string_lisp_2
1383       ((const Bufbyte *)
1384        "No compatible image-instance types given: wanted one of %s, got %s",
1385        Qnil, -1, 2,
1386        encode_image_instance_type_list (desired_dest_mask),
1387        encode_image_instance_type_list (given_dest_mask)),
1388       instantiator));
1389 }
1390
1391 static int
1392 valid_image_instance_type_p (Lisp_Object type)
1393 {
1394   return !NILP (memq_no_quit (type, Vimage_instance_type_list));
1395 }
1396
1397 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /*
1398 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid.
1399 Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap,
1400 'pointer, 'subwindow, and 'widget, depending on how XEmacs was compiled.
1401 */
1402        (image_instance_type))
1403 {
1404   return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil;
1405 }
1406
1407 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /*
1408 Return a list of valid image-instance types.
1409 */
1410        ())
1411 {
1412   return Fcopy_sequence (Vimage_instance_type_list);
1413 }
1414
1415 Error_behavior
1416 decode_error_behavior_flag (Lisp_Object noerror)
1417 {
1418   if (NILP (noerror))        return ERROR_ME;
1419   else if (EQ (noerror, Qt)) return ERROR_ME_NOT;
1420   else                       return ERROR_ME_WARN;
1421 }
1422
1423 Lisp_Object
1424 encode_error_behavior_flag (Error_behavior errb)
1425 {
1426   if (ERRB_EQ (errb, ERROR_ME))
1427     return Qnil;
1428   else if (ERRB_EQ (errb, ERROR_ME_NOT))
1429     return Qt;
1430   else
1431     {
1432       assert (ERRB_EQ (errb, ERROR_ME_WARN));
1433       return Qwarning;
1434     }
1435 }
1436
1437 /* Recurse up the hierarchy looking for the topmost glyph. This means
1438    that instances in layouts will inherit face properties from their
1439    parent. */
1440 Lisp_Object image_instance_parent_glyph (Lisp_Image_Instance* ii)
1441 {
1442   if (IMAGE_INSTANCEP (IMAGE_INSTANCE_PARENT (ii)))
1443     {
1444       return image_instance_parent_glyph
1445         (XIMAGE_INSTANCE (IMAGE_INSTANCE_PARENT (ii)));
1446     }
1447   return IMAGE_INSTANCE_PARENT (ii);
1448 }
1449
1450 static Lisp_Object
1451 make_image_instance_1 (Lisp_Object data, Lisp_Object domain,
1452                        Lisp_Object dest_types)
1453 {
1454   Lisp_Object ii;
1455   struct gcpro gcpro1;
1456   int dest_mask;
1457   Lisp_Object governing_domain;
1458
1459   if (IMAGE_INSTANCEP (data))
1460     signal_simple_error ("Image instances not allowed here", data);
1461   image_validate (data);
1462   domain = decode_domain (domain);
1463   /* instantiate_image_instantiator() will abort if given an
1464      image instance ... */
1465   dest_mask = decode_image_instance_type_list (dest_types);
1466   data = normalize_image_instantiator (data,
1467                                        DEVICE_TYPE (DOMAIN_XDEVICE (domain)),
1468                                        make_int (dest_mask));
1469   GCPRO1 (data);
1470   /* After normalizing the data, it's always either an image instance (which
1471      we filtered out above) or a vector. */
1472   if (EQ (INSTANTIATOR_TYPE (data), Qinherit))
1473     signal_simple_error ("Inheritance not allowed here", data);
1474   governing_domain =
1475     get_image_instantiator_governing_domain (data, domain);
1476   ii = instantiate_image_instantiator (governing_domain, domain, data,
1477                                        Qnil, Qnil, dest_mask, Qnil);
1478   RETURN_UNGCPRO (ii);
1479 }
1480
1481 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /*
1482 Return a new `image-instance' object.
1483
1484 Image-instance objects encapsulate the way a particular image (pixmap,
1485 etc.) is displayed on a particular device.  In most circumstances, you
1486 do not need to directly create image instances; use a glyph instead.
1487 However, it may occasionally be useful to explicitly create image
1488 instances, if you want more control over the instantiation process.
1489
1490 DATA is an image instantiator, which describes the image; see
1491 `make-image-specifier' for a description of the allowed values.
1492
1493 DEST-TYPES should be a list of allowed image instance types that can
1494 be generated.  The recognized image instance types are
1495
1496 'nothing
1497   Nothing is displayed.
1498 'text
1499   Displayed as text.  The foreground and background colors and the
1500   font of the text are specified independent of the pixmap.  Typically
1501   these attributes will come from the face of the surrounding text,
1502   unless a face is specified for the glyph in which the image appears.
1503 'mono-pixmap
1504   Displayed as a mono pixmap (a pixmap with only two colors where the
1505   foreground and background can be specified independent of the pixmap;
1506   typically the pixmap assumes the foreground and background colors of
1507   the text around it, unless a face is specified for the glyph in which
1508   the image appears).
1509 'color-pixmap
1510   Displayed as a color pixmap.
1511 'pointer
1512   Used as the mouse pointer for a window.
1513 'subwindow
1514   A child window that is treated as an image.  This allows (e.g.)
1515   another program to be responsible for drawing into the window.
1516 'widget
1517   A child window that contains a window-system widget, e.g. a push
1518   button, text field, or slider.
1519
1520 The DEST-TYPES list is unordered.  If multiple destination types are
1521 possible for a given instantiator, the "most natural" type for the
1522 instantiator's format is chosen. (For XBM, the most natural types are
1523 `mono-pixmap', followed by `color-pixmap', followed by `pointer'.  For
1524 the other normal image formats, the most natural types are
1525 `color-pixmap', followed by `mono-pixmap', followed by `pointer'.  For
1526 the string and formatted-string formats, the most natural types are
1527 `text', followed by `mono-pixmap' (not currently implemented),
1528 followed by `color-pixmap' (not currently implemented).  For MS
1529 Windows resources, the most natural type for pointer resources is
1530 `pointer', and for the others it's `color-pixmap'.  The other formats
1531 can only be instantiated as one type. (If you want to control more
1532 specifically the order of the types into which an image is
1533 instantiated, just call `make-image-instance' repeatedly until it
1534 succeeds, passing less and less preferred destination types each
1535 time.)
1536
1537 See `make-image-specifier' for a description of the different image
1538 instantiator formats.
1539
1540 If DEST-TYPES is omitted, all possible types are allowed.
1541
1542 DOMAIN specifies the domain to which the image instance will be attached.
1543 This domain is termed the \"governing domain\".  The type of the governing
1544 domain depends on the image instantiator format. (Although, more correctly,
1545 it should probably depend on the image instance type.) For example, pixmap
1546 image instances are specific to a device, but widget image instances are
1547 specific to a particular XEmacs window because in order to display such a
1548 widget when two windows onto the same buffer want to display the widget,
1549 two separate underlying widgets must be created. (That's because a widget
1550 is actually a child window-system window, and all window-system windows have
1551 a unique existence on the screen.) This means that the governing domain for
1552 a pixmap image instance will be some device (most likely, the only existing
1553 device), whereas the governing domain for a widget image instance will be
1554 some XEmacs window.
1555
1556 If you specify an overly general DOMAIN (e.g. a frame when a window was
1557 wanted), an error is signaled.  If you specify an overly specific DOMAIN
1558 \(e.g. a window when a device was wanted), the corresponding general domain
1559 is fetched and used instead.  For `make-image-instance', it makes no
1560 difference whether you specify an overly specific domain or the properly
1561 general domain derived from it.  However, it does matter when creating an
1562 image instance by instantiating a specifier or glyph (e.g. with
1563 `glyph-image-instance'), because the more specific domain causes spec lookup
1564 to start there and proceed to more general domains. (It would also matter
1565 when creating an image instance with an instantiator format of `inherit',
1566 but we currently disallow this. #### We should fix this.)
1567
1568 If omitted, DOMAIN defaults to the selected window.
1569
1570 NOERROR controls what happens when the image cannot be generated.
1571 If nil, an error message is generated.  If t, no messages are
1572 generated and this function returns nil.  If anything else, a warning
1573 message is generated and this function returns nil.
1574 */
1575        (data, domain, dest_types, noerror))
1576 {
1577   Error_behavior errb = decode_error_behavior_flag (noerror);
1578
1579   return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1,
1580                                      Qnil, Qimage, errb,
1581                                      3, data, domain, dest_types);
1582 }
1583
1584 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /*
1585 Return non-nil if OBJECT is an image instance.
1586 */
1587        (object))
1588 {
1589   return IMAGE_INSTANCEP (object) ? Qt : Qnil;
1590 }
1591
1592 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /*
1593 Return the type of the given image instance.
1594 The return value will be one of 'nothing, 'text, 'mono-pixmap,
1595 'color-pixmap, 'pointer, or 'subwindow.
1596 */
1597        (image_instance))
1598 {
1599   CHECK_IMAGE_INSTANCE (image_instance);
1600   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1601   return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance));
1602 }
1603
1604 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /*
1605 Return the name of the given image instance.
1606 */
1607        (image_instance))
1608 {
1609   CHECK_IMAGE_INSTANCE (image_instance);
1610   return XIMAGE_INSTANCE_NAME (image_instance);
1611 }
1612
1613 DEFUN ("image-instance-domain", Fimage_instance_domain, 1, 1, 0, /*
1614 Return the governing domain of the given image instance.
1615 The governing domain of an image instance is the domain that the image
1616 instance is specific to.  It is NOT necessarily the domain that was
1617 given to the call to `specifier-instance' that resulted in the creation
1618 of this image instance.  See `make-image-instance' for more information
1619 on governing domains.
1620 */
1621        (image_instance))
1622 {
1623   CHECK_IMAGE_INSTANCE (image_instance);
1624   return XIMAGE_INSTANCE_DOMAIN (image_instance);
1625 }
1626
1627 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /*
1628 Return the string of the given image instance.
1629 This will only be non-nil for text image instances and widgets.
1630 */
1631        (image_instance))
1632 {
1633   CHECK_IMAGE_INSTANCE (image_instance);
1634   if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT)
1635     return XIMAGE_INSTANCE_TEXT_STRING (image_instance);
1636   else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET)
1637     return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance);
1638   else
1639     return Qnil;
1640 }
1641
1642 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /*
1643 Return the given property of the given image instance.
1644 Returns nil if the property or the property method do not exist for
1645 the image instance in the domain.
1646 */
1647        (image_instance, prop))
1648 {
1649   Lisp_Image_Instance* ii;
1650   Lisp_Object type, ret;
1651   struct image_instantiator_methods* meths;
1652
1653   CHECK_IMAGE_INSTANCE (image_instance);
1654   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1655   CHECK_SYMBOL (prop);
1656   ii = XIMAGE_INSTANCE (image_instance);
1657
1658   /* ... then try device specific methods ... */
1659   type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1660   meths = decode_device_ii_format (image_instance_device (image_instance),
1661                                    type, ERROR_ME_NOT);
1662   if (meths && HAS_IIFORMAT_METH_P (meths, property)
1663       &&
1664       !UNBOUNDP (ret =  IIFORMAT_METH (meths, property, (image_instance, prop))))
1665     {
1666       return ret;
1667     }
1668   /* ... then format specific methods ... */
1669   meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1670   if (meths && HAS_IIFORMAT_METH_P (meths, property)
1671       &&
1672       !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop))))
1673     {
1674       return ret;
1675     }
1676   /* ... then fail */
1677   return Qnil;
1678 }
1679
1680 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /*
1681 Return the file name from which IMAGE-INSTANCE was read, if known.
1682 */
1683        (image_instance))
1684 {
1685   CHECK_IMAGE_INSTANCE (image_instance);
1686   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1687
1688   switch (XIMAGE_INSTANCE_TYPE (image_instance))
1689     {
1690     case IMAGE_MONO_PIXMAP:
1691     case IMAGE_COLOR_PIXMAP:
1692     case IMAGE_POINTER:
1693       return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance);
1694
1695     default:
1696       return Qnil;
1697     }
1698 }
1699
1700 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /*
1701 Return the file name from which IMAGE-INSTANCE's mask was read, if known.
1702 */
1703        (image_instance))
1704 {
1705   CHECK_IMAGE_INSTANCE (image_instance);
1706   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1707
1708   switch (XIMAGE_INSTANCE_TYPE (image_instance))
1709     {
1710     case IMAGE_MONO_PIXMAP:
1711     case IMAGE_COLOR_PIXMAP:
1712     case IMAGE_POINTER:
1713       return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance);
1714
1715     default:
1716       return Qnil;
1717     }
1718 }
1719
1720 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /*
1721 Return the depth of the image instance.
1722 This is 0 for a bitmap, or a positive integer for a pixmap.
1723 */
1724        (image_instance))
1725 {
1726   CHECK_IMAGE_INSTANCE (image_instance);
1727   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1728
1729   switch (XIMAGE_INSTANCE_TYPE (image_instance))
1730     {
1731     case IMAGE_MONO_PIXMAP:
1732     case IMAGE_COLOR_PIXMAP:
1733     case IMAGE_POINTER:
1734       return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance));
1735
1736     default:
1737       return Qnil;
1738     }
1739 }
1740
1741 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /*
1742 Return the height of the image instance, in pixels.
1743 */
1744        (image_instance))
1745 {
1746   CHECK_IMAGE_INSTANCE (image_instance);
1747   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1748
1749   switch (XIMAGE_INSTANCE_TYPE (image_instance))
1750     {
1751     case IMAGE_MONO_PIXMAP:
1752     case IMAGE_COLOR_PIXMAP:
1753     case IMAGE_POINTER:
1754     case IMAGE_SUBWINDOW:
1755     case IMAGE_WIDGET:
1756       return make_int (XIMAGE_INSTANCE_HEIGHT (image_instance));
1757
1758     default:
1759       return Qnil;
1760     }
1761 }
1762
1763 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /*
1764 Return the width of the image instance, in pixels.
1765 */
1766        (image_instance))
1767 {
1768   CHECK_IMAGE_INSTANCE (image_instance);
1769   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1770
1771   switch (XIMAGE_INSTANCE_TYPE (image_instance))
1772     {
1773     case IMAGE_MONO_PIXMAP:
1774     case IMAGE_COLOR_PIXMAP:
1775     case IMAGE_POINTER:
1776     case IMAGE_SUBWINDOW:
1777     case IMAGE_WIDGET:
1778       return make_int (XIMAGE_INSTANCE_WIDTH (image_instance));
1779
1780     default:
1781       return Qnil;
1782     }
1783 }
1784
1785 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /*
1786 Return the X coordinate of the image instance's hotspot, if known.
1787 This is a point relative to the origin of the pixmap.  When an image is
1788  used as a mouse pointer, the hotspot is the point on the image that sits
1789  over the location that the pointer points to.  This is, for example, the
1790  tip of the arrow or the center of the crosshairs.
1791 This will always be nil for a non-pointer image instance.
1792 */
1793        (image_instance))
1794 {
1795   CHECK_IMAGE_INSTANCE (image_instance);
1796   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1797
1798   switch (XIMAGE_INSTANCE_TYPE (image_instance))
1799     {
1800     case IMAGE_MONO_PIXMAP:
1801     case IMAGE_COLOR_PIXMAP:
1802     case IMAGE_POINTER:
1803       return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance);
1804
1805     default:
1806       return Qnil;
1807     }
1808 }
1809
1810 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /*
1811 Return the Y coordinate of the image instance's hotspot, if known.
1812 This is a point relative to the origin of the pixmap.  When an image is
1813  used as a mouse pointer, the hotspot is the point on the image that sits
1814  over the location that the pointer points to.  This is, for example, the
1815  tip of the arrow or the center of the crosshairs.
1816 This will always be nil for a non-pointer image instance.
1817 */
1818        (image_instance))
1819 {
1820   CHECK_IMAGE_INSTANCE (image_instance);
1821   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1822
1823   switch (XIMAGE_INSTANCE_TYPE (image_instance))
1824     {
1825     case IMAGE_MONO_PIXMAP:
1826     case IMAGE_COLOR_PIXMAP:
1827     case IMAGE_POINTER:
1828       return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance);
1829
1830     default:
1831       return Qnil;
1832     }
1833 }
1834
1835 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /*
1836 Return the foreground color of IMAGE-INSTANCE, if applicable.
1837 This will be a color instance or nil. (It will only be non-nil for
1838 colorized mono pixmaps and for pointers.)
1839 */
1840        (image_instance))
1841 {
1842   CHECK_IMAGE_INSTANCE (image_instance);
1843   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1844
1845   switch (XIMAGE_INSTANCE_TYPE (image_instance))
1846     {
1847     case IMAGE_MONO_PIXMAP:
1848     case IMAGE_COLOR_PIXMAP:
1849     case IMAGE_POINTER:
1850       return XIMAGE_INSTANCE_PIXMAP_FG (image_instance);
1851
1852     case IMAGE_WIDGET:
1853       return FACE_FOREGROUND (
1854                               XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1855                               XIMAGE_INSTANCE_FRAME
1856                               (image_instance));
1857
1858     default:
1859       return Qnil;
1860     }
1861 }
1862
1863 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /*
1864 Return the background color of IMAGE-INSTANCE, if applicable.
1865 This will be a color instance or nil. (It will only be non-nil for
1866 colorized mono pixmaps and for pointers.)
1867 */
1868        (image_instance))
1869 {
1870   CHECK_IMAGE_INSTANCE (image_instance);
1871   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1872
1873   switch (XIMAGE_INSTANCE_TYPE (image_instance))
1874     {
1875     case IMAGE_MONO_PIXMAP:
1876     case IMAGE_COLOR_PIXMAP:
1877     case IMAGE_POINTER:
1878       return XIMAGE_INSTANCE_PIXMAP_BG (image_instance);
1879
1880     case IMAGE_WIDGET:
1881       return FACE_BACKGROUND (
1882                               XIMAGE_INSTANCE_WIDGET_FACE (image_instance),
1883                               XIMAGE_INSTANCE_FRAME
1884                               (image_instance));
1885
1886     default:
1887       return Qnil;
1888     }
1889 }
1890
1891
1892 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /*
1893 Make the image instance be displayed in the given colors.
1894 This function returns a new image instance that is exactly like the
1895 specified one except that (if possible) the foreground and background
1896 colors and as specified.  Currently, this only does anything if the image
1897 instance is a mono pixmap; otherwise, the same image instance is returned.
1898 */
1899        (image_instance, foreground, background))
1900 {
1901   Lisp_Object new;
1902   Lisp_Object device;
1903
1904   CHECK_IMAGE_INSTANCE (image_instance);
1905   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1906   CHECK_COLOR_INSTANCE (foreground);
1907   CHECK_COLOR_INSTANCE (background);
1908
1909   device = image_instance_device (image_instance);
1910   if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance))
1911     return image_instance;
1912
1913   /* #### There should be a copy_image_instance(), which calls a
1914      device-specific method to copy the window-system subobject. */
1915   new = allocate_image_instance (XIMAGE_INSTANCE_DOMAIN (image_instance),
1916                                  Qnil, Qnil);
1917   copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance));
1918   /* note that if this method returns non-zero, this method MUST
1919      copy any window-system resources, so that when one image instance is
1920      freed, the other one is not hosed. */
1921   if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground,
1922                                                             background)))
1923     return image_instance;
1924   return new;
1925 }
1926
1927
1928 /************************************************************************/
1929 /*                              Geometry calculations                   */
1930 /************************************************************************/
1931
1932 /* Find out desired geometry of the image instance. If there is no
1933    special function then just return the width and / or height. */
1934 void
1935 image_instance_query_geometry (Lisp_Object image_instance,
1936                                int* width, int* height,
1937                                enum image_instance_geometry disp,
1938                                Lisp_Object domain)
1939 {
1940   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1941   Lisp_Object type;
1942   struct image_instantiator_methods* meths;
1943   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1944
1945   type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
1946   meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
1947
1948   if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry))
1949     {
1950       IIFORMAT_METH (meths, query_geometry, (image_instance, width, height,
1951                                              disp, domain));
1952     }
1953   else
1954     {
1955       if (width)
1956         *width = IMAGE_INSTANCE_WIDTH (ii);
1957       if (height)
1958         *height = IMAGE_INSTANCE_HEIGHT (ii);
1959     }
1960 }
1961
1962 /* Layout the image instance using the provided dimensions. Layout
1963    widgets are going to do different kinds of calculations to
1964    determine what size to give things so we could make the layout
1965    function relatively simple to take account of that. An alternative
1966    approach is to consider separately the two cases, one where you
1967    don't mind what size you have (normal widgets) and one where you
1968    want to specify something (layout widgets). */
1969 void
1970 image_instance_layout (Lisp_Object image_instance,
1971                        int width, int height,
1972                        int xoffset, int yoffset,
1973                        Lisp_Object domain)
1974 {
1975   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance);
1976   Lisp_Object type;
1977   struct image_instantiator_methods* meths;
1978
1979   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
1980
1981   /* Nothing is as nothing does. */
1982   if (NOTHING_IMAGE_INSTANCEP (image_instance))
1983     return;
1984
1985   /* We don't want carefully calculated offsets to be mucked up by
1986      random layouts. */
1987   if (xoffset != IMAGE_UNCHANGED_GEOMETRY)
1988     XIMAGE_INSTANCE_XOFFSET (image_instance) = xoffset;
1989   if (yoffset != IMAGE_UNCHANGED_GEOMETRY)
1990     XIMAGE_INSTANCE_YOFFSET (image_instance) = yoffset;
1991
1992   assert (XIMAGE_INSTANCE_YOFFSET (image_instance) >= 0
1993           && XIMAGE_INSTANCE_XOFFSET (image_instance) >= 0);
1994
1995   /* If geometry is unspecified then get some reasonable values for it. */
1996   if (width == IMAGE_UNSPECIFIED_GEOMETRY
1997       ||
1998       height == IMAGE_UNSPECIFIED_GEOMETRY)
1999     {
2000       int dwidth = IMAGE_UNSPECIFIED_GEOMETRY;
2001       int dheight = IMAGE_UNSPECIFIED_GEOMETRY;
2002       /* Get the desired geometry. */
2003       image_instance_query_geometry (image_instance,
2004                                      &dwidth, &dheight,
2005                                      IMAGE_DESIRED_GEOMETRY,
2006                                      domain);
2007       /* Compare with allowed geometry. */
2008       if (width == IMAGE_UNSPECIFIED_GEOMETRY)
2009         width = dwidth;
2010       if (height == IMAGE_UNSPECIFIED_GEOMETRY)
2011         height = dheight;
2012     }
2013
2014   /* If we don't have sane values then we cannot layout at this point and
2015      must just return. */
2016   if (width == IMAGE_UNSPECIFIED_GEOMETRY
2017       ||
2018       height == IMAGE_UNSPECIFIED_GEOMETRY)
2019       return;
2020
2021   /* At this point width and height should contain sane values. Thus
2022      we set the glyph geometry and lay it out. */
2023   if (IMAGE_INSTANCE_WIDTH (ii) != width
2024       ||
2025       IMAGE_INSTANCE_HEIGHT (ii) != height)
2026     {
2027       IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
2028     }
2029
2030   IMAGE_INSTANCE_WIDTH (ii) = width;
2031   IMAGE_INSTANCE_HEIGHT (ii) = height;
2032
2033   type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
2034   meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
2035
2036   MAYBE_IIFORMAT_METH (meths, layout,
2037                        (image_instance, width, height, xoffset, yoffset,
2038                         domain));
2039   /* Do not clear the dirty flag here - redisplay will do this for
2040      us at the end. */
2041   IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0;
2042 }
2043
2044 /* Update an image instance from its changed instantiator. */
2045 static void
2046 update_image_instance (Lisp_Object image_instance,
2047                        Lisp_Object instantiator)
2048 {
2049   struct image_instantiator_methods* meths;
2050   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2051
2052   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
2053
2054   if (NOTHING_IMAGE_INSTANCEP (image_instance))
2055     return;
2056
2057   assert (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0)
2058           || (internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0)
2059            && internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, -10)));
2060
2061   /* If the instantiator is identical then do nothing. We must use
2062      equal here because the specifier code copies the instantiator. */
2063   if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0))
2064     {
2065       /* Extract the changed properties so that device / format
2066          methods only have to cope with these. We assume that
2067          normalization has already been done. */
2068       Lisp_Object diffs = find_instantiator_differences
2069         (instantiator,
2070          IMAGE_INSTANCE_INSTANTIATOR (ii));
2071       Lisp_Object type = encode_image_instance_type
2072         (IMAGE_INSTANCE_TYPE (ii));
2073       struct gcpro gcpro1;
2074       GCPRO1 (diffs);
2075
2076       /* try device specific methods first ... */
2077       meths = decode_device_ii_format (image_instance_device (image_instance),
2078                                        type, ERROR_ME_NOT);
2079       MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs));
2080       /* ... then format specific methods ... */
2081       meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
2082       MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs));
2083
2084       /* Instance and therefore glyph has changed so mark as dirty.
2085          If we don't do this output optimizations will assume the
2086          glyph is unchanged. */
2087       set_image_instance_dirty_p (image_instance, 1);
2088       /* Structure has changed. */
2089       IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
2090
2091       UNGCPRO;
2092     }
2093   /* We should now have a consistent instantiator so keep a record of
2094      it. It is important that we don't actually update the window
2095      system widgets here - we must do that when redisplay tells us
2096      to.
2097
2098      #### should we delay doing this until the display is up-to-date
2099      also? */
2100   IMAGE_INSTANCE_INSTANTIATOR (ii) = instantiator;
2101 }
2102
2103 /*
2104  * Mark image instance in W as dirty if (a) W's faces have changed and
2105  * (b) GLYPH_OR_II instance in W is a string.
2106  *
2107  * Return non-zero if instance has been marked dirty.
2108  */
2109 int
2110 invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w)
2111 {
2112   if (XFRAME(WINDOW_FRAME(w))->faces_changed)
2113     {
2114       Lisp_Object image = glyph_or_ii;
2115
2116       if (GLYPHP (glyph_or_ii))
2117         {
2118           Lisp_Object window;
2119           XSETWINDOW (window, w);
2120           image = glyph_image_instance (glyph_or_ii, window, ERROR_ME_NOT, 1);
2121         }
2122
2123       if (TEXT_IMAGE_INSTANCEP (image))
2124         {
2125           Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image);
2126           IMAGE_INSTANCE_DIRTYP (ii) = 1;
2127           IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
2128           if (GLYPHP (glyph_or_ii))
2129             XGLYPH_DIRTYP (glyph_or_ii) = 1;
2130           return 1;
2131         }
2132     }
2133
2134   return 0;
2135 }
2136
2137 \f
2138 /************************************************************************/
2139 /*                              error helpers                           */
2140 /************************************************************************/
2141 DOESNT_RETURN
2142 signal_image_error (const char *reason, Lisp_Object frob)
2143 {
2144   signal_error (Qimage_conversion_error,
2145                 list2 (build_translated_string (reason), frob));
2146 }
2147
2148 DOESNT_RETURN
2149 signal_image_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1)
2150 {
2151   signal_error (Qimage_conversion_error,
2152                 list3 (build_translated_string (reason), frob0, frob1));
2153 }
2154
2155 /****************************************************************************
2156  *                                  nothing                                 *
2157  ****************************************************************************/
2158
2159 static int
2160 nothing_possible_dest_types (void)
2161 {
2162   return IMAGE_NOTHING_MASK;
2163 }
2164
2165 static void
2166 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2167                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2168                      int dest_mask, Lisp_Object domain)
2169 {
2170   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2171
2172   if (dest_mask & IMAGE_NOTHING_MASK)
2173     {
2174       IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
2175       IMAGE_INSTANCE_HEIGHT (ii) = 0;
2176       IMAGE_INSTANCE_WIDTH (ii) = 0;
2177     }
2178   else
2179     incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
2180 }
2181
2182 \f
2183 /****************************************************************************
2184  *                                  inherit                                 *
2185  ****************************************************************************/
2186
2187 static void
2188 inherit_validate (Lisp_Object instantiator)
2189 {
2190   face_must_be_present (instantiator);
2191 }
2192
2193 static Lisp_Object
2194 inherit_normalize (Lisp_Object inst, Lisp_Object console_type,
2195                    Lisp_Object dest_mask)
2196 {
2197   Lisp_Object face;
2198
2199   assert (XVECTOR_LENGTH (inst) == 3);
2200   face = XVECTOR_DATA (inst)[2];
2201   if (!FACEP (face))
2202     inst = vector3 (Qinherit, Q_face, Fget_face (face));
2203   return inst;
2204 }
2205
2206 static int
2207 inherit_possible_dest_types (void)
2208 {
2209   return IMAGE_MONO_PIXMAP_MASK;
2210 }
2211
2212 static void
2213 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2214                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2215                      int dest_mask, Lisp_Object domain)
2216 {
2217   /* handled specially in image_instantiate */
2218   abort ();
2219 }
2220
2221 \f
2222 /****************************************************************************
2223  *                                  string                                  *
2224  ****************************************************************************/
2225
2226 static void
2227 string_validate (Lisp_Object instantiator)
2228 {
2229   data_must_be_present (instantiator);
2230 }
2231
2232 static int
2233 string_possible_dest_types (void)
2234 {
2235   return IMAGE_TEXT_MASK;
2236 }
2237
2238 /* Called from autodetect_instantiate() */
2239 void
2240 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2241                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2242                     int dest_mask, Lisp_Object domain)
2243 {
2244   Lisp_Object string = find_keyword_in_vector (instantiator, Q_data);
2245   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2246
2247   /* Should never get here with a domain other than a window. */
2248   assert (!NILP (string) && WINDOWP (DOMAIN_WINDOW (domain)));
2249   if (dest_mask & IMAGE_TEXT_MASK)
2250     {
2251       IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
2252       IMAGE_INSTANCE_TEXT_STRING (ii) = string;
2253     }
2254   else
2255     incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
2256 }
2257
2258 /* Sort out the size of the text that is being displayed. Calculating
2259    it dynamically allows us to change the text and still see
2260    everything. Note that the following methods are for text not string
2261    since that is what the instantiated type is. The first method is a
2262    helper that is used elsewhere for calculating text geometry. */
2263 void
2264 query_string_geometry (Lisp_Object string, Lisp_Object face,
2265                        int* width, int* height, int* descent, Lisp_Object domain)
2266 {
2267   struct font_metric_info fm;
2268   Charset_ID charsets[NUM_LEADING_BYTES];
2269   struct face_cachel frame_cachel;
2270   struct face_cachel *cachel;
2271   Lisp_Object frame = DOMAIN_FRAME (domain);
2272
2273   CHECK_STRING (string);
2274
2275   /* Compute height */
2276   if (height)
2277     {
2278       /* Compute string metric info */
2279       find_charsets_in_bufbyte_string (charsets,
2280                                        XSTRING_DATA   (string),
2281                                        XSTRING_LENGTH (string));
2282
2283       /* Fallback to the default face if none was provided. */
2284       if (!NILP (face))
2285         {
2286           reset_face_cachel (&frame_cachel);
2287           update_face_cachel_data (&frame_cachel, frame, face);
2288           cachel = &frame_cachel;
2289         }
2290       else
2291         {
2292           cachel = WINDOW_FACE_CACHEL (DOMAIN_XWINDOW (domain),
2293                                        DEFAULT_INDEX);
2294         }
2295
2296       ensure_face_cachel_complete (cachel, domain, charsets);
2297       face_cachel_charset_font_metric_info (cachel, charsets, &fm);
2298
2299       *height = fm.ascent + fm.descent;
2300       /* #### descent only gets set if we query the height as well. */
2301       if (descent)
2302         *descent = fm.descent;
2303     }
2304
2305   /* Compute width */
2306   if (width)
2307     {
2308       if (!NILP (face))
2309         *width = redisplay_frame_text_width_string (XFRAME (frame),
2310                                                     face,
2311                                                     0, string, 0, -1);
2312       else
2313         *width = redisplay_frame_text_width_string (XFRAME (frame),
2314                                                     Vdefault_face,
2315                                                     0, string, 0, -1);
2316     }
2317 }
2318
2319 Lisp_Object
2320 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain)
2321 {
2322   Charset_ID charsets[NUM_LEADING_BYTES];
2323   struct face_cachel frame_cachel;
2324   struct face_cachel *cachel;
2325   int i;
2326   Lisp_Object frame = DOMAIN_FRAME (domain);
2327
2328   /* Compute string font info */
2329   find_charsets_in_bufbyte_string (charsets,
2330                                    XSTRING_DATA   (string),
2331                                    XSTRING_LENGTH (string));
2332
2333   reset_face_cachel (&frame_cachel);
2334   update_face_cachel_data (&frame_cachel, frame, face);
2335   cachel = &frame_cachel;
2336
2337   ensure_face_cachel_complete (cachel, domain, charsets);
2338
2339   for (i = 0; i < NUM_LEADING_BYTES; i++)
2340     {
2341       if (charsets[i])
2342         {
2343           return FACE_CACHEL_FONT (cachel,
2344                                    CHARSET_BY_LEADING_BYTE (i +
2345                                                             MIN_LEADING_BYTE));
2346
2347         }
2348     }
2349
2350   return Qnil;                  /* NOT REACHED */
2351 }
2352
2353 static void
2354 text_query_geometry (Lisp_Object image_instance,
2355                      int* width, int* height,
2356                      enum image_instance_geometry disp, Lisp_Object domain)
2357 {
2358   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2359   int descent = 0;
2360
2361   query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii),
2362                          IMAGE_INSTANCE_FACE (ii),
2363                          width, height, &descent, domain);
2364
2365   /* The descent gets set as a side effect of querying the
2366      geometry. */
2367   IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent;
2368 }
2369
2370 /* set the properties of a string */
2371 static void
2372 text_update (Lisp_Object image_instance, Lisp_Object instantiator)
2373 {
2374   Lisp_Object val = find_keyword_in_vector (instantiator, Q_data);
2375
2376   if (!NILP (val))
2377     {
2378       CHECK_STRING (val);
2379       XIMAGE_INSTANCE_TEXT_STRING (image_instance) = val;
2380     }
2381 }
2382
2383 \f
2384 /****************************************************************************
2385  *                             formatted-string                             *
2386  ****************************************************************************/
2387
2388 static void
2389 formatted_string_validate (Lisp_Object instantiator)
2390 {
2391   data_must_be_present (instantiator);
2392 }
2393
2394 static int
2395 formatted_string_possible_dest_types (void)
2396 {
2397   return IMAGE_TEXT_MASK;
2398 }
2399
2400 static void
2401 formatted_string_instantiate (Lisp_Object image_instance,
2402                               Lisp_Object instantiator,
2403                               Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2404                               int dest_mask, Lisp_Object domain)
2405 {
2406   /* #### implement this */
2407   warn_when_safe (Qunimplemented, Qnotice,
2408                   "`formatted-string' not yet implemented; assuming `string'");
2409
2410   string_instantiate (image_instance, instantiator,
2411                       pointer_fg, pointer_bg, dest_mask, domain);
2412 }
2413
2414 \f
2415 /************************************************************************/
2416 /*                        pixmap file functions                         */
2417 /************************************************************************/
2418
2419 /* If INSTANTIATOR refers to inline data, return Qnil.
2420    If INSTANTIATOR refers to data in a file, return the full filename
2421    if it exists; otherwise, return a cons of (filename).
2422
2423    FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
2424    keywords used to look up the file and inline data,
2425    respectively, in the instantiator.  Normally these would
2426    be Q_file and Q_data, but might be different for mask data. */
2427
2428 Lisp_Object
2429 potential_pixmap_file_instantiator (Lisp_Object instantiator,
2430                                     Lisp_Object file_keyword,
2431                                     Lisp_Object data_keyword,
2432                                     Lisp_Object console_type)
2433 {
2434   Lisp_Object file;
2435   Lisp_Object data;
2436
2437   assert (VECTORP (instantiator));
2438
2439   data = find_keyword_in_vector (instantiator, data_keyword);
2440   file = find_keyword_in_vector (instantiator, file_keyword);
2441
2442   if (!NILP (file) && NILP (data))
2443     {
2444       Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
2445         (decode_console_type(console_type, ERROR_ME),
2446          locate_pixmap_file, (file));
2447
2448       if (!NILP (retval))
2449         return retval;
2450       else
2451         return Fcons (file, Qnil); /* should have been file */
2452     }
2453
2454   return Qnil;
2455 }
2456
2457 Lisp_Object
2458 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
2459                              Lisp_Object image_type_tag)
2460 {
2461   /* This function can call lisp */
2462   Lisp_Object file = Qnil;
2463   struct gcpro gcpro1, gcpro2;
2464   Lisp_Object alist = Qnil;
2465
2466   GCPRO2 (file, alist);
2467
2468   /* Now, convert any file data into inline data.  At the end of this,
2469      `data' will contain the inline data (if any) or Qnil, and `file'
2470      will contain the name this data was derived from (if known) or
2471      Qnil.
2472
2473      Note that if we cannot generate any regular inline data, we
2474      skip out. */
2475
2476   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2477                                              console_type);
2478
2479   if (CONSP (file)) /* failure locating filename */
2480     signal_double_file_error ("Opening pixmap file",
2481                               "no such file or directory",
2482                               Fcar (file));
2483
2484   if (NILP (file)) /* no conversion necessary */
2485     RETURN_UNGCPRO (inst);
2486
2487   alist = tagged_vector_to_alist (inst);
2488
2489   {
2490     Lisp_Object data = make_string_from_file (file);
2491     alist = remassq_no_quit (Q_file, alist);
2492     /* there can't be a :data at this point. */
2493     alist = Fcons (Fcons (Q_file, file),
2494                    Fcons (Fcons (Q_data, data), alist));
2495   }
2496
2497   {
2498     Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
2499     free_alist (alist);
2500     RETURN_UNGCPRO (result);
2501   }
2502 }
2503
2504 \f
2505 #ifdef HAVE_WINDOW_SYSTEM
2506 /**********************************************************************
2507  *                             XBM                                    *
2508  **********************************************************************/
2509
2510 /* Check if DATA represents a valid inline XBM spec (i.e. a list
2511    of (width height bits), with checking done on the dimensions).
2512    If not, signal an error. */
2513
2514 static void
2515 check_valid_xbm_inline (Lisp_Object data)
2516 {
2517   Lisp_Object width, height, bits;
2518
2519   if (!CONSP (data) ||
2520       !CONSP (XCDR (data)) ||
2521       !CONSP (XCDR (XCDR (data))) ||
2522       !NILP (XCDR (XCDR (XCDR (data)))))
2523     signal_simple_error ("Must be list of 3 elements", data);
2524
2525   width  = XCAR (data);
2526   height = XCAR (XCDR (data));
2527   bits   = XCAR (XCDR (XCDR (data)));
2528
2529   CHECK_STRING (bits);
2530
2531   if (!NATNUMP (width))
2532     signal_simple_error ("Width must be a natural number", width);
2533
2534   if (!NATNUMP (height))
2535     signal_simple_error ("Height must be a natural number", height);
2536
2537   if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
2538     signal_simple_error ("data is too short for width and height",
2539                          vector3 (width, height, bits));
2540 }
2541
2542 /* Validate method for XBM's. */
2543
2544 static void
2545 xbm_validate (Lisp_Object instantiator)
2546 {
2547   file_or_data_must_be_present (instantiator);
2548 }
2549
2550 /* Given a filename that is supposed to contain XBM data, return
2551    the inline representation of it as (width height bits).  Return
2552    the hotspot through XHOT and YHOT, if those pointers are not 0.
2553    If there is no hotspot, XHOT and YHOT will contain -1.
2554
2555    If the function fails:
2556
2557    -- if OK_IF_DATA_INVALID is set and the data was invalid,
2558       return Qt.
2559    -- maybe return an error, or return Qnil.
2560  */
2561
2562 #ifdef HAVE_X_WINDOWS
2563 #include <X11/Xlib.h>
2564 #else
2565 #define XFree(data) free(data)
2566 #endif
2567
2568 Lisp_Object
2569 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
2570                      int ok_if_data_invalid)
2571 {
2572   unsigned int w, h;
2573   Extbyte *data;
2574   int result;
2575   const char *filename_ext;
2576
2577   LISP_STRING_TO_EXTERNAL (name, filename_ext, Qfile_name);
2578   result = read_bitmap_data_from_file (filename_ext, &w, &h,
2579                                        (unsigned char **) &data, xhot, yhot);
2580
2581   if (result == BitmapSuccess)
2582     {
2583       Lisp_Object retval;
2584       int len = (w + 7) / 8 * h;
2585
2586       retval = list3 (make_int (w), make_int (h),
2587                       make_ext_string (data, len, Qbinary));
2588       XFree (data);
2589       return retval;
2590     }
2591
2592   switch (result)
2593     {
2594     case BitmapOpenFailed:
2595       {
2596         /* should never happen */
2597         signal_double_file_error ("Opening bitmap file",
2598                                   "no such file or directory",
2599                                   name);
2600       }
2601     case BitmapFileInvalid:
2602       {
2603         if (ok_if_data_invalid)
2604           return Qt;
2605         signal_double_file_error ("Reading bitmap file",
2606                                   "invalid data in file",
2607                                   name);
2608       }
2609     case BitmapNoMemory:
2610       {
2611         signal_double_file_error ("Reading bitmap file",
2612                                   "out of memory",
2613                                   name);
2614       }
2615     default:
2616       {
2617         signal_double_file_error_2 ("Reading bitmap file",
2618                                     "unknown error code",
2619                                     make_int (result), name);
2620       }
2621     }
2622
2623   return Qnil; /* not reached */
2624 }
2625
2626 Lisp_Object
2627 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2628                        Lisp_Object mask_file, Lisp_Object console_type)
2629 {
2630   /* This is unclean but it's fairly standard -- a number of the
2631      bitmaps in /usr/include/X11/bitmaps use it -- so we support
2632      it. */
2633   if (NILP (mask_file)
2634       /* don't override explicitly specified mask data. */
2635       && NILP (assq_no_quit (Q_mask_data, alist))
2636       && !NILP (file))
2637     {
2638       mask_file = MAYBE_LISP_CONTYPE_METH
2639         (decode_console_type(console_type, ERROR_ME),
2640          locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
2641       if (NILP (mask_file))
2642         mask_file = MAYBE_LISP_CONTYPE_METH
2643           (decode_console_type(console_type, ERROR_ME),
2644            locate_pixmap_file, (concat2 (file, build_string ("msk"))));
2645     }
2646
2647   if (!NILP (mask_file))
2648     {
2649       Lisp_Object mask_data =
2650         bitmap_to_lisp_data (mask_file, 0, 0, 0);
2651       alist = remassq_no_quit (Q_mask_file, alist);
2652       /* there can't be a :mask-data at this point. */
2653       alist = Fcons (Fcons (Q_mask_file, mask_file),
2654                      Fcons (Fcons (Q_mask_data, mask_data), alist));
2655     }
2656
2657   return alist;
2658 }
2659
2660 /* Normalize method for XBM's. */
2661
2662 static Lisp_Object
2663 xbm_normalize (Lisp_Object inst, Lisp_Object console_type,
2664                Lisp_Object dest_mask)
2665 {
2666   Lisp_Object file = Qnil, mask_file = Qnil;
2667   struct gcpro gcpro1, gcpro2, gcpro3;
2668   Lisp_Object alist = Qnil;
2669
2670   GCPRO3 (file, mask_file, alist);
2671
2672   /* Now, convert any file data into inline data for both the regular
2673      data and the mask data.  At the end of this, `data' will contain
2674      the inline data (if any) or Qnil, and `file' will contain
2675      the name this data was derived from (if known) or Qnil.
2676      Likewise for `mask_file' and `mask_data'.
2677
2678      Note that if we cannot generate any regular inline data, we
2679      skip out. */
2680
2681   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2682                                              console_type);
2683   mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2684                                                   Q_mask_data, console_type);
2685
2686   if (CONSP (file)) /* failure locating filename */
2687     signal_double_file_error ("Opening bitmap file",
2688                               "no such file or directory",
2689                               Fcar (file));
2690
2691   if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2692     RETURN_UNGCPRO (inst);
2693
2694   alist = tagged_vector_to_alist (inst);
2695
2696   if (!NILP (file))
2697     {
2698       int xhot, yhot;
2699       Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
2700       alist = remassq_no_quit (Q_file, alist);
2701       /* there can't be a :data at this point. */
2702       alist = Fcons (Fcons (Q_file, file),
2703                      Fcons (Fcons (Q_data, data), alist));
2704
2705       if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2706         alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2707                        alist);
2708       if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2709         alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2710                        alist);
2711     }
2712
2713   alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2714
2715   {
2716     Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2717     free_alist (alist);
2718     RETURN_UNGCPRO (result);
2719   }
2720 }
2721
2722 \f
2723 static int
2724 xbm_possible_dest_types (void)
2725 {
2726   return
2727     IMAGE_MONO_PIXMAP_MASK  |
2728     IMAGE_COLOR_PIXMAP_MASK |
2729     IMAGE_POINTER_MASK;
2730 }
2731
2732 #endif
2733
2734 \f
2735 #ifdef HAVE_XFACE
2736 /**********************************************************************
2737  *                             X-Face                                 *
2738  **********************************************************************/
2739
2740 static void
2741 xface_validate (Lisp_Object instantiator)
2742 {
2743   file_or_data_must_be_present (instantiator);
2744 }
2745
2746 static Lisp_Object
2747 xface_normalize (Lisp_Object inst, Lisp_Object console_type,
2748                  Lisp_Object dest_mask)
2749 {
2750   /* This function can call lisp */
2751   Lisp_Object file = Qnil, mask_file = Qnil;
2752   struct gcpro gcpro1, gcpro2, gcpro3;
2753   Lisp_Object alist = Qnil;
2754
2755   GCPRO3 (file, mask_file, alist);
2756
2757   /* Now, convert any file data into inline data for both the regular
2758      data and the mask data.  At the end of this, `data' will contain
2759      the inline data (if any) or Qnil, and `file' will contain
2760      the name this data was derived from (if known) or Qnil.
2761      Likewise for `mask_file' and `mask_data'.
2762
2763      Note that if we cannot generate any regular inline data, we
2764      skip out. */
2765
2766   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2767                                              console_type);
2768   mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2769                                                   Q_mask_data, console_type);
2770
2771   if (CONSP (file)) /* failure locating filename */
2772     signal_double_file_error ("Opening bitmap file",
2773                               "no such file or directory",
2774                               Fcar (file));
2775
2776   if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2777     RETURN_UNGCPRO (inst);
2778
2779   alist = tagged_vector_to_alist (inst);
2780
2781   {
2782     Lisp_Object data = make_string_from_file (file);
2783     alist = remassq_no_quit (Q_file, alist);
2784     /* there can't be a :data at this point. */
2785     alist = Fcons (Fcons (Q_file, file),
2786                    Fcons (Fcons (Q_data, data), alist));
2787   }
2788
2789   alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2790
2791   {
2792     Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2793     free_alist (alist);
2794     RETURN_UNGCPRO (result);
2795   }
2796 }
2797
2798 static int
2799 xface_possible_dest_types (void)
2800 {
2801   return
2802     IMAGE_MONO_PIXMAP_MASK  |
2803     IMAGE_COLOR_PIXMAP_MASK |
2804     IMAGE_POINTER_MASK;
2805 }
2806
2807 #endif /* HAVE_XFACE */
2808
2809 \f
2810 #ifdef HAVE_XPM
2811
2812 /**********************************************************************
2813  *                             XPM                                    *
2814  **********************************************************************/
2815
2816 #ifdef HAVE_GTK
2817 /* Gtk has to be gratuitously different, eh? */
2818 Lisp_Object
2819 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2820 {
2821   return (make_string_from_file (name));
2822 }
2823 #else
2824 Lisp_Object
2825 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2826 {
2827   char **data;
2828   int result;
2829   char *fname = 0;
2830
2831   LISP_STRING_TO_EXTERNAL (name, fname, Qfile_name);
2832   result = XpmReadFileToData (fname, &data);
2833
2834   if (result == XpmSuccess)
2835     {
2836       Lisp_Object retval = Qnil;
2837       struct buffer *old_buffer = current_buffer;
2838       Lisp_Object temp_buffer =
2839         Fget_buffer_create (build_string (" *pixmap conversion*"));
2840       int elt;
2841       int height, width, ncolors;
2842       struct gcpro gcpro1, gcpro2, gcpro3;
2843       int speccount = specpdl_depth ();
2844
2845       GCPRO3 (name, retval, temp_buffer);
2846
2847       specbind (Qinhibit_quit, Qt);
2848       set_buffer_internal (XBUFFER (temp_buffer));
2849       Ferase_buffer (Qnil);
2850
2851       buffer_insert_c_string (current_buffer, "/* XPM */\r");
2852       buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2853
2854       sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2855       for (elt = 0; elt <= width + ncolors; elt++)
2856         {
2857           buffer_insert_c_string (current_buffer, "\"");
2858           buffer_insert_c_string (current_buffer, data[elt]);
2859
2860           if (elt < width + ncolors)
2861             buffer_insert_c_string (current_buffer, "\",\r");
2862           else
2863             buffer_insert_c_string (current_buffer, "\"};\r");
2864         }
2865
2866       retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2867       XpmFree (data);
2868
2869       set_buffer_internal (old_buffer);
2870       unbind_to (speccount, Qnil);
2871
2872       RETURN_UNGCPRO (retval);
2873     }
2874
2875   switch (result)
2876     {
2877     case XpmFileInvalid:
2878       {
2879         if (ok_if_data_invalid)
2880           return Qt;
2881         signal_image_error ("invalid XPM data in file", name);
2882       }
2883     case XpmNoMemory:
2884       {
2885         signal_double_file_error ("Reading pixmap file",
2886                                   "out of memory", name);
2887       }
2888     case XpmOpenFailed:
2889       {
2890         /* should never happen? */
2891         signal_double_file_error ("Opening pixmap file",
2892                                   "no such file or directory", name);
2893       }
2894     default:
2895       {
2896         signal_double_file_error_2 ("Parsing pixmap file",
2897                                     "unknown error code",
2898                                     make_int (result), name);
2899         break;
2900       }
2901     }
2902
2903   return Qnil; /* not reached */
2904 }
2905 #endif /* !HAVE_GTK */
2906
2907 static void
2908 check_valid_xpm_color_symbols (Lisp_Object data)
2909 {
2910   Lisp_Object rest;
2911
2912   for (rest = data; !NILP (rest); rest = XCDR (rest))
2913     {
2914       if (!CONSP (rest) ||
2915           !CONSP (XCAR (rest)) ||
2916           !STRINGP (XCAR (XCAR (rest))) ||
2917           (!STRINGP (XCDR (XCAR (rest))) &&
2918            !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2919         signal_simple_error ("Invalid color symbol alist", data);
2920     }
2921 }
2922
2923 static void
2924 xpm_validate (Lisp_Object instantiator)
2925 {
2926   file_or_data_must_be_present (instantiator);
2927 }
2928
2929 Lisp_Object Vxpm_color_symbols;
2930
2931 Lisp_Object
2932 evaluate_xpm_color_symbols (void)
2933 {
2934   Lisp_Object rest, results = Qnil;
2935   struct gcpro gcpro1, gcpro2;
2936
2937   GCPRO2 (rest, results);
2938   for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2939     {
2940       Lisp_Object name, value, cons;
2941
2942       CHECK_CONS (rest);
2943       cons = XCAR (rest);
2944       CHECK_CONS (cons);
2945       name = XCAR (cons);
2946       CHECK_STRING (name);
2947       value = XCDR (cons);
2948       CHECK_CONS (value);
2949       value = XCAR (value);
2950       value = Feval (value);
2951       if (NILP (value))
2952         continue;
2953       if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2954         signal_simple_error
2955           ("Result from xpm-color-symbols eval must be nil, string, or color",
2956            value);
2957       results = Fcons (Fcons (name, value), results);
2958     }
2959   UNGCPRO;                      /* no more evaluation */
2960   return results;
2961 }
2962
2963 static Lisp_Object
2964 xpm_normalize (Lisp_Object inst, Lisp_Object console_type,
2965                Lisp_Object dest_mask)
2966 {
2967   Lisp_Object file = Qnil;
2968   Lisp_Object color_symbols;
2969   struct gcpro gcpro1, gcpro2;
2970   Lisp_Object alist = Qnil;
2971
2972   GCPRO2 (file, alist);
2973
2974   /* Now, convert any file data into inline data.  At the end of this,
2975      `data' will contain the inline data (if any) or Qnil, and
2976      `file' will contain the name this data was derived from (if
2977      known) or Qnil.
2978
2979      Note that if we cannot generate any regular inline data, we
2980      skip out. */
2981
2982   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2983                                              console_type);
2984
2985   if (CONSP (file)) /* failure locating filename */
2986     signal_double_file_error ("Opening pixmap file",
2987                               "no such file or directory",
2988                               Fcar (file));
2989
2990   color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2991                                                    Qunbound);
2992
2993   if (NILP (file) && !UNBOUNDP (color_symbols))
2994     /* no conversion necessary */
2995     RETURN_UNGCPRO (inst);
2996
2997   alist = tagged_vector_to_alist (inst);
2998
2999   if (!NILP (file))
3000     {
3001       Lisp_Object data = pixmap_to_lisp_data (file, 0);
3002       alist = remassq_no_quit (Q_file, alist);
3003       /* there can't be a :data at this point. */
3004       alist = Fcons (Fcons (Q_file, file),
3005                      Fcons (Fcons (Q_data, data), alist));
3006     }
3007
3008   if (UNBOUNDP (color_symbols))
3009     {
3010       color_symbols = evaluate_xpm_color_symbols ();
3011       alist = Fcons (Fcons (Q_color_symbols, color_symbols),
3012                      alist);
3013     }
3014
3015   {
3016     Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
3017     free_alist (alist);
3018     RETURN_UNGCPRO (result);
3019   }
3020 }
3021
3022 static int
3023 xpm_possible_dest_types (void)
3024 {
3025   return
3026     IMAGE_MONO_PIXMAP_MASK  |
3027     IMAGE_COLOR_PIXMAP_MASK |
3028     IMAGE_POINTER_MASK;
3029 }
3030
3031 #endif /* HAVE_XPM */
3032
3033 \f
3034 /****************************************************************************
3035  *                         Image Specifier Object                           *
3036  ****************************************************************************/
3037
3038 DEFINE_SPECIFIER_TYPE (image);
3039
3040 static void
3041 image_create (Lisp_Object obj)
3042 {
3043   Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3044
3045   IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
3046   IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
3047   IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
3048 }
3049
3050 static void
3051 image_mark (Lisp_Object obj)
3052 {
3053   Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3054
3055   mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
3056   mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
3057 }
3058
3059 static int
3060 instantiator_eq_equal (Lisp_Object obj1, Lisp_Object obj2)
3061 {
3062   if (EQ (obj1, obj2))
3063     return 1;
3064
3065   else if (CONSP (obj1) && CONSP (obj2))
3066     {
3067       return instantiator_eq_equal (XCAR (obj1), XCAR (obj2))
3068         &&
3069         instantiator_eq_equal (XCDR (obj1), XCDR (obj2));
3070     }
3071   return 0;
3072 }
3073
3074 static hashcode_t
3075 instantiator_eq_hash (Lisp_Object obj)
3076 {
3077   if (CONSP (obj))
3078     {
3079       /* no point in worrying about tail recursion, since we're not
3080          going very deep */
3081       return HASH2 (instantiator_eq_hash (XCAR (obj)),
3082                     instantiator_eq_hash (XCDR (obj)));
3083     }
3084   return LISP_HASH (obj);
3085 }
3086
3087 /* We need a special hash table for storing image instances. */
3088 Lisp_Object
3089 make_image_instance_cache_hash_table (void)
3090 {
3091   return make_general_lisp_hash_table
3092     (instantiator_eq_hash, instantiator_eq_equal,
3093      30, -1.0, -1.0,
3094      HASH_TABLE_KEY_CAR_VALUE_WEAK);
3095 }
3096
3097 static Lisp_Object
3098 image_instantiate_cache_result (Lisp_Object locative)
3099 {
3100   /* locative = (instance instantiator . subtable)
3101
3102      So we are using the instantiator as the key and the instance as
3103      the value. Since the hashtable is key-weak this means that the
3104      image instance will stay around as long as the instantiator stays
3105      around. The instantiator is stored in the `image' slot of the
3106      glyph, so as long as the glyph is marked the instantiator will be
3107      as well and hence the cached image instance also.*/
3108   Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
3109   free_cons (XCONS (XCDR (locative)));
3110   free_cons (XCONS (locative));
3111   return Qnil;
3112 }
3113
3114 /* Given a specification for an image, return an instance of
3115    the image which matches the given instantiator and which can be
3116    displayed in the given domain. */
3117
3118 static Lisp_Object
3119 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
3120                    Lisp_Object domain, Lisp_Object instantiator,
3121                    Lisp_Object depth)
3122 {
3123   Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
3124   int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
3125   int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
3126
3127   if (IMAGE_INSTANCEP (instantiator))
3128     {
3129       /* make sure that the image instance's governing domain and type are
3130          matching. */
3131       Lisp_Object governing_domain = XIMAGE_INSTANCE_DOMAIN (instantiator);
3132
3133       if ((DEVICEP (governing_domain)
3134            && EQ (governing_domain, DOMAIN_DEVICE (domain)))
3135           || (FRAMEP (governing_domain)
3136               && EQ (governing_domain, DOMAIN_FRAME (domain)))
3137           || (WINDOWP (governing_domain)
3138               && EQ (governing_domain, DOMAIN_WINDOW (domain))))
3139         {
3140           int mask =
3141             image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
3142           if (mask & dest_mask)
3143             return instantiator;
3144           else
3145             signal_simple_error ("Type of image instance not allowed here",
3146                                  instantiator);
3147         }
3148       else
3149         signal_simple_error_2 ("Wrong domain for image instance",
3150                                instantiator, domain);
3151     }
3152   /* How ugly !! An image instanciator that uses a kludgy syntax to snarf in
3153      face properties. There's a design flaw here. -- didier */
3154   else if (VECTORP (instantiator)
3155            && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit))
3156     {
3157       assert (XVECTOR_LENGTH (instantiator) == 3);
3158       return (FACE_PROPERTY_INSTANCE
3159               (Fget_face (XVECTOR_DATA (instantiator)[2]),
3160                Qbackground_pixmap, domain, 1, depth));
3161     }
3162   else
3163     {
3164       Lisp_Object instance = Qnil;
3165       Lisp_Object subtable = Qnil;
3166       /* #### Should this be GCPRO'd? */
3167       Lisp_Object hash_key = Qnil;
3168       Lisp_Object pointer_fg = Qnil;
3169       Lisp_Object pointer_bg = Qnil;
3170       Lisp_Object governing_domain =
3171         get_image_instantiator_governing_domain (instantiator, domain);
3172       struct gcpro gcpro1;
3173
3174       GCPRO1 (instance);
3175
3176       /* We have to put subwindow, widget and text image instances in
3177          a per-window cache so that we can see the same glyph in
3178          different windows. We use governing_domain to determine the type
3179          of image_instance that will be created. */
3180
3181       if (pointerp)
3182         {
3183           pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
3184           pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
3185           hash_key = list4 (glyph, INSTANTIATOR_TYPE (instantiator),
3186                             pointer_fg, pointer_bg);
3187         }
3188       else
3189         /* We cannot simply key on the glyph since fallbacks could use
3190            the same glyph but have a totally different instantiator
3191            type. Thus we key on the glyph and the type (but not any
3192            other parts of the instantiator. */
3193         hash_key = list2 (glyph, INSTANTIATOR_TYPE (instantiator));
3194
3195       /* First look in the device cache. */
3196       if (DEVICEP (governing_domain))
3197         {
3198           subtable = Fgethash (make_int (dest_mask),
3199                                XDEVICE (governing_domain)->
3200                                image_instance_cache,
3201                                Qunbound);
3202           if (UNBOUNDP (subtable))
3203             {
3204               /* For the image instance cache, we do comparisons with
3205                  EQ rather than with EQUAL, as we do for color and
3206                  font names.  The reasons are:
3207
3208                  1) pixmap data can be very long, and thus the hashing
3209                  and comparing will take awhile.
3210
3211                  2) It's not so likely that we'll run into things that
3212                  are EQUAL but not EQ (that can happen a lot with
3213                  faces, because their specifiers are copied around);
3214                  but pixmaps tend not to be in faces.
3215
3216                  However, if the image-instance could be a pointer, we
3217                  have to use EQUAL because we massaged the
3218                  instantiator into a cons3 also containing the
3219                  foreground and background of the pointer face.  */
3220               subtable = make_image_instance_cache_hash_table ();
3221
3222               Fputhash (make_int (dest_mask), subtable,
3223                         XDEVICE (governing_domain)->image_instance_cache);
3224               instance = Qunbound;
3225             }
3226           else
3227             {
3228               instance = Fgethash (hash_key, subtable, Qunbound);
3229             }
3230         }
3231       else if (WINDOWP (governing_domain))
3232         {
3233           /* Subwindows have a per-window cache and have to be treated
3234              differently. */
3235           instance =
3236             Fgethash (hash_key,
3237                       XWINDOW (governing_domain)->subwindow_instance_cache,
3238                       Qunbound);
3239         }
3240       else
3241         abort ();       /* We're not allowed anything else currently. */
3242
3243       /* If we don't have an instance at this point then create
3244          one. */
3245       if (UNBOUNDP (instance))
3246         {
3247           Lisp_Object locative =
3248             noseeum_cons (Qnil,
3249                           noseeum_cons (hash_key,
3250                                         DEVICEP (governing_domain) ? subtable
3251                                         : XWINDOW (governing_domain)
3252                                         ->subwindow_instance_cache));
3253           int speccount = specpdl_depth ();
3254
3255           /* Make sure we cache the failures, too.  Use an
3256              unwind-protect to catch such errors.  If we fail, the
3257              unwind-protect records nil in the hash table.  If we
3258              succeed, we change the car of the locative to the
3259              resulting instance, which gets recorded instead. */
3260           record_unwind_protect (image_instantiate_cache_result,
3261                                  locative);
3262           instance =
3263             instantiate_image_instantiator (governing_domain,
3264                                             domain, instantiator,
3265                                             pointer_fg, pointer_bg,
3266                                             dest_mask, glyph);
3267
3268           /* We need a per-frame cache for redisplay. */
3269           cache_subwindow_instance_in_frame_maybe (instance);
3270
3271           Fsetcar (locative, instance);
3272 #ifdef ERROR_CHECK_GLYPHS
3273           if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
3274               & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
3275               assert (EQ (XIMAGE_INSTANCE_FRAME (instance),
3276                           DOMAIN_FRAME (domain)));
3277 #endif
3278           unbind_to (speccount, Qnil);
3279 #ifdef ERROR_CHECK_GLYPHS
3280           if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
3281               & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
3282             assert (EQ (Fgethash (hash_key,
3283                                   XWINDOW (governing_domain)
3284                                   ->subwindow_instance_cache,
3285                                   Qunbound), instance));
3286 #endif
3287         }
3288       else if (NILP (instance))
3289         signal_simple_error ("Can't instantiate image (probably cached)",
3290                              instantiator);
3291       /* We found an instance. However, because we are using the glyph
3292          as the hash key instead of the instantiator, the current
3293          instantiator may not be the same as the original. Thus we
3294          must update the instance based on the new
3295          instantiator. Preserving instance identity like this is
3296          important to stop excessive window system widget creation and
3297          deletion - and hence flashing. */
3298       else
3299         {
3300           /* #### This function should be able to cope with *all*
3301              changes to the instantiator, but currently only copes
3302              with the most used properties. This means that it is
3303              possible to make changes that don't get reflected in the
3304              display. */
3305           update_image_instance (instance, instantiator);
3306           free_list (hash_key);
3307         }
3308
3309 #ifdef ERROR_CHECK_GLYPHS
3310       if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
3311           & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
3312         assert (EQ (XIMAGE_INSTANCE_FRAME (instance),
3313                     DOMAIN_FRAME (domain)));
3314 #endif
3315       ERROR_CHECK_IMAGE_INSTANCE (instance);
3316       RETURN_UNGCPRO (instance);
3317     }
3318
3319   abort ();
3320   return Qnil; /* not reached */
3321 }
3322
3323 /* Validate an image instantiator. */
3324
3325 static void
3326 image_validate (Lisp_Object instantiator)
3327 {
3328   if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
3329     return;
3330   else if (VECTORP (instantiator))
3331     {
3332       Lisp_Object *elt = XVECTOR_DATA (instantiator);
3333       int instantiator_len = XVECTOR_LENGTH (instantiator);
3334       struct image_instantiator_methods *meths;
3335       Lisp_Object already_seen = Qnil;
3336       struct gcpro gcpro1;
3337       int i;
3338
3339       if (instantiator_len < 1)
3340         signal_simple_error ("Vector length must be at least 1",
3341                              instantiator);
3342
3343       meths = decode_image_instantiator_format (elt[0], ERROR_ME);
3344       if (!(instantiator_len & 1))
3345         signal_simple_error
3346           ("Must have alternating keyword/value pairs", instantiator);
3347
3348       GCPRO1 (already_seen);
3349
3350       for (i = 1; i < instantiator_len; i += 2)
3351         {
3352           Lisp_Object keyword = elt[i];
3353           Lisp_Object value = elt[i+1];
3354           int j;
3355
3356           CHECK_SYMBOL (keyword);
3357           if (!SYMBOL_IS_KEYWORD (keyword))
3358             signal_simple_error ("Symbol must begin with a colon", keyword);
3359
3360           for (j = 0; j < Dynarr_length (meths->keywords); j++)
3361             if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
3362               break;
3363
3364           if (j == Dynarr_length (meths->keywords))
3365             signal_simple_error ("Unrecognized keyword", keyword);
3366
3367           if (!Dynarr_at (meths->keywords, j).multiple_p)
3368             {
3369               if (!NILP (memq_no_quit (keyword, already_seen)))
3370                 signal_simple_error
3371                   ("Keyword may not appear more than once", keyword);
3372               already_seen = Fcons (keyword, already_seen);
3373             }
3374
3375           (Dynarr_at (meths->keywords, j).validate) (value);
3376         }
3377
3378       UNGCPRO;
3379
3380       MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
3381     }
3382   else
3383     signal_simple_error ("Must be string or vector", instantiator);
3384 }
3385
3386 static void
3387 image_after_change (Lisp_Object specifier, Lisp_Object locale)
3388 {
3389   Lisp_Object attachee =
3390     IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
3391   Lisp_Object property =
3392     IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
3393   if (FACEP (attachee))
3394     {
3395       face_property_was_changed (attachee, property, locale);
3396       if (BUFFERP (locale))
3397         XBUFFER (locale)->buffer_local_face_property = 1;
3398     }
3399   else if (GLYPHP (attachee))
3400     glyph_property_was_changed (attachee, property, locale);
3401 }
3402
3403 void
3404 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
3405                        Lisp_Object property)
3406 {
3407   Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3408
3409   IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
3410   IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
3411 }
3412
3413 static Lisp_Object
3414 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
3415                     Lisp_Object tag_set, Lisp_Object instantiator)
3416 {
3417   Lisp_Object possible_console_types = Qnil;
3418   Lisp_Object rest;
3419   Lisp_Object retlist = Qnil;
3420   struct gcpro gcpro1, gcpro2;
3421
3422   LIST_LOOP (rest, Vconsole_type_list)
3423     {
3424       Lisp_Object contype = XCAR (rest);
3425       if (!NILP (memq_no_quit (contype, tag_set)))
3426         possible_console_types = Fcons (contype, possible_console_types);
3427     }
3428
3429   if (XINT (Flength (possible_console_types)) > 1)
3430     /* two conflicting console types specified */
3431     return Qnil;
3432
3433   if (NILP (possible_console_types))
3434     possible_console_types = Vconsole_type_list;
3435
3436   GCPRO2 (retlist, possible_console_types);
3437
3438   LIST_LOOP (rest, possible_console_types)
3439     {
3440       Lisp_Object contype = XCAR (rest);
3441       Lisp_Object newinst = call_with_suspended_errors
3442         ((lisp_fn_t) normalize_image_instantiator,
3443          Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
3444          make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
3445
3446       if (!NILP (newinst))
3447         {
3448           Lisp_Object newtag;
3449           if (NILP (memq_no_quit (contype, tag_set)))
3450             newtag = Fcons (contype, tag_set);
3451           else
3452             newtag = tag_set;
3453           retlist = Fcons (Fcons (newtag, newinst), retlist);
3454         }
3455     }
3456
3457   UNGCPRO;
3458
3459   return retlist;
3460 }
3461
3462 /* Copy an image instantiator. We can't use Fcopy_tree since widgets
3463    may contain circular references which would send Fcopy_tree into
3464    infloop death. */
3465 static Lisp_Object
3466 image_copy_vector_instantiator (Lisp_Object instantiator)
3467 {
3468   int i;
3469   struct image_instantiator_methods *meths;
3470   Lisp_Object *elt;
3471   int instantiator_len;
3472
3473   CHECK_VECTOR (instantiator);
3474
3475   instantiator = Fcopy_sequence (instantiator);
3476   elt = XVECTOR_DATA (instantiator);
3477   instantiator_len = XVECTOR_LENGTH (instantiator);
3478
3479   meths = decode_image_instantiator_format (elt[0], ERROR_ME);
3480
3481   for (i = 1; i < instantiator_len; i += 2)
3482     {
3483       int j;
3484       Lisp_Object keyword = elt[i];
3485       Lisp_Object value = elt[i+1];
3486
3487       /* Find the keyword entry. */
3488       for (j = 0; j < Dynarr_length (meths->keywords); j++)
3489         {
3490           if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
3491             break;
3492         }
3493
3494       /* Only copy keyword values that should be copied. */
3495       if (Dynarr_at (meths->keywords, j).copy_p
3496           &&
3497           (CONSP (value) || VECTORP (value)))
3498         {
3499           elt [i+1] = Fcopy_tree (value, Qt);
3500         }
3501     }
3502
3503   return instantiator;
3504 }
3505
3506 static Lisp_Object
3507 image_copy_instantiator (Lisp_Object arg)
3508 {
3509   if (CONSP (arg))
3510     {
3511       Lisp_Object rest;
3512       rest = arg = Fcopy_sequence (arg);
3513       while (CONSP (rest))
3514         {
3515           Lisp_Object elt = XCAR (rest);
3516           if (CONSP (elt))
3517             XCAR (rest) = Fcopy_tree (elt, Qt);
3518           else if (VECTORP (elt))
3519             XCAR (rest) = image_copy_vector_instantiator (elt);
3520           if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
3521             XCDR (rest) = Fcopy_tree (XCDR (rest), Qt);
3522           rest = XCDR (rest);
3523         }
3524     }
3525   else if (VECTORP (arg))
3526     {
3527       arg = image_copy_vector_instantiator (arg);
3528     }
3529   return arg;
3530 }
3531
3532 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
3533 Return non-nil if OBJECT is an image specifier.
3534 See `make-image-specifier' for a description of image instantiators.
3535 */
3536        (object))
3537 {
3538   return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
3539 }
3540
3541 \f
3542 /****************************************************************************
3543  *                             Glyph Object                                 *
3544  ****************************************************************************/
3545
3546 static Lisp_Object
3547 mark_glyph (Lisp_Object obj)
3548 {
3549   Lisp_Glyph *glyph = XGLYPH (obj);
3550
3551   mark_object (glyph->image);
3552   mark_object (glyph->contrib_p);
3553   mark_object (glyph->baseline);
3554   mark_object (glyph->face);
3555
3556   return glyph->plist;
3557 }
3558
3559 static void
3560 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3561 {
3562   Lisp_Glyph *glyph = XGLYPH (obj);
3563   char buf[20];
3564
3565   if (print_readably)
3566     error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
3567
3568   write_c_string ("#<glyph (", printcharfun);
3569   print_internal (Fglyph_type (obj), printcharfun, 0);
3570   write_c_string (") ", printcharfun);
3571   print_internal (glyph->image, printcharfun, 1);
3572   sprintf (buf, "0x%x>", glyph->header.uid);
3573   write_c_string (buf, printcharfun);
3574 }
3575
3576 /* Glyphs are equal if all of their display attributes are equal.  We
3577    don't compare names or doc-strings, because that would make equal
3578    be eq.
3579
3580    This isn't concerned with "unspecified" attributes, that's what
3581    #'glyph-differs-from-default-p is for. */
3582 static int
3583 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3584 {
3585   Lisp_Glyph *g1 = XGLYPH (obj1);
3586   Lisp_Glyph *g2 = XGLYPH (obj2);
3587
3588   depth++;
3589
3590   return (internal_equal (g1->image,     g2->image,     depth) &&
3591           internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
3592           internal_equal (g1->baseline,  g2->baseline,  depth) &&
3593           internal_equal (g1->face,      g2->face,      depth) &&
3594           !plists_differ (g1->plist,     g2->plist, 0, 0, depth + 1));
3595 }
3596
3597 static unsigned long
3598 glyph_hash (Lisp_Object obj, int depth)
3599 {
3600   depth++;
3601
3602   /* No need to hash all of the elements; that would take too long.
3603      Just hash the most common ones. */
3604   return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
3605                 internal_hash (XGLYPH (obj)->face,  depth));
3606 }
3607
3608 static Lisp_Object
3609 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
3610 {
3611   Lisp_Glyph *g = XGLYPH (obj);
3612
3613   if (EQ (prop, Qimage))     return g->image;
3614   if (EQ (prop, Qcontrib_p)) return g->contrib_p;
3615   if (EQ (prop, Qbaseline))  return g->baseline;
3616   if (EQ (prop, Qface))      return g->face;
3617
3618   return external_plist_get (&g->plist, prop, 0, ERROR_ME);
3619 }
3620
3621 static int
3622 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3623 {
3624   if (EQ (prop, Qimage)     ||
3625       EQ (prop, Qcontrib_p) ||
3626       EQ (prop, Qbaseline))
3627     return 0;
3628
3629   if (EQ (prop, Qface))
3630     {
3631       XGLYPH (obj)->face = Fget_face (value);
3632       return 1;
3633     }
3634
3635   external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
3636   return 1;
3637 }
3638
3639 static int
3640 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
3641 {
3642   if (EQ (prop, Qimage)     ||
3643       EQ (prop, Qcontrib_p) ||
3644       EQ (prop, Qbaseline))
3645     return -1;
3646
3647   if (EQ (prop, Qface))
3648     {
3649       XGLYPH (obj)->face = Qnil;
3650       return 1;
3651     }
3652
3653   return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
3654 }
3655
3656 static Lisp_Object
3657 glyph_plist (Lisp_Object obj)
3658 {
3659   Lisp_Glyph *glyph = XGLYPH (obj);
3660   Lisp_Object result = glyph->plist;
3661
3662   result = cons3 (Qface,      glyph->face,      result);
3663   result = cons3 (Qbaseline,  glyph->baseline,  result);
3664   result = cons3 (Qcontrib_p, glyph->contrib_p, result);
3665   result = cons3 (Qimage,     glyph->image,     result);
3666
3667   return result;
3668 }
3669
3670 static const struct lrecord_description glyph_description[] = {
3671   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) },
3672   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) },
3673   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) },
3674   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) },
3675   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) },
3676   { XD_END }
3677 };
3678
3679 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
3680                                           mark_glyph, print_glyph, 0,
3681                                           glyph_equal, glyph_hash, glyph_description,
3682                                           glyph_getprop, glyph_putprop,
3683                                           glyph_remprop, glyph_plist,
3684                                           Lisp_Glyph);
3685 \f
3686 Lisp_Object
3687 allocate_glyph (enum glyph_type type,
3688                 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
3689                                       Lisp_Object locale))
3690 {
3691   /* This function can GC */
3692   Lisp_Object obj = Qnil;
3693   Lisp_Glyph *g = alloc_lcrecord_type (Lisp_Glyph, &lrecord_glyph);
3694
3695   g->type = type;
3696   g->image = Fmake_specifier (Qimage); /* This function can GC */
3697   g->dirty = 0;
3698   switch (g->type)
3699     {
3700     case GLYPH_BUFFER:
3701       XIMAGE_SPECIFIER_ALLOWED (g->image) =
3702         IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
3703         | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
3704         | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK;
3705       break;
3706     case GLYPH_POINTER:
3707       XIMAGE_SPECIFIER_ALLOWED (g->image) =
3708         IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
3709       break;
3710     case GLYPH_ICON:
3711       XIMAGE_SPECIFIER_ALLOWED (g->image) =
3712         IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK
3713         | IMAGE_COLOR_PIXMAP_MASK;
3714       break;
3715     default:
3716       abort ();
3717     }
3718
3719   /* I think Fmake_specifier can GC.  I think set_specifier_fallback can GC. */
3720   /* We're getting enough reports of odd behavior in this area it seems */
3721   /* best to GCPRO everything. */
3722   {
3723     Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3724     Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3725     Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3726     struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3727
3728     GCPRO4 (obj, tem1, tem2, tem3);
3729
3730     set_specifier_fallback (g->image, tem1);
3731     g->contrib_p = Fmake_specifier (Qboolean);
3732     set_specifier_fallback (g->contrib_p, tem2);
3733     /* #### should have a specifier for the following */
3734     g->baseline = Fmake_specifier (Qgeneric);
3735     set_specifier_fallback (g->baseline, tem3);
3736     g->face = Qnil;
3737     g->plist = Qnil;
3738     g->after_change = after_change;
3739     XSETGLYPH (obj, g);
3740
3741     set_image_attached_to (g->image, obj, Qimage);
3742     UNGCPRO;
3743   }
3744
3745   return obj;
3746 }
3747
3748 static enum glyph_type
3749 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3750 {
3751   if (NILP (type))
3752     return GLYPH_BUFFER;
3753
3754   if (ERRB_EQ (errb, ERROR_ME))
3755     CHECK_SYMBOL (type);
3756
3757   if (EQ (type, Qbuffer))  return GLYPH_BUFFER;
3758   if (EQ (type, Qpointer)) return GLYPH_POINTER;
3759   if (EQ (type, Qicon))    return GLYPH_ICON;
3760
3761   maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3762
3763   return GLYPH_UNKNOWN;
3764 }
3765
3766 static int
3767 valid_glyph_type_p (Lisp_Object type)
3768 {
3769   return !NILP (memq_no_quit (type, Vglyph_type_list));
3770 }
3771
3772 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3773 Given a GLYPH-TYPE, return non-nil if it is valid.
3774 Valid types are `buffer', `pointer', and `icon'.
3775 */
3776        (glyph_type))
3777 {
3778   return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3779 }
3780
3781 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3782 Return a list of valid glyph types.
3783 */
3784        ())
3785 {
3786   return Fcopy_sequence (Vglyph_type_list);
3787 }
3788
3789 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3790 Create and return a new uninitialized glyph of type TYPE.
3791
3792 TYPE specifies the type of the glyph; this should be one of `buffer',
3793 `pointer', or `icon', and defaults to `buffer'.  The type of the glyph
3794 specifies in which contexts the glyph can be used, and controls the
3795 allowable image types into which the glyph's image can be
3796 instantiated.
3797
3798 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3799 extent, in the modeline, and in the toolbar.  Their image can be
3800 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3801 and `subwindow'.
3802
3803 `pointer' glyphs can be used to specify the mouse pointer.  Their
3804 image can be instantiated as `pointer'.
3805
3806 `icon' glyphs can be used to specify the icon used when a frame is
3807 iconified.  Their image can be instantiated as `mono-pixmap' and
3808 `color-pixmap'.
3809 */
3810        (type))
3811 {
3812   enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3813   return allocate_glyph (typeval, 0);
3814 }
3815
3816 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3817 Return non-nil if OBJECT is a glyph.
3818
3819 A glyph is an object used for pixmaps, widgets and the like.  It is used
3820 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3821 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3822 buttons, and the like.  Much more detailed information can be found at
3823 `make-glyph'.  Its image is described using an image specifier --
3824 see `make-image-specifier'.  See also `make-image-instance' for further
3825 information.
3826 */
3827        (object))
3828 {
3829   return GLYPHP (object) ? Qt : Qnil;
3830 }
3831
3832 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3833 Return the type of the given glyph.
3834 The return value will be one of 'buffer, 'pointer, or 'icon.
3835 */
3836        (glyph))
3837 {
3838   CHECK_GLYPH (glyph);
3839   switch (XGLYPH_TYPE (glyph))
3840     {
3841     default: abort ();
3842     case GLYPH_BUFFER:  return Qbuffer;
3843     case GLYPH_POINTER: return Qpointer;
3844     case GLYPH_ICON:    return Qicon;
3845     }
3846 }
3847
3848 Lisp_Object
3849 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3850                       Error_behavior errb, int no_quit)
3851 {
3852   Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3853
3854   /* This can never return Qunbound.  All glyphs have 'nothing as
3855      a fallback. */
3856   Lisp_Object image_instance = specifier_instance (specifier, Qunbound,
3857                                                    domain, errb, no_quit, 0,
3858                                                    Qzero);
3859   assert (!UNBOUNDP (image_instance));
3860   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
3861
3862   return image_instance;
3863 }
3864
3865 static Lisp_Object
3866 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window)
3867 {
3868   Lisp_Object instance = glyph_or_image;
3869
3870   if (GLYPHP (glyph_or_image))
3871     instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3872
3873   return instance;
3874 }
3875
3876 /*****************************************************************************
3877  glyph_width
3878
3879  Return the width of the given GLYPH on the given WINDOW.
3880  Calculations are done based on recursively querying the geometry of
3881  the associated image instances.
3882  ****************************************************************************/
3883 unsigned short
3884 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain)
3885 {
3886   Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3887                                                      domain);
3888   if (!IMAGE_INSTANCEP (instance))
3889     return 0;
3890
3891   if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3892     image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3893                            IMAGE_UNSPECIFIED_GEOMETRY,
3894                            IMAGE_UNCHANGED_GEOMETRY,
3895                            IMAGE_UNCHANGED_GEOMETRY, domain);
3896
3897   return XIMAGE_INSTANCE_WIDTH (instance);
3898 }
3899
3900 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3901 Return the width of GLYPH on WINDOW.
3902 This may not be exact as it does not take into account all of the context
3903 that redisplay will.
3904 */
3905        (glyph, window))
3906 {
3907   XSETWINDOW (window, decode_window (window));
3908   CHECK_GLYPH (glyph);
3909
3910   return make_int (glyph_width (glyph, window));
3911 }
3912
3913 unsigned short
3914 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain)
3915 {
3916   Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3917                                                      domain);
3918   if (!IMAGE_INSTANCEP (instance))
3919     return 0;
3920
3921   if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3922     image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3923                            IMAGE_UNSPECIFIED_GEOMETRY,
3924                            IMAGE_UNCHANGED_GEOMETRY,
3925                            IMAGE_UNCHANGED_GEOMETRY, domain);
3926
3927   if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3928     return XIMAGE_INSTANCE_TEXT_ASCENT (instance);
3929   else
3930     return XIMAGE_INSTANCE_HEIGHT (instance);
3931 }
3932
3933 unsigned short
3934 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain)
3935 {
3936   Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3937                                                      domain);
3938   if (!IMAGE_INSTANCEP (instance))
3939     return 0;
3940
3941   if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3942     image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3943                            IMAGE_UNSPECIFIED_GEOMETRY,
3944                            IMAGE_UNCHANGED_GEOMETRY,
3945                            IMAGE_UNCHANGED_GEOMETRY, domain);
3946
3947   if (XIMAGE_INSTANCE_TYPE (instance) ==  IMAGE_TEXT)
3948     return XIMAGE_INSTANCE_TEXT_DESCENT (instance);
3949   else
3950     return 0;
3951 }
3952
3953 /* strictly a convenience function. */
3954 unsigned short
3955 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain)
3956 {
3957   Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3958                                                      domain);
3959
3960   if (!IMAGE_INSTANCEP (instance))
3961     return 0;
3962
3963   if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3964     image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3965                            IMAGE_UNSPECIFIED_GEOMETRY,
3966                            IMAGE_UNCHANGED_GEOMETRY,
3967                            IMAGE_UNCHANGED_GEOMETRY, domain);
3968
3969   return XIMAGE_INSTANCE_HEIGHT (instance);
3970 }
3971
3972 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3973 Return the ascent value of GLYPH on WINDOW.
3974 This may not be exact as it does not take into account all of the context
3975 that redisplay will.
3976 */
3977        (glyph, window))
3978 {
3979   XSETWINDOW (window, decode_window (window));
3980   CHECK_GLYPH (glyph);
3981
3982   return make_int (glyph_ascent (glyph, window));
3983 }
3984
3985 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3986 Return the descent value of GLYPH on WINDOW.
3987 This may not be exact as it does not take into account all of the context
3988 that redisplay will.
3989 */
3990        (glyph, window))
3991 {
3992   XSETWINDOW (window, decode_window (window));
3993   CHECK_GLYPH (glyph);
3994
3995   return make_int (glyph_descent (glyph, window));
3996 }
3997
3998 /* This is redundant but I bet a lot of people expect it to exist. */
3999 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
4000 Return the height of GLYPH on WINDOW.
4001 This may not be exact as it does not take into account all of the context
4002 that redisplay will.
4003 */
4004        (glyph, window))
4005 {
4006   XSETWINDOW (window, decode_window (window));
4007   CHECK_GLYPH (glyph);
4008
4009   return make_int (glyph_height (glyph, window));
4010 }
4011
4012 static void
4013 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty)
4014 {
4015   Lisp_Object instance = glyph_or_image;
4016
4017   if (!NILP (glyph_or_image))
4018     {
4019       if (GLYPHP (glyph_or_image))
4020         {
4021           instance = glyph_image_instance (glyph_or_image, window,
4022                                            ERROR_ME_NOT, 1);
4023           XGLYPH_DIRTYP (glyph_or_image) = dirty;
4024         }
4025
4026       if (!IMAGE_INSTANCEP (instance))
4027         return;
4028
4029       XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
4030     }
4031 }
4032
4033 static void
4034 set_image_instance_dirty_p (Lisp_Object instance, int dirty)
4035 {
4036   if (IMAGE_INSTANCEP (instance))
4037     {
4038       XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
4039       /* Now cascade up the hierarchy. */
4040       set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance),
4041                                   dirty);
4042     }
4043   else if (GLYPHP (instance))
4044     {
4045       XGLYPH_DIRTYP (instance) = dirty;
4046     }
4047 }
4048
4049 /* #### do we need to cache this info to speed things up? */
4050
4051 Lisp_Object
4052 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
4053 {
4054   if (!GLYPHP (glyph))
4055     return Qnil;
4056   else
4057     {
4058       Lisp_Object retval =
4059         specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
4060                                     /* #### look into ERROR_ME_NOT */
4061                                     Qunbound, domain, ERROR_ME_NOT,
4062                                     0, Qzero);
4063       if (!NILP (retval) && !INTP (retval))
4064         retval = Qnil;
4065       else if (INTP (retval))
4066         {
4067           if (XINT (retval) < 0)
4068             retval = Qzero;
4069           if (XINT (retval) > 100)
4070             retval = make_int (100);
4071         }
4072       return retval;
4073     }
4074 }
4075
4076 Lisp_Object
4077 glyph_face (Lisp_Object glyph, Lisp_Object domain)
4078 {
4079   /* #### Domain parameter not currently used but it will be */
4080   return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
4081 }
4082
4083 int
4084 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
4085 {
4086   if (!GLYPHP (glyph))
4087     return 0;
4088   else
4089     return !NILP (specifier_instance_no_quit
4090                   (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
4091                    /* #### look into ERROR_ME_NOT */
4092                    ERROR_ME_NOT, 0, Qzero));
4093 }
4094
4095 static void
4096 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
4097                             Lisp_Object locale)
4098 {
4099   if (XGLYPH (glyph)->after_change)
4100     (XGLYPH (glyph)->after_change) (glyph, property, locale);
4101 }
4102
4103 void
4104 glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height,
4105                       enum image_instance_geometry disp, Lisp_Object domain)
4106 {
4107   Lisp_Object instance = glyph_or_image;
4108
4109   if (GLYPHP (glyph_or_image))
4110     instance = glyph_image_instance (glyph_or_image, domain, ERROR_ME_NOT, 1);
4111
4112   image_instance_query_geometry (instance, width, height, disp, domain);
4113 }
4114
4115 void
4116 glyph_do_layout (Lisp_Object glyph_or_image, int width, int height,
4117               int xoffset, int yoffset, Lisp_Object domain)
4118 {
4119   Lisp_Object instance = glyph_or_image;
4120
4121   if (GLYPHP (glyph_or_image))
4122     instance = glyph_image_instance (glyph_or_image, domain, ERROR_ME_NOT, 1);
4123
4124   image_instance_layout (instance, width, height, xoffset, yoffset, domain);
4125 }
4126
4127 \f
4128 /*****************************************************************************
4129  *                     glyph cachel functions                                *
4130  *****************************************************************************/
4131
4132 /* #### All of this is 95% copied from face cachels.  Consider
4133   consolidating.
4134
4135   Why do we need glyph_cachels? Simply because a glyph_cachel captures
4136   per-window information about a particular glyph. A glyph itself is
4137   not created in any particular context, so if we were to rely on a
4138   glyph to tell us about its dirtiness we would not be able to reset
4139   the dirty flag after redisplaying it as it may exist in other
4140   contexts. When we have redisplayed we need to know which glyphs to
4141   reset the dirty flags on - the glyph_cachels give us a nice list we
4142   can iterate through doing this.  */
4143 void
4144 mark_glyph_cachels (glyph_cachel_dynarr *elements)
4145 {
4146   int elt;
4147
4148   if (!elements)
4149     return;
4150
4151   for (elt = 0; elt < Dynarr_length (elements); elt++)
4152     {
4153       struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
4154       mark_object (cachel->glyph);
4155     }
4156 }
4157
4158 static void
4159 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
4160                           struct glyph_cachel *cachel)
4161 {
4162   if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)
4163       || XGLYPH_DIRTYP (cachel->glyph)
4164       || XFRAME(WINDOW_FRAME(w))->faces_changed)
4165     {
4166       Lisp_Object window, instance;
4167
4168       XSETWINDOW (window, w);
4169
4170       cachel->glyph   = glyph;
4171       /* Speed things up slightly by grabbing the glyph instantiation
4172          and passing it to the size functions. */
4173       instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
4174
4175       if (!IMAGE_INSTANCEP (instance))
4176         return;
4177
4178       /* Mark text instance of the glyph dirty if faces have changed,
4179          because its geometry might have changed. */
4180       invalidate_glyph_geometry_maybe (instance, w);
4181
4182       /* #### Do the following 2 lines buy us anything? --kkm */
4183       XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance);
4184       cachel->dirty   = XGLYPH_DIRTYP (glyph);
4185       cachel->width   = glyph_width   (instance, window);
4186       cachel->ascent  = glyph_ascent  (instance, window);
4187       cachel->descent = glyph_descent (instance, window);
4188     }
4189
4190   cachel->updated = 1;
4191 }
4192
4193 static void
4194 add_glyph_cachel (struct window *w, Lisp_Object glyph)
4195 {
4196   struct glyph_cachel new_cachel;
4197
4198   xzero (new_cachel);
4199   new_cachel.glyph = Qnil;
4200
4201   update_glyph_cachel_data (w, glyph, &new_cachel);
4202   Dynarr_add (w->glyph_cachels, new_cachel);
4203 }
4204
4205 glyph_index
4206 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
4207 {
4208   int elt;
4209
4210   if (noninteractive)
4211     return 0;
4212
4213   for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4214     {
4215       struct glyph_cachel *cachel =
4216         Dynarr_atp (w->glyph_cachels, elt);
4217
4218       if (EQ (cachel->glyph, glyph) && !NILP (glyph))
4219         {
4220           update_glyph_cachel_data (w, glyph, cachel);
4221           return elt;
4222         }
4223     }
4224
4225   /* If we didn't find the glyph, add it and then return its index. */
4226   add_glyph_cachel (w, glyph);
4227   return elt;
4228 }
4229
4230 void
4231 reset_glyph_cachels (struct window *w)
4232 {
4233   Dynarr_reset (w->glyph_cachels);
4234   get_glyph_cachel_index (w, Vcontinuation_glyph);
4235   get_glyph_cachel_index (w, Vtruncation_glyph);
4236   get_glyph_cachel_index (w, Vhscroll_glyph);
4237   get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
4238   get_glyph_cachel_index (w, Voctal_escape_glyph);
4239   get_glyph_cachel_index (w, Vinvisible_text_glyph);
4240 }
4241
4242 void
4243 mark_glyph_cachels_as_not_updated (struct window *w)
4244 {
4245   int elt;
4246
4247   /* We need to have a dirty flag to tell if the glyph has changed.
4248      We can check to see if each glyph variable is actually a
4249      completely different glyph, though. */
4250 #define FROB(glyph_obj, gindex)                                         \
4251   update_glyph_cachel_data (w, glyph_obj,                               \
4252                               Dynarr_atp (w->glyph_cachels, gindex))
4253
4254   FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
4255   FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
4256   FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
4257   FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
4258   FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
4259   FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
4260 #undef FROB
4261
4262   for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4263     {
4264       Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
4265     }
4266 }
4267
4268 /* Unset the dirty bit on all the glyph cachels that have it. */
4269 void
4270 mark_glyph_cachels_as_clean (struct window* w)
4271 {
4272   int elt;
4273   Lisp_Object window;
4274   XSETWINDOW (window, w);
4275   for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4276     {
4277       struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt);
4278       cachel->dirty = 0;
4279       set_glyph_dirty_p (cachel->glyph, window, 0);
4280     }
4281 }
4282
4283 #ifdef MEMORY_USAGE_STATS
4284
4285 int
4286 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
4287                             struct overhead_stats *ovstats)
4288 {
4289   int total = 0;
4290
4291   if (glyph_cachels)
4292     total += Dynarr_memory_usage (glyph_cachels, ovstats);
4293
4294   return total;
4295 }
4296
4297 #endif /* MEMORY_USAGE_STATS */
4298
4299
4300 \f
4301 /*****************************************************************************
4302  *                     subwindow cachel functions                                    *
4303  *****************************************************************************/
4304 /* Subwindows are curious in that you have to physically unmap them to
4305    not display them. It is problematic deciding what to do in
4306    redisplay. We have two caches - a per-window instance cache that
4307    keeps track of subwindows on a window, these are linked to their
4308    instantiator in the hashtable and when the instantiator goes away
4309    we want the instance to go away also. However we also have a
4310    per-frame instance cache that we use to determine if a subwindow is
4311    obscuring an area that we want to clear. We need to be able to flip
4312    through this quickly so a hashtable is not suitable hence the
4313    subwindow_cachels. This is a weak list so unreference instances
4314    will get deleted properly. */
4315
4316 /* redisplay in general assumes that drawing something will erase
4317    what was there before. unfortunately this does not apply to
4318    subwindows that need to be specifically unmapped in order to
4319    disappear. we take a brute force approach - on the basis that its
4320    cheap - and unmap all subwindows in a display line */
4321
4322 /* Put new instances in the frame subwindow cache. This is less costly than
4323    doing it every time something gets mapped, and deleted instances will be
4324    removed automatically. */
4325 static void
4326 cache_subwindow_instance_in_frame_maybe (Lisp_Object instance)
4327 {
4328   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (instance);
4329   if (!NILP (DOMAIN_FRAME (IMAGE_INSTANCE_DOMAIN (ii))))
4330     {
4331       struct frame* f = DOMAIN_XFRAME (IMAGE_INSTANCE_DOMAIN (ii));
4332       XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))
4333         = Fcons (instance, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
4334     }
4335 }
4336
4337 /* Unmap and finalize all subwindow instances in the frame cache. This
4338    is necessary because GC will not guarantee the order things get
4339    deleted in and moreover, frame finalization deletes the window
4340    system windows before deleting XEmacs windows, and hence
4341    subwindows.  */
4342 int
4343 unmap_subwindow_instance_cache_mapper (Lisp_Object key, Lisp_Object value,
4344                                        void* finalize)
4345 {
4346   /* value can be nil; we cache failures as well as successes */
4347   if (!NILP (value))
4348     {
4349       struct frame* f = XFRAME (XIMAGE_INSTANCE_FRAME (value));
4350       unmap_subwindow (value);
4351       if (finalize)
4352         {
4353           /* In case GC doesn't catch up fast enough, remove from the frame
4354              cache also. Otherwise code that checks the sanity of the instance
4355              will fail. */
4356           XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))
4357             = delq_no_quit (value,
4358                             XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
4359           finalize_image_instance (XIMAGE_INSTANCE (value), 0);
4360         }
4361     }
4362   return 0;
4363 }
4364
4365 static void
4366 finalize_all_subwindow_instances (struct window *w)
4367 {
4368   if (!NILP (w->next))   finalize_all_subwindow_instances (XWINDOW (w->next));
4369   if (!NILP (w->vchild)) finalize_all_subwindow_instances (XWINDOW (w->vchild));
4370   if (!NILP (w->hchild)) finalize_all_subwindow_instances (XWINDOW (w->hchild));
4371
4372   elisp_maphash (unmap_subwindow_instance_cache_mapper,
4373                  w->subwindow_instance_cache, (void*)1);
4374 }
4375
4376 void
4377 free_frame_subwindow_instances (struct frame* f)
4378 {
4379   /* Make sure all instances are finalized. We have to do this via the
4380      instance cache since some instances may be extant but not
4381      displayed (and hence not in the frame cache). */
4382   finalize_all_subwindow_instances (XWINDOW (f->root_window));
4383 }
4384
4385 /* Unmap all instances in the frame cache. */
4386 void
4387 reset_frame_subwindow_instance_cache (struct frame* f)
4388 {
4389   Lisp_Object rest;
4390
4391   LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
4392     {
4393       Lisp_Object value = XCAR (rest);
4394       unmap_subwindow (value);
4395     }
4396 }
4397
4398 /*****************************************************************************
4399  *                              subwindow exposure ignorance                    *
4400  *****************************************************************************/
4401 /* when we unmap subwindows the associated window system will generate
4402    expose events. This we do not want as redisplay already copes with
4403    the repainting necessary. Worse, we can get in an endless cycle of
4404    redisplay if we are not careful. Thus we keep a per-frame list of
4405    expose events that are going to come and ignore them as
4406    required. */
4407
4408 struct expose_ignore_blocktype
4409 {
4410   Blocktype_declare (struct expose_ignore);
4411 } *the_expose_ignore_blocktype;
4412
4413 int
4414 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
4415 {
4416   struct expose_ignore *ei, *prev;
4417   /* the ignore list is FIFO so we should generally get a match with
4418      the first element in the list */
4419   for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next)
4420     {
4421       /* Checking for exact matches just isn't good enough as we
4422          might get exposures for partially obscured subwindows, thus
4423          we have to check for overlaps. Being conservative, we will
4424          check for exposures wholly contained by the subwindow - this
4425          might give us what we want.*/
4426       if (ei->x <= (unsigned) x && ei->y <= (unsigned) y
4427           && ei->x + ei->width >= (unsigned) (x + width)
4428           && ei->y + ei->height >= (unsigned) (y + height))
4429         {
4430 #ifdef DEBUG_WIDGETS
4431           stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n",
4432                       x, y, width, height, ei->x, ei->y, ei->width, ei->height);
4433 #endif
4434           if (!prev)
4435             f->subwindow_exposures = ei->next;
4436           else
4437             prev->next = ei->next;
4438
4439           if (ei == f->subwindow_exposures_tail)
4440             f->subwindow_exposures_tail = prev;
4441
4442           Blocktype_free (the_expose_ignore_blocktype, ei);
4443           return 1;
4444         }
4445       prev = ei;
4446     }
4447   return 0;
4448 }
4449
4450 static void
4451 register_ignored_expose (struct frame* f, int x, int y, int width, int height)
4452 {
4453   if (!hold_ignored_expose_registration)
4454     {
4455       struct expose_ignore *ei;
4456
4457       ei = Blocktype_alloc (the_expose_ignore_blocktype);
4458
4459       ei->next = NULL;
4460       ei->x = x;
4461       ei->y = y;
4462       ei->width = width;
4463       ei->height = height;
4464
4465       /* we have to add the exposure to the end of the list, since we
4466          want to check the oldest events first. for speed we keep a record
4467          of the end so that we can add right to it. */
4468       if (f->subwindow_exposures_tail)
4469         {
4470           f->subwindow_exposures_tail->next = ei;
4471         }
4472       if (!f->subwindow_exposures)
4473         {
4474           f->subwindow_exposures = ei;
4475         }
4476       f->subwindow_exposures_tail = ei;
4477     }
4478 }
4479
4480 /****************************************************************************
4481  find_matching_subwindow
4482
4483  See if there is a subwindow that completely encloses the requested
4484  area.
4485  ****************************************************************************/
4486 int find_matching_subwindow (struct frame* f, int x, int y, int width, int height)
4487 {
4488   Lisp_Object rest;
4489
4490   LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
4491     {
4492       Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest));
4493
4494       if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii)
4495           &&
4496           IMAGE_INSTANCE_DISPLAY_X (ii) <= (unsigned) x
4497           &&
4498           IMAGE_INSTANCE_DISPLAY_Y (ii) <= (unsigned) y
4499           &&
4500           IMAGE_INSTANCE_DISPLAY_X (ii)
4501           + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) >= (unsigned) (x + width)
4502           &&
4503           IMAGE_INSTANCE_DISPLAY_Y (ii)
4504           + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) >= (unsigned) (y + height))
4505         {
4506           return 1;
4507         }
4508     }
4509   return 0;
4510 }
4511
4512 \f
4513 /*****************************************************************************
4514  *                              subwindow functions                          *
4515  *****************************************************************************/
4516
4517 /* Update the displayed characteristics of a subwindow. This function
4518    should generally only get called if the subwindow is actually
4519    dirty. */
4520 void
4521 redisplay_subwindow (Lisp_Object subwindow)
4522 {
4523   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4524   int count = specpdl_depth ();
4525
4526   /* The update method is allowed to call eval.  Since it is quite
4527      common for this function to get called from somewhere in
4528      redisplay we need to make sure that quits are ignored.  Otherwise
4529      Fsignal will abort. */
4530   specbind (Qinhibit_quit, Qt);
4531
4532   ERROR_CHECK_IMAGE_INSTANCE (subwindow);
4533
4534   if (WIDGET_IMAGE_INSTANCEP (subwindow))
4535     {
4536       if (image_instance_changed (subwindow))
4537         redisplay_widget (subwindow);
4538       /* Reset the changed flags. */
4539       IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0;
4540       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0;
4541       IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii) = 0;
4542       IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0;
4543     }
4544   else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW
4545            &&
4546            !NILP (IMAGE_INSTANCE_FRAME (ii)))
4547     {
4548       MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain),
4549                      redisplay_subwindow, (ii));
4550     }
4551
4552   IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0;
4553   /* This function is typically called by redisplay just before
4554      outputting the information to the screen. Thus we record a hash
4555      of the output to determine whether on-screen is the same as
4556      recorded structure. This approach has limitations in there is a
4557      good chance that hash values will be different for the same
4558      visual appearance. However, we would rather that then the other
4559      way round - it simply means that we will get more displays than
4560      we might need. We can get better hashing by making the depth
4561      negative - currently it will recurse down 7 levels.*/
4562   IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow,
4563                                                     IMAGE_INSTANCE_HASH_DEPTH);
4564
4565   unbind_to (count, Qnil);
4566 }
4567
4568 /* Determine whether an image_instance has changed structurally and
4569    hence needs redisplaying in some way.
4570
4571    #### This should just look at the instantiator differences when we
4572    get rid of the stored items altogether. In fact we should probably
4573    store the new instantiator as well as the old - as we do with
4574    gui_items currently - and then pick-up the new on the next
4575    redisplay. This would obviate the need for any of this trickery
4576    with hashcodes. */
4577 int
4578 image_instance_changed (Lisp_Object subwindow)
4579 {
4580   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4581
4582   if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) !=
4583       IMAGE_INSTANCE_DISPLAY_HASH (ii))
4584     return 1;
4585   /* #### I think there is probably a bug here. This gets called for
4586      layouts - and yet the pending items are always nil for
4587      layouts. We are saved by layout optimization, but I'm undecided
4588      as to what the correct fix is. */
4589   else if (WIDGET_IMAGE_INSTANCEP (subwindow)
4590            && (!internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (ii),
4591                                 IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii), 0)
4592                || !NILP (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii))
4593                || IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii)))
4594     return 1;
4595   else
4596     return 0;
4597 }
4598
4599 /* Update all the subwindows on a frame. */
4600 void
4601 update_widget_instances (Lisp_Object frame)
4602 {
4603   struct frame* f;
4604   Lisp_Object rest;
4605
4606   /* Its possible for the preceding callback to have deleted the
4607      frame, so cope with this. */
4608   if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
4609     return;
4610
4611   CHECK_FRAME (frame);
4612   f = XFRAME (frame);
4613
4614   /* If we get called we know something has changed. */
4615   LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
4616     {
4617       Lisp_Object widget = XCAR (rest);
4618
4619       if (XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (widget)
4620           &&
4621           image_instance_changed (widget))
4622         {
4623           set_image_instance_dirty_p (widget, 1);
4624           MARK_FRAME_GLYPHS_CHANGED (f);
4625         }
4626     }
4627 }
4628
4629 /* remove a subwindow from its frame */
4630 void unmap_subwindow (Lisp_Object subwindow)
4631 {
4632   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4633   struct frame* f;
4634
4635   ERROR_CHECK_IMAGE_INSTANCE (subwindow);
4636
4637   if (!image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii))
4638       & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK)
4639       ||
4640       !IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii))
4641     return;
4642
4643 #ifdef DEBUG_WIDGETS
4644   stderr_out ("unmapping subwindow %p\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
4645 #endif
4646   f = XFRAME (IMAGE_INSTANCE_FRAME (ii));
4647
4648   /* make sure we don't get expose events */
4649   register_ignored_expose (f, IMAGE_INSTANCE_DISPLAY_X (ii),
4650                            IMAGE_INSTANCE_DISPLAY_Y (ii),
4651                            IMAGE_INSTANCE_DISPLAY_WIDTH (ii),
4652                            IMAGE_INSTANCE_DISPLAY_HEIGHT (ii));
4653   IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4654
4655   MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)),
4656                  unmap_subwindow, (ii));
4657 }
4658
4659 /* show a subwindow in its frame */
4660 void map_subwindow (Lisp_Object subwindow, int x, int y,
4661                     struct display_glyph_area *dga)
4662 {
4663   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4664   struct frame* f;
4665
4666   ERROR_CHECK_IMAGE_INSTANCE (subwindow);
4667
4668   if (!image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii))
4669       & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK))
4670     return;
4671
4672 #ifdef DEBUG_WIDGETS
4673   stderr_out ("mapping subwindow %p, %dx%d@%d+%d\n",
4674               IMAGE_INSTANCE_SUBWINDOW_ID (ii),
4675               dga->width, dga->height, x, y);
4676 #endif
4677   f = XFRAME (IMAGE_INSTANCE_FRAME (ii));
4678   IMAGE_INSTANCE_DISPLAY_X (ii) = x;
4679   IMAGE_INSTANCE_DISPLAY_Y (ii) = y;
4680   IMAGE_INSTANCE_DISPLAY_WIDTH (ii) = dga->width;
4681   IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) = dga->height;
4682
4683   MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain),
4684                  map_subwindow, (ii, x, y, dga));
4685   IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
4686 }
4687
4688 static int
4689 subwindow_possible_dest_types (void)
4690 {
4691   return IMAGE_SUBWINDOW_MASK;
4692 }
4693
4694 int
4695 subwindow_governing_domain (void)
4696 {
4697   return GOVERNING_DOMAIN_WINDOW;
4698 }
4699
4700 /* Partially instantiate a subwindow. */
4701 void
4702 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
4703                        Lisp_Object pointer_fg, Lisp_Object pointer_bg,
4704                        int dest_mask, Lisp_Object domain)
4705 {
4706   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
4707   Lisp_Object device = image_instance_device (image_instance);
4708   Lisp_Object frame = DOMAIN_FRAME (domain);
4709   Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
4710   Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
4711
4712   if (NILP (frame))
4713     signal_simple_error ("No selected frame", device);
4714
4715   if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
4716     incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
4717
4718   ii->data = 0;
4719   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
4720   IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4721
4722   if (INTP (width))
4723     {
4724       int w = 1;
4725       if (XINT (width) > 1)
4726         w = XINT (width);
4727       IMAGE_INSTANCE_WIDTH (ii) = w;
4728       IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0;
4729     }
4730
4731   if (INTP (height))
4732     {
4733       int h = 1;
4734       if (XINT (height) > 1)
4735         h = XINT (height);
4736       IMAGE_INSTANCE_HEIGHT (ii) = h;
4737       IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0;
4738     }
4739 }
4740
4741 /* This is just a backup in case no-one has assigned a suitable geometry.
4742    #### It should really query the enclose window for geometry. */
4743 static void
4744 subwindow_query_geometry (Lisp_Object image_instance, int* width,
4745                           int* height, enum image_instance_geometry disp,
4746                           Lisp_Object domain)
4747 {
4748   if (width)    *width = 20;
4749   if (height)   *height = 20;
4750 }
4751
4752 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
4753 Return non-nil if OBJECT is a subwindow.
4754 */
4755        (object))
4756 {
4757   CHECK_IMAGE_INSTANCE (object);
4758   return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
4759 }
4760
4761 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
4762 Return the window id of SUBWINDOW as a number.
4763 */
4764        (subwindow))
4765 {
4766   CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4767   return make_int ((EMACS_INT) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow));
4768 }
4769
4770 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
4771 Resize SUBWINDOW to WIDTH x HEIGHT.
4772 If a value is nil that parameter is not changed.
4773 */
4774        (subwindow, width, height))
4775 {
4776   int neww, newh;
4777   Lisp_Image_Instance* ii;
4778
4779   CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4780   ii = XIMAGE_INSTANCE (subwindow);
4781
4782   if (NILP (width))
4783     neww = IMAGE_INSTANCE_WIDTH (ii);
4784   else
4785     neww = XINT (width);
4786
4787   if (NILP (height))
4788     newh = IMAGE_INSTANCE_HEIGHT (ii);
4789   else
4790     newh = XINT (height);
4791
4792   /* The actual resizing gets done asynchronously by
4793      update_subwindow. */
4794   IMAGE_INSTANCE_HEIGHT (ii) = newh;
4795   IMAGE_INSTANCE_WIDTH (ii) = neww;
4796   IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
4797
4798   return subwindow;
4799 }
4800
4801 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
4802 Generate a Map event for SUBWINDOW.
4803 */
4804        (subwindow))
4805 {
4806   CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4807 #if 0
4808   map_subwindow (subwindow, 0, 0);
4809 #endif
4810   return subwindow;
4811 }
4812
4813 \f
4814 /*****************************************************************************
4815  *                              display tables                               *
4816  *****************************************************************************/
4817
4818 /* Get the display tables for use currently on window W with face
4819    FACE.  #### This will have to be redone.  */
4820
4821 void
4822 get_display_tables (struct window *w, face_index findex,
4823                     Lisp_Object *face_table, Lisp_Object *window_table)
4824 {
4825   Lisp_Object tem;
4826   tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
4827   if (UNBOUNDP (tem))
4828     tem = Qnil;
4829   if (!LISTP (tem))
4830     tem = noseeum_cons (tem, Qnil);
4831   *face_table = tem;
4832   tem = w->display_table;
4833   if (UNBOUNDP (tem))
4834     tem = Qnil;
4835   if (!LISTP (tem))
4836     tem = noseeum_cons (tem, Qnil);
4837   *window_table = tem;
4838 }
4839
4840 Lisp_Object
4841 display_table_entry (Emchar ch, Lisp_Object face_table,
4842                      Lisp_Object window_table)
4843 {
4844   Lisp_Object tail;
4845
4846   /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
4847   for (tail = face_table; 1; tail = XCDR (tail))
4848     {
4849       Lisp_Object table;
4850       if (NILP (tail))
4851         {
4852           if (!NILP (window_table))
4853             {
4854               tail = window_table;
4855               window_table = Qnil;
4856             }
4857           else
4858             return Qnil;
4859         }
4860       table = XCAR (tail);
4861
4862       if (VECTORP (table))
4863         {
4864           if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
4865             return XVECTOR_DATA (table)[ch];
4866           else
4867             continue;
4868         }
4869       else if (CHAR_TABLEP (table)
4870                && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
4871         {
4872           return get_char_table (ch, XCHAR_TABLE (table));
4873         }
4874       else if (CHAR_TABLEP (table)
4875                && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
4876         {
4877           Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
4878           if (!NILP (gotit))
4879             return gotit;
4880           else
4881             continue;
4882         }
4883       else if (RANGE_TABLEP (table))
4884         {
4885           Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
4886           if (!NILP (gotit))
4887             return gotit;
4888           else
4889             continue;
4890         }
4891       else
4892         abort ();
4893     }
4894 }
4895
4896 /*****************************************************************************
4897  *                              timeouts for animated glyphs                      *
4898  *****************************************************************************/
4899 static Lisp_Object Qglyph_animated_timeout_handler;
4900
4901 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /*
4902 Callback function for updating animated images.
4903 Don't use this.
4904 */
4905        (arg))
4906 {
4907   CHECK_WEAK_LIST (arg);
4908
4909   if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg))))
4910     {
4911       Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg));
4912
4913       if (IMAGE_INSTANCEP (value))
4914         {
4915           Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value);
4916
4917           if (COLOR_PIXMAP_IMAGE_INSTANCEP (value)
4918               &&
4919               IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1
4920               &&
4921               !disable_animated_pixmaps)
4922             {
4923               /* Increment the index of the image slice we are currently
4924                  viewing. */
4925               IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
4926                 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
4927                 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
4928               /* We might need to kick redisplay at this point - but we
4929                  also might not. */
4930               MARK_DEVICE_FRAMES_GLYPHS_CHANGED
4931                 (XDEVICE (image_instance_device (value)));
4932               /* Cascade dirtiness so that we can have an animated glyph in a layout
4933                  for instance. */
4934               set_image_instance_dirty_p (value, 1);
4935             }
4936         }
4937     }
4938   return Qnil;
4939 }
4940
4941 Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image)
4942 {
4943   Lisp_Object ret = Qnil;
4944
4945   if (tickms > 0 && IMAGE_INSTANCEP (image))
4946     {
4947       double ms = ((double)tickms) / 1000.0;
4948       struct gcpro gcpro1;
4949       Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE);
4950
4951       GCPRO1 (holder);
4952       XWEAK_LIST_LIST (holder) = Fcons (image, Qnil);
4953
4954       ret = Fadd_timeout (make_float (ms),
4955                           Qglyph_animated_timeout_handler,
4956                           holder, make_float (ms));
4957
4958       UNGCPRO;
4959     }
4960   return ret;
4961 }
4962
4963 void disable_glyph_animated_timeout (int i)
4964 {
4965   Lisp_Object id;
4966   XSETINT (id, i);
4967
4968   Fdisable_timeout (id);
4969 }
4970
4971 \f
4972 /*****************************************************************************
4973  *                              initialization                               *
4974  *****************************************************************************/
4975
4976 void
4977 syms_of_glyphs (void)
4978 {
4979   INIT_LRECORD_IMPLEMENTATION (glyph);
4980   INIT_LRECORD_IMPLEMENTATION (image_instance);
4981
4982   /* image instantiators */
4983
4984   DEFSUBR (Fimage_instantiator_format_list);
4985   DEFSUBR (Fvalid_image_instantiator_format_p);
4986   DEFSUBR (Fset_console_type_image_conversion_list);
4987   DEFSUBR (Fconsole_type_image_conversion_list);
4988
4989   DEFKEYWORD (Q_file);
4990   DEFKEYWORD (Q_data);
4991   DEFKEYWORD (Q_face);
4992   DEFKEYWORD (Q_pixel_height);
4993   DEFKEYWORD (Q_pixel_width);
4994
4995 #ifdef HAVE_XPM
4996   DEFKEYWORD (Q_color_symbols);
4997 #endif
4998 #ifdef HAVE_WINDOW_SYSTEM
4999   DEFKEYWORD (Q_mask_file);
5000   DEFKEYWORD (Q_mask_data);
5001   DEFKEYWORD (Q_hotspot_x);
5002   DEFKEYWORD (Q_hotspot_y);
5003   DEFKEYWORD (Q_foreground);
5004   DEFKEYWORD (Q_background);
5005 #endif
5006   /* image specifiers */
5007
5008   DEFSUBR (Fimage_specifier_p);
5009   /* Qimage in general.c */
5010
5011   /* image instances */
5012
5013   defsymbol (&Qimage_instancep, "image-instance-p");
5014
5015   DEFSYMBOL (Qnothing_image_instance_p);
5016   DEFSYMBOL (Qtext_image_instance_p);
5017   DEFSYMBOL (Qmono_pixmap_image_instance_p);
5018   DEFSYMBOL (Qcolor_pixmap_image_instance_p);
5019   DEFSYMBOL (Qpointer_image_instance_p);
5020   DEFSYMBOL (Qwidget_image_instance_p);
5021   DEFSYMBOL (Qsubwindow_image_instance_p);
5022
5023   DEFSUBR (Fmake_image_instance);
5024   DEFSUBR (Fimage_instance_p);
5025   DEFSUBR (Fimage_instance_type);
5026   DEFSUBR (Fvalid_image_instance_type_p);
5027   DEFSUBR (Fimage_instance_type_list);
5028   DEFSUBR (Fimage_instance_name);
5029   DEFSUBR (Fimage_instance_domain);
5030   DEFSUBR (Fimage_instance_string);
5031   DEFSUBR (Fimage_instance_file_name);
5032   DEFSUBR (Fimage_instance_mask_file_name);
5033   DEFSUBR (Fimage_instance_depth);
5034   DEFSUBR (Fimage_instance_height);
5035   DEFSUBR (Fimage_instance_width);
5036   DEFSUBR (Fimage_instance_hotspot_x);
5037   DEFSUBR (Fimage_instance_hotspot_y);
5038   DEFSUBR (Fimage_instance_foreground);
5039   DEFSUBR (Fimage_instance_background);
5040   DEFSUBR (Fimage_instance_property);
5041   DEFSUBR (Fcolorize_image_instance);
5042   /* subwindows */
5043   DEFSUBR (Fsubwindowp);
5044   DEFSUBR (Fimage_instance_subwindow_id);
5045   DEFSUBR (Fresize_subwindow);
5046   DEFSUBR (Fforce_subwindow_map);
5047
5048   /* Qnothing defined as part of the "nothing" image-instantiator
5049      type. */
5050   /* Qtext defined in general.c */
5051   DEFSYMBOL (Qmono_pixmap);
5052   DEFSYMBOL (Qcolor_pixmap);
5053   /* Qpointer defined in general.c */
5054
5055   /* glyphs */
5056
5057   DEFSYMBOL (Qglyphp);
5058   DEFSYMBOL (Qcontrib_p);
5059   DEFSYMBOL (Qbaseline);
5060
5061   DEFSYMBOL (Qbuffer_glyph_p);
5062   DEFSYMBOL (Qpointer_glyph_p);
5063   DEFSYMBOL (Qicon_glyph_p);
5064
5065   DEFSYMBOL (Qconst_glyph_variable);
5066
5067   DEFSUBR (Fglyph_type);
5068   DEFSUBR (Fvalid_glyph_type_p);
5069   DEFSUBR (Fglyph_type_list);
5070   DEFSUBR (Fglyphp);
5071   DEFSUBR (Fmake_glyph_internal);
5072   DEFSUBR (Fglyph_width);
5073   DEFSUBR (Fglyph_ascent);
5074   DEFSUBR (Fglyph_descent);
5075   DEFSUBR (Fglyph_height);
5076   DEFSUBR (Fset_instantiator_property);
5077
5078   /* Qbuffer defined in general.c. */
5079   /* Qpointer defined above */
5080
5081   /* Unfortunately, timeout handlers must be lisp functions. This is
5082      for animated glyphs. */
5083   DEFSYMBOL (Qglyph_animated_timeout_handler);
5084   DEFSUBR (Fglyph_animated_timeout_handler);
5085
5086   /* Errors */
5087   DEFERROR_STANDARD (Qimage_conversion_error, Qio_error);
5088 }
5089
5090 static const struct lrecord_description image_specifier_description[] = {
5091   { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee) },
5092   { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee_property) },
5093   { XD_END }
5094 };
5095
5096 void
5097 specifier_type_create_image (void)
5098 {
5099   /* image specifiers */
5100
5101   INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
5102
5103   SPECIFIER_HAS_METHOD (image, create);
5104   SPECIFIER_HAS_METHOD (image, mark);
5105   SPECIFIER_HAS_METHOD (image, instantiate);
5106   SPECIFIER_HAS_METHOD (image, validate);
5107   SPECIFIER_HAS_METHOD (image, after_change);
5108   SPECIFIER_HAS_METHOD (image, going_to_add);
5109   SPECIFIER_HAS_METHOD (image, copy_instantiator);
5110 }
5111
5112 void
5113 reinit_specifier_type_create_image (void)
5114 {
5115   REINITIALIZE_SPECIFIER_TYPE (image);
5116 }
5117
5118
5119 static const struct lrecord_description iike_description_1[] = {
5120   { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) },
5121   { XD_END }
5122 };
5123
5124 static const struct struct_description iike_description = {
5125   sizeof (ii_keyword_entry),
5126   iike_description_1
5127 };
5128
5129 static const struct lrecord_description iiked_description_1[] = {
5130   XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description),
5131   { XD_END }
5132 };
5133
5134 static const struct struct_description iiked_description = {
5135   sizeof (ii_keyword_entry_dynarr),
5136   iiked_description_1
5137 };
5138
5139 static const struct lrecord_description iife_description_1[] = {
5140   { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) },
5141   { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) },
5142   { XD_STRUCT_PTR,  offsetof (image_instantiator_format_entry, meths),  1, &iim_description },
5143   { XD_END }
5144 };
5145
5146 static const struct struct_description iife_description = {
5147   sizeof (image_instantiator_format_entry),
5148   iife_description_1
5149 };
5150
5151 static const struct lrecord_description iifed_description_1[] = {
5152   XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description),
5153   { XD_END }
5154 };
5155
5156 static const struct struct_description iifed_description = {
5157   sizeof (image_instantiator_format_entry_dynarr),
5158   iifed_description_1
5159 };
5160
5161 static const struct lrecord_description iim_description_1[] = {
5162   { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) },
5163   { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) },
5164   { XD_STRUCT_PTR,  offsetof (struct image_instantiator_methods, keywords), 1, &iiked_description },
5165   { XD_STRUCT_PTR,  offsetof (struct image_instantiator_methods, consoles), 1, &cted_description },
5166   { XD_END }
5167 };
5168
5169 const struct struct_description iim_description = {
5170   sizeof (struct image_instantiator_methods),
5171   iim_description_1
5172 };
5173
5174 void
5175 image_instantiator_format_create (void)
5176 {
5177   /* image instantiators */
5178
5179   the_image_instantiator_format_entry_dynarr =
5180     Dynarr_new (image_instantiator_format_entry);
5181
5182   Vimage_instantiator_format_list = Qnil;
5183   staticpro (&Vimage_instantiator_format_list);
5184
5185   dump_add_root_struct_ptr (&the_image_instantiator_format_entry_dynarr, &iifed_description);
5186
5187   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
5188
5189   IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
5190   IIFORMAT_HAS_METHOD (nothing, instantiate);
5191
5192   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
5193
5194   IIFORMAT_HAS_METHOD (inherit, validate);
5195   IIFORMAT_HAS_METHOD (inherit, normalize);
5196   IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
5197   IIFORMAT_HAS_METHOD (inherit, instantiate);
5198
5199   IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
5200
5201   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
5202
5203   IIFORMAT_HAS_METHOD (string, validate);
5204   IIFORMAT_HAS_SHARED_METHOD (string, governing_domain, subwindow);
5205   IIFORMAT_HAS_METHOD (string, possible_dest_types);
5206   IIFORMAT_HAS_METHOD (string, instantiate);
5207
5208   IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
5209   /* Do this so we can set strings. */
5210   /* #### Andy, what is this?  This is a bogus format and should not be
5211      visible to the user. */
5212   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text");
5213   IIFORMAT_HAS_METHOD (text, update);
5214   IIFORMAT_HAS_METHOD (text, query_geometry);
5215
5216   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
5217
5218   IIFORMAT_HAS_METHOD (formatted_string, validate);
5219   IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
5220   IIFORMAT_HAS_METHOD (formatted_string, instantiate);
5221   IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
5222
5223   /* Do this so pointers have geometry. */
5224   /* #### Andy, what is this?  This is a bogus format and should not be
5225      visible to the user. */
5226   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (pointer, "pointer");
5227   IIFORMAT_HAS_SHARED_METHOD (pointer, query_geometry, subwindow);
5228
5229   /* subwindows */
5230   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
5231   IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
5232   IIFORMAT_HAS_METHOD (subwindow, governing_domain);
5233   IIFORMAT_HAS_METHOD (subwindow, instantiate);
5234   IIFORMAT_HAS_METHOD (subwindow, query_geometry);
5235   IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
5236   IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
5237
5238 #ifdef HAVE_WINDOW_SYSTEM
5239   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
5240
5241   IIFORMAT_HAS_METHOD (xbm, validate);
5242   IIFORMAT_HAS_METHOD (xbm, normalize);
5243   IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
5244
5245   IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
5246   IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
5247   IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
5248   IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
5249   IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
5250   IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
5251   IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
5252   IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
5253 #endif /* HAVE_WINDOW_SYSTEM */
5254
5255 #ifdef HAVE_XFACE
5256   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
5257
5258   IIFORMAT_HAS_METHOD (xface, validate);
5259   IIFORMAT_HAS_METHOD (xface, normalize);
5260   IIFORMAT_HAS_METHOD (xface, possible_dest_types);
5261
5262   IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
5263   IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
5264   IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
5265   IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
5266   IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
5267   IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
5268 #endif
5269
5270 #ifdef HAVE_XPM
5271   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
5272
5273   IIFORMAT_HAS_METHOD (xpm, validate);
5274   IIFORMAT_HAS_METHOD (xpm, normalize);
5275   IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
5276
5277   IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
5278   IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
5279   IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
5280 #endif /* HAVE_XPM */
5281 }
5282
5283 void
5284 reinit_vars_of_glyphs (void)
5285 {
5286   the_expose_ignore_blocktype =
5287     Blocktype_new (struct expose_ignore_blocktype);
5288
5289   hold_ignored_expose_registration = 0;
5290 }
5291
5292
5293 void
5294 vars_of_glyphs (void)
5295 {
5296   reinit_vars_of_glyphs ();
5297
5298   Vthe_nothing_vector = vector1 (Qnothing);
5299   staticpro (&Vthe_nothing_vector);
5300
5301   /* image instances */
5302
5303   Vimage_instance_type_list = Fcons (Qnothing,
5304                                      list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
5305                                             Qpointer, Qsubwindow, Qwidget));
5306   staticpro (&Vimage_instance_type_list);
5307
5308   /* glyphs */
5309
5310   Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
5311   staticpro (&Vglyph_type_list);
5312
5313   /* The octal-escape glyph, control-arrow-glyph and
5314      invisible-text-glyph are completely initialized in glyphs.el */
5315
5316   DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
5317 What to prefix character codes displayed in octal with.
5318 */);
5319   Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5320
5321   DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
5322 What to use as an arrow for control characters.
5323 */);
5324   Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
5325                                          redisplay_glyph_changed);
5326
5327   DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
5328 What to use to indicate the presence of invisible text.
5329 This is the glyph that is displayed when an ellipsis is called for
5330 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
5331 Normally this is three dots ("...").
5332 */);
5333   Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
5334                                           redisplay_glyph_changed);
5335
5336   /* Partially initialized in glyphs.el */
5337   DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
5338 What to display at the beginning of horizontally scrolled lines.
5339 */);
5340   Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5341 #ifdef HAVE_WINDOW_SYSTEM
5342   Fprovide (Qxbm);
5343 #endif
5344 #ifdef HAVE_XPM
5345   Fprovide (Qxpm);
5346
5347   DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
5348 Definitions of logical color-names used when reading XPM files.
5349 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
5350 The COLOR-NAME should be a string, which is the name of the color to define;
5351 the FORM should evaluate to a `color' specifier object, or a string to be
5352 passed to `make-color-instance'.  If a loaded XPM file references a symbolic
5353 color called COLOR-NAME, it will display as the computed color instead.
5354
5355 The default value of this variable defines the logical color names
5356 \"foreground\" and \"background\" to be the colors of the `default' face.
5357 */ );
5358   Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
5359 #endif /* HAVE_XPM */
5360 #ifdef HAVE_XFACE
5361   Fprovide (Qxface);
5362 #endif
5363
5364   DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /*
5365 Whether animated pixmaps should be animated.
5366 Default is t.
5367 */);
5368   disable_animated_pixmaps = 0;
5369 }
5370
5371 void
5372 specifier_vars_of_glyphs (void)
5373 {
5374   /* #### Can we GC here? The set_specifier_* calls definitely need */
5375   /* protection. */
5376   /* display tables */
5377
5378   DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
5379 *The display table currently in use.
5380 This is a specifier; use `set-specifier' to change it.
5381
5382 Display tables are used to control how characters are displayed.  Each
5383 time that redisplay processes a character, it is looked up in all the
5384 display tables that apply (obtained by calling `specifier-instance' on
5385 `current-display-table' and any overriding display tables specified in
5386 currently active faces).  The first entry found that matches the
5387 character determines how the character is displayed.  If there is no
5388 matching entry, the default display method is used. (Non-control
5389 characters are displayed as themselves and control characters are
5390 displayed according to the buffer-local variable `ctl-arrow'.  Control
5391 characters are further affected by `control-arrow-glyph' and
5392 `octal-escape-glyph'.)
5393
5394 Each instantiator in this specifier and the display-table specifiers
5395 in faces is a display table or a list of such tables.  If a list, each
5396 table will be searched in turn for an entry matching a particular
5397 character.  Each display table is one of
5398
5399 -- a vector, specifying values for characters starting at 0
5400 -- a char table, either of type `char' or `generic'
5401 -- a range table
5402
5403 Each entry in a display table should be one of
5404
5405 -- nil (this entry is ignored and the search continues)
5406 -- a character (use this character; if it happens to be the same as
5407    the original character, default processing happens, otherwise
5408    redisplay attempts to display this character directly;
5409    #### At some point recursive display-table lookup will be
5410    implemented.)
5411 -- a string (display each character in the string directly;
5412    #### At some point recursive display-table lookup will be
5413    implemented.)
5414 -- a glyph (display the glyph;
5415    #### At some point recursive display-table lookup will be
5416    implemented when a string glyph is being processed.)
5417 -- a cons of the form (format "STRING") where STRING is a printf-like
5418    spec used to process the character. #### Unfortunately no
5419    formatting directives other than %% are implemented.
5420 -- a vector (each element of the vector is processed recursively;
5421    in such a case, nil elements in the vector are simply ignored)
5422
5423 #### At some point in the near future, display tables are likely to
5424 be expanded to include other features, such as referencing characters
5425 in particular fonts and allowing the character search to continue
5426 all the way up the chain of specifier instantiators.  These features
5427 are necessary to properly display Unicode characters.
5428 */ );
5429   Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
5430   set_specifier_fallback (Vcurrent_display_table,
5431                           list1 (Fcons (Qnil, Qnil)));
5432   set_specifier_caching (Vcurrent_display_table,
5433                          offsetof (struct window, display_table),
5434                          some_window_value_changed,
5435                          0, 0, 0);
5436 }
5437
5438 void
5439 complex_vars_of_glyphs (void)
5440 {
5441   /* Partially initialized in glyphs-x.c, glyphs.el */
5442   DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
5443 What to display at the end of truncated lines.
5444 */ );
5445   Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5446
5447   /* Partially initialized in glyphs-x.c, glyphs.el */
5448   DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
5449 What to display at the end of wrapped lines.
5450 */ );
5451   Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5452
5453   /* Partially initialized in glyphs-x.c, glyphs.el */
5454   DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
5455 The glyph used to display the XEmacs logo at startup.
5456 */ );
5457   Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);
5458 }