Mercurial > hg > xemacs-beta
annotate src/glyphs.c @ 5636:07256dcc0c8b
Add missing foreback specifier values to the GUI Element face.
They were missing for an unexplicable reason in my initial patch, leading to
nil color instances in the whole hierarchy of widget faces.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2012-01-03 Didier Verna <didier@xemacs.org>
* faces.c (complex_vars_of_faces): Add missing foreback specifier
values to the GUI Element face.
| author | Didier Verna <didier@lrde.epita.fr> |
|---|---|
| date | Tue, 03 Jan 2012 11:25:06 +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 } |