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