Mercurial > hg > xemacs-beta
annotate src/glyphs.c @ 4981:4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_lo_import):
* postgresql/postgresql.c (Fpq_lo_export):
* ldap/eldap.c (Fldap_open):
* ldap/eldap.c (Fldap_search_basic):
* ldap/eldap.c (Fldap_add):
* ldap/eldap.c (Fldap_modify):
* ldap/eldap.c (Fldap_delete):
* canna/canna_api.c (Fcanna_initialize):
* canna/canna_api.c (Fcanna_store_yomi):
* canna/canna_api.c (Fcanna_parse):
* canna/canna_api.c (Fcanna_henkan_begin):
EXTERNAL_TO_C_STRING returns its argument instead of storing it
in a parameter, and is renamed to EXTERNAL_TO_ITEXT. Similar
things happen to related macros. See entry in src/ChangeLog.
More Mule-izing of postgresql.c. Extract out common code
between `pq-connectdb' and `pq-connect-start'. Fix places
that signal an error string using a formatted string to instead
follow the standard and have a fixed reason followed by the
particular error message stored as one of the frobs.
src/ChangeLog addition:
2010-02-05 Ben Wing <ben@xemacs.org>
* console-msw.c (write_string_to_mswindows_debugging_output):
* console-msw.c (Fmswindows_message_box):
* console-x.c (x_perhaps_init_unseen_key_defaults):
* console.c:
* database.c (dbm_get):
* database.c (dbm_put):
* database.c (dbm_remove):
* database.c (berkdb_get):
* database.c (berkdb_put):
* database.c (berkdb_remove):
* database.c (Fopen_database):
* device-gtk.c (gtk_init_device):
* device-msw.c (msprinter_init_device_internal):
* device-msw.c (msprinter_default_printer):
* device-msw.c (msprinter_init_device):
* device-msw.c (sync_printer_with_devmode):
* device-msw.c (Fmsprinter_select_settings):
* device-x.c (sanity_check_geometry_resource):
* device-x.c (Dynarr_add_validified_lisp_string):
* device-x.c (x_init_device):
* device-x.c (Fx_put_resource):
* device-x.c (Fx_valid_keysym_name_p):
* device-x.c (Fx_set_font_path):
* dialog-msw.c (push_lisp_string_as_unicode):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-x.c (dbox_descriptor_to_widget_value):
* editfns.c (Fformat_time_string):
* editfns.c (Fencode_time):
* editfns.c (Fset_time_zone_rule):
* emacs.c (make_argc_argv):
* emacs.c (Fdump_emacs):
* emodules.c (emodules_load):
* eval.c:
* eval.c (maybe_signal_error_1):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* fileio.c (report_error_with_errno):
* fileio.c (Fsysnetunam):
* fileio.c (Fdo_auto_save):
* font-mgr.c (extract_fcapi_string):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_filename):
* frame-gtk.c (gtk_set_frame_text_value):
* frame-gtk.c (gtk_create_widgets):
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_set_title_from_ibyte):
* frame-msw.c (msprinter_init_frame_3):
* frame-x.c (x_set_frame_text_value):
* frame-x.c (x_set_frame_properties):
* frame-x.c (start_drag_internal_1):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (x_create_widgets):
* glyphs-eimage.c (my_jpeg_output_message):
* glyphs-eimage.c (jpeg_instantiate):
* glyphs-eimage.c (gif_instantiate):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (xbm_instantiate_1):
* glyphs-gtk.c (gtk_xbm_instantiate):
* glyphs-gtk.c (gtk_xpm_instantiate):
* glyphs-gtk.c (gtk_xface_instantiate):
* glyphs-gtk.c (cursor_font_instantiate):
* glyphs-gtk.c (gtk_redisplay_widget):
* glyphs-gtk.c (gtk_widget_instantiate_1):
* glyphs-gtk.c (gtk_add_tab_item):
* glyphs-msw.c (mswindows_xpm_instantiate):
* glyphs-msw.c (bmp_instantiate):
* glyphs-msw.c (mswindows_resource_instantiate):
* glyphs-msw.c (xbm_instantiate_1):
* glyphs-msw.c (mswindows_xbm_instantiate):
* glyphs-msw.c (mswindows_xface_instantiate):
* glyphs-msw.c (mswindows_redisplay_widget):
* glyphs-msw.c (mswindows_widget_instantiate):
* glyphs-msw.c (add_tree_item):
* glyphs-msw.c (add_tab_item):
* glyphs-msw.c (mswindows_combo_box_instantiate):
* glyphs-msw.c (mswindows_widget_query_string_geometry):
* glyphs-x.c (x_locate_pixmap_file):
* glyphs-x.c (xbm_instantiate_1):
* glyphs-x.c (x_xbm_instantiate):
* glyphs-x.c (extract_xpm_color_names):
* glyphs-x.c (x_xpm_instantiate):
* glyphs-x.c (x_xface_instantiate):
* glyphs-x.c (autodetect_instantiate):
* glyphs-x.c (safe_XLoadFont):
* glyphs-x.c (cursor_font_instantiate):
* glyphs-x.c (x_redisplay_widget):
* glyphs-x.c (Fchange_subwindow_property):
* glyphs-x.c (x_widget_instantiate):
* glyphs-x.c (x_tab_control_redisplay):
* glyphs.c (pixmap_to_lisp_data):
* gui-x.c (menu_separator_style_and_to_external):
* gui-x.c (add_accel_and_to_external):
* gui-x.c (button_item_to_widget_value):
* hpplay.c (player_error_internal):
* hpplay.c (play_sound_file):
* hpplay.c (play_sound_data):
* intl.c (Fset_current_locale):
* lisp.h:
* menubar-gtk.c (gtk_xemacs_set_accel_keys):
* menubar-msw.c (populate_menu_add_item):
* menubar-msw.c (populate_or_checksum_helper):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* nt.c (init_user_info):
* nt.c (get_long_basename):
* nt.c (nt_get_resource):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_readdir):
* nt.c (read_unc_volume):
* nt.c (mswindows_stat):
* nt.c (mswindows_getdcwd):
* nt.c (mswindows_executable_type):
* nt.c (Fmswindows_short_file_name):
* ntplay.c (nt_play_sound_file):
* objects-gtk.c:
* objects-gtk.c (gtk_valid_color_name_p):
* objects-gtk.c (gtk_initialize_font_instance):
* objects-gtk.c (gtk_font_list):
* objects-msw.c (font_enum_callback_2):
* objects-msw.c (parse_font_spec):
* objects-x.c (x_parse_nearest_color):
* objects-x.c (x_valid_color_name_p):
* objects-x.c (x_initialize_font_instance):
* objects-x.c (x_font_instance_truename):
* objects-x.c (x_font_list):
* objects-xlike-inc.c (XFUN):
* objects-xlike-inc.c (xft_find_charset_font):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_create_process):
* process-nt.c (get_internet_address):
* process-nt.c (nt_open_network_stream):
* process-unix.c:
* process-unix.c (allocate_pty):
* process-unix.c (get_internet_address):
* process-unix.c (unix_canonicalize_host_name):
* process-unix.c (unix_open_network_stream):
* realpath.c:
* select-common.h (lisp_data_to_selection_data):
* select-gtk.c (symbol_to_gtk_atom):
* select-gtk.c (atom_to_symbol):
* select-msw.c (symbol_to_ms_cf):
* select-msw.c (mswindows_register_selection_data_type):
* select-x.c (symbol_to_x_atom):
* select-x.c (x_atom_to_symbol):
* select-x.c (hack_motif_clipboard_selection):
* select-x.c (Fx_store_cutbuffer_internal):
* sound.c (Fplay_sound_file):
* sound.c (Fplay_sound):
* sound.h (sound_perror):
* sysdep.c:
* sysdep.c (qxe_allocating_getcwd):
* sysdep.c (qxe_execve):
* sysdep.c (copy_in_passwd):
* sysdep.c (qxe_getpwnam):
* sysdep.c (qxe_ctime):
* sysdll.c (dll_open):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (search_linked_libs):
* sysdll.c (dll_error):
* sysfile.h:
* sysfile.h (PATHNAME_CONVERT_OUT_TSTR):
* sysfile.h (PATHNAME_CONVERT_OUT_UTF_8):
* sysfile.h (PATHNAME_CONVERT_OUT):
* sysfile.h (LISP_PATHNAME_CONVERT_OUT):
* syswindows.h (ITEXT_TO_TSTR):
* syswindows.h (LOCAL_FILE_FORMAT_TO_TSTR):
* syswindows.h (TSTR_TO_LOCAL_FILE_FORMAT):
* syswindows.h (LOCAL_FILE_FORMAT_TO_INTERNAL_MSWIN):
* syswindows.h (LISP_LOCAL_FILE_FORMAT_MAYBE_URL_TO_TSTR):
* text.h:
* text.h (eicpy_ext_len):
* text.h (enum new_dfc_src_type):
* text.h (EXTERNAL_TO_ITEXT):
* text.h (GET_STRERROR):
* tooltalk.c (check_status):
* tooltalk.c (Fadd_tooltalk_message_arg):
* tooltalk.c (Fadd_tooltalk_pattern_attribute):
* tooltalk.c (Fadd_tooltalk_pattern_arg):
* win32.c (tstr_to_local_file_format):
* win32.c (mswindows_lisp_error_1):
* win32.c (mswindows_report_process_error):
* win32.c (Fmswindows_shell_execute):
* win32.c (mswindows_read_link_1):
Changes involving external/internal format conversion,
mostly code cleanup and renaming.
1. Eliminate the previous macros like LISP_STRING_TO_EXTERNAL
that stored its result in a parameter. The new version of
LISP_STRING_TO_EXTERNAL returns its result through the
return value, same as the previous NEW_LISP_STRING_TO_EXTERNAL.
Use the new-style macros throughout the code.
2. Rename C_STRING_TO_EXTERNAL and friends to ITEXT_TO_EXTERNAL,
in keeping with overall naming rationalization involving
Itext and related types.
Macros involved in previous two:
EXTERNAL_TO_C_STRING -> EXTERNAL_TO_ITEXT
EXTERNAL_TO_C_STRING_MALLOC -> EXTERNAL_TO_ITEXT_MALLOC
SIZED_EXTERNAL_TO_C_STRING -> SIZED_EXTERNAL_TO_ITEXT
SIZED_EXTERNAL_TO_C_STRING_MALLOC -> SIZED_EXTERNAL_TO_ITEXT_MALLOC
C_STRING_TO_EXTERNAL -> ITEXT_TO_EXTERNAL
C_STRING_TO_EXTERNAL_MALLOC -> ITEXT_TO_EXTERNAL_MALLOC
LISP_STRING_TO_EXTERNAL
LISP_STRING_TO_EXTERNAL_MALLOC
LISP_STRING_TO_TSTR
C_STRING_TO_TSTR -> ITEXT_TO_TSTR
TSTR_TO_C_STRING -> TSTR_TO_ITEXT
The following four still return their values through parameters,
since they have more than one value to return:
C_STRING_TO_SIZED_EXTERNAL -> ITEXT_TO_SIZED_EXTERNAL
LISP_STRING_TO_SIZED_EXTERNAL
C_STRING_TO_SIZED_EXTERNAL_MALLOC -> ITEXT_TO_SIZED_EXTERNAL_MALLOC
LISP_STRING_TO_SIZED_EXTERNAL_MALLOC
Sometimes additional casts had to be inserted, since the old
macros played strange games and completely defeated the type system
of the store params.
3. Rewrite many places where direct calls to TO_EXTERNAL_FORMAT
occurred with calls to one of the convenience macros listed above,
or to make_extstring().
4. Eliminate SIZED_C_STRING macros (they were hardly used, anyway)
and use a direct call to TO_EXTERNAL_FORMAT or TO_INTERNAL_FORMAT.
4. Use LISP_PATHNAME_CONVERT_OUT in many places instead of something
like LISP_STRING_TO_EXTERNAL(..., Qfile_name).
5. Eliminate some temporary variables that are no longer necessary
now that we return a value rather than storing it into a variable.
6. Some Mule-izing in database.c.
7. Error functions:
-- A bit of code cleanup in maybe_signal_error_1.
-- Eliminate report_file_type_error; it's just an alias for
signal_error_2 with params in a different order.
-- Fix some places in the hostname-handling code that directly
inserted externally-retrieved error strings into the
supposed ASCII "reason" param instead of doing the right thing
and sticking text descriptive of what was going on in "reason"
and putting the external message in a frob.
8. Use Ascbyte instead of CIbyte in process-unix.c and maybe one
or two other places.
9. Some code cleanup in copy_in_passwd() in sysdep.c.
10. Fix a real bug due to accidental variable shadowing in
tstr_to_local_file_format() in win32.c.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Fri, 05 Feb 2010 11:02:24 -0600 |
parents | 4d35e52790f8 |
children | ae48681c47fa |
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 |
4226 | 7 Copyright (C) 2007 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; | |
826 | 663 window = VOID_TO_LISP (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, | |
679 LISP_TO_VOID (window)); | |
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) | |
4846 | 995 printing_unreadable_lcrecord (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)); |
800 | 1111 write_fmt_string (printcharfun, " 0x%x>", ii->header.uid); |
428 | 1112 } |
1113 | |
1114 static void | |
1115 finalize_image_instance (void *header, int for_disksave) | |
1116 { | |
440 | 1117 Lisp_Image_Instance *i = (Lisp_Image_Instance *) header; |
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 if (for_disksave) finalose (i); | |
1125 | |
442 | 1126 /* We can't use the domain here, because it might have |
1127 disappeared. */ | |
1128 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (i)), | |
1129 finalize_image_instance, (i)); | |
1130 | |
1131 /* Make sure we don't try this twice. */ | |
1132 IMAGE_INSTANCE_DEVICE (i) = Qnil; | |
428 | 1133 } |
1134 | |
1135 static int | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1136 image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1137 int UNUSED (foldcase)) |
428 | 1138 { |
440 | 1139 Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1); |
1140 Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2); | |
442 | 1141 |
1142 ERROR_CHECK_IMAGE_INSTANCE (obj1); | |
1143 ERROR_CHECK_IMAGE_INSTANCE (obj2); | |
1144 | |
1145 if (!EQ (IMAGE_INSTANCE_DOMAIN (i1), | |
1146 IMAGE_INSTANCE_DOMAIN (i2)) | |
1147 || IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2) | |
438 | 1148 || IMAGE_INSTANCE_WIDTH (i1) != IMAGE_INSTANCE_WIDTH (i2) |
442 | 1149 || IMAGE_INSTANCE_MARGIN_WIDTH (i1) != |
1150 IMAGE_INSTANCE_MARGIN_WIDTH (i2) | |
438 | 1151 || IMAGE_INSTANCE_HEIGHT (i1) != IMAGE_INSTANCE_HEIGHT (i2) |
1152 || IMAGE_INSTANCE_XOFFSET (i1) != IMAGE_INSTANCE_XOFFSET (i2) | |
1153 || IMAGE_INSTANCE_YOFFSET (i1) != IMAGE_INSTANCE_YOFFSET (i2)) | |
428 | 1154 return 0; |
1155 if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2), | |
1156 depth + 1)) | |
1157 return 0; | |
442 | 1158 if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (i1), |
1159 IMAGE_INSTANCE_INSTANTIATOR (i2), | |
1160 depth + 1)) | |
1161 return 0; | |
428 | 1162 |
1163 switch (IMAGE_INSTANCE_TYPE (i1)) | |
1164 { | |
1165 case IMAGE_NOTHING: | |
1166 break; | |
1167 | |
1168 case IMAGE_TEXT: | |
1169 if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1), | |
1170 IMAGE_INSTANCE_TEXT_STRING (i2), | |
1171 depth + 1)) | |
1172 return 0; | |
1173 break; | |
1174 | |
1175 case IMAGE_MONO_PIXMAP: | |
1176 case IMAGE_COLOR_PIXMAP: | |
1177 case IMAGE_POINTER: | |
438 | 1178 if (!(IMAGE_INSTANCE_PIXMAP_DEPTH (i1) == |
428 | 1179 IMAGE_INSTANCE_PIXMAP_DEPTH (i2) && |
1180 IMAGE_INSTANCE_PIXMAP_SLICE (i1) == | |
1181 IMAGE_INSTANCE_PIXMAP_SLICE (i2) && | |
1182 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1), | |
1183 IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) && | |
1184 EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1), | |
1185 IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) && | |
1186 internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1), | |
1187 IMAGE_INSTANCE_PIXMAP_FILENAME (i2), | |
1188 depth + 1) && | |
1189 internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1), | |
1190 IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2), | |
1191 depth + 1))) | |
1192 return 0; | |
1193 break; | |
1194 | |
1195 case IMAGE_WIDGET: | |
1196 if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1), | |
1197 IMAGE_INSTANCE_WIDGET_TYPE (i2)) | |
438 | 1198 && IMAGE_INSTANCE_SUBWINDOW_ID (i1) == |
1199 IMAGE_INSTANCE_SUBWINDOW_ID (i2) | |
442 | 1200 && |
1201 EQ (IMAGE_INSTANCE_WIDGET_FACE (i1), | |
1202 IMAGE_INSTANCE_WIDGET_TYPE (i2)) | |
428 | 1203 && internal_equal (IMAGE_INSTANCE_WIDGET_ITEMS (i1), |
1204 IMAGE_INSTANCE_WIDGET_ITEMS (i2), | |
1205 depth + 1) | |
442 | 1206 && internal_equal (IMAGE_INSTANCE_LAYOUT_CHILDREN (i1), |
1207 IMAGE_INSTANCE_LAYOUT_CHILDREN (i2), | |
1208 depth + 1) | |
428 | 1209 && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1), |
1210 IMAGE_INSTANCE_WIDGET_PROPS (i2), | |
1211 depth + 1) | |
442 | 1212 && internal_equal (IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i1), |
1213 IMAGE_INSTANCE_WIDGET_WIDTH_SUBR (i2), | |
1214 depth + 1) | |
1215 && internal_equal (IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i1), | |
1216 IMAGE_INSTANCE_WIDGET_HEIGHT_SUBR (i2), | |
1217 depth + 1) | |
428 | 1218 )) |
1219 return 0; | |
438 | 1220 break; |
440 | 1221 |
428 | 1222 case IMAGE_SUBWINDOW: |
438 | 1223 if (!(IMAGE_INSTANCE_SUBWINDOW_ID (i1) == |
428 | 1224 IMAGE_INSTANCE_SUBWINDOW_ID (i2))) |
1225 return 0; | |
1226 break; | |
1227 | |
1228 default: | |
2500 | 1229 ABORT (); |
428 | 1230 } |
1231 | |
442 | 1232 return DEVMETH_OR_GIVEN (DOMAIN_XDEVICE (i1->domain), |
1233 image_instance_equal, (i1, i2, depth), 1); | |
1234 } | |
1235 | |
1236 /* Image instance domain manipulators. We can't error check in these | |
1237 otherwise we get into infinite recursion. */ | |
1238 Lisp_Object | |
1239 image_instance_device (Lisp_Object instance) | |
1240 { | |
1241 return XIMAGE_INSTANCE_DEVICE (instance); | |
1242 } | |
1243 | |
1244 Lisp_Object | |
1245 image_instance_frame (Lisp_Object instance) | |
1246 { | |
1247 return XIMAGE_INSTANCE_FRAME (instance); | |
1248 } | |
1249 | |
1250 Lisp_Object | |
1251 image_instance_window (Lisp_Object instance) | |
1252 { | |
1253 return DOMAIN_WINDOW (XIMAGE_INSTANCE_DOMAIN (instance)); | |
1254 } | |
1255 | |
1256 int | |
1257 image_instance_live_p (Lisp_Object instance) | |
1258 { | |
1259 return DOMAIN_LIVE_P (XIMAGE_INSTANCE_DOMAIN (instance)); | |
428 | 1260 } |
1261 | |
665 | 1262 static Hashcode |
428 | 1263 image_instance_hash (Lisp_Object obj, int depth) |
1264 { | |
440 | 1265 Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); |
665 | 1266 Hashcode hash = HASH5 (LISP_HASH (IMAGE_INSTANCE_DOMAIN (i)), |
647 | 1267 IMAGE_INSTANCE_WIDTH (i), |
1268 IMAGE_INSTANCE_MARGIN_WIDTH (i), | |
1269 IMAGE_INSTANCE_HEIGHT (i), | |
1270 internal_hash (IMAGE_INSTANCE_INSTANTIATOR (i), | |
1271 depth + 1)); | |
442 | 1272 |
1273 ERROR_CHECK_IMAGE_INSTANCE (obj); | |
428 | 1274 |
1275 switch (IMAGE_INSTANCE_TYPE (i)) | |
1276 { | |
1277 case IMAGE_NOTHING: | |
1278 break; | |
1279 | |
1280 case IMAGE_TEXT: | |
1281 hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i), | |
1282 depth + 1)); | |
1283 break; | |
1284 | |
1285 case IMAGE_MONO_PIXMAP: | |
1286 case IMAGE_COLOR_PIXMAP: | |
1287 case IMAGE_POINTER: | |
438 | 1288 hash = HASH4 (hash, IMAGE_INSTANCE_PIXMAP_DEPTH (i), |
428 | 1289 IMAGE_INSTANCE_PIXMAP_SLICE (i), |
1290 internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i), | |
1291 depth + 1)); | |
1292 break; | |
1293 | |
1294 case IMAGE_WIDGET: | |
442 | 1295 /* We need the hash to be equivalent to what should be |
4252 | 1296 displayed. */ |
442 | 1297 hash = HASH5 (hash, |
1298 LISP_HASH (IMAGE_INSTANCE_WIDGET_TYPE (i)), | |
428 | 1299 internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1), |
442 | 1300 internal_hash (IMAGE_INSTANCE_WIDGET_ITEMS (i), depth + 1), |
1301 internal_hash (IMAGE_INSTANCE_LAYOUT_CHILDREN (i), | |
1302 depth + 1)); | |
438 | 1303 case IMAGE_SUBWINDOW: |
442 | 1304 hash = HASH2 (hash, (EMACS_INT) IMAGE_INSTANCE_SUBWINDOW_ID (i)); |
438 | 1305 break; |
1306 | |
428 | 1307 default: |
2500 | 1308 ABORT (); |
428 | 1309 } |
1310 | |
442 | 1311 return HASH2 (hash, DEVMETH_OR_GIVEN |
1312 (XDEVICE (image_instance_device (obj)), | |
1313 image_instance_hash, (i, depth), | |
1314 0)); | |
428 | 1315 } |
1316 | |
934 | 1317 DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance, |
1318 0, /*dumpable-flag*/ | |
1319 mark_image_instance, print_image_instance, | |
1320 finalize_image_instance, image_instance_equal, | |
1204 | 1321 image_instance_hash, |
1322 image_instance_description, | |
934 | 1323 Lisp_Image_Instance); |
428 | 1324 |
1325 static Lisp_Object | |
442 | 1326 allocate_image_instance (Lisp_Object governing_domain, Lisp_Object parent, |
1327 Lisp_Object instantiator) | |
428 | 1328 { |
440 | 1329 Lisp_Image_Instance *lp = |
3017 | 1330 ALLOC_LCRECORD_TYPE (Lisp_Image_Instance, &lrecord_image_instance); |
428 | 1331 Lisp_Object val; |
1332 | |
442 | 1333 /* It's not possible to simply keep a record of the domain in which |
1334 the instance was instantiated. This is because caching may mean | |
1335 that the domain becomes invalid but the instance remains | |
1336 valid. However, the only truly relevant domain is the domain in | |
1337 which the instance is cached since this is the one that will be | |
1338 common to the instances. */ | |
1339 lp->domain = governing_domain; | |
1340 /* The cache domain is not quite sufficient since the domain can get | |
1341 deleted before the image instance does. We need to know the | |
1342 domain device in order to finalize the image instance | |
1343 properly. We therefore record the device also. */ | |
1344 lp->device = DOMAIN_DEVICE (governing_domain); | |
428 | 1345 lp->type = IMAGE_NOTHING; |
1346 lp->name = Qnil; | |
442 | 1347 lp->width = IMAGE_UNSPECIFIED_GEOMETRY; |
1348 lp->height = IMAGE_UNSPECIFIED_GEOMETRY; | |
1349 lp->parent = parent; | |
1350 lp->instantiator = instantiator; | |
1351 /* So that layouts get done. */ | |
1352 lp->layout_changed = 1; | |
1353 | |
793 | 1354 val = wrap_image_instance (lp); |
442 | 1355 MARK_GLYPHS_CHANGED; |
1356 | |
428 | 1357 return val; |
1358 } | |
1359 | |
1360 static enum image_instance_type | |
578 | 1361 decode_image_instance_type (Lisp_Object type, Error_Behavior errb) |
428 | 1362 { |
1363 if (ERRB_EQ (errb, ERROR_ME)) | |
1364 CHECK_SYMBOL (type); | |
1365 | |
1366 if (EQ (type, Qnothing)) return IMAGE_NOTHING; | |
1367 if (EQ (type, Qtext)) return IMAGE_TEXT; | |
1368 if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP; | |
1369 if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP; | |
1370 if (EQ (type, Qpointer)) return IMAGE_POINTER; | |
1371 if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW; | |
1372 if (EQ (type, Qwidget)) return IMAGE_WIDGET; | |
1373 | |
563 | 1374 maybe_invalid_constant ("Invalid image-instance type", type, |
428 | 1375 Qimage, errb); |
1376 | |
1377 return IMAGE_UNKNOWN; /* not reached */ | |
1378 } | |
1379 | |
1380 static Lisp_Object | |
1381 encode_image_instance_type (enum image_instance_type type) | |
1382 { | |
1383 switch (type) | |
1384 { | |
1385 case IMAGE_NOTHING: return Qnothing; | |
1386 case IMAGE_TEXT: return Qtext; | |
1387 case IMAGE_MONO_PIXMAP: return Qmono_pixmap; | |
1388 case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap; | |
1389 case IMAGE_POINTER: return Qpointer; | |
1390 case IMAGE_SUBWINDOW: return Qsubwindow; | |
1391 case IMAGE_WIDGET: return Qwidget; | |
1392 default: | |
2500 | 1393 ABORT (); |
428 | 1394 } |
1395 | |
1396 return Qnil; /* not reached */ | |
1397 } | |
1398 | |
1399 static int | |
1400 decode_image_instance_type_list (Lisp_Object list) | |
1401 { | |
1402 int mask = 0; | |
1403 | |
1404 if (NILP (list)) | |
1405 return ~0; | |
1406 | |
1407 if (!CONSP (list)) | |
1408 { | |
1409 enum image_instance_type type = | |
1410 decode_image_instance_type (list, ERROR_ME); | |
1411 return image_instance_type_to_mask (type); | |
1412 } | |
1413 | |
2367 | 1414 { |
1415 EXTERNAL_LIST_LOOP_2 (elt, list) | |
1416 { | |
1417 enum image_instance_type type = | |
1418 decode_image_instance_type (elt, ERROR_ME); | |
1419 mask |= image_instance_type_to_mask (type); | |
1420 } | |
1421 } | |
428 | 1422 |
1423 return mask; | |
1424 } | |
1425 | |
1426 static Lisp_Object | |
1427 encode_image_instance_type_list (int mask) | |
1428 { | |
1429 int count = 0; | |
1430 Lisp_Object result = Qnil; | |
1431 | |
1432 while (mask) | |
1433 { | |
1434 count++; | |
1435 if (mask & 1) | |
1436 result = Fcons (encode_image_instance_type | |
1437 ((enum image_instance_type) count), result); | |
1438 mask >>= 1; | |
1439 } | |
1440 | |
1441 return Fnreverse (result); | |
1442 } | |
1443 | |
1444 DOESNT_RETURN | |
1445 incompatible_image_types (Lisp_Object instantiator, int given_dest_mask, | |
1446 int desired_dest_mask) | |
1447 { | |
563 | 1448 signal_error_1 |
1449 (Qinvalid_argument, | |
428 | 1450 list2 |
771 | 1451 (emacs_sprintf_string_lisp |
1452 ("No compatible image-instance types given: wanted one of %s, got %s", | |
1453 Qnil, 2, encode_image_instance_type_list (desired_dest_mask), | |
428 | 1454 encode_image_instance_type_list (given_dest_mask)), |
1455 instantiator)); | |
1456 } | |
1457 | |
1458 static int | |
1459 valid_image_instance_type_p (Lisp_Object type) | |
1460 { | |
1461 return !NILP (memq_no_quit (type, Vimage_instance_type_list)); | |
1462 } | |
1463 | |
1464 DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /* | |
1465 Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid. | |
2959 | 1466 Valid types are some subset of `nothing', `text', `mono-pixmap', |
1467 `color-pixmap', `pointer', `subwindow', and `widget', depending on how | |
1468 XEmacs was compiled. | |
428 | 1469 */ |
1470 (image_instance_type)) | |
1471 { | |
1472 return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil; | |
1473 } | |
1474 | |
1475 DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /* | |
1476 Return a list of valid image-instance types. | |
1477 */ | |
1478 ()) | |
1479 { | |
1480 return Fcopy_sequence (Vimage_instance_type_list); | |
1481 } | |
1482 | |
578 | 1483 Error_Behavior |
444 | 1484 decode_error_behavior_flag (Lisp_Object noerror) |
1485 { | |
1486 if (NILP (noerror)) return ERROR_ME; | |
1487 else if (EQ (noerror, Qt)) return ERROR_ME_NOT; | |
793 | 1488 else if (EQ (noerror, Qdebug)) return ERROR_ME_DEBUG_WARN; |
444 | 1489 else return ERROR_ME_WARN; |
428 | 1490 } |
1491 | |
1492 Lisp_Object | |
578 | 1493 encode_error_behavior_flag (Error_Behavior errb) |
428 | 1494 { |
1495 if (ERRB_EQ (errb, ERROR_ME)) | |
1496 return Qnil; | |
1497 else if (ERRB_EQ (errb, ERROR_ME_NOT)) | |
1498 return Qt; | |
793 | 1499 else if (ERRB_EQ (errb, ERROR_ME_DEBUG_WARN)) |
1500 return Qdebug; | |
428 | 1501 else |
1502 { | |
1503 assert (ERRB_EQ (errb, ERROR_ME_WARN)); | |
1504 return Qwarning; | |
1505 } | |
1506 } | |
1507 | |
442 | 1508 /* Recurse up the hierarchy looking for the topmost glyph. This means |
1509 that instances in layouts will inherit face properties from their | |
1510 parent. */ | |
1511 Lisp_Object image_instance_parent_glyph (Lisp_Image_Instance* ii) | |
1512 { | |
1513 if (IMAGE_INSTANCEP (IMAGE_INSTANCE_PARENT (ii))) | |
1514 { | |
1515 return image_instance_parent_glyph | |
1516 (XIMAGE_INSTANCE (IMAGE_INSTANCE_PARENT (ii))); | |
1517 } | |
1518 return IMAGE_INSTANCE_PARENT (ii); | |
1519 } | |
1520 | |
428 | 1521 static Lisp_Object |
442 | 1522 make_image_instance_1 (Lisp_Object data, Lisp_Object domain, |
428 | 1523 Lisp_Object dest_types) |
1524 { | |
1525 Lisp_Object ii; | |
1526 struct gcpro gcpro1; | |
1527 int dest_mask; | |
442 | 1528 Lisp_Object governing_domain; |
1529 | |
428 | 1530 if (IMAGE_INSTANCEP (data)) |
563 | 1531 invalid_argument ("Image instances not allowed here", data); |
428 | 1532 image_validate (data); |
442 | 1533 domain = decode_domain (domain); |
1534 /* instantiate_image_instantiator() will abort if given an | |
1535 image instance ... */ | |
428 | 1536 dest_mask = decode_image_instance_type_list (dest_types); |
442 | 1537 data = normalize_image_instantiator (data, |
1538 DEVICE_TYPE (DOMAIN_XDEVICE (domain)), | |
428 | 1539 make_int (dest_mask)); |
1540 GCPRO1 (data); | |
442 | 1541 /* After normalizing the data, it's always either an image instance (which |
1542 we filtered out above) or a vector. */ | |
450 | 1543 if (EQ (INSTANTIATOR_TYPE (data), Qinherit)) |
563 | 1544 invalid_argument ("Inheritance not allowed here", data); |
442 | 1545 governing_domain = |
1546 get_image_instantiator_governing_domain (data, domain); | |
1547 ii = instantiate_image_instantiator (governing_domain, domain, data, | |
438 | 1548 Qnil, Qnil, dest_mask, Qnil); |
428 | 1549 RETURN_UNGCPRO (ii); |
1550 } | |
1551 | |
1552 DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /* | |
1553 Return a new `image-instance' object. | |
1554 | |
1555 Image-instance objects encapsulate the way a particular image (pixmap, | |
1556 etc.) is displayed on a particular device. In most circumstances, you | |
1557 do not need to directly create image instances; use a glyph instead. | |
1558 However, it may occasionally be useful to explicitly create image | |
1559 instances, if you want more control over the instantiation process. | |
1560 | |
1561 DATA is an image instantiator, which describes the image; see | |
442 | 1562 `make-image-specifier' for a description of the allowed values. |
428 | 1563 |
1564 DEST-TYPES should be a list of allowed image instance types that can | |
1565 be generated. The recognized image instance types are | |
1566 | |
2959 | 1567 `nothing' |
428 | 1568 Nothing is displayed. |
2959 | 1569 `text' |
428 | 1570 Displayed as text. The foreground and background colors and the |
1571 font of the text are specified independent of the pixmap. Typically | |
1572 these attributes will come from the face of the surrounding text, | |
1573 unless a face is specified for the glyph in which the image appears. | |
2959 | 1574 `mono-pixmap' |
428 | 1575 Displayed as a mono pixmap (a pixmap with only two colors where the |
1576 foreground and background can be specified independent of the pixmap; | |
1577 typically the pixmap assumes the foreground and background colors of | |
1578 the text around it, unless a face is specified for the glyph in which | |
1579 the image appears). | |
2959 | 1580 `color-pixmap' |
428 | 1581 Displayed as a color pixmap. |
2959 | 1582 `pointer' |
428 | 1583 Used as the mouse pointer for a window. |
2959 | 1584 `subwindow' |
428 | 1585 A child window that is treated as an image. This allows (e.g.) |
1586 another program to be responsible for drawing into the window. | |
2959 | 1587 `widget' |
428 | 1588 A child window that contains a window-system widget, e.g. a push |
442 | 1589 button, text field, or slider. |
1590 | |
1591 The DEST-TYPES list is unordered. If multiple destination types are | |
1592 possible for a given instantiator, the "most natural" type for the | |
1593 instantiator's format is chosen. (For XBM, the most natural types are | |
1594 `mono-pixmap', followed by `color-pixmap', followed by `pointer'. For | |
1595 the other normal image formats, the most natural types are | |
1596 `color-pixmap', followed by `mono-pixmap', followed by `pointer'. For | |
1597 the string and formatted-string formats, the most natural types are | |
1598 `text', followed by `mono-pixmap' (not currently implemented), | |
1599 followed by `color-pixmap' (not currently implemented). For MS | |
1600 Windows resources, the most natural type for pointer resources is | |
1601 `pointer', and for the others it's `color-pixmap'. The other formats | |
1602 can only be instantiated as one type. (If you want to control more | |
1603 specifically the order of the types into which an image is | |
1604 instantiated, just call `make-image-instance' repeatedly until it | |
1605 succeeds, passing less and less preferred destination types each | |
1606 time.) | |
1607 | |
1608 See `make-image-specifier' for a description of the different image | |
1609 instantiator formats. | |
428 | 1610 |
1611 If DEST-TYPES is omitted, all possible types are allowed. | |
1612 | |
442 | 1613 DOMAIN specifies the domain to which the image instance will be attached. |
1614 This domain is termed the \"governing domain\". The type of the governing | |
1615 domain depends on the image instantiator format. (Although, more correctly, | |
1616 it should probably depend on the image instance type.) For example, pixmap | |
1617 image instances are specific to a device, but widget image instances are | |
1618 specific to a particular XEmacs window because in order to display such a | |
1619 widget when two windows onto the same buffer want to display the widget, | |
1620 two separate underlying widgets must be created. (That's because a widget | |
1621 is actually a child window-system window, and all window-system windows have | |
1622 a unique existence on the screen.) This means that the governing domain for | |
1623 a pixmap image instance will be some device (most likely, the only existing | |
1624 device), whereas the governing domain for a widget image instance will be | |
1625 some XEmacs window. | |
1626 | |
1627 If you specify an overly general DOMAIN (e.g. a frame when a window was | |
1628 wanted), an error is signaled. If you specify an overly specific DOMAIN | |
1629 \(e.g. a window when a device was wanted), the corresponding general domain | |
1630 is fetched and used instead. For `make-image-instance', it makes no | |
1631 difference whether you specify an overly specific domain or the properly | |
1632 general domain derived from it. However, it does matter when creating an | |
1633 image instance by instantiating a specifier or glyph (e.g. with | |
1634 `glyph-image-instance'), because the more specific domain causes spec lookup | |
1635 to start there and proceed to more general domains. (It would also matter | |
1636 when creating an image instance with an instantiator format of `inherit', | |
1637 but we currently disallow this. #### We should fix this.) | |
1638 | |
1639 If omitted, DOMAIN defaults to the selected window. | |
1640 | |
444 | 1641 NOERROR controls what happens when the image cannot be generated. |
428 | 1642 If nil, an error message is generated. If t, no messages are |
1643 generated and this function returns nil. If anything else, a warning | |
440 | 1644 message is generated and this function returns nil. |
428 | 1645 */ |
444 | 1646 (data, domain, dest_types, noerror)) |
1647 { | |
578 | 1648 Error_Behavior errb = decode_error_behavior_flag (noerror); |
428 | 1649 |
1650 return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1, | |
1651 Qnil, Qimage, errb, | |
442 | 1652 3, data, domain, dest_types); |
428 | 1653 } |
1654 | |
1655 DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /* | |
1656 Return non-nil if OBJECT is an image instance. | |
1657 */ | |
1658 (object)) | |
1659 { | |
1660 return IMAGE_INSTANCEP (object) ? Qt : Qnil; | |
1661 } | |
1662 | |
1663 DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /* | |
1664 Return the type of the given image instance. | |
2959 | 1665 The return value will be one of `nothing', `text', `mono-pixmap', |
1666 `color-pixmap', `pointer', `subwindow', or `widget'. | |
428 | 1667 */ |
1668 (image_instance)) | |
1669 { | |
1670 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1671 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1672 return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance)); |
1673 } | |
1674 | |
1675 DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /* | |
1676 Return the name of the given image instance. | |
1677 */ | |
1678 (image_instance)) | |
1679 { | |
1680 CHECK_IMAGE_INSTANCE (image_instance); | |
1681 return XIMAGE_INSTANCE_NAME (image_instance); | |
1682 } | |
1683 | |
872 | 1684 DEFUN ("image-instance-instantiator", Fimage_instance_instantiator, 1, 1, 0, /* |
1685 Return the instantiator that was used to create the image instance. | |
1686 */ | |
1687 (image_instance)) | |
1688 { | |
1689 CHECK_IMAGE_INSTANCE (image_instance); | |
1690 return XIMAGE_INSTANCE_INSTANTIATOR (image_instance); | |
1691 } | |
1692 | |
442 | 1693 DEFUN ("image-instance-domain", Fimage_instance_domain, 1, 1, 0, /* |
1694 Return the governing domain of the given image instance. | |
1695 The governing domain of an image instance is the domain that the image | |
1696 instance is specific to. It is NOT necessarily the domain that was | |
1697 given to the call to `specifier-instance' that resulted in the creation | |
1698 of this image instance. See `make-image-instance' for more information | |
1699 on governing domains. | |
1700 */ | |
1701 (image_instance)) | |
1702 { | |
1703 CHECK_IMAGE_INSTANCE (image_instance); | |
1704 return XIMAGE_INSTANCE_DOMAIN (image_instance); | |
1705 } | |
1706 | |
428 | 1707 DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /* |
1708 Return the string of the given image instance. | |
1709 This will only be non-nil for text image instances and widgets. | |
1710 */ | |
1711 (image_instance)) | |
1712 { | |
1713 CHECK_IMAGE_INSTANCE (image_instance); | |
1714 if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT) | |
1715 return XIMAGE_INSTANCE_TEXT_STRING (image_instance); | |
1716 else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET) | |
1717 return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance); | |
1718 else | |
1719 return Qnil; | |
1720 } | |
1721 | |
1722 DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /* | |
440 | 1723 Return the given property of the given image instance. |
428 | 1724 Returns nil if the property or the property method do not exist for |
440 | 1725 the image instance in the domain. |
428 | 1726 */ |
1727 (image_instance, prop)) | |
1728 { | |
440 | 1729 Lisp_Image_Instance* ii; |
428 | 1730 Lisp_Object type, ret; |
1731 struct image_instantiator_methods* meths; | |
1732 | |
1733 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1734 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1735 CHECK_SYMBOL (prop); |
1736 ii = XIMAGE_INSTANCE (image_instance); | |
1737 | |
1738 /* ... then try device specific methods ... */ | |
1739 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); | |
442 | 1740 meths = decode_device_ii_format (image_instance_device (image_instance), |
428 | 1741 type, ERROR_ME_NOT); |
1742 if (meths && HAS_IIFORMAT_METH_P (meths, property) | |
440 | 1743 && |
428 | 1744 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop)))) |
1745 { | |
1746 return ret; | |
1747 } | |
1748 /* ... then format specific methods ... */ | |
1749 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); | |
1750 if (meths && HAS_IIFORMAT_METH_P (meths, property) | |
1751 && | |
1752 !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop)))) | |
1753 { | |
1754 return ret; | |
1755 } | |
1756 /* ... then fail */ | |
1757 return Qnil; | |
1758 } | |
1759 | |
1760 DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /* | |
1761 Return the file name from which IMAGE-INSTANCE was read, if known. | |
1762 */ | |
1763 (image_instance)) | |
1764 { | |
1765 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1766 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1767 |
1768 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1769 { | |
1770 case IMAGE_MONO_PIXMAP: | |
1771 case IMAGE_COLOR_PIXMAP: | |
1772 case IMAGE_POINTER: | |
1773 return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance); | |
1774 | |
1775 default: | |
1776 return Qnil; | |
1777 } | |
1778 } | |
1779 | |
1780 DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /* | |
1781 Return the file name from which IMAGE-INSTANCE's mask was read, if known. | |
1782 */ | |
1783 (image_instance)) | |
1784 { | |
1785 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1786 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1787 |
1788 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1789 { | |
1790 case IMAGE_MONO_PIXMAP: | |
1791 case IMAGE_COLOR_PIXMAP: | |
1792 case IMAGE_POINTER: | |
1793 return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance); | |
1794 | |
1795 default: | |
1796 return Qnil; | |
1797 } | |
1798 } | |
1799 | |
1800 DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /* | |
1801 Return the depth of the image instance. | |
1802 This is 0 for a bitmap, or a positive integer for a pixmap. | |
1803 */ | |
1804 (image_instance)) | |
1805 { | |
1806 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1807 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1808 |
1809 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1810 { | |
1811 case IMAGE_MONO_PIXMAP: | |
1812 case IMAGE_COLOR_PIXMAP: | |
1813 case IMAGE_POINTER: | |
1814 return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance)); | |
1815 | |
1816 default: | |
1817 return Qnil; | |
1818 } | |
1819 } | |
1820 | |
1821 DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /* | |
1822 Return the height of the image instance, in pixels. | |
1823 */ | |
1824 (image_instance)) | |
1825 { | |
1826 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1827 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1828 |
1829 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1830 { | |
1831 case IMAGE_MONO_PIXMAP: | |
1832 case IMAGE_COLOR_PIXMAP: | |
1833 case IMAGE_POINTER: | |
1834 case IMAGE_SUBWINDOW: | |
1835 case IMAGE_WIDGET: | |
438 | 1836 return make_int (XIMAGE_INSTANCE_HEIGHT (image_instance)); |
428 | 1837 |
1838 default: | |
1839 return Qnil; | |
1840 } | |
1841 } | |
1842 | |
1843 DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /* | |
1844 Return the width of the image instance, in pixels. | |
1845 */ | |
1846 (image_instance)) | |
1847 { | |
1848 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1849 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1850 |
1851 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1852 { | |
1853 case IMAGE_MONO_PIXMAP: | |
1854 case IMAGE_COLOR_PIXMAP: | |
1855 case IMAGE_POINTER: | |
1856 case IMAGE_SUBWINDOW: | |
1857 case IMAGE_WIDGET: | |
438 | 1858 return make_int (XIMAGE_INSTANCE_WIDTH (image_instance)); |
428 | 1859 |
1860 default: | |
1861 return Qnil; | |
1862 } | |
1863 } | |
1864 | |
1865 DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /* | |
1866 Return the X coordinate of the image instance's hotspot, if known. | |
1867 This is a point relative to the origin of the pixmap. When an image is | |
1868 used as a mouse pointer, the hotspot is the point on the image that sits | |
1869 over the location that the pointer points to. This is, for example, the | |
1870 tip of the arrow or the center of the crosshairs. | |
1871 This will always be nil for a non-pointer image instance. | |
1872 */ | |
1873 (image_instance)) | |
1874 { | |
1875 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1876 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1877 |
1878 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1879 { | |
1880 case IMAGE_MONO_PIXMAP: | |
1881 case IMAGE_COLOR_PIXMAP: | |
1882 case IMAGE_POINTER: | |
1883 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance); | |
1884 | |
1885 default: | |
1886 return Qnil; | |
1887 } | |
1888 } | |
1889 | |
1890 DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /* | |
1891 Return the Y coordinate of the image instance's hotspot, if known. | |
1892 This is a point relative to the origin of the pixmap. When an image is | |
1893 used as a mouse pointer, the hotspot is the point on the image that sits | |
1894 over the location that the pointer points to. This is, for example, the | |
1895 tip of the arrow or the center of the crosshairs. | |
1896 This will always be nil for a non-pointer image instance. | |
1897 */ | |
1898 (image_instance)) | |
1899 { | |
1900 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1901 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1902 |
1903 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1904 { | |
1905 case IMAGE_MONO_PIXMAP: | |
1906 case IMAGE_COLOR_PIXMAP: | |
1907 case IMAGE_POINTER: | |
1908 return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance); | |
1909 | |
1910 default: | |
1911 return Qnil; | |
1912 } | |
1913 } | |
1914 | |
1915 DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /* | |
1916 Return the foreground color of IMAGE-INSTANCE, if applicable. | |
1917 This will be a color instance or nil. (It will only be non-nil for | |
1918 colorized mono pixmaps and for pointers.) | |
1919 */ | |
1920 (image_instance)) | |
1921 { | |
1922 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1923 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1924 |
1925 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1926 { | |
1927 case IMAGE_MONO_PIXMAP: | |
1928 case IMAGE_COLOR_PIXMAP: | |
1929 case IMAGE_POINTER: | |
1930 return XIMAGE_INSTANCE_PIXMAP_FG (image_instance); | |
1931 | |
1932 case IMAGE_WIDGET: | |
1933 return FACE_FOREGROUND ( | |
1934 XIMAGE_INSTANCE_WIDGET_FACE (image_instance), | |
442 | 1935 XIMAGE_INSTANCE_FRAME |
428 | 1936 (image_instance)); |
1937 | |
1938 default: | |
1939 return Qnil; | |
1940 } | |
1941 } | |
1942 | |
1943 DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /* | |
1944 Return the background color of IMAGE-INSTANCE, if applicable. | |
1945 This will be a color instance or nil. (It will only be non-nil for | |
1946 colorized mono pixmaps and for pointers.) | |
1947 */ | |
1948 (image_instance)) | |
1949 { | |
1950 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1951 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1952 |
1953 switch (XIMAGE_INSTANCE_TYPE (image_instance)) | |
1954 { | |
1955 case IMAGE_MONO_PIXMAP: | |
1956 case IMAGE_COLOR_PIXMAP: | |
1957 case IMAGE_POINTER: | |
1958 return XIMAGE_INSTANCE_PIXMAP_BG (image_instance); | |
1959 | |
1960 case IMAGE_WIDGET: | |
1961 return FACE_BACKGROUND ( | |
1962 XIMAGE_INSTANCE_WIDGET_FACE (image_instance), | |
442 | 1963 XIMAGE_INSTANCE_FRAME |
428 | 1964 (image_instance)); |
1965 | |
1966 default: | |
1967 return Qnil; | |
1968 } | |
1969 } | |
1970 | |
1971 | |
1972 DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /* | |
1973 Make the image instance be displayed in the given colors. | |
1974 This function returns a new image instance that is exactly like the | |
1975 specified one except that (if possible) the foreground and background | |
1976 colors and as specified. Currently, this only does anything if the image | |
1977 instance is a mono pixmap; otherwise, the same image instance is returned. | |
1978 */ | |
1979 (image_instance, foreground, background)) | |
1980 { | |
2959 | 1981 Lisp_Object new_; |
428 | 1982 Lisp_Object device; |
1983 | |
1984 CHECK_IMAGE_INSTANCE (image_instance); | |
442 | 1985 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
428 | 1986 CHECK_COLOR_INSTANCE (foreground); |
1987 CHECK_COLOR_INSTANCE (background); | |
1988 | |
442 | 1989 device = image_instance_device (image_instance); |
428 | 1990 if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance)) |
1991 return image_instance; | |
1992 | |
430 | 1993 /* #### There should be a copy_image_instance(), which calls a |
1994 device-specific method to copy the window-system subobject. */ | |
2959 | 1995 new_ = allocate_image_instance (XIMAGE_INSTANCE_DOMAIN (image_instance), |
442 | 1996 Qnil, Qnil); |
3017 | 1997 COPY_LCRECORD (XIMAGE_INSTANCE (new_), XIMAGE_INSTANCE (image_instance)); |
428 | 1998 /* note that if this method returns non-zero, this method MUST |
1999 copy any window-system resources, so that when one image instance is | |
2000 freed, the other one is not hosed. */ | |
2959 | 2001 if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new_, foreground, |
428 | 2002 background))) |
2003 return image_instance; | |
2959 | 2004 return new_; |
428 | 2005 } |
2006 | |
438 | 2007 |
2008 /************************************************************************/ | |
2009 /* Geometry calculations */ | |
2010 /************************************************************************/ | |
2011 | |
2012 /* Find out desired geometry of the image instance. If there is no | |
2013 special function then just return the width and / or height. */ | |
2014 void | |
440 | 2015 image_instance_query_geometry (Lisp_Object image_instance, |
442 | 2016 int* width, int* height, |
438 | 2017 enum image_instance_geometry disp, |
2018 Lisp_Object domain) | |
2019 { | |
440 | 2020 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); |
438 | 2021 Lisp_Object type; |
2022 struct image_instantiator_methods* meths; | |
442 | 2023 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
438 | 2024 |
2025 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); | |
2026 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); | |
440 | 2027 |
438 | 2028 if (meths && HAS_IIFORMAT_METH_P (meths, query_geometry)) |
2029 { | |
440 | 2030 IIFORMAT_METH (meths, query_geometry, (image_instance, width, height, |
438 | 2031 disp, domain)); |
2032 } | |
2033 else | |
2034 { | |
2035 if (width) | |
2036 *width = IMAGE_INSTANCE_WIDTH (ii); | |
2037 if (height) | |
2038 *height = IMAGE_INSTANCE_HEIGHT (ii); | |
2039 } | |
2040 } | |
2041 | |
2042 /* Layout the image instance using the provided dimensions. Layout | |
2043 widgets are going to do different kinds of calculations to | |
2044 determine what size to give things so we could make the layout | |
2045 function relatively simple to take account of that. An alternative | |
2046 approach is to consider separately the two cases, one where you | |
2047 don't mind what size you have (normal widgets) and one where you | |
442 | 2048 want to specify something (layout widgets). */ |
438 | 2049 void |
440 | 2050 image_instance_layout (Lisp_Object image_instance, |
442 | 2051 int width, int height, |
2052 int xoffset, int yoffset, | |
438 | 2053 Lisp_Object domain) |
2054 { | |
440 | 2055 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); |
438 | 2056 Lisp_Object type; |
2057 struct image_instantiator_methods* meths; | |
2058 | |
442 | 2059 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
2060 | |
2061 /* Nothing is as nothing does. */ | |
2062 if (NOTHING_IMAGE_INSTANCEP (image_instance)) | |
2063 return; | |
2064 | |
2065 /* We don't want carefully calculated offsets to be mucked up by | |
2066 random layouts. */ | |
2067 if (xoffset != IMAGE_UNCHANGED_GEOMETRY) | |
2068 XIMAGE_INSTANCE_XOFFSET (image_instance) = xoffset; | |
2069 if (yoffset != IMAGE_UNCHANGED_GEOMETRY) | |
2070 XIMAGE_INSTANCE_YOFFSET (image_instance) = yoffset; | |
2071 | |
2072 assert (XIMAGE_INSTANCE_YOFFSET (image_instance) >= 0 | |
2073 && XIMAGE_INSTANCE_XOFFSET (image_instance) >= 0); | |
2074 | |
438 | 2075 /* If geometry is unspecified then get some reasonable values for it. */ |
2076 if (width == IMAGE_UNSPECIFIED_GEOMETRY | |
2077 || | |
2078 height == IMAGE_UNSPECIFIED_GEOMETRY) | |
2079 { | |
442 | 2080 int dwidth = IMAGE_UNSPECIFIED_GEOMETRY; |
2081 int dheight = IMAGE_UNSPECIFIED_GEOMETRY; | |
438 | 2082 /* Get the desired geometry. */ |
450 | 2083 image_instance_query_geometry (image_instance, |
2084 &dwidth, &dheight, | |
2085 IMAGE_DESIRED_GEOMETRY, | |
2086 domain); | |
438 | 2087 /* Compare with allowed geometry. */ |
2088 if (width == IMAGE_UNSPECIFIED_GEOMETRY) | |
2089 width = dwidth; | |
2090 if (height == IMAGE_UNSPECIFIED_GEOMETRY) | |
2091 height = dheight; | |
2092 } | |
2093 | |
442 | 2094 /* If we don't have sane values then we cannot layout at this point and |
2095 must just return. */ | |
2096 if (width == IMAGE_UNSPECIFIED_GEOMETRY | |
2097 || | |
2098 height == IMAGE_UNSPECIFIED_GEOMETRY) | |
2099 return; | |
2100 | |
438 | 2101 /* At this point width and height should contain sane values. Thus |
2102 we set the glyph geometry and lay it out. */ | |
442 | 2103 if (IMAGE_INSTANCE_WIDTH (ii) != width |
2104 || | |
2105 IMAGE_INSTANCE_HEIGHT (ii) != height) | |
2106 { | |
2107 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1; | |
2108 } | |
2109 | |
438 | 2110 IMAGE_INSTANCE_WIDTH (ii) = width; |
2111 IMAGE_INSTANCE_HEIGHT (ii) = height; | |
440 | 2112 |
450 | 2113 type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); |
2114 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); | |
2115 | |
2116 MAYBE_IIFORMAT_METH (meths, layout, | |
2117 (image_instance, width, height, xoffset, yoffset, | |
2118 domain)); | |
2119 /* Do not clear the dirty flag here - redisplay will do this for | |
2120 us at the end. */ | |
2121 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 0; | |
442 | 2122 } |
2123 | |
2124 /* Update an image instance from its changed instantiator. */ | |
2125 static void | |
2126 update_image_instance (Lisp_Object image_instance, | |
2127 Lisp_Object instantiator) | |
2128 { | |
2129 struct image_instantiator_methods* meths; | |
2130 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); | |
2131 | |
2132 ERROR_CHECK_IMAGE_INSTANCE (image_instance); | |
2133 | |
2134 if (NOTHING_IMAGE_INSTANCEP (image_instance)) | |
2135 return; | |
2136 | |
2137 assert (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0) | |
2138 || (internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0) | |
2139 && internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, -10))); | |
2140 | |
2141 /* If the instantiator is identical then do nothing. We must use | |
2142 equal here because the specifier code copies the instantiator. */ | |
2143 if (!internal_equal (IMAGE_INSTANCE_INSTANTIATOR (ii), instantiator, 0)) | |
438 | 2144 { |
442 | 2145 /* Extract the changed properties so that device / format |
2146 methods only have to cope with these. We assume that | |
2147 normalization has already been done. */ | |
2148 Lisp_Object diffs = find_instantiator_differences | |
2149 (instantiator, | |
2150 IMAGE_INSTANCE_INSTANTIATOR (ii)); | |
2151 Lisp_Object type = encode_image_instance_type | |
2152 (IMAGE_INSTANCE_TYPE (ii)); | |
2153 struct gcpro gcpro1; | |
2154 GCPRO1 (diffs); | |
2155 | |
2156 /* try device specific methods first ... */ | |
2157 meths = decode_device_ii_format (image_instance_device (image_instance), | |
2158 type, ERROR_ME_NOT); | |
2159 MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs)); | |
2160 /* ... then format specific methods ... */ | |
2161 meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); | |
2162 MAYBE_IIFORMAT_METH (meths, update, (image_instance, diffs)); | |
2163 | |
2164 /* Instance and therefore glyph has changed so mark as dirty. | |
2165 If we don't do this output optimizations will assume the | |
2166 glyph is unchanged. */ | |
2167 set_image_instance_dirty_p (image_instance, 1); | |
2168 /* Structure has changed. */ | |
2169 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1; | |
2170 | |
2171 UNGCPRO; | |
438 | 2172 } |
442 | 2173 /* We should now have a consistent instantiator so keep a record of |
2174 it. It is important that we don't actually update the window | |
2175 system widgets here - we must do that when redisplay tells us | |
2176 to. | |
2177 | |
2178 #### should we delay doing this until the display is up-to-date | |
2179 also? */ | |
2180 IMAGE_INSTANCE_INSTANTIATOR (ii) = instantiator; | |
440 | 2181 } |
2182 | |
2183 /* | |
2184 * Mark image instance in W as dirty if (a) W's faces have changed and | |
2185 * (b) GLYPH_OR_II instance in W is a string. | |
2186 * | |
2187 * Return non-zero if instance has been marked dirty. | |
2188 */ | |
2189 int | |
2190 invalidate_glyph_geometry_maybe (Lisp_Object glyph_or_ii, struct window* w) | |
2191 { | |
2192 if (XFRAME(WINDOW_FRAME(w))->faces_changed) | |
2193 { | |
2194 Lisp_Object image = glyph_or_ii; | |
2195 | |
2196 if (GLYPHP (glyph_or_ii)) | |
2197 { | |
793 | 2198 Lisp_Object window = wrap_window (w); |
2199 | |
2200 image = glyph_image_instance (glyph_or_ii, window, | |
2201 ERROR_ME_DEBUG_WARN, 1); | |
440 | 2202 } |
2203 | |
2204 if (TEXT_IMAGE_INSTANCEP (image)) | |
2205 { | |
442 | 2206 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image); |
2207 IMAGE_INSTANCE_DIRTYP (ii) = 1; | |
2208 IMAGE_INSTANCE_LAYOUT_CHANGED (ii) = 1; | |
440 | 2209 if (GLYPHP (glyph_or_ii)) |
2210 XGLYPH_DIRTYP (glyph_or_ii) = 1; | |
2211 return 1; | |
2212 } | |
2213 } | |
2214 | |
2215 return 0; | |
438 | 2216 } |
2217 | |
428 | 2218 |
2219 /************************************************************************/ | |
2220 /* error helpers */ | |
2221 /************************************************************************/ | |
2222 DOESNT_RETURN | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2223 signal_image_error (const Ascbyte *reason, Lisp_Object frob) |
428 | 2224 { |
563 | 2225 signal_error (Qimage_conversion_error, reason, frob); |
428 | 2226 } |
2227 | |
2228 DOESNT_RETURN | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2229 signal_image_error_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
|
2230 Lisp_Object frob1) |
428 | 2231 { |
563 | 2232 signal_error_2 (Qimage_conversion_error, reason, frob0, frob1); |
2233 } | |
2234 | |
2235 DOESNT_RETURN | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2236 signal_double_image_error (const Ascbyte *reason1, const Ascbyte *reason2, |
563 | 2237 Lisp_Object data) |
2238 { | |
2239 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
|
2240 list3 (build_msg_string (reason1), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2241 build_msg_string (reason2), |
563 | 2242 data)); |
2243 } | |
2244 | |
2245 DOESNT_RETURN | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2246 signal_double_image_error_2 (const Ascbyte *reason1, const Ascbyte *reason2, |
563 | 2247 Lisp_Object data1, Lisp_Object data2) |
2248 { | |
2249 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
|
2250 list4 (build_msg_string (reason1), |
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2251 build_msg_string (reason2), |
563 | 2252 data1, data2)); |
428 | 2253 } |
2254 | |
2255 /**************************************************************************** | |
2256 * nothing * | |
2257 ****************************************************************************/ | |
2258 | |
2259 static int | |
2260 nothing_possible_dest_types (void) | |
2261 { | |
2262 return IMAGE_NOTHING_MASK; | |
2263 } | |
2264 | |
2265 static void | |
2266 nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
2286 | 2267 Lisp_Object UNUSED (pointer_fg), |
2268 Lisp_Object UNUSED (pointer_bg), | |
2269 int dest_mask, Lisp_Object UNUSED (domain)) | |
428 | 2270 { |
440 | 2271 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); |
428 | 2272 |
2273 if (dest_mask & IMAGE_NOTHING_MASK) | |
442 | 2274 { |
2275 IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING; | |
2276 IMAGE_INSTANCE_HEIGHT (ii) = 0; | |
2277 IMAGE_INSTANCE_WIDTH (ii) = 0; | |
2278 } | |
428 | 2279 else |
2280 incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK); | |
2281 } | |
2282 | |
2283 | |
2284 /**************************************************************************** | |
2285 * inherit * | |
2286 ****************************************************************************/ | |
2287 | |
2288 static void | |
2289 inherit_validate (Lisp_Object instantiator) | |
2290 { | |
2291 face_must_be_present (instantiator); | |
2292 } | |
2293 | |
2294 static Lisp_Object | |
2286 | 2295 inherit_normalize (Lisp_Object inst, Lisp_Object UNUSED (console_type), |
2296 Lisp_Object UNUSED (dest_mask)) | |
428 | 2297 { |
2298 Lisp_Object face; | |
2299 | |
2300 assert (XVECTOR_LENGTH (inst) == 3); | |
2301 face = XVECTOR_DATA (inst)[2]; | |
2302 if (!FACEP (face)) | |
2303 inst = vector3 (Qinherit, Q_face, Fget_face (face)); | |
2304 return inst; | |
2305 } | |
2306 | |
2307 static int | |
2308 inherit_possible_dest_types (void) | |
2309 { | |
2310 return IMAGE_MONO_PIXMAP_MASK; | |
2311 } | |
2312 | |
2313 static void | |
2286 | 2314 inherit_instantiate (Lisp_Object UNUSED (image_instance), |
2315 Lisp_Object UNUSED (instantiator), | |
2316 Lisp_Object UNUSED (pointer_fg), | |
2317 Lisp_Object UNUSED (pointer_bg), | |
2318 int UNUSED (dest_mask), Lisp_Object UNUSED (domain)) | |
428 | 2319 { |
2320 /* handled specially in image_instantiate */ | |
2500 | 2321 ABORT (); |
428 | 2322 } |
2323 | |
2324 | |
2325 /**************************************************************************** | |
2326 * string * | |
2327 ****************************************************************************/ | |
2328 | |
2329 static void | |
2330 string_validate (Lisp_Object instantiator) | |
2331 { | |
2332 data_must_be_present (instantiator); | |
2333 } | |
2334 | |
2335 static int | |
2336 string_possible_dest_types (void) | |
2337 { | |
2338 return IMAGE_TEXT_MASK; | |
2339 } | |
2340 | |
438 | 2341 /* Called from autodetect_instantiate() */ |
428 | 2342 void |
2343 string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
2286 | 2344 Lisp_Object UNUSED (pointer_fg), |
2345 Lisp_Object UNUSED (pointer_bg), | |
428 | 2346 int dest_mask, Lisp_Object domain) |
2347 { | |
434 | 2348 Lisp_Object string = find_keyword_in_vector (instantiator, Q_data); |
440 | 2349 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); |
2350 | |
1411 | 2351 assert (!NILP (string)); |
2352 | |
438 | 2353 /* Should never get here with a domain other than a window. */ |
1411 | 2354 #ifndef NDEBUG |
2355 /* Work Around for an Intel Compiler 7.0 internal error */ | |
2356 /* assert (WINDOWP (DOMAIN_WINDOW (domain))); internal error: 0_5086 */ | |
2357 { | |
2358 Lisp_Object w = DOMAIN_WINDOW (domain); | |
2359 assert (WINDOWP (w)); | |
2360 } | |
2361 #endif | |
2362 | |
428 | 2363 if (dest_mask & IMAGE_TEXT_MASK) |
2364 { | |
2365 IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT; | |
434 | 2366 IMAGE_INSTANCE_TEXT_STRING (ii) = string; |
428 | 2367 } |
2368 else | |
2369 incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK); | |
2370 } | |
2371 | |
438 | 2372 /* Sort out the size of the text that is being displayed. Calculating |
2373 it dynamically allows us to change the text and still see | |
2374 everything. Note that the following methods are for text not string | |
2375 since that is what the instantiated type is. The first method is a | |
2376 helper that is used elsewhere for calculating text geometry. */ | |
2377 void | |
2378 query_string_geometry (Lisp_Object string, Lisp_Object face, | |
442 | 2379 int* width, int* height, int* descent, Lisp_Object domain) |
438 | 2380 { |
2381 struct font_metric_info fm; | |
2382 unsigned char charsets[NUM_LEADING_BYTES]; | |
4815
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2383 struct face_cachel cachel; |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2384 struct face_cachel *the_cachel; |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2385 Lisp_Object window = DOMAIN_WINDOW (domain); |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2386 Lisp_Object frame = DOMAIN_FRAME (domain); |
438 | 2387 |
903 | 2388 CHECK_STRING (string); |
2389 | |
438 | 2390 /* Compute height */ |
2391 if (height) | |
2392 { | |
2393 /* Compute string metric info */ | |
867 | 2394 find_charsets_in_ibyte_string (charsets, |
438 | 2395 XSTRING_DATA (string), |
2396 XSTRING_LENGTH (string)); | |
440 | 2397 |
438 | 2398 /* Fallback to the default face if none was provided. */ |
2399 if (!NILP (face)) | |
2400 { | |
4815
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2401 reset_face_cachel (&cachel); |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2402 update_face_cachel_data (&cachel, |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2403 /* #### 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
|
2404 #### possible to *not* get a window |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2405 #### here, but you never know... |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2406 #### -- dvl */ |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2407 NILP (window) ? frame : window, |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2408 face); |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2409 the_cachel = &cachel; |
438 | 2410 } |
2411 else | |
4815
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2412 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
|
2413 DEFAULT_INDEX); |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2414 |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2415 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
|
2416 face_cachel_charset_font_metric_info (the_cachel, charsets, &fm); |
440 | 2417 |
438 | 2418 *height = fm.ascent + fm.descent; |
2419 /* #### descent only gets set if we query the height as well. */ | |
2420 if (descent) | |
2421 *descent = fm.descent; | |
2422 } | |
440 | 2423 |
438 | 2424 /* Compute width */ |
2425 if (width) | |
4815
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2426 *width = redisplay_text_width_string (domain, |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2427 NILP (face) ? Vdefault_face : face, |
6540302eedf5
Fix query_string_geometry lookup domain
Didier Verna <didier@lrde.epita.fr>
parents:
4677
diff
changeset
|
2428 0, string, 0, -1); |
438 | 2429 } |
2430 | |
2431 Lisp_Object | |
2432 query_string_font (Lisp_Object string, Lisp_Object face, Lisp_Object domain) | |
2433 { | |
2434 unsigned char charsets[NUM_LEADING_BYTES]; | |
4816
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2435 struct face_cachel cachel; |
438 | 2436 int i; |
4816
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2437 Lisp_Object window = DOMAIN_WINDOW (domain); |
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2438 Lisp_Object frame = DOMAIN_FRAME (domain); |
438 | 2439 |
2440 /* Compute string font info */ | |
867 | 2441 find_charsets_in_ibyte_string (charsets, |
4816
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2442 XSTRING_DATA (string), |
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2443 XSTRING_LENGTH (string)); |
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2444 |
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2445 reset_face_cachel (&cachel); |
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2446 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
|
2447 ensure_face_cachel_complete (&cachel, domain, charsets); |
440 | 2448 |
438 | 2449 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
|
2450 if (charsets[i]) |
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2451 return FACE_CACHEL_FONT |
576f09d387d5
Fix query_string_font lookup domains
Didier Verna <didier@lrde.epita.fr>
parents:
4815
diff
changeset
|
2452 ((&cachel), charset_by_leading_byte (i + MIN_LEADING_BYTE)); |
438 | 2453 |
2454 return Qnil; /* NOT REACHED */ | |
2455 } | |
2456 | |
2457 static void | |
2458 text_query_geometry (Lisp_Object image_instance, | |
442 | 2459 int* width, int* height, |
2286 | 2460 enum image_instance_geometry UNUSED (disp), |
2461 Lisp_Object domain) | |
438 | 2462 { |
440 | 2463 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); |
442 | 2464 int descent = 0; |
438 | 2465 |
2466 query_string_geometry (IMAGE_INSTANCE_TEXT_STRING (ii), | |
2467 IMAGE_INSTANCE_FACE (ii), | |
2468 width, height, &descent, domain); | |
2469 | |
2470 /* The descent gets set as a side effect of querying the | |
2471 geometry. */ | |
2472 IMAGE_INSTANCE_TEXT_DESCENT (ii) = descent; | |
2473 } | |
2474 | |
428 | 2475 /* set the properties of a string */ |
442 | 2476 static void |
2477 text_update (Lisp_Object image_instance, Lisp_Object instantiator) | |
2478 { | |
2479 Lisp_Object val = find_keyword_in_vector (instantiator, Q_data); | |
2480 | |
2481 if (!NILP (val)) | |
428 | 2482 { |
2483 CHECK_STRING (val); | |
442 | 2484 XIMAGE_INSTANCE_TEXT_STRING (image_instance) = val; |
428 | 2485 } |
2486 } | |
2487 | |
2488 | |
2489 /**************************************************************************** | |
2490 * formatted-string * | |
2491 ****************************************************************************/ | |
2492 | |
2493 static void | |
2494 formatted_string_validate (Lisp_Object instantiator) | |
2495 { | |
2496 data_must_be_present (instantiator); | |
2497 } | |
2498 | |
2499 static int | |
2500 formatted_string_possible_dest_types (void) | |
2501 { | |
2502 return IMAGE_TEXT_MASK; | |
2503 } | |
2504 | |
2505 static void | |
2506 formatted_string_instantiate (Lisp_Object image_instance, | |
2507 Lisp_Object instantiator, | |
2508 Lisp_Object pointer_fg, Lisp_Object pointer_bg, | |
2509 int dest_mask, Lisp_Object domain) | |
2510 { | |
2511 /* #### implement this */ | |
2512 warn_when_safe (Qunimplemented, Qnotice, | |
2513 "`formatted-string' not yet implemented; assuming `string'"); | |
438 | 2514 |
440 | 2515 string_instantiate (image_instance, instantiator, |
438 | 2516 pointer_fg, pointer_bg, dest_mask, domain); |
428 | 2517 } |
2518 | |
2519 | |
2520 /************************************************************************/ | |
2521 /* pixmap file functions */ | |
2522 /************************************************************************/ | |
2523 | |
4252 | 2524 /* If INSTANTIATOR refers to inline data, return Qt. |
428 | 2525 If INSTANTIATOR refers to data in a file, return the full filename |
4252 | 2526 if it exists, Qnil if there's no console method for locating the file, or |
2527 (filename) if there was an error locating the file. | |
428 | 2528 |
2529 FILE_KEYWORD and DATA_KEYWORD are symbols specifying the | |
2530 keywords used to look up the file and inline data, | |
2531 respectively, in the instantiator. Normally these would | |
2532 be Q_file and Q_data, but might be different for mask data. */ | |
2533 | |
2534 Lisp_Object | |
2535 potential_pixmap_file_instantiator (Lisp_Object instantiator, | |
2536 Lisp_Object file_keyword, | |
2537 Lisp_Object data_keyword, | |
2538 Lisp_Object console_type) | |
2539 { | |
2540 Lisp_Object file; | |
2541 Lisp_Object data; | |
2542 | |
2543 assert (VECTORP (instantiator)); | |
2544 | |
2545 data = find_keyword_in_vector (instantiator, data_keyword); | |
2546 file = find_keyword_in_vector (instantiator, file_keyword); | |
2547 | |
2548 if (!NILP (file) && NILP (data)) | |
2549 { | |
4226 | 2550 struct console_methods *meths |
4252 | 2551 = decode_console_type(console_type, ERROR_ME); |
4226 | 2552 |
2553 if (HAS_CONTYPE_METH_P (meths, locate_pixmap_file)) | |
4252 | 2554 { |
2555 Lisp_Object retval | |
2556 = CONTYPE_METH (meths, locate_pixmap_file, (file)); | |
2557 | |
2558 if (!NILP (retval)) | |
2559 return retval; | |
2560 else | |
2561 return Fcons (file, Qnil); /* should have been file */ | |
2562 } | |
2563 else /* method unavailable */ | |
2564 return Qnil; | |
428 | 2565 } |
2566 | |
4226 | 2567 return Qt; |
2568 } | |
2569 | |
428 | 2570 Lisp_Object |
2571 simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type, | |
2572 Lisp_Object image_type_tag) | |
2573 { | |
2574 /* This function can call lisp */ | |
2575 Lisp_Object file = Qnil; | |
2576 struct gcpro gcpro1, gcpro2; | |
2577 Lisp_Object alist = Qnil; | |
2578 | |
2579 GCPRO2 (file, alist); | |
2580 | |
2581 /* Now, convert any file data into inline data. At the end of this, | |
2582 `data' will contain the inline data (if any) or Qnil, and `file' | |
2583 will contain the name this data was derived from (if known) or | |
2584 Qnil. | |
2585 | |
2586 Note that if we cannot generate any regular inline data, we | |
2587 skip out. */ | |
2588 | |
2589 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
2590 console_type); | |
2591 | |
4226 | 2592 if (NILP (file)) /* normalization impossible for the console type */ |
2593 RETURN_UNGCPRO (Qnil); | |
2594 | |
428 | 2595 if (CONSP (file)) /* failure locating filename */ |
563 | 2596 signal_double_image_error ("Opening pixmap file", |
2597 "no such file or directory", | |
2598 Fcar (file)); | |
428 | 2599 |
4226 | 2600 if (EQ (file, Qt)) /* no conversion necessary */ |
428 | 2601 RETURN_UNGCPRO (inst); |
2602 | |
2603 alist = tagged_vector_to_alist (inst); | |
2604 | |
2605 { | |
2606 Lisp_Object data = make_string_from_file (file); | |
2607 alist = remassq_no_quit (Q_file, alist); | |
2608 /* there can't be a :data at this point. */ | |
2609 alist = Fcons (Fcons (Q_file, file), | |
2610 Fcons (Fcons (Q_data, data), alist)); | |
2611 } | |
2612 | |
2613 { | |
2614 Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist); | |
2615 free_alist (alist); | |
2616 RETURN_UNGCPRO (result); | |
2617 } | |
2618 } | |
2619 | |
2620 | |
2621 #ifdef HAVE_WINDOW_SYSTEM | |
2622 /********************************************************************** | |
2623 * XBM * | |
2624 **********************************************************************/ | |
2625 | |
2626 /* Check if DATA represents a valid inline XBM spec (i.e. a list | |
2627 of (width height bits), with checking done on the dimensions). | |
2628 If not, signal an error. */ | |
2629 | |
2630 static void | |
2631 check_valid_xbm_inline (Lisp_Object data) | |
2632 { | |
2633 Lisp_Object width, height, bits; | |
2634 | |
2635 if (!CONSP (data) || | |
2636 !CONSP (XCDR (data)) || | |
2637 !CONSP (XCDR (XCDR (data))) || | |
2638 !NILP (XCDR (XCDR (XCDR (data))))) | |
563 | 2639 sferror ("Must be list of 3 elements", data); |
428 | 2640 |
2641 width = XCAR (data); | |
2642 height = XCAR (XCDR (data)); | |
2643 bits = XCAR (XCDR (XCDR (data))); | |
2644 | |
2645 CHECK_STRING (bits); | |
2646 | |
2647 if (!NATNUMP (width)) | |
563 | 2648 invalid_argument ("Width must be a natural number", width); |
428 | 2649 |
2650 if (!NATNUMP (height)) | |
563 | 2651 invalid_argument ("Height must be a natural number", height); |
428 | 2652 |
826 | 2653 if (((XINT (width) * XINT (height)) / 8) > string_char_length (bits)) |
563 | 2654 invalid_argument ("data is too short for width and height", |
428 | 2655 vector3 (width, height, bits)); |
2656 } | |
2657 | |
2658 /* Validate method for XBM's. */ | |
2659 | |
2660 static void | |
2661 xbm_validate (Lisp_Object instantiator) | |
2662 { | |
2663 file_or_data_must_be_present (instantiator); | |
2664 } | |
2665 | |
2666 /* Given a filename that is supposed to contain XBM data, return | |
2667 the inline representation of it as (width height bits). Return | |
2668 the hotspot through XHOT and YHOT, if those pointers are not 0. | |
2669 If there is no hotspot, XHOT and YHOT will contain -1. | |
2670 | |
2671 If the function fails: | |
2672 | |
2673 -- if OK_IF_DATA_INVALID is set and the data was invalid, | |
2674 return Qt. | |
2675 -- maybe return an error, or return Qnil. | |
2676 */ | |
2677 | |
2678 #ifdef HAVE_X_WINDOWS | |
2679 #include <X11/Xlib.h> | |
2680 #else | |
2681 #define XFree(data) free(data) | |
2682 #endif | |
2683 | |
2684 Lisp_Object | |
2685 bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot, | |
2686 int ok_if_data_invalid) | |
2687 { | |
647 | 2688 int w, h; |
2367 | 2689 Binbyte *data; |
428 | 2690 int result; |
771 | 2691 |
2692 result = read_bitmap_data_from_file (name, &w, &h, &data, xhot, yhot); | |
428 | 2693 |
2694 if (result == BitmapSuccess) | |
2695 { | |
2696 Lisp_Object retval; | |
2697 int len = (w + 7) / 8 * h; | |
2698 | |
2699 retval = list3 (make_int (w), make_int (h), | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2700 make_extstring ((Extbyte *) data, len, Qbinary)); |
444 | 2701 XFree (data); |
428 | 2702 return retval; |
2703 } | |
2704 | |
2705 switch (result) | |
2706 { | |
2707 case BitmapOpenFailed: | |
2708 { | |
2709 /* should never happen */ | |
563 | 2710 signal_double_image_error ("Opening bitmap file", |
2711 "no such file or directory", | |
2712 name); | |
428 | 2713 } |
2714 case BitmapFileInvalid: | |
2715 { | |
2716 if (ok_if_data_invalid) | |
2717 return Qt; | |
563 | 2718 signal_double_image_error ("Reading bitmap file", |
2719 "invalid data in file", | |
2720 name); | |
428 | 2721 } |
2722 case BitmapNoMemory: | |
2723 { | |
563 | 2724 signal_double_image_error ("Reading bitmap file", |
2725 "out of memory", | |
2726 name); | |
428 | 2727 } |
2728 default: | |
2729 { | |
563 | 2730 signal_double_image_error_2 ("Reading bitmap file", |
2731 "unknown error code", | |
2732 make_int (result), name); | |
428 | 2733 } |
2734 } | |
2735 | |
2736 return Qnil; /* not reached */ | |
2737 } | |
2738 | |
2739 Lisp_Object | |
2740 xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file, | |
2741 Lisp_Object mask_file, Lisp_Object console_type) | |
2742 { | |
2743 /* This is unclean but it's fairly standard -- a number of the | |
2744 bitmaps in /usr/include/X11/bitmaps use it -- so we support | |
2745 it. */ | |
4252 | 2746 if (EQ (mask_file, Qt) |
428 | 2747 /* don't override explicitly specified mask data. */ |
2748 && NILP (assq_no_quit (Q_mask_data, alist)) | |
4252 | 2749 && !EQ (file, Qt)) |
428 | 2750 { |
2751 mask_file = MAYBE_LISP_CONTYPE_METH | |
2752 (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
|
2753 locate_pixmap_file, (concat2 (file, build_ascstring ("Mask")))); |
428 | 2754 if (NILP (mask_file)) |
2755 mask_file = MAYBE_LISP_CONTYPE_METH | |
2756 (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
|
2757 locate_pixmap_file, (concat2 (file, build_ascstring ("msk")))); |
428 | 2758 } |
2759 | |
2760 if (!NILP (mask_file)) | |
2761 { | |
2762 Lisp_Object mask_data = | |
2763 bitmap_to_lisp_data (mask_file, 0, 0, 0); | |
2764 alist = remassq_no_quit (Q_mask_file, alist); | |
2765 /* there can't be a :mask-data at this point. */ | |
2766 alist = Fcons (Fcons (Q_mask_file, mask_file), | |
2767 Fcons (Fcons (Q_mask_data, mask_data), alist)); | |
2768 } | |
2769 | |
2770 return alist; | |
2771 } | |
2772 | |
2773 /* Normalize method for XBM's. */ | |
2774 | |
2775 static Lisp_Object | |
442 | 2776 xbm_normalize (Lisp_Object inst, Lisp_Object console_type, |
2286 | 2777 Lisp_Object UNUSED (dest_mask)) |
428 | 2778 { |
2779 Lisp_Object file = Qnil, mask_file = Qnil; | |
2780 struct gcpro gcpro1, gcpro2, gcpro3; | |
2781 Lisp_Object alist = Qnil; | |
2782 | |
2783 GCPRO3 (file, mask_file, alist); | |
2784 | |
2785 /* Now, convert any file data into inline data for both the regular | |
2786 data and the mask data. At the end of this, `data' will contain | |
2787 the inline data (if any) or Qnil, and `file' will contain | |
2788 the name this data was derived from (if known) or Qnil. | |
2789 Likewise for `mask_file' and `mask_data'. | |
2790 | |
2791 Note that if we cannot generate any regular inline data, we | |
2792 skip out. */ | |
2793 | |
2794 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
2795 console_type); | |
2796 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, | |
2797 Q_mask_data, console_type); | |
2798 | |
4226 | 2799 if (NILP (file)) /* normalization impossible for the console type */ |
2800 RETURN_UNGCPRO (Qnil); | |
2801 | |
428 | 2802 if (CONSP (file)) /* failure locating filename */ |
563 | 2803 signal_double_image_error ("Opening bitmap file", |
2804 "no such file or directory", | |
2805 Fcar (file)); | |
428 | 2806 |
4226 | 2807 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ |
428 | 2808 RETURN_UNGCPRO (inst); |
2809 | |
2810 alist = tagged_vector_to_alist (inst); | |
2811 | |
4226 | 2812 if (!EQ (file, Qt)) |
428 | 2813 { |
2814 int xhot, yhot; | |
2815 Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0); | |
2816 alist = remassq_no_quit (Q_file, alist); | |
2817 /* there can't be a :data at this point. */ | |
2818 alist = Fcons (Fcons (Q_file, file), | |
2819 Fcons (Fcons (Q_data, data), alist)); | |
2820 | |
2821 if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist))) | |
2822 alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)), | |
2823 alist); | |
2824 if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist))) | |
2825 alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)), | |
2826 alist); | |
2827 } | |
2828 | |
2829 alist = xbm_mask_file_munging (alist, file, mask_file, console_type); | |
2830 | |
2831 { | |
2832 Lisp_Object result = alist_to_tagged_vector (Qxbm, alist); | |
2833 free_alist (alist); | |
2834 RETURN_UNGCPRO (result); | |
2835 } | |
2836 } | |
2837 | |
2838 | |
2839 static int | |
2840 xbm_possible_dest_types (void) | |
2841 { | |
2842 return | |
2843 IMAGE_MONO_PIXMAP_MASK | | |
2844 IMAGE_COLOR_PIXMAP_MASK | | |
2845 IMAGE_POINTER_MASK; | |
2846 } | |
2847 | |
2848 #endif | |
2849 | |
2850 | |
2851 #ifdef HAVE_XFACE | |
2852 /********************************************************************** | |
2853 * X-Face * | |
2854 **********************************************************************/ | |
2855 | |
2856 static void | |
2857 xface_validate (Lisp_Object instantiator) | |
2858 { | |
2859 file_or_data_must_be_present (instantiator); | |
2860 } | |
2861 | |
2862 static Lisp_Object | |
442 | 2863 xface_normalize (Lisp_Object inst, Lisp_Object console_type, |
2286 | 2864 Lisp_Object UNUSED (dest_mask)) |
428 | 2865 { |
2866 /* This function can call lisp */ | |
2867 Lisp_Object file = Qnil, mask_file = Qnil; | |
2868 struct gcpro gcpro1, gcpro2, gcpro3; | |
2869 Lisp_Object alist = Qnil; | |
2870 | |
2871 GCPRO3 (file, mask_file, alist); | |
2872 | |
2873 /* Now, convert any file data into inline data for both the regular | |
2874 data and the mask data. At the end of this, `data' will contain | |
2875 the inline data (if any) or Qnil, and `file' will contain | |
2876 the name this data was derived from (if known) or Qnil. | |
2877 Likewise for `mask_file' and `mask_data'. | |
2878 | |
2879 Note that if we cannot generate any regular inline data, we | |
2880 skip out. */ | |
2881 | |
2882 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
2883 console_type); | |
2884 mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, | |
2885 Q_mask_data, console_type); | |
2886 | |
4226 | 2887 if (NILP (file)) /* normalization impossible for the console type */ |
2888 RETURN_UNGCPRO (Qnil); | |
2889 | |
428 | 2890 if (CONSP (file)) /* failure locating filename */ |
563 | 2891 signal_double_image_error ("Opening bitmap file", |
2892 "no such file or directory", | |
2893 Fcar (file)); | |
428 | 2894 |
4226 | 2895 if (EQ (file, Qt) && EQ (mask_file, Qt)) /* no conversion necessary */ |
428 | 2896 RETURN_UNGCPRO (inst); |
2897 | |
2898 alist = tagged_vector_to_alist (inst); | |
2899 | |
2900 { | |
4252 | 2901 /* #### FIXME: what if EQ (file, Qt) && !EQ (mask, Qt) ? Is that possible? |
2902 If so, we have a problem... -- dvl */ | |
428 | 2903 Lisp_Object data = make_string_from_file (file); |
2904 alist = remassq_no_quit (Q_file, alist); | |
2905 /* there can't be a :data at this point. */ | |
2906 alist = Fcons (Fcons (Q_file, file), | |
2907 Fcons (Fcons (Q_data, data), alist)); | |
2908 } | |
2909 | |
2910 alist = xbm_mask_file_munging (alist, file, mask_file, console_type); | |
2911 | |
2912 { | |
2913 Lisp_Object result = alist_to_tagged_vector (Qxface, alist); | |
2914 free_alist (alist); | |
2915 RETURN_UNGCPRO (result); | |
2916 } | |
2917 } | |
2918 | |
2919 static int | |
2920 xface_possible_dest_types (void) | |
2921 { | |
2922 return | |
2923 IMAGE_MONO_PIXMAP_MASK | | |
2924 IMAGE_COLOR_PIXMAP_MASK | | |
2925 IMAGE_POINTER_MASK; | |
2926 } | |
2927 | |
2928 #endif /* HAVE_XFACE */ | |
2929 | |
2930 | |
2931 #ifdef HAVE_XPM | |
2932 | |
2933 /********************************************************************** | |
2934 * XPM * | |
2935 **********************************************************************/ | |
2936 | |
462 | 2937 #ifdef HAVE_GTK |
2938 /* Gtk has to be gratuitously different, eh? */ | |
2939 Lisp_Object | |
4908
b3ce27ca7647
various fixes related to gtk, redisplay-xlike-inc.c
Ben Wing <ben@xemacs.org>
parents:
4906
diff
changeset
|
2940 pixmap_to_lisp_data (Lisp_Object name, int UNUSED (ok_if_data_invalid)) |
462 | 2941 { |
2942 return (make_string_from_file (name)); | |
2943 } | |
2944 #else | |
428 | 2945 Lisp_Object |
2946 pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid) | |
2947 { | |
2526 | 2948 Ascbyte **data; |
428 | 2949 int result; |
2526 | 2950 Extbyte *fname = 0; |
2951 Ibyte *resolved; | |
2952 | |
2953 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
|
2954 fname = ITEXT_TO_EXTERNAL (resolved, Qfile_name); |
428 | 2955 result = XpmReadFileToData (fname, &data); |
2956 | |
2957 if (result == XpmSuccess) | |
2958 { | |
2959 Lisp_Object retval = Qnil; | |
2960 struct buffer *old_buffer = current_buffer; | |
2961 Lisp_Object temp_buffer = | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2962 Fget_buffer_create (build_ascstring (" *pixmap conversion*")); |
428 | 2963 int elt; |
2964 int height, width, ncolors; | |
2965 struct gcpro gcpro1, gcpro2, gcpro3; | |
2966 int speccount = specpdl_depth (); | |
2967 | |
2968 GCPRO3 (name, retval, temp_buffer); | |
2969 | |
2970 specbind (Qinhibit_quit, Qt); | |
2971 set_buffer_internal (XBUFFER (temp_buffer)); | |
2972 Ferase_buffer (Qnil); | |
2973 | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2974 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
|
2975 buffer_insert_ascstring (current_buffer, "static char *pixmap[] = {\r"); |
428 | 2976 |
2977 sscanf (data[0], "%d %d %d", &height, &width, &ncolors); | |
2978 for (elt = 0; elt <= width + ncolors; elt++) | |
2979 { | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2980 buffer_insert_ascstring (current_buffer, "\""); |
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2981 buffer_insert_ascstring (current_buffer, data[elt]); |
428 | 2982 |
2983 if (elt < width + ncolors) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2984 buffer_insert_ascstring (current_buffer, "\",\r"); |
428 | 2985 else |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
2986 buffer_insert_ascstring (current_buffer, "\"};\r"); |
428 | 2987 } |
2988 | |
2989 retval = Fbuffer_substring (Qnil, Qnil, Qnil); | |
2990 XpmFree (data); | |
2991 | |
2992 set_buffer_internal (old_buffer); | |
771 | 2993 unbind_to (speccount); |
428 | 2994 |
2995 RETURN_UNGCPRO (retval); | |
2996 } | |
2997 | |
2998 switch (result) | |
2999 { | |
3000 case XpmFileInvalid: | |
3001 { | |
3002 if (ok_if_data_invalid) | |
3003 return Qt; | |
3004 signal_image_error ("invalid XPM data in file", name); | |
3005 } | |
3006 case XpmNoMemory: | |
3007 { | |
563 | 3008 signal_double_image_error ("Reading pixmap file", |
3009 "out of memory", name); | |
428 | 3010 } |
3011 case XpmOpenFailed: | |
3012 { | |
3013 /* should never happen? */ | |
563 | 3014 signal_double_image_error ("Opening pixmap file", |
3015 "no such file or directory", name); | |
428 | 3016 } |
3017 default: | |
3018 { | |
563 | 3019 signal_double_image_error_2 ("Parsing pixmap file", |
3020 "unknown error code", | |
3021 make_int (result), name); | |
428 | 3022 break; |
3023 } | |
3024 } | |
3025 | |
3026 return Qnil; /* not reached */ | |
3027 } | |
462 | 3028 #endif /* !HAVE_GTK */ |
428 | 3029 |
3030 static void | |
3031 check_valid_xpm_color_symbols (Lisp_Object data) | |
3032 { | |
3033 Lisp_Object rest; | |
3034 | |
3035 for (rest = data; !NILP (rest); rest = XCDR (rest)) | |
3036 { | |
3037 if (!CONSP (rest) || | |
3038 !CONSP (XCAR (rest)) || | |
3039 !STRINGP (XCAR (XCAR (rest))) || | |
3040 (!STRINGP (XCDR (XCAR (rest))) && | |
3041 !COLOR_SPECIFIERP (XCDR (XCAR (rest))))) | |
563 | 3042 sferror ("Invalid color symbol alist", data); |
428 | 3043 } |
3044 } | |
3045 | |
3046 static void | |
3047 xpm_validate (Lisp_Object instantiator) | |
3048 { | |
3049 file_or_data_must_be_present (instantiator); | |
3050 } | |
3051 | |
3052 Lisp_Object Vxpm_color_symbols; | |
3053 | |
3054 Lisp_Object | |
3055 evaluate_xpm_color_symbols (void) | |
3056 { | |
3057 Lisp_Object rest, results = Qnil; | |
3058 struct gcpro gcpro1, gcpro2; | |
3059 | |
3060 GCPRO2 (rest, results); | |
3061 for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest)) | |
3062 { | |
3063 Lisp_Object name, value, cons; | |
3064 | |
3065 CHECK_CONS (rest); | |
3066 cons = XCAR (rest); | |
3067 CHECK_CONS (cons); | |
3068 name = XCAR (cons); | |
3069 CHECK_STRING (name); | |
3070 value = XCDR (cons); | |
3071 CHECK_CONS (value); | |
3072 value = XCAR (value); | |
4677
8f1ee2d15784
Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4426
diff
changeset
|
3073 value = IGNORE_MULTIPLE_VALUES (Feval (value)); |
428 | 3074 if (NILP (value)) |
3075 continue; | |
3076 if (!STRINGP (value) && !COLOR_SPECIFIERP (value)) | |
563 | 3077 invalid_argument |
428 | 3078 ("Result from xpm-color-symbols eval must be nil, string, or color", |
3079 value); | |
3080 results = Fcons (Fcons (name, value), results); | |
3081 } | |
3082 UNGCPRO; /* no more evaluation */ | |
3083 return results; | |
3084 } | |
3085 | |
3086 static Lisp_Object | |
442 | 3087 xpm_normalize (Lisp_Object inst, Lisp_Object console_type, |
2286 | 3088 Lisp_Object UNUSED (dest_mask)) |
428 | 3089 { |
3090 Lisp_Object file = Qnil; | |
3091 Lisp_Object color_symbols; | |
3092 struct gcpro gcpro1, gcpro2; | |
3093 Lisp_Object alist = Qnil; | |
3094 | |
3095 GCPRO2 (file, alist); | |
3096 | |
3097 /* Now, convert any file data into inline data. At the end of this, | |
3098 `data' will contain the inline data (if any) or Qnil, and | |
3099 `file' will contain the name this data was derived from (if | |
3100 known) or Qnil. | |
3101 | |
3102 Note that if we cannot generate any regular inline data, we | |
3103 skip out. */ | |
3104 | |
3105 file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, | |
3106 console_type); | |
3107 | |
4226 | 3108 if (NILP (file)) /* normalization impossible for the console type */ |
3109 RETURN_UNGCPRO (Qnil); | |
3110 | |
428 | 3111 if (CONSP (file)) /* failure locating filename */ |
563 | 3112 signal_double_image_error ("Opening pixmap file", |
3113 "no such file or directory", | |
3114 Fcar (file)); | |
428 | 3115 |
3116 color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols, | |
3117 Qunbound); | |
3118 | |
4226 | 3119 if (EQ (file, Qt) && !UNBOUNDP (color_symbols)) |
428 | 3120 /* no conversion necessary */ |
3121 RETURN_UNGCPRO (inst); | |
3122 | |
3123 alist = tagged_vector_to_alist (inst); | |
3124 | |
4226 | 3125 if (!NILP (file) && !EQ (file, Qt)) |
428 | 3126 { |
3127 Lisp_Object data = pixmap_to_lisp_data (file, 0); | |
3128 alist = remassq_no_quit (Q_file, alist); | |
3129 /* there can't be a :data at this point. */ | |
3130 alist = Fcons (Fcons (Q_file, file), | |
3131 Fcons (Fcons (Q_data, data), alist)); | |
3132 } | |
3133 | |
3134 if (UNBOUNDP (color_symbols)) | |
3135 { | |
3136 color_symbols = evaluate_xpm_color_symbols (); | |
3137 alist = Fcons (Fcons (Q_color_symbols, color_symbols), | |
3138 alist); | |
3139 } | |
3140 | |
3141 { | |
3142 Lisp_Object result = alist_to_tagged_vector (Qxpm, alist); | |
3143 free_alist (alist); | |
3144 RETURN_UNGCPRO (result); | |
3145 } | |
3146 } | |
3147 | |
3148 static int | |
3149 xpm_possible_dest_types (void) | |
3150 { | |
3151 return | |
3152 IMAGE_MONO_PIXMAP_MASK | | |
3153 IMAGE_COLOR_PIXMAP_MASK | | |
3154 IMAGE_POINTER_MASK; | |
3155 } | |
3156 | |
3157 #endif /* HAVE_XPM */ | |
3158 | |
3159 | |
3160 /**************************************************************************** | |
3161 * Image Specifier Object * | |
3162 ****************************************************************************/ | |
3163 | |
1204 | 3164 static const struct memory_description image_specifier_description[] = { |
3165 { XD_LISP_OBJECT, offsetof (struct image_specifier, attachee) }, | |
3166 { XD_LISP_OBJECT, offsetof (struct image_specifier, attachee_property) }, | |
3167 { XD_END } | |
3168 }; | |
3169 | |
3170 DEFINE_SPECIFIER_TYPE_WITH_DATA (image); | |
428 | 3171 |
3172 static void | |
3173 image_create (Lisp_Object obj) | |
3174 { | |
440 | 3175 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); |
428 | 3176 |
3177 IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */ | |
3178 IMAGE_SPECIFIER_ATTACHEE (image) = Qnil; | |
3179 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil; | |
3180 } | |
3181 | |
3182 static void | |
3183 image_mark (Lisp_Object obj) | |
3184 { | |
440 | 3185 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); |
428 | 3186 |
3187 mark_object (IMAGE_SPECIFIER_ATTACHEE (image)); | |
3188 mark_object (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)); | |
3189 } | |
3190 | |
450 | 3191 static int |
3192 instantiator_eq_equal (Lisp_Object obj1, Lisp_Object obj2) | |
3193 { | |
3194 if (EQ (obj1, obj2)) | |
3195 return 1; | |
3196 | |
3197 else if (CONSP (obj1) && CONSP (obj2)) | |
3198 { | |
3199 return instantiator_eq_equal (XCAR (obj1), XCAR (obj2)) | |
3200 && | |
3201 instantiator_eq_equal (XCDR (obj1), XCDR (obj2)); | |
3202 } | |
3203 return 0; | |
3204 } | |
3205 | |
665 | 3206 static Hashcode |
450 | 3207 instantiator_eq_hash (Lisp_Object obj) |
3208 { | |
3209 if (CONSP (obj)) | |
3210 { | |
3211 /* no point in worrying about tail recursion, since we're not | |
3212 going very deep */ | |
3213 return HASH2 (instantiator_eq_hash (XCAR (obj)), | |
3214 instantiator_eq_hash (XCDR (obj))); | |
3215 } | |
3216 return LISP_HASH (obj); | |
3217 } | |
3218 | |
3219 /* We need a special hash table for storing image instances. */ | |
3220 Lisp_Object | |
3221 make_image_instance_cache_hash_table (void) | |
3222 { | |
3223 return make_general_lisp_hash_table | |
3224 (instantiator_eq_hash, instantiator_eq_equal, | |
3225 30, -1.0, -1.0, | |
3226 HASH_TABLE_KEY_CAR_VALUE_WEAK); | |
3227 } | |
3228 | |
428 | 3229 static Lisp_Object |
3230 image_instantiate_cache_result (Lisp_Object locative) | |
3231 { | |
442 | 3232 /* locative = (instance instantiator . subtable) |
3233 | |
3234 So we are using the instantiator as the key and the instance as | |
3235 the value. Since the hashtable is key-weak this means that the | |
3236 image instance will stay around as long as the instantiator stays | |
3237 around. The instantiator is stored in the `image' slot of the | |
3238 glyph, so as long as the glyph is marked the instantiator will be | |
3239 as well and hence the cached image instance also.*/ | |
428 | 3240 Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative))); |
853 | 3241 free_cons (XCDR (locative)); |
3242 free_cons (locative); | |
428 | 3243 return Qnil; |
3244 } | |
3245 | |
3246 /* Given a specification for an image, return an instance of | |
3247 the image which matches the given instantiator and which can be | |
3248 displayed in the given domain. */ | |
3249 | |
3250 static Lisp_Object | |
2286 | 3251 image_instantiate (Lisp_Object specifier, Lisp_Object UNUSED (matchspec), |
428 | 3252 Lisp_Object domain, Lisp_Object instantiator, |
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
4252
diff
changeset
|
3253 Lisp_Object depth, int no_fallback) |
428 | 3254 { |
438 | 3255 Lisp_Object glyph = IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); |
428 | 3256 int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier); |
3257 int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER); | |
3258 | |
3259 if (IMAGE_INSTANCEP (instantiator)) | |
3260 { | |
442 | 3261 /* make sure that the image instance's governing domain and type are |
428 | 3262 matching. */ |
442 | 3263 Lisp_Object governing_domain = XIMAGE_INSTANCE_DOMAIN (instantiator); |
3264 | |
3265 if ((DEVICEP (governing_domain) | |
3266 && EQ (governing_domain, DOMAIN_DEVICE (domain))) | |
3267 || (FRAMEP (governing_domain) | |
3268 && EQ (governing_domain, DOMAIN_FRAME (domain))) | |
3269 || (WINDOWP (governing_domain) | |
3270 && EQ (governing_domain, DOMAIN_WINDOW (domain)))) | |
428 | 3271 { |
3272 int mask = | |
3273 image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator)); | |
3274 if (mask & dest_mask) | |
3275 return instantiator; | |
3276 else | |
563 | 3277 invalid_argument ("Type of image instance not allowed here", |
428 | 3278 instantiator); |
3279 } | |
3280 else | |
563 | 3281 invalid_argument_2 ("Wrong domain for image instance", |
442 | 3282 instantiator, domain); |
428 | 3283 } |
452 | 3284 /* How ugly !! An image instanciator that uses a kludgy syntax to snarf in |
3285 face properties. There's a design flaw here. -- didier */ | |
428 | 3286 else if (VECTORP (instantiator) |
450 | 3287 && EQ (INSTANTIATOR_TYPE (instantiator), Qinherit)) |
428 | 3288 { |
3289 assert (XVECTOR_LENGTH (instantiator) == 3); | |
3290 return (FACE_PROPERTY_INSTANCE | |
3291 (Fget_face (XVECTOR_DATA (instantiator)[2]), | |
4426
515b91f904c1
Fix specifier inheritance behavior
Didier Verna <didier@xemacs.org>
parents:
4252
diff
changeset
|
3292 Qbackground_pixmap, domain, no_fallback, depth)); |
428 | 3293 } |
3294 else | |
3295 { | |
442 | 3296 Lisp_Object instance = Qnil; |
3297 Lisp_Object subtable = Qnil; | |
450 | 3298 /* #### Should this be GCPRO'd? */ |
3299 Lisp_Object hash_key = Qnil; | |
428 | 3300 Lisp_Object pointer_fg = Qnil; |
3301 Lisp_Object pointer_bg = Qnil; | |
442 | 3302 Lisp_Object governing_domain = |
3303 get_image_instantiator_governing_domain (instantiator, domain); | |
3304 struct gcpro gcpro1; | |
3305 | |
3306 GCPRO1 (instance); | |
3307 | |
3308 /* We have to put subwindow, widget and text image instances in | |
3309 a per-window cache so that we can see the same glyph in | |
3310 different windows. We use governing_domain to determine the type | |
3311 of image_instance that will be created. */ | |
428 | 3312 |
3313 if (pointerp) | |
3314 { | |
3315 pointer_fg = FACE_FOREGROUND (Vpointer_face, domain); | |
3316 pointer_bg = FACE_BACKGROUND (Vpointer_face, domain); | |
452 | 3317 hash_key = list4 (glyph, INSTANTIATOR_TYPE (instantiator), |
450 | 3318 pointer_fg, pointer_bg); |
428 | 3319 } |
450 | 3320 else |
3321 /* We cannot simply key on the glyph since fallbacks could use | |
3322 the same glyph but have a totally different instantiator | |
3323 type. Thus we key on the glyph and the type (but not any | |
3324 other parts of the instantiator. */ | |
3325 hash_key = list2 (glyph, INSTANTIATOR_TYPE (instantiator)); | |
428 | 3326 |
442 | 3327 /* First look in the device cache. */ |
3328 if (DEVICEP (governing_domain)) | |
428 | 3329 { |
442 | 3330 subtable = Fgethash (make_int (dest_mask), |
3331 XDEVICE (governing_domain)-> | |
3332 image_instance_cache, | |
3333 Qunbound); | |
3334 if (UNBOUNDP (subtable)) | |
3335 { | |
3336 /* For the image instance cache, we do comparisons with | |
3337 EQ rather than with EQUAL, as we do for color and | |
3338 font names. The reasons are: | |
3339 | |
3340 1) pixmap data can be very long, and thus the hashing | |
3341 and comparing will take awhile. | |
3342 | |
3343 2) It's not so likely that we'll run into things that | |
3344 are EQUAL but not EQ (that can happen a lot with | |
3345 faces, because their specifiers are copied around); | |
3346 but pixmaps tend not to be in faces. | |
3347 | |
3348 However, if the image-instance could be a pointer, we | |
3349 have to use EQUAL because we massaged the | |
3350 instantiator into a cons3 also containing the | |
3351 foreground and background of the pointer face. */ | |
450 | 3352 subtable = make_image_instance_cache_hash_table (); |
3353 | |
442 | 3354 Fputhash (make_int (dest_mask), subtable, |
3355 XDEVICE (governing_domain)->image_instance_cache); | |
3356 instance = Qunbound; | |
3357 } | |
3358 else | |
3359 { | |
450 | 3360 instance = Fgethash (hash_key, subtable, Qunbound); |
442 | 3361 } |
3362 } | |
3363 else if (WINDOWP (governing_domain)) | |
3364 { | |
3365 /* Subwindows have a per-window cache and have to be treated | |
3366 differently. */ | |
3367 instance = | |
450 | 3368 Fgethash (hash_key, |
442 | 3369 XWINDOW (governing_domain)->subwindow_instance_cache, |
3370 Qunbound); | |
428 | 3371 } |
3372 else | |
2500 | 3373 ABORT (); /* We're not allowed anything else currently. */ |
442 | 3374 |
3375 /* If we don't have an instance at this point then create | |
4252 | 3376 one. */ |
428 | 3377 if (UNBOUNDP (instance)) |
3378 { | |
3379 Lisp_Object locative = | |
3380 noseeum_cons (Qnil, | |
450 | 3381 noseeum_cons (hash_key, |
442 | 3382 DEVICEP (governing_domain) ? subtable |
3383 : XWINDOW (governing_domain) | |
3384 ->subwindow_instance_cache)); | |
428 | 3385 int speccount = specpdl_depth (); |
440 | 3386 |
442 | 3387 /* Make sure we cache the failures, too. Use an |
3388 unwind-protect to catch such errors. If we fail, the | |
3389 unwind-protect records nil in the hash table. If we | |
3390 succeed, we change the car of the locative to the | |
3391 resulting instance, which gets recorded instead. */ | |
428 | 3392 record_unwind_protect (image_instantiate_cache_result, |
3393 locative); | |
442 | 3394 instance = |
3395 instantiate_image_instantiator (governing_domain, | |
3396 domain, instantiator, | |
3397 pointer_fg, pointer_bg, | |
3398 dest_mask, glyph); | |
3399 | |
3400 /* We need a per-frame cache for redisplay. */ | |
3401 cache_subwindow_instance_in_frame_maybe (instance); | |
440 | 3402 |
428 | 3403 Fsetcar (locative, instance); |
442 | 3404 #ifdef ERROR_CHECK_GLYPHS |
3405 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) | |
3406 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) | |
3407 assert (EQ (XIMAGE_INSTANCE_FRAME (instance), | |
3408 DOMAIN_FRAME (domain))); | |
3409 #endif | |
771 | 3410 unbind_to (speccount); |
442 | 3411 #ifdef ERROR_CHECK_GLYPHS |
428 | 3412 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) |
442 | 3413 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) |
450 | 3414 assert (EQ (Fgethash (hash_key, |
442 | 3415 XWINDOW (governing_domain) |
3416 ->subwindow_instance_cache, | |
3417 Qunbound), instance)); | |
3418 #endif | |
428 | 3419 } |
442 | 3420 else if (NILP (instance)) |
563 | 3421 gui_error ("Can't instantiate image (probably cached)", instantiator); |
442 | 3422 /* We found an instance. However, because we are using the glyph |
4252 | 3423 as the hash key instead of the instantiator, the current |
3424 instantiator may not be the same as the original. Thus we | |
3425 must update the instance based on the new | |
3426 instantiator. Preserving instance identity like this is | |
3427 important to stop excessive window system widget creation and | |
3428 deletion - and hence flashing. */ | |
442 | 3429 else |
3430 { | |
3431 /* #### This function should be able to cope with *all* | |
3432 changes to the instantiator, but currently only copes | |
3433 with the most used properties. This means that it is | |
3434 possible to make changes that don't get reflected in the | |
3435 display. */ | |
3436 update_image_instance (instance, instantiator); | |
450 | 3437 free_list (hash_key); |
442 | 3438 } |
3439 | |
3440 #ifdef ERROR_CHECK_GLYPHS | |
3441 if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) | |
3442 & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) | |
3443 assert (EQ (XIMAGE_INSTANCE_FRAME (instance), | |
3444 DOMAIN_FRAME (domain))); | |
3445 #endif | |
3446 ERROR_CHECK_IMAGE_INSTANCE (instance); | |
3447 RETURN_UNGCPRO (instance); | |
428 | 3448 } |
3449 | |
2500 | 3450 ABORT (); |
428 | 3451 return Qnil; /* not reached */ |
3452 } | |
3453 | |
3454 /* Validate an image instantiator. */ | |
3455 | |
3456 static void | |
3457 image_validate (Lisp_Object instantiator) | |
3458 { | |
3459 if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator)) | |
3460 return; | |
3461 else if (VECTORP (instantiator)) | |
3462 { | |
3463 Lisp_Object *elt = XVECTOR_DATA (instantiator); | |
3464 int instantiator_len = XVECTOR_LENGTH (instantiator); | |
3465 struct image_instantiator_methods *meths; | |
3466 Lisp_Object already_seen = Qnil; | |
3467 struct gcpro gcpro1; | |
3468 int i; | |
3469 | |
3470 if (instantiator_len < 1) | |
563 | 3471 sferror ("Vector length must be at least 1", |
428 | 3472 instantiator); |
3473 | |
3474 meths = decode_image_instantiator_format (elt[0], ERROR_ME); | |
3475 if (!(instantiator_len & 1)) | |
563 | 3476 sferror |
428 | 3477 ("Must have alternating keyword/value pairs", instantiator); |
3478 | |
3479 GCPRO1 (already_seen); | |
3480 | |
3481 for (i = 1; i < instantiator_len; i += 2) | |
3482 { | |
3483 Lisp_Object keyword = elt[i]; | |
3484 Lisp_Object value = elt[i+1]; | |
3485 int j; | |
3486 | |
3487 CHECK_SYMBOL (keyword); | |
3488 if (!SYMBOL_IS_KEYWORD (keyword)) | |
563 | 3489 invalid_argument ("Symbol must begin with a colon", keyword); |
428 | 3490 |
3491 for (j = 0; j < Dynarr_length (meths->keywords); j++) | |
3492 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword)) | |
3493 break; | |
3494 | |
3495 if (j == Dynarr_length (meths->keywords)) | |
563 | 3496 invalid_argument ("Unrecognized keyword", keyword); |
428 | 3497 |
3498 if (!Dynarr_at (meths->keywords, j).multiple_p) | |
3499 { | |
3500 if (!NILP (memq_no_quit (keyword, already_seen))) | |
563 | 3501 sferror |
428 | 3502 ("Keyword may not appear more than once", keyword); |
3503 already_seen = Fcons (keyword, already_seen); | |
3504 } | |
3505 | |
3506 (Dynarr_at (meths->keywords, j).validate) (value); | |
3507 } | |
3508 | |
3509 UNGCPRO; | |
3510 | |
3511 MAYBE_IIFORMAT_METH (meths, validate, (instantiator)); | |
3512 } | |
3513 else | |
563 | 3514 invalid_argument ("Must be string or vector", instantiator); |
428 | 3515 } |
3516 | |
3517 static void | |
3518 image_after_change (Lisp_Object specifier, Lisp_Object locale) | |
3519 { | |
3520 Lisp_Object attachee = | |
3521 IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); | |
3522 Lisp_Object property = | |
3523 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier)); | |
3524 if (FACEP (attachee)) | |
448 | 3525 { |
3526 face_property_was_changed (attachee, property, locale); | |
3527 if (BUFFERP (locale)) | |
3528 XBUFFER (locale)->buffer_local_face_property = 1; | |
3529 } | |
428 | 3530 else if (GLYPHP (attachee)) |
3531 glyph_property_was_changed (attachee, property, locale); | |
3532 } | |
3533 | |
3534 void | |
3535 set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph, | |
3536 Lisp_Object property) | |
3537 { | |
440 | 3538 Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); |
428 | 3539 |
3540 IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph; | |
3541 IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property; | |
3542 } | |
3543 | |
3544 static Lisp_Object | |
2286 | 3545 image_going_to_add (Lisp_Object specifier, Lisp_Object UNUSED (locale), |
428 | 3546 Lisp_Object tag_set, Lisp_Object instantiator) |
3547 { | |
3548 Lisp_Object possible_console_types = Qnil; | |
3549 Lisp_Object rest; | |
3550 Lisp_Object retlist = Qnil; | |
3551 struct gcpro gcpro1, gcpro2; | |
3552 | |
3553 LIST_LOOP (rest, Vconsole_type_list) | |
3554 { | |
3555 Lisp_Object contype = XCAR (rest); | |
3556 if (!NILP (memq_no_quit (contype, tag_set))) | |
3557 possible_console_types = Fcons (contype, possible_console_types); | |
3558 } | |
3559 | |
3560 if (XINT (Flength (possible_console_types)) > 1) | |
3561 /* two conflicting console types specified */ | |
3562 return Qnil; | |
3563 | |
3564 if (NILP (possible_console_types)) | |
3565 possible_console_types = Vconsole_type_list; | |
3566 | |
3567 GCPRO2 (retlist, possible_console_types); | |
3568 | |
3569 LIST_LOOP (rest, possible_console_types) | |
3570 { | |
3571 Lisp_Object contype = XCAR (rest); | |
3572 Lisp_Object newinst = call_with_suspended_errors | |
3573 ((lisp_fn_t) normalize_image_instantiator, | |
793 | 3574 Qnil, Qimage, ERROR_ME_DEBUG_WARN, 3, instantiator, contype, |
428 | 3575 make_int (XIMAGE_SPECIFIER_ALLOWED (specifier))); |
3576 | |
3577 if (!NILP (newinst)) | |
3578 { | |
3579 Lisp_Object newtag; | |
3580 if (NILP (memq_no_quit (contype, tag_set))) | |
3581 newtag = Fcons (contype, tag_set); | |
3582 else | |
3583 newtag = tag_set; | |
3584 retlist = Fcons (Fcons (newtag, newinst), retlist); | |
3585 } | |
3586 } | |
3587 | |
3588 UNGCPRO; | |
3589 | |
3590 return retlist; | |
3591 } | |
3592 | |
434 | 3593 /* Copy an image instantiator. We can't use Fcopy_tree since widgets |
3594 may contain circular references which would send Fcopy_tree into | |
3595 infloop death. */ | |
3596 static Lisp_Object | |
3597 image_copy_vector_instantiator (Lisp_Object instantiator) | |
3598 { | |
3599 int i; | |
3600 struct image_instantiator_methods *meths; | |
3601 Lisp_Object *elt; | |
3602 int instantiator_len; | |
3603 | |
3604 CHECK_VECTOR (instantiator); | |
3605 | |
3606 instantiator = Fcopy_sequence (instantiator); | |
3607 elt = XVECTOR_DATA (instantiator); | |
3608 instantiator_len = XVECTOR_LENGTH (instantiator); | |
440 | 3609 |
434 | 3610 meths = decode_image_instantiator_format (elt[0], ERROR_ME); |
3611 | |
3612 for (i = 1; i < instantiator_len; i += 2) | |
3613 { | |
3614 int j; | |
3615 Lisp_Object keyword = elt[i]; | |
3616 Lisp_Object value = elt[i+1]; | |
3617 | |
3618 /* Find the keyword entry. */ | |
3619 for (j = 0; j < Dynarr_length (meths->keywords); j++) | |
3620 { | |
3621 if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword)) | |
3622 break; | |
3623 } | |
3624 | |
3625 /* Only copy keyword values that should be copied. */ | |
3626 if (Dynarr_at (meths->keywords, j).copy_p | |
3627 && | |
3628 (CONSP (value) || VECTORP (value))) | |
3629 { | |
3630 elt [i+1] = Fcopy_tree (value, Qt); | |
3631 } | |
3632 } | |
3633 | |
3634 return instantiator; | |
3635 } | |
3636 | |
3637 static Lisp_Object | |
3638 image_copy_instantiator (Lisp_Object arg) | |
3639 { | |
3640 if (CONSP (arg)) | |
3641 { | |
3642 Lisp_Object rest; | |
3643 rest = arg = Fcopy_sequence (arg); | |
3644 while (CONSP (rest)) | |
3645 { | |
3646 Lisp_Object elt = XCAR (rest); | |
3647 if (CONSP (elt)) | |
3648 XCAR (rest) = Fcopy_tree (elt, Qt); | |
3649 else if (VECTORP (elt)) | |
3650 XCAR (rest) = image_copy_vector_instantiator (elt); | |
3651 if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */ | |
3652 XCDR (rest) = Fcopy_tree (XCDR (rest), Qt); | |
3653 rest = XCDR (rest); | |
3654 } | |
3655 } | |
3656 else if (VECTORP (arg)) | |
3657 { | |
3658 arg = image_copy_vector_instantiator (arg); | |
3659 } | |
3660 return arg; | |
3661 } | |
3662 | |
428 | 3663 DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /* |
3664 Return non-nil if OBJECT is an image specifier. | |
442 | 3665 See `make-image-specifier' for a description of image instantiators. |
428 | 3666 */ |
3667 (object)) | |
3668 { | |
3669 return IMAGE_SPECIFIERP (object) ? Qt : Qnil; | |
3670 } | |
3671 | |
3672 | |
3673 /**************************************************************************** | |
3674 * Glyph Object * | |
3675 ****************************************************************************/ | |
3676 | |
3677 static Lisp_Object | |
3678 mark_glyph (Lisp_Object obj) | |
3679 { | |
440 | 3680 Lisp_Glyph *glyph = XGLYPH (obj); |
428 | 3681 |
3682 mark_object (glyph->image); | |
3683 mark_object (glyph->contrib_p); | |
3684 mark_object (glyph->baseline); | |
3685 mark_object (glyph->face); | |
3686 | |
3687 return glyph->plist; | |
3688 } | |
3689 | |
3690 static void | |
2286 | 3691 print_glyph (Lisp_Object obj, Lisp_Object printcharfun, |
3692 int UNUSED (escapeflag)) | |
428 | 3693 { |
440 | 3694 Lisp_Glyph *glyph = XGLYPH (obj); |
428 | 3695 |
3696 if (print_readably) | |
4846 | 3697 printing_unreadable_lcrecord (obj, 0); |
428 | 3698 |
800 | 3699 write_fmt_string_lisp (printcharfun, "#<glyph (%s", 1, Fglyph_type (obj)); |
3700 write_fmt_string_lisp (printcharfun, ") %S", 1, glyph->image); | |
3701 write_fmt_string (printcharfun, "0x%x>", glyph->header.uid); | |
428 | 3702 } |
3703 | |
3704 /* Glyphs are equal if all of their display attributes are equal. We | |
3705 don't compare names or doc-strings, because that would make equal | |
3706 be eq. | |
3707 | |
3708 This isn't concerned with "unspecified" attributes, that's what | |
3709 #'glyph-differs-from-default-p is for. */ | |
3710 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
|
3711 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
|
3712 int UNUSED (foldcase)) |
428 | 3713 { |
440 | 3714 Lisp_Glyph *g1 = XGLYPH (obj1); |
3715 Lisp_Glyph *g2 = XGLYPH (obj2); | |
428 | 3716 |
3717 depth++; | |
3718 | |
3719 return (internal_equal (g1->image, g2->image, depth) && | |
3720 internal_equal (g1->contrib_p, g2->contrib_p, depth) && | |
3721 internal_equal (g1->baseline, g2->baseline, depth) && | |
3722 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
|
3723 !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1, 0)); |
428 | 3724 } |
3725 | |
665 | 3726 static Hashcode |
428 | 3727 glyph_hash (Lisp_Object obj, int depth) |
3728 { | |
3729 depth++; | |
3730 | |
3731 /* No need to hash all of the elements; that would take too long. | |
3732 Just hash the most common ones. */ | |
3733 return HASH2 (internal_hash (XGLYPH (obj)->image, depth), | |
3734 internal_hash (XGLYPH (obj)->face, depth)); | |
3735 } | |
3736 | |
3737 static Lisp_Object | |
3738 glyph_getprop (Lisp_Object obj, Lisp_Object prop) | |
3739 { | |
440 | 3740 Lisp_Glyph *g = XGLYPH (obj); |
428 | 3741 |
3742 if (EQ (prop, Qimage)) return g->image; | |
3743 if (EQ (prop, Qcontrib_p)) return g->contrib_p; | |
3744 if (EQ (prop, Qbaseline)) return g->baseline; | |
3745 if (EQ (prop, Qface)) return g->face; | |
3746 | |
3747 return external_plist_get (&g->plist, prop, 0, ERROR_ME); | |
3748 } | |
3749 | |
3750 static int | |
3751 glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) | |
3752 { | |
3753 if (EQ (prop, Qimage) || | |
3754 EQ (prop, Qcontrib_p) || | |
3755 EQ (prop, Qbaseline)) | |
3756 return 0; | |
3757 | |
3758 if (EQ (prop, Qface)) | |
3759 { | |
3760 XGLYPH (obj)->face = Fget_face (value); | |
3761 return 1; | |
3762 } | |
3763 | |
3764 external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME); | |
3765 return 1; | |
3766 } | |
3767 | |
3768 static int | |
3769 glyph_remprop (Lisp_Object obj, Lisp_Object prop) | |
3770 { | |
3771 if (EQ (prop, Qimage) || | |
3772 EQ (prop, Qcontrib_p) || | |
3773 EQ (prop, Qbaseline)) | |
3774 return -1; | |
3775 | |
3776 if (EQ (prop, Qface)) | |
3777 { | |
3778 XGLYPH (obj)->face = Qnil; | |
3779 return 1; | |
3780 } | |
3781 | |
3782 return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME); | |
3783 } | |
3784 | |
3785 static Lisp_Object | |
3786 glyph_plist (Lisp_Object obj) | |
3787 { | |
440 | 3788 Lisp_Glyph *glyph = XGLYPH (obj); |
428 | 3789 Lisp_Object result = glyph->plist; |
3790 | |
3791 result = cons3 (Qface, glyph->face, result); | |
3792 result = cons3 (Qbaseline, glyph->baseline, result); | |
3793 result = cons3 (Qcontrib_p, glyph->contrib_p, result); | |
3794 result = cons3 (Qimage, glyph->image, result); | |
3795 | |
3796 return result; | |
3797 } | |
3798 | |
1204 | 3799 static const struct memory_description glyph_description[] = { |
440 | 3800 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, image) }, |
3801 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, contrib_p) }, | |
3802 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, baseline) }, | |
3803 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, face) }, | |
3804 { XD_LISP_OBJECT, offsetof (Lisp_Glyph, plist) }, | |
428 | 3805 { XD_END } |
3806 }; | |
3807 | |
934 | 3808 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph, |
3809 1, /*dumpable-flag*/ | |
3810 mark_glyph, print_glyph, 0, | |
1204 | 3811 glyph_equal, glyph_hash, |
3812 glyph_description, | |
934 | 3813 glyph_getprop, glyph_putprop, |
3814 glyph_remprop, glyph_plist, | |
3815 Lisp_Glyph); | |
428 | 3816 |
3817 Lisp_Object | |
3818 allocate_glyph (enum glyph_type type, | |
3819 void (*after_change) (Lisp_Object glyph, Lisp_Object property, | |
3820 Lisp_Object locale)) | |
3821 { | |
3822 /* This function can GC */ | |
3823 Lisp_Object obj = Qnil; | |
3017 | 3824 Lisp_Glyph *g = ALLOC_LCRECORD_TYPE (Lisp_Glyph, &lrecord_glyph); |
428 | 3825 |
3826 g->type = type; | |
3827 g->image = Fmake_specifier (Qimage); /* This function can GC */ | |
3828 g->dirty = 0; | |
3829 switch (g->type) | |
3830 { | |
3831 case GLYPH_BUFFER: | |
3832 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
440 | 3833 IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK |
3834 | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK | |
442 | 3835 | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK; |
428 | 3836 break; |
3837 case GLYPH_POINTER: | |
3838 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
3839 IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK; | |
3840 break; | |
3841 case GLYPH_ICON: | |
3842 XIMAGE_SPECIFIER_ALLOWED (g->image) = | |
438 | 3843 IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK |
3844 | IMAGE_COLOR_PIXMAP_MASK; | |
428 | 3845 break; |
3846 default: | |
2500 | 3847 ABORT (); |
428 | 3848 } |
3849 | |
3850 /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */ | |
3851 /* We're getting enough reports of odd behavior in this area it seems */ | |
3852 /* best to GCPRO everything. */ | |
3853 { | |
3854 Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector)); | |
3855 Lisp_Object tem2 = list1 (Fcons (Qnil, Qt)); | |
3856 Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil)); | |
3857 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
3858 | |
3859 GCPRO4 (obj, tem1, tem2, tem3); | |
3860 | |
3861 set_specifier_fallback (g->image, tem1); | |
3862 g->contrib_p = Fmake_specifier (Qboolean); | |
3863 set_specifier_fallback (g->contrib_p, tem2); | |
3864 /* #### should have a specifier for the following */ | |
3865 g->baseline = Fmake_specifier (Qgeneric); | |
3866 set_specifier_fallback (g->baseline, tem3); | |
3867 g->face = Qnil; | |
3868 g->plist = Qnil; | |
3869 g->after_change = after_change; | |
793 | 3870 obj = wrap_glyph (g); |
428 | 3871 |
3872 set_image_attached_to (g->image, obj, Qimage); | |
3873 UNGCPRO; | |
3874 } | |
3875 | |
3876 return obj; | |
3877 } | |
3878 | |
3879 static enum glyph_type | |
578 | 3880 decode_glyph_type (Lisp_Object type, Error_Behavior errb) |
428 | 3881 { |
3882 if (NILP (type)) | |
3883 return GLYPH_BUFFER; | |
3884 | |
3885 if (ERRB_EQ (errb, ERROR_ME)) | |
3886 CHECK_SYMBOL (type); | |
3887 | |
3888 if (EQ (type, Qbuffer)) return GLYPH_BUFFER; | |
3889 if (EQ (type, Qpointer)) return GLYPH_POINTER; | |
3890 if (EQ (type, Qicon)) return GLYPH_ICON; | |
3891 | |
563 | 3892 maybe_invalid_constant ("Invalid glyph type", type, Qimage, errb); |
428 | 3893 |
3894 return GLYPH_UNKNOWN; | |
3895 } | |
3896 | |
3897 static int | |
3898 valid_glyph_type_p (Lisp_Object type) | |
3899 { | |
3900 return !NILP (memq_no_quit (type, Vglyph_type_list)); | |
3901 } | |
3902 | |
3903 DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /* | |
3904 Given a GLYPH-TYPE, return non-nil if it is valid. | |
3905 Valid types are `buffer', `pointer', and `icon'. | |
3906 */ | |
3907 (glyph_type)) | |
3908 { | |
3909 return valid_glyph_type_p (glyph_type) ? Qt : Qnil; | |
3910 } | |
3911 | |
3912 DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /* | |
3913 Return a list of valid glyph types. | |
3914 */ | |
3915 ()) | |
3916 { | |
3917 return Fcopy_sequence (Vglyph_type_list); | |
3918 } | |
3919 | |
3920 DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /* | |
442 | 3921 Create and return a new uninitialized glyph of type TYPE. |
428 | 3922 |
3923 TYPE specifies the type of the glyph; this should be one of `buffer', | |
3924 `pointer', or `icon', and defaults to `buffer'. The type of the glyph | |
3925 specifies in which contexts the glyph can be used, and controls the | |
3926 allowable image types into which the glyph's image can be | |
3927 instantiated. | |
3928 | |
3929 `buffer' glyphs can be used as the begin-glyph or end-glyph of an | |
3930 extent, in the modeline, and in the toolbar. Their image can be | |
3931 instantiated as `nothing', `mono-pixmap', `color-pixmap', `text', | |
3932 and `subwindow'. | |
3933 | |
3934 `pointer' glyphs can be used to specify the mouse pointer. Their | |
3935 image can be instantiated as `pointer'. | |
3936 | |
3937 `icon' glyphs can be used to specify the icon used when a frame is | |
3938 iconified. Their image can be instantiated as `mono-pixmap' and | |
3939 `color-pixmap'. | |
3940 */ | |
3941 (type)) | |
3942 { | |
3943 enum glyph_type typeval = decode_glyph_type (type, ERROR_ME); | |
3944 return allocate_glyph (typeval, 0); | |
3945 } | |
3946 | |
3947 DEFUN ("glyphp", Fglyphp, 1, 1, 0, /* | |
3948 Return non-nil if OBJECT is a glyph. | |
3949 | |
442 | 3950 A glyph is an object used for pixmaps, widgets and the like. It is used |
428 | 3951 in begin-glyphs and end-glyphs attached to extents, in marginal and textual |
3952 annotations, in overlay arrows (overlay-arrow-* variables), in toolbar | |
442 | 3953 buttons, and the like. Much more detailed information can be found at |
3954 `make-glyph'. Its image is described using an image specifier -- | |
3955 see `make-image-specifier'. See also `make-image-instance' for further | |
3956 information. | |
428 | 3957 */ |
3958 (object)) | |
3959 { | |
3960 return GLYPHP (object) ? Qt : Qnil; | |
3961 } | |
3962 | |
3963 DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /* | |
3964 Return the type of the given glyph. | |
2959 | 3965 The return value will be one of `buffer', `pointer', or `icon'. |
428 | 3966 */ |
3967 (glyph)) | |
3968 { | |
3969 CHECK_GLYPH (glyph); | |
3970 switch (XGLYPH_TYPE (glyph)) | |
3971 { | |
2500 | 3972 default: ABORT (); |
428 | 3973 case GLYPH_BUFFER: return Qbuffer; |
3974 case GLYPH_POINTER: return Qpointer; | |
3975 case GLYPH_ICON: return Qicon; | |
3976 } | |
3977 } | |
3978 | |
438 | 3979 Lisp_Object |
3980 glyph_image_instance (Lisp_Object glyph, Lisp_Object domain, | |
578 | 3981 Error_Behavior errb, int no_quit) |
438 | 3982 { |
3983 Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph)); | |
3984 | |
2959 | 3985 /* This can never return Qunbound. All glyphs have `nothing' as |
438 | 3986 a fallback. */ |
440 | 3987 Lisp_Object image_instance = specifier_instance (specifier, Qunbound, |
438 | 3988 domain, errb, no_quit, 0, |
3989 Qzero); | |
440 | 3990 assert (!UNBOUNDP (image_instance)); |
442 | 3991 ERROR_CHECK_IMAGE_INSTANCE (image_instance); |
438 | 3992 |
3993 return image_instance; | |
3994 } | |
3995 | |
3996 static Lisp_Object | |
3997 glyph_image_instance_maybe (Lisp_Object glyph_or_image, Lisp_Object window) | |
3998 { | |
3999 Lisp_Object instance = glyph_or_image; | |
4000 | |
4001 if (GLYPHP (glyph_or_image)) | |
793 | 4002 instance = glyph_image_instance (glyph_or_image, window, |
4003 ERROR_ME_DEBUG_WARN, 1); | |
438 | 4004 |
4005 return instance; | |
4006 } | |
4007 | |
1411 | 4008 inline static int |
4009 image_instance_needs_layout (Lisp_Object instance) | |
4010 { | |
4011 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (instance); | |
4012 | |
4013 if (IMAGE_INSTANCE_DIRTYP (ii) && IMAGE_INSTANCE_LAYOUT_CHANGED (ii)) | |
4014 { | |
4015 return 1; | |
4016 } | |
4017 else | |
4018 { | |
4019 Lisp_Object iif = IMAGE_INSTANCE_FRAME (ii); | |
4020 return FRAMEP (iif) && XFRAME (iif)->size_changed; | |
4021 } | |
4022 } | |
4023 | |
428 | 4024 /***************************************************************************** |
4025 glyph_width | |
4026 | |
438 | 4027 Return the width of the given GLYPH on the given WINDOW. |
4028 Calculations are done based on recursively querying the geometry of | |
4029 the associated image instances. | |
428 | 4030 ****************************************************************************/ |
4031 unsigned short | |
438 | 4032 glyph_width (Lisp_Object glyph_or_image, Lisp_Object domain) |
428 | 4033 { |
438 | 4034 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
4035 domain); | |
428 | 4036 if (!IMAGE_INSTANCEP (instance)) |
4037 return 0; | |
4038 | |
1411 | 4039 if (image_instance_needs_layout (instance)) |
438 | 4040 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
442 | 4041 IMAGE_UNSPECIFIED_GEOMETRY, |
4042 IMAGE_UNCHANGED_GEOMETRY, | |
4043 IMAGE_UNCHANGED_GEOMETRY, domain); | |
438 | 4044 |
4045 return XIMAGE_INSTANCE_WIDTH (instance); | |
428 | 4046 } |
4047 | |
4048 DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /* | |
4049 Return the width of GLYPH on WINDOW. | |
4050 This may not be exact as it does not take into account all of the context | |
4051 that redisplay will. | |
4052 */ | |
4053 (glyph, window)) | |
4054 { | |
793 | 4055 window = wrap_window (decode_window (window)); |
428 | 4056 CHECK_GLYPH (glyph); |
4057 | |
438 | 4058 return make_int (glyph_width (glyph, window)); |
428 | 4059 } |
4060 | |
4061 unsigned short | |
438 | 4062 glyph_ascent (Lisp_Object glyph_or_image, Lisp_Object domain) |
428 | 4063 { |
438 | 4064 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
4065 domain); | |
4066 if (!IMAGE_INSTANCEP (instance)) | |
4067 return 0; | |
4068 | |
1411 | 4069 if (image_instance_needs_layout (instance)) |
438 | 4070 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
442 | 4071 IMAGE_UNSPECIFIED_GEOMETRY, |
4072 IMAGE_UNCHANGED_GEOMETRY, | |
4073 IMAGE_UNCHANGED_GEOMETRY, domain); | |
438 | 4074 |
4075 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) | |
4076 return XIMAGE_INSTANCE_TEXT_ASCENT (instance); | |
4077 else | |
4078 return XIMAGE_INSTANCE_HEIGHT (instance); | |
428 | 4079 } |
4080 | |
4081 unsigned short | |
438 | 4082 glyph_descent (Lisp_Object glyph_or_image, Lisp_Object domain) |
428 | 4083 { |
438 | 4084 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
4085 domain); | |
4086 if (!IMAGE_INSTANCEP (instance)) | |
4087 return 0; | |
4088 | |
1411 | 4089 if (image_instance_needs_layout (instance)) |
438 | 4090 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
442 | 4091 IMAGE_UNSPECIFIED_GEOMETRY, |
4092 IMAGE_UNCHANGED_GEOMETRY, | |
4093 IMAGE_UNCHANGED_GEOMETRY, domain); | |
438 | 4094 |
4095 if (XIMAGE_INSTANCE_TYPE (instance) == IMAGE_TEXT) | |
4096 return XIMAGE_INSTANCE_TEXT_DESCENT (instance); | |
4097 else | |
4098 return 0; | |
428 | 4099 } |
4100 | |
4101 /* strictly a convenience function. */ | |
4102 unsigned short | |
438 | 4103 glyph_height (Lisp_Object glyph_or_image, Lisp_Object domain) |
428 | 4104 { |
438 | 4105 Lisp_Object instance = glyph_image_instance_maybe (glyph_or_image, |
4106 domain); | |
440 | 4107 |
438 | 4108 if (!IMAGE_INSTANCEP (instance)) |
4109 return 0; | |
4110 | |
1411 | 4111 if (image_instance_needs_layout (instance)) |
438 | 4112 image_instance_layout (instance, IMAGE_UNSPECIFIED_GEOMETRY, |
442 | 4113 IMAGE_UNSPECIFIED_GEOMETRY, |
4114 IMAGE_UNCHANGED_GEOMETRY, | |
4115 IMAGE_UNCHANGED_GEOMETRY, domain); | |
438 | 4116 |
4117 return XIMAGE_INSTANCE_HEIGHT (instance); | |
428 | 4118 } |
4119 | |
4120 DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /* | |
4121 Return the ascent value of GLYPH on WINDOW. | |
4122 This may not be exact as it does not take into account all of the context | |
4123 that redisplay will. | |
4124 */ | |
4125 (glyph, window)) | |
4126 { | |
793 | 4127 window = wrap_window (decode_window (window)); |
428 | 4128 CHECK_GLYPH (glyph); |
4129 | |
438 | 4130 return make_int (glyph_ascent (glyph, window)); |
428 | 4131 } |
4132 | |
4133 DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /* | |
4134 Return the descent value of GLYPH on WINDOW. | |
4135 This may not be exact as it does not take into account all of the context | |
4136 that redisplay will. | |
4137 */ | |
4138 (glyph, window)) | |
4139 { | |
793 | 4140 window = wrap_window (decode_window (window)); |
428 | 4141 CHECK_GLYPH (glyph); |
4142 | |
438 | 4143 return make_int (glyph_descent (glyph, window)); |
428 | 4144 } |
4145 | |
4146 /* This is redundant but I bet a lot of people expect it to exist. */ | |
4147 DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /* | |
4148 Return the height of GLYPH on WINDOW. | |
4149 This may not be exact as it does not take into account all of the context | |
4150 that redisplay will. | |
4151 */ | |
4152 (glyph, window)) | |
4153 { | |
793 | 4154 window = wrap_window (decode_window (window)); |
428 | 4155 CHECK_GLYPH (glyph); |
4156 | |
438 | 4157 return make_int (glyph_height (glyph, window)); |
428 | 4158 } |
4159 | |
4160 static void | |
4161 set_glyph_dirty_p (Lisp_Object glyph_or_image, Lisp_Object window, int dirty) | |
4162 { | |
4163 Lisp_Object instance = glyph_or_image; | |
4164 | |
4165 if (!NILP (glyph_or_image)) | |
4166 { | |
4167 if (GLYPHP (glyph_or_image)) | |
4168 { | |
4169 instance = glyph_image_instance (glyph_or_image, window, | |
793 | 4170 ERROR_ME_DEBUG_WARN, 1); |
428 | 4171 XGLYPH_DIRTYP (glyph_or_image) = dirty; |
4172 } | |
4173 | |
442 | 4174 if (!IMAGE_INSTANCEP (instance)) |
4175 return; | |
4176 | |
428 | 4177 XIMAGE_INSTANCE_DIRTYP (instance) = dirty; |
4178 } | |
4179 } | |
4180 | |
442 | 4181 static void |
4182 set_image_instance_dirty_p (Lisp_Object instance, int dirty) | |
4183 { | |
4184 if (IMAGE_INSTANCEP (instance)) | |
4185 { | |
4186 XIMAGE_INSTANCE_DIRTYP (instance) = dirty; | |
4187 /* Now cascade up the hierarchy. */ | |
4188 set_image_instance_dirty_p (XIMAGE_INSTANCE_PARENT (instance), | |
4189 dirty); | |
4190 } | |
4191 else if (GLYPHP (instance)) | |
4192 { | |
4193 XGLYPH_DIRTYP (instance) = dirty; | |
4194 } | |
4195 } | |
4196 | |
428 | 4197 /* #### do we need to cache this info to speed things up? */ |
4198 | |
4199 Lisp_Object | |
4200 glyph_baseline (Lisp_Object glyph, Lisp_Object domain) | |
4201 { | |
4202 if (!GLYPHP (glyph)) | |
4203 return Qnil; | |
4204 else | |
4205 { | |
4206 Lisp_Object retval = | |
4207 specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)), | |
793 | 4208 /* #### look into error flag */ |
4209 Qunbound, domain, ERROR_ME_DEBUG_WARN, | |
428 | 4210 0, Qzero); |
4211 if (!NILP (retval) && !INTP (retval)) | |
4212 retval = Qnil; | |
4213 else if (INTP (retval)) | |
4214 { | |
4215 if (XINT (retval) < 0) | |
4216 retval = Qzero; | |
4217 if (XINT (retval) > 100) | |
4218 retval = make_int (100); | |
4219 } | |
4220 return retval; | |
4221 } | |
4222 } | |
4223 | |
4224 Lisp_Object | |
2286 | 4225 glyph_face (Lisp_Object glyph, Lisp_Object UNUSED (domain)) |
428 | 4226 { |
4227 /* #### Domain parameter not currently used but it will be */ | |
4228 return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil; | |
4229 } | |
4230 | |
4231 int | |
4232 glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain) | |
4233 { | |
4234 if (!GLYPHP (glyph)) | |
4235 return 0; | |
4236 else | |
4237 return !NILP (specifier_instance_no_quit | |
4238 (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain, | |
793 | 4239 /* #### look into error flag */ |
4240 ERROR_ME_DEBUG_WARN, 0, Qzero)); | |
428 | 4241 } |
4242 | |
4243 static void | |
4244 glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property, | |
4245 Lisp_Object locale) | |
4246 { | |
4247 if (XGLYPH (glyph)->after_change) | |
4248 (XGLYPH (glyph)->after_change) (glyph, property, locale); | |
4249 } | |
4250 | |
442 | 4251 void |
4252 glyph_query_geometry (Lisp_Object glyph_or_image, int* width, int* height, | |
438 | 4253 enum image_instance_geometry disp, Lisp_Object domain) |
4254 { | |
4255 Lisp_Object instance = glyph_or_image; | |
4256 | |
4257 if (GLYPHP (glyph_or_image)) | |
793 | 4258 instance = glyph_image_instance (glyph_or_image, domain, |
4259 ERROR_ME_DEBUG_WARN, 1); | |
440 | 4260 |
438 | 4261 image_instance_query_geometry (instance, width, height, disp, domain); |
4262 } | |
4263 | |
442 | 4264 void |
4265 glyph_do_layout (Lisp_Object glyph_or_image, int width, int height, | |
4266 int xoffset, int yoffset, Lisp_Object domain) | |
438 | 4267 { |
4268 Lisp_Object instance = glyph_or_image; | |
4269 | |
4270 if (GLYPHP (glyph_or_image)) | |
793 | 4271 instance = glyph_image_instance (glyph_or_image, domain, |
4272 ERROR_ME_DEBUG_WARN, 1); | |
442 | 4273 |
4274 image_instance_layout (instance, width, height, xoffset, yoffset, domain); | |
4275 } | |
438 | 4276 |
428 | 4277 |
4278 /***************************************************************************** | |
4968 | 4279 * glyph cachel functions * |
428 | 4280 *****************************************************************************/ |
4281 | |
4968 | 4282 #define NUM_PRECACHED_GLYPHS 6 |
4283 #define LOOP_OVER_PRECACHED_GLYPHS \ | |
4284 FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX) \ | |
4285 FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX) \ | |
4286 FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX) \ | |
4287 FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX) \ | |
4288 FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX) \ | |
4289 FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX) | |
4290 | |
4291 | |
442 | 4292 /* #### All of this is 95% copied from face cachels. Consider |
4293 consolidating. | |
4294 | |
4295 Why do we need glyph_cachels? Simply because a glyph_cachel captures | |
4296 per-window information about a particular glyph. A glyph itself is | |
4297 not created in any particular context, so if we were to rely on a | |
4298 glyph to tell us about its dirtiness we would not be able to reset | |
4299 the dirty flag after redisplaying it as it may exist in other | |
4300 contexts. When we have redisplayed we need to know which glyphs to | |
4301 reset the dirty flags on - the glyph_cachels give us a nice list we | |
4302 can iterate through doing this. */ | |
428 | 4303 void |
4304 mark_glyph_cachels (glyph_cachel_dynarr *elements) | |
4305 { | |
4306 int elt; | |
4307 | |
4308 if (!elements) | |
4309 return; | |
4310 | |
4311 for (elt = 0; elt < Dynarr_length (elements); elt++) | |
4312 { | |
4313 struct glyph_cachel *cachel = Dynarr_atp (elements, elt); | |
4314 mark_object (cachel->glyph); | |
4315 } | |
4316 } | |
4317 | |
4318 static void | |
4319 update_glyph_cachel_data (struct window *w, Lisp_Object glyph, | |
4320 struct glyph_cachel *cachel) | |
4321 { | |
4322 if (!cachel->updated || NILP (cachel->glyph) || !EQ (cachel->glyph, glyph) | |
440 | 4323 || XGLYPH_DIRTYP (cachel->glyph) |
4324 || XFRAME(WINDOW_FRAME(w))->faces_changed) | |
428 | 4325 { |
4326 Lisp_Object window, instance; | |
4327 | |
793 | 4328 window = wrap_window (w); |
428 | 4329 |
4330 cachel->glyph = glyph; | |
440 | 4331 /* Speed things up slightly by grabbing the glyph instantiation |
4332 and passing it to the size functions. */ | |
793 | 4333 instance = glyph_image_instance (glyph, window, ERROR_ME_DEBUG_WARN, 1); |
440 | 4334 |
442 | 4335 if (!IMAGE_INSTANCEP (instance)) |
4336 return; | |
4337 | |
440 | 4338 /* Mark text instance of the glyph dirty if faces have changed, |
4339 because its geometry might have changed. */ | |
4340 invalidate_glyph_geometry_maybe (instance, w); | |
4341 | |
4342 /* #### Do the following 2 lines buy us anything? --kkm */ | |
4343 XGLYPH_DIRTYP (glyph) = XIMAGE_INSTANCE_DIRTYP (instance); | |
4344 cachel->dirty = XGLYPH_DIRTYP (glyph); | |
438 | 4345 cachel->width = glyph_width (instance, window); |
4346 cachel->ascent = glyph_ascent (instance, window); | |
4347 cachel->descent = glyph_descent (instance, window); | |
428 | 4348 } |
4349 | |
4350 cachel->updated = 1; | |
4351 } | |
4352 | |
4353 static void | |
4354 add_glyph_cachel (struct window *w, Lisp_Object glyph) | |
4355 { | |
4356 struct glyph_cachel new_cachel; | |
4357 | |
4358 xzero (new_cachel); | |
4359 new_cachel.glyph = Qnil; | |
4360 | |
4361 update_glyph_cachel_data (w, glyph, &new_cachel); | |
4362 Dynarr_add (w->glyph_cachels, new_cachel); | |
4363 } | |
4364 | |
4968 | 4365 #ifdef ERROR_CHECK_GLYPHS |
4366 | |
4367 /* The precached glyphs should always occur in slots 0 - 5, with each glyph in the | |
4368 slot reserved for it. Meanwhile any other glyphs should always occur in slots | |
4369 6 or greater. */ | |
4370 static void | |
4371 verify_glyph_index (Lisp_Object glyph, glyph_index idx) | |
4372 { | |
4373 if (0) | |
4374 ; | |
4375 #define FROB(glyph_obj, gindex) \ | |
4376 else if (EQ (glyph, glyph_obj)) \ | |
4377 assert (gindex == idx); | |
4378 LOOP_OVER_PRECACHED_GLYPHS | |
4379 else | |
4380 assert (idx >= NUM_PRECACHED_GLYPHS); | |
4381 #undef FROB | |
4382 } | |
4383 | |
4384 #endif /* ERROR_CHECK_GLYPHS */ | |
4385 | |
428 | 4386 glyph_index |
4387 get_glyph_cachel_index (struct window *w, Lisp_Object glyph) | |
4388 { | |
4389 int elt; | |
4390 | |
4391 if (noninteractive) | |
4392 return 0; | |
4393 | |
4394 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) | |
4395 { | |
4396 struct glyph_cachel *cachel = | |
4397 Dynarr_atp (w->glyph_cachels, elt); | |
4398 | |
4399 if (EQ (cachel->glyph, glyph) && !NILP (glyph)) | |
4400 { | |
4968 | 4401 #ifdef ERROR_CHECK_GLYPHS |
4402 verify_glyph_index (glyph, elt); | |
4403 #endif /* ERROR_CHECK_GLYPHS */ | |
428 | 4404 update_glyph_cachel_data (w, glyph, cachel); |
4405 return elt; | |
4406 } | |
4407 } | |
4408 | |
4409 /* If we didn't find the glyph, add it and then return its index. */ | |
4410 add_glyph_cachel (w, glyph); | |
4411 return elt; | |
4412 } | |
4413 | |
4414 void | |
4415 reset_glyph_cachels (struct window *w) | |
4416 { | |
4417 Dynarr_reset (w->glyph_cachels); | |
4968 | 4418 #define FROB(glyph_obj, gindex) \ |
4419 get_glyph_cachel_index (w, glyph_obj); | |
4420 LOOP_OVER_PRECACHED_GLYPHS | |
4421 #undef FROB | |
428 | 4422 } |
4423 | |
4424 void | |
4425 mark_glyph_cachels_as_not_updated (struct window *w) | |
4426 { | |
4427 int elt; | |
4428 | |
4968 | 4429 /* A previous bug resulted from the glyph cachels never getting reset |
4430 in the minibuffer window after creation, and another glyph added before | |
4431 we got a chance to add the six normal glyphs that should go first, and | |
4432 we got called with only one glyph present. */ | |
4433 assert (Dynarr_length (w->glyph_cachels) >= NUM_PRECACHED_GLYPHS); | |
428 | 4434 /* We need to have a dirty flag to tell if the glyph has changed. |
4435 We can check to see if each glyph variable is actually a | |
4436 completely different glyph, though. */ | |
4437 #define FROB(glyph_obj, gindex) \ | |
4438 update_glyph_cachel_data (w, glyph_obj, \ | |
4968 | 4439 Dynarr_atp (w->glyph_cachels, gindex)); |
4440 LOOP_OVER_PRECACHED_GLYPHS | |
428 | 4441 #undef FROB |
4442 | |
4443 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) | |
4444 { | |
4445 Dynarr_atp (w->glyph_cachels, elt)->updated = 0; | |
4446 } | |
4447 } | |
4448 | |
4449 /* Unset the dirty bit on all the glyph cachels that have it. */ | |
440 | 4450 void |
428 | 4451 mark_glyph_cachels_as_clean (struct window* w) |
4452 { | |
4453 int elt; | |
793 | 4454 Lisp_Object window = wrap_window (w); |
4455 | |
428 | 4456 for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) |
4457 { | |
4458 struct glyph_cachel *cachel = Dynarr_atp (w->glyph_cachels, elt); | |
4459 cachel->dirty = 0; | |
4460 set_glyph_dirty_p (cachel->glyph, window, 0); | |
4461 } | |
4462 } | |
4463 | |
4464 #ifdef MEMORY_USAGE_STATS | |
4465 | |
4466 int | |
4467 compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, | |
4468 struct overhead_stats *ovstats) | |
4469 { | |
4470 int total = 0; | |
4471 | |
4472 if (glyph_cachels) | |
4473 total += Dynarr_memory_usage (glyph_cachels, ovstats); | |
4474 | |
4475 return total; | |
4476 } | |
4477 | |
4478 #endif /* MEMORY_USAGE_STATS */ | |
4479 | |
4480 | |
4481 | |
4482 /***************************************************************************** | |
4968 | 4483 * subwindow cachel functions * |
428 | 4484 *****************************************************************************/ |
438 | 4485 /* Subwindows are curious in that you have to physically unmap them to |
428 | 4486 not display them. It is problematic deciding what to do in |
4487 redisplay. We have two caches - a per-window instance cache that | |
4488 keeps track of subwindows on a window, these are linked to their | |
4489 instantiator in the hashtable and when the instantiator goes away | |
4490 we want the instance to go away also. However we also have a | |
4491 per-frame instance cache that we use to determine if a subwindow is | |
4492 obscuring an area that we want to clear. We need to be able to flip | |
4493 through this quickly so a hashtable is not suitable hence the | |
442 | 4494 subwindow_cachels. This is a weak list so unreference instances |
4495 will get deleted properly. */ | |
428 | 4496 |
4497 /* redisplay in general assumes that drawing something will erase | |
4498 what was there before. unfortunately this does not apply to | |
4499 subwindows that need to be specifically unmapped in order to | |
4500 disappear. we take a brute force approach - on the basis that its | |
4501 cheap - and unmap all subwindows in a display line */ | |
442 | 4502 |
4503 /* Put new instances in the frame subwindow cache. This is less costly than | |
4504 doing it every time something gets mapped, and deleted instances will be | |
4505 removed automatically. */ | |
4506 static void | |
4507 cache_subwindow_instance_in_frame_maybe (Lisp_Object instance) | |
4508 { | |
4509 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (instance); | |
4510 if (!NILP (DOMAIN_FRAME (IMAGE_INSTANCE_DOMAIN (ii)))) | |
428 | 4511 { |
442 | 4512 struct frame* f = DOMAIN_XFRAME (IMAGE_INSTANCE_DOMAIN (ii)); |
4513 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) | |
4514 = Fcons (instance, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); | |
4515 } | |
4516 } | |
4517 | |
4518 /* Unmap and finalize all subwindow instances in the frame cache. This | |
4519 is necessary because GC will not guarantee the order things get | |
4520 deleted in and moreover, frame finalization deletes the window | |
4521 system windows before deleting XEmacs windows, and hence | |
4522 subwindows. */ | |
4523 int | |
2286 | 4524 unmap_subwindow_instance_cache_mapper (Lisp_Object UNUSED (key), |
4525 Lisp_Object value, void* finalize) | |
442 | 4526 { |
4527 /* value can be nil; we cache failures as well as successes */ | |
4528 if (!NILP (value)) | |
4529 { | |
4530 struct frame* f = XFRAME (XIMAGE_INSTANCE_FRAME (value)); | |
4531 unmap_subwindow (value); | |
4532 if (finalize) | |
428 | 4533 { |
442 | 4534 /* In case GC doesn't catch up fast enough, remove from the frame |
4535 cache also. Otherwise code that checks the sanity of the instance | |
4536 will fail. */ | |
4537 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f)) | |
4538 = delq_no_quit (value, | |
4539 XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))); | |
4540 finalize_image_instance (XIMAGE_INSTANCE (value), 0); | |
428 | 4541 } |
4542 } | |
442 | 4543 return 0; |
4544 } | |
4545 | |
4546 static void | |
4547 finalize_all_subwindow_instances (struct window *w) | |
4548 { | |
4549 if (!NILP (w->next)) finalize_all_subwindow_instances (XWINDOW (w->next)); | |
4550 if (!NILP (w->vchild)) finalize_all_subwindow_instances (XWINDOW (w->vchild)); | |
4551 if (!NILP (w->hchild)) finalize_all_subwindow_instances (XWINDOW (w->hchild)); | |
4552 | |
4553 elisp_maphash (unmap_subwindow_instance_cache_mapper, | |
4554 w->subwindow_instance_cache, (void*)1); | |
428 | 4555 } |
4556 | |
4557 void | |
442 | 4558 free_frame_subwindow_instances (struct frame* f) |
4559 { | |
4560 /* Make sure all instances are finalized. We have to do this via the | |
4561 instance cache since some instances may be extant but not | |
4562 displayed (and hence not in the frame cache). */ | |
4563 finalize_all_subwindow_instances (XWINDOW (f->root_window)); | |
4564 } | |
4565 | |
4566 /* Unmap all instances in the frame cache. */ | |
4567 void | |
4568 reset_frame_subwindow_instance_cache (struct frame* f) | |
4569 { | |
4570 Lisp_Object rest; | |
4571 | |
4572 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) | |
4573 { | |
4574 Lisp_Object value = XCAR (rest); | |
4575 unmap_subwindow (value); | |
4576 } | |
4577 } | |
428 | 4578 |
4579 /***************************************************************************** | |
4968 | 4580 * subwindow exposure ignorance * |
428 | 4581 *****************************************************************************/ |
4582 /* when we unmap subwindows the associated window system will generate | |
4583 expose events. This we do not want as redisplay already copes with | |
4584 the repainting necessary. Worse, we can get in an endless cycle of | |
4585 redisplay if we are not careful. Thus we keep a per-frame list of | |
4586 expose events that are going to come and ignore them as | |
4587 required. */ | |
4588 | |
3092 | 4589 #ifndef NEW_GC |
428 | 4590 struct expose_ignore_blocktype |
4591 { | |
4592 Blocktype_declare (struct expose_ignore); | |
4593 } *the_expose_ignore_blocktype; | |
3092 | 4594 #endif /* not NEW_GC */ |
428 | 4595 |
4596 int | |
647 | 4597 check_for_ignored_expose (struct frame* f, int x, int y, int width, int height) |
428 | 4598 { |
4599 struct expose_ignore *ei, *prev; | |
4600 /* the ignore list is FIFO so we should generally get a match with | |
4601 the first element in the list */ | |
4602 for (ei = f->subwindow_exposures, prev = 0; ei; ei = ei->next) | |
4603 { | |
4604 /* Checking for exact matches just isn't good enough as we | |
442 | 4605 might get exposures for partially obscured subwindows, thus |
4606 we have to check for overlaps. Being conservative, we will | |
4607 check for exposures wholly contained by the subwindow - this | |
428 | 4608 might give us what we want.*/ |
440 | 4609 if (ei->x <= x && ei->y <= y |
428 | 4610 && ei->x + ei->width >= x + width |
4611 && ei->y + ei->height >= y + height) | |
4612 { | |
4613 #ifdef DEBUG_WIDGETS | |
4614 stderr_out ("ignored %d+%d, %dx%d for exposure %d+%d, %dx%d\n", | |
4615 x, y, width, height, ei->x, ei->y, ei->width, ei->height); | |
4616 #endif | |
4617 if (!prev) | |
4618 f->subwindow_exposures = ei->next; | |
4619 else | |
4620 prev->next = ei->next; | |
440 | 4621 |
428 | 4622 if (ei == f->subwindow_exposures_tail) |
4623 f->subwindow_exposures_tail = prev; | |
4624 | |
4117 | 4625 #ifndef NEW_GC |
428 | 4626 Blocktype_free (the_expose_ignore_blocktype, ei); |
3092 | 4627 #endif /* not NEW_GC */ |
428 | 4628 return 1; |
4629 } | |
4630 prev = ei; | |
4631 } | |
4632 return 0; | |
4633 } | |
4634 | |
4635 static void | |
4636 register_ignored_expose (struct frame* f, int x, int y, int width, int height) | |
4637 { | |
4638 if (!hold_ignored_expose_registration) | |
4639 { | |
4640 struct expose_ignore *ei; | |
440 | 4641 |
3092 | 4642 #ifdef NEW_GC |
4643 ei = alloc_lrecord_type (struct expose_ignore, &lrecord_expose_ignore); | |
4644 #else /* not NEW_GC */ | |
428 | 4645 ei = Blocktype_alloc (the_expose_ignore_blocktype); |
3092 | 4646 #endif /* not NEW_GC */ |
440 | 4647 |
428 | 4648 ei->next = NULL; |
4649 ei->x = x; | |
4650 ei->y = y; | |
4651 ei->width = width; | |
4652 ei->height = height; | |
440 | 4653 |
428 | 4654 /* we have to add the exposure to the end of the list, since we |
4655 want to check the oldest events first. for speed we keep a record | |
4656 of the end so that we can add right to it. */ | |
4657 if (f->subwindow_exposures_tail) | |
4658 { | |
4659 f->subwindow_exposures_tail->next = ei; | |
4660 } | |
4661 if (!f->subwindow_exposures) | |
4662 { | |
4663 f->subwindow_exposures = ei; | |
4664 } | |
4665 f->subwindow_exposures_tail = ei; | |
4666 } | |
4667 } | |
4668 | |
4669 /**************************************************************************** | |
4670 find_matching_subwindow | |
4671 | |
4672 See if there is a subwindow that completely encloses the requested | |
4673 area. | |
4674 ****************************************************************************/ | |
647 | 4675 int |
4676 find_matching_subwindow (struct frame* f, int x, int y, int width, int height) | |
428 | 4677 { |
442 | 4678 Lisp_Object rest; |
4679 | |
4680 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) | |
428 | 4681 { |
442 | 4682 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (XCAR (rest)); |
4683 | |
4684 if (IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) | |
4685 && | |
4686 IMAGE_INSTANCE_DISPLAY_X (ii) <= x | |
428 | 4687 && |
442 | 4688 IMAGE_INSTANCE_DISPLAY_Y (ii) <= y |
440 | 4689 && |
442 | 4690 IMAGE_INSTANCE_DISPLAY_X (ii) |
4691 + IMAGE_INSTANCE_DISPLAY_WIDTH (ii) >= x + width | |
428 | 4692 && |
442 | 4693 IMAGE_INSTANCE_DISPLAY_Y (ii) |
4694 + IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) >= y + height) | |
428 | 4695 { |
4696 return 1; | |
4697 } | |
4698 } | |
4699 return 0; | |
4700 } | |
4701 | |
4702 | |
4703 /***************************************************************************** | |
4704 * subwindow functions * | |
4705 *****************************************************************************/ | |
4706 | |
442 | 4707 /* Update the displayed characteristics of a subwindow. This function |
4708 should generally only get called if the subwindow is actually | |
4709 dirty. */ | |
4710 void | |
4711 redisplay_subwindow (Lisp_Object subwindow) | |
428 | 4712 { |
440 | 4713 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); |
442 | 4714 int count = specpdl_depth (); |
4715 | |
4716 /* The update method is allowed to call eval. Since it is quite | |
4717 common for this function to get called from somewhere in | |
4718 redisplay we need to make sure that quits are ignored. Otherwise | |
4719 Fsignal will abort. */ | |
4720 specbind (Qinhibit_quit, Qt); | |
4721 | |
4722 ERROR_CHECK_IMAGE_INSTANCE (subwindow); | |
4723 | |
4724 if (WIDGET_IMAGE_INSTANCEP (subwindow)) | |
4725 { | |
4726 if (image_instance_changed (subwindow)) | |
4727 redisplay_widget (subwindow); | |
4728 /* Reset the changed flags. */ | |
4729 IMAGE_INSTANCE_WIDGET_FACE_CHANGED (ii) = 0; | |
4730 IMAGE_INSTANCE_WIDGET_ITEMS_CHANGED (ii) = 0; | |
4731 IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii) = 0; | |
4732 IMAGE_INSTANCE_TEXT_CHANGED (ii) = 0; | |
4733 } | |
4734 else if (IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW | |
4735 && | |
4736 !NILP (IMAGE_INSTANCE_FRAME (ii))) | |
4737 { | |
4738 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), | |
4739 redisplay_subwindow, (ii)); | |
4740 } | |
4741 | |
4742 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 0; | |
4743 /* This function is typically called by redisplay just before | |
4744 outputting the information to the screen. Thus we record a hash | |
4745 of the output to determine whether on-screen is the same as | |
4746 recorded structure. This approach has limitations in there is a | |
4747 good chance that hash values will be different for the same | |
4748 visual appearance. However, we would rather that then the other | |
4749 way round - it simply means that we will get more displays than | |
4750 we might need. We can get better hashing by making the depth | |
4751 negative - currently it will recurse down 7 levels.*/ | |
4752 IMAGE_INSTANCE_DISPLAY_HASH (ii) = internal_hash (subwindow, | |
4753 IMAGE_INSTANCE_HASH_DEPTH); | |
4754 | |
771 | 4755 unbind_to (count); |
442 | 4756 } |
4757 | |
4758 /* Determine whether an image_instance has changed structurally and | |
4759 hence needs redisplaying in some way. | |
4760 | |
4761 #### This should just look at the instantiator differences when we | |
4762 get rid of the stored items altogether. In fact we should probably | |
4763 store the new instantiator as well as the old - as we do with | |
4764 gui_items currently - and then pick-up the new on the next | |
4765 redisplay. This would obviate the need for any of this trickery | |
4766 with hashcodes. */ | |
4767 int | |
4768 image_instance_changed (Lisp_Object subwindow) | |
4769 { | |
4770 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); | |
4771 | |
4772 if (internal_hash (subwindow, IMAGE_INSTANCE_HASH_DEPTH) != | |
4773 IMAGE_INSTANCE_DISPLAY_HASH (ii)) | |
4774 return 1; | |
4775 /* #### I think there is probably a bug here. This gets called for | |
4776 layouts - and yet the pending items are always nil for | |
4777 layouts. We are saved by layout optimization, but I'm undecided | |
4778 as to what the correct fix is. */ | |
4779 else if (WIDGET_IMAGE_INSTANCEP (subwindow) | |
853 | 4780 && (!internal_equal_trapping_problems |
4781 (Qglyph, "bad subwindow instantiator", | |
4782 /* in this case we really don't want to be | |
4783 interrupted by QUIT because we care about | |
4784 the return value; and we know that any loops | |
4785 will ultimately cause errors to be issued. | |
4786 We specify a retval of 1 in that case so that | |
4787 the glyph code doesn't try to keep reoutputting | |
4788 a bad subwindow. */ | |
4789 INHIBIT_QUIT, 0, 1, IMAGE_INSTANCE_WIDGET_ITEMS (ii), | |
4790 IMAGE_INSTANCE_WIDGET_PENDING_ITEMS (ii), 0) | |
442 | 4791 || !NILP (IMAGE_INSTANCE_LAYOUT_CHILDREN (ii)) |
4792 || IMAGE_INSTANCE_WIDGET_ACTION_OCCURRED (ii))) | |
4793 return 1; | |
4794 else | |
4795 return 0; | |
428 | 4796 } |
4797 | |
438 | 4798 /* Update all the subwindows on a frame. */ |
428 | 4799 void |
442 | 4800 update_widget_instances (Lisp_Object frame) |
4801 { | |
4802 struct frame* f; | |
4803 Lisp_Object rest; | |
4804 | |
4805 /* Its possible for the preceding callback to have deleted the | |
4806 frame, so cope with this. */ | |
4807 if (!FRAMEP (frame) || !FRAME_LIVE_P (XFRAME (frame))) | |
4808 return; | |
4809 | |
4810 CHECK_FRAME (frame); | |
4811 f = XFRAME (frame); | |
4812 | |
4813 /* If we get called we know something has changed. */ | |
4814 LIST_LOOP (rest, XWEAK_LIST_LIST (FRAME_SUBWINDOW_CACHE (f))) | |
4815 { | |
4816 Lisp_Object widget = XCAR (rest); | |
4817 | |
4818 if (XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (widget) | |
4819 && | |
4820 image_instance_changed (widget)) | |
4821 { | |
4822 set_image_instance_dirty_p (widget, 1); | |
4823 MARK_FRAME_GLYPHS_CHANGED (f); | |
4824 } | |
4825 } | |
428 | 4826 } |
4827 | |
4828 /* remove a subwindow from its frame */ | |
793 | 4829 void |
4830 unmap_subwindow (Lisp_Object subwindow) | |
428 | 4831 { |
440 | 4832 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); |
428 | 4833 struct frame* f; |
4834 | |
442 | 4835 ERROR_CHECK_IMAGE_INSTANCE (subwindow); |
4836 | |
1204 | 4837 if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii)) |
4838 & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK)) | |
4839 || !IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii)) | |
428 | 4840 return; |
442 | 4841 |
428 | 4842 #ifdef DEBUG_WIDGETS |
442 | 4843 stderr_out ("unmapping subwindow %p\n", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); |
428 | 4844 #endif |
442 | 4845 f = XFRAME (IMAGE_INSTANCE_FRAME (ii)); |
428 | 4846 |
4847 /* make sure we don't get expose events */ | |
442 | 4848 register_ignored_expose (f, IMAGE_INSTANCE_DISPLAY_X (ii), |
4849 IMAGE_INSTANCE_DISPLAY_Y (ii), | |
4850 IMAGE_INSTANCE_DISPLAY_WIDTH (ii), | |
4252 | 4851 IMAGE_INSTANCE_DISPLAY_HEIGHT (ii)); |
428 | 4852 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; |
4853 | |
442 | 4854 MAYBE_DEVMETH (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)), |
4855 unmap_subwindow, (ii)); | |
428 | 4856 } |
4857 | |
4858 /* show a subwindow in its frame */ | |
793 | 4859 void |
4860 map_subwindow (Lisp_Object subwindow, int x, int y, | |
4861 struct display_glyph_area *dga) | |
428 | 4862 { |
440 | 4863 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); |
428 | 4864 |
442 | 4865 ERROR_CHECK_IMAGE_INSTANCE (subwindow); |
4866 | |
1204 | 4867 if (!(image_instance_type_to_mask (IMAGE_INSTANCE_TYPE (ii)) |
4868 & (IMAGE_WIDGET_MASK | IMAGE_SUBWINDOW_MASK))) | |
428 | 4869 return; |
4870 | |
4871 #ifdef DEBUG_WIDGETS | |
442 | 4872 stderr_out ("mapping subwindow %p, %dx%d@%d+%d\n", |
428 | 4873 IMAGE_INSTANCE_SUBWINDOW_ID (ii), |
4874 dga->width, dga->height, x, y); | |
4875 #endif | |
2286 | 4876 /* Error check by side effect */ |
4877 (void) XFRAME (IMAGE_INSTANCE_FRAME (ii)); | |
442 | 4878 IMAGE_INSTANCE_DISPLAY_X (ii) = x; |
4879 IMAGE_INSTANCE_DISPLAY_Y (ii) = y; | |
4880 IMAGE_INSTANCE_DISPLAY_WIDTH (ii) = dga->width; | |
4881 IMAGE_INSTANCE_DISPLAY_HEIGHT (ii) = dga->height; | |
4882 | |
4883 MAYBE_DEVMETH (DOMAIN_XDEVICE (ii->domain), | |
4884 map_subwindow, (ii, x, y, dga)); | |
428 | 4885 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1; |
4886 } | |
4887 | |
4888 static int | |
4889 subwindow_possible_dest_types (void) | |
4890 { | |
4891 return IMAGE_SUBWINDOW_MASK; | |
4892 } | |
4893 | |
442 | 4894 int |
4895 subwindow_governing_domain (void) | |
4896 { | |
4897 return GOVERNING_DOMAIN_WINDOW; | |
4898 } | |
4899 | |
428 | 4900 /* Partially instantiate a subwindow. */ |
4901 void | |
4902 subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, | |
2286 | 4903 Lisp_Object UNUSED (pointer_fg), |
4904 Lisp_Object UNUSED (pointer_bg), | |
428 | 4905 int dest_mask, Lisp_Object domain) |
4906 { | |
440 | 4907 Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); |
442 | 4908 Lisp_Object device = image_instance_device (image_instance); |
4909 Lisp_Object frame = DOMAIN_FRAME (domain); | |
428 | 4910 Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width); |
4911 Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height); | |
4912 | |
4913 if (NILP (frame)) | |
563 | 4914 invalid_state ("No selected frame", device); |
440 | 4915 |
428 | 4916 if (!(dest_mask & IMAGE_SUBWINDOW_MASK)) |
4917 incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK); | |
4918 | |
4919 ii->data = 0; | |
4920 IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0; | |
4921 IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; | |
442 | 4922 |
4923 if (INTP (width)) | |
428 | 4924 { |
4925 int w = 1; | |
4926 if (XINT (width) > 1) | |
4927 w = XINT (width); | |
442 | 4928 IMAGE_INSTANCE_WIDTH (ii) = w; |
4929 IMAGE_INSTANCE_SUBWINDOW_H_RESIZEP (ii) = 0; | |
428 | 4930 } |
442 | 4931 |
4932 if (INTP (height)) | |
428 | 4933 { |
4934 int h = 1; | |
4935 if (XINT (height) > 1) | |
4936 h = XINT (height); | |
442 | 4937 IMAGE_INSTANCE_HEIGHT (ii) = h; |
4938 IMAGE_INSTANCE_SUBWINDOW_V_RESIZEP (ii) = 0; | |
428 | 4939 } |
4940 } | |
4941 | |
442 | 4942 /* This is just a backup in case no-one has assigned a suitable geometry. |
4943 #### It should really query the enclose window for geometry. */ | |
4944 static void | |
2286 | 4945 subwindow_query_geometry (Lisp_Object UNUSED (image_instance), |
4946 int* width, int* height, | |
4947 enum image_instance_geometry UNUSED (disp), | |
4948 Lisp_Object UNUSED (domain)) | |
442 | 4949 { |
4950 if (width) *width = 20; | |
4951 if (height) *height = 20; | |
4952 } | |
4953 | |
428 | 4954 DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /* |
4955 Return non-nil if OBJECT is a subwindow. | |
4956 */ | |
4957 (object)) | |
4958 { | |
4959 CHECK_IMAGE_INSTANCE (object); | |
4960 return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil; | |
4961 } | |
4962 | |
4963 DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /* | |
4964 Return the window id of SUBWINDOW as a number. | |
4965 */ | |
4966 (subwindow)) | |
4967 { | |
4968 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); | |
442 | 4969 return make_int ((EMACS_INT) XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow)); |
428 | 4970 } |
4971 | |
4972 DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /* | |
4973 Resize SUBWINDOW to WIDTH x HEIGHT. | |
4974 If a value is nil that parameter is not changed. | |
4975 */ | |
4976 (subwindow, width, height)) | |
4977 { | |
4978 int neww, newh; | |
442 | 4979 Lisp_Image_Instance* ii; |
428 | 4980 |
4981 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); | |
442 | 4982 ii = XIMAGE_INSTANCE (subwindow); |
428 | 4983 |
4984 if (NILP (width)) | |
442 | 4985 neww = IMAGE_INSTANCE_WIDTH (ii); |
428 | 4986 else |
4987 neww = XINT (width); | |
4988 | |
4989 if (NILP (height)) | |
442 | 4990 newh = IMAGE_INSTANCE_HEIGHT (ii); |
428 | 4991 else |
4992 newh = XINT (height); | |
4993 | |
442 | 4994 /* The actual resizing gets done asynchronously by |
438 | 4995 update_subwindow. */ |
442 | 4996 IMAGE_INSTANCE_HEIGHT (ii) = newh; |
4997 IMAGE_INSTANCE_WIDTH (ii) = neww; | |
4998 IMAGE_INSTANCE_SIZE_CHANGED (ii) = 1; | |
428 | 4999 |
5000 return subwindow; | |
5001 } | |
5002 | |
5003 DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /* | |
5004 Generate a Map event for SUBWINDOW. | |
5005 */ | |
5006 (subwindow)) | |
5007 { | |
5008 CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); | |
5009 #if 0 | |
5010 map_subwindow (subwindow, 0, 0); | |
5011 #endif | |
5012 return subwindow; | |
5013 } | |
5014 | |
5015 | |
5016 /***************************************************************************** | |
5017 * display tables * | |
5018 *****************************************************************************/ | |
5019 | |
5020 /* Get the display tables for use currently on window W with face | |
5021 FACE. #### This will have to be redone. */ | |
5022 | |
5023 void | |
5024 get_display_tables (struct window *w, face_index findex, | |
5025 Lisp_Object *face_table, Lisp_Object *window_table) | |
5026 { | |
5027 Lisp_Object tem; | |
5028 tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex); | |
5029 if (UNBOUNDP (tem)) | |
5030 tem = Qnil; | |
5031 if (!LISTP (tem)) | |
5032 tem = noseeum_cons (tem, Qnil); | |
5033 *face_table = tem; | |
5034 tem = w->display_table; | |
5035 if (UNBOUNDP (tem)) | |
5036 tem = Qnil; | |
5037 if (!LISTP (tem)) | |
5038 tem = noseeum_cons (tem, Qnil); | |
5039 *window_table = tem; | |
5040 } | |
5041 | |
5042 Lisp_Object | |
867 | 5043 display_table_entry (Ichar ch, Lisp_Object face_table, |
428 | 5044 Lisp_Object window_table) |
5045 { | |
5046 Lisp_Object tail; | |
5047 | |
5048 /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */ | |
5049 for (tail = face_table; 1; tail = XCDR (tail)) | |
5050 { | |
5051 Lisp_Object table; | |
5052 if (NILP (tail)) | |
5053 { | |
5054 if (!NILP (window_table)) | |
5055 { | |
5056 tail = window_table; | |
5057 window_table = Qnil; | |
5058 } | |
5059 else | |
5060 return Qnil; | |
5061 } | |
5062 table = XCAR (tail); | |
5063 | |
5064 if (VECTORP (table)) | |
5065 { | |
5066 if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch])) | |
5067 return XVECTOR_DATA (table)[ch]; | |
5068 else | |
5069 continue; | |
5070 } | |
5071 else if (CHAR_TABLEP (table) | |
5072 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR) | |
5073 { | |
826 | 5074 return get_char_table (ch, table); |
428 | 5075 } |
5076 else if (CHAR_TABLEP (table) | |
5077 && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC) | |
5078 { | |
826 | 5079 Lisp_Object gotit = get_char_table (ch, table); |
428 | 5080 if (!NILP (gotit)) |
5081 return gotit; | |
5082 else | |
5083 continue; | |
5084 } | |
5085 else if (RANGE_TABLEP (table)) | |
5086 { | |
5087 Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil); | |
5088 if (!NILP (gotit)) | |
5089 return gotit; | |
5090 else | |
5091 continue; | |
5092 } | |
5093 else | |
2500 | 5094 ABORT (); |
428 | 5095 } |
5096 } | |
5097 | |
793 | 5098 /**************************************************************************** |
5099 * timeouts for animated glyphs * | |
5100 ****************************************************************************/ | |
428 | 5101 static Lisp_Object Qglyph_animated_timeout_handler; |
5102 | |
5103 DEFUN ("glyph-animated-timeout-handler", Fglyph_animated_timeout_handler, 1, 1, 0, /* | |
5104 Callback function for updating animated images. | |
5105 Don't use this. | |
5106 */ | |
5107 (arg)) | |
5108 { | |
5109 CHECK_WEAK_LIST (arg); | |
5110 | |
5111 if (!NILP (XWEAK_LIST_LIST (arg)) && !NILP (XCAR (XWEAK_LIST_LIST (arg)))) | |
5112 { | |
5113 Lisp_Object value = XCAR (XWEAK_LIST_LIST (arg)); | |
440 | 5114 |
428 | 5115 if (IMAGE_INSTANCEP (value)) |
5116 { | |
440 | 5117 Lisp_Image_Instance* ii = XIMAGE_INSTANCE (value); |
428 | 5118 |
5119 if (COLOR_PIXMAP_IMAGE_INSTANCEP (value) | |
5120 && | |
5121 IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii) > 1 | |
5122 && | |
5123 !disable_animated_pixmaps) | |
5124 { | |
5125 /* Increment the index of the image slice we are currently | |
5126 viewing. */ | |
4252 | 5127 IMAGE_INSTANCE_PIXMAP_SLICE (ii) = |
428 | 5128 (IMAGE_INSTANCE_PIXMAP_SLICE (ii) + 1) |
5129 % IMAGE_INSTANCE_PIXMAP_MAXSLICE (ii); | |
5130 /* We might need to kick redisplay at this point - but we | |
5131 also might not. */ | |
440 | 5132 MARK_DEVICE_FRAMES_GLYPHS_CHANGED |
442 | 5133 (XDEVICE (image_instance_device (value))); |
5134 /* Cascade dirtiness so that we can have an animated glyph in a layout | |
5135 for instance. */ | |
5136 set_image_instance_dirty_p (value, 1); | |
428 | 5137 } |
5138 } | |
5139 } | |
5140 return Qnil; | |
5141 } | |
5142 | |
793 | 5143 Lisp_Object |
5144 add_glyph_animated_timeout (EMACS_INT tickms, Lisp_Object image) | |
428 | 5145 { |
5146 Lisp_Object ret = Qnil; | |
5147 | |
5148 if (tickms > 0 && IMAGE_INSTANCEP (image)) | |
5149 { | |
5150 double ms = ((double)tickms) / 1000.0; | |
5151 struct gcpro gcpro1; | |
5152 Lisp_Object holder = make_weak_list (WEAK_LIST_SIMPLE); | |
5153 | |
5154 GCPRO1 (holder); | |
5155 XWEAK_LIST_LIST (holder) = Fcons (image, Qnil); | |
5156 | |
5157 ret = Fadd_timeout (make_float (ms), | |
5158 Qglyph_animated_timeout_handler, | |
5159 holder, make_float (ms)); | |
5160 | |
5161 UNGCPRO; | |
5162 } | |
5163 return ret; | |
5164 } | |
5165 | |
793 | 5166 void |
5167 disable_glyph_animated_timeout (int i) | |
5168 { | |
5169 Fdisable_timeout (make_int (i)); | |
428 | 5170 } |
5171 | |
5172 | |
5173 /***************************************************************************** | |
5174 * initialization * | |
5175 *****************************************************************************/ | |
5176 | |
5177 void | |
5178 syms_of_glyphs (void) | |
5179 { | |
442 | 5180 INIT_LRECORD_IMPLEMENTATION (glyph); |
5181 INIT_LRECORD_IMPLEMENTATION (image_instance); | |
5182 | |
428 | 5183 /* image instantiators */ |
5184 | |
5185 DEFSUBR (Fimage_instantiator_format_list); | |
5186 DEFSUBR (Fvalid_image_instantiator_format_p); | |
5187 DEFSUBR (Fset_console_type_image_conversion_list); | |
5188 DEFSUBR (Fconsole_type_image_conversion_list); | |
5189 | |
442 | 5190 DEFKEYWORD (Q_file); |
5191 DEFKEYWORD (Q_data); | |
5192 DEFKEYWORD (Q_face); | |
5193 DEFKEYWORD (Q_pixel_height); | |
5194 DEFKEYWORD (Q_pixel_width); | |
428 | 5195 |
5196 #ifdef HAVE_XPM | |
442 | 5197 DEFKEYWORD (Q_color_symbols); |
428 | 5198 #endif |
5199 #ifdef HAVE_WINDOW_SYSTEM | |
442 | 5200 DEFKEYWORD (Q_mask_file); |
5201 DEFKEYWORD (Q_mask_data); | |
5202 DEFKEYWORD (Q_hotspot_x); | |
5203 DEFKEYWORD (Q_hotspot_y); | |
5204 DEFKEYWORD (Q_foreground); | |
5205 DEFKEYWORD (Q_background); | |
428 | 5206 #endif |
5207 /* image specifiers */ | |
5208 | |
5209 DEFSUBR (Fimage_specifier_p); | |
5210 /* Qimage in general.c */ | |
5211 | |
5212 /* image instances */ | |
5213 | |
563 | 5214 DEFSYMBOL_MULTIWORD_PREDICATE (Qimage_instancep); |
428 | 5215 |
442 | 5216 DEFSYMBOL (Qnothing_image_instance_p); |
5217 DEFSYMBOL (Qtext_image_instance_p); | |
5218 DEFSYMBOL (Qmono_pixmap_image_instance_p); | |
5219 DEFSYMBOL (Qcolor_pixmap_image_instance_p); | |
5220 DEFSYMBOL (Qpointer_image_instance_p); | |
5221 DEFSYMBOL (Qwidget_image_instance_p); | |
5222 DEFSYMBOL (Qsubwindow_image_instance_p); | |
428 | 5223 |
5224 DEFSUBR (Fmake_image_instance); | |
5225 DEFSUBR (Fimage_instance_p); | |
5226 DEFSUBR (Fimage_instance_type); | |
5227 DEFSUBR (Fvalid_image_instance_type_p); | |
5228 DEFSUBR (Fimage_instance_type_list); | |
5229 DEFSUBR (Fimage_instance_name); | |
442 | 5230 DEFSUBR (Fimage_instance_domain); |
872 | 5231 DEFSUBR (Fimage_instance_instantiator); |
428 | 5232 DEFSUBR (Fimage_instance_string); |
5233 DEFSUBR (Fimage_instance_file_name); | |
5234 DEFSUBR (Fimage_instance_mask_file_name); | |
5235 DEFSUBR (Fimage_instance_depth); | |
5236 DEFSUBR (Fimage_instance_height); | |
5237 DEFSUBR (Fimage_instance_width); | |
5238 DEFSUBR (Fimage_instance_hotspot_x); | |
5239 DEFSUBR (Fimage_instance_hotspot_y); | |
5240 DEFSUBR (Fimage_instance_foreground); | |
5241 DEFSUBR (Fimage_instance_background); | |
5242 DEFSUBR (Fimage_instance_property); | |
5243 DEFSUBR (Fcolorize_image_instance); | |
5244 /* subwindows */ | |
5245 DEFSUBR (Fsubwindowp); | |
5246 DEFSUBR (Fimage_instance_subwindow_id); | |
5247 DEFSUBR (Fresize_subwindow); | |
5248 DEFSUBR (Fforce_subwindow_map); | |
5249 | |
5250 /* Qnothing defined as part of the "nothing" image-instantiator | |
5251 type. */ | |
5252 /* Qtext defined in general.c */ | |
442 | 5253 DEFSYMBOL (Qmono_pixmap); |
5254 DEFSYMBOL (Qcolor_pixmap); | |
428 | 5255 /* Qpointer defined in general.c */ |
5256 | |
5257 /* glyphs */ | |
5258 | |
442 | 5259 DEFSYMBOL (Qglyphp); |
5260 DEFSYMBOL (Qcontrib_p); | |
5261 DEFSYMBOL (Qbaseline); | |
5262 | |
5263 DEFSYMBOL (Qbuffer_glyph_p); | |
5264 DEFSYMBOL (Qpointer_glyph_p); | |
5265 DEFSYMBOL (Qicon_glyph_p); | |
5266 | |
5267 DEFSYMBOL (Qconst_glyph_variable); | |
428 | 5268 |
5269 DEFSUBR (Fglyph_type); | |
5270 DEFSUBR (Fvalid_glyph_type_p); | |
5271 DEFSUBR (Fglyph_type_list); | |
5272 DEFSUBR (Fglyphp); | |
5273 DEFSUBR (Fmake_glyph_internal); | |
5274 DEFSUBR (Fglyph_width); | |
5275 DEFSUBR (Fglyph_ascent); | |
5276 DEFSUBR (Fglyph_descent); | |
5277 DEFSUBR (Fglyph_height); | |
442 | 5278 DEFSUBR (Fset_instantiator_property); |
428 | 5279 |
5280 /* Qbuffer defined in general.c. */ | |
5281 /* Qpointer defined above */ | |
5282 | |
1204 | 5283 /* Unfortunately, timeout handlers must be lisp functions. This is |
428 | 5284 for animated glyphs. */ |
442 | 5285 DEFSYMBOL (Qglyph_animated_timeout_handler); |
428 | 5286 DEFSUBR (Fglyph_animated_timeout_handler); |
5287 | |
5288 /* Errors */ | |
563 | 5289 DEFERROR_STANDARD (Qimage_conversion_error, Qconversion_error); |
428 | 5290 } |
5291 | |
5292 void | |
5293 specifier_type_create_image (void) | |
5294 { | |
5295 /* image specifiers */ | |
5296 | |
5297 INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep"); | |
5298 | |
5299 SPECIFIER_HAS_METHOD (image, create); | |
5300 SPECIFIER_HAS_METHOD (image, mark); | |
5301 SPECIFIER_HAS_METHOD (image, instantiate); | |
5302 SPECIFIER_HAS_METHOD (image, validate); | |
5303 SPECIFIER_HAS_METHOD (image, after_change); | |
5304 SPECIFIER_HAS_METHOD (image, going_to_add); | |
434 | 5305 SPECIFIER_HAS_METHOD (image, copy_instantiator); |
428 | 5306 } |
5307 | |
5308 void | |
5309 reinit_specifier_type_create_image (void) | |
5310 { | |
5311 REINITIALIZE_SPECIFIER_TYPE (image); | |
5312 } | |
5313 | |
5314 | |
1204 | 5315 static const struct memory_description iike_description_1[] = { |
440 | 5316 { XD_LISP_OBJECT, offsetof (ii_keyword_entry, keyword) }, |
428 | 5317 { XD_END } |
5318 }; | |
5319 | |
1204 | 5320 static const struct sized_memory_description iike_description = { |
440 | 5321 sizeof (ii_keyword_entry), |
428 | 5322 iike_description_1 |
5323 }; | |
5324 | |
1204 | 5325 static const struct memory_description iiked_description_1[] = { |
440 | 5326 XD_DYNARR_DESC (ii_keyword_entry_dynarr, &iike_description), |
428 | 5327 { XD_END } |
5328 }; | |
5329 | |
1204 | 5330 static const struct sized_memory_description iiked_description = { |
440 | 5331 sizeof (ii_keyword_entry_dynarr), |
428 | 5332 iiked_description_1 |
5333 }; | |
5334 | |
1204 | 5335 static const struct memory_description iife_description_1[] = { |
440 | 5336 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, symbol) }, |
5337 { XD_LISP_OBJECT, offsetof (image_instantiator_format_entry, device) }, | |
2551 | 5338 { XD_BLOCK_PTR, offsetof (image_instantiator_format_entry, meths), 1, |
5339 { &iim_description } }, | |
428 | 5340 { XD_END } |
5341 }; | |
5342 | |
1204 | 5343 static const struct sized_memory_description iife_description = { |
440 | 5344 sizeof (image_instantiator_format_entry), |
428 | 5345 iife_description_1 |
5346 }; | |
5347 | |
1204 | 5348 static const struct memory_description iifed_description_1[] = { |
440 | 5349 XD_DYNARR_DESC (image_instantiator_format_entry_dynarr, &iife_description), |
428 | 5350 { XD_END } |
5351 }; | |
5352 | |
1204 | 5353 static const struct sized_memory_description iifed_description = { |
440 | 5354 sizeof (image_instantiator_format_entry_dynarr), |
428 | 5355 iifed_description_1 |
5356 }; | |
5357 | |
1204 | 5358 static const struct memory_description iim_description_1[] = { |
440 | 5359 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, symbol) }, |
5360 { XD_LISP_OBJECT, offsetof (struct image_instantiator_methods, device) }, | |
2551 | 5361 { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, keywords), 1, |
5362 { &iiked_description } }, | |
5363 { XD_BLOCK_PTR, offsetof (struct image_instantiator_methods, consoles), 1, | |
5364 { &cted_description } }, | |
428 | 5365 { XD_END } |
5366 }; | |
5367 | |
1204 | 5368 const struct sized_memory_description iim_description = { |
442 | 5369 sizeof (struct image_instantiator_methods), |
428 | 5370 iim_description_1 |
5371 }; | |
5372 | |
5373 void | |
5374 image_instantiator_format_create (void) | |
5375 { | |
5376 /* image instantiators */ | |
5377 | |
5378 the_image_instantiator_format_entry_dynarr = | |
5379 Dynarr_new (image_instantiator_format_entry); | |
5380 | |
5381 Vimage_instantiator_format_list = Qnil; | |
5382 staticpro (&Vimage_instantiator_format_list); | |
5383 | |
2367 | 5384 dump_add_root_block_ptr (&the_image_instantiator_format_entry_dynarr, &iifed_description); |
428 | 5385 |
5386 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing"); | |
5387 | |
5388 IIFORMAT_HAS_METHOD (nothing, possible_dest_types); | |
5389 IIFORMAT_HAS_METHOD (nothing, instantiate); | |
5390 | |
5391 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit"); | |
5392 | |
5393 IIFORMAT_HAS_METHOD (inherit, validate); | |
5394 IIFORMAT_HAS_METHOD (inherit, normalize); | |
5395 IIFORMAT_HAS_METHOD (inherit, possible_dest_types); | |
5396 IIFORMAT_HAS_METHOD (inherit, instantiate); | |
5397 | |
5398 IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face); | |
5399 | |
5400 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string"); | |
5401 | |
5402 IIFORMAT_HAS_METHOD (string, validate); | |
442 | 5403 IIFORMAT_HAS_SHARED_METHOD (string, governing_domain, subwindow); |
428 | 5404 IIFORMAT_HAS_METHOD (string, possible_dest_types); |
5405 IIFORMAT_HAS_METHOD (string, instantiate); | |
5406 | |
5407 IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string); | |
5408 /* Do this so we can set strings. */ | |
442 | 5409 /* #### Andy, what is this? This is a bogus format and should not be |
5410 visible to the user. */ | |
428 | 5411 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (text, "text"); |
442 | 5412 IIFORMAT_HAS_METHOD (text, update); |
438 | 5413 IIFORMAT_HAS_METHOD (text, query_geometry); |
428 | 5414 |
5415 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string"); | |
5416 | |
5417 IIFORMAT_HAS_METHOD (formatted_string, validate); | |
5418 IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types); | |
5419 IIFORMAT_HAS_METHOD (formatted_string, instantiate); | |
5420 IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string); | |
5421 | |
442 | 5422 /* Do this so pointers have geometry. */ |
5423 /* #### Andy, what is this? This is a bogus format and should not be | |
5424 visible to the user. */ | |
5425 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (pointer, "pointer"); | |
5426 IIFORMAT_HAS_SHARED_METHOD (pointer, query_geometry, subwindow); | |
5427 | |
428 | 5428 /* subwindows */ |
5429 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow"); | |
5430 IIFORMAT_HAS_METHOD (subwindow, possible_dest_types); | |
442 | 5431 IIFORMAT_HAS_METHOD (subwindow, governing_domain); |
428 | 5432 IIFORMAT_HAS_METHOD (subwindow, instantiate); |
442 | 5433 IIFORMAT_HAS_METHOD (subwindow, query_geometry); |
428 | 5434 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int); |
5435 IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int); | |
5436 | |
5437 #ifdef HAVE_WINDOW_SYSTEM | |
5438 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm"); | |
5439 | |
5440 IIFORMAT_HAS_METHOD (xbm, validate); | |
5441 IIFORMAT_HAS_METHOD (xbm, normalize); | |
5442 IIFORMAT_HAS_METHOD (xbm, possible_dest_types); | |
5443 | |
5444 IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline); | |
5445 IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string); | |
5446 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline); | |
5447 IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string); | |
5448 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int); | |
5449 IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int); | |
5450 IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string); | |
5451 IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string); | |
5452 #endif /* HAVE_WINDOW_SYSTEM */ | |
5453 | |
5454 #ifdef HAVE_XFACE | |
5455 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface"); | |
5456 | |
5457 IIFORMAT_HAS_METHOD (xface, validate); | |
5458 IIFORMAT_HAS_METHOD (xface, normalize); | |
5459 IIFORMAT_HAS_METHOD (xface, possible_dest_types); | |
5460 | |
5461 IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string); | |
5462 IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string); | |
2959 | 5463 IIFORMAT_VALID_KEYWORD (xface, Q_mask_data, check_valid_xbm_inline); |
5464 IIFORMAT_VALID_KEYWORD (xface, Q_mask_file, check_valid_string); | |
428 | 5465 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int); |
5466 IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int); | |
5467 IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string); | |
5468 IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string); | |
5469 #endif | |
5470 | |
5471 #ifdef HAVE_XPM | |
5472 INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm"); | |
5473 | |
5474 IIFORMAT_HAS_METHOD (xpm, validate); | |
5475 IIFORMAT_HAS_METHOD (xpm, normalize); | |
5476 IIFORMAT_HAS_METHOD (xpm, possible_dest_types); | |
5477 | |
5478 IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string); | |
5479 IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string); | |
5480 IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols); | |
5481 #endif /* HAVE_XPM */ | |
5482 } | |
5483 | |
5484 void | |
5485 reinit_vars_of_glyphs (void) | |
5486 { | |
3092 | 5487 #ifndef NEW_GC |
428 | 5488 the_expose_ignore_blocktype = |
5489 Blocktype_new (struct expose_ignore_blocktype); | |
3092 | 5490 #endif /* not NEW_GC */ |
428 | 5491 |
5492 hold_ignored_expose_registration = 0; | |
5493 } | |
5494 | |
5495 | |
5496 void | |
5497 vars_of_glyphs (void) | |
5498 { | |
5499 Vthe_nothing_vector = vector1 (Qnothing); | |
5500 staticpro (&Vthe_nothing_vector); | |
5501 | |
5502 /* image instances */ | |
5503 | |
440 | 5504 Vimage_instance_type_list = Fcons (Qnothing, |
5505 list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, | |
428 | 5506 Qpointer, Qsubwindow, Qwidget)); |
5507 staticpro (&Vimage_instance_type_list); | |
5508 | |
5509 /* glyphs */ | |
5510 | |
5511 Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon); | |
5512 staticpro (&Vglyph_type_list); | |
5513 | |
5514 #ifdef HAVE_WINDOW_SYSTEM | |
5515 Fprovide (Qxbm); | |
5516 #endif | |
5517 #ifdef HAVE_XPM | |
5518 Fprovide (Qxpm); | |
5519 | |
5520 DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /* | |
5521 Definitions of logical color-names used when reading XPM files. | |
5522 Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE). | |
5523 The COLOR-NAME should be a string, which is the name of the color to define; | |
5524 the FORM should evaluate to a `color' specifier object, or a string to be | |
5525 passed to `make-color-instance'. If a loaded XPM file references a symbolic | |
5526 color called COLOR-NAME, it will display as the computed color instead. | |
5527 | |
5528 The default value of this variable defines the logical color names | |
5529 \"foreground\" and \"background\" to be the colors of the `default' face. | |
5530 */ ); | |
5531 Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */ | |
5532 #endif /* HAVE_XPM */ | |
5533 #ifdef HAVE_XFACE | |
5534 Fprovide (Qxface); | |
5535 #endif | |
5536 | |
5537 DEFVAR_BOOL ("disable-animated-pixmaps", &disable_animated_pixmaps /* | |
5538 Whether animated pixmaps should be animated. | |
5539 Default is t. | |
5540 */); | |
5541 disable_animated_pixmaps = 0; | |
5542 } | |
5543 | |
5544 void | |
5545 specifier_vars_of_glyphs (void) | |
5546 { | |
5547 /* #### Can we GC here? The set_specifier_* calls definitely need */ | |
5548 /* protection. */ | |
5549 /* display tables */ | |
5550 | |
5551 DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /* | |
5552 *The display table currently in use. | |
5553 This is a specifier; use `set-specifier' to change it. | |
442 | 5554 |
5555 Display tables are used to control how characters are displayed. Each | |
5556 time that redisplay processes a character, it is looked up in all the | |
5557 display tables that apply (obtained by calling `specifier-instance' on | |
5558 `current-display-table' and any overriding display tables specified in | |
5559 currently active faces). The first entry found that matches the | |
5560 character determines how the character is displayed. If there is no | |
5561 matching entry, the default display method is used. (Non-control | |
5562 characters are displayed as themselves and control characters are | |
5563 displayed according to the buffer-local variable `ctl-arrow'. Control | |
5564 characters are further affected by `control-arrow-glyph' and | |
5565 `octal-escape-glyph'.) | |
5566 | |
5567 Each instantiator in this specifier and the display-table specifiers | |
5568 in faces is a display table or a list of such tables. If a list, each | |
5569 table will be searched in turn for an entry matching a particular | |
5570 character. Each display table is one of | |
5571 | |
5572 -- a vector, specifying values for characters starting at 0 | |
5573 -- a char table, either of type `char' or `generic' | |
5574 -- a range table | |
5575 | |
5576 Each entry in a display table should be one of | |
5577 | |
5578 -- nil (this entry is ignored and the search continues) | |
5579 -- a character (use this character; if it happens to be the same as | |
5580 the original character, default processing happens, otherwise | |
5581 redisplay attempts to display this character directly; | |
5582 #### At some point recursive display-table lookup will be | |
5583 implemented.) | |
5584 -- a string (display each character in the string directly; | |
5585 #### At some point recursive display-table lookup will be | |
5586 implemented.) | |
5587 -- a glyph (display the glyph; | |
5588 #### At some point recursive display-table lookup will be | |
5589 implemented when a string glyph is being processed.) | |
5590 -- a cons of the form (format "STRING") where STRING is a printf-like | |
5591 spec used to process the character. #### Unfortunately no | |
5592 formatting directives other than %% are implemented. | |
5593 -- a vector (each element of the vector is processed recursively; | |
5594 in such a case, nil elements in the vector are simply ignored) | |
5595 | |
5596 #### At some point in the near future, display tables are likely to | |
5597 be expanded to include other features, such as referencing characters | |
5598 in particular fonts and allowing the character search to continue | |
5599 all the way up the chain of specifier instantiators. These features | |
5600 are necessary to properly display Unicode characters. | |
428 | 5601 */ ); |
5602 Vcurrent_display_table = Fmake_specifier (Qdisplay_table); | |
5603 set_specifier_fallback (Vcurrent_display_table, | |
5604 list1 (Fcons (Qnil, Qnil))); | |
5605 set_specifier_caching (Vcurrent_display_table, | |
438 | 5606 offsetof (struct window, display_table), |
428 | 5607 some_window_value_changed, |
444 | 5608 0, 0, 0); |
428 | 5609 } |
5610 | |
5611 void | |
5612 complex_vars_of_glyphs (void) | |
5613 { | |
5614 /* Partially initialized in glyphs-x.c, glyphs.el */ | |
5615 DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /* | |
5616 What to display at the end of truncated lines. | |
5617 */ ); | |
5618 Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
5619 | |
5620 /* Partially initialized in glyphs-x.c, glyphs.el */ | |
5621 DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /* | |
5622 What to display at the end of wrapped lines. | |
5623 */ ); | |
5624 Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
5625 | |
2367 | 5626 /* The octal-escape glyph, control-arrow-glyph and |
5627 invisible-text-glyph are completely initialized in glyphs.el */ | |
5628 | |
5629 DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /* | |
5630 What to prefix character codes displayed in octal with. | |
5631 */); | |
5632 Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
5633 | |
5634 DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /* | |
5635 What to use as an arrow for control characters. | |
5636 */); | |
5637 Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER, | |
5638 redisplay_glyph_changed); | |
5639 | |
5640 DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /* | |
5641 What to use to indicate the presence of invisible text. | |
5642 This is the glyph that is displayed when an ellipsis is called for | |
5643 \(see `selective-display-ellipses' and `buffer-invisibility-spec'). | |
5644 Normally this is three dots ("..."). | |
5645 */); | |
5646 Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER, | |
5647 redisplay_glyph_changed); | |
5648 | |
5649 /* Partially initialized in glyphs.el */ | |
5650 DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /* | |
5651 What to display at the beginning of horizontally scrolled lines. | |
5652 */); | |
5653 Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); | |
5654 | |
428 | 5655 /* Partially initialized in glyphs-x.c, glyphs.el */ |
5656 DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /* | |
5657 The glyph used to display the XEmacs logo at startup. | |
5658 */ ); | |
5659 Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0); | |
5660 } |