Reformatted.
[chise/xemacs-chise.git.1] / 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 mapexp = 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 (mapexp);
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)] = mapexp;
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 mapexp = 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 (mapexp, 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   /* If geometry is unspecified then get some reasonable values for it. */
1993   if (width == IMAGE_UNSPECIFIED_GEOMETRY
1994       ||
1995       height == IMAGE_UNSPECIFIED_GEOMETRY)
1996     {
1997       int dwidth = IMAGE_UNSPECIFIED_GEOMETRY;
1998       int dheight = IMAGE_UNSPECIFIED_GEOMETRY;
1999       /* Get the desired geometry. */
2000       image_instance_query_geometry (image_instance,
2001                                      &dwidth, &dheight,
2002                                      IMAGE_DESIRED_GEOMETRY,
2003                                      domain);
2004       /* Compare with allowed geometry. */
2005       if (width == IMAGE_UNSPECIFIED_GEOMETRY)
2006         width = dwidth;
2007       if (height == IMAGE_UNSPECIFIED_GEOMETRY)
2008         height = dheight;
2009     }
2010
2011   /* If we don't have sane values then we cannot layout at this point and
2012      must just return. */
2013   if (width == IMAGE_UNSPECIFIED_GEOMETRY
2014       ||
2015       height == IMAGE_UNSPECIFIED_GEOMETRY)
2016       return;
2017
2018   /* At this point width and height should contain sane values. Thus
2019      we set the glyph geometry and lay it out. */
2020   if (IMAGE_INSTANCE_WIDTH (ii) != width
2021       ||
2022       IMAGE_INSTANCE_HEIGHT (ii) != height)
2023     {
2024       IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
2025     }
2026
2027   IMAGE_INSTANCE_WIDTH (ii) = width;
2028   IMAGE_INSTANCE_HEIGHT (ii) = height;
2029
2030   type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii));
2031   meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
2032
2033   MAYBE_IIFORMAT_METH (meths, layout,
2034                        (image_instance, width, height, xoffset, yoffset,
2035                         domain));
2036   /* Do not clear the dirty flag here - redisplay will do this for
2037      us at the end. */
2038   IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0;
2039 }
2040
2041 /* Update an image instance from its changed instantiator. */
2042 static void
2043 update_image_instance (Lisp_Object image_instance,
2044                        Lisp_Object instantiator)
2045 {
2046   struct image_instantiator_methods* meths;
2047   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2048
2049   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
2050
2051   if (NOTHING_IMAGE_INSTANCEP (image_instance))
2052     return;
2053
2054   assert (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0)
2055           || (internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0)
2056            && internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, -10)));
2057
2058   /* If the instantiator is identical then do nothing. We must use
2059      equal here because the specifier code copies the instantiator. */
2060   if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0))
2061     {
2062       /* Extract the changed properties so that device / format
2063          methods only have to cope with these. We assume that
2064          normalization has already been done. */
2065       Lisp_Object diffs = find_instantiator_differences
2066         (instantiator,
2067          IMAGE_INSTANCE_INSTANTIATOR (ii));
2068       Lisp_Object type = encode_image_instance_type
2069         (IMAGE_INSTANCE_TYPE (ii));
2070       struct gcpro gcpro1;
2071       GCPRO1 (diffs);
2072
2073       /* try device specific methods first ... */
2074       meths = decode_device_ii_format (image_instance_device (image_instance),
2075                                        type, ERROR_ME_NOT);
2076       MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs));
2077       /* ... then format specific methods ... */
2078       meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT);
2079       MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs));
2080
2081       /* Instance and therefore glyph has changed so mark as dirty.
2082          If we don't do this output optimizations will assume the
2083          glyph is unchanged. */
2084       set_image_instance_dirty_p (image_instance, 1);
2085       /* Structure has changed. */
2086       IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
2087
2088       UNGCPRO;
2089     }
2090   /* We should now have a consistent instantiator so keep a record of
2091      it. It is important that we don't actually update the window
2092      system widgets here - we must do that when redisplay tells us
2093      to.
2094
2095      #### should we delay doing this until the display is up-to-date
2096      also? */
2097   IMAGE_INSTANCE_INSTANTIATOR (ii) = instantiator;
2098 }
2099
2100 /*
2101  * Mark image instance in W as dirty if (a) W's faces have changed and
2102  * (b) GLYPH_OR_II instance in W is a string.
2103  *
2104  * Return non-zero if instance has been marked dirty.
2105  */
2106 int
2107 invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w)
2108 {
2109   if (XFRAME(WINDOW_FRAME(w))->faces_changed)
2110     {
2111       Lisp_Object image = glyph_or_ii;
2112
2113       if (GLYPHP (glyph_or_ii))
2114         {
2115           Lisp_Object window;
2116           XSETWINDOW (window, w);
2117           image = glyph_image_instance (glyph_or_ii, window, ERROR_ME_NOT, 1);
2118         }
2119
2120       if (TEXT_IMAGE_INSTANCEP (image))
2121         {
2122           Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image);
2123           IMAGE_INSTANCE_DIRTYP (ii) = 1;
2124           IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1;
2125           if (GLYPHP (glyph_or_ii))
2126             XGLYPH_DIRTYP (glyph_or_ii) = 1;
2127           return 1;
2128         }
2129     }
2130
2131   return 0;
2132 }
2133
2134 \f
2135 /************************************************************************/
2136 /*                              error helpers                           */
2137 /************************************************************************/
2138 DOESNT_RETURN
2139 signal_image_error (const char *reason, Lisp_Object frob)
2140 {
2141   signal_error (Qimage_conversion_error,
2142                 list2 (build_translated_string (reason), frob));
2143 }
2144
2145 DOESNT_RETURN
2146 signal_image_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1)
2147 {
2148   signal_error (Qimage_conversion_error,
2149                 list3 (build_translated_string (reason), frob0, frob1));
2150 }
2151
2152 /****************************************************************************
2153  *                                  nothing                                 *
2154  ****************************************************************************/
2155
2156 static int
2157 nothing_possible_dest_types (void)
2158 {
2159   return IMAGE_NOTHING_MASK;
2160 }
2161
2162 static void
2163 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2164                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2165                      int dest_mask, Lisp_Object domain)
2166 {
2167   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2168
2169   if (dest_mask & IMAGE_NOTHING_MASK)
2170     {
2171       IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING;
2172       IMAGE_INSTANCE_HEIGHT (ii) = 0;
2173       IMAGE_INSTANCE_WIDTH (ii) = 0;
2174     }
2175   else
2176     incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK);
2177 }
2178
2179 \f
2180 /****************************************************************************
2181  *                                  inherit                                 *
2182  ****************************************************************************/
2183
2184 static void
2185 inherit_validate (Lisp_Object instantiator)
2186 {
2187   face_must_be_present (instantiator);
2188 }
2189
2190 static Lisp_Object
2191 inherit_normalize (Lisp_Object inst, Lisp_Object console_type,
2192                    Lisp_Object dest_mask)
2193 {
2194   Lisp_Object face;
2195
2196   assert (XVECTOR_LENGTH (inst) == 3);
2197   face = XVECTOR_DATA (inst)[2];
2198   if (!FACEP (face))
2199     inst = vector3 (Qinherit, Q_face, Fget_face (face));
2200   return inst;
2201 }
2202
2203 static int
2204 inherit_possible_dest_types (void)
2205 {
2206   return IMAGE_MONO_PIXMAP_MASK;
2207 }
2208
2209 static void
2210 inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2211                      Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2212                      int dest_mask, Lisp_Object domain)
2213 {
2214   /* handled specially in image_instantiate */
2215   ABORT ();
2216 }
2217
2218 \f
2219 /****************************************************************************
2220  *                                  string                                  *
2221  ****************************************************************************/
2222
2223 static void
2224 string_validate (Lisp_Object instantiator)
2225 {
2226   data_must_be_present (instantiator);
2227 }
2228
2229 static int
2230 string_possible_dest_types (void)
2231 {
2232   return IMAGE_TEXT_MASK;
2233 }
2234
2235 /* Called from autodetect_instantiate() */
2236 void
2237 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
2238                     Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2239                     int dest_mask, Lisp_Object domain)
2240 {
2241   Lisp_Object string = find_keyword_in_vector (instantiator, Q_data);
2242   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2243
2244   /* Should never get here with a domain other than a window. */
2245   assert (!NILP (string) && WINDOWP (DOMAIN_WINDOW (domain)));
2246   if (dest_mask & IMAGE_TEXT_MASK)
2247     {
2248       IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT;
2249       IMAGE_INSTANCE_TEXT_STRING (ii) = string;
2250     }
2251   else
2252     incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK);
2253 }
2254
2255 /* Sort out the size of the text that is being displayed. Calculating
2256    it dynamically allows us to change the text and still see
2257    everything. Note that the following methods are for text not string
2258    since that is what the instantiated type is. The first method is a
2259    helper that is used elsewhere for calculating text geometry. */
2260 void
2261 query_string_geometry (Lisp_Object string, Lisp_Object face,
2262                        int* width, int* height, int* descent, Lisp_Object domain)
2263 {
2264   struct font_metric_info fm;
2265   Charset_ID charsets[NUM_LEADING_BYTES];
2266   struct face_cachel frame_cachel;
2267   struct face_cachel *cachel;
2268   Lisp_Object frame = DOMAIN_FRAME (domain);
2269
2270   CHECK_STRING (string);
2271
2272   /* Compute height */
2273   if (height)
2274     {
2275       /* Compute string metric info */
2276       find_charsets_in_bufbyte_string (charsets,
2277                                        XSTRING_DATA   (string),
2278                                        XSTRING_LENGTH (string));
2279
2280       /* Fallback to the default face if none was provided. */
2281       if (!NILP (face))
2282         {
2283           reset_face_cachel (&frame_cachel);
2284           update_face_cachel_data (&frame_cachel, frame, face);
2285           cachel = &frame_cachel;
2286         }
2287       else
2288         {
2289           cachel = WINDOW_FACE_CACHEL (DOMAIN_XWINDOW (domain),
2290                                        DEFAULT_INDEX);
2291         }
2292
2293       ensure_face_cachel_complete (cachel, domain, charsets);
2294       face_cachel_charset_font_metric_info (cachel, charsets, &fm);
2295
2296       *height = fm.ascent + fm.descent;
2297       /* #### descent only gets set if we query the height as well. */
2298       if (descent)
2299         *descent = fm.descent;
2300     }
2301
2302   /* Compute width */
2303   if (width)
2304     {
2305       if (!NILP (face))
2306         *width = redisplay_frame_text_width_string (XFRAME (frame),
2307                                                     face,
2308                                                     0, string, 0, -1);
2309       else
2310         *width = redisplay_frame_text_width_string (XFRAME (frame),
2311                                                     Vdefault_face,
2312                                                     0, string, 0, -1);
2313     }
2314 }
2315
2316 Lisp_Object
2317 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain)
2318 {
2319   Charset_ID charsets[NUM_LEADING_BYTES];
2320   struct face_cachel frame_cachel;
2321   struct face_cachel *cachel;
2322   int i;
2323   Lisp_Object frame = DOMAIN_FRAME (domain);
2324
2325   /* Compute string font info */
2326   find_charsets_in_bufbyte_string (charsets,
2327                                    XSTRING_DATA   (string),
2328                                    XSTRING_LENGTH (string));
2329
2330   reset_face_cachel (&frame_cachel);
2331   update_face_cachel_data (&frame_cachel, frame, face);
2332   cachel = &frame_cachel;
2333
2334   ensure_face_cachel_complete (cachel, domain, charsets);
2335
2336   for (i = 0; i < NUM_LEADING_BYTES; i++)
2337     {
2338       if (charsets[i])
2339         {
2340           return FACE_CACHEL_FONT (cachel,
2341                                    CHARSET_BY_LEADING_BYTE (i +
2342                                                             MIN_LEADING_BYTE));
2343
2344         }
2345     }
2346
2347   return Qnil;                  /* NOT REACHED */
2348 }
2349
2350 static void
2351 text_query_geometry (Lisp_Object image_instance,
2352                      int* width, int* height,
2353                      enum image_instance_geometry disp, Lisp_Object domain)
2354 {
2355   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
2356   int descent = 0;
2357
2358   query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii),
2359                          IMAGE_INSTANCE_FACE (ii),
2360                          width, height, &descent, domain);
2361
2362   /* The descent gets set as a side effect of querying the
2363      geometry. */
2364   IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent;
2365 }
2366
2367 /* set the properties of a string */
2368 static void
2369 text_update (Lisp_Object image_instance, Lisp_Object instantiator)
2370 {
2371   Lisp_Object val = find_keyword_in_vector (instantiator, Q_data);
2372
2373   if (!NILP (val))
2374     {
2375       CHECK_STRING (val);
2376       XIMAGE_INSTANCE_TEXT_STRING (image_instance) = val;
2377     }
2378 }
2379
2380 \f
2381 /****************************************************************************
2382  *                             formatted-string                             *
2383  ****************************************************************************/
2384
2385 static void
2386 formatted_string_validate (Lisp_Object instantiator)
2387 {
2388   data_must_be_present (instantiator);
2389 }
2390
2391 static int
2392 formatted_string_possible_dest_types (void)
2393 {
2394   return IMAGE_TEXT_MASK;
2395 }
2396
2397 static void
2398 formatted_string_instantiate (Lisp_Object image_instance,
2399                               Lisp_Object instantiator,
2400                               Lisp_Object pointer_fg, Lisp_Object pointer_bg,
2401                               int dest_mask, Lisp_Object domain)
2402 {
2403   /* #### implement this */
2404   warn_when_safe (Qunimplemented, Qnotice,
2405                   "`formatted-string' not yet implemented; assuming `string'");
2406
2407   string_instantiate (image_instance, instantiator,
2408                       pointer_fg, pointer_bg, dest_mask, domain);
2409 }
2410
2411 \f
2412 /************************************************************************/
2413 /*                        pixmap file functions                         */
2414 /************************************************************************/
2415
2416 /* If INSTANTIATOR refers to inline data, return Qnil.
2417    If INSTANTIATOR refers to data in a file, return the full filename
2418    if it exists; otherwise, return a cons of (filename).
2419
2420    FILE_KEYWORD and DATA_KEYWORD are symbols specifying the
2421    keywords used to look up the file and inline data,
2422    respectively, in the instantiator.  Normally these would
2423    be Q_file and Q_data, but might be different for mask data. */
2424
2425 Lisp_Object
2426 potential_pixmap_file_instantiator (Lisp_Object instantiator,
2427                                     Lisp_Object file_keyword,
2428                                     Lisp_Object data_keyword,
2429                                     Lisp_Object console_type)
2430 {
2431   Lisp_Object file;
2432   Lisp_Object data;
2433
2434   assert (VECTORP (instantiator));
2435
2436   data = find_keyword_in_vector (instantiator, data_keyword);
2437   file = find_keyword_in_vector (instantiator, file_keyword);
2438
2439   if (!NILP (file) && NILP (data))
2440     {
2441       Lisp_Object retval = MAYBE_LISP_CONTYPE_METH
2442         (decode_console_type(console_type, ERROR_ME),
2443          locate_pixmap_file, (file));
2444
2445       if (!NILP (retval))
2446         return retval;
2447       else
2448         return Fcons (file, Qnil); /* should have been file */
2449     }
2450
2451   return Qnil;
2452 }
2453
2454 Lisp_Object
2455 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type,
2456                              Lisp_Object image_type_tag)
2457 {
2458   /* This function can call lisp */
2459   Lisp_Object file = Qnil;
2460   struct gcpro gcpro1, gcpro2;
2461   Lisp_Object alist = Qnil;
2462
2463   GCPRO2 (file, alist);
2464
2465   /* Now, convert any file data into inline data.  At the end of this,
2466      `data' will contain the inline data (if any) or Qnil, and `file'
2467      will contain the name this data was derived from (if known) or
2468      Qnil.
2469
2470      Note that if we cannot generate any regular inline data, we
2471      skip out. */
2472
2473   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2474                                              console_type);
2475
2476   if (CONSP (file)) /* failure locating filename */
2477     signal_double_file_error ("Opening pixmap file",
2478                               "no such file or directory",
2479                               Fcar (file));
2480
2481   if (NILP (file)) /* no conversion necessary */
2482     RETURN_UNGCPRO (inst);
2483
2484   alist = tagged_vector_to_alist (inst);
2485
2486   {
2487     Lisp_Object data = make_string_from_file (file);
2488     alist = remassq_no_quit (Q_file, alist);
2489     /* there can't be a :data at this point. */
2490     alist = Fcons (Fcons (Q_file, file),
2491                    Fcons (Fcons (Q_data, data), alist));
2492   }
2493
2494   {
2495     Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist);
2496     free_alist (alist);
2497     RETURN_UNGCPRO (result);
2498   }
2499 }
2500
2501 \f
2502 #ifdef HAVE_WINDOW_SYSTEM
2503 /**********************************************************************
2504  *                             XBM                                    *
2505  **********************************************************************/
2506
2507 /* Check if DATA represents a valid inline XBM spec (i.e. a list
2508    of (width height bits), with checking done on the dimensions).
2509    If not, signal an error. */
2510
2511 static void
2512 check_valid_xbm_inline (Lisp_Object data)
2513 {
2514   Lisp_Object width, height, bits;
2515
2516   if (!CONSP (data) ||
2517       !CONSP (XCDR (data)) ||
2518       !CONSP (XCDR (XCDR (data))) ||
2519       !NILP (XCDR (XCDR (XCDR (data)))))
2520     signal_simple_error ("Must be list of 3 elements", data);
2521
2522   width  = XCAR (data);
2523   height = XCAR (XCDR (data));
2524   bits   = XCAR (XCDR (XCDR (data)));
2525
2526   CHECK_STRING (bits);
2527
2528   if (!NATNUMP (width))
2529     signal_simple_error ("Width must be a natural number", width);
2530
2531   if (!NATNUMP (height))
2532     signal_simple_error ("Height must be a natural number", height);
2533
2534   if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits))
2535     signal_simple_error ("data is too short for width and height",
2536                          vector3 (width, height, bits));
2537 }
2538
2539 /* Validate method for XBM's. */
2540
2541 static void
2542 xbm_validate (Lisp_Object instantiator)
2543 {
2544   file_or_data_must_be_present (instantiator);
2545 }
2546
2547 /* Given a filename that is supposed to contain XBM data, return
2548    the inline representation of it as (width height bits).  Return
2549    the hotspot through XHOT and YHOT, if those pointers are not 0.
2550    If there is no hotspot, XHOT and YHOT will contain -1.
2551
2552    If the function fails:
2553
2554    -- if OK_IF_DATA_INVALID is set and the data was invalid,
2555       return Qt.
2556    -- maybe return an error, or return Qnil.
2557  */
2558
2559 #ifdef HAVE_X_WINDOWS
2560 #include <X11/Xlib.h>
2561 #else
2562 #define XFree(data) free(data)
2563 #endif
2564
2565 Lisp_Object
2566 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot,
2567                      int ok_if_data_invalid)
2568 {
2569   unsigned int w, h;
2570   Extbyte *data;
2571   int result;
2572   const char *filename_ext;
2573
2574   LISP_STRING_TO_EXTERNAL (name, filename_ext, Qfile_name);
2575   result = read_bitmap_data_from_file (filename_ext, &w, &h,
2576                                        (unsigned char **) &data, xhot, yhot);
2577
2578   if (result == BitmapSuccess)
2579     {
2580       Lisp_Object retval;
2581       int len = (w + 7) / 8 * h;
2582
2583       retval = list3 (make_int (w), make_int (h),
2584                       make_ext_string (data, len, Qbinary));
2585       XFree (data);
2586       return retval;
2587     }
2588
2589   switch (result)
2590     {
2591     case BitmapOpenFailed:
2592       {
2593         /* should never happen */
2594         signal_double_file_error ("Opening bitmap file",
2595                                   "no such file or directory",
2596                                   name);
2597       }
2598     case BitmapFileInvalid:
2599       {
2600         if (ok_if_data_invalid)
2601           return Qt;
2602         signal_double_file_error ("Reading bitmap file",
2603                                   "invalid data in file",
2604                                   name);
2605       }
2606     case BitmapNoMemory:
2607       {
2608         signal_double_file_error ("Reading bitmap file",
2609                                   "out of memory",
2610                                   name);
2611       }
2612     default:
2613       {
2614         signal_double_file_error_2 ("Reading bitmap file",
2615                                     "unknown error code",
2616                                     make_int (result), name);
2617       }
2618     }
2619
2620   return Qnil; /* not reached */
2621 }
2622
2623 Lisp_Object
2624 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file,
2625                        Lisp_Object mask_file, Lisp_Object console_type)
2626 {
2627   /* This is unclean but it's fairly standard -- a number of the
2628      bitmaps in /usr/include/X11/bitmaps use it -- so we support
2629      it. */
2630   if (NILP (mask_file)
2631       /* don't override explicitly specified mask data. */
2632       && NILP (assq_no_quit (Q_mask_data, alist))
2633       && !NILP (file))
2634     {
2635       mask_file = MAYBE_LISP_CONTYPE_METH
2636         (decode_console_type(console_type, ERROR_ME),
2637          locate_pixmap_file, (concat2 (file, build_string ("Mask"))));
2638       if (NILP (mask_file))
2639         mask_file = MAYBE_LISP_CONTYPE_METH
2640           (decode_console_type(console_type, ERROR_ME),
2641            locate_pixmap_file, (concat2 (file, build_string ("msk"))));
2642     }
2643
2644   if (!NILP (mask_file))
2645     {
2646       Lisp_Object mask_data =
2647         bitmap_to_lisp_data (mask_file, 0, 0, 0);
2648       alist = remassq_no_quit (Q_mask_file, alist);
2649       /* there can't be a :mask-data at this point. */
2650       alist = Fcons (Fcons (Q_mask_file, mask_file),
2651                      Fcons (Fcons (Q_mask_data, mask_data), alist));
2652     }
2653
2654   return alist;
2655 }
2656
2657 /* Normalize method for XBM's. */
2658
2659 static Lisp_Object
2660 xbm_normalize (Lisp_Object inst, Lisp_Object console_type,
2661                Lisp_Object dest_mask)
2662 {
2663   Lisp_Object file = Qnil, mask_file = Qnil;
2664   struct gcpro gcpro1, gcpro2, gcpro3;
2665   Lisp_Object alist = Qnil;
2666
2667   GCPRO3 (file, mask_file, alist);
2668
2669   /* Now, convert any file data into inline data for both the regular
2670      data and the mask data.  At the end of this, `data' will contain
2671      the inline data (if any) or Qnil, and `file' will contain
2672      the name this data was derived from (if known) or Qnil.
2673      Likewise for `mask_file' and `mask_data'.
2674
2675      Note that if we cannot generate any regular inline data, we
2676      skip out. */
2677
2678   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2679                                              console_type);
2680   mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2681                                                   Q_mask_data, console_type);
2682
2683   if (CONSP (file)) /* failure locating filename */
2684     signal_double_file_error ("Opening bitmap file",
2685                               "no such file or directory",
2686                               Fcar (file));
2687
2688   if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2689     RETURN_UNGCPRO (inst);
2690
2691   alist = tagged_vector_to_alist (inst);
2692
2693   if (!NILP (file))
2694     {
2695       int xhot, yhot;
2696       Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0);
2697       alist = remassq_no_quit (Q_file, alist);
2698       /* there can't be a :data at this point. */
2699       alist = Fcons (Fcons (Q_file, file),
2700                      Fcons (Fcons (Q_data, data), alist));
2701
2702       if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist)))
2703         alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)),
2704                        alist);
2705       if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist)))
2706         alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)),
2707                        alist);
2708     }
2709
2710   alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2711
2712   {
2713     Lisp_Object result = alist_to_tagged_vector (Qxbm, alist);
2714     free_alist (alist);
2715     RETURN_UNGCPRO (result);
2716   }
2717 }
2718
2719 \f
2720 static int
2721 xbm_possible_dest_types (void)
2722 {
2723   return
2724     IMAGE_MONO_PIXMAP_MASK  |
2725     IMAGE_COLOR_PIXMAP_MASK |
2726     IMAGE_POINTER_MASK;
2727 }
2728
2729 #endif
2730
2731 \f
2732 #ifdef HAVE_XFACE
2733 /**********************************************************************
2734  *                             X-Face                                 *
2735  **********************************************************************/
2736
2737 static void
2738 xface_validate (Lisp_Object instantiator)
2739 {
2740   file_or_data_must_be_present (instantiator);
2741 }
2742
2743 static Lisp_Object
2744 xface_normalize (Lisp_Object inst, Lisp_Object console_type,
2745                  Lisp_Object dest_mask)
2746 {
2747   /* This function can call lisp */
2748   Lisp_Object file = Qnil, mask_file = Qnil;
2749   struct gcpro gcpro1, gcpro2, gcpro3;
2750   Lisp_Object alist = Qnil;
2751
2752   GCPRO3 (file, mask_file, alist);
2753
2754   /* Now, convert any file data into inline data for both the regular
2755      data and the mask data.  At the end of this, `data' will contain
2756      the inline data (if any) or Qnil, and `file' will contain
2757      the name this data was derived from (if known) or Qnil.
2758      Likewise for `mask_file' and `mask_data'.
2759
2760      Note that if we cannot generate any regular inline data, we
2761      skip out. */
2762
2763   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2764                                              console_type);
2765   mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file,
2766                                                   Q_mask_data, console_type);
2767
2768   if (CONSP (file)) /* failure locating filename */
2769     signal_double_file_error ("Opening bitmap file",
2770                               "no such file or directory",
2771                               Fcar (file));
2772
2773   if (NILP (file) && NILP (mask_file)) /* no conversion necessary */
2774     RETURN_UNGCPRO (inst);
2775
2776   alist = tagged_vector_to_alist (inst);
2777
2778   {
2779     Lisp_Object data = make_string_from_file (file);
2780     alist = remassq_no_quit (Q_file, alist);
2781     /* there can't be a :data at this point. */
2782     alist = Fcons (Fcons (Q_file, file),
2783                    Fcons (Fcons (Q_data, data), alist));
2784   }
2785
2786   alist = xbm_mask_file_munging (alist, file, mask_file, console_type);
2787
2788   {
2789     Lisp_Object result = alist_to_tagged_vector (Qxface, alist);
2790     free_alist (alist);
2791     RETURN_UNGCPRO (result);
2792   }
2793 }
2794
2795 static int
2796 xface_possible_dest_types (void)
2797 {
2798   return
2799     IMAGE_MONO_PIXMAP_MASK  |
2800     IMAGE_COLOR_PIXMAP_MASK |
2801     IMAGE_POINTER_MASK;
2802 }
2803
2804 #endif /* HAVE_XFACE */
2805
2806 \f
2807 #ifdef HAVE_XPM
2808
2809 /**********************************************************************
2810  *                             XPM                                    *
2811  **********************************************************************/
2812
2813 #ifdef HAVE_GTK
2814 /* Gtk has to be gratuitously different, eh? */
2815 Lisp_Object
2816 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2817 {
2818   return (make_string_from_file (name));
2819 }
2820 #else
2821 Lisp_Object
2822 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid)
2823 {
2824   char **data;
2825   int result;
2826   char *fname = 0;
2827
2828   LISP_STRING_TO_EXTERNAL (name, fname, Qfile_name);
2829   result = XpmReadFileToData (fname, &data);
2830
2831   if (result == XpmSuccess)
2832     {
2833       Lisp_Object retval = Qnil;
2834       struct buffer *old_buffer = current_buffer;
2835       Lisp_Object temp_buffer =
2836         Fget_buffer_create (build_string (" *pixmap conversion*"));
2837       int elt;
2838       int height, width, ncolors;
2839       struct gcpro gcpro1, gcpro2, gcpro3;
2840       int speccount = specpdl_depth ();
2841
2842       GCPRO3 (name, retval, temp_buffer);
2843
2844       specbind (Qinhibit_quit, Qt);
2845       set_buffer_internal (XBUFFER (temp_buffer));
2846       Ferase_buffer (Qnil);
2847
2848       buffer_insert_c_string (current_buffer, "/* XPM */\r");
2849       buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r");
2850
2851       sscanf (data[0], "%d %d %d", &height, &width, &ncolors);
2852       for (elt = 0; elt <= width + ncolors; elt++)
2853         {
2854           buffer_insert_c_string (current_buffer, "\"");
2855           buffer_insert_c_string (current_buffer, data[elt]);
2856
2857           if (elt < width + ncolors)
2858             buffer_insert_c_string (current_buffer, "\",\r");
2859           else
2860             buffer_insert_c_string (current_buffer, "\"};\r");
2861         }
2862
2863       retval = Fbuffer_substring (Qnil, Qnil, Qnil);
2864       XpmFree (data);
2865
2866       set_buffer_internal (old_buffer);
2867       unbind_to (speccount, Qnil);
2868
2869       RETURN_UNGCPRO (retval);
2870     }
2871
2872   switch (result)
2873     {
2874     case XpmFileInvalid:
2875       {
2876         if (ok_if_data_invalid)
2877           return Qt;
2878         signal_image_error ("invalid XPM data in file", name);
2879       }
2880     case XpmNoMemory:
2881       {
2882         signal_double_file_error ("Reading pixmap file",
2883                                   "out of memory", name);
2884       }
2885     case XpmOpenFailed:
2886       {
2887         /* should never happen? */
2888         signal_double_file_error ("Opening pixmap file",
2889                                   "no such file or directory", name);
2890       }
2891     default:
2892       {
2893         signal_double_file_error_2 ("Parsing pixmap file",
2894                                     "unknown error code",
2895                                     make_int (result), name);
2896         break;
2897       }
2898     }
2899
2900   return Qnil; /* not reached */
2901 }
2902 #endif /* !HAVE_GTK */
2903
2904 static void
2905 check_valid_xpm_color_symbols (Lisp_Object data)
2906 {
2907   Lisp_Object rest;
2908
2909   for (rest = data; !NILP (rest); rest = XCDR (rest))
2910     {
2911       if (!CONSP (rest) ||
2912           !CONSP (XCAR (rest)) ||
2913           !STRINGP (XCAR (XCAR (rest))) ||
2914           (!STRINGP (XCDR (XCAR (rest))) &&
2915            !COLOR_SPECIFIERP (XCDR (XCAR (rest)))))
2916         signal_simple_error ("Invalid color symbol alist", data);
2917     }
2918 }
2919
2920 static void
2921 xpm_validate (Lisp_Object instantiator)
2922 {
2923   file_or_data_must_be_present (instantiator);
2924 }
2925
2926 Lisp_Object Vxpm_color_symbols;
2927
2928 Lisp_Object
2929 evaluate_xpm_color_symbols (void)
2930 {
2931   Lisp_Object rest, results = Qnil;
2932   struct gcpro gcpro1, gcpro2;
2933
2934   GCPRO2 (rest, results);
2935   for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest))
2936     {
2937       Lisp_Object name, value, cons;
2938
2939       CHECK_CONS (rest);
2940       cons = XCAR (rest);
2941       CHECK_CONS (cons);
2942       name = XCAR (cons);
2943       CHECK_STRING (name);
2944       value = XCDR (cons);
2945       CHECK_CONS (value);
2946       value = XCAR (value);
2947       value = Feval (value);
2948       if (NILP (value))
2949         continue;
2950       if (!STRINGP (value) && !COLOR_SPECIFIERP (value))
2951         signal_simple_error
2952           ("Result from xpm-color-symbols eval must be nil, string, or color",
2953            value);
2954       results = Fcons (Fcons (name, value), results);
2955     }
2956   UNGCPRO;                      /* no more evaluation */
2957   return results;
2958 }
2959
2960 static Lisp_Object
2961 xpm_normalize (Lisp_Object inst, Lisp_Object console_type,
2962                Lisp_Object dest_mask)
2963 {
2964   Lisp_Object file = Qnil;
2965   Lisp_Object color_symbols;
2966   struct gcpro gcpro1, gcpro2;
2967   Lisp_Object alist = Qnil;
2968
2969   GCPRO2 (file, alist);
2970
2971   /* Now, convert any file data into inline data.  At the end of this,
2972      `data' will contain the inline data (if any) or Qnil, and
2973      `file' will contain the name this data was derived from (if
2974      known) or Qnil.
2975
2976      Note that if we cannot generate any regular inline data, we
2977      skip out. */
2978
2979   file = potential_pixmap_file_instantiator (inst, Q_file, Q_data,
2980                                              console_type);
2981
2982   if (CONSP (file)) /* failure locating filename */
2983     signal_double_file_error ("Opening pixmap file",
2984                               "no such file or directory",
2985                               Fcar (file));
2986
2987   color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols,
2988                                                    Qunbound);
2989
2990   if (NILP (file) && !UNBOUNDP (color_symbols))
2991     /* no conversion necessary */
2992     RETURN_UNGCPRO (inst);
2993
2994   alist = tagged_vector_to_alist (inst);
2995
2996   if (!NILP (file))
2997     {
2998       Lisp_Object data = pixmap_to_lisp_data (file, 0);
2999       alist = remassq_no_quit (Q_file, alist);
3000       /* there can't be a :data at this point. */
3001       alist = Fcons (Fcons (Q_file, file),
3002                      Fcons (Fcons (Q_data, data), alist));
3003     }
3004
3005   if (UNBOUNDP (color_symbols))
3006     {
3007       color_symbols = evaluate_xpm_color_symbols ();
3008       alist = Fcons (Fcons (Q_color_symbols, color_symbols),
3009                      alist);
3010     }
3011
3012   {
3013     Lisp_Object result = alist_to_tagged_vector (Qxpm, alist);
3014     free_alist (alist);
3015     RETURN_UNGCPRO (result);
3016   }
3017 }
3018
3019 static int
3020 xpm_possible_dest_types (void)
3021 {
3022   return
3023     IMAGE_MONO_PIXMAP_MASK  |
3024     IMAGE_COLOR_PIXMAP_MASK |
3025     IMAGE_POINTER_MASK;
3026 }
3027
3028 #endif /* HAVE_XPM */
3029
3030 \f
3031 /****************************************************************************
3032  *                         Image Specifier Object                           *
3033  ****************************************************************************/
3034
3035 DEFINE_SPECIFIER_TYPE (image);
3036
3037 static void
3038 image_create (Lisp_Object obj)
3039 {
3040   Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3041
3042   IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */
3043   IMAGE_SPECIFIER_ATTACHEE (image) = Qnil;
3044   IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil;
3045 }
3046
3047 static void
3048 image_mark (Lisp_Object obj)
3049 {
3050   Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3051
3052   mark_object (IMAGE_SPECIFIER_ATTACHEE (image));
3053   mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image));
3054 }
3055
3056 static int
3057 instantiator_eq_equal (Lisp_Object obj1, Lisp_Object obj2)
3058 {
3059   if (EQ (obj1, obj2))
3060     return 1;
3061
3062   else if (CONSP (obj1) && CONSP (obj2))
3063     {
3064       return instantiator_eq_equal (XCAR (obj1), XCAR (obj2))
3065         &&
3066         instantiator_eq_equal (XCDR (obj1), XCDR (obj2));
3067     }
3068   return 0;
3069 }
3070
3071 static hashcode_t
3072 instantiator_eq_hash (Lisp_Object obj)
3073 {
3074   if (CONSP (obj))
3075     {
3076       /* no point in worrying about tail recursion, since we're not
3077          going very deep */
3078       return HASH2 (instantiator_eq_hash (XCAR (obj)),
3079                     instantiator_eq_hash (XCDR (obj)));
3080     }
3081   return LISP_HASH (obj);
3082 }
3083
3084 /* We need a special hash table for storing image instances. */
3085 Lisp_Object
3086 make_image_instance_cache_hash_table (void)
3087 {
3088   return make_general_lisp_hash_table
3089     (instantiator_eq_hash, instantiator_eq_equal,
3090      30, -1.0, -1.0,
3091      HASH_TABLE_KEY_CAR_VALUE_WEAK);
3092 }
3093
3094 static Lisp_Object
3095 image_instantiate_cache_result (Lisp_Object locative)
3096 {
3097   /* locative = (instance instantiator . subtable)
3098
3099      So we are using the instantiator as the key and the instance as
3100      the value. Since the hashtable is key-weak this means that the
3101      image instance will stay around as long as the instantiator stays
3102      around. The instantiator is stored in the `image' slot of the
3103      glyph, so as long as the glyph is marked the instantiator will be
3104      as well and hence the cached image instance also.*/
3105   Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative)));
3106   free_cons (XCONS (XCDR (locative)));
3107   free_cons (XCONS (locative));
3108   return Qnil;
3109 }
3110
3111 /* Given a specification for an image, return an instance of
3112    the image which matches the given instantiator and which can be
3113    displayed in the given domain. */
3114
3115 static Lisp_Object
3116 image_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
3117                    Lisp_Object domain, Lisp_Object instantiator,
3118                    Lisp_Object depth)
3119 {
3120   Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
3121   int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier);
3122   int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER);
3123
3124   if (IMAGE_INSTANCEP (instantiator))
3125     {
3126       /* make sure that the image instance's governing domain and type are
3127          matching. */
3128       Lisp_Object governing_domain = XIMAGE_INSTANCE_DOMAIN (instantiator);
3129
3130       if ((DEVICEP (governing_domain)
3131            && EQ (governing_domain, DOMAIN_DEVICE (domain)))
3132           || (FRAMEP (governing_domain)
3133               && EQ (governing_domain, DOMAIN_FRAME (domain)))
3134           || (WINDOWP (governing_domain)
3135               && EQ (governing_domain, DOMAIN_WINDOW (domain))))
3136         {
3137           int mask =
3138             image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator));
3139           if (mask & dest_mask)
3140             return instantiator;
3141           else
3142             signal_simple_error ("Type of image instance not allowed here",
3143                                  instantiator);
3144         }
3145       else
3146         signal_simple_error_2 ("Wrong domain for image instance",
3147                                instantiator, domain);
3148     }
3149   /* How ugly !! An image instanciator that uses a kludgy syntax to snarf in
3150      face properties. There's a design flaw here. -- didier */
3151   else if (VECTORP (instantiator)
3152            && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit))
3153     {
3154       assert (XVECTOR_LENGTH (instantiator) == 3);
3155       return (FACE_PROPERTY_INSTANCE
3156               (Fget_face (XVECTOR_DATA (instantiator)[2]),
3157                Qbackground_pixmap, domain, 1, depth));
3158     }
3159   else
3160     {
3161       Lisp_Object instance = Qnil;
3162       Lisp_Object subtable = Qnil;
3163       /* #### Should this be GCPRO'd? */
3164       Lisp_Object hash_key = Qnil;
3165       Lisp_Object pointer_fg = Qnil;
3166       Lisp_Object pointer_bg = Qnil;
3167       Lisp_Object governing_domain =
3168         get_image_instantiator_governing_domain (instantiator, domain);
3169       struct gcpro gcpro1;
3170
3171       GCPRO1 (instance);
3172
3173       /* We have to put subwindow, widget and text image instances in
3174          a per-window cache so that we can see the same glyph in
3175          different windows. We use governing_domain to determine the type
3176          of image_instance that will be created. */
3177
3178       if (pointerp)
3179         {
3180           pointer_fg = FACE_FOREGROUND (Vpointer_face, domain);
3181           pointer_bg = FACE_BACKGROUND (Vpointer_face, domain);
3182           hash_key = list4 (glyph, INSTANTIATOR_TYPE (instantiator),
3183                             pointer_fg, pointer_bg);
3184         }
3185       else
3186         /* We cannot simply key on the glyph since fallbacks could use
3187            the same glyph but have a totally different instantiator
3188            type. Thus we key on the glyph and the type (but not any
3189            other parts of the instantiator. */
3190         hash_key = list2 (glyph, INSTANTIATOR_TYPE (instantiator));
3191
3192       /* First look in the device cache. */
3193       if (DEVICEP (governing_domain))
3194         {
3195           subtable = Fgethash (make_int (dest_mask),
3196                                XDEVICE (governing_domain)->
3197                                image_instance_cache,
3198                                Qunbound);
3199           if (UNBOUNDP (subtable))
3200             {
3201               /* For the image instance cache, we do comparisons with
3202                  EQ rather than with EQUAL, as we do for color and
3203                  font names.  The reasons are:
3204
3205                  1) pixmap data can be very long, and thus the hashing
3206                  and comparing will take awhile.
3207
3208                  2) It's not so likely that we'll run into things that
3209                  are EQUAL but not EQ (that can happen a lot with
3210                  faces, because their specifiers are copied around);
3211                  but pixmaps tend not to be in faces.
3212
3213                  However, if the image-instance could be a pointer, we
3214                  have to use EQUAL because we massaged the
3215                  instantiator into a cons3 also containing the
3216                  foreground and background of the pointer face.  */
3217               subtable = make_image_instance_cache_hash_table ();
3218
3219               Fputhash (make_int (dest_mask), subtable,
3220                         XDEVICE (governing_domain)->image_instance_cache);
3221               instance = Qunbound;
3222             }
3223           else
3224             {
3225               instance = Fgethash (hash_key, subtable, Qunbound);
3226             }
3227         }
3228       else if (WINDOWP (governing_domain))
3229         {
3230           /* Subwindows have a per-window cache and have to be treated
3231              differently. */
3232           instance =
3233             Fgethash (hash_key,
3234                       XWINDOW (governing_domain)->subwindow_instance_cache,
3235                       Qunbound);
3236         }
3237       else
3238         ABORT ();       /* We're not allowed anything else currently. */
3239
3240       /* If we don't have an instance at this point then create
3241          one. */
3242       if (UNBOUNDP (instance))
3243         {
3244           Lisp_Object locative =
3245             noseeum_cons (Qnil,
3246                           noseeum_cons (hash_key,
3247                                         DEVICEP (governing_domain) ? subtable
3248                                         : XWINDOW (governing_domain)
3249                                         ->subwindow_instance_cache));
3250           int speccount = specpdl_depth ();
3251
3252           /* Make sure we cache the failures, too.  Use an
3253              unwind-protect to catch such errors.  If we fail, the
3254              unwind-protect records nil in the hash table.  If we
3255              succeed, we change the car of the locative to the
3256              resulting instance, which gets recorded instead. */
3257           record_unwind_protect (image_instantiate_cache_result,
3258                                  locative);
3259           instance =
3260             instantiate_image_instantiator (governing_domain,
3261                                             domain, instantiator,
3262                                             pointer_fg, pointer_bg,
3263                                             dest_mask, glyph);
3264
3265           /* We need a per-frame cache for redisplay. */
3266           cache_subwindow_instance_in_frame_maybe (instance);
3267
3268           Fsetcar (locative, instance);
3269 #ifdef ERROR_CHECK_GLYPHS
3270           if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
3271               & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
3272               assert (EQ (XIMAGE_INSTANCE_FRAME (instance),
3273                           DOMAIN_FRAME (domain)));
3274 #endif
3275           unbind_to (speccount, Qnil);
3276 #ifdef ERROR_CHECK_GLYPHS
3277           if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
3278               & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
3279             assert (EQ (Fgethash (hash_key,
3280                                   XWINDOW (governing_domain)
3281                                   ->subwindow_instance_cache,
3282                                   Qunbound), instance));
3283 #endif
3284         }
3285       else if (NILP (instance))
3286         signal_simple_error ("Can't instantiate image (probably cached)",
3287                              instantiator);
3288       /* We found an instance. However, because we are using the glyph
3289          as the hash key instead of the instantiator, the current
3290          instantiator may not be the same as the original. Thus we
3291          must update the instance based on the new
3292          instantiator. Preserving instance identity like this is
3293          important to stop excessive window system widget creation and
3294          deletion - and hence flashing. */
3295       else
3296         {
3297           /* #### This function should be able to cope with *all*
3298              changes to the instantiator, but currently only copes
3299              with the most used properties. This means that it is
3300              possible to make changes that don't get reflected in the
3301              display. */
3302           update_image_instance (instance, instantiator);
3303           free_list (hash_key);
3304         }
3305
3306 #ifdef ERROR_CHECK_GLYPHS
3307       if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance))
3308           & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK))
3309         assert (EQ (XIMAGE_INSTANCE_FRAME (instance),
3310                     DOMAIN_FRAME (domain)));
3311 #endif
3312       ERROR_CHECK_IMAGE_INSTANCE (instance);
3313       RETURN_UNGCPRO (instance);
3314     }
3315
3316   ABORT ();
3317   return Qnil; /* not reached */
3318 }
3319
3320 /* Validate an image instantiator. */
3321
3322 static void
3323 image_validate (Lisp_Object instantiator)
3324 {
3325   if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator))
3326     return;
3327   else if (VECTORP (instantiator))
3328     {
3329       Lisp_Object *elt = XVECTOR_DATA (instantiator);
3330       int instantiator_len = XVECTOR_LENGTH (instantiator);
3331       struct image_instantiator_methods *meths;
3332       Lisp_Object already_seen = Qnil;
3333       struct gcpro gcpro1;
3334       int i;
3335
3336       if (instantiator_len < 1)
3337         signal_simple_error ("Vector length must be at least 1",
3338                              instantiator);
3339
3340       meths = decode_image_instantiator_format (elt[0], ERROR_ME);
3341       if (!(instantiator_len & 1))
3342         signal_simple_error
3343           ("Must have alternating keyword/value pairs", instantiator);
3344
3345       GCPRO1 (already_seen);
3346
3347       for (i = 1; i < instantiator_len; i += 2)
3348         {
3349           Lisp_Object keyword = elt[i];
3350           Lisp_Object value = elt[i+1];
3351           int j;
3352
3353           CHECK_SYMBOL (keyword);
3354           if (!SYMBOL_IS_KEYWORD (keyword))
3355             signal_simple_error ("Symbol must begin with a colon", keyword);
3356
3357           for (j = 0; j < Dynarr_length (meths->keywords); j++)
3358             if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
3359               break;
3360
3361           if (j == Dynarr_length (meths->keywords))
3362             signal_simple_error ("Unrecognized keyword", keyword);
3363
3364           if (!Dynarr_at (meths->keywords, j).multiple_p)
3365             {
3366               if (!NILP (memq_no_quit (keyword, already_seen)))
3367                 signal_simple_error
3368                   ("Keyword may not appear more than once", keyword);
3369               already_seen = Fcons (keyword, already_seen);
3370             }
3371
3372           (Dynarr_at (meths->keywords, j).validate) (value);
3373         }
3374
3375       UNGCPRO;
3376
3377       MAYBE_IIFORMAT_METH (meths, validate, (instantiator));
3378     }
3379   else
3380     signal_simple_error ("Must be string or vector", instantiator);
3381 }
3382
3383 static void
3384 image_after_change (Lisp_Object specifier, Lisp_Object locale)
3385 {
3386   Lisp_Object attachee =
3387     IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier));
3388   Lisp_Object property =
3389     IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier));
3390   if (FACEP (attachee))
3391     {
3392       face_property_was_changed (attachee, property, locale);
3393       if (BUFFERP (locale))
3394         XBUFFER (locale)->buffer_local_face_property = 1;
3395     }
3396   else if (GLYPHP (attachee))
3397     glyph_property_was_changed (attachee, property, locale);
3398 }
3399
3400 void
3401 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph,
3402                        Lisp_Object property)
3403 {
3404   Lisp_Specifier *image = XIMAGE_SPECIFIER (obj);
3405
3406   IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph;
3407   IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property;
3408 }
3409
3410 static Lisp_Object
3411 image_going_to_add (Lisp_Object specifier, Lisp_Object locale,
3412                     Lisp_Object tag_set, Lisp_Object instantiator)
3413 {
3414   Lisp_Object possible_console_types = Qnil;
3415   Lisp_Object rest;
3416   Lisp_Object retlist = Qnil;
3417   struct gcpro gcpro1, gcpro2;
3418
3419   LIST_LOOP (rest, Vconsole_type_list)
3420     {
3421       Lisp_Object contype = XCAR (rest);
3422       if (!NILP (memq_no_quit (contype, tag_set)))
3423         possible_console_types = Fcons (contype, possible_console_types);
3424     }
3425
3426   if (XINT (Flength (possible_console_types)) > 1)
3427     /* two conflicting console types specified */
3428     return Qnil;
3429
3430   if (NILP (possible_console_types))
3431     possible_console_types = Vconsole_type_list;
3432
3433   GCPRO2 (retlist, possible_console_types);
3434
3435   LIST_LOOP (rest, possible_console_types)
3436     {
3437       Lisp_Object contype = XCAR (rest);
3438       Lisp_Object newinst = call_with_suspended_errors
3439         ((lisp_fn_t) normalize_image_instantiator,
3440          Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype,
3441          make_int (XIMAGE_SPECIFIER_ALLOWED (specifier)));
3442
3443       if (!NILP (newinst))
3444         {
3445           Lisp_Object newtag;
3446           if (NILP (memq_no_quit (contype, tag_set)))
3447             newtag = Fcons (contype, tag_set);
3448           else
3449             newtag = tag_set;
3450           retlist = Fcons (Fcons (newtag, newinst), retlist);
3451         }
3452     }
3453
3454   UNGCPRO;
3455
3456   return retlist;
3457 }
3458
3459 /* Copy an image instantiator. We can't use Fcopy_tree since widgets
3460    may contain circular references which would send Fcopy_tree into
3461    infloop death. */
3462 static Lisp_Object
3463 image_copy_vector_instantiator (Lisp_Object instantiator)
3464 {
3465   int i;
3466   struct image_instantiator_methods *meths;
3467   Lisp_Object *elt;
3468   int instantiator_len;
3469
3470   CHECK_VECTOR (instantiator);
3471
3472   instantiator = Fcopy_sequence (instantiator);
3473   elt = XVECTOR_DATA (instantiator);
3474   instantiator_len = XVECTOR_LENGTH (instantiator);
3475
3476   meths = decode_image_instantiator_format (elt[0], ERROR_ME);
3477
3478   for (i = 1; i < instantiator_len; i += 2)
3479     {
3480       int j;
3481       Lisp_Object keyword = elt[i];
3482       Lisp_Object value = elt[i+1];
3483
3484       /* Find the keyword entry. */
3485       for (j = 0; j < Dynarr_length (meths->keywords); j++)
3486         {
3487           if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword))
3488             break;
3489         }
3490
3491       /* Only copy keyword values that should be copied. */
3492       if (Dynarr_at (meths->keywords, j).copy_p
3493           &&
3494           (CONSP (value) || VECTORP (value)))
3495         {
3496           elt [i+1] = Fcopy_tree (value, Qt);
3497         }
3498     }
3499
3500   return instantiator;
3501 }
3502
3503 static Lisp_Object
3504 image_copy_instantiator (Lisp_Object arg)
3505 {
3506   if (CONSP (arg))
3507     {
3508       Lisp_Object rest;
3509       rest = arg = Fcopy_sequence (arg);
3510       while (CONSP (rest))
3511         {
3512           Lisp_Object elt = XCAR (rest);
3513           if (CONSP (elt))
3514             XCAR (rest) = Fcopy_tree (elt, Qt);
3515           else if (VECTORP (elt))
3516             XCAR (rest) = image_copy_vector_instantiator (elt);
3517           if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */
3518             XCDR (rest) = Fcopy_tree (XCDR (rest), Qt);
3519           rest = XCDR (rest);
3520         }
3521     }
3522   else if (VECTORP (arg))
3523     {
3524       arg = image_copy_vector_instantiator (arg);
3525     }
3526   return arg;
3527 }
3528
3529 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /*
3530 Return non-nil if OBJECT is an image specifier.
3531 See `make-image-specifier' for a description of image instantiators.
3532 */
3533        (object))
3534 {
3535   return IMAGE_SPECIFIERP (object) ? Qt : Qnil;
3536 }
3537
3538 \f
3539 /****************************************************************************
3540  *                             Glyph Object                                 *
3541  ****************************************************************************/
3542
3543 static Lisp_Object
3544 mark_glyph (Lisp_Object obj)
3545 {
3546   Lisp_Glyph *glyph = XGLYPH (obj);
3547
3548   mark_object (glyph->image);
3549   mark_object (glyph->contrib_p);
3550   mark_object (glyph->baseline);
3551   mark_object (glyph->face);
3552
3553   return glyph->plist;
3554 }
3555
3556 static void
3557 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3558 {
3559   Lisp_Glyph *glyph = XGLYPH (obj);
3560   char buf[20];
3561
3562   if (print_readably)
3563     error ("printing unreadable object #<glyph 0x%x>", glyph->header.uid);
3564
3565   write_c_string ("#<glyph (", printcharfun);
3566   print_internal (Fglyph_type (obj), printcharfun, 0);
3567   write_c_string (") ", printcharfun);
3568   print_internal (glyph->image, printcharfun, 1);
3569   sprintf (buf, "0x%x>", glyph->header.uid);
3570   write_c_string (buf, printcharfun);
3571 }
3572
3573 /* Glyphs are equal if all of their display attributes are equal.  We
3574    don't compare names or doc-strings, because that would make equal
3575    be eq.
3576
3577    This isn't concerned with "unspecified" attributes, that's what
3578    #'glyph-differs-from-default-p is for. */
3579 static int
3580 glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3581 {
3582   Lisp_Glyph *g1 = XGLYPH (obj1);
3583   Lisp_Glyph *g2 = XGLYPH (obj2);
3584
3585   depth++;
3586
3587   return (internal_equal (g1->image,     g2->image,     depth) &&
3588           internal_equal (g1->contrib_p, g2->contrib_p, depth) &&
3589           internal_equal (g1->baseline,  g2->baseline,  depth) &&
3590           internal_equal (g1->face,      g2->face,      depth) &&
3591           !plists_differ (g1->plist,     g2->plist, 0, 0, depth + 1));
3592 }
3593
3594 static unsigned long
3595 glyph_hash (Lisp_Object obj, int depth)
3596 {
3597   depth++;
3598
3599   /* No need to hash all of the elements; that would take too long.
3600      Just hash the most common ones. */
3601   return HASH2 (internal_hash (XGLYPH (obj)->image, depth),
3602                 internal_hash (XGLYPH (obj)->face,  depth));
3603 }
3604
3605 static Lisp_Object
3606 glyph_getprop (Lisp_Object obj, Lisp_Object prop)
3607 {
3608   Lisp_Glyph *g = XGLYPH (obj);
3609
3610   if (EQ (prop, Qimage))     return g->image;
3611   if (EQ (prop, Qcontrib_p)) return g->contrib_p;
3612   if (EQ (prop, Qbaseline))  return g->baseline;
3613   if (EQ (prop, Qface))      return g->face;
3614
3615   return external_plist_get (&g->plist, prop, 0, ERROR_ME);
3616 }
3617
3618 static int
3619 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
3620 {
3621   if (EQ (prop, Qimage)     ||
3622       EQ (prop, Qcontrib_p) ||
3623       EQ (prop, Qbaseline))
3624     return 0;
3625
3626   if (EQ (prop, Qface))
3627     {
3628       XGLYPH (obj)->face = Fget_face (value);
3629       return 1;
3630     }
3631
3632   external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME);
3633   return 1;
3634 }
3635
3636 static int
3637 glyph_remprop (Lisp_Object obj, Lisp_Object prop)
3638 {
3639   if (EQ (prop, Qimage)     ||
3640       EQ (prop, Qcontrib_p) ||
3641       EQ (prop, Qbaseline))
3642     return -1;
3643
3644   if (EQ (prop, Qface))
3645     {
3646       XGLYPH (obj)->face = Qnil;
3647       return 1;
3648     }
3649
3650   return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME);
3651 }
3652
3653 static Lisp_Object
3654 glyph_plist (Lisp_Object obj)
3655 {
3656   Lisp_Glyph *glyph = XGLYPH (obj);
3657   Lisp_Object result = glyph->plist;
3658
3659   result = cons3 (Qface,      glyph->face,      result);
3660   result = cons3 (Qbaseline,  glyph->baseline,  result);
3661   result = cons3 (Qcontrib_p, glyph->contrib_p, result);
3662   result = cons3 (Qimage,     glyph->image,     result);
3663
3664   return result;
3665 }
3666
3667 static const struct lrecord_description glyph_description[] = {
3668   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) },
3669   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) },
3670   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) },
3671   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) },
3672   { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) },
3673   { XD_END }
3674 };
3675
3676 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph,
3677                                           mark_glyph, print_glyph, 0,
3678                                           glyph_equal, glyph_hash, glyph_description,
3679                                           glyph_getprop, glyph_putprop,
3680                                           glyph_remprop, glyph_plist,
3681                                           Lisp_Glyph);
3682 \f
3683 Lisp_Object
3684 allocate_glyph (enum glyph_type type,
3685                 void (*after_change) (Lisp_Object glyph, Lisp_Object property,
3686                                       Lisp_Object locale))
3687 {
3688   /* This function can GC */
3689   Lisp_Object obj = Qnil;
3690   Lisp_Glyph *g = alloc_lcrecord_type (Lisp_Glyph, &lrecord_glyph);
3691
3692   g->type = type;
3693   g->image = Fmake_specifier (Qimage); /* This function can GC */
3694   g->dirty = 0;
3695   switch (g->type)
3696     {
3697     case GLYPH_BUFFER:
3698       XIMAGE_SPECIFIER_ALLOWED (g->image) =
3699         IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK
3700         | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK
3701         | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK;
3702       break;
3703     case GLYPH_POINTER:
3704       XIMAGE_SPECIFIER_ALLOWED (g->image) =
3705         IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK;
3706       break;
3707     case GLYPH_ICON:
3708       XIMAGE_SPECIFIER_ALLOWED (g->image) =
3709         IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK
3710         | IMAGE_COLOR_PIXMAP_MASK;
3711       break;
3712     default:
3713       ABORT ();
3714     }
3715
3716   /* I think Fmake_specifier can GC.  I think set_specifier_fallback can GC. */
3717   /* We're getting enough reports of odd behavior in this area it seems */
3718   /* best to GCPRO everything. */
3719   {
3720     Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector));
3721     Lisp_Object tem2 = list1 (Fcons (Qnil, Qt));
3722     Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil));
3723     struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3724
3725     GCPRO4 (obj, tem1, tem2, tem3);
3726
3727     set_specifier_fallback (g->image, tem1);
3728     g->contrib_p = Fmake_specifier (Qboolean);
3729     set_specifier_fallback (g->contrib_p, tem2);
3730     /* #### should have a specifier for the following */
3731     g->baseline = Fmake_specifier (Qgeneric);
3732     set_specifier_fallback (g->baseline, tem3);
3733     g->face = Qnil;
3734     g->plist = Qnil;
3735     g->after_change = after_change;
3736     XSETGLYPH (obj, g);
3737
3738     set_image_attached_to (g->image, obj, Qimage);
3739     UNGCPRO;
3740   }
3741
3742   return obj;
3743 }
3744
3745 static enum glyph_type
3746 decode_glyph_type (Lisp_Object type, Error_behavior errb)
3747 {
3748   if (NILP (type))
3749     return GLYPH_BUFFER;
3750
3751   if (ERRB_EQ (errb, ERROR_ME))
3752     CHECK_SYMBOL (type);
3753
3754   if (EQ (type, Qbuffer))  return GLYPH_BUFFER;
3755   if (EQ (type, Qpointer)) return GLYPH_POINTER;
3756   if (EQ (type, Qicon))    return GLYPH_ICON;
3757
3758   maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb);
3759
3760   return GLYPH_UNKNOWN;
3761 }
3762
3763 static int
3764 valid_glyph_type_p (Lisp_Object type)
3765 {
3766   return !NILP (memq_no_quit (type, Vglyph_type_list));
3767 }
3768
3769 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /*
3770 Given a GLYPH-TYPE, return non-nil if it is valid.
3771 Valid types are `buffer', `pointer', and `icon'.
3772 */
3773        (glyph_type))
3774 {
3775   return valid_glyph_type_p (glyph_type) ? Qt : Qnil;
3776 }
3777
3778 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /*
3779 Return a list of valid glyph types.
3780 */
3781        ())
3782 {
3783   return Fcopy_sequence (Vglyph_type_list);
3784 }
3785
3786 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /*
3787 Create and return a new uninitialized glyph of type TYPE.
3788
3789 TYPE specifies the type of the glyph; this should be one of `buffer',
3790 `pointer', or `icon', and defaults to `buffer'.  The type of the glyph
3791 specifies in which contexts the glyph can be used, and controls the
3792 allowable image types into which the glyph's image can be
3793 instantiated.
3794
3795 `buffer' glyphs can be used as the begin-glyph or end-glyph of an
3796 extent, in the modeline, and in the toolbar.  Their image can be
3797 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text',
3798 and `subwindow'.
3799
3800 `pointer' glyphs can be used to specify the mouse pointer.  Their
3801 image can be instantiated as `pointer'.
3802
3803 `icon' glyphs can be used to specify the icon used when a frame is
3804 iconified.  Their image can be instantiated as `mono-pixmap' and
3805 `color-pixmap'.
3806 */
3807        (type))
3808 {
3809   enum glyph_type typeval = decode_glyph_type (type, ERROR_ME);
3810   return allocate_glyph (typeval, 0);
3811 }
3812
3813 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /*
3814 Return non-nil if OBJECT is a glyph.
3815
3816 A glyph is an object used for pixmaps, widgets and the like.  It is used
3817 in begin-glyphs and end-glyphs attached to extents, in marginal and textual
3818 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar
3819 buttons, and the like.  Much more detailed information can be found at
3820 `make-glyph'.  Its image is described using an image specifier --
3821 see `make-image-specifier'.  See also `make-image-instance' for further
3822 information.
3823 */
3824        (object))
3825 {
3826   return GLYPHP (object) ? Qt : Qnil;
3827 }
3828
3829 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /*
3830 Return the type of the given glyph.
3831 The return value will be one of 'buffer, 'pointer, or 'icon.
3832 */
3833        (glyph))
3834 {
3835   CHECK_GLYPH (glyph);
3836   switch (XGLYPH_TYPE (glyph))
3837     {
3838     default: ABORT ();
3839     case GLYPH_BUFFER:  return Qbuffer;
3840     case GLYPH_POINTER: return Qpointer;
3841     case GLYPH_ICON:    return Qicon;
3842     }
3843 }
3844
3845 Lisp_Object
3846 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain,
3847                       Error_behavior errb, int no_quit)
3848 {
3849   Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph));
3850
3851   /* This can never return Qunbound.  All glyphs have 'nothing as
3852      a fallback. */
3853   Lisp_Object image_instance = specifier_instance (specifier, Qunbound,
3854                                                    domain, errb, no_quit, 0,
3855                                                    Qzero);
3856   assert (!UNBOUNDP (image_instance));
3857   ERROR_CHECK_IMAGE_INSTANCE (image_instance);
3858
3859   return image_instance;
3860 }
3861
3862 static Lisp_Object
3863 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window)
3864 {
3865   Lisp_Object instance = glyph_or_image;
3866
3867   if (GLYPHP (glyph_or_image))
3868     instance = glyph_image_instance (glyph_or_image, window, ERROR_ME_NOT, 1);
3869
3870   return instance;
3871 }
3872
3873 /*****************************************************************************
3874  glyph_width
3875
3876  Return the width of the given GLYPH on the given WINDOW.
3877  Calculations are done based on recursively querying the geometry of
3878  the associated image instances.
3879  ****************************************************************************/
3880 unsigned short
3881 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain)
3882 {
3883   Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3884                                                      domain);
3885   if (!IMAGE_INSTANCEP (instance))
3886     return 0;
3887
3888   if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3889     image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3890                            IMAGE_UNSPECIFIED_GEOMETRY,
3891                            IMAGE_UNCHANGED_GEOMETRY,
3892                            IMAGE_UNCHANGED_GEOMETRY, domain);
3893
3894   return XIMAGE_INSTANCE_WIDTH (instance);
3895 }
3896
3897 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /*
3898 Return the width of GLYPH on WINDOW.
3899 This may not be exact as it does not take into account all of the context
3900 that redisplay will.
3901 */
3902        (glyph, window))
3903 {
3904   XSETWINDOW (window, decode_window (window));
3905   CHECK_GLYPH (glyph);
3906
3907   return make_int (glyph_width (glyph, window));
3908 }
3909
3910 unsigned short
3911 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain)
3912 {
3913   Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3914                                                      domain);
3915   if (!IMAGE_INSTANCEP (instance))
3916     return 0;
3917
3918   if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3919     image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3920                            IMAGE_UNSPECIFIED_GEOMETRY,
3921                            IMAGE_UNCHANGED_GEOMETRY,
3922                            IMAGE_UNCHANGED_GEOMETRY, domain);
3923
3924   if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT)
3925     return XIMAGE_INSTANCE_TEXT_ASCENT (instance);
3926   else
3927     return XIMAGE_INSTANCE_HEIGHT (instance);
3928 }
3929
3930 unsigned short
3931 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain)
3932 {
3933   Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3934                                                      domain);
3935   if (!IMAGE_INSTANCEP (instance))
3936     return 0;
3937
3938   if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3939     image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3940                            IMAGE_UNSPECIFIED_GEOMETRY,
3941                            IMAGE_UNCHANGED_GEOMETRY,
3942                            IMAGE_UNCHANGED_GEOMETRY, domain);
3943
3944   if (XIMAGE_INSTANCE_TYPE (instance) ==  IMAGE_TEXT)
3945     return XIMAGE_INSTANCE_TEXT_DESCENT (instance);
3946   else
3947     return 0;
3948 }
3949
3950 /* strictly a convenience function. */
3951 unsigned short
3952 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain)
3953 {
3954   Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image,
3955                                                      domain);
3956
3957   if (!IMAGE_INSTANCEP (instance))
3958     return 0;
3959
3960   if (XIMAGE_INSTANCE_NEEDS_LAYOUT (instance))
3961     image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY,
3962                            IMAGE_UNSPECIFIED_GEOMETRY,
3963                            IMAGE_UNCHANGED_GEOMETRY,
3964                            IMAGE_UNCHANGED_GEOMETRY, domain);
3965
3966   return XIMAGE_INSTANCE_HEIGHT (instance);
3967 }
3968
3969 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /*
3970 Return the ascent value of GLYPH on WINDOW.
3971 This may not be exact as it does not take into account all of the context
3972 that redisplay will.
3973 */
3974        (glyph, window))
3975 {
3976   XSETWINDOW (window, decode_window (window));
3977   CHECK_GLYPH (glyph);
3978
3979   return make_int (glyph_ascent (glyph, window));
3980 }
3981
3982 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /*
3983 Return the descent value of GLYPH on WINDOW.
3984 This may not be exact as it does not take into account all of the context
3985 that redisplay will.
3986 */
3987        (glyph, window))
3988 {
3989   XSETWINDOW (window, decode_window (window));
3990   CHECK_GLYPH (glyph);
3991
3992   return make_int (glyph_descent (glyph, window));
3993 }
3994
3995 /* This is redundant but I bet a lot of people expect it to exist. */
3996 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /*
3997 Return the height of GLYPH on WINDOW.
3998 This may not be exact as it does not take into account all of the context
3999 that redisplay will.
4000 */
4001        (glyph, window))
4002 {
4003   XSETWINDOW (window, decode_window (window));
4004   CHECK_GLYPH (glyph);
4005
4006   return make_int (glyph_height (glyph, window));
4007 }
4008
4009 static void
4010 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty)
4011 {
4012   Lisp_Object instance = glyph_or_image;
4013
4014   if (!NILP (glyph_or_image))
4015     {
4016       if (GLYPHP (glyph_or_image))
4017         {
4018           instance = glyph_image_instance (glyph_or_image, window,
4019                                            ERROR_ME_NOT, 1);
4020           XGLYPH_DIRTYP (glyph_or_image) = dirty;
4021         }
4022
4023       if (!IMAGE_INSTANCEP (instance))
4024         return;
4025
4026       XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
4027     }
4028 }
4029
4030 static void
4031 set_image_instance_dirty_p (Lisp_Object instance, int dirty)
4032 {
4033   if (IMAGE_INSTANCEP (instance))
4034     {
4035       XIMAGE_INSTANCE_DIRTYP (instance) = dirty;
4036       /* Now cascade up the hierarchy. */
4037       set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance),
4038                                   dirty);
4039     }
4040   else if (GLYPHP (instance))
4041     {
4042       XGLYPH_DIRTYP (instance) = dirty;
4043     }
4044 }
4045
4046 /* #### do we need to cache this info to speed things up? */
4047
4048 Lisp_Object
4049 glyph_baseline (Lisp_Object glyph, Lisp_Object domain)
4050 {
4051   if (!GLYPHP (glyph))
4052     return Qnil;
4053   else
4054     {
4055       Lisp_Object retval =
4056         specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)),
4057                                     /* #### look into ERROR_ME_NOT */
4058                                     Qunbound, domain, ERROR_ME_NOT,
4059                                     0, Qzero);
4060       if (!NILP (retval) && !INTP (retval))
4061         retval = Qnil;
4062       else if (INTP (retval))
4063         {
4064           if (XINT (retval) < 0)
4065             retval = Qzero;
4066           if (XINT (retval) > 100)
4067             retval = make_int (100);
4068         }
4069       return retval;
4070     }
4071 }
4072
4073 Lisp_Object
4074 glyph_face (Lisp_Object glyph, Lisp_Object domain)
4075 {
4076   /* #### Domain parameter not currently used but it will be */
4077   return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil;
4078 }
4079
4080 int
4081 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain)
4082 {
4083   if (!GLYPHP (glyph))
4084     return 0;
4085   else
4086     return !NILP (specifier_instance_no_quit
4087                   (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain,
4088                    /* #### look into ERROR_ME_NOT */
4089                    ERROR_ME_NOT, 0, Qzero));
4090 }
4091
4092 static void
4093 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property,
4094                             Lisp_Object locale)
4095 {
4096   if (XGLYPH (glyph)->after_change)
4097     (XGLYPH (glyph)->after_change) (glyph, property, locale);
4098 }
4099
4100 void
4101 glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height,
4102                       enum image_instance_geometry disp, Lisp_Object domain)
4103 {
4104   Lisp_Object instance = glyph_or_image;
4105
4106   if (GLYPHP (glyph_or_image))
4107     instance = glyph_image_instance (glyph_or_image, domain, ERROR_ME_NOT, 1);
4108
4109   image_instance_query_geometry (instance, width, height, disp, domain);
4110 }
4111
4112 void
4113 glyph_do_layout (Lisp_Object glyph_or_image, int width, int height,
4114               int xoffset, int yoffset, Lisp_Object domain)
4115 {
4116   Lisp_Object instance = glyph_or_image;
4117
4118   if (GLYPHP (glyph_or_image))
4119     instance = glyph_image_instance (glyph_or_image, domain, ERROR_ME_NOT, 1);
4120
4121   image_instance_layout (instance, width, height, xoffset, yoffset, domain);
4122 }
4123
4124 \f
4125 /*****************************************************************************
4126  *                     glyph cachel functions                                *
4127  *****************************************************************************/
4128
4129 /* #### All of this is 95% copied from face cachels.  Consider
4130   consolidating.
4131
4132   Why do we need glyph_cachels? Simply because a glyph_cachel captures
4133   per-window information about a particular glyph. A glyph itself is
4134   not created in any particular context, so if we were to rely on a
4135   glyph to tell us about its dirtiness we would not be able to reset
4136   the dirty flag after redisplaying it as it may exist in other
4137   contexts. When we have redisplayed we need to know which glyphs to
4138   reset the dirty flags on - the glyph_cachels give us a nice list we
4139   can iterate through doing this.  */
4140 void
4141 mark_glyph_cachels (glyph_cachel_dynarr *elements)
4142 {
4143   int elt;
4144
4145   if (!elements)
4146     return;
4147
4148   for (elt = 0; elt < Dynarr_length (elements); elt++)
4149     {
4150       struct glyph_cachel *cachel = Dynarr_atp (elements, elt);
4151       mark_object (cachel->glyph);
4152     }
4153 }
4154
4155 static void
4156 update_glyph_cachel_data (struct window *w, Lisp_Object glyph,
4157                           struct glyph_cachel *cachel)
4158 {
4159   if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)
4160       || XGLYPH_DIRTYP (cachel->glyph)
4161       || XFRAME(WINDOW_FRAME(w))->faces_changed)
4162     {
4163       Lisp_Object window, instance;
4164
4165       XSETWINDOW (window, w);
4166
4167       cachel->glyph   = glyph;
4168       /* Speed things up slightly by grabbing the glyph instantiation
4169          and passing it to the size functions. */
4170       instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1);
4171
4172       if (!IMAGE_INSTANCEP (instance))
4173         return;
4174
4175       /* Mark text instance of the glyph dirty if faces have changed,
4176          because its geometry might have changed. */
4177       invalidate_glyph_geometry_maybe (instance, w);
4178
4179       /* #### Do the following 2 lines buy us anything? --kkm */
4180       XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance);
4181       cachel->dirty   = XGLYPH_DIRTYP (glyph);
4182       cachel->width   = glyph_width   (instance, window);
4183       cachel->ascent  = glyph_ascent  (instance, window);
4184       cachel->descent = glyph_descent (instance, window);
4185     }
4186
4187   cachel->updated = 1;
4188 }
4189
4190 static void
4191 add_glyph_cachel (struct window *w, Lisp_Object glyph)
4192 {
4193   struct glyph_cachel new_cachel;
4194
4195   xzero (new_cachel);
4196   new_cachel.glyph = Qnil;
4197
4198   update_glyph_cachel_data (w, glyph, &new_cachel);
4199   Dynarr_add (w->glyph_cachels, new_cachel);
4200 }
4201
4202 glyph_index
4203 get_glyph_cachel_index (struct window *w, Lisp_Object glyph)
4204 {
4205   int elt;
4206
4207   if (noninteractive)
4208     return 0;
4209
4210   for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4211     {
4212       struct glyph_cachel *cachel =
4213         Dynarr_atp (w->glyph_cachels, elt);
4214
4215       if (EQ (cachel->glyph, glyph) && !NILP (glyph))
4216         {
4217           update_glyph_cachel_data (w, glyph, cachel);
4218           return elt;
4219         }
4220     }
4221
4222   /* If we didn't find the glyph, add it and then return its index. */
4223   add_glyph_cachel (w, glyph);
4224   return elt;
4225 }
4226
4227 void
4228 reset_glyph_cachels (struct window *w)
4229 {
4230   Dynarr_reset (w->glyph_cachels);
4231   get_glyph_cachel_index (w, Vcontinuation_glyph);
4232   get_glyph_cachel_index (w, Vtruncation_glyph);
4233   get_glyph_cachel_index (w, Vhscroll_glyph);
4234   get_glyph_cachel_index (w, Vcontrol_arrow_glyph);
4235   get_glyph_cachel_index (w, Voctal_escape_glyph);
4236   get_glyph_cachel_index (w, Vinvisible_text_glyph);
4237 }
4238
4239 void
4240 mark_glyph_cachels_as_not_updated (struct window *w)
4241 {
4242   int elt;
4243
4244   /* We need to have a dirty flag to tell if the glyph has changed.
4245      We can check to see if each glyph variable is actually a
4246      completely different glyph, though. */
4247 #define FROB(glyph_obj, gindex)                                         \
4248   update_glyph_cachel_data (w, glyph_obj,                               \
4249                               Dynarr_atp (w->glyph_cachels, gindex))
4250
4251   FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX);
4252   FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX);
4253   FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX);
4254   FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX);
4255   FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX);
4256   FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX);
4257 #undef FROB
4258
4259   for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4260     {
4261       Dynarr_atp (w->glyph_cachels, elt)->updated = 0;
4262     }
4263 }
4264
4265 /* Unset the dirty bit on all the glyph cachels that have it. */
4266 void
4267 mark_glyph_cachels_as_clean (struct window* w)
4268 {
4269   int elt;
4270   Lisp_Object window;
4271   XSETWINDOW (window, w);
4272   for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++)
4273     {
4274       struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt);
4275       cachel->dirty = 0;
4276       set_glyph_dirty_p (cachel->glyph, window, 0);
4277     }
4278 }
4279
4280 #ifdef MEMORY_USAGE_STATS
4281
4282 int
4283 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels,
4284                             struct overhead_stats *ovstats)
4285 {
4286   int total = 0;
4287
4288   if (glyph_cachels)
4289     total += Dynarr_memory_usage (glyph_cachels, ovstats);
4290
4291   return total;
4292 }
4293
4294 #endif /* MEMORY_USAGE_STATS */
4295
4296
4297 \f
4298 /*****************************************************************************
4299  *                     subwindow cachel functions                                    *
4300  *****************************************************************************/
4301 /* Subwindows are curious in that you have to physically unmap them to
4302    not display them. It is problematic deciding what to do in
4303    redisplay. We have two caches - a per-window instance cache that
4304    keeps track of subwindows on a window, these are linked to their
4305    instantiator in the hashtable and when the instantiator goes away
4306    we want the instance to go away also. However we also have a
4307    per-frame instance cache that we use to determine if a subwindow is
4308    obscuring an area that we want to clear. We need to be able to flip
4309    through this quickly so a hashtable is not suitable hence the
4310    subwindow_cachels. This is a weak list so unreference instances
4311    will get deleted properly. */
4312
4313 /* redisplay in general assumes that drawing something will erase
4314    what was there before. unfortunately this does not apply to
4315    subwindows that need to be specifically unmapped in order to
4316    disappear. we take a brute force approach - on the basis that its
4317    cheap - and unmap all subwindows in a display line */
4318
4319 /* Put new instances in the frame subwindow cache. This is less costly than
4320    doing it every time something gets mapped, and deleted instances will be
4321    removed automatically. */
4322 static void
4323 cache_subwindow_instance_in_frame_maybe (Lisp_Object instance)
4324 {
4325   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (instance);
4326   if (!NILP (DOMAIN_FRAME (IMAGE_INSTANCE_DOMAIN (ii))))
4327     {
4328       struct frame* f = DOMAIN_XFRAME (IMAGE_INSTANCE_DOMAIN (ii));
4329       XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))
4330         = Fcons (instance, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
4331     }
4332 }
4333
4334 /* Unmap and finalize all subwindow instances in the frame cache. This
4335    is necessary because GC will not guarantee the order things get
4336    deleted in and moreover, frame finalization deletes the window
4337    system windows before deleting XEmacs windows, and hence
4338    subwindows.  */
4339 int
4340 unmap_subwindow_instance_cache_mapper (Lisp_Object key, Lisp_Object value,
4341                                        void* finalize)
4342 {
4343   /* value can be nil; we cache failures as well as successes */
4344   if (!NILP (value))
4345     {
4346       struct frame* f = XFRAME (XIMAGE_INSTANCE_FRAME (value));
4347       unmap_subwindow (value);
4348       if (finalize)
4349         {
4350           /* In case GC doesn't catch up fast enough, remove from the frame
4351              cache also. Otherwise code that checks the sanity of the instance
4352              will fail. */
4353           XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))
4354             = delq_no_quit (value,
4355                             XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)));
4356           finalize_image_instance (XIMAGE_INSTANCE (value), 0);
4357         }
4358     }
4359   return 0;
4360 }
4361
4362 static void
4363 finalize_all_subwindow_instances (struct window *w)
4364 {
4365   if (!NILP (w->next))   finalize_all_subwindow_instances (XWINDOW (w->next));
4366   if (!NILP (w->vchild)) finalize_all_subwindow_instances (XWINDOW (w->vchild));
4367   if (!NILP (w->hchild)) finalize_all_subwindow_instances (XWINDOW (w->hchild));
4368
4369   elisp_maphash (unmap_subwindow_instance_cache_mapper,
4370                  w->subwindow_instance_cache, (void*)1);
4371 }
4372
4373 void
4374 free_frame_subwindow_instances (struct frame* f)
4375 {
4376   /* Make sure all instances are finalized. We have to do this via the
4377      instance cache since some instances may be extant but not
4378      displayed (and hence not in the frame cache). */
4379   finalize_all_subwindow_instances (XWINDOW (f->root_window));
4380 }
4381
4382 /* Unmap all instances in the frame cache. */
4383 void
4384 reset_frame_subwindow_instance_cache (struct frame* f)
4385 {
4386   Lisp_Object rest;
4387
4388   LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
4389     {
4390       Lisp_Object value = XCAR (rest);
4391       unmap_subwindow (value);
4392     }
4393 }
4394
4395 /*****************************************************************************
4396  *                              subwindow exposure ignorance                    *
4397  *****************************************************************************/
4398 /* when we unmap subwindows the associated window system will generate
4399    expose events. This we do not want as redisplay already copes with
4400    the repainting necessary. Worse, we can get in an endless cycle of
4401    redisplay if we are not careful. Thus we keep a per-frame list of
4402    expose events that are going to come and ignore them as
4403    required. */
4404
4405 struct expose_ignore_blocktype
4406 {
4407   Blocktype_declare (struct expose_ignore);
4408 } *the_expose_ignore_blocktype;
4409
4410 int
4411 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height)
4412 {
4413   struct expose_ignore *ei, *prev;
4414   /* the ignore list is FIFO so we should generally get a match with
4415      the first element in the list */
4416   for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next)
4417     {
4418       /* Checking for exact matches just isn't good enough as we
4419          might get exposures for partially obscured subwindows, thus
4420          we have to check for overlaps. Being conservative, we will
4421          check for exposures wholly contained by the subwindow - this
4422          might give us what we want.*/
4423       if (ei->x <= (unsigned) x && ei->y <= (unsigned) y
4424           && ei->x + ei->width >= (unsigned) (x + width)
4425           && ei->y + ei->height >= (unsigned) (y + height))
4426         {
4427 #ifdef DEBUG_WIDGETS
4428           stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n",
4429                       x, y, width, height, ei->x, ei->y, ei->width, ei->height);
4430 #endif
4431           if (!prev)
4432             f->subwindow_exposures = ei->next;
4433           else
4434             prev->next = ei->next;
4435
4436           if (ei == f->subwindow_exposures_tail)
4437             f->subwindow_exposures_tail = prev;
4438
4439           Blocktype_free (the_expose_ignore_blocktype, ei);
4440           return 1;
4441         }
4442       prev = ei;
4443     }
4444   return 0;
4445 }
4446
4447 static void
4448 register_ignored_expose (struct frame* f, int x, int y, int width, int height)
4449 {
4450   if (!hold_ignored_expose_registration)
4451     {
4452       struct expose_ignore *ei;
4453
4454       ei = Blocktype_alloc (the_expose_ignore_blocktype);
4455
4456       ei->next = NULL;
4457       ei->x = x;
4458       ei->y = y;
4459       ei->width = width;
4460       ei->height = height;
4461
4462       /* we have to add the exposure to the end of the list, since we
4463          want to check the oldest events first. for speed we keep a record
4464          of the end so that we can add right to it. */
4465       if (f->subwindow_exposures_tail)
4466         {
4467           f->subwindow_exposures_tail->next = ei;
4468         }
4469       if (!f->subwindow_exposures)
4470         {
4471           f->subwindow_exposures = ei;
4472         }
4473       f->subwindow_exposures_tail = ei;
4474     }
4475 }
4476
4477 /****************************************************************************
4478  find_matching_subwindow
4479
4480  See if there is a subwindow that completely encloses the requested
4481  area.
4482  ****************************************************************************/
4483 int find_matching_subwindow (struct frame* f, int x, int y, int width, int height)
4484 {
4485   Lisp_Object rest;
4486
4487   LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
4488     {
4489       Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest));
4490
4491       if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii)
4492           &&
4493           IMAGE_INSTANCE_DISPLAY_X (ii) <= (unsigned) x
4494           &&
4495           IMAGE_INSTANCE_DISPLAY_Y (ii) <= (unsigned) y
4496           &&
4497           IMAGE_INSTANCE_DISPLAY_X (ii)
4498           + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) >= (unsigned) (x + width)
4499           &&
4500           IMAGE_INSTANCE_DISPLAY_Y (ii)
4501           + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) >= (unsigned) (y + height))
4502         {
4503           return 1;
4504         }
4505     }
4506   return 0;
4507 }
4508
4509 \f
4510 /*****************************************************************************
4511  *                              subwindow functions                          *
4512  *****************************************************************************/
4513
4514 /* Update the displayed characteristics of a subwindow. This function
4515    should generally only get called if the subwindow is actually
4516    dirty. */
4517 void
4518 redisplay_subwindow (Lisp_Object subwindow)
4519 {
4520   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4521   int count = specpdl_depth ();
4522
4523   /* The update method is allowed to call eval.  Since it is quite
4524      common for this function to get called from somewhere in
4525      redisplay we need to make sure that quits are ignored.  Otherwise
4526      Fsignal will ABORT. */
4527   specbind (Qinhibit_quit, Qt);
4528
4529   ERROR_CHECK_IMAGE_INSTANCE (subwindow);
4530
4531   if (WIDGET_IMAGE_INSTANCEP (subwindow))
4532     {
4533       if (image_instance_changed (subwindow))
4534         redisplay_widget (subwindow);
4535       /* Reset the changed flags. */
4536       IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0;
4537       IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0;
4538       IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii) = 0;
4539       IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0;
4540     }
4541   else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW
4542            &&
4543            !NILP (IMAGE_INSTANCE_FRAME (ii)))
4544     {
4545       MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain),
4546                      redisplay_subwindow, (ii));
4547     }
4548
4549   IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0;
4550   /* This function is typically called by redisplay just before
4551      outputting the information to the screen. Thus we record a hash
4552      of the output to determine whether on-screen is the same as
4553      recorded structure. This approach has limitations in there is a
4554      good chance that hash values will be different for the same
4555      visual appearance. However, we would rather that then the other
4556      way round - it simply means that we will get more displays than
4557      we might need. We can get better hashing by making the depth
4558      negative - currently it will recurse down 7 levels.*/
4559   IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow,
4560                                                     IMAGE_INSTANCE_HASH_DEPTH);
4561
4562   unbind_to (count, Qnil);
4563 }
4564
4565 /* Determine whether an image_instance has changed structurally and
4566    hence needs redisplaying in some way.
4567
4568    #### This should just look at the instantiator differences when we
4569    get rid of the stored items altogether. In fact we should probably
4570    store the new instantiator as well as the old - as we do with
4571    gui_items currently - and then pick-up the new on the next
4572    redisplay. This would obviate the need for any of this trickery
4573    with hashcodes. */
4574 int
4575 image_instance_changed (Lisp_Object subwindow)
4576 {
4577   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4578
4579   if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) !=
4580       IMAGE_INSTANCE_DISPLAY_HASH (ii))
4581     return 1;
4582   /* #### I think there is probably a bug here. This gets called for
4583      layouts - and yet the pending items are always nil for
4584      layouts. We are saved by layout optimization, but I'm undecided
4585      as to what the correct fix is. */
4586   else if (WIDGET_IMAGE_INSTANCEP (subwindow)
4587            && (!internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (ii),
4588                                 IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii), 0)
4589                || !NILP (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii))
4590                || IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii)))
4591     return 1;
4592   else
4593     return 0;
4594 }
4595
4596 /* Update all the subwindows on a frame. */
4597 void
4598 update_widget_instances (Lisp_Object frame)
4599 {
4600   struct frame* f;
4601   Lisp_Object rest;
4602
4603   /* Its possible for the preceding callback to have deleted the
4604      frame, so cope with this. */
4605   if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame)))
4606     return;
4607
4608   CHECK_FRAME (frame);
4609   f = XFRAME (frame);
4610
4611   /* If we get called we know something has changed. */
4612   LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)))
4613     {
4614       Lisp_Object widget = XCAR (rest);
4615
4616       if (XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (widget)
4617           &&
4618           image_instance_changed (widget))
4619         {
4620           set_image_instance_dirty_p (widget, 1);
4621           MARK_FRAME_GLYPHS_CHANGED (f);
4622         }
4623     }
4624 }
4625
4626 /* remove a subwindow from its frame */
4627 void unmap_subwindow (Lisp_Object subwindow)
4628 {
4629   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4630   struct frame* f;
4631
4632   ERROR_CHECK_IMAGE_INSTANCE (subwindow);
4633
4634   if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii))
4635         & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK))
4636       ||
4637       !IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii))
4638     return;
4639
4640 #ifdef DEBUG_WIDGETS
4641   stderr_out ("unmapping subwindow %p\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii));
4642 #endif
4643   f = XFRAME (IMAGE_INSTANCE_FRAME (ii));
4644
4645   /* make sure we don't get expose events */
4646   register_ignored_expose (f, IMAGE_INSTANCE_DISPLAY_X (ii),
4647                            IMAGE_INSTANCE_DISPLAY_Y (ii),
4648                            IMAGE_INSTANCE_DISPLAY_WIDTH (ii),
4649                            IMAGE_INSTANCE_DISPLAY_HEIGHT (ii));
4650   IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4651
4652   MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)),
4653                  unmap_subwindow, (ii));
4654 }
4655
4656 /* show a subwindow in its frame */
4657 void map_subwindow (Lisp_Object subwindow, int x, int y,
4658                     struct display_glyph_area *dga)
4659 {
4660   Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow);
4661   struct frame* f;
4662
4663   ERROR_CHECK_IMAGE_INSTANCE (subwindow);
4664
4665   if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii))
4666         & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK)))
4667     return;
4668
4669 #ifdef DEBUG_WIDGETS
4670   stderr_out ("mapping subwindow %p, %dx%d@%d+%d\n",
4671               IMAGE_INSTANCE_SUBWINDOW_ID (ii),
4672               dga->width, dga->height, x, y);
4673 #endif
4674   f = XFRAME (IMAGE_INSTANCE_FRAME (ii));
4675   IMAGE_INSTANCE_DISPLAY_X (ii) = x;
4676   IMAGE_INSTANCE_DISPLAY_Y (ii) = y;
4677   IMAGE_INSTANCE_DISPLAY_WIDTH (ii) = dga->width;
4678   IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) = dga->height;
4679
4680   MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain),
4681                  map_subwindow, (ii, x, y, dga));
4682   IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1;
4683 }
4684
4685 static int
4686 subwindow_possible_dest_types (void)
4687 {
4688   return IMAGE_SUBWINDOW_MASK;
4689 }
4690
4691 int
4692 subwindow_governing_domain (void)
4693 {
4694   return GOVERNING_DOMAIN_WINDOW;
4695 }
4696
4697 /* Partially instantiate a subwindow. */
4698 void
4699 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator,
4700                        Lisp_Object pointer_fg, Lisp_Object pointer_bg,
4701                        int dest_mask, Lisp_Object domain)
4702 {
4703   Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance);
4704   Lisp_Object device = image_instance_device (image_instance);
4705   Lisp_Object frame = DOMAIN_FRAME (domain);
4706   Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width);
4707   Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height);
4708
4709   if (NILP (frame))
4710     signal_simple_error ("No selected frame", device);
4711
4712   if (!(dest_mask & IMAGE_SUBWINDOW_MASK))
4713     incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK);
4714
4715   ii->data = 0;
4716   IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0;
4717   IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0;
4718
4719   if (INTP (width))
4720     {
4721       int w = 1;
4722       if (XINT (width) > 1)
4723         w = XINT (width);
4724       IMAGE_INSTANCE_WIDTH (ii) = w;
4725       IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0;
4726     }
4727
4728   if (INTP (height))
4729     {
4730       int h = 1;
4731       if (XINT (height) > 1)
4732         h = XINT (height);
4733       IMAGE_INSTANCE_HEIGHT (ii) = h;
4734       IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0;
4735     }
4736 }
4737
4738 /* This is just a backup in case no-one has assigned a suitable geometry.
4739    #### It should really query the enclose window for geometry. */
4740 static void
4741 subwindow_query_geometry (Lisp_Object image_instance, int* width,
4742                           int* height, enum image_instance_geometry disp,
4743                           Lisp_Object domain)
4744 {
4745   if (width)    *width = 20;
4746   if (height)   *height = 20;
4747 }
4748
4749 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /*
4750 Return non-nil if OBJECT is a subwindow.
4751 */
4752        (object))
4753 {
4754   CHECK_IMAGE_INSTANCE (object);
4755   return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil;
4756 }
4757
4758 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /*
4759 Return the window id of SUBWINDOW as a number.
4760 */
4761        (subwindow))
4762 {
4763   CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4764   return make_int ((EMACS_INT) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow));
4765 }
4766
4767 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /*
4768 Resize SUBWINDOW to WIDTH x HEIGHT.
4769 If a value is nil that parameter is not changed.
4770 */
4771        (subwindow, width, height))
4772 {
4773   int neww, newh;
4774   Lisp_Image_Instance* ii;
4775
4776   CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4777   ii = XIMAGE_INSTANCE (subwindow);
4778
4779   if (NILP (width))
4780     neww = IMAGE_INSTANCE_WIDTH (ii);
4781   else
4782     neww = XINT (width);
4783
4784   if (NILP (height))
4785     newh = IMAGE_INSTANCE_HEIGHT (ii);
4786   else
4787     newh = XINT (height);
4788
4789   /* The actual resizing gets done asynchronously by
4790      update_subwindow. */
4791   IMAGE_INSTANCE_HEIGHT (ii) = newh;
4792   IMAGE_INSTANCE_WIDTH (ii) = neww;
4793   IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1;
4794
4795   return subwindow;
4796 }
4797
4798 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /*
4799 Generate a Map event for SUBWINDOW.
4800 */
4801        (subwindow))
4802 {
4803   CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow);
4804 #if 0
4805   map_subwindow (subwindow, 0, 0);
4806 #endif
4807   return subwindow;
4808 }
4809
4810 \f
4811 /*****************************************************************************
4812  *                              display tables                               *
4813  *****************************************************************************/
4814
4815 /* Get the display tables for use currently on window W with face
4816    FACE.  #### This will have to be redone.  */
4817
4818 void
4819 get_display_tables (struct window *w, face_index findex,
4820                     Lisp_Object *face_table, Lisp_Object *window_table)
4821 {
4822   Lisp_Object tem;
4823   tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex);
4824   if (UNBOUNDP (tem))
4825     tem = Qnil;
4826   if (!LISTP (tem))
4827     tem = noseeum_cons (tem, Qnil);
4828   *face_table = tem;
4829   tem = w->display_table;
4830   if (UNBOUNDP (tem))
4831     tem = Qnil;
4832   if (!LISTP (tem))
4833     tem = noseeum_cons (tem, Qnil);
4834   *window_table = tem;
4835 }
4836
4837 Lisp_Object
4838 display_table_entry (Emchar ch, Lisp_Object face_table,
4839                      Lisp_Object window_table)
4840 {
4841   Lisp_Object tail;
4842
4843   /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */
4844   for (tail = face_table; 1; tail = XCDR (tail))
4845     {
4846       Lisp_Object table;
4847       if (NILP (tail))
4848         {
4849           if (!NILP (window_table))
4850             {
4851               tail = window_table;
4852               window_table = Qnil;
4853             }
4854           else
4855             return Qnil;
4856         }
4857       table = XCAR (tail);
4858
4859       if (VECTORP (table))
4860         {
4861           if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch]))
4862             return XVECTOR_DATA (table)[ch];
4863           else
4864             continue;
4865         }
4866       else if (CHAR_TABLEP (table)
4867                && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)
4868         {
4869           return get_char_table (ch, XCHAR_TABLE (table));
4870         }
4871       else if (CHAR_TABLEP (table)
4872                && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC)
4873         {
4874           Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table));
4875           if (!NILP (gotit))
4876             return gotit;
4877           else
4878             continue;
4879         }
4880       else if (RANGE_TABLEP (table))
4881         {
4882           Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil);
4883           if (!NILP (gotit))
4884             return gotit;
4885           else
4886             continue;
4887         }
4888       else
4889         ABORT ();
4890     }
4891 }
4892
4893 /*****************************************************************************
4894  *                              timeouts for animated glyphs                      *
4895  *****************************************************************************/
4896 static Lisp_Object Qglyph_animated_timeout_handler;
4897
4898 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /*
4899 Callback function for updating animated images.
4900 Don't use this.
4901 */
4902        (arg))
4903 {
4904   CHECK_WEAK_LIST (arg);
4905
4906   if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg))))
4907     {
4908       Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg));
4909
4910       if (IMAGE_INSTANCEP (value))
4911         {
4912           Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value);
4913
4914           if (COLOR_PIXMAP_IMAGE_INSTANCEP (value)
4915               &&
4916               IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1
4917               &&
4918               !disable_animated_pixmaps)
4919             {
4920               /* Increment the index of the image slice we are currently
4921                  viewing. */
4922               IMAGE_INSTANCE_PIXMAP_SLICE (ii) =
4923                 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1)
4924                 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii);
4925               /* We might need to kick redisplay at this point - but we
4926                  also might not. */
4927               MARK_DEVICE_FRAMES_GLYPHS_CHANGED
4928                 (XDEVICE (image_instance_device (value)));
4929               /* Cascade dirtiness so that we can have an animated glyph in a layout
4930                  for instance. */
4931               set_image_instance_dirty_p (value, 1);
4932             }
4933         }
4934     }
4935   return Qnil;
4936 }
4937
4938 Lisp_Object add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image)
4939 {
4940   Lisp_Object ret = Qnil;
4941
4942   if (tickms > 0 && IMAGE_INSTANCEP (image))
4943     {
4944       double ms = ((double)tickms) / 1000.0;
4945       struct gcpro gcpro1;
4946       Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE);
4947
4948       GCPRO1 (holder);
4949       XWEAK_LIST_LIST (holder) = Fcons (image, Qnil);
4950
4951       ret = Fadd_timeout (make_float (ms),
4952                           Qglyph_animated_timeout_handler,
4953                           holder, make_float (ms));
4954
4955       UNGCPRO;
4956     }
4957   return ret;
4958 }
4959
4960 void disable_glyph_animated_timeout (int i)
4961 {
4962   Lisp_Object id;
4963   XSETINT (id, i);
4964
4965   Fdisable_timeout (id);
4966 }
4967
4968 \f
4969 /*****************************************************************************
4970  *                              initialization                               *
4971  *****************************************************************************/
4972
4973 void
4974 syms_of_glyphs (void)
4975 {
4976   INIT_LRECORD_IMPLEMENTATION (glyph);
4977   INIT_LRECORD_IMPLEMENTATION (image_instance);
4978
4979   /* image instantiators */
4980
4981   DEFSUBR (Fimage_instantiator_format_list);
4982   DEFSUBR (Fvalid_image_instantiator_format_p);
4983   DEFSUBR (Fset_console_type_image_conversion_list);
4984   DEFSUBR (Fconsole_type_image_conversion_list);
4985
4986   DEFKEYWORD (Q_file);
4987   DEFKEYWORD (Q_data);
4988   DEFKEYWORD (Q_face);
4989   DEFKEYWORD (Q_pixel_height);
4990   DEFKEYWORD (Q_pixel_width);
4991
4992 #ifdef HAVE_XPM
4993   DEFKEYWORD (Q_color_symbols);
4994 #endif
4995 #ifdef HAVE_WINDOW_SYSTEM
4996   DEFKEYWORD (Q_mask_file);
4997   DEFKEYWORD (Q_mask_data);
4998   DEFKEYWORD (Q_hotspot_x);
4999   DEFKEYWORD (Q_hotspot_y);
5000   DEFKEYWORD (Q_foreground);
5001   DEFKEYWORD (Q_background);
5002 #endif
5003   /* image specifiers */
5004
5005   DEFSUBR (Fimage_specifier_p);
5006   /* Qimage in general.c */
5007
5008   /* image instances */
5009
5010   defsymbol (&Qimage_instancep, "image-instance-p");
5011
5012   DEFSYMBOL (Qnothing_image_instance_p);
5013   DEFSYMBOL (Qtext_image_instance_p);
5014   DEFSYMBOL (Qmono_pixmap_image_instance_p);
5015   DEFSYMBOL (Qcolor_pixmap_image_instance_p);
5016   DEFSYMBOL (Qpointer_image_instance_p);
5017   DEFSYMBOL (Qwidget_image_instance_p);
5018   DEFSYMBOL (Qsubwindow_image_instance_p);
5019
5020   DEFSUBR (Fmake_image_instance);
5021   DEFSUBR (Fimage_instance_p);
5022   DEFSUBR (Fimage_instance_type);
5023   DEFSUBR (Fvalid_image_instance_type_p);
5024   DEFSUBR (Fimage_instance_type_list);
5025   DEFSUBR (Fimage_instance_name);
5026   DEFSUBR (Fimage_instance_domain);
5027   DEFSUBR (Fimage_instance_string);
5028   DEFSUBR (Fimage_instance_file_name);
5029   DEFSUBR (Fimage_instance_mask_file_name);
5030   DEFSUBR (Fimage_instance_depth);
5031   DEFSUBR (Fimage_instance_height);
5032   DEFSUBR (Fimage_instance_width);
5033   DEFSUBR (Fimage_instance_hotspot_x);
5034   DEFSUBR (Fimage_instance_hotspot_y);
5035   DEFSUBR (Fimage_instance_foreground);
5036   DEFSUBR (Fimage_instance_background);
5037   DEFSUBR (Fimage_instance_property);
5038   DEFSUBR (Fcolorize_image_instance);
5039   /* subwindows */
5040   DEFSUBR (Fsubwindowp);
5041   DEFSUBR (Fimage_instance_subwindow_id);
5042   DEFSUBR (Fresize_subwindow);
5043   DEFSUBR (Fforce_subwindow_map);
5044
5045   /* Qnothing defined as part of the "nothing" image-instantiator
5046      type. */
5047   /* Qtext defined in general.c */
5048   DEFSYMBOL (Qmono_pixmap);
5049   DEFSYMBOL (Qcolor_pixmap);
5050   /* Qpointer defined in general.c */
5051
5052   /* glyphs */
5053
5054   DEFSYMBOL (Qglyphp);
5055   DEFSYMBOL (Qcontrib_p);
5056   DEFSYMBOL (Qbaseline);
5057
5058   DEFSYMBOL (Qbuffer_glyph_p);
5059   DEFSYMBOL (Qpointer_glyph_p);
5060   DEFSYMBOL (Qicon_glyph_p);
5061
5062   DEFSYMBOL (Qconst_glyph_variable);
5063
5064   DEFSUBR (Fglyph_type);
5065   DEFSUBR (Fvalid_glyph_type_p);
5066   DEFSUBR (Fglyph_type_list);
5067   DEFSUBR (Fglyphp);
5068   DEFSUBR (Fmake_glyph_internal);
5069   DEFSUBR (Fglyph_width);
5070   DEFSUBR (Fglyph_ascent);
5071   DEFSUBR (Fglyph_descent);
5072   DEFSUBR (Fglyph_height);
5073   DEFSUBR (Fset_instantiator_property);
5074
5075   /* Qbuffer defined in general.c. */
5076   /* Qpointer defined above */
5077
5078   /* Unfortunately, timeout handlers must be lisp functions. This is
5079      for animated glyphs. */
5080   DEFSYMBOL (Qglyph_animated_timeout_handler);
5081   DEFSUBR (Fglyph_animated_timeout_handler);
5082
5083   /* Errors */
5084   DEFERROR_STANDARD (Qimage_conversion_error, Qio_error);
5085 }
5086
5087 static const struct lrecord_description image_specifier_description[] = {
5088   { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee) },
5089   { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct image_specifier, attachee_property) },
5090   { XD_END }
5091 };
5092
5093 void
5094 specifier_type_create_image (void)
5095 {
5096   /* image specifiers */
5097
5098   INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep");
5099
5100   SPECIFIER_HAS_METHOD (image, create);
5101   SPECIFIER_HAS_METHOD (image, mark);
5102   SPECIFIER_HAS_METHOD (image, instantiate);
5103   SPECIFIER_HAS_METHOD (image, validate);
5104   SPECIFIER_HAS_METHOD (image, after_change);
5105   SPECIFIER_HAS_METHOD (image, going_to_add);
5106   SPECIFIER_HAS_METHOD (image, copy_instantiator);
5107 }
5108
5109 void
5110 reinit_specifier_type_create_image (void)
5111 {
5112   REINITIALIZE_SPECIFIER_TYPE (image);
5113 }
5114
5115
5116 static const struct lrecord_description iike_description_1[] = {
5117   { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) },
5118   { XD_END }
5119 };
5120
5121 static const struct struct_description iike_description = {
5122   sizeof (ii_keyword_entry),
5123   iike_description_1
5124 };
5125
5126 static const struct lrecord_description iiked_description_1[] = {
5127   XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description),
5128   { XD_END }
5129 };
5130
5131 static const struct struct_description iiked_description = {
5132   sizeof (ii_keyword_entry_dynarr),
5133   iiked_description_1
5134 };
5135
5136 static const struct lrecord_description iife_description_1[] = {
5137   { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) },
5138   { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) },
5139   { XD_STRUCT_PTR,  offsetof (image_instantiator_format_entry, meths),  1, &iim_description },
5140   { XD_END }
5141 };
5142
5143 static const struct struct_description iife_description = {
5144   sizeof (image_instantiator_format_entry),
5145   iife_description_1
5146 };
5147
5148 static const struct lrecord_description iifed_description_1[] = {
5149   XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description),
5150   { XD_END }
5151 };
5152
5153 static const struct struct_description iifed_description = {
5154   sizeof (image_instantiator_format_entry_dynarr),
5155   iifed_description_1
5156 };
5157
5158 static const struct lrecord_description iim_description_1[] = {
5159   { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) },
5160   { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) },
5161   { XD_STRUCT_PTR,  offsetof (struct image_instantiator_methods, keywords), 1, &iiked_description },
5162   { XD_STRUCT_PTR,  offsetof (struct image_instantiator_methods, consoles), 1, &cted_description },
5163   { XD_END }
5164 };
5165
5166 const struct struct_description iim_description = {
5167   sizeof (struct image_instantiator_methods),
5168   iim_description_1
5169 };
5170
5171 void
5172 image_instantiator_format_create (void)
5173 {
5174   /* image instantiators */
5175
5176   the_image_instantiator_format_entry_dynarr =
5177     Dynarr_new (image_instantiator_format_entry);
5178
5179   Vimage_instantiator_format_list = Qnil;
5180   staticpro (&Vimage_instantiator_format_list);
5181
5182   dump_add_root_struct_ptr (&the_image_instantiator_format_entry_dynarr, &iifed_description);
5183
5184   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing");
5185
5186   IIFORMAT_HAS_METHOD (nothing, possible_dest_types);
5187   IIFORMAT_HAS_METHOD (nothing, instantiate);
5188
5189   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit");
5190
5191   IIFORMAT_HAS_METHOD (inherit, validate);
5192   IIFORMAT_HAS_METHOD (inherit, normalize);
5193   IIFORMAT_HAS_METHOD (inherit, possible_dest_types);
5194   IIFORMAT_HAS_METHOD (inherit, instantiate);
5195
5196   IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face);
5197
5198   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string");
5199
5200   IIFORMAT_HAS_METHOD (string, validate);
5201   IIFORMAT_HAS_SHARED_METHOD (string, governing_domain, subwindow);
5202   IIFORMAT_HAS_METHOD (string, possible_dest_types);
5203   IIFORMAT_HAS_METHOD (string, instantiate);
5204
5205   IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string);
5206   /* Do this so we can set strings. */
5207   /* #### Andy, what is this?  This is a bogus format and should not be
5208      visible to the user. */
5209   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text");
5210   IIFORMAT_HAS_METHOD (text, update);
5211   IIFORMAT_HAS_METHOD (text, query_geometry);
5212
5213   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string");
5214
5215   IIFORMAT_HAS_METHOD (formatted_string, validate);
5216   IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types);
5217   IIFORMAT_HAS_METHOD (formatted_string, instantiate);
5218   IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string);
5219
5220   /* Do this so pointers have geometry. */
5221   /* #### Andy, what is this?  This is a bogus format and should not be
5222      visible to the user. */
5223   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (pointer, "pointer");
5224   IIFORMAT_HAS_SHARED_METHOD (pointer, query_geometry, subwindow);
5225
5226   /* subwindows */
5227   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow");
5228   IIFORMAT_HAS_METHOD (subwindow, possible_dest_types);
5229   IIFORMAT_HAS_METHOD (subwindow, governing_domain);
5230   IIFORMAT_HAS_METHOD (subwindow, instantiate);
5231   IIFORMAT_HAS_METHOD (subwindow, query_geometry);
5232   IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int);
5233   IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int);
5234
5235 #ifdef HAVE_WINDOW_SYSTEM
5236   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm");
5237
5238   IIFORMAT_HAS_METHOD (xbm, validate);
5239   IIFORMAT_HAS_METHOD (xbm, normalize);
5240   IIFORMAT_HAS_METHOD (xbm, possible_dest_types);
5241
5242   IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline);
5243   IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string);
5244   IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline);
5245   IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string);
5246   IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int);
5247   IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int);
5248   IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string);
5249   IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string);
5250 #endif /* HAVE_WINDOW_SYSTEM */
5251
5252 #ifdef HAVE_XFACE
5253   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface");
5254
5255   IIFORMAT_HAS_METHOD (xface, validate);
5256   IIFORMAT_HAS_METHOD (xface, normalize);
5257   IIFORMAT_HAS_METHOD (xface, possible_dest_types);
5258
5259   IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string);
5260   IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string);
5261   IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int);
5262   IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int);
5263   IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string);
5264   IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string);
5265 #endif
5266
5267 #ifdef HAVE_XPM
5268   INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm");
5269
5270   IIFORMAT_HAS_METHOD (xpm, validate);
5271   IIFORMAT_HAS_METHOD (xpm, normalize);
5272   IIFORMAT_HAS_METHOD (xpm, possible_dest_types);
5273
5274   IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string);
5275   IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string);
5276   IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols);
5277 #endif /* HAVE_XPM */
5278 }
5279
5280 void
5281 reinit_vars_of_glyphs (void)
5282 {
5283   the_expose_ignore_blocktype =
5284     Blocktype_new (struct expose_ignore_blocktype);
5285
5286   hold_ignored_expose_registration = 0;
5287 }
5288
5289
5290 void
5291 vars_of_glyphs (void)
5292 {
5293   reinit_vars_of_glyphs ();
5294
5295   Vthe_nothing_vector = vector1 (Qnothing);
5296   staticpro (&Vthe_nothing_vector);
5297
5298   /* image instances */
5299
5300   Vimage_instance_type_list = Fcons (Qnothing,
5301                                      list6 (Qtext, Qmono_pixmap, Qcolor_pixmap,
5302                                             Qpointer, Qsubwindow, Qwidget));
5303   staticpro (&Vimage_instance_type_list);
5304
5305   /* glyphs */
5306
5307   Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon);
5308   staticpro (&Vglyph_type_list);
5309
5310   /* The octal-escape glyph, control-arrow-glyph and
5311      invisible-text-glyph are completely initialized in glyphs.el */
5312
5313   DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /*
5314 What to prefix character codes displayed in octal with.
5315 */);
5316   Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5317
5318   DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /*
5319 What to use as an arrow for control characters.
5320 */);
5321   Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER,
5322                                          redisplay_glyph_changed);
5323
5324   DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /*
5325 What to use to indicate the presence of invisible text.
5326 This is the glyph that is displayed when an ellipsis is called for
5327 \(see `selective-display-ellipses' and `buffer-invisibility-spec').
5328 Normally this is three dots ("...").
5329 */);
5330   Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER,
5331                                           redisplay_glyph_changed);
5332
5333   /* Partially initialized in glyphs.el */
5334   DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /*
5335 What to display at the beginning of horizontally scrolled lines.
5336 */);
5337   Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5338 #ifdef HAVE_WINDOW_SYSTEM
5339   Fprovide (Qxbm);
5340 #endif
5341 #ifdef HAVE_XPM
5342   Fprovide (Qxpm);
5343
5344   DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /*
5345 Definitions of logical color-names used when reading XPM files.
5346 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE).
5347 The COLOR-NAME should be a string, which is the name of the color to define;
5348 the FORM should evaluate to a `color' specifier object, or a string to be
5349 passed to `make-color-instance'.  If a loaded XPM file references a symbolic
5350 color called COLOR-NAME, it will display as the computed color instead.
5351
5352 The default value of this variable defines the logical color names
5353 \"foreground\" and \"background\" to be the colors of the `default' face.
5354 */ );
5355   Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */
5356 #endif /* HAVE_XPM */
5357 #ifdef HAVE_XFACE
5358   Fprovide (Qxface);
5359 #endif
5360
5361   DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /*
5362 Whether animated pixmaps should be animated.
5363 Default is t.
5364 */);
5365   disable_animated_pixmaps = 0;
5366 }
5367
5368 void
5369 specifier_vars_of_glyphs (void)
5370 {
5371   /* #### Can we GC here? The set_specifier_* calls definitely need */
5372   /* protection. */
5373   /* display tables */
5374
5375   DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /*
5376 *The display table currently in use.
5377 This is a specifier; use `set-specifier' to change it.
5378
5379 Display tables are used to control how characters are displayed.  Each
5380 time that redisplay processes a character, it is looked up in all the
5381 display tables that apply (obtained by calling `specifier-instance' on
5382 `current-display-table' and any overriding display tables specified in
5383 currently active faces).  The first entry found that matches the
5384 character determines how the character is displayed.  If there is no
5385 matching entry, the default display method is used. (Non-control
5386 characters are displayed as themselves and control characters are
5387 displayed according to the buffer-local variable `ctl-arrow'.  Control
5388 characters are further affected by `control-arrow-glyph' and
5389 `octal-escape-glyph'.)
5390
5391 Each instantiator in this specifier and the display-table specifiers
5392 in faces is a display table or a list of such tables.  If a list, each
5393 table will be searched in turn for an entry matching a particular
5394 character.  Each display table is one of
5395
5396 -- a vector, specifying values for characters starting at 0
5397 -- a char table, either of type `char' or `generic'
5398 -- a range table
5399
5400 Each entry in a display table should be one of
5401
5402 -- nil (this entry is ignored and the search continues)
5403 -- a character (use this character; if it happens to be the same as
5404    the original character, default processing happens, otherwise
5405    redisplay attempts to display this character directly;
5406    #### At some point recursive display-table lookup will be
5407    implemented.)
5408 -- a string (display each character in the string directly;
5409    #### At some point recursive display-table lookup will be
5410    implemented.)
5411 -- a glyph (display the glyph;
5412    #### At some point recursive display-table lookup will be
5413    implemented when a string glyph is being processed.)
5414 -- a cons of the form (format "STRING") where STRING is a printf-like
5415    spec used to process the character. #### Unfortunately no
5416    formatting directives other than %% are implemented.
5417 -- a vector (each element of the vector is processed recursively;
5418    in such a case, nil elements in the vector are simply ignored)
5419
5420 #### At some point in the near future, display tables are likely to
5421 be expanded to include other features, such as referencing characters
5422 in particular fonts and allowing the character search to continue
5423 all the way up the chain of specifier instantiators.  These features
5424 are necessary to properly display Unicode characters.
5425 */ );
5426   Vcurrent_display_table = Fmake_specifier (Qdisplay_table);
5427   set_specifier_fallback (Vcurrent_display_table,
5428                           list1 (Fcons (Qnil, Qnil)));
5429   set_specifier_caching (Vcurrent_display_table,
5430                          offsetof (struct window, display_table),
5431                          some_window_value_changed,
5432                          0, 0, 0);
5433 }
5434
5435 void
5436 complex_vars_of_glyphs (void)
5437 {
5438   /* Partially initialized in glyphs-x.c, glyphs.el */
5439   DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /*
5440 What to display at the end of truncated lines.
5441 */ );
5442   Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5443
5444   /* Partially initialized in glyphs-x.c, glyphs.el */
5445   DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /*
5446 What to display at the end of wrapped lines.
5447 */ );
5448   Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed);
5449
5450   /* Partially initialized in glyphs-x.c, glyphs.el */
5451   DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /*
5452 The glyph used to display the XEmacs logo at startup.
5453 */ );
5454   Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0);
5455 }