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