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