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