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