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