Mercurial > hg > xemacs-beta
annotate src/glyphs.c @ 5887:6eca500211f4
Prototype for X509_check_host() has changed, detect this in configure.ac
ChangeLog addition:
2015-04-09 Aidan Kehoe <kehoea@parhasard.net>
* configure.ac:
If X509_check_host() is available, check the number of arguments
it takes. Don't use it if it takes any number of arguments other
than five. Also don't use it if <openssl/x509v3.h> does not
declare it, since if that is so there is no portable way to tell
how many arguments it should take, and so we would end up smashing
the stack.
* configure: Regenerate.
src/ChangeLog addition:
2015-04-09 Aidan Kehoe <kehoea@parhasard.net>
* tls.c:
#include <openssl/x509v3.h> for its prototype for
X509_check_host().
* tls.c (tls_open):
Pass the new fifth argument to X509_check_host().
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Thu, 09 Apr 2015 14:27:02 +0100 |
| parents | 427a72c6ee17 |
| children | 0f2338afbabf |
| 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 { | |
|
5762
427a72c6ee17
Eliminate several compiler (clang) warnings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5736
diff
changeset
|
2640 Lisp_Object width, height, bits; |
|
427a72c6ee17
Eliminate several compiler (clang) warnings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5736
diff
changeset
|
2641 EMACS_INT i_width, i_height; |
| 428 | 2642 |
| 2643 if (!CONSP (data) || | |
| 2644 !CONSP (XCDR (data)) || | |
| 2645 !CONSP (XCDR (XCDR (data))) || | |
| 2646 !NILP (XCDR (XCDR (XCDR (data))))) | |
| 563 | 2647 sferror ("Must be list of 3 elements", data); |
| 428 | 2648 |
| 2649 width = XCAR (data); | |
| 2650 height = XCAR (XCDR (data)); | |
| 2651 bits = XCAR (XCDR (XCDR (data))); | |
| 2652 | |
| 2653 CHECK_STRING (bits); | |
| 2654 | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5626
diff
changeset
|
2655 if (!FIXNUMP (width) || XREALFIXNUM (width) < 0) |
| 563 | 2656 invalid_argument ("Width must be a natural number", width); |
| 428 | 2657 |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5626
diff
changeset
|
2658 if (!FIXNUMP (height) || XREALFIXNUM (height) < 0) |
| 563 | 2659 invalid_argument ("Height must be a natural number", height); |
| 428 | 2660 |
|
5762
427a72c6ee17
Eliminate several compiler (clang) warnings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5736
diff
changeset
|
2661 i_width = XREALFIXNUM (width); |
|
427a72c6ee17
Eliminate several compiler (clang) warnings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5736
diff
changeset
|
2662 i_height = XREALFIXNUM (height); |
|
427a72c6ee17
Eliminate several compiler (clang) warnings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5736
diff
changeset
|
2663 if (i_width * i_height / 8 > string_char_length (bits)) |
| 563 | 2664 invalid_argument ("data is too short for width and height", |
| 428 | 2665 vector3 (width, height, bits)); |
| 2666 } | |
| 2667 | |
| 2668 /* Validate method for XBM's. */ | |
| 2669 | |
| 2670 static void | |
| 2671 xbm_validate (Lisp_Object instantiator) | |
| 2672 { | |
| 2673 file_or_data_must_be_present (instantiator); | |
| 2674 } | |
| 2675 | |
| 2676 /* Given a filename that is supposed to contain XBM data, return | |
| 2677 the inline representation of it as (width height bits). Return | |
| 2678 the hotspot through XHOT and YHOT, if those pointers are not 0. | |
| 2679 If there is no hotspot, XHOT and YHOT will contain -1. | |
| 2680 | |
| 2681 If the function fails: | |
| 2682 | |
| 2683 -- if OK_IF_DATA_INVALID is set and the data was invalid, | |
| 2684 return Qt. | |
| 2685 -- maybe return an error, or return Qnil. | |
| 2686 */ | |
| 2687 | |
| 2688 #ifdef HAVE_X_WINDOWS | |
| 2689 #include <X11/Xlib.h> | |
| 2690 #else | |
| 2691 #define XFree(data) free(data) | |
| 2692 #endif | |
| 2693 | |
| 2694 Lisp_Object | |
| 2695 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot, | |
| 2696 int ok_if_data_invalid) | |
| 2697 { | |
| 647 | 2698 int w, h; |
| 2367 | 2699 Binbyte *data; |
| 428 | 2700 int result; |
| 771 | 2701 |
| 2702 result = read_bitmap_data_from_file (name, &w, &h, &data, xhot, yhot); | |
| 428 | 2703 |
| 2704 if (result == BitmapSuccess) | |
| 2705 { | |
| 2706 Lisp_Object retval; | |
| 2707 int len = (w + 7) / 8 * h; | |
| 2708 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
2709 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
|
2710 make_extstring ((Extbyte *) data, len, Qbinary)); |
| 444 | 2711 XFree (data); |
| 428 | 2712 return retval; |
| 2713 } | |
| 2714 | |
| 2715 switch (result) | |
| 2716 { | |
| 2717 case BitmapOpenFailed: | |
| 2718 { | |
| 2719 /* should never happen */ | |
| 563 | 2720 signal_double_image_error ("Opening bitmap file", |
| 2721 "no such file or directory", | |
| 2722 name); | |
| 428 | 2723 } |
| 2724 case BitmapFileInvalid: | |
| 2725 { | |
| 2726 if (ok_if_data_invalid) | |
| 2727 return Qt; | |
| 563 | 2728 signal_double_image_error ("Reading bitmap file", |
| 2729 "invalid data in file", | |
| 2730 name); | |
| 428 | 2731 } |
| 2732 case BitmapNoMemory: | |
| 2733 { | |
| 563 | 2734 signal_double_image_error ("Reading bitmap file", |
| 2735 "out of memory", | |
| 2736 name); | |
| 428 | 2737 } |
| 2738 default: | |
| 2739 { | |
| 563 | 2740 signal_double_image_error_2 ("Reading bitmap file", |
| 2741 "unknown error code", | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
2742 make_fixnum (result), name); |
| 428 | 2743 } |
| 2744 } | |
| 2745 | |
| 2746 return Qnil; /* not reached */ | |
| 2747 } | |
| 2748 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2749 /* 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
|
2750 "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
|
2751 number of bitmaps in /usr/include/X11/bitmaps use it. */ |
| 428 | 2752 Lisp_Object |
| 2753 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file, | |
| 2754 Lisp_Object mask_file, Lisp_Object console_type) | |
| 2755 { | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2756 /* 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
|
2757 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
|
2758 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
|
2759 exist. */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2760 if (EQ (mask_file, Qt) && NILP (assq_no_quit (Q_mask_data, alist))) |
| 428 | 2761 { |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2762 assert (!EQ (file, Qt) && !EQ (file, Qnil)); |
| 428 | 2763 mask_file = MAYBE_LISP_CONTYPE_METH |
| 2764 (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
|
2765 locate_pixmap_file, (concat2 (file, build_ascstring ("Mask")))); |
| 428 | 2766 if (NILP (mask_file)) |
| 2767 mask_file = MAYBE_LISP_CONTYPE_METH | |
| 2768 (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
|
2769 locate_pixmap_file, (concat2 (file, build_ascstring ("msk")))); |
| 428 | 2770 } |
| 2771 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2772 /* We got a mask file, either explicitely or from the search above. */ |
| 428 | 2773 if (!NILP (mask_file)) |
| 2774 { | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2775 Lisp_Object mask_data; |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2776 |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2777 assert (!EQ (mask_file, Qt)); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2778 |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2779 mask_data = bitmap_to_lisp_data (mask_file, 0, 0, 0); |
| 428 | 2780 alist = remassq_no_quit (Q_mask_file, alist); |
| 2781 /* there can't be a :mask-data at this point. */ | |
| 2782 alist = Fcons (Fcons (Q_mask_file, mask_file), | |
| 2783 Fcons (Fcons (Q_mask_data, mask_data), alist)); | |
| 2784 } | |
| 2785 | |
| 2786 return alist; | |
| 2787 } | |
| 2788 | |
| 2789 /* Normalize method for XBM's. */ | |
| 2790 | |
| 2791 static Lisp_Object | |
| 442 | 2792 xbm_normalize (Lisp_Object inst, Lisp_Object console_type, |
| 2286 | 2793 Lisp_Object UNUSED (dest_mask)) |
| 428 | 2794 { |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2795 Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil; |
| 428 | 2796 struct gcpro gcpro1, gcpro2, gcpro3; |
| 2797 | |
| 2798 GCPRO3 (file, mask_file, alist); | |
| 2799 | |
| 2800 /* Now, convert any file data into inline data for both the regular | |
| 2801 data and the mask data. At the end of this, `data' will contain | |
| 2802 the inline data (if any) or Qnil, and `file' will contain | |
| 2803 the name this data was derived from (if known) or Qnil. | |
| 2804 Likewise for `mask_file' and `mask_data'. | |
| 2805 | |
| 2806 Note that if we cannot generate any regular inline data, we | |
| 2807 skip out. */ | |
| 2808 | |
| 2809 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
| 2810 console_type); | |
| 2811 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, | |
| 2812 Q_mask_data, console_type); | |
| 2813 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2814 /* 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
|
2815 file (neither a mask file BTW). */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2816 if (NILP (file)) |
| 4226 | 2817 RETURN_UNGCPRO (Qnil); |
| 2818 | |
| 428 | 2819 if (CONSP (file)) /* failure locating filename */ |
| 563 | 2820 signal_double_image_error ("Opening bitmap file", |
| 2821 "no such file or directory", | |
| 2822 Fcar (file)); | |
| 428 | 2823 |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2824 if (CONSP (mask_file)) /* failure locating filename */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2825 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
|
2826 "no such file or directory", |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2827 Fcar (mask_file)); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2828 |
| 4226 | 2829 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ |
| 428 | 2830 RETURN_UNGCPRO (inst); |
| 2831 | |
| 2832 alist = tagged_vector_to_alist (inst); | |
| 2833 | |
| 4226 | 2834 if (!EQ (file, Qt)) |
| 428 | 2835 { |
| 2836 int xhot, yhot; | |
| 2837 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0); | |
| 2838 alist = remassq_no_quit (Q_file, alist); | |
| 2839 /* there can't be a :data at this point. */ | |
| 2840 alist = Fcons (Fcons (Q_file, file), | |
| 2841 Fcons (Fcons (Q_data, data), alist)); | |
| 2842 | |
| 2843 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
|
2844 alist = Fcons (Fcons (Q_hotspot_x, make_fixnum (xhot)), |
| 428 | 2845 alist); |
| 2846 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
|
2847 alist = Fcons (Fcons (Q_hotspot_y, make_fixnum (yhot)), |
| 428 | 2848 alist); |
| 2849 } | |
| 2850 | |
| 2851 alist = xbm_mask_file_munging (alist, file, mask_file, console_type); | |
| 2852 | |
| 2853 { | |
| 2854 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist); | |
| 2855 free_alist (alist); | |
| 2856 RETURN_UNGCPRO (result); | |
| 2857 } | |
| 2858 } | |
| 2859 | |
| 2860 | |
| 2861 static int | |
| 2862 xbm_possible_dest_types (void) | |
| 2863 { | |
| 2864 return | |
| 2865 IMAGE_MONO_PIXMAP_MASK | | |
| 2866 IMAGE_COLOR_PIXMAP_MASK | | |
| 2867 IMAGE_POINTER_MASK; | |
| 2868 } | |
| 2869 | |
| 2870 #endif | |
| 2871 | |
| 2872 | |
| 2873 #ifdef HAVE_XFACE | |
| 2874 /********************************************************************** | |
| 2875 * X-Face * | |
| 2876 **********************************************************************/ | |
| 2877 | |
| 2878 static void | |
| 2879 xface_validate (Lisp_Object instantiator) | |
| 2880 { | |
| 2881 file_or_data_must_be_present (instantiator); | |
| 2882 } | |
| 2883 | |
| 2884 static Lisp_Object | |
| 442 | 2885 xface_normalize (Lisp_Object inst, Lisp_Object console_type, |
| 2286 | 2886 Lisp_Object UNUSED (dest_mask)) |
| 428 | 2887 { |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2888 Lisp_Object file = Qnil, mask_file = Qnil, alist = Qnil; |
| 428 | 2889 struct gcpro gcpro1, gcpro2, gcpro3; |
| 2890 | |
| 2891 GCPRO3 (file, mask_file, alist); | |
| 2892 | |
| 2893 /* Now, convert any file data into inline data for both the regular | |
| 2894 data and the mask data. At the end of this, `data' will contain | |
| 2895 the inline data (if any) or Qnil, and `file' will contain | |
| 2896 the name this data was derived from (if known) or Qnil. | |
| 2897 Likewise for `mask_file' and `mask_data'. | |
| 2898 | |
| 2899 Note that if we cannot generate any regular inline data, we | |
| 2900 skip out. */ | |
| 2901 | |
| 2902 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
| 2903 console_type); | |
| 2904 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, | |
| 2905 Q_mask_data, console_type); | |
| 2906 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2907 /* 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
|
2908 file (neither a mask file BTW). */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2909 if (NILP (file)) |
| 4226 | 2910 RETURN_UNGCPRO (Qnil); |
| 2911 | |
| 428 | 2912 if (CONSP (file)) /* failure locating filename */ |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2913 signal_double_image_error ("Opening face file", |
| 563 | 2914 "no such file or directory", |
| 2915 Fcar (file)); | |
| 428 | 2916 |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2917 if (CONSP (mask_file)) /* failure locating filename */ |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2918 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
|
2919 "no such file or directory", |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2920 Fcar (mask_file)); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2921 |
| 4226 | 2922 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ |
| 428 | 2923 RETURN_UNGCPRO (inst); |
| 2924 | |
| 2925 alist = tagged_vector_to_alist (inst); | |
| 2926 | |
|
5073
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2927 if (!EQ (file, Qt)) |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2928 { |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2929 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
|
2930 alist = remassq_no_quit (Q_file, alist); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2931 /* 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
|
2932 alist = Fcons (Fcons (Q_file, file), |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2933 Fcons (Fcons (Q_data, data), alist)); |
|
78a3c171a427
Fixes for bitmap mask files handling
Didier Verna <didier@lrde.epita.fr>
parents:
5013
diff
changeset
|
2934 } |
| 428 | 2935 |
| 2936 alist = xbm_mask_file_munging (alist, file, mask_file, console_type); | |
| 2937 | |
| 2938 { | |
| 2939 Lisp_Object result = alist_to_tagged_vector (Qxface, alist); | |
| 2940 free_alist (alist); | |
| 2941 RETURN_UNGCPRO (result); | |
| 2942 } | |
| 2943 } | |
| 2944 | |
| 2945 static int | |
| 2946 xface_possible_dest_types (void) | |
| 2947 { | |
| 2948 return | |
| 2949 IMAGE_MONO_PIXMAP_MASK | | |
| 2950 IMAGE_COLOR_PIXMAP_MASK | | |
| 2951 IMAGE_POINTER_MASK; | |
| 2952 } | |
| 2953 | |
| 2954 #endif /* HAVE_XFACE */ | |
| 2955 | |
| 2956 | |
| 2957 #ifdef HAVE_XPM | |
| 2958 | |
| 2959 /********************************************************************** | |
| 2960 * XPM * | |
| 2961 **********************************************************************/ | |
| 2962 | |
| 462 | 2963 #ifdef HAVE_GTK |
| 2964 /* Gtk has to be gratuitously different, eh? */ | |
| 2965 Lisp_Object | |
|
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2966 pixmap_to_lisp_data (Lisp_Object name, int UNUSED (ok_if_data_invalid)) |
| 462 | 2967 { |
| 2968 return (make_string_from_file (name)); | |
| 2969 } | |
| 2970 #else | |
| 428 | 2971 Lisp_Object |
| 2972 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid) | |
| 2973 { | |
| 2526 | 2974 Ascbyte **data; |
| 428 | 2975 int result; |
| 2526 | 2976 Extbyte *fname = 0; |
| 2977 Ibyte *resolved; | |
| 2978 | |
| 2979 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
|
2980 fname = ITEXT_TO_EXTERNAL (resolved, Qfile_name); |
| 428 | 2981 result = XpmReadFileToData (fname, &data); |
| 2982 | |
| 2983 if (result == XpmSuccess) | |
| 2984 { | |
| 2985 Lisp_Object retval = Qnil; | |
| 2986 struct buffer *old_buffer = current_buffer; | |
| 2987 Lisp_Object temp_buffer = | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2988 Fget_buffer_create (build_ascstring (" *pixmap conversion*")); |
| 428 | 2989 int elt; |
| 2990 int height, width, ncolors; | |
| 2991 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 2992 int speccount = specpdl_depth (); | |
| 2993 | |
| 2994 GCPRO3 (name, retval, temp_buffer); | |
| 2995 | |
| 2996 specbind (Qinhibit_quit, Qt); | |
| 2997 set_buffer_internal (XBUFFER (temp_buffer)); | |
| 2998 Ferase_buffer (Qnil); | |
| 2999 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3000 buffer_insert_ascstring (current_buffer, "/* XPM */\r"); |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3001 buffer_insert_ascstring (current_buffer, "static char *pixmap[] = {\r"); |
| 428 | 3002 |
| 3003 sscanf (data[0], "%d %d %d", &height, &width, &ncolors); | |
| 3004 for (elt = 0; elt <= width + ncolors; elt++) | |
| 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, "\""); |
|
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3007 buffer_insert_ascstring (current_buffer, data[elt]); |
| 428 | 3008 |
| 3009 if (elt < width + ncolors) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3010 buffer_insert_ascstring (current_buffer, "\",\r"); |
| 428 | 3011 else |
|
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, "\"};\r"); |
| 428 | 3013 } |
| 3014 | |
| 3015 retval = Fbuffer_substring (Qnil, Qnil, Qnil); | |
| 3016 XpmFree (data); | |
| 3017 | |
| 3018 set_buffer_internal (old_buffer); | |
| 771 | 3019 unbind_to (speccount); |
| 428 | 3020 |
| 3021 RETURN_UNGCPRO (retval); | |
| 3022 } | |
| 3023 | |
| 3024 switch (result) | |
| 3025 { | |
| 3026 case XpmFileInvalid: | |
| 3027 { | |
| 3028 if (ok_if_data_invalid) | |
| 3029 return Qt; | |
| 3030 signal_image_error ("invalid XPM data in file", name); | |
| 3031 } | |
| 3032 case XpmNoMemory: | |
| 3033 { | |
| 563 | 3034 signal_double_image_error ("Reading pixmap file", |
| 3035 "out of memory", name); | |
| 428 | 3036 } |
| 3037 case XpmOpenFailed: | |
| 3038 { | |
| 3039 /* should never happen? */ | |
| 563 | 3040 signal_double_image_error ("Opening pixmap file", |
| 3041 "no such file or directory", name); | |
| 428 | 3042 } |
| 3043 default: | |
| 3044 { | |
| 563 | 3045 signal_double_image_error_2 ("Parsing pixmap file", |
| 3046 "unknown error code", | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
3047 make_fixnum (result), name); |
| 428 | 3048 break; |
| 3049 } | |
| 3050 } | |
| 3051 | |
| 3052 return Qnil; /* not reached */ | |
| 3053 } | |
| 462 | 3054 #endif /* !HAVE_GTK */ |
| 428 | 3055 |
| 3056 static void | |
| 3057 check_valid_xpm_color_symbols (Lisp_Object data) | |
| 3058 { | |
| 3059 Lisp_Object rest; | |
| 3060 | |
| 3061 for (rest = data; !NILP (rest); rest = XCDR (rest)) | |
| 3062 { | |
| 3063 if (!CONSP (rest) || | |
| 3064 !CONSP (XCAR (rest)) || | |
| 3065 !STRINGP (XCAR (XCAR (rest))) || | |
| 3066 (!STRINGP (XCDR (XCAR (rest))) && | |
| 3067 !COLOR_SPECIFIERP (XCDR (XCAR (rest))))) | |
| 563 | 3068 sferror ("Invalid color symbol alist", data); |
| 428 | 3069 } |
| 3070 } | |
| 3071 | |
| 3072 static void | |
| 3073 xpm_validate (Lisp_Object instantiator) | |
| 3074 { | |
| 3075 file_or_data_must_be_present (instantiator); | |
| 3076 } | |
| 3077 | |
| 3078 Lisp_Object Vxpm_color_symbols; | |
| 3079 | |
| 3080 Lisp_Object | |
| 3081 evaluate_xpm_color_symbols (void) | |
| 3082 { | |
| 3083 Lisp_Object rest, results = Qnil; | |
| 3084 struct gcpro gcpro1, gcpro2; | |
| 3085 | |
| 3086 GCPRO2 (rest, results); | |
| 3087 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest)) | |
| 3088 { | |
| 3089 Lisp_Object name, value, cons; | |
| 3090 | |
| 3091 CHECK_CONS (rest); | |
| 3092 cons = XCAR (rest); | |
| 3093 CHECK_CONS (cons); | |
| 3094 name = XCAR (cons); | |
| 3095 CHECK_STRING (name); | |
| 3096 value = XCDR (cons); | |
| 3097 CHECK_CONS (value); | |
| 3098 value = XCAR (value); | |
|
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4426
diff
changeset
|
3099 value = IGNORE_MULTIPLE_VALUES (Feval (value)); |
| 428 | 3100 if (NILP (value)) |
| 3101 continue; | |
| 3102 if (!STRINGP (value) && !COLOR_SPECIFIERP (value)) | |
| 563 | 3103 invalid_argument |
| 428 | 3104 ("Result from xpm-color-symbols eval must be nil, string, or color", |
| 3105 value); | |
| 3106 results = Fcons (Fcons (name, value), results); | |
| 3107 } | |
| 3108 UNGCPRO; /* no more evaluation */ | |
| 3109 return results; | |
| 3110 } | |
| 3111 | |
| 3112 static Lisp_Object | |
| 442 | 3113 xpm_normalize (Lisp_Object inst, Lisp_Object console_type, |
| 2286 | 3114 Lisp_Object UNUSED (dest_mask)) |
| 428 | 3115 { |
| 3116 Lisp_Object file = Qnil; | |
| 3117 Lisp_Object color_symbols; | |
| 3118 struct gcpro gcpro1, gcpro2; | |
| 3119 Lisp_Object alist = Qnil; | |
| 3120 | |
| 3121 GCPRO2 (file, alist); | |
| 3122 | |
| 3123 /* Now, convert any file data into inline data. At the end of this, | |
| 3124 `data' will contain the inline data (if any) or Qnil, and | |
| 3125 `file' will contain the name this data was derived from (if | |
| 3126 known) or Qnil. | |
| 3127 | |
| 3128 Note that if we cannot generate any regular inline data, we | |
| 3129 skip out. */ | |
| 3130 | |
| 3131 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
| 3132 console_type); | |
| 3133 | |
| 4226 | 3134 if (NILP (file)) /* normalization impossible for the console type */ |
| 3135 RETURN_UNGCPRO (Qnil); | |
| 3136 | |
| 428 | 3137 if (CONSP (file)) /* failure locating filename */ |
| 563 | 3138 signal_double_image_error ("Opening pixmap file", |
| 3139 "no such file or directory", | |
| 3140 Fcar (file)); | |
| 428 | 3141 |
| 3142 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols, | |
| 3143 Qunbound); | |
| 3144 | |
| 4226 | 3145 if (EQ (file, Qt) && !UNBOUNDP (color_symbols)) |
| 428 | 3146 /* no conversion necessary */ |
| 3147 RETURN_UNGCPRO (inst); | |
| 3148 | |
| 3149 alist = tagged_vector_to_alist (inst); | |
| 3150 | |
| 4226 | 3151 if (!NILP (file) && !EQ (file, Qt)) |
| 428 | 3152 { |
| 3153 Lisp_Object data = pixmap_to_lisp_data (file, 0); | |
| 3154 alist = remassq_no_quit (Q_file, alist); | |
| 3155 /* there can't be a :data at this point. */ | |
| 3156 alist = Fcons (Fcons (Q_file, file), | |
| 3157 Fcons (Fcons (Q_data, data), alist)); | |
| 3158 } | |
| 3159 | |
| 3160 if (UNBOUNDP (color_symbols)) | |
| 3161 { | |
| 3162 color_symbols = evaluate_xpm_color_symbols (); | |
| 3163 alist = Fcons (Fcons (Q_color_symbols, color_symbols), | |
| 3164 alist); | |
| 3165 } | |
| 3166 | |
| 3167 { | |
| 3168 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist); | |
| 3169 free_alist (alist); | |
| 3170 RETURN_UNGCPRO (result); | |
| 3171 } | |
| 3172 } | |
| 3173 | |
| 3174 static int | |
| 3175 xpm_possible_dest_types (void) | |
| 3176 { | |
| 3177 return | |
| 3178 IMAGE_MONO_PIXMAP_MASK | | |
| 3179 IMAGE_COLOR_PIXMAP_MASK | | |
| 3180 IMAGE_POINTER_MASK; | |
| 3181 } | |
| 3182 | |
| 3183 #endif /* HAVE_XPM */ | |
| 3184 | |
| 3185 | |
| 3186 /**************************************************************************** | |
| 3187 * Image Specifier Object * | |
| 3188 ****************************************************************************/ | |
| 3189 | |
| 1204 | 3190 static const struct memory_description image_specifier_description[] = { |
| 3191 { XD_LISP_OBJECT, offsetof (struct image_specifier, attachee) }, | |
| 3192 { XD_LISP_OBJECT, offsetof (struct image_specifier, attachee_property) }, | |
| 3193 { XD_END } | |
| 3194 }; | |
| 3195 | |
| 3196 DEFINE_SPECIFIER_TYPE_WITH_DATA (image); | |
| 428 | 3197 |
| 3198 static void | |
| 3199 image_create (Lisp_Object obj) | |
| 3200 { | |
| 440 | 3201 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); |
| 428 | 3202 |
| 3203 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */ | |
| 3204 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil; | |
| 3205 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil; | |
| 3206 } | |
| 3207 | |
| 3208 static void | |
| 3209 image_mark (Lisp_Object obj) | |
| 3210 { | |
| 440 | 3211 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); |
| 428 | 3212 |
| 3213 mark_object (IMAGE_SPECIFIER_ATTACHEE (image)); | |
| 3214 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)); | |
| 3215 } | |
| 3216 | |
| 450 | 3217 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
|
3218 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
|
3219 Lisp_Object obj1, Lisp_Object obj2) |
| 450 | 3220 { |
| 3221 if (EQ (obj1, obj2)) | |
| 3222 return 1; | |
| 3223 | |
| 3224 else if (CONSP (obj1) && CONSP (obj2)) | |
| 3225 { | |
|
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
|
3226 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
|
3227 && instantiator_eq_equal (NULL, XCDR (obj1), XCDR (obj2)); |
| 450 | 3228 } |
| 3229 return 0; | |
| 3230 } | |
| 3231 | |
| 665 | 3232 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
|
3233 instantiator_eq_hash (const Hash_Table_Test *UNUSED (http), Lisp_Object obj) |
| 450 | 3234 { |
| 3235 if (CONSP (obj)) | |
| 3236 { | |
| 3237 /* no point in worrying about tail recursion, since we're not | |
| 3238 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
|
3239 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
|
3240 instantiator_eq_hash (NULL, XCDR (obj))); |
| 450 | 3241 } |
| 3242 return LISP_HASH (obj); | |
| 3243 } | |
| 3244 | |
| 3245 /* We need a special hash table for storing image instances. */ | |
| 3246 Lisp_Object | |
| 3247 make_image_instance_cache_hash_table (void) | |
| 3248 { | |
|
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
|
3249 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
|
3250 -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
|
3251 HASH_TABLE_KEY_CAR_VALUE_WEAK); |
| 450 | 3252 } |
| 3253 | |
| 428 | 3254 static Lisp_Object |
| 3255 image_instantiate_cache_result (Lisp_Object locative) | |
| 3256 { | |
| 442 | 3257 /* locative = (instance instantiator . subtable) |
| 3258 | |
| 3259 So we are using the instantiator as the key and the instance as | |
| 3260 the value. Since the hashtable is key-weak this means that the | |
| 3261 image instance will stay around as long as the instantiator stays | |
| 3262 around. The instantiator is stored in the `image' slot of the | |
| 3263 glyph, so as long as the glyph is marked the instantiator will be | |
| 3264 as well and hence the cached image instance also.*/ | |
| 428 | 3265 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative))); |
| 853 | 3266 free_cons (XCDR (locative)); |
| 3267 free_cons (locative); | |
| 428 | 3268 return Qnil; |
| 3269 } | |
| 3270 | |
| 3271 /* Given a specification for an image, return an instance of | |
| 3272 the image which matches the given instantiator and which can be | |
| 3273 displayed in the given domain. */ | |
| 3274 | |
| 3275 static Lisp_Object | |
| 2286 | 3276 image_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec), |
| 428 | 3277 Lisp_Object domain, Lisp_Object instantiator, |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
4252
diff
changeset
|
3278 Lisp_Object depth, int no_fallback) |
| 428 | 3279 { |
| 438 | 3280 Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); |
| 428 | 3281 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier); |
| 3282 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER); | |
| 3283 | |
| 3284 if (IMAGE_INSTANCEP (instantiator)) | |
| 3285 { | |
| 442 | 3286 /* make sure that the image instance's governing domain and type are |
| 428 | 3287 matching. */ |
| 442 | 3288 Lisp_Object governing_domain = XIMAGE_INSTANCE_DOMAIN (instantiator); |
| 3289 | |
| 3290 if ((DEVICEP (governing_domain) | |
| 3291 && EQ (governing_domain, DOMAIN_DEVICE (domain))) | |
| 3292 || (FRAMEP (governing_domain) | |
| 3293 && EQ (governing_domain, DOMAIN_FRAME (domain))) | |
| 3294 || (WINDOWP (governing_domain) | |
| 3295 && EQ (governing_domain, DOMAIN_WINDOW (domain)))) | |
| 428 | 3296 { |
| 3297 int mask = | |
| 3298 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator)); | |
| 3299 if (mask & dest_mask) | |
| 3300 return instantiator; | |
| 3301 else | |
| 563 | 3302 invalid_argument ("Type of image instance not allowed here", |
| 428 | 3303 instantiator); |
| 3304 } | |
| 3305 else | |
| 563 | 3306 invalid_argument_2 ("Wrong domain for image instance", |
| 442 | 3307 instantiator, domain); |
| 428 | 3308 } |
| 452 | 3309 /* How ugly !! An image instanciator that uses a kludgy syntax to snarf in |
| 3310 face properties. There's a design flaw here. -- didier */ | |
| 428 | 3311 else if (VECTORP (instantiator) |
| 450 | 3312 && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit)) |
| 428 | 3313 { |
| 3314 assert (XVECTOR_LENGTH (instantiator) == 3); | |
| 3315 return (FACE_PROPERTY_INSTANCE | |
| 3316 (Fget_face (XVECTOR_DATA (instantiator)[2]), | |
|
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
4252
diff
changeset
|
3317 Qbackground_pixmap, domain, no_fallback, depth)); |
| 428 | 3318 } |
| 3319 else | |
| 3320 { | |
| 442 | 3321 Lisp_Object instance = Qnil; |
| 3322 Lisp_Object subtable = Qnil; | |
| 450 | 3323 /* #### Should this be GCPRO'd? */ |
| 3324 Lisp_Object hash_key = Qnil; | |
| 428 | 3325 Lisp_Object pointer_fg = Qnil; |
| 3326 Lisp_Object pointer_bg = Qnil; | |
| 442 | 3327 Lisp_Object governing_domain = |
| 3328 get_image_instantiator_governing_domain (instantiator, domain); | |
| 3329 struct gcpro gcpro1; | |
| 3330 | |
| 3331 GCPRO1 (instance); | |
| 3332 | |
| 3333 /* We have to put subwindow, widget and text image instances in | |
| 3334 a per-window cache so that we can see the same glyph in | |
| 3335 different windows. We use governing_domain to determine the type | |
| 3336 of image_instance that will be created. */ | |
| 428 | 3337 |
| 3338 if (pointerp) | |
| 3339 { | |
| 3340 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain); | |
| 3341 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain); | |
| 452 | 3342 hash_key = list4 (glyph, INSTANTIATOR_TYPE (instantiator), |
| 450 | 3343 pointer_fg, pointer_bg); |
| 428 | 3344 } |
| 450 | 3345 else |
| 3346 /* We cannot simply key on the glyph since fallbacks could use | |
| 3347 the same glyph but have a totally different instantiator | |
| 3348 type. Thus we key on the glyph and the type (but not any | |
| 3349 other parts of the instantiator. */ | |
| 3350 hash_key = list2 (glyph, INSTANTIATOR_TYPE (instantiator)); | |
| 428 | 3351 |
| 442 | 3352 /* First look in the device cache. */ |
| 3353 if (DEVICEP (governing_domain)) | |
| 428 | 3354 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
3355 subtable = Fgethash (make_fixnum (dest_mask), |
| 442 | 3356 XDEVICE (governing_domain)-> |
| 3357 image_instance_cache, | |
| 3358 Qunbound); | |
| 3359 if (UNBOUNDP (subtable)) | |
| 3360 { | |
| 3361 /* For the image instance cache, we do comparisons with | |
| 3362 EQ rather than with EQUAL, as we do for color and | |
| 3363 font names. The reasons are: | |
| 3364 | |
| 3365 1) pixmap data can be very long, and thus the hashing | |
| 3366 and comparing will take awhile. | |
| 3367 | |
| 3368 2) It's not so likely that we'll run into things that | |
| 3369 are EQUAL but not EQ (that can happen a lot with | |
| 3370 faces, because their specifiers are copied around); | |
| 3371 but pixmaps tend not to be in faces. | |
| 3372 | |
| 3373 However, if the image-instance could be a pointer, we | |
| 3374 have to use EQUAL because we massaged the | |
| 3375 instantiator into a cons3 also containing the | |
| 3376 foreground and background of the pointer face. */ | |
| 450 | 3377 subtable = make_image_instance_cache_hash_table (); |
| 3378 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
3379 Fputhash (make_fixnum (dest_mask), subtable, |
| 442 | 3380 XDEVICE (governing_domain)->image_instance_cache); |
| 3381 instance = Qunbound; | |
| 3382 } | |
| 3383 else | |
| 3384 { | |
| 450 | 3385 instance = Fgethash (hash_key, subtable, Qunbound); |
| 442 | 3386 } |
| 3387 } | |
| 3388 else if (WINDOWP (governing_domain)) | |
| 3389 { | |
| 3390 /* Subwindows have a per-window cache and have to be treated | |
| 3391 differently. */ | |
| 3392 instance = | |
| 450 | 3393 Fgethash (hash_key, |
| 442 | 3394 XWINDOW (governing_domain)->subwindow_instance_cache, |
| 3395 Qunbound); | |
| 428 | 3396 } |
| 3397 else | |
| 2500 | 3398 ABORT (); /* We're not allowed anything else currently. */ |
| 442 | 3399 |
| 3400 /* If we don't have an instance at this point then create | |
| 4252 | 3401 one. */ |
| 428 | 3402 if (UNBOUNDP (instance)) |
| 3403 { | |
| 3404 Lisp_Object locative = | |
| 3405 noseeum_cons (Qnil, | |
| 450 | 3406 noseeum_cons (hash_key, |
| 442 | 3407 DEVICEP (governing_domain) ? subtable |
| 3408 : XWINDOW (governing_domain) | |
| 3409 ->subwindow_instance_cache)); | |
| 428 | 3410 int speccount = specpdl_depth (); |
| 440 | 3411 |
| 442 | 3412 /* Make sure we cache the failures, too. Use an |
| 3413 unwind-protect to catch such errors. If we fail, the | |
| 3414 unwind-protect records nil in the hash table. If we | |
| 3415 succeed, we change the car of the locative to the | |
| 3416 resulting instance, which gets recorded instead. */ | |
| 428 | 3417 record_unwind_protect (image_instantiate_cache_result, |
| 3418 locative); | |
| 442 | 3419 instance = |
| 3420 instantiate_image_instantiator (governing_domain, | |
| 3421 domain, instantiator, | |
| 3422 pointer_fg, pointer_bg, | |
| 3423 dest_mask, glyph); | |
| 3424 | |
| 3425 /* We need a per-frame cache for redisplay. */ | |
| 3426 cache_subwindow_instance_in_frame_maybe (instance); | |
| 440 | 3427 |
| 428 | 3428 Fsetcar (locative, instance); |
| 442 | 3429 #ifdef ERROR_CHECK_GLYPHS |
| 3430 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) | |
| 3431 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) | |
| 3432 assert (EQ (XIMAGE_INSTANCE_FRAME (instance), | |
| 3433 DOMAIN_FRAME (domain))); | |
| 3434 #endif | |
| 771 | 3435 unbind_to (speccount); |
| 442 | 3436 #ifdef ERROR_CHECK_GLYPHS |
| 428 | 3437 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) |
| 442 | 3438 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) |
| 450 | 3439 assert (EQ (Fgethash (hash_key, |
| 442 | 3440 XWINDOW (governing_domain) |
| 3441 ->subwindow_instance_cache, | |
| 3442 Qunbound), instance)); | |
| 3443 #endif | |
| 428 | 3444 } |
| 442 | 3445 else if (NILP (instance)) |
| 563 | 3446 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
|
3447 |
| 442 | 3448 /* We found an instance. However, because we are using the glyph |
| 4252 | 3449 as the hash key instead of the instantiator, the current |
| 3450 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
|
3451 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
|
3452 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
|
3453 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
|
3454 |
|
eb41da9b4469
More documentation about glyphs cache coherency problem.
Didier Verna <didier@xemacs.org>
parents:
5581
diff
changeset
|
3455 /* #### 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
|
3456 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
|
3457 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
|
3458 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
|
3459 (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
|
3460 doesn't work. |
|
eb41da9b4469
More documentation about glyphs cache coherency problem.
Didier Verna <didier@xemacs.org>
parents:
5581
diff
changeset
|
3461 |
|
eb41da9b4469
More documentation about glyphs cache coherency problem.
Didier Verna <didier@xemacs.org>
parents:
5581
diff
changeset
|
3462 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
|
3463 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
|
3464 intolerable flashing. |
|
eb41da9b4469
More documentation about glyphs cache coherency problem.
Didier Verna <didier@xemacs.org>
parents:
5581
diff
changeset
|
3465 |
|
eb41da9b4469
More documentation about glyphs cache coherency problem.
Didier Verna <didier@xemacs.org>
parents:
5581
diff
changeset
|
3466 -- dvl */ |
| 442 | 3467 else |
| 3468 { | |
| 3469 /* #### This function should be able to cope with *all* | |
| 3470 changes to the instantiator, but currently only copes | |
| 3471 with the most used properties. This means that it is | |
| 3472 possible to make changes that don't get reflected in the | |
| 3473 display. */ | |
| 3474 update_image_instance (instance, instantiator); | |
| 450 | 3475 free_list (hash_key); |
| 442 | 3476 } |
| 3477 | |
| 3478 #ifdef ERROR_CHECK_GLYPHS | |
| 3479 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) | |
| 3480 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) | |
| 3481 assert (EQ (XIMAGE_INSTANCE_FRAME (instance), | |
| 3482 DOMAIN_FRAME (domain))); | |
| 3483 #endif | |
| 3484 ERROR_CHECK_IMAGE_INSTANCE (instance); | |
| 3485 RETURN_UNGCPRO (instance); | |
| 428 | 3486 } |
| 3487 | |
| 2500 | 3488 ABORT (); |
| 428 | 3489 return Qnil; /* not reached */ |
| 3490 } | |
| 3491 | |
| 3492 /* Validate an image instantiator. */ | |
| 3493 | |
| 3494 static void | |
| 3495 image_validate (Lisp_Object instantiator) | |
| 3496 { | |
| 3497 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator)) | |
| 3498 return; | |
| 3499 else if (VECTORP (instantiator)) | |
| 3500 { | |
| 3501 Lisp_Object *elt = XVECTOR_DATA (instantiator); | |
| 3502 int instantiator_len = XVECTOR_LENGTH (instantiator); | |
| 3503 struct image_instantiator_methods *meths; | |
| 3504 Lisp_Object already_seen = Qnil; | |
| 3505 struct gcpro gcpro1; | |
| 3506 int i; | |
| 3507 | |
| 3508 if (instantiator_len < 1) | |
| 563 | 3509 sferror ("Vector length must be at least 1", |
| 428 | 3510 instantiator); |
| 3511 | |
| 3512 meths = decode_image_instantiator_format (elt[0], ERROR_ME); | |
| 3513 if (!(instantiator_len & 1)) | |
| 563 | 3514 sferror |
| 428 | 3515 ("Must have alternating keyword/value pairs", instantiator); |
| 3516 | |
| 3517 GCPRO1 (already_seen); | |
| 3518 | |
| 3519 for (i = 1; i < instantiator_len; i += 2) | |
| 3520 { | |
| 3521 Lisp_Object keyword = elt[i]; | |
| 3522 Lisp_Object value = elt[i+1]; | |
| 3523 int j; | |
| 3524 | |
| 3525 CHECK_SYMBOL (keyword); | |
| 3526 if (!SYMBOL_IS_KEYWORD (keyword)) | |
| 563 | 3527 invalid_argument ("Symbol must begin with a colon", keyword); |
| 428 | 3528 |
| 3529 for (j = 0; j < Dynarr_length (meths->keywords); j++) | |
| 3530 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword)) | |
| 3531 break; | |
| 3532 | |
| 3533 if (j == Dynarr_length (meths->keywords)) | |
| 563 | 3534 invalid_argument ("Unrecognized keyword", keyword); |
| 428 | 3535 |
| 3536 if (!Dynarr_at (meths->keywords, j).multiple_p) | |
| 3537 { | |
| 3538 if (!NILP (memq_no_quit (keyword, already_seen))) | |
| 563 | 3539 sferror |
| 428 | 3540 ("Keyword may not appear more than once", keyword); |
| 3541 already_seen = Fcons (keyword, already_seen); | |
| 3542 } | |
| 3543 | |
| 3544 (Dynarr_at (meths->keywords, j).validate) (value); | |
| 3545 } | |
| 3546 | |
| 3547 UNGCPRO; | |
| 3548 | |
| 3549 MAYBE_IIFORMAT_METH (meths, validate, (instantiator)); | |
| 3550 } | |
| 3551 else | |
| 563 | 3552 invalid_argument ("Must be string or vector", instantiator); |
| 428 | 3553 } |
| 3554 | |
| 3555 static void | |
| 3556 image_after_change (Lisp_Object specifier, Lisp_Object locale) | |
| 3557 { | |
| 3558 Lisp_Object attachee = | |
| 3559 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); | |
| 3560 Lisp_Object property = | |
| 3561 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier)); | |
| 3562 if (FACEP (attachee)) | |
| 448 | 3563 { |
| 3564 face_property_was_changed (attachee, property, locale); | |
| 3565 if (BUFFERP (locale)) | |
| 3566 XBUFFER (locale)->buffer_local_face_property = 1; | |
| 3567 } | |
| 428 | 3568 else if (GLYPHP (attachee)) |
| 3569 glyph_property_was_changed (attachee, property, locale); | |
| 3570 } | |
| 3571 | |
| 3572 void | |
| 3573 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph, | |
| 3574 Lisp_Object property) | |
| 3575 { | |
| 440 | 3576 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); |
| 428 | 3577 |
| 3578 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph; | |
| 3579 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property; | |
| 3580 } | |
| 3581 | |
| 3582 static Lisp_Object | |
| 2286 | 3583 image_going_to_add (Lisp_Object specifier, Lisp_Object UNUSED (locale), |
| 428 | 3584 Lisp_Object tag_set, Lisp_Object instantiator) |
| 3585 { | |
| 3586 Lisp_Object possible_console_types = Qnil; | |
| 3587 Lisp_Object rest; | |
| 3588 Lisp_Object retlist = Qnil; | |
| 3589 struct gcpro gcpro1, gcpro2; | |
| 3590 | |
| 3591 LIST_LOOP (rest, Vconsole_type_list) | |
| 3592 { | |
| 3593 Lisp_Object contype = XCAR (rest); | |
| 3594 if (!NILP (memq_no_quit (contype, tag_set))) | |
| 3595 possible_console_types = Fcons (contype, possible_console_types); | |
| 3596 } | |
| 3597 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
3598 if (XFIXNUM (Flength (possible_console_types)) > 1) |
| 428 | 3599 /* two conflicting console types specified */ |
| 3600 return Qnil; | |
| 3601 | |
| 3602 if (NILP (possible_console_types)) | |
| 3603 possible_console_types = Vconsole_type_list; | |
| 3604 | |
| 3605 GCPRO2 (retlist, possible_console_types); | |
| 3606 | |
| 3607 LIST_LOOP (rest, possible_console_types) | |
| 3608 { | |
| 3609 Lisp_Object contype = XCAR (rest); | |
| 3610 Lisp_Object newinst = call_with_suspended_errors | |
| 3611 ((lisp_fn_t) normalize_image_instantiator, | |
| 793 | 3612 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
|
3613 make_fixnum (XIMAGE_SPECIFIER_ALLOWED (specifier))); |
| 428 | 3614 |
| 3615 if (!NILP (newinst)) | |
| 3616 { | |
| 3617 Lisp_Object newtag; | |
| 3618 if (NILP (memq_no_quit (contype, tag_set))) | |
| 3619 newtag = Fcons (contype, tag_set); | |
| 3620 else | |
| 3621 newtag = tag_set; | |
| 3622 retlist = Fcons (Fcons (newtag, newinst), retlist); | |
| 3623 } | |
| 3624 } | |
| 3625 | |
| 3626 UNGCPRO; | |
| 3627 | |
| 3628 return retlist; | |
| 3629 } | |
| 3630 | |
| 434 | 3631 /* Copy an image instantiator. We can't use Fcopy_tree since widgets |
| 3632 may contain circular references which would send Fcopy_tree into | |
| 3633 infloop death. */ | |
| 3634 static Lisp_Object | |
| 3635 image_copy_vector_instantiator (Lisp_Object instantiator) | |
| 3636 { | |
| 3637 int i; | |
| 3638 struct image_instantiator_methods *meths; | |
| 3639 Lisp_Object *elt; | |
| 3640 int instantiator_len; | |
| 3641 | |
| 3642 CHECK_VECTOR (instantiator); | |
| 3643 | |
| 3644 instantiator = Fcopy_sequence (instantiator); | |
| 3645 elt = XVECTOR_DATA (instantiator); | |
| 3646 instantiator_len = XVECTOR_LENGTH (instantiator); | |
| 440 | 3647 |
| 434 | 3648 meths = decode_image_instantiator_format (elt[0], ERROR_ME); |
| 3649 | |
| 3650 for (i = 1; i < instantiator_len; i += 2) | |
| 3651 { | |
| 3652 int j; | |
| 3653 Lisp_Object keyword = elt[i]; | |
| 3654 Lisp_Object value = elt[i+1]; | |
| 3655 | |
| 3656 /* Find the keyword entry. */ | |
| 3657 for (j = 0; j < Dynarr_length (meths->keywords); j++) | |
| 3658 { | |
| 3659 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword)) | |
| 3660 break; | |
| 3661 } | |
| 3662 | |
| 3663 /* Only copy keyword values that should be copied. */ | |
| 3664 if (Dynarr_at (meths->keywords, j).copy_p | |
| 3665 && | |
| 3666 (CONSP (value) || VECTORP (value))) | |
| 3667 { | |
| 3668 elt [i+1] = Fcopy_tree (value, Qt); | |
| 3669 } | |
| 3670 } | |
| 3671 | |
| 3672 return instantiator; | |
| 3673 } | |
| 3674 | |
| 3675 static Lisp_Object | |
| 3676 image_copy_instantiator (Lisp_Object arg) | |
| 3677 { | |
| 3678 if (CONSP (arg)) | |
| 3679 { | |
| 3680 Lisp_Object rest; | |
| 3681 rest = arg = Fcopy_sequence (arg); | |
| 3682 while (CONSP (rest)) | |
| 3683 { | |
| 3684 Lisp_Object elt = XCAR (rest); | |
| 3685 if (CONSP (elt)) | |
| 3686 XCAR (rest) = Fcopy_tree (elt, Qt); | |
| 3687 else if (VECTORP (elt)) | |
| 3688 XCAR (rest) = image_copy_vector_instantiator (elt); | |
| 3689 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */ | |
| 3690 XCDR (rest) = Fcopy_tree (XCDR (rest), Qt); | |
| 3691 rest = XCDR (rest); | |
| 3692 } | |
| 3693 } | |
| 3694 else if (VECTORP (arg)) | |
| 3695 { | |
| 3696 arg = image_copy_vector_instantiator (arg); | |
| 3697 } | |
| 3698 return arg; | |
| 3699 } | |
| 3700 | |
| 428 | 3701 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /* |
| 3702 Return non-nil if OBJECT is an image specifier. | |
| 442 | 3703 See `make-image-specifier' for a description of image instantiators. |
| 428 | 3704 */ |
| 3705 (object)) | |
| 3706 { | |
| 3707 return IMAGE_SPECIFIERP (object) ? Qt : Qnil; | |
| 3708 } | |
| 3709 | |
| 3710 | |
| 3711 /**************************************************************************** | |
| 3712 * Glyph Object * | |
| 3713 ****************************************************************************/ | |
| 3714 | |
| 3715 static Lisp_Object | |
| 3716 mark_glyph (Lisp_Object obj) | |
| 3717 { | |
| 440 | 3718 Lisp_Glyph *glyph = XGLYPH (obj); |
| 428 | 3719 |
| 3720 mark_object (glyph->image); | |
| 3721 mark_object (glyph->contrib_p); | |
| 3722 mark_object (glyph->baseline); | |
| 3723 mark_object (glyph->face); | |
| 3724 | |
| 3725 return glyph->plist; | |
| 3726 } | |
| 3727 | |
| 3728 static void | |
| 2286 | 3729 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, |
| 3730 int UNUSED (escapeflag)) | |
| 428 | 3731 { |
| 440 | 3732 Lisp_Glyph *glyph = XGLYPH (obj); |
| 428 | 3733 |
| 3734 if (print_readably) | |
|
5142
f965e31a35f0
reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents:
5127
diff
changeset
|
3735 printing_unreadable_lisp_object (obj, 0); |
| 428 | 3736 |
| 800 | 3737 write_fmt_string_lisp (printcharfun, "#<glyph (%s", 1, Fglyph_type (obj)); |
| 3738 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
|
3739 write_fmt_string (printcharfun, "0x%x>", LISP_OBJECT_UID (obj)); |
| 428 | 3740 } |
| 3741 | |
| 3742 /* Glyphs are equal if all of their display attributes are equal. We | |
| 3743 don't compare names or doc-strings, because that would make equal | |
| 3744 be eq. | |
| 3745 | |
| 3746 This isn't concerned with "unspecified" attributes, that's what | |
| 3747 #'glyph-differs-from-default-p is for. */ | |
| 3748 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
|
3749 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
|
3750 int UNUSED (foldcase)) |
| 428 | 3751 { |
| 440 | 3752 Lisp_Glyph *g1 = XGLYPH (obj1); |
| 3753 Lisp_Glyph *g2 = XGLYPH (obj2); | |
| 428 | 3754 |
| 3755 depth++; | |
| 3756 | |
| 3757 return (internal_equal (g1->image, g2->image, depth) && | |
| 3758 internal_equal (g1->contrib_p, g2->contrib_p, depth) && | |
| 3759 internal_equal (g1->baseline, g2->baseline, depth) && | |
| 3760 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
|
3761 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1, 0)); |
| 428 | 3762 } |
| 3763 | |
| 665 | 3764 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
|
3765 glyph_hash (Lisp_Object obj, int depth, Boolint UNUSED (equalp)) |
| 428 | 3766 { |
| 3767 depth++; | |
| 3768 | |
| 3769 /* No need to hash all of the elements; that would take too long. | |
| 3770 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
|
3771 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
|
3772 internal_hash (XGLYPH (obj)->face, depth, 0)); |
| 428 | 3773 } |
| 3774 | |
| 3775 static Lisp_Object | |
| 3776 glyph_getprop (Lisp_Object obj, Lisp_Object prop) | |
| 3777 { | |
| 440 | 3778 Lisp_Glyph *g = XGLYPH (obj); |
| 428 | 3779 |
| 3780 if (EQ (prop, Qimage)) return g->image; | |
| 3781 if (EQ (prop, Qcontrib_p)) return g->contrib_p; | |
| 3782 if (EQ (prop, Qbaseline)) return g->baseline; | |
| 3783 if (EQ (prop, Qface)) return g->face; | |
| 3784 | |
| 3785 return external_plist_get (&g->plist, prop, 0, ERROR_ME); | |
| 3786 } | |
| 3787 | |
| 3788 static int | |
| 3789 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) | |
| 3790 { | |
| 3791 if (EQ (prop, Qimage) || | |
| 3792 EQ (prop, Qcontrib_p) || | |
| 3793 EQ (prop, Qbaseline)) | |
| 3794 return 0; | |
| 3795 | |
| 3796 if (EQ (prop, Qface)) | |
| 3797 { | |
| 3798 XGLYPH (obj)->face = Fget_face (value); | |
| 3799 return 1; | |
| 3800 } | |
| 3801 | |
| 3802 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME); | |
| 3803 return 1; | |
| 3804 } | |
| 3805 | |
| 3806 static int | |
| 3807 glyph_remprop (Lisp_Object obj, Lisp_Object prop) | |
| 3808 { | |
| 3809 if (EQ (prop, Qimage) || | |
| 3810 EQ (prop, Qcontrib_p) || | |
| 3811 EQ (prop, Qbaseline)) | |
| 3812 return -1; | |
| 3813 | |
| 3814 if (EQ (prop, Qface)) | |
| 3815 { | |
| 3816 XGLYPH (obj)->face = Qnil; | |
| 3817 return 1; | |
| 3818 } | |
| 3819 | |
| 3820 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME); | |
| 3821 } | |
| 3822 | |
| 3823 static Lisp_Object | |
| 3824 glyph_plist (Lisp_Object obj) | |
| 3825 { | |
| 440 | 3826 Lisp_Glyph *glyph = XGLYPH (obj); |
| 428 | 3827 Lisp_Object result = glyph->plist; |
| 3828 | |
| 3829 result = cons3 (Qface, glyph->face, result); | |
| 3830 result = cons3 (Qbaseline, glyph->baseline, result); | |
| 3831 result = cons3 (Qcontrib_p, glyph->contrib_p, result); | |
| 3832 result = cons3 (Qimage, glyph->image, result); | |
| 3833 | |
| 3834 return result; | |
| 3835 } | |
| 3836 | |
| 1204 | 3837 static const struct memory_description glyph_description[] = { |
| 440 | 3838 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) }, |
| 3839 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) }, | |
| 3840 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) }, | |
| 3841 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) }, | |
| 3842 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) }, | |
| 428 | 3843 { XD_END } |
| 3844 }; | |
| 3845 | |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3846 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
|
3847 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
|
3848 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
|
3849 glyph_description, |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
3850 Lisp_Glyph); |
| 428 | 3851 |
| 3852 Lisp_Object | |
| 3853 allocate_glyph (enum glyph_type type, | |
| 3854 void (*after_change) (Lisp_Object glyph, Lisp_Object property, | |
| 3855 Lisp_Object locale)) | |
| 3856 { | |
| 3857 /* This function can GC */ | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
3858 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
|
3859 Lisp_Glyph *g = XGLYPH (obj); |
| 428 | 3860 |
| 3861 g->type = type; | |
| 3862 g->image = Fmake_specifier (Qimage); /* This function can GC */ | |
| 3863 g->dirty = 0; | |
| 3864 switch (g->type) | |
| 3865 { | |
| 3866 case GLYPH_BUFFER: | |
| 3867 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
| 440 | 3868 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK |
| 3869 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK | |
| 442 | 3870 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK; |
| 428 | 3871 break; |
| 3872 case GLYPH_POINTER: | |
| 3873 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
| 3874 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK; | |
| 3875 break; | |
| 3876 case GLYPH_ICON: | |
| 3877 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
| 438 | 3878 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK |
| 3879 | IMAGE_COLOR_PIXMAP_MASK; | |
| 428 | 3880 break; |
| 3881 default: | |
| 2500 | 3882 ABORT (); |
| 428 | 3883 } |
| 3884 | |
| 3885 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */ | |
| 3886 /* We're getting enough reports of odd behavior in this area it seems */ | |
| 3887 /* best to GCPRO everything. */ | |
| 3888 { | |
| 3889 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector)); | |
| 3890 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt)); | |
| 3891 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil)); | |
| 3892 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 3893 | |
| 3894 GCPRO4 (obj, tem1, tem2, tem3); | |
| 3895 | |
| 3896 set_specifier_fallback (g->image, tem1); | |
| 3897 g->contrib_p = Fmake_specifier (Qboolean); | |
| 3898 set_specifier_fallback (g->contrib_p, tem2); | |
| 3899 /* #### should have a specifier for the following */ | |
| 3900 g->baseline = Fmake_specifier (Qgeneric); | |
| 3901 set_specifier_fallback (g->baseline, tem3); | |
| 3902 g->face = Qnil; | |
| 3903 g->plist = Qnil; | |
| 3904 g->after_change = after_change; | |
| 3905 | |
| 3906 set_image_attached_to (g->image, obj, Qimage); | |
| 3907 UNGCPRO; | |
| 3908 } | |
| 3909 | |
| 3910 return obj; | |
| 3911 } | |
| 3912 | |
| 3913 static enum glyph_type | |
| 578 | 3914 decode_glyph_type (Lisp_Object type, Error_Behavior errb) |
| 428 | 3915 { |
| 3916 if (NILP (type)) | |
| 3917 return GLYPH_BUFFER; | |
| 3918 | |
| 3919 if (ERRB_EQ (errb, ERROR_ME)) | |
| 3920 CHECK_SYMBOL (type); | |
| 3921 | |
| 3922 if (EQ (type, Qbuffer)) return GLYPH_BUFFER; | |
| 3923 if (EQ (type, Qpointer)) return GLYPH_POINTER; | |
| 3924 if (EQ (type, Qicon)) return GLYPH_ICON; | |
| 3925 | |
| 563 | 3926 maybe_invalid_constant ("Invalid glyph type", type, Qimage, errb); |
| 428 | 3927 |
| 3928 return GLYPH_UNKNOWN; | |
| 3929 } | |
| 3930 | |
| 3931 static int | |
| 3932 valid_glyph_type_p (Lisp_Object type) | |
| 3933 { | |
| 3934 return !NILP (memq_no_quit (type, Vglyph_type_list)); | |
| 3935 } | |
| 3936 | |
| 3937 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /* | |
| 3938 Given a GLYPH-TYPE, return non-nil if it is valid. | |
| 3939 Valid types are `buffer', `pointer', and `icon'. | |
| 3940 */ | |
| 3941 (glyph_type)) | |
| 3942 { | |
| 3943 return valid_glyph_type_p (glyph_type) ? Qt : Qnil; | |
| 3944 } | |
| 3945 | |
| 3946 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /* | |
| 3947 Return a list of valid glyph types. | |
| 3948 */ | |
| 3949 ()) | |
| 3950 { | |
| 3951 return Fcopy_sequence (Vglyph_type_list); | |
| 3952 } | |
| 3953 | |
| 3954 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /* | |
| 442 | 3955 Create and return a new uninitialized glyph of type TYPE. |
| 428 | 3956 |
| 3957 TYPE specifies the type of the glyph; this should be one of `buffer', | |
| 3958 `pointer', or `icon', and defaults to `buffer'. The type of the glyph | |
| 3959 specifies in which contexts the glyph can be used, and controls the | |
| 3960 allowable image types into which the glyph's image can be | |
| 3961 instantiated. | |
| 3962 | |
| 3963 `buffer' glyphs can be used as the begin-glyph or end-glyph of an | |
| 3964 extent, in the modeline, and in the toolbar. Their image can be | |
| 3965 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text', | |
| 3966 and `subwindow'. | |
| 3967 | |
| 3968 `pointer' glyphs can be used to specify the mouse pointer. Their | |
| 3969 image can be instantiated as `pointer'. | |
| 3970 | |
| 3971 `icon' glyphs can be used to specify the icon used when a frame is | |
| 3972 iconified. Their image can be instantiated as `mono-pixmap' and | |
| 3973 `color-pixmap'. | |
| 3974 */ | |
| 3975 (type)) | |
| 3976 { | |
| 3977 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME); | |
| 3978 return allocate_glyph (typeval, 0); | |
| 3979 } | |
| 3980 | |
| 3981 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /* | |
| 3982 Return non-nil if OBJECT is a glyph. | |
| 3983 | |
| 442 | 3984 A glyph is an object used for pixmaps, widgets and the like. It is used |
| 428 | 3985 in begin-glyphs and end-glyphs attached to extents, in marginal and textual |
| 3986 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar | |
| 442 | 3987 buttons, and the like. Much more detailed information can be found at |
| 3988 `make-glyph'. Its image is described using an image specifier -- | |
| 3989 see `make-image-specifier'. See also `make-image-instance' for further | |
| 3990 information. | |
| 428 | 3991 */ |
| 3992 (object)) | |
| 3993 { | |
| 3994 return GLYPHP (object) ? Qt : Qnil; | |
| 3995 } | |
| 3996 | |
| 3997 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /* | |
| 3998 Return the type of the given glyph. | |
| 2959 | 3999 The return value will be one of `buffer', `pointer', or `icon'. |
| 428 | 4000 */ |
| 4001 (glyph)) | |
| 4002 { | |
| 4003 CHECK_GLYPH (glyph); | |
| 4004 switch (XGLYPH_TYPE (glyph)) | |
| 4005 { | |
| 2500 | 4006 default: ABORT (); |
| 428 | 4007 case GLYPH_BUFFER: return Qbuffer; |
| 4008 case GLYPH_POINTER: return Qpointer; | |
| 4009 case GLYPH_ICON: return Qicon; | |
| 4010 } | |
| 4011 } | |
| 4012 | |
| 438 | 4013 Lisp_Object |
| 4014 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain, | |
| 578 | 4015 Error_Behavior errb, int no_quit) |
| 438 | 4016 { |
| 4017 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph)); | |
| 4018 | |
| 2959 | 4019 /* This can never return Qunbound. All glyphs have `nothing' as |
| 438 | 4020 a fallback. */ |
| 440 | 4021 Lisp_Object image_instance = specifier_instance (specifier, Qunbound, |
| 438 | 4022 domain, errb, no_quit, 0, |
| 4023 Qzero); | |
| 440 | 4024 assert (!UNBOUNDP (image_instance)); |
| 442 | 4025 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
| 438 | 4026 |
| 4027 return image_instance; | |
| 4028 } | |
| 4029 | |
| 4030 static Lisp_Object | |
| 4031 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window) | |
| 4032 { | |
| 4033 Lisp_Object instance = glyph_or_image; | |
| 4034 | |
| 4035 if (GLYPHP (glyph_or_image)) | |
| 793 | 4036 instance = glyph_image_instance (glyph_or_image, window, |
| 4037 ERROR_ME_DEBUG_WARN, 1); | |
| 438 | 4038 |
| 4039 return instance; | |
| 4040 } | |
| 4041 | |
| 1411 | 4042 inline static int |
| 4043 image_instance_needs_layout (Lisp_Object instance) | |
| 4044 { | |
| 4045 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (instance); | |
| 4046 | |
| 4047 if (IMAGE_INSTANCE_DIRTYP (ii) && IMAGE_INSTANCE_LAYOUT_CHANGED (ii)) | |
| 4048 { | |
| 4049 return 1; | |
| 4050 } | |
| 4051 else | |
| 4052 { | |
| 4053 Lisp_Object iif = IMAGE_INSTANCE_FRAME (ii); | |
| 4054 return FRAMEP (iif) && XFRAME (iif)->size_changed; | |
| 4055 } | |
| 4056 } | |
| 4057 | |
| 428 | 4058 /***************************************************************************** |
| 4059 glyph_width | |
| 4060 | |
| 438 | 4061 Return the width of the given GLYPH on the given WINDOW. |
| 4062 Calculations are done based on recursively querying the geometry of | |
| 4063 the associated image instances. | |
| 428 | 4064 ****************************************************************************/ |
| 4065 unsigned short | |
| 438 | 4066 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain) |
| 428 | 4067 { |
| 438 | 4068 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
| 4069 domain); | |
| 428 | 4070 if (!IMAGE_INSTANCEP (instance)) |
| 4071 return 0; | |
| 4072 | |
| 1411 | 4073 if (image_instance_needs_layout (instance)) |
| 438 | 4074 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
| 442 | 4075 IMAGE_UNSPECIFIED_GEOMETRY, |
| 4076 IMAGE_UNCHANGED_GEOMETRY, | |
| 4077 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 438 | 4078 |
| 4079 return XIMAGE_INSTANCE_WIDTH (instance); | |
| 428 | 4080 } |
| 4081 | |
| 4082 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /* | |
| 4083 Return the width of GLYPH on WINDOW. | |
| 4084 This may not be exact as it does not take into account all of the context | |
| 4085 that redisplay will. | |
| 4086 */ | |
| 4087 (glyph, window)) | |
| 4088 { | |
| 793 | 4089 window = wrap_window (decode_window (window)); |
| 428 | 4090 CHECK_GLYPH (glyph); |
| 4091 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4092 return make_fixnum (glyph_width (glyph, window)); |
| 428 | 4093 } |
| 4094 | |
| 4095 unsigned short | |
| 438 | 4096 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain) |
| 428 | 4097 { |
| 438 | 4098 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
| 4099 domain); | |
| 4100 if (!IMAGE_INSTANCEP (instance)) | |
| 4101 return 0; | |
| 4102 | |
| 1411 | 4103 if (image_instance_needs_layout (instance)) |
| 438 | 4104 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
| 442 | 4105 IMAGE_UNSPECIFIED_GEOMETRY, |
| 4106 IMAGE_UNCHANGED_GEOMETRY, | |
| 4107 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 438 | 4108 |
| 4109 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) | |
| 4110 return XIMAGE_INSTANCE_TEXT_ASCENT (instance); | |
| 4111 else | |
| 4112 return XIMAGE_INSTANCE_HEIGHT (instance); | |
| 428 | 4113 } |
| 4114 | |
| 4115 unsigned short | |
| 438 | 4116 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain) |
| 428 | 4117 { |
| 438 | 4118 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
| 4119 domain); | |
| 4120 if (!IMAGE_INSTANCEP (instance)) | |
| 4121 return 0; | |
| 4122 | |
| 1411 | 4123 if (image_instance_needs_layout (instance)) |
| 438 | 4124 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
| 442 | 4125 IMAGE_UNSPECIFIED_GEOMETRY, |
| 4126 IMAGE_UNCHANGED_GEOMETRY, | |
| 4127 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 438 | 4128 |
| 4129 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) | |
| 4130 return XIMAGE_INSTANCE_TEXT_DESCENT (instance); | |
| 4131 else | |
| 4132 return 0; | |
| 428 | 4133 } |
| 4134 | |
| 4135 /* strictly a convenience function. */ | |
| 4136 unsigned short | |
| 438 | 4137 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain) |
| 428 | 4138 { |
| 438 | 4139 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
| 4140 domain); | |
| 440 | 4141 |
| 438 | 4142 if (!IMAGE_INSTANCEP (instance)) |
| 4143 return 0; | |
| 4144 | |
| 1411 | 4145 if (image_instance_needs_layout (instance)) |
| 438 | 4146 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
| 442 | 4147 IMAGE_UNSPECIFIED_GEOMETRY, |
| 4148 IMAGE_UNCHANGED_GEOMETRY, | |
| 4149 IMAGE_UNCHANGED_GEOMETRY, domain); | |
| 438 | 4150 |
| 4151 return XIMAGE_INSTANCE_HEIGHT (instance); | |
| 428 | 4152 } |
| 4153 | |
| 4154 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /* | |
| 4155 Return the ascent value of GLYPH on WINDOW. | |
| 4156 This may not be exact as it does not take into account all of the context | |
| 4157 that redisplay will. | |
| 4158 */ | |
| 4159 (glyph, window)) | |
| 4160 { | |
| 793 | 4161 window = wrap_window (decode_window (window)); |
| 428 | 4162 CHECK_GLYPH (glyph); |
| 4163 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4164 return make_fixnum (glyph_ascent (glyph, window)); |
| 428 | 4165 } |
| 4166 | |
| 4167 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /* | |
| 4168 Return the descent value of GLYPH on WINDOW. | |
| 4169 This may not be exact as it does not take into account all of the context | |
| 4170 that redisplay will. | |
| 4171 */ | |
| 4172 (glyph, window)) | |
| 4173 { | |
| 793 | 4174 window = wrap_window (decode_window (window)); |
| 428 | 4175 CHECK_GLYPH (glyph); |
| 4176 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4177 return make_fixnum (glyph_descent (glyph, window)); |
| 428 | 4178 } |
| 4179 | |
| 4180 /* This is redundant but I bet a lot of people expect it to exist. */ | |
| 4181 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /* | |
| 4182 Return the height of GLYPH on WINDOW. | |
| 4183 This may not be exact as it does not take into account all of the context | |
| 4184 that redisplay will. | |
| 4185 */ | |
| 4186 (glyph, window)) | |
| 4187 { | |
| 793 | 4188 window = wrap_window (decode_window (window)); |
| 428 | 4189 CHECK_GLYPH (glyph); |
| 4190 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4191 return make_fixnum (glyph_height (glyph, window)); |
| 428 | 4192 } |
| 4193 | |
| 4194 static void | |
| 4195 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty) | |
| 4196 { | |
| 4197 Lisp_Object instance = glyph_or_image; | |
| 4198 | |
| 4199 if (!NILP (glyph_or_image)) | |
| 4200 { | |
| 4201 if (GLYPHP (glyph_or_image)) | |
| 4202 { | |
| 4203 instance = glyph_image_instance (glyph_or_image, window, | |
| 793 | 4204 ERROR_ME_DEBUG_WARN, 1); |
| 428 | 4205 XGLYPH_DIRTYP (glyph_or_image) = dirty; |
| 4206 } | |
| 4207 | |
| 442 | 4208 if (!IMAGE_INSTANCEP (instance)) |
| 4209 return; | |
| 4210 | |
| 428 | 4211 XIMAGE_INSTANCE_DIRTYP (instance) = dirty; |
| 4212 } | |
| 4213 } | |
| 4214 | |
| 442 | 4215 static void |
| 4216 set_image_instance_dirty_p (Lisp_Object instance, int dirty) | |
| 4217 { | |
| 4218 if (IMAGE_INSTANCEP (instance)) | |
| 4219 { | |
| 4220 XIMAGE_INSTANCE_DIRTYP (instance) = dirty; | |
| 4221 /* Now cascade up the hierarchy. */ | |
| 4222 set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance), | |
| 4223 dirty); | |
| 4224 } | |
| 4225 else if (GLYPHP (instance)) | |
| 4226 { | |
| 4227 XGLYPH_DIRTYP (instance) = dirty; | |
| 4228 } | |
| 4229 } | |
| 4230 | |
| 428 | 4231 /* #### do we need to cache this info to speed things up? */ |
| 4232 | |
| 4233 Lisp_Object | |
| 4234 glyph_baseline (Lisp_Object glyph, Lisp_Object domain) | |
| 4235 { | |
| 4236 if (!GLYPHP (glyph)) | |
| 4237 return Qnil; | |
| 4238 else | |
| 4239 { | |
| 4240 Lisp_Object retval = | |
| 4241 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)), | |
| 793 | 4242 /* #### look into error flag */ |
| 4243 Qunbound, domain, ERROR_ME_DEBUG_WARN, | |
| 428 | 4244 0, Qzero); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4245 if (!NILP (retval) && !FIXNUMP (retval)) |
| 428 | 4246 retval = Qnil; |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4247 else if (FIXNUMP (retval)) |
| 428 | 4248 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4249 if (XFIXNUM (retval) < 0) |
| 428 | 4250 retval = Qzero; |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4251 if (XFIXNUM (retval) > 100) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4252 retval = make_fixnum (100); |
| 428 | 4253 } |
| 4254 return retval; | |
| 4255 } | |
| 4256 } | |
| 4257 | |
| 4258 Lisp_Object | |
| 2286 | 4259 glyph_face (Lisp_Object glyph, Lisp_Object UNUSED (domain)) |
| 428 | 4260 { |
| 4261 /* #### Domain parameter not currently used but it will be */ | |
| 4262 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil; | |
| 4263 } | |
| 4264 | |
| 4265 int | |
| 4266 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain) | |
| 4267 { | |
| 4268 if (!GLYPHP (glyph)) | |
| 4269 return 0; | |
| 4270 else | |
| 4271 return !NILP (specifier_instance_no_quit | |
| 4272 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain, | |
| 793 | 4273 /* #### look into error flag */ |
| 4274 ERROR_ME_DEBUG_WARN, 0, Qzero)); | |
| 428 | 4275 } |
| 4276 | |
| 4277 static void | |
| 4278 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property, | |
| 4279 Lisp_Object locale) | |
| 4280 { | |
| 4281 if (XGLYPH (glyph)->after_change) | |
| 4282 (XGLYPH (glyph)->after_change) (glyph, property, locale); | |
| 4283 } | |
| 4284 | |
| 442 | 4285 void |
| 4286 glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height, | |
| 438 | 4287 enum image_instance_geometry disp, Lisp_Object domain) |
| 4288 { | |
| 4289 Lisp_Object instance = glyph_or_image; | |
| 4290 | |
| 4291 if (GLYPHP (glyph_or_image)) | |
| 793 | 4292 instance = glyph_image_instance (glyph_or_image, domain, |
| 4293 ERROR_ME_DEBUG_WARN, 1); | |
| 440 | 4294 |
| 438 | 4295 image_instance_query_geometry (instance, width, height, disp, domain); |
| 4296 } | |
| 4297 | |
| 442 | 4298 void |
| 4299 glyph_do_layout (Lisp_Object glyph_or_image, int width, int height, | |
| 4300 int xoffset, int yoffset, Lisp_Object domain) | |
| 438 | 4301 { |
| 4302 Lisp_Object instance = glyph_or_image; | |
| 4303 | |
| 4304 if (GLYPHP (glyph_or_image)) | |
| 793 | 4305 instance = glyph_image_instance (glyph_or_image, domain, |
| 4306 ERROR_ME_DEBUG_WARN, 1); | |
| 442 | 4307 |
| 4308 image_instance_layout (instance, width, height, xoffset, yoffset, domain); | |
| 4309 } | |
| 438 | 4310 |
| 428 | 4311 |
| 4312 /***************************************************************************** | |
| 4968 | 4313 * glyph cachel functions * |
| 428 | 4314 *****************************************************************************/ |
| 4315 | |
| 4968 | 4316 #define NUM_PRECACHED_GLYPHS 6 |
| 4317 #define LOOP_OVER_PRECACHED_GLYPHS \ | |
| 4318 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX) \ | |
| 4319 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX) \ | |
| 4320 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX) \ | |
| 4321 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX) \ | |
| 4322 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX) \ | |
| 4323 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX) | |
| 4324 | |
| 4325 | |
| 442 | 4326 /* #### All of this is 95% copied from face cachels. Consider |
| 4327 consolidating. | |
| 4328 | |
| 4329 Why do we need glyph_cachels? Simply because a glyph_cachel captures | |
| 4330 per-window information about a particular glyph. A glyph itself is | |
| 4331 not created in any particular context, so if we were to rely on a | |
| 4332 glyph to tell us about its dirtiness we would not be able to reset | |
| 4333 the dirty flag after redisplaying it as it may exist in other | |
| 4334 contexts. When we have redisplayed we need to know which glyphs to | |
| 4335 reset the dirty flags on - the glyph_cachels give us a nice list we | |
| 4336 can iterate through doing this. */ | |
| 428 | 4337 void |
| 4338 mark_glyph_cachels (glyph_cachel_dynarr *elements) | |
| 4339 { | |
| 4340 int elt; | |
| 4341 | |
| 4342 if (!elements) | |
| 4343 return; | |
| 4344 | |
| 4345 for (elt = 0; elt < Dynarr_length (elements); elt++) | |
| 4346 { | |
| 4347 struct glyph_cachel *cachel = Dynarr_atp (elements, elt); | |
| 4348 mark_object (cachel->glyph); | |
| 4349 } | |
| 4350 } | |
| 4351 | |
| 4352 static void | |
| 4353 update_glyph_cachel_data (struct window *w, Lisp_Object glyph, | |
| 4354 struct glyph_cachel *cachel) | |
| 4355 { | |
| 4356 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph) | |
| 440 | 4357 || XGLYPH_DIRTYP (cachel->glyph) |
| 4358 || XFRAME(WINDOW_FRAME(w))->faces_changed) | |
| 428 | 4359 { |
| 4360 Lisp_Object window, instance; | |
| 4361 | |
| 793 | 4362 window = wrap_window (w); |
| 428 | 4363 |
| 4364 cachel->glyph = glyph; | |
| 440 | 4365 /* Speed things up slightly by grabbing the glyph instantiation |
| 4366 and passing it to the size functions. */ | |
| 793 | 4367 instance = glyph_image_instance (glyph, window, ERROR_ME_DEBUG_WARN, 1); |
| 440 | 4368 |
| 442 | 4369 if (!IMAGE_INSTANCEP (instance)) |
| 4370 return; | |
| 4371 | |
| 440 | 4372 /* Mark text instance of the glyph dirty if faces have changed, |
| 4373 because its geometry might have changed. */ | |
| 4374 invalidate_glyph_geometry_maybe (instance, w); | |
| 4375 | |
| 4376 /* #### Do the following 2 lines buy us anything? --kkm */ | |
| 4377 XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance); | |
| 4378 cachel->dirty = XGLYPH_DIRTYP (glyph); | |
| 438 | 4379 cachel->width = glyph_width (instance, window); |
| 4380 cachel->ascent = glyph_ascent (instance, window); | |
| 4381 cachel->descent = glyph_descent (instance, window); | |
| 428 | 4382 } |
| 4383 | |
| 4384 cachel->updated = 1; | |
| 4385 } | |
| 4386 | |
| 4387 static void | |
| 4388 add_glyph_cachel (struct window *w, Lisp_Object glyph) | |
| 4389 { | |
| 4390 struct glyph_cachel new_cachel; | |
| 4391 | |
| 4392 xzero (new_cachel); | |
| 4393 new_cachel.glyph = Qnil; | |
| 4394 | |
| 4395 update_glyph_cachel_data (w, glyph, &new_cachel); | |
| 4396 Dynarr_add (w->glyph_cachels, new_cachel); | |
| 4397 } | |
| 4398 | |
| 4968 | 4399 #ifdef ERROR_CHECK_GLYPHS |
| 4400 | |
| 4401 /* The precached glyphs should always occur in slots 0 - 5, with each glyph in the | |
| 4402 slot reserved for it. Meanwhile any other glyphs should always occur in slots | |
| 4403 6 or greater. */ | |
| 4404 static void | |
| 4405 verify_glyph_index (Lisp_Object glyph, glyph_index idx) | |
| 4406 { | |
| 4407 if (0) | |
| 4408 ; | |
| 4409 #define FROB(glyph_obj, gindex) \ | |
| 4410 else if (EQ (glyph, glyph_obj)) \ | |
| 4411 assert (gindex == idx); | |
| 4412 LOOP_OVER_PRECACHED_GLYPHS | |
| 4413 else | |
| 4414 assert (idx >= NUM_PRECACHED_GLYPHS); | |
| 4415 #undef FROB | |
| 4416 } | |
| 4417 | |
| 4418 #endif /* ERROR_CHECK_GLYPHS */ | |
| 4419 | |
| 428 | 4420 glyph_index |
| 4421 get_glyph_cachel_index (struct window *w, Lisp_Object glyph) | |
| 4422 { | |
| 4423 int elt; | |
| 4424 | |
| 4425 if (noninteractive) | |
| 4426 return 0; | |
| 4427 | |
| 4428 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) | |
| 4429 { | |
| 4430 struct glyph_cachel *cachel = | |
| 4431 Dynarr_atp (w->glyph_cachels, elt); | |
| 4432 | |
| 4433 if (EQ (cachel->glyph, glyph) && !NILP (glyph)) | |
| 4434 { | |
| 4968 | 4435 #ifdef ERROR_CHECK_GLYPHS |
| 4436 verify_glyph_index (glyph, elt); | |
| 4437 #endif /* ERROR_CHECK_GLYPHS */ | |
| 428 | 4438 update_glyph_cachel_data (w, glyph, cachel); |
| 4439 return elt; | |
| 4440 } | |
| 4441 } | |
| 4442 | |
| 4443 /* If we didn't find the glyph, add it and then return its index. */ | |
| 4444 add_glyph_cachel (w, glyph); | |
| 4445 return elt; | |
| 4446 } | |
| 4447 | |
| 4448 void | |
| 4449 reset_glyph_cachels (struct window *w) | |
| 4450 { | |
| 4451 Dynarr_reset (w->glyph_cachels); | |
| 4968 | 4452 #define FROB(glyph_obj, gindex) \ |
| 4453 get_glyph_cachel_index (w, glyph_obj); | |
| 4454 LOOP_OVER_PRECACHED_GLYPHS | |
| 4455 #undef FROB | |
| 428 | 4456 } |
| 4457 | |
| 4458 void | |
| 4459 mark_glyph_cachels_as_not_updated (struct window *w) | |
| 4460 { | |
| 4461 int elt; | |
| 4462 | |
| 4968 | 4463 /* A previous bug resulted from the glyph cachels never getting reset |
| 4464 in the minibuffer window after creation, and another glyph added before | |
| 4465 we got a chance to add the six normal glyphs that should go first, and | |
| 4466 we got called with only one glyph present. */ | |
| 4467 assert (Dynarr_length (w->glyph_cachels) >= NUM_PRECACHED_GLYPHS); | |
| 428 | 4468 /* We need to have a dirty flag to tell if the glyph has changed. |
| 4469 We can check to see if each glyph variable is actually a | |
| 4470 completely different glyph, though. */ | |
| 4471 #define FROB(glyph_obj, gindex) \ | |
| 4472 update_glyph_cachel_data (w, glyph_obj, \ | |
| 4968 | 4473 Dynarr_atp (w->glyph_cachels, gindex)); |
| 4474 LOOP_OVER_PRECACHED_GLYPHS | |
| 428 | 4475 #undef FROB |
| 4476 | |
| 4477 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) | |
| 4478 { | |
| 4479 Dynarr_atp (w->glyph_cachels, elt)->updated = 0; | |
| 4480 } | |
| 4481 } | |
| 4482 | |
| 4483 /* Unset the dirty bit on all the glyph cachels that have it. */ | |
| 440 | 4484 void |
| 428 | 4485 mark_glyph_cachels_as_clean (struct window* w) |
| 4486 { | |
| 4487 int elt; | |
| 793 | 4488 Lisp_Object window = wrap_window (w); |
| 4489 | |
| 428 | 4490 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) |
| 4491 { | |
| 4492 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt); | |
| 4493 cachel->dirty = 0; | |
| 4494 set_glyph_dirty_p (cachel->glyph, window, 0); | |
| 4495 } | |
| 4496 } | |
| 4497 | |
| 4498 #ifdef MEMORY_USAGE_STATS | |
| 4499 | |
| 4500 int | |
| 4501 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
|
4502 struct usage_stats *ustats) |
| 428 | 4503 { |
| 4504 int total = 0; | |
| 4505 | |
| 4506 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
|
4507 total += Dynarr_memory_usage (glyph_cachels, ustats); |
| 428 | 4508 |
| 4509 return total; | |
| 4510 } | |
| 4511 | |
| 4512 #endif /* MEMORY_USAGE_STATS */ | |
| 4513 | |
| 4514 | |
| 4515 | |
| 4516 /***************************************************************************** | |
| 4968 | 4517 * subwindow cachel functions * |
| 428 | 4518 *****************************************************************************/ |
| 438 | 4519 /* Subwindows are curious in that you have to physically unmap them to |
| 428 | 4520 not display them. It is problematic deciding what to do in |
| 4521 redisplay. We have two caches - a per-window instance cache that | |
| 4522 keeps track of subwindows on a window, these are linked to their | |
| 4523 instantiator in the hashtable and when the instantiator goes away | |
| 4524 we want the instance to go away also. However we also have a | |
| 4525 per-frame instance cache that we use to determine if a subwindow is | |
| 4526 obscuring an area that we want to clear. We need to be able to flip | |
| 4527 through this quickly so a hashtable is not suitable hence the | |
| 442 | 4528 subwindow_cachels. This is a weak list so unreference instances |
| 4529 will get deleted properly. */ | |
| 428 | 4530 |
| 4531 /* redisplay in general assumes that drawing something will erase | |
| 4532 what was there before. unfortunately this does not apply to | |
| 4533 subwindows that need to be specifically unmapped in order to | |
| 4534 disappear. we take a brute force approach - on the basis that its | |
| 4535 cheap - and unmap all subwindows in a display line */ | |
| 442 | 4536 |
| 4537 /* Put new instances in the frame subwindow cache. This is less costly than | |
| 4538 doing it every time something gets mapped, and deleted instances will be | |
| 4539 removed automatically. */ | |
| 4540 static void | |
| 4541 cache_subwindow_instance_in_frame_maybe (Lisp_Object instance) | |
| 4542 { | |
| 4543 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (instance); | |
| 4544 if (!NILP (DOMAIN_FRAME (IMAGE_INSTANCE_DOMAIN (ii)))) | |
| 428 | 4545 { |
| 442 | 4546 struct frame* f = DOMAIN_XFRAME (IMAGE_INSTANCE_DOMAIN (ii)); |
| 4547 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) | |
| 4548 = Fcons (instance, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); | |
| 4549 } | |
| 4550 } | |
| 4551 | |
| 4552 /* Unmap and finalize all subwindow instances in the frame cache. This | |
| 4553 is necessary because GC will not guarantee the order things get | |
| 4554 deleted in and moreover, frame finalization deletes the window | |
| 4555 system windows before deleting XEmacs windows, and hence | |
| 4556 subwindows. */ | |
| 4557 int | |
| 2286 | 4558 unmap_subwindow_instance_cache_mapper (Lisp_Object UNUSED (key), |
| 4559 Lisp_Object value, void* finalize) | |
| 442 | 4560 { |
| 4561 /* value can be nil; we cache failures as well as successes */ | |
| 4562 if (!NILP (value)) | |
| 4563 { | |
| 4564 struct frame* f = XFRAME (XIMAGE_INSTANCE_FRAME (value)); | |
| 4565 unmap_subwindow (value); | |
| 4566 if (finalize) | |
| 428 | 4567 { |
| 442 | 4568 /* In case GC doesn't catch up fast enough, remove from the frame |
| 4569 cache also. Otherwise code that checks the sanity of the instance | |
| 4570 will fail. */ | |
| 4571 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) | |
| 4572 = delq_no_quit (value, | |
| 4573 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
|
4574 finalize_image_instance (value); |
| 428 | 4575 } |
| 4576 } | |
| 442 | 4577 return 0; |
| 4578 } | |
| 4579 | |
| 4580 static void | |
| 4581 finalize_all_subwindow_instances (struct window *w) | |
| 4582 { | |
| 4583 if (!NILP (w->next)) finalize_all_subwindow_instances (XWINDOW (w->next)); | |
| 4584 if (!NILP (w->vchild)) finalize_all_subwindow_instances (XWINDOW (w->vchild)); | |
| 4585 if (!NILP (w->hchild)) finalize_all_subwindow_instances (XWINDOW (w->hchild)); | |
| 4586 | |
| 4587 elisp_maphash (unmap_subwindow_instance_cache_mapper, | |
| 4588 w->subwindow_instance_cache, (void*)1); | |
| 428 | 4589 } |
| 4590 | |
| 4591 void | |
| 442 | 4592 free_frame_subwindow_instances (struct frame* f) |
| 4593 { | |
| 4594 /* Make sure all instances are finalized. We have to do this via the | |
| 4595 instance cache since some instances may be extant but not | |
| 4596 displayed (and hence not in the frame cache). */ | |
| 4597 finalize_all_subwindow_instances (XWINDOW (f->root_window)); | |
| 4598 } | |
| 4599 | |
| 4600 /* Unmap all instances in the frame cache. */ | |
| 4601 void | |
| 4602 reset_frame_subwindow_instance_cache (struct frame* f) | |
| 4603 { | |
| 4604 Lisp_Object rest; | |
| 4605 | |
| 4606 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) | |
| 4607 { | |
| 4608 Lisp_Object value = XCAR (rest); | |
| 4609 unmap_subwindow (value); | |
| 4610 } | |
| 4611 } | |
| 428 | 4612 |
| 4613 /***************************************************************************** | |
| 4968 | 4614 * subwindow exposure ignorance * |
| 428 | 4615 *****************************************************************************/ |
| 4616 /* when we unmap subwindows the associated window system will generate | |
| 4617 expose events. This we do not want as redisplay already copes with | |
| 4618 the repainting necessary. Worse, we can get in an endless cycle of | |
| 4619 redisplay if we are not careful. Thus we keep a per-frame list of | |
| 4620 expose events that are going to come and ignore them as | |
| 4621 required. */ | |
| 4622 | |
| 3092 | 4623 #ifndef NEW_GC |
| 428 | 4624 struct expose_ignore_blocktype |
| 4625 { | |
| 4626 Blocktype_declare (struct expose_ignore); | |
| 4627 } *the_expose_ignore_blocktype; | |
| 3092 | 4628 #endif /* not NEW_GC */ |
| 428 | 4629 |
| 4630 int | |
| 647 | 4631 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height) |
| 428 | 4632 { |
| 4633 struct expose_ignore *ei, *prev; | |
| 4634 /* the ignore list is FIFO so we should generally get a match with | |
| 4635 the first element in the list */ | |
| 4636 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next) | |
| 4637 { | |
| 4638 /* Checking for exact matches just isn't good enough as we | |
| 442 | 4639 might get exposures for partially obscured subwindows, thus |
| 4640 we have to check for overlaps. Being conservative, we will | |
| 4641 check for exposures wholly contained by the subwindow - this | |
| 428 | 4642 might give us what we want.*/ |
| 440 | 4643 if (ei->x <= x && ei->y <= y |
| 428 | 4644 && ei->x + ei->width >= x + width |
| 4645 && ei->y + ei->height >= y + height) | |
| 4646 { | |
| 4647 #ifdef DEBUG_WIDGETS | |
| 4648 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n", | |
| 4649 x, y, width, height, ei->x, ei->y, ei->width, ei->height); | |
| 4650 #endif | |
| 4651 if (!prev) | |
| 4652 f->subwindow_exposures = ei->next; | |
| 4653 else | |
| 4654 prev->next = ei->next; | |
| 440 | 4655 |
| 428 | 4656 if (ei == f->subwindow_exposures_tail) |
| 4657 f->subwindow_exposures_tail = prev; | |
| 4658 | |
| 4117 | 4659 #ifndef NEW_GC |
| 428 | 4660 Blocktype_free (the_expose_ignore_blocktype, ei); |
| 3092 | 4661 #endif /* not NEW_GC */ |
| 428 | 4662 return 1; |
| 4663 } | |
| 4664 prev = ei; | |
| 4665 } | |
| 4666 return 0; | |
| 4667 } | |
| 4668 | |
| 4669 static void | |
| 4670 register_ignored_expose (struct frame* f, int x, int y, int width, int height) | |
| 4671 { | |
| 4672 if (!hold_ignored_expose_registration) | |
| 4673 { | |
| 4674 struct expose_ignore *ei; | |
| 440 | 4675 |
| 3092 | 4676 #ifdef NEW_GC |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
4677 ei = XEXPOSE_IGNORE (ALLOC_NORMAL_LISP_OBJECT (expose_ignore)); |
| 3092 | 4678 #else /* not NEW_GC */ |
| 428 | 4679 ei = Blocktype_alloc (the_expose_ignore_blocktype); |
| 3092 | 4680 #endif /* not NEW_GC */ |
| 440 | 4681 |
| 428 | 4682 ei->next = NULL; |
| 4683 ei->x = x; | |
| 4684 ei->y = y; | |
| 4685 ei->width = width; | |
| 4686 ei->height = height; | |
| 440 | 4687 |
| 428 | 4688 /* we have to add the exposure to the end of the list, since we |
| 4689 want to check the oldest events first. for speed we keep a record | |
| 4690 of the end so that we can add right to it. */ | |
| 4691 if (f->subwindow_exposures_tail) | |
| 4692 { | |
| 4693 f->subwindow_exposures_tail->next = ei; | |
| 4694 } | |
| 4695 if (!f->subwindow_exposures) | |
| 4696 { | |
| 4697 f->subwindow_exposures = ei; | |
| 4698 } | |
| 4699 f->subwindow_exposures_tail = ei; | |
| 4700 } | |
| 4701 } | |
| 4702 | |
| 4703 /**************************************************************************** | |
| 4704 find_matching_subwindow | |
| 4705 | |
| 4706 See if there is a subwindow that completely encloses the requested | |
| 4707 area. | |
| 4708 ****************************************************************************/ | |
| 647 | 4709 int |
| 4710 find_matching_subwindow (struct frame* f, int x, int y, int width, int height) | |
| 428 | 4711 { |
| 442 | 4712 Lisp_Object rest; |
| 4713 | |
| 4714 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) | |
| 428 | 4715 { |
| 442 | 4716 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest)); |
| 4717 | |
| 4718 if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) | |
| 4719 && | |
| 4720 IMAGE_INSTANCE_DISPLAY_X (ii) <= x | |
| 428 | 4721 && |
| 442 | 4722 IMAGE_INSTANCE_DISPLAY_Y (ii) <= y |
| 440 | 4723 && |
| 442 | 4724 IMAGE_INSTANCE_DISPLAY_X (ii) |
| 4725 + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) >= x + width | |
| 428 | 4726 && |
| 442 | 4727 IMAGE_INSTANCE_DISPLAY_Y (ii) |
| 4728 + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) >= y + height) | |
| 428 | 4729 { |
| 4730 return 1; | |
| 4731 } | |
| 4732 } | |
| 4733 return 0; | |
| 4734 } | |
| 4735 | |
| 4736 | |
| 4737 /***************************************************************************** | |
| 4738 * subwindow functions * | |
| 4739 *****************************************************************************/ | |
| 4740 | |
| 442 | 4741 /* Update the displayed characteristics of a subwindow. This function |
| 4742 should generally only get called if the subwindow is actually | |
| 4743 dirty. */ | |
| 4744 void | |
| 4745 redisplay_subwindow (Lisp_Object subwindow) | |
| 428 | 4746 { |
| 440 | 4747 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); |
| 442 | 4748 int count = specpdl_depth (); |
| 4749 | |
| 4750 /* The update method is allowed to call eval. Since it is quite | |
| 4751 common for this function to get called from somewhere in | |
| 4752 redisplay we need to make sure that quits are ignored. Otherwise | |
| 4753 Fsignal will abort. */ | |
| 4754 specbind (Qinhibit_quit, Qt); | |
| 4755 | |
| 4756 ERROR_CHECK_IMAGE_INSTANCE (subwindow); | |
| 4757 | |
| 4758 if (WIDGET_IMAGE_INSTANCEP (subwindow)) | |
| 4759 { | |
| 4760 if (image_instance_changed (subwindow)) | |
| 4761 redisplay_widget (subwindow); | |
| 4762 /* Reset the changed flags. */ | |
| 4763 IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0; | |
| 4764 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0; | |
| 4765 IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii) = 0; | |
| 4766 IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0; | |
| 4767 } | |
| 4768 else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW | |
| 4769 && | |
| 4770 !NILP (IMAGE_INSTANCE_FRAME (ii))) | |
| 4771 { | |
| 4772 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), | |
| 4773 redisplay_subwindow, (ii)); | |
| 4774 } | |
| 4775 | |
| 4776 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0; | |
| 4777 /* This function is typically called by redisplay just before | |
| 4778 outputting the information to the screen. Thus we record a hash | |
| 4779 of the output to determine whether on-screen is the same as | |
| 4780 recorded structure. This approach has limitations in there is a | |
| 4781 good chance that hash values will be different for the same | |
| 4782 visual appearance. However, we would rather that then the other | |
| 4783 way round - it simply means that we will get more displays than | |
| 4784 we might need. We can get better hashing by making the depth | |
| 4785 negative - currently it will recurse down 7 levels.*/ | |
| 4786 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
|
4787 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
|
4788 0); |
| 442 | 4789 |
| 771 | 4790 unbind_to (count); |
| 442 | 4791 } |
| 4792 | |
| 4793 /* Determine whether an image_instance has changed structurally and | |
| 4794 hence needs redisplaying in some way. | |
| 4795 | |
| 4796 #### This should just look at the instantiator differences when we | |
| 4797 get rid of the stored items altogether. In fact we should probably | |
| 4798 store the new instantiator as well as the old - as we do with | |
| 4799 gui_items currently - and then pick-up the new on the next | |
| 4800 redisplay. This would obviate the need for any of this trickery | |
| 4801 with hashcodes. */ | |
| 4802 int | |
| 4803 image_instance_changed (Lisp_Object subwindow) | |
| 4804 { | |
| 4805 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); | |
| 4806 | |
|
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
|
4807 if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH, 0) != |
| 442 | 4808 IMAGE_INSTANCE_DISPLAY_HASH (ii)) |
| 4809 return 1; | |
| 4810 /* #### I think there is probably a bug here. This gets called for | |
| 4811 layouts - and yet the pending items are always nil for | |
| 4812 layouts. We are saved by layout optimization, but I'm undecided | |
| 4813 as to what the correct fix is. */ | |
| 4814 else if (WIDGET_IMAGE_INSTANCEP (subwindow) | |
| 853 | 4815 && (!internal_equal_trapping_problems |
| 4816 (Qglyph, "bad subwindow instantiator", | |
| 4817 /* in this case we really don't want to be | |
| 4818 interrupted by QUIT because we care about | |
| 4819 the return value; and we know that any loops | |
| 4820 will ultimately cause errors to be issued. | |
| 4821 We specify a retval of 1 in that case so that | |
| 4822 the glyph code doesn't try to keep reoutputting | |
| 4823 a bad subwindow. */ | |
| 4824 INHIBIT_QUIT, 0, 1, IMAGE_INSTANCE_WIDGET_ITEMS (ii), | |
| 4825 IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii), 0) | |
| 442 | 4826 || !NILP (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii)) |
| 4827 || IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii))) | |
| 4828 return 1; | |
| 4829 else | |
| 4830 return 0; | |
| 428 | 4831 } |
| 4832 | |
| 438 | 4833 /* Update all the subwindows on a frame. */ |
| 428 | 4834 void |
| 442 | 4835 update_widget_instances (Lisp_Object frame) |
| 4836 { | |
| 4837 struct frame* f; | |
| 4838 Lisp_Object rest; | |
| 4839 | |
| 4840 /* Its possible for the preceding callback to have deleted the | |
| 4841 frame, so cope with this. */ | |
| 4842 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame))) | |
| 4843 return; | |
| 4844 | |
| 4845 CHECK_FRAME (frame); | |
| 4846 f = XFRAME (frame); | |
| 4847 | |
| 4848 /* If we get called we know something has changed. */ | |
| 4849 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) | |
| 4850 { | |
| 4851 Lisp_Object widget = XCAR (rest); | |
| 4852 | |
| 4853 if (XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (widget) | |
| 4854 && | |
| 4855 image_instance_changed (widget)) | |
| 4856 { | |
| 4857 set_image_instance_dirty_p (widget, 1); | |
| 4858 MARK_FRAME_GLYPHS_CHANGED (f); | |
| 4859 } | |
| 4860 } | |
| 428 | 4861 } |
| 4862 | |
| 4863 /* remove a subwindow from its frame */ | |
| 793 | 4864 void |
| 4865 unmap_subwindow (Lisp_Object subwindow) | |
| 428 | 4866 { |
| 440 | 4867 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); |
| 428 | 4868 struct frame* f; |
| 4869 | |
| 442 | 4870 ERROR_CHECK_IMAGE_INSTANCE (subwindow); |
| 4871 | |
| 1204 | 4872 if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii)) |
| 4873 & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK)) | |
| 4874 || !IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii)) | |
| 428 | 4875 return; |
| 442 | 4876 |
| 428 | 4877 #ifdef DEBUG_WIDGETS |
| 442 | 4878 stderr_out ("unmapping subwindow %p\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); |
| 428 | 4879 #endif |
| 442 | 4880 f = XFRAME (IMAGE_INSTANCE_FRAME (ii)); |
| 428 | 4881 |
| 4882 /* make sure we don't get expose events */ | |
| 442 | 4883 register_ignored_expose (f, IMAGE_INSTANCE_DISPLAY_X (ii), |
| 4884 IMAGE_INSTANCE_DISPLAY_Y (ii), | |
| 4885 IMAGE_INSTANCE_DISPLAY_WIDTH (ii), | |
| 4252 | 4886 IMAGE_INSTANCE_DISPLAY_HEIGHT (ii)); |
| 428 | 4887 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; |
| 4888 | |
| 442 | 4889 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)), |
| 4890 unmap_subwindow, (ii)); | |
| 428 | 4891 } |
| 4892 | |
| 4893 /* show a subwindow in its frame */ | |
| 793 | 4894 void |
| 4895 map_subwindow (Lisp_Object subwindow, int x, int y, | |
| 4896 struct display_glyph_area *dga) | |
| 428 | 4897 { |
| 440 | 4898 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); |
| 428 | 4899 |
| 442 | 4900 ERROR_CHECK_IMAGE_INSTANCE (subwindow); |
| 4901 | |
| 1204 | 4902 if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii)) |
| 4903 & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK))) | |
| 428 | 4904 return; |
| 4905 | |
| 4906 #ifdef DEBUG_WIDGETS | |
| 442 | 4907 stderr_out ("mapping subwindow %p, %dx%d@%d+%d\n", |
| 428 | 4908 IMAGE_INSTANCE_SUBWINDOW_ID (ii), |
| 4909 dga->width, dga->height, x, y); | |
| 4910 #endif | |
| 2286 | 4911 /* Error check by side effect */ |
| 4912 (void) XFRAME (IMAGE_INSTANCE_FRAME (ii)); | |
| 442 | 4913 IMAGE_INSTANCE_DISPLAY_X (ii) = x; |
| 4914 IMAGE_INSTANCE_DISPLAY_Y (ii) = y; | |
| 4915 IMAGE_INSTANCE_DISPLAY_WIDTH (ii) = dga->width; | |
| 4916 IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) = dga->height; | |
| 4917 | |
| 4918 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), | |
| 4919 map_subwindow, (ii, x, y, dga)); | |
| 428 | 4920 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1; |
| 4921 } | |
| 4922 | |
| 4923 static int | |
| 4924 subwindow_possible_dest_types (void) | |
| 4925 { | |
| 4926 return IMAGE_SUBWINDOW_MASK; | |
| 4927 } | |
| 4928 | |
| 442 | 4929 int |
| 4930 subwindow_governing_domain (void) | |
| 4931 { | |
| 4932 return GOVERNING_DOMAIN_WINDOW; | |
| 4933 } | |
| 4934 | |
| 428 | 4935 /* Partially instantiate a subwindow. */ |
| 4936 void | |
| 4937 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
| 2286 | 4938 Lisp_Object UNUSED (pointer_fg), |
| 4939 Lisp_Object UNUSED (pointer_bg), | |
| 428 | 4940 int dest_mask, Lisp_Object domain) |
| 4941 { | |
| 440 | 4942 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); |
| 442 | 4943 Lisp_Object device = image_instance_device (image_instance); |
| 4944 Lisp_Object frame = DOMAIN_FRAME (domain); | |
| 428 | 4945 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width); |
| 4946 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height); | |
| 4947 | |
| 4948 if (NILP (frame)) | |
| 563 | 4949 invalid_state ("No selected frame", device); |
| 440 | 4950 |
| 428 | 4951 if (!(dest_mask & IMAGE_SUBWINDOW_MASK)) |
| 4952 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK); | |
| 4953 | |
| 4954 ii->data = 0; | |
| 4955 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0; | |
| 4956 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; | |
| 442 | 4957 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4958 if (FIXNUMP (width)) |
| 428 | 4959 { |
| 4960 int w = 1; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4961 if (XFIXNUM (width) > 1) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4962 w = XFIXNUM (width); |
| 442 | 4963 IMAGE_INSTANCE_WIDTH (ii) = w; |
| 4964 IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; | |
| 428 | 4965 } |
| 442 | 4966 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4967 if (FIXNUMP (height)) |
| 428 | 4968 { |
| 4969 int h = 1; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4970 if (XFIXNUM (height) > 1) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
4971 h = XFIXNUM (height); |
| 442 | 4972 IMAGE_INSTANCE_HEIGHT (ii) = h; |
| 4973 IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; | |
| 428 | 4974 } |
| 4975 } | |
| 4976 | |
| 442 | 4977 /* This is just a backup in case no-one has assigned a suitable geometry. |
| 4978 #### It should really query the enclose window for geometry. */ | |
| 4979 static void | |
| 2286 | 4980 subwindow_query_geometry (Lisp_Object UNUSED (image_instance), |
| 4981 int* width, int* height, | |
| 4982 enum image_instance_geometry UNUSED (disp), | |
| 4983 Lisp_Object UNUSED (domain)) | |
| 442 | 4984 { |
| 4985 if (width) *width = 20; | |
| 4986 if (height) *height = 20; | |
| 4987 } | |
| 4988 | |
| 428 | 4989 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /* |
| 4990 Return non-nil if OBJECT is a subwindow. | |
| 4991 */ | |
| 4992 (object)) | |
| 4993 { | |
| 4994 CHECK_IMAGE_INSTANCE (object); | |
| 4995 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil; | |
| 4996 } | |
| 4997 | |
| 4998 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /* | |
| 4999 Return the window id of SUBWINDOW as a number. | |
| 5000 */ | |
| 5001 (subwindow)) | |
| 5002 { | |
| 5003 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
5004 return make_fixnum ((EMACS_INT) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)); |
| 428 | 5005 } |
| 5006 | |
| 5007 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /* | |
| 5008 Resize SUBWINDOW to WIDTH x HEIGHT. | |
| 5009 If a value is nil that parameter is not changed. | |
| 5010 */ | |
| 5011 (subwindow, width, height)) | |
| 5012 { | |
| 5013 int neww, newh; | |
| 442 | 5014 Lisp_Image_Instance* ii; |
| 428 | 5015 |
| 5016 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); | |
| 442 | 5017 ii = XIMAGE_INSTANCE (subwindow); |
| 428 | 5018 |
| 5019 if (NILP (width)) | |
| 442 | 5020 neww = IMAGE_INSTANCE_WIDTH (ii); |
| 428 | 5021 else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
5022 neww = XFIXNUM (width); |
| 428 | 5023 |
| 5024 if (NILP (height)) | |
| 442 | 5025 newh = IMAGE_INSTANCE_HEIGHT (ii); |
| 428 | 5026 else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
5027 newh = XFIXNUM (height); |
| 428 | 5028 |
| 442 | 5029 /* The actual resizing gets done asynchronously by |
| 438 | 5030 update_subwindow. */ |
| 442 | 5031 IMAGE_INSTANCE_HEIGHT (ii) = newh; |
| 5032 IMAGE_INSTANCE_WIDTH (ii) = neww; | |
| 5033 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1; | |
| 428 | 5034 |
| 5035 return subwindow; | |
| 5036 } | |
| 5037 | |
| 5038 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /* | |
| 5039 Generate a Map event for SUBWINDOW. | |
| 5040 */ | |
| 5041 (subwindow)) | |
| 5042 { | |
| 5043 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); | |
| 5044 #if 0 | |
| 5045 map_subwindow (subwindow, 0, 0); | |
| 5046 #endif | |
| 5047 return subwindow; | |
| 5048 } | |
| 5049 | |
| 5050 | |
| 5051 /***************************************************************************** | |
| 5052 * display tables * | |
| 5053 *****************************************************************************/ | |
| 5054 | |
| 5055 /* Get the display tables for use currently on window W with face | |
| 5056 FACE. #### This will have to be redone. */ | |
| 5057 | |
| 5058 void | |
| 5059 get_display_tables (struct window *w, face_index findex, | |
| 5060 Lisp_Object *face_table, Lisp_Object *window_table) | |
| 5061 { | |
| 5062 Lisp_Object tem; | |
| 5063 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex); | |
| 5064 if (UNBOUNDP (tem)) | |
| 5065 tem = Qnil; | |
| 5066 if (!LISTP (tem)) | |
| 5067 tem = noseeum_cons (tem, Qnil); | |
| 5068 *face_table = tem; | |
| 5069 tem = w->display_table; | |
| 5070 if (UNBOUNDP (tem)) | |
| 5071 tem = Qnil; | |
| 5072 if (!LISTP (tem)) | |
| 5073 tem = noseeum_cons (tem, Qnil); | |
| 5074 *window_table = tem; | |
| 5075 } | |
| 5076 | |
| 5077 Lisp_Object | |
| 867 | 5078 display_table_entry (Ichar ch, Lisp_Object face_table, |
| 428 | 5079 Lisp_Object window_table) |
| 5080 { | |
| 5081 Lisp_Object tail; | |
| 5082 | |
| 5083 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */ | |
| 5084 for (tail = face_table; 1; tail = XCDR (tail)) | |
| 5085 { | |
| 5086 Lisp_Object table; | |
| 5087 if (NILP (tail)) | |
| 5088 { | |
| 5089 if (!NILP (window_table)) | |
| 5090 { | |
| 5091 tail = window_table; | |
| 5092 window_table = Qnil; | |
| 5093 } | |
| 5094 else | |
| 5095 return Qnil; | |
| 5096 } | |
| 5097 table = XCAR (tail); | |
| 5098 | |
| 5099 if (VECTORP (table)) | |
| 5100 { | |
| 5101 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch])) | |
| 5102 return XVECTOR_DATA (table)[ch]; | |
| 5103 else | |
| 5104 continue; | |
| 5105 } | |
| 5106 else if (CHAR_TABLEP (table) | |
| 5107 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR) | |
| 5108 { | |
| 826 | 5109 return get_char_table (ch, table); |
| 428 | 5110 } |
| 5111 else if (CHAR_TABLEP (table) | |
| 5112 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC) | |
| 5113 { | |
| 826 | 5114 Lisp_Object gotit = get_char_table (ch, table); |
| 428 | 5115 if (!NILP (gotit)) |
| 5116 return gotit; | |
| 5117 else | |
| 5118 continue; | |
| 5119 } | |
| 5120 else if (RANGE_TABLEP (table)) | |
| 5121 { | |
| 5122 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil); | |
| 5123 if (!NILP (gotit)) | |
| 5124 return gotit; | |
| 5125 else | |
| 5126 continue; | |
| 5127 } | |
| 5128 else | |
| 2500 | 5129 ABORT (); |
| 428 | 5130 } |
| 5131 } | |
| 5132 | |
| 793 | 5133 /**************************************************************************** |
| 5134 * timeouts for animated glyphs * | |
| 5135 ****************************************************************************/ | |
| 428 | 5136 static Lisp_Object Qglyph_animated_timeout_handler; |
| 5137 | |
| 5138 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /* | |
| 5139 Callback function for updating animated images. | |
| 5140 Don't use this. | |
| 5141 */ | |
| 5142 (arg)) | |
| 5143 { | |
| 5144 CHECK_WEAK_LIST (arg); | |
| 5145 | |
| 5146 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg)))) | |
| 5147 { | |
| 5148 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg)); | |
| 440 | 5149 |
| 428 | 5150 if (IMAGE_INSTANCEP (value)) |
| 5151 { | |
| 440 | 5152 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value); |
| 428 | 5153 |
| 5154 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value) | |
| 5155 && | |
| 5156 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1 | |
| 5157 && | |
| 5158 !disable_animated_pixmaps) | |
| 5159 { | |
| 5160 /* Increment the index of the image slice we are currently | |
| 5161 viewing. */ | |
| 4252 | 5162 IMAGE_INSTANCE_PIXMAP_SLICE (ii) = |
| 428 | 5163 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1) |
| 5164 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii); | |
| 5165 /* We might need to kick redisplay at this point - but we | |
| 5166 also might not. */ | |
| 440 | 5167 MARK_DEVICE_FRAMES_GLYPHS_CHANGED |
| 442 | 5168 (XDEVICE (image_instance_device (value))); |
| 5169 /* Cascade dirtiness so that we can have an animated glyph in a layout | |
| 5170 for instance. */ | |
| 5171 set_image_instance_dirty_p (value, 1); | |
| 428 | 5172 } |
| 5173 } | |
| 5174 } | |
| 5175 return Qnil; | |
| 5176 } | |
| 5177 | |
| 793 | 5178 Lisp_Object |
| 5179 add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image) | |
| 428 | 5180 { |
| 5181 Lisp_Object ret = Qnil; | |
| 5182 | |
| 5183 if (tickms > 0 && IMAGE_INSTANCEP (image)) | |
| 5184 { | |
| 5185 double ms = ((double)tickms) / 1000.0; | |
| 5186 struct gcpro gcpro1; | |
| 5187 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE); | |
| 5188 | |
| 5189 GCPRO1 (holder); | |
| 5190 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil); | |
| 5191 | |
| 5192 ret = Fadd_timeout (make_float (ms), | |
| 5193 Qglyph_animated_timeout_handler, | |
| 5194 holder, make_float (ms)); | |
| 5195 | |
| 5196 UNGCPRO; | |
| 5197 } | |
| 5198 return ret; | |
| 5199 } | |
| 5200 | |
| 793 | 5201 void |
| 5202 disable_glyph_animated_timeout (int i) | |
| 5203 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5438
diff
changeset
|
5204 Fdisable_timeout (make_fixnum (i)); |
| 428 | 5205 } |
| 5206 | |
| 5207 | |
| 5208 /***************************************************************************** | |
| 5209 * initialization * | |
| 5210 *****************************************************************************/ | |
| 5211 | |
| 5212 void | |
|
5157
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5213 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
|
5214 { |
|
1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
Ben Wing <ben@xemacs.org>
parents:
5146
diff
changeset
|
5215 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
|
5216 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
|
5217 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
|
5218 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
|
5219 } |
|
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 void |
| 428 | 5222 syms_of_glyphs (void) |
| 5223 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
5224 INIT_LISP_OBJECT (glyph); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
5225 INIT_LISP_OBJECT (image_instance); |
| 442 | 5226 |
| 428 | 5227 /* image instantiators */ |
| 5228 | |
| 5229 DEFSUBR (Fimage_instantiator_format_list); | |
| 5230 DEFSUBR (Fvalid_image_instantiator_format_p); | |
| 5231 DEFSUBR (Fset_console_type_image_conversion_list); | |
| 5232 DEFSUBR (Fconsole_type_image_conversion_list); | |
| 5233 | |
| 442 | 5234 DEFKEYWORD (Q_file); |
| 5235 DEFKEYWORD (Q_face); | |
| 5236 DEFKEYWORD (Q_pixel_height); | |
| 5237 DEFKEYWORD (Q_pixel_width); | |
| 428 | 5238 |
| 5239 #ifdef HAVE_XPM | |
| 442 | 5240 DEFKEYWORD (Q_color_symbols); |
| 428 | 5241 #endif |
| 5242 #ifdef HAVE_WINDOW_SYSTEM | |
| 442 | 5243 DEFKEYWORD (Q_mask_file); |
| 5244 DEFKEYWORD (Q_mask_data); | |
| 5245 DEFKEYWORD (Q_hotspot_x); | |
| 5246 DEFKEYWORD (Q_hotspot_y); | |
| 5247 DEFKEYWORD (Q_foreground); | |
| 5248 DEFKEYWORD (Q_background); | |
| 428 | 5249 #endif |
| 5250 /* image specifiers */ | |
| 5251 | |
| 5252 DEFSUBR (Fimage_specifier_p); | |
| 5253 /* Qimage in general.c */ | |
| 5254 | |
| 5255 /* image instances */ | |
| 5256 | |
| 563 | 5257 DEFSYMBOL_MULTIWORD_PREDICATE (Qimage_instancep); |
| 428 | 5258 |
| 442 | 5259 DEFSYMBOL (Qnothing_image_instance_p); |
| 5260 DEFSYMBOL (Qtext_image_instance_p); | |
| 5261 DEFSYMBOL (Qmono_pixmap_image_instance_p); | |
| 5262 DEFSYMBOL (Qcolor_pixmap_image_instance_p); | |
| 5263 DEFSYMBOL (Qpointer_image_instance_p); | |
| 5264 DEFSYMBOL (Qwidget_image_instance_p); | |
| 5265 DEFSYMBOL (Qsubwindow_image_instance_p); | |
| 428 | 5266 |
| 5267 DEFSUBR (Fmake_image_instance); | |
| 5268 DEFSUBR (Fimage_instance_p); | |
| 5269 DEFSUBR (Fimage_instance_type); | |
| 5270 DEFSUBR (Fvalid_image_instance_type_p); | |
| 5271 DEFSUBR (Fimage_instance_type_list); | |
| 5272 DEFSUBR (Fimage_instance_name); | |
| 442 | 5273 DEFSUBR (Fimage_instance_domain); |
| 872 | 5274 DEFSUBR (Fimage_instance_instantiator); |
| 428 | 5275 DEFSUBR (Fimage_instance_string); |
| 5276 DEFSUBR (Fimage_instance_file_name); | |
| 5277 DEFSUBR (Fimage_instance_mask_file_name); | |
| 5278 DEFSUBR (Fimage_instance_depth); | |
| 5279 DEFSUBR (Fimage_instance_height); | |
| 5280 DEFSUBR (Fimage_instance_width); | |
| 5281 DEFSUBR (Fimage_instance_hotspot_x); | |
| 5282 DEFSUBR (Fimage_instance_hotspot_y); | |
| 5283 DEFSUBR (Fimage_instance_foreground); | |
| 5284 DEFSUBR (Fimage_instance_background); | |
| 5285 DEFSUBR (Fimage_instance_property); | |
| 5286 DEFSUBR (Fcolorize_image_instance); | |
| 5287 /* subwindows */ | |
| 5288 DEFSUBR (Fsubwindowp); | |
| 5289 DEFSUBR (Fimage_instance_subwindow_id); | |
| 5290 DEFSUBR (Fresize_subwindow); | |
| 5291 DEFSUBR (Fforce_subwindow_map); | |
| 5292 | |
| 5293 /* Qnothing defined as part of the "nothing" image-instantiator | |
| 5294 type. */ | |
| 5295 /* Qtext defined in general.c */ | |
| 442 | 5296 DEFSYMBOL (Qmono_pixmap); |
| 5297 DEFSYMBOL (Qcolor_pixmap); | |
| 428 | 5298 /* Qpointer defined in general.c */ |
| 5299 | |
| 5300 /* glyphs */ | |
| 5301 | |
| 442 | 5302 DEFSYMBOL (Qglyphp); |
| 5303 DEFSYMBOL (Qcontrib_p); | |
| 5304 DEFSYMBOL (Qbaseline); | |
| 5305 | |
| 5306 DEFSYMBOL (Qbuffer_glyph_p); | |
| 5307 DEFSYMBOL (Qpointer_glyph_p); | |
| 5308 DEFSYMBOL (Qicon_glyph_p); | |
| 5309 | |
| 5310 DEFSYMBOL (Qconst_glyph_variable); | |
| 428 | 5311 |
| 5312 DEFSUBR (Fglyph_type); | |
| 5313 DEFSUBR (Fvalid_glyph_type_p); | |
| 5314 DEFSUBR (Fglyph_type_list); | |
| 5315 DEFSUBR (Fglyphp); | |
| 5316 DEFSUBR (Fmake_glyph_internal); | |
| 5317 DEFSUBR (Fglyph_width); | |
| 5318 DEFSUBR (Fglyph_ascent); | |
| 5319 DEFSUBR (Fglyph_descent); | |
| 5320 DEFSUBR (Fglyph_height); | |
| 442 | 5321 DEFSUBR (Fset_instantiator_property); |
| 428 | 5322 |
| 5323 /* Qbuffer defined in general.c. */ | |
| 5324 /* Qpointer defined above */ | |
| 5325 | |
| 1204 | 5326 /* Unfortunately, timeout handlers must be lisp functions. This is |
| 428 | 5327 for animated glyphs. */ |
| 442 | 5328 DEFSYMBOL (Qglyph_animated_timeout_handler); |
| 428 | 5329 DEFSUBR (Fglyph_animated_timeout_handler); |
| 5330 | |
| 5331 /* Errors */ | |
| 563 | 5332 DEFERROR_STANDARD (Qimage_conversion_error, Qconversion_error); |
| 428 | 5333 } |
| 5334 | |
| 5335 void | |
| 5336 specifier_type_create_image (void) | |
| 5337 { | |
| 5338 /* image specifiers */ | |
| 5339 | |
| 5340 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep"); | |
| 5341 | |
| 5342 SPECIFIER_HAS_METHOD (image, create); | |
| 5343 SPECIFIER_HAS_METHOD (image, mark); | |
| 5344 SPECIFIER_HAS_METHOD (image, instantiate); | |
| 5345 SPECIFIER_HAS_METHOD (image, validate); | |
| 5346 SPECIFIER_HAS_METHOD (image, after_change); | |
| 5347 SPECIFIER_HAS_METHOD (image, going_to_add); | |
| 434 | 5348 SPECIFIER_HAS_METHOD (image, copy_instantiator); |
| 428 | 5349 } |
| 5350 | |
| 5351 void | |
| 5352 reinit_specifier_type_create_image (void) | |
| 5353 { | |
| 5354 REINITIALIZE_SPECIFIER_TYPE (image); | |
| 5355 } | |
| 5356 | |
| 5357 | |
| 1204 | 5358 static const struct memory_description iike_description_1[] = { |
| 440 | 5359 { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) }, |
| 428 | 5360 { XD_END } |
| 5361 }; | |
| 5362 | |
| 1204 | 5363 static const struct sized_memory_description iike_description = { |
| 440 | 5364 sizeof (ii_keyword_entry), |
| 428 | 5365 iike_description_1 |
| 5366 }; | |
| 5367 | |
| 1204 | 5368 static const struct memory_description iiked_description_1[] = { |
| 440 | 5369 XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description), |
| 428 | 5370 { XD_END } |
| 5371 }; | |
| 5372 | |
| 1204 | 5373 static const struct sized_memory_description iiked_description = { |
| 440 | 5374 sizeof (ii_keyword_entry_dynarr), |
| 428 | 5375 iiked_description_1 |
| 5376 }; | |
| 5377 | |
| 1204 | 5378 static const struct memory_description iife_description_1[] = { |
| 440 | 5379 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) }, |
| 5380 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) }, | |
| 2551 | 5381 { XD_BLOCK_PTR, offsetof (image_instantiator_format_entry, meths), 1, |
| 5382 { &iim_description } }, | |
| 428 | 5383 { XD_END } |
| 5384 }; | |
| 5385 | |
| 1204 | 5386 static const struct sized_memory_description iife_description = { |
| 440 | 5387 sizeof (image_instantiator_format_entry), |
| 428 | 5388 iife_description_1 |
| 5389 }; | |
| 5390 | |
| 1204 | 5391 static const struct memory_description iifed_description_1[] = { |
| 440 | 5392 XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description), |
| 428 | 5393 { XD_END } |
| 5394 }; | |
| 5395 | |
| 1204 | 5396 static const struct sized_memory_description iifed_description = { |
| 440 | 5397 sizeof (image_instantiator_format_entry_dynarr), |
| 428 | 5398 iifed_description_1 |
| 5399 }; | |
| 5400 | |
| 1204 | 5401 static const struct memory_description iim_description_1[] = { |
| 440 | 5402 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) }, |
| 5403 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) }, | |
| 2551 | 5404 { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, keywords), 1, |
| 5405 { &iiked_description } }, | |
| 5406 { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, consoles), 1, | |
| 5407 { &cted_description } }, | |
| 428 | 5408 { XD_END } |
| 5409 }; | |
| 5410 | |
| 1204 | 5411 const struct sized_memory_description iim_description = { |
| 442 | 5412 sizeof (struct image_instantiator_methods), |
| 428 | 5413 iim_description_1 |
| 5414 }; | |
| 5415 | |
| 5416 void | |
| 5417 image_instantiator_format_create (void) | |
| 5418 { | |
| 5419 /* image instantiators */ | |
| 5420 | |
| 5421 the_image_instantiator_format_entry_dynarr = | |
| 5422 Dynarr_new (image_instantiator_format_entry); | |
| 5423 | |
| 5424 Vimage_instantiator_format_list = Qnil; | |
| 5425 staticpro (&Vimage_instantiator_format_list); | |
| 5426 | |
| 2367 | 5427 dump_add_root_block_ptr (&the_image_instantiator_format_entry_dynarr, &iifed_description); |
| 428 | 5428 |
| 5429 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing"); | |
| 5430 | |
| 5431 IIFORMAT_HAS_METHOD (nothing, possible_dest_types); | |
| 5432 IIFORMAT_HAS_METHOD (nothing, instantiate); | |
| 5433 | |
| 5434 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit"); | |
| 5435 | |
| 5436 IIFORMAT_HAS_METHOD (inherit, validate); | |
| 5437 IIFORMAT_HAS_METHOD (inherit, normalize); | |
| 5438 IIFORMAT_HAS_METHOD (inherit, possible_dest_types); | |
| 5439 IIFORMAT_HAS_METHOD (inherit, instantiate); | |
| 5440 | |
| 5441 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face); | |
| 5442 | |
| 5443 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string"); | |
| 5444 | |
| 5445 IIFORMAT_HAS_METHOD (string, validate); | |
| 442 | 5446 IIFORMAT_HAS_SHARED_METHOD (string, governing_domain, subwindow); |
| 428 | 5447 IIFORMAT_HAS_METHOD (string, possible_dest_types); |
| 5448 IIFORMAT_HAS_METHOD (string, instantiate); | |
| 5449 | |
| 5450 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string); | |
| 5451 /* Do this so we can set strings. */ | |
| 442 | 5452 /* #### Andy, what is this? This is a bogus format and should not be |
| 5453 visible to the user. */ | |
| 428 | 5454 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text"); |
| 442 | 5455 IIFORMAT_HAS_METHOD (text, update); |
| 438 | 5456 IIFORMAT_HAS_METHOD (text, query_geometry); |
| 428 | 5457 |
| 5458 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string"); | |
| 5459 | |
| 5460 IIFORMAT_HAS_METHOD (formatted_string, validate); | |
| 5461 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types); | |
| 5462 IIFORMAT_HAS_METHOD (formatted_string, instantiate); | |
| 5463 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string); | |
| 5464 | |
| 442 | 5465 /* Do this so pointers have geometry. */ |
| 5466 /* #### Andy, what is this? This is a bogus format and should not be | |
| 5467 visible to the user. */ | |
| 5468 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (pointer, "pointer"); | |
| 5469 IIFORMAT_HAS_SHARED_METHOD (pointer, query_geometry, subwindow); | |
| 5470 | |
| 428 | 5471 /* subwindows */ |
| 5472 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow"); | |
| 5473 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types); | |
| 442 | 5474 IIFORMAT_HAS_METHOD (subwindow, governing_domain); |
| 428 | 5475 IIFORMAT_HAS_METHOD (subwindow, instantiate); |
| 442 | 5476 IIFORMAT_HAS_METHOD (subwindow, query_geometry); |
| 428 | 5477 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int); |
| 5478 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int); | |
| 5479 | |
| 5480 #ifdef HAVE_WINDOW_SYSTEM | |
| 5481 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm"); | |
| 5482 | |
| 5483 IIFORMAT_HAS_METHOD (xbm, validate); | |
| 5484 IIFORMAT_HAS_METHOD (xbm, normalize); | |
| 5485 IIFORMAT_HAS_METHOD (xbm, possible_dest_types); | |
| 5486 | |
| 5487 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline); | |
| 5488 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string); | |
| 5489 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline); | |
| 5490 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string); | |
| 5491 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int); | |
| 5492 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int); | |
| 5493 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string); | |
| 5494 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string); | |
| 5495 #endif /* HAVE_WINDOW_SYSTEM */ | |
| 5496 | |
| 5497 #ifdef HAVE_XFACE | |
| 5498 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface"); | |
| 5499 | |
| 5500 IIFORMAT_HAS_METHOD (xface, validate); | |
| 5501 IIFORMAT_HAS_METHOD (xface, normalize); | |
| 5502 IIFORMAT_HAS_METHOD (xface, possible_dest_types); | |
| 5503 | |
| 5504 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string); | |
| 5505 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string); | |
| 2959 | 5506 IIFORMAT_VALID_KEYWORD (xface, Q_mask_data, check_valid_xbm_inline); |
| 5507 IIFORMAT_VALID_KEYWORD (xface, Q_mask_file, check_valid_string); | |
| 428 | 5508 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int); |
| 5509 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int); | |
| 5510 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string); | |
| 5511 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string); | |
| 5512 #endif | |
| 5513 | |
| 5514 #ifdef HAVE_XPM | |
| 5515 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm"); | |
| 5516 | |
| 5517 IIFORMAT_HAS_METHOD (xpm, validate); | |
| 5518 IIFORMAT_HAS_METHOD (xpm, normalize); | |
| 5519 IIFORMAT_HAS_METHOD (xpm, possible_dest_types); | |
| 5520 | |
| 5521 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string); | |
| 5522 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string); | |
| 5523 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols); | |
| 5524 #endif /* HAVE_XPM */ | |
| 5525 } | |
| 5526 | |
| 5527 void | |
| 5528 reinit_vars_of_glyphs (void) | |
| 5529 { | |
| 3092 | 5530 #ifndef NEW_GC |
| 428 | 5531 the_expose_ignore_blocktype = |
| 5532 Blocktype_new (struct expose_ignore_blocktype); | |
| 3092 | 5533 #endif /* not NEW_GC */ |
| 428 | 5534 |
| 5535 hold_ignored_expose_registration = 0; | |
| 5536 } | |
| 5537 | |
| 5538 | |
| 5539 void | |
| 5540 vars_of_glyphs (void) | |
| 5541 { | |
| 5542 Vthe_nothing_vector = vector1 (Qnothing); | |
| 5543 staticpro (&Vthe_nothing_vector); | |
| 5544 | |
| 5545 /* image instances */ | |
| 5546 | |
| 440 | 5547 Vimage_instance_type_list = Fcons (Qnothing, |
| 5548 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, | |
| 428 | 5549 Qpointer, Qsubwindow, Qwidget)); |
| 5550 staticpro (&Vimage_instance_type_list); | |
| 5551 | |
|
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
|
5552 /* 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
|
5553 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
|
5554 = 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
|
5555 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
|
5556 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
|
5557 |
| 428 | 5558 /* glyphs */ |
| 5559 | |
| 5560 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon); | |
| 5561 staticpro (&Vglyph_type_list); | |
| 5562 | |
| 5563 #ifdef HAVE_WINDOW_SYSTEM | |
| 5564 Fprovide (Qxbm); | |
| 5565 #endif | |
| 5566 #ifdef HAVE_XPM | |
| 5567 Fprovide (Qxpm); | |
| 5568 | |
| 5569 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /* | |
| 5570 Definitions of logical color-names used when reading XPM files. | |
| 5571 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE). | |
| 5572 The COLOR-NAME should be a string, which is the name of the color to define; | |
| 5573 the FORM should evaluate to a `color' specifier object, or a string to be | |
| 5574 passed to `make-color-instance'. If a loaded XPM file references a symbolic | |
| 5575 color called COLOR-NAME, it will display as the computed color instead. | |
| 5576 | |
| 5577 The default value of this variable defines the logical color names | |
| 5578 \"foreground\" and \"background\" to be the colors of the `default' face. | |
| 5579 */ ); | |
| 5580 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */ | |
| 5581 #endif /* HAVE_XPM */ | |
| 5582 #ifdef HAVE_XFACE | |
| 5583 Fprovide (Qxface); | |
| 5584 #endif | |
| 5585 | |
| 5586 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /* | |
| 5587 Whether animated pixmaps should be animated. | |
| 5588 Default is t. | |
| 5589 */); | |
| 5590 disable_animated_pixmaps = 0; | |
| 5591 } | |
| 5592 | |
| 5593 void | |
| 5594 specifier_vars_of_glyphs (void) | |
| 5595 { | |
| 5596 /* #### Can we GC here? The set_specifier_* calls definitely need */ | |
| 5597 /* protection. */ | |
| 5598 /* display tables */ | |
| 5599 | |
| 5600 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /* | |
| 5601 *The display table currently in use. | |
| 5602 This is a specifier; use `set-specifier' to change it. | |
| 442 | 5603 |
| 5604 Display tables are used to control how characters are displayed. Each | |
| 5605 time that redisplay processes a character, it is looked up in all the | |
| 5606 display tables that apply (obtained by calling `specifier-instance' on | |
| 5607 `current-display-table' and any overriding display tables specified in | |
| 5608 currently active faces). The first entry found that matches the | |
| 5609 character determines how the character is displayed. If there is no | |
| 5610 matching entry, the default display method is used. (Non-control | |
| 5611 characters are displayed as themselves and control characters are | |
| 5612 displayed according to the buffer-local variable `ctl-arrow'. Control | |
| 5613 characters are further affected by `control-arrow-glyph' and | |
| 5614 `octal-escape-glyph'.) | |
| 5615 | |
| 5616 Each instantiator in this specifier and the display-table specifiers | |
| 5617 in faces is a display table or a list of such tables. If a list, each | |
| 5618 table will be searched in turn for an entry matching a particular | |
| 5619 character. Each display table is one of | |
| 5620 | |
| 5621 -- a vector, specifying values for characters starting at 0 | |
| 5622 -- a char table, either of type `char' or `generic' | |
| 5623 -- a range table | |
| 5624 | |
| 5625 Each entry in a display table should be one of | |
| 5626 | |
| 5627 -- nil (this entry is ignored and the search continues) | |
| 5628 -- a character (use this character; if it happens to be the same as | |
| 5629 the original character, default processing happens, otherwise | |
| 5630 redisplay attempts to display this character directly; | |
| 5631 #### At some point recursive display-table lookup will be | |
| 5632 implemented.) | |
| 5633 -- a string (display each character in the string directly; | |
| 5634 #### At some point recursive display-table lookup will be | |
| 5635 implemented.) | |
| 5636 -- a glyph (display the glyph; | |
| 5637 #### At some point recursive display-table lookup will be | |
| 5638 implemented when a string glyph is being processed.) | |
| 5639 -- a cons of the form (format "STRING") where STRING is a printf-like | |
| 5640 spec used to process the character. #### Unfortunately no | |
| 5641 formatting directives other than %% are implemented. | |
| 5642 -- a vector (each element of the vector is processed recursively; | |
| 5643 in such a case, nil elements in the vector are simply ignored) | |
| 5644 | |
| 5645 #### At some point in the near future, display tables are likely to | |
| 5646 be expanded to include other features, such as referencing characters | |
| 5647 in particular fonts and allowing the character search to continue | |
| 5648 all the way up the chain of specifier instantiators. These features | |
| 5649 are necessary to properly display Unicode characters. | |
| 428 | 5650 */ ); |
| 5651 Vcurrent_display_table = Fmake_specifier (Qdisplay_table); | |
| 5652 set_specifier_fallback (Vcurrent_display_table, | |
| 5653 list1 (Fcons (Qnil, Qnil))); | |
| 5654 set_specifier_caching (Vcurrent_display_table, | |
| 438 | 5655 offsetof (struct window, display_table), |
| 428 | 5656 some_window_value_changed, |
| 444 | 5657 0, 0, 0); |
| 428 | 5658 } |
| 5659 | |
| 5660 void | |
| 5661 complex_vars_of_glyphs (void) | |
| 5662 { | |
| 5663 /* Partially initialized in glyphs-x.c, glyphs.el */ | |
| 5664 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /* | |
| 5665 What to display at the end of truncated lines. | |
| 5666 */ ); | |
| 5667 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
| 5668 | |
| 5669 /* Partially initialized in glyphs-x.c, glyphs.el */ | |
| 5670 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /* | |
| 5671 What to display at the end of wrapped lines. | |
| 5672 */ ); | |
| 5673 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
| 5674 | |
| 2367 | 5675 /* The octal-escape glyph, control-arrow-glyph and |
| 5676 invisible-text-glyph are completely initialized in glyphs.el */ | |
| 5677 | |
| 5678 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /* | |
| 5679 What to prefix character codes displayed in octal with. | |
| 5680 */); | |
| 5681 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
| 5682 | |
| 5683 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /* | |
| 5684 What to use as an arrow for control characters. | |
| 5685 */); | |
| 5686 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER, | |
| 5687 redisplay_glyph_changed); | |
| 5688 | |
| 5689 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /* | |
| 5690 What to use to indicate the presence of invisible text. | |
| 5691 This is the glyph that is displayed when an ellipsis is called for | |
| 5692 \(see `selective-display-ellipses' and `buffer-invisibility-spec'). | |
| 5693 Normally this is three dots ("..."). | |
| 5694 */); | |
| 5695 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER, | |
| 5696 redisplay_glyph_changed); | |
| 5697 | |
| 5698 /* Partially initialized in glyphs.el */ | |
| 5699 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /* | |
| 5700 What to display at the beginning of horizontally scrolled lines. | |
| 5701 */); | |
| 5702 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
| 5703 | |
| 428 | 5704 /* Partially initialized in glyphs-x.c, glyphs.el */ |
| 5705 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /* | |
| 5706 The glyph used to display the XEmacs logo at startup. | |
| 5707 */ ); | |
| 5708 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0); | |
| 5709 } |