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