Mercurial > hg > xemacs-beta
annotate src/extents.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 | 8b63e21b0436 |
| children | e813cf16c015 |
| rev | line source |
|---|---|
| 428 | 1 /* Copyright (c) 1994, 1995 Free Software Foundation, Inc. |
| 2 Copyright (c) 1995 Sun Microsystems, Inc. | |
| 2506 | 3 Copyright (c) 1995, 1996, 2000, 2002, 2003, 2004, 2005 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not in FSF. */ | |
| 23 | |
| 24 /* This file has been Mule-ized. */ | |
| 25 | |
| 26 /* Written by Ben Wing <ben@xemacs.org>. | |
| 27 | |
| 28 [Originally written by some people at Lucid. | |
| 29 Hacked on by jwz. | |
| 30 Start/end-open stuff added by John Rose (john.rose@eng.sun.com). | |
| 31 Rewritten from scratch by Ben Wing, December 1994.] */ | |
| 32 | |
| 33 /* Commentary: | |
| 34 | |
| 35 Extents are regions over a buffer, with a start and an end position | |
| 36 denoting the region of the buffer included in the extent. In | |
| 37 addition, either end can be closed or open, meaning that the endpoint | |
| 38 is or is not logically included in the extent. Insertion of a character | |
| 39 at a closed endpoint causes the character to go inside the extent; | |
| 40 insertion at an open endpoint causes the character to go outside. | |
| 41 | |
| 42 Extent endpoints are stored using memory indices (see insdel.c), | |
| 43 to minimize the amount of adjusting that needs to be done when | |
| 44 characters are inserted or deleted. | |
| 45 | |
| 46 (Formerly, extent endpoints at the gap could be either before or | |
| 47 after the gap, depending on the open/closedness of the endpoint. | |
| 48 The intent of this was to make it so that insertions would | |
| 49 automatically go inside or out of extents as necessary with no | |
| 50 further work needing to be done. It didn't work out that way, | |
| 51 however, and just ended up complexifying and buggifying all the | |
| 52 rest of the code.) | |
| 53 | |
| 54 Extents are compared using memory indices. There are two orderings | |
| 55 for extents and both orders are kept current at all times. The normal | |
| 56 or "display" order is as follows: | |
| 57 | |
| 58 Extent A is "less than" extent B, that is, earlier in the display order, | |
| 59 if: A-start < B-start, | |
| 60 or if: A-start = B-start, and A-end > B-end | |
| 61 | |
| 62 So if two extents begin at the same position, the larger of them is the | |
| 63 earlier one in the display order (EXTENT_LESS is true). | |
| 64 | |
| 65 For the e-order, the same thing holds: Extent A is "less than" extent B | |
| 66 in e-order, that is, later in the buffer, | |
| 67 if: A-end < B-end, | |
| 68 or if: A-end = B-end, and A-start > B-start | |
| 69 | |
| 70 So if two extents end at the same position, the smaller of them is the | |
| 71 earlier one in the e-order (EXTENT_E_LESS is true). | |
| 72 | |
| 73 The display order and the e-order are complementary orders: any | |
| 74 theorem about the display order also applies to the e-order if you | |
| 75 swap all occurrences of "display order" and "e-order", "less than" | |
| 76 and "greater than", and "extent start" and "extent end". | |
| 77 | |
| 78 Extents can be zero-length, and will end up that way if their endpoints | |
| 79 are explicitly set that way or if their detachable property is nil | |
| 80 and all the text in the extent is deleted. (The exception is open-open | |
| 81 zero-length extents, which are barred from existing because there is | |
| 82 no sensible way to define their properties. Deletion of the text in | |
| 83 an open-open extent causes it to be converted into a closed-open | |
| 84 extent.) Zero-length extents are primarily used to represent | |
| 85 annotations, and behave as follows: | |
| 86 | |
| 87 1) Insertion at the position of a zero-length extent expands the extent | |
| 88 if both endpoints are closed; goes after the extent if it is closed-open; | |
| 89 and goes before the extent if it is open-closed. | |
| 90 | |
| 91 2) Deletion of a character on a side of a zero-length extent whose | |
| 92 corresponding endpoint is closed causes the extent to be detached if | |
| 93 it is detachable; if the extent is not detachable or the corresponding | |
| 94 endpoint is open, the extent remains in the buffer, moving as necessary. | |
| 95 | |
| 96 Note that closed-open, non-detachable zero-length extents behave exactly | |
| 97 like markers and that open-closed, non-detachable zero-length extents | |
| 98 behave like the "point-type" marker in Mule. | |
| 99 | |
| 100 | |
| 101 #### The following information is wrong in places. | |
| 102 | |
| 103 More about the different orders: | |
| 104 -------------------------------- | |
| 105 | |
| 106 The extents in a buffer are ordered by "display order" because that | |
| 107 is that order that the redisplay mechanism needs to process them in. | |
| 108 The e-order is an auxiliary ordering used to facilitate operations | |
| 109 over extents. The operations that can be performed on the ordered | |
| 110 list of extents in a buffer are | |
| 111 | |
| 112 1) Locate where an extent would go if inserted into the list. | |
| 113 2) Insert an extent into the list. | |
| 114 3) Remove an extent from the list. | |
| 115 4) Map over all the extents that overlap a range. | |
| 116 | |
| 117 (4) requires being able to determine the first and last extents | |
| 118 that overlap a range. | |
| 119 | |
| 120 NOTE: "overlap" is used as follows: | |
| 121 | |
| 122 -- two ranges overlap if they have at least one point in common. | |
| 123 Whether the endpoints are open or closed makes a difference here. | |
| 124 -- a point overlaps a range if the point is contained within the | |
| 125 range; this is equivalent to treating a point P as the range | |
| 126 [P, P]. | |
| 127 -- In the case of an *extent* overlapping a point or range, the | |
| 128 extent is normally treated as having closed endpoints. This | |
| 129 applies consistently in the discussion of stacks of extents | |
| 130 and such below. Note that this definition of overlap is not | |
| 131 necessarily consistent with the extents that `map-extents' | |
| 132 maps over, since `map-extents' sometimes pays attention to | |
| 133 whether the endpoints of an extents are open or closed. | |
| 134 But for our purposes, it greatly simplifies things to treat | |
| 135 all extents as having closed endpoints. | |
| 136 | |
| 137 First, define >, <, <=, etc. as applied to extents to mean | |
| 138 comparison according to the display order. Comparison between an | |
| 139 extent E and an index I means comparison between E and the range | |
| 140 [I, I]. | |
| 141 Also define e>, e<, e<=, etc. to mean comparison according to the | |
| 142 e-order. | |
| 143 For any range R, define R(0) to be the starting index of the range | |
| 144 and R(1) to be the ending index of the range. | |
| 145 For any extent E, define E(next) to be the extent directly following | |
| 146 E, and E(prev) to be the extent directly preceding E. Assume | |
| 147 E(next) and E(prev) can be determined from E in constant time. | |
| 148 (This is because we store the extent list as a doubly linked | |
| 149 list.) | |
| 150 Similarly, define E(e-next) and E(e-prev) to be the extents | |
| 151 directly following and preceding E in the e-order. | |
| 152 | |
| 153 Now: | |
| 154 | |
| 155 Let R be a range. | |
| 156 Let F be the first extent overlapping R. | |
| 157 Let L be the last extent overlapping R. | |
| 158 | |
| 159 Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next). | |
| 160 | |
| 161 This follows easily from the definition of display order. The | |
| 162 basic reason that this theorem applies is that the display order | |
| 163 sorts by increasing starting index. | |
| 164 | |
| 165 Therefore, we can determine L just by looking at where we would | |
| 166 insert R(1) into the list, and if we know F and are moving forward | |
| 167 over extents, we can easily determine when we've hit L by comparing | |
| 168 the extent we're at to R(1). | |
| 169 | |
| 170 Theorem 2: F(e-prev) e< [1, R(0)] e<= F. | |
| 171 | |
| 172 This is the analog of Theorem 1, and applies because the e-order | |
| 173 sorts by increasing ending index. | |
| 174 | |
| 175 Therefore, F can be found in the same amount of time as operation (1), | |
| 176 i.e. the time that it takes to locate where an extent would go if | |
| 177 inserted into the e-order list. | |
| 178 | |
| 179 If the lists were stored as balanced binary trees, then operation (1) | |
| 180 would take logarithmic time, which is usually quite fast. However, | |
| 181 currently they're stored as simple doubly-linked lists, and instead | |
| 182 we do some caching to try to speed things up. | |
| 183 | |
| 184 Define a "stack of extents" (or "SOE") as the set of extents | |
| 185 (ordered in the display order) that overlap an index I, together with | |
| 186 the SOE's "previous" extent, which is an extent that precedes I in | |
| 187 the e-order. (Hopefully there will not be very many extents between | |
| 188 I and the previous extent.) | |
| 189 | |
| 190 Now: | |
| 191 | |
| 192 Let I be an index, let S be the stack of extents on I, let F be | |
| 193 the first extent in S, and let P be S's previous extent. | |
| 194 | |
| 195 Theorem 3: The first extent in S is the first extent that overlaps | |
| 196 any range [I, J]. | |
| 197 | |
| 198 Proof: Any extent that overlaps [I, J] but does not include I must | |
| 199 have a start index > I, and thus be greater than any extent in S. | |
| 200 | |
| 201 Therefore, finding the first extent that overlaps a range R is the | |
| 202 same as finding the first extent that overlaps R(0). | |
| 203 | |
| 204 Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the | |
| 205 first extent that overlaps I2. Then, either F2 is in S or F2 is | |
| 206 greater than any extent in S. | |
| 207 | |
| 208 Proof: If F2 does not include I then its start index is greater | |
| 209 than I and thus it is greater than any extent in S, including F. | |
| 210 Otherwise, F2 includes I and thus is in S, and thus F2 >= F. | |
| 211 | |
| 212 */ | |
| 213 | |
| 214 #include <config.h> | |
| 215 #include "lisp.h" | |
| 216 | |
| 217 #include "buffer.h" | |
| 218 #include "debug.h" | |
| 219 #include "device.h" | |
| 220 #include "elhash.h" | |
| 872 | 221 #include "extents-impl.h" |
| 428 | 222 #include "faces.h" |
| 223 #include "frame.h" | |
| 224 #include "glyphs.h" | |
| 225 #include "insdel.h" | |
| 226 #include "keymap.h" | |
| 227 #include "opaque.h" | |
| 228 #include "process.h" | |
| 1292 | 229 #include "profile.h" |
| 428 | 230 #include "redisplay.h" |
| 442 | 231 #include "gutter.h" |
| 428 | 232 |
| 233 /* ------------------------------- */ | |
| 234 /* gap array */ | |
| 235 /* ------------------------------- */ | |
| 236 | |
| 237 /* Note that this object is not extent-specific and should perhaps be | |
| 238 moved into another file. */ | |
| 239 | |
| 240 /* Holds a marker that moves as elements in the array are inserted and | |
| 241 deleted, similar to standard markers. */ | |
| 242 | |
| 243 typedef struct gap_array_marker | |
| 244 { | |
| 3092 | 245 #ifdef NEW_GC |
| 246 struct lrecord_header header; | |
| 247 #endif /* NEW_GC */ | |
| 428 | 248 int pos; |
| 249 struct gap_array_marker *next; | |
| 250 } Gap_Array_Marker; | |
| 251 | |
| 1204 | 252 |
| 428 | 253 /* Holds a "gap array", which is an array of elements with a gap located |
| 254 in it. Insertions and deletions with a high degree of locality | |
| 255 are very fast, essentially in constant time. Array positions as | |
| 256 used and returned in the gap array functions are independent of | |
| 257 the gap. */ | |
| 258 | |
| 1204 | 259 /* Layout of gap array: |
| 260 | |
| 261 <------ gap ------><---- gapsize ----><----- numels - gap ----> | |
| 262 <---------------------- numels + gapsize ---------------------> | |
| 263 | |
| 264 For marking purposes, we use two extra variables computed from | |
| 265 the others -- the offset to the data past the gap, plus the number | |
| 266 of elements in that data: | |
| 267 | |
| 268 offset_past_gap = elsize * (gap + gapsize) | |
| 269 els_past_gap = numels - gap | |
| 270 */ | |
| 271 | |
| 272 | |
| 428 | 273 typedef struct gap_array |
| 274 { | |
| 3092 | 275 #ifdef NEW_GC |
| 276 struct lrecord_header header; | |
| 277 #endif /* NEW_GC */ | |
| 1204 | 278 Elemcount gap; |
| 279 Elemcount gapsize; | |
| 280 Elemcount numels; | |
| 281 Bytecount elsize; | |
| 282 /* Redundant numbers computed from the others, for marking purposes */ | |
| 283 Bytecount offset_past_gap; | |
| 284 Elemcount els_past_gap; | |
| 428 | 285 Gap_Array_Marker *markers; |
| 1204 | 286 /* this is a stretchy array */ |
| 287 char array[1]; | |
| 428 | 288 } Gap_Array; |
| 289 | |
| 3092 | 290 #ifndef NEW_GC |
| 428 | 291 static Gap_Array_Marker *gap_array_marker_freelist; |
| 3092 | 292 #endif /* not NEW_GC */ |
| 428 | 293 |
| 294 /* Convert a "memory position" (i.e. taking the gap into account) into | |
| 295 the address of the element at (i.e. after) that position. "Memory | |
| 826 | 296 positions" are only used internally and are of type Memxpos. |
| 428 | 297 "Array positions" are used externally and are of type int. */ |
| 298 #define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel)) | |
| 299 | |
| 300 /* Number of elements currently in a gap array */ | |
| 301 #define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels) | |
| 302 | |
| 303 #define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \ | |
| 304 ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize) | |
| 305 | |
| 306 #define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \ | |
| 307 ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize) | |
| 308 | |
| 309 /* Convert an array position into the address of the element at | |
| 310 (i.e. after) that position. */ | |
| 311 #define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \ | |
| 312 GAP_ARRAY_MEMEL_ADDR(ga, pos) : \ | |
| 313 GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize)) | |
| 314 | |
| 315 /* ------------------------------- */ | |
| 316 /* extent list */ | |
| 317 /* ------------------------------- */ | |
| 318 | |
| 319 typedef struct extent_list_marker | |
| 320 { | |
| 3092 | 321 #ifdef NEW_GC |
| 322 struct lrecord_header header; | |
| 323 #endif /* NEW_GC */ | |
| 428 | 324 Gap_Array_Marker *m; |
| 325 int endp; | |
| 326 struct extent_list_marker *next; | |
| 327 } Extent_List_Marker; | |
| 328 | |
| 329 typedef struct extent_list | |
| 330 { | |
| 3092 | 331 #ifdef NEW_GC |
| 332 struct lrecord_header header; | |
| 333 #endif /* NEW_GC */ | |
| 428 | 334 Gap_Array *start; |
| 335 Gap_Array *end; | |
| 336 Extent_List_Marker *markers; | |
| 337 } Extent_List; | |
| 338 | |
| 3092 | 339 #ifndef NEW_GC |
| 428 | 340 static Extent_List_Marker *extent_list_marker_freelist; |
| 3092 | 341 #endif /* not NEW_GC */ |
| 428 | 342 |
| 343 #define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \ | |
| 344 ((extent_start (e) == (st)) && \ | |
| 345 (extent_end (e) > (nd)))) | |
| 346 | |
| 347 #define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \ | |
| 348 (extent_end (e) == (nd))) | |
| 349 | |
| 350 #define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \ | |
| 351 ((extent_start (e) == (st)) && \ | |
| 352 (extent_end (e) >= (nd)))) | |
| 353 | |
| 354 /* Is extent E1 less than extent E2 in the display order? */ | |
| 355 #define EXTENT_LESS(e1,e2) \ | |
| 356 EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2)) | |
| 357 | |
| 358 /* Is extent E1 equal to extent E2? */ | |
| 359 #define EXTENT_EQUAL(e1,e2) \ | |
| 360 EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) | |
| 361 | |
| 362 /* Is extent E1 less than or equal to extent E2 in the display order? */ | |
| 363 #define EXTENT_LESS_EQUAL(e1,e2) \ | |
| 364 EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) | |
| 365 | |
| 366 #define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \ | |
| 367 ((extent_end (e) == (nd)) && \ | |
| 368 (extent_start (e) > (st)))) | |
| 369 | |
| 370 #define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \ | |
| 371 ((extent_end (e) == (nd)) && \ | |
| 372 (extent_start (e) >= (st)))) | |
| 373 | |
| 374 /* Is extent E1 less than extent E2 in the e-order? */ | |
| 375 #define EXTENT_E_LESS(e1,e2) \ | |
| 376 EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2)) | |
| 377 | |
| 378 /* Is extent E1 less than or equal to extent E2 in the e-order? */ | |
| 379 #define EXTENT_E_LESS_EQUAL(e1,e2) \ | |
| 380 EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) | |
| 381 | |
| 382 #define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos)) | |
| 383 | |
| 384 /* ------------------------------- */ | |
| 385 /* auxiliary extent structure */ | |
| 386 /* ------------------------------- */ | |
| 387 | |
| 388 struct extent_auxiliary extent_auxiliary_defaults; | |
| 389 | |
| 390 /* ------------------------------- */ | |
| 391 /* buffer-extent primitives */ | |
| 392 /* ------------------------------- */ | |
| 393 | |
| 394 typedef struct stack_of_extents | |
| 395 { | |
| 3092 | 396 #ifdef NEW_GC |
| 397 struct lrecord_header header; | |
| 398 #endif /* NEW_GC */ | |
| 428 | 399 Extent_List *extents; |
| 826 | 400 Memxpos pos; /* Position of stack of extents. EXTENTS is the list of |
| 428 | 401 all extents that overlap this position. This position |
| 402 can be -1 if the stack of extents is invalid (this | |
| 403 happens when a buffer is first created or a string's | |
| 404 stack of extents is created [a string's stack of extents | |
| 405 is nuked when a GC occurs, to conserve memory]). */ | |
| 406 } Stack_Of_Extents; | |
| 407 | |
| 408 /* ------------------------------- */ | |
| 409 /* map-extents */ | |
| 410 /* ------------------------------- */ | |
| 411 | |
| 826 | 412 typedef int (*map_extents_fun) (EXTENT extent, void *arg); |
| 413 | |
| 428 | 414 typedef int Endpoint_Index; |
| 415 | |
| 826 | 416 #define memxpos_to_startind(x, start_open) \ |
| 428 | 417 ((Endpoint_Index) (((x) << 1) + !!(start_open))) |
| 826 | 418 #define memxpos_to_endind(x, end_open) \ |
| 428 | 419 ((Endpoint_Index) (((x) << 1) - !!(end_open))) |
| 420 | |
| 421 /* ------------------------------- */ | |
| 422 /* buffer-or-string primitives */ | |
| 423 /* ------------------------------- */ | |
| 424 | |
| 826 | 425 /* Similar for Bytebpos's and start/end indices. */ |
| 426 | |
| 427 #define buffer_or_string_bytexpos_to_startind(obj, ind, start_open) \ | |
| 428 memxpos_to_startind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \ | |
| 428 | 429 start_open) |
| 430 | |
| 826 | 431 #define buffer_or_string_bytexpos_to_endind(obj, ind, end_open) \ |
| 432 memxpos_to_endind (buffer_or_string_bytexpos_to_memxpos (obj, ind), \ | |
| 428 | 433 end_open) |
| 434 | |
| 435 /* ------------------------------- */ | |
| 436 /* Lisp-level functions */ | |
| 437 /* ------------------------------- */ | |
| 438 | |
| 439 /* flags for decode_extent() */ | |
| 440 #define DE_MUST_HAVE_BUFFER 1 | |
| 441 #define DE_MUST_BE_ATTACHED 2 | |
| 442 | |
| 443 Lisp_Object Vlast_highlighted_extent; | |
| 1292 | 444 |
| 445 Lisp_Object QSin_map_extents_internal; | |
| 446 | |
| 458 | 447 Fixnum mouse_highlight_priority; |
| 428 | 448 |
| 449 Lisp_Object Qextentp; | |
| 450 Lisp_Object Qextent_live_p; | |
| 451 | |
| 452 Lisp_Object Qall_extents_closed; | |
| 453 Lisp_Object Qall_extents_open; | |
| 454 Lisp_Object Qall_extents_closed_open; | |
| 455 Lisp_Object Qall_extents_open_closed; | |
| 456 Lisp_Object Qstart_in_region; | |
| 457 Lisp_Object Qend_in_region; | |
| 458 Lisp_Object Qstart_and_end_in_region; | |
| 459 Lisp_Object Qstart_or_end_in_region; | |
| 460 Lisp_Object Qnegate_in_region; | |
| 461 | |
| 462 Lisp_Object Qdetached; | |
| 463 Lisp_Object Qdestroyed; | |
| 464 Lisp_Object Qbegin_glyph; | |
| 465 Lisp_Object Qend_glyph; | |
| 466 Lisp_Object Qstart_open; | |
| 467 Lisp_Object Qend_open; | |
| 468 Lisp_Object Qstart_closed; | |
| 469 Lisp_Object Qend_closed; | |
| 470 Lisp_Object Qread_only; | |
| 471 /* Qhighlight defined in general.c */ | |
| 472 Lisp_Object Qunique; | |
| 473 Lisp_Object Qduplicable; | |
| 474 Lisp_Object Qdetachable; | |
| 475 Lisp_Object Qpriority; | |
| 476 Lisp_Object Qmouse_face; | |
| 477 Lisp_Object Qinitial_redisplay_function; | |
| 478 | |
| 479 Lisp_Object Qglyph_layout; /* This exists only for backwards compatibility. */ | |
| 480 Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout; | |
| 481 Lisp_Object Qoutside_margin; | |
| 482 Lisp_Object Qinside_margin; | |
| 483 Lisp_Object Qwhitespace; | |
| 484 /* Qtext defined in general.c */ | |
| 485 | |
| 486 Lisp_Object Qcopy_function; | |
| 487 Lisp_Object Qpaste_function; | |
| 488 | |
| 489 static Lisp_Object canonicalize_extent_property (Lisp_Object prop, | |
| 490 Lisp_Object value); | |
| 826 | 491 |
| 492 typedef struct | |
| 493 { | |
| 494 Lisp_Object key, value; | |
| 495 } Lisp_Object_pair; | |
| 496 typedef struct | |
| 497 { | |
| 498 Dynarr_declare (Lisp_Object_pair); | |
| 499 } Lisp_Object_pair_dynarr; | |
| 500 | |
| 501 static void extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props); | |
| 502 | |
| 428 | 503 Lisp_Object Vextent_face_memoize_hash_table; |
| 504 Lisp_Object Vextent_face_reverse_memoize_hash_table; | |
| 505 Lisp_Object Vextent_face_reusable_list; | |
| 506 /* FSFmacs bogosity */ | |
| 507 Lisp_Object Vdefault_text_properties; | |
| 508 | |
| 442 | 509 /* if true, we don't want to set any redisplay flags on modeline extent |
| 510 changes */ | |
| 511 int in_modeline_generation; | |
| 512 | |
| 428 | 513 |
| 514 /************************************************************************/ | |
| 515 /* Generalized gap array */ | |
| 516 /************************************************************************/ | |
| 517 | |
| 518 /* This generalizes the "array with a gap" model used to store buffer | |
| 519 characters. This is based on the stuff in insdel.c and should | |
| 520 probably be merged with it. This is not extent-specific and should | |
| 521 perhaps be moved into a separate file. */ | |
| 522 | |
| 523 /* ------------------------------- */ | |
| 524 /* internal functions */ | |
| 525 /* ------------------------------- */ | |
| 526 | |
| 527 /* Adjust the gap array markers in the range (FROM, TO]. Parallel to | |
| 528 adjust_markers() in insdel.c. */ | |
| 529 | |
| 530 static void | |
| 826 | 531 gap_array_adjust_markers (Gap_Array *ga, Memxpos from, |
| 1204 | 532 Memxpos to, Elemcount amount) |
| 428 | 533 { |
| 534 Gap_Array_Marker *m; | |
| 535 | |
| 536 for (m = ga->markers; m; m = m->next) | |
| 537 m->pos = do_marker_adjustment (m->pos, from, to, amount); | |
| 538 } | |
| 539 | |
| 1204 | 540 static void |
| 541 gap_array_recompute_derived_values (Gap_Array *ga) | |
| 542 { | |
| 543 ga->offset_past_gap = ga->elsize * (ga->gap + ga->gapsize); | |
| 544 ga->els_past_gap = ga->numels - ga->gap; | |
| 545 } | |
| 546 | |
| 428 | 547 /* Move the gap to array position POS. Parallel to move_gap() in |
| 548 insdel.c but somewhat simplified. */ | |
| 549 | |
| 550 static void | |
| 1204 | 551 gap_array_move_gap (Gap_Array *ga, Elemcount pos) |
| 552 { | |
| 553 Elemcount gap = ga->gap; | |
| 554 Elemcount gapsize = ga->gapsize; | |
| 555 | |
| 428 | 556 if (pos < gap) |
| 557 { | |
| 558 memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize), | |
| 559 GAP_ARRAY_MEMEL_ADDR (ga, pos), | |
| 560 (gap - pos)*ga->elsize); | |
| 826 | 561 gap_array_adjust_markers (ga, (Memxpos) pos, (Memxpos) gap, |
| 428 | 562 gapsize); |
| 563 } | |
| 564 else if (pos > gap) | |
| 565 { | |
| 566 memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap), | |
| 567 GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize), | |
| 568 (pos - gap)*ga->elsize); | |
| 826 | 569 gap_array_adjust_markers (ga, (Memxpos) (gap + gapsize), |
| 570 (Memxpos) (pos + gapsize), - gapsize); | |
| 428 | 571 } |
| 572 ga->gap = pos; | |
| 1204 | 573 |
| 574 gap_array_recompute_derived_values (ga); | |
| 428 | 575 } |
| 576 | |
| 577 /* Make the gap INCREMENT characters longer. Parallel to make_gap() in | |
| 1204 | 578 insdel.c. The gap array may be moved, so assign the return value back |
| 579 to the array pointer. */ | |
| 580 | |
| 581 static Gap_Array * | |
| 582 gap_array_make_gap (Gap_Array *ga, Elemcount increment) | |
| 583 { | |
| 584 Elemcount real_gap_loc; | |
| 585 Elemcount old_gap_size; | |
| 428 | 586 |
| 587 /* If we have to get more space, get enough to last a while. We use | |
| 588 a geometric progression that saves on realloc space. */ | |
| 589 increment += 100 + ga->numels / 8; | |
| 590 | |
| 3092 | 591 #ifdef NEW_GC |
| 592 ga = (Gap_Array *) mc_realloc (ga, | |
| 593 offsetof (Gap_Array, array) + | |
| 594 (ga->numels + ga->gapsize + increment) * | |
| 595 ga->elsize); | |
| 596 #else /* not NEW_GC */ | |
| 1204 | 597 ga = (Gap_Array *) xrealloc (ga, |
| 598 offsetof (Gap_Array, array) + | |
| 599 (ga->numels + ga->gapsize + increment) * | |
| 600 ga->elsize); | |
| 3092 | 601 #endif /* not NEW_GC */ |
| 1204 | 602 if (ga == 0) |
| 428 | 603 memory_full (); |
| 604 | |
| 605 real_gap_loc = ga->gap; | |
| 606 old_gap_size = ga->gapsize; | |
| 607 | |
| 608 /* Call the newly allocated space a gap at the end of the whole space. */ | |
| 609 ga->gap = ga->numels + ga->gapsize; | |
| 610 ga->gapsize = increment; | |
| 611 | |
| 612 /* Move the new gap down to be consecutive with the end of the old one. | |
| 613 This adjusts the markers properly too. */ | |
| 614 gap_array_move_gap (ga, real_gap_loc + old_gap_size); | |
| 615 | |
| 616 /* Now combine the two into one large gap. */ | |
| 617 ga->gapsize += old_gap_size; | |
| 618 ga->gap = real_gap_loc; | |
| 1204 | 619 |
| 620 gap_array_recompute_derived_values (ga); | |
| 621 | |
| 622 return ga; | |
| 428 | 623 } |
| 624 | |
| 625 /* ------------------------------- */ | |
| 626 /* external functions */ | |
| 627 /* ------------------------------- */ | |
| 628 | |
| 629 /* Insert NUMELS elements (pointed to by ELPTR) into the specified | |
| 1204 | 630 gap array at POS. The gap array may be moved, so assign the |
| 631 return value back to the array pointer. */ | |
| 632 | |
| 633 static Gap_Array * | |
| 634 gap_array_insert_els (Gap_Array *ga, Elemcount pos, void *elptr, | |
| 635 Elemcount numels) | |
| 428 | 636 { |
| 637 assert (pos >= 0 && pos <= ga->numels); | |
| 638 if (ga->gapsize < numels) | |
| 1204 | 639 ga = gap_array_make_gap (ga, numels - ga->gapsize); |
| 428 | 640 if (pos != ga->gap) |
| 641 gap_array_move_gap (ga, pos); | |
| 642 | |
| 643 memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr, | |
| 644 numels*ga->elsize); | |
| 645 ga->gapsize -= numels; | |
| 646 ga->gap += numels; | |
| 647 ga->numels += numels; | |
| 1204 | 648 gap_array_recompute_derived_values (ga); |
| 428 | 649 /* This is the equivalent of insert-before-markers. |
| 650 | |
| 651 #### Should only happen if marker is "moves forward at insert" type. | |
| 652 */ | |
| 653 | |
| 654 gap_array_adjust_markers (ga, pos - 1, pos, numels); | |
| 1204 | 655 return ga; |
| 428 | 656 } |
| 657 | |
| 658 /* Delete NUMELS elements from the specified gap array, starting at FROM. */ | |
| 659 | |
| 660 static void | |
| 1204 | 661 gap_array_delete_els (Gap_Array *ga, Elemcount from, Elemcount numdel) |
| 662 { | |
| 663 Elemcount to = from + numdel; | |
| 664 Elemcount gapsize = ga->gapsize; | |
| 428 | 665 |
| 666 assert (from >= 0); | |
| 667 assert (numdel >= 0); | |
| 668 assert (to <= ga->numels); | |
| 669 | |
| 670 /* Make sure the gap is somewhere in or next to what we are deleting. */ | |
| 671 if (to < ga->gap) | |
| 672 gap_array_move_gap (ga, to); | |
| 673 if (from > ga->gap) | |
| 674 gap_array_move_gap (ga, from); | |
| 675 | |
| 676 /* Relocate all markers pointing into the new, larger gap | |
| 677 to point at the end of the text before the gap. */ | |
| 678 gap_array_adjust_markers (ga, to + gapsize, to + gapsize, | |
| 679 - numdel - gapsize); | |
| 680 | |
| 681 ga->gapsize += numdel; | |
| 682 ga->numels -= numdel; | |
| 683 ga->gap = from; | |
| 1204 | 684 gap_array_recompute_derived_values (ga); |
| 428 | 685 } |
| 686 | |
| 687 static Gap_Array_Marker * | |
| 1204 | 688 gap_array_make_marker (Gap_Array *ga, Elemcount pos) |
| 428 | 689 { |
| 690 Gap_Array_Marker *m; | |
| 691 | |
| 692 assert (pos >= 0 && pos <= ga->numels); | |
| 3092 | 693 #ifdef NEW_GC |
| 694 m = alloc_lrecord_type (Gap_Array_Marker, &lrecord_gap_array_marker); | |
| 695 #else /* not NEW_GC */ | |
| 428 | 696 if (gap_array_marker_freelist) |
| 697 { | |
| 698 m = gap_array_marker_freelist; | |
| 699 gap_array_marker_freelist = gap_array_marker_freelist->next; | |
| 700 } | |
| 701 else | |
| 702 m = xnew (Gap_Array_Marker); | |
| 3092 | 703 #endif /* not NEW_GC */ |
| 428 | 704 |
| 705 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); | |
| 706 m->next = ga->markers; | |
| 707 ga->markers = m; | |
| 708 return m; | |
| 709 } | |
| 710 | |
| 711 static void | |
| 712 gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m) | |
| 713 { | |
| 714 Gap_Array_Marker *p, *prev; | |
| 715 | |
| 716 for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next) | |
| 717 ; | |
| 718 assert (p); | |
| 719 if (prev) | |
| 720 prev->next = p->next; | |
| 721 else | |
| 722 ga->markers = p->next; | |
| 4117 | 723 #ifndef NEW_GC |
| 428 | 724 m->next = gap_array_marker_freelist; |
| 1204 | 725 m->pos = 0xDEADBEEF; /* -559038737 base 10 */ |
| 428 | 726 gap_array_marker_freelist = m; |
| 3092 | 727 #endif /* not NEW_GC */ |
| 728 } | |
| 729 | |
| 730 #ifndef NEW_GC | |
| 428 | 731 static void |
| 732 gap_array_delete_all_markers (Gap_Array *ga) | |
| 733 { | |
| 734 Gap_Array_Marker *p, *next; | |
| 735 | |
| 736 for (p = ga->markers; p; p = next) | |
| 737 { | |
| 738 next = p->next; | |
| 739 p->next = gap_array_marker_freelist; | |
| 740 p->pos = 0xDEADBEEF; /* -559038737 as an int */ | |
| 741 gap_array_marker_freelist = p; | |
| 742 } | |
| 743 } | |
| 3092 | 744 #endif /* not NEW_GC */ |
| 428 | 745 |
| 746 static void | |
| 1204 | 747 gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, Elemcount pos) |
| 428 | 748 { |
| 749 assert (pos >= 0 && pos <= ga->numels); | |
| 750 m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); | |
| 751 } | |
| 752 | |
| 753 #define gap_array_marker_pos(ga, m) \ | |
| 754 GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos) | |
| 755 | |
| 756 static Gap_Array * | |
| 1204 | 757 make_gap_array (Elemcount elsize) |
| 428 | 758 { |
| 3092 | 759 #ifdef NEW_GC |
| 760 Gap_Array *ga = alloc_lrecord_type (Gap_Array, &lrecord_gap_array); | |
| 761 #else /* not NEW_GC */ | |
| 428 | 762 Gap_Array *ga = xnew_and_zero (Gap_Array); |
| 3092 | 763 #endif /* not NEW_GC */ |
| 428 | 764 ga->elsize = elsize; |
| 765 return ga; | |
| 766 } | |
| 767 | |
| 3092 | 768 #ifndef NEW_GC |
| 428 | 769 static void |
| 770 free_gap_array (Gap_Array *ga) | |
| 771 { | |
| 772 gap_array_delete_all_markers (ga); | |
| 1726 | 773 xfree (ga, Gap_Array *); |
| 428 | 774 } |
| 3092 | 775 #endif /* not NEW_GC */ |
| 428 | 776 |
| 777 | |
| 778 /************************************************************************/ | |
| 779 /* Extent list primitives */ | |
| 780 /************************************************************************/ | |
| 781 | |
| 782 /* A list of extents is maintained as a double gap array: one gap array | |
| 783 is ordered by start index (the "display order") and the other is | |
| 784 ordered by end index (the "e-order"). Note that positions in an | |
| 785 extent list should logically be conceived of as referring *to* | |
| 786 a particular extent (as is the norm in programs) rather than | |
| 787 sitting between two extents. Note also that callers of these | |
| 788 functions should not be aware of the fact that the extent list is | |
| 789 implemented as an array, except for the fact that positions are | |
| 790 integers (this should be generalized to handle integers and linked | |
| 791 list equally well). | |
| 792 */ | |
| 793 | |
| 794 /* Number of elements in an extent list */ | |
| 1204 | 795 #define extent_list_num_els(el) GAP_ARRAY_NUM_ELS (el->start) |
| 428 | 796 |
| 797 /* Return the position at which EXTENT is located in the specified extent | |
| 798 list (in the display order if ENDP is 0, in the e-order otherwise). | |
| 799 If the extent is not found, the position where the extent would | |
| 800 be inserted is returned. If ENDP is 0, the insertion would go after | |
| 801 all other equal extents. If ENDP is not 0, the insertion would go | |
| 802 before all other equal extents. If FOUNDP is not 0, then whether | |
| 803 the extent was found will get written into it. */ | |
| 804 | |
| 805 static int | |
| 806 extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp) | |
| 807 { | |
| 808 Gap_Array *ga = endp ? el->end : el->start; | |
| 809 int left = 0, right = GAP_ARRAY_NUM_ELS (ga); | |
| 810 int oldfoundpos, foundpos; | |
| 811 int found; | |
| 812 | |
| 813 while (left != right) | |
| 814 { | |
| 815 /* RIGHT might not point to a valid extent (i.e. it's at the end | |
| 816 of the list), so NEWPOS must round down. */ | |
| 647 | 817 int newpos = (left + right) >> 1; |
| 428 | 818 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, (int) newpos); |
| 819 | |
| 820 if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent)) | |
| 647 | 821 left = newpos + 1; |
| 428 | 822 else |
| 823 right = newpos; | |
| 824 } | |
| 825 | |
| 826 /* Now we're at the beginning of all equal extents. */ | |
| 827 found = 0; | |
| 828 oldfoundpos = foundpos = left; | |
| 829 while (foundpos < GAP_ARRAY_NUM_ELS (ga)) | |
| 830 { | |
| 831 EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos); | |
| 832 if (e == extent) | |
| 833 { | |
| 834 found = 1; | |
| 835 break; | |
| 836 } | |
| 837 if (!EXTENT_EQUAL (e, extent)) | |
| 838 break; | |
| 839 foundpos++; | |
| 840 } | |
| 841 if (foundp) | |
| 842 *foundp = found; | |
| 843 if (found || !endp) | |
| 844 return foundpos; | |
| 845 else | |
| 846 return oldfoundpos; | |
| 847 } | |
| 848 | |
| 849 /* Return the position of the first extent that begins at or after POS | |
| 850 (or ends at or after POS, if ENDP is not 0). | |
| 851 | |
| 852 An out-of-range value for POS is allowed, and guarantees that the | |
| 853 position at the beginning or end of the extent list is returned. */ | |
| 854 | |
| 855 static int | |
| 826 | 856 extent_list_locate_from_pos (Extent_List *el, Memxpos pos, int endp) |
| 428 | 857 { |
| 858 struct extent fake_extent; | |
| 859 /* | |
| 860 | |
| 861 Note that if we search for [POS, POS], then we get the following: | |
| 862 | |
| 863 -- if ENDP is 0, then all extents whose start position is <= POS | |
| 864 lie before the returned position, and all extents whose start | |
| 865 position is > POS lie at or after the returned position. | |
| 866 | |
| 867 -- if ENDP is not 0, then all extents whose end position is < POS | |
| 868 lie before the returned position, and all extents whose end | |
| 869 position is >= POS lie at or after the returned position. | |
| 870 | |
| 871 */ | |
| 872 set_extent_start (&fake_extent, endp ? pos : pos-1); | |
| 873 set_extent_end (&fake_extent, endp ? pos : pos-1); | |
| 874 return extent_list_locate (el, &fake_extent, endp, 0); | |
| 875 } | |
| 876 | |
| 877 /* Return the extent at POS. */ | |
| 878 | |
| 879 static EXTENT | |
| 826 | 880 extent_list_at (Extent_List *el, Memxpos pos, int endp) |
| 428 | 881 { |
| 882 Gap_Array *ga = endp ? el->end : el->start; | |
| 883 | |
| 884 assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga)); | |
| 885 return EXTENT_GAP_ARRAY_AT (ga, pos); | |
| 886 } | |
| 887 | |
| 888 /* Insert an extent into an extent list. */ | |
| 889 | |
| 890 static void | |
| 891 extent_list_insert (Extent_List *el, EXTENT extent) | |
| 892 { | |
| 893 int pos, foundp; | |
| 894 | |
| 895 pos = extent_list_locate (el, extent, 0, &foundp); | |
| 896 assert (!foundp); | |
| 1204 | 897 el->start = gap_array_insert_els (el->start, pos, &extent, 1); |
| 428 | 898 pos = extent_list_locate (el, extent, 1, &foundp); |
| 899 assert (!foundp); | |
| 1204 | 900 el->end = gap_array_insert_els (el->end, pos, &extent, 1); |
| 428 | 901 } |
| 902 | |
| 903 /* Delete an extent from an extent list. */ | |
| 904 | |
| 905 static void | |
| 906 extent_list_delete (Extent_List *el, EXTENT extent) | |
| 907 { | |
| 908 int pos, foundp; | |
| 909 | |
| 910 pos = extent_list_locate (el, extent, 0, &foundp); | |
| 911 assert (foundp); | |
| 912 gap_array_delete_els (el->start, pos, 1); | |
| 913 pos = extent_list_locate (el, extent, 1, &foundp); | |
| 914 assert (foundp); | |
| 915 gap_array_delete_els (el->end, pos, 1); | |
| 916 } | |
| 917 | |
| 918 static void | |
| 919 extent_list_delete_all (Extent_List *el) | |
| 920 { | |
| 921 gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start)); | |
| 922 gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end)); | |
| 923 } | |
| 924 | |
| 925 static Extent_List_Marker * | |
| 926 extent_list_make_marker (Extent_List *el, int pos, int endp) | |
| 927 { | |
| 928 Extent_List_Marker *m; | |
| 929 | |
| 3092 | 930 #ifdef NEW_GC |
| 931 m = alloc_lrecord_type (Extent_List_Marker, &lrecord_extent_list_marker); | |
| 932 #else /* not NEW_GC */ | |
| 428 | 933 if (extent_list_marker_freelist) |
| 934 { | |
| 935 m = extent_list_marker_freelist; | |
| 936 extent_list_marker_freelist = extent_list_marker_freelist->next; | |
| 937 } | |
| 938 else | |
| 939 m = xnew (Extent_List_Marker); | |
| 3092 | 940 #endif /* not NEW_GC */ |
| 428 | 941 |
| 942 m->m = gap_array_make_marker (endp ? el->end : el->start, pos); | |
| 943 m->endp = endp; | |
| 944 m->next = el->markers; | |
| 945 el->markers = m; | |
| 946 return m; | |
| 947 } | |
| 948 | |
| 949 #define extent_list_move_marker(el, mkr, pos) \ | |
| 950 gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos) | |
| 951 | |
| 952 static void | |
| 953 extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m) | |
| 954 { | |
| 955 Extent_List_Marker *p, *prev; | |
| 956 | |
| 957 for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next) | |
| 958 ; | |
| 959 assert (p); | |
| 960 if (prev) | |
| 961 prev->next = p->next; | |
| 962 else | |
| 963 el->markers = p->next; | |
| 3092 | 964 #ifdef NEW_GC |
| 965 gap_array_delete_marker (m->endp ? el->end : el->start, m->m); | |
| 966 #else /* not NEW_GC */ | |
| 428 | 967 m->next = extent_list_marker_freelist; |
| 968 extent_list_marker_freelist = m; | |
| 969 gap_array_delete_marker (m->endp ? el->end : el->start, m->m); | |
| 3092 | 970 #endif /* not NEW_GC */ |
| 428 | 971 } |
| 972 | |
| 973 #define extent_list_marker_pos(el, mkr) \ | |
| 974 gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m) | |
| 975 | |
| 976 static Extent_List * | |
| 977 allocate_extent_list (void) | |
| 978 { | |
| 3092 | 979 #ifdef NEW_GC |
| 980 Extent_List *el = alloc_lrecord_type (Extent_List, &lrecord_extent_list); | |
| 981 #else /* not NEW_GC */ | |
| 428 | 982 Extent_List *el = xnew (Extent_List); |
| 3092 | 983 #endif /* not NEW_GC */ |
| 440 | 984 el->start = make_gap_array (sizeof (EXTENT)); |
| 985 el->end = make_gap_array (sizeof (EXTENT)); | |
| 428 | 986 el->markers = 0; |
| 987 return el; | |
| 988 } | |
| 989 | |
| 3092 | 990 #ifndef NEW_GC |
| 428 | 991 static void |
| 992 free_extent_list (Extent_List *el) | |
| 993 { | |
| 994 free_gap_array (el->start); | |
| 995 free_gap_array (el->end); | |
| 1726 | 996 xfree (el, Extent_List *); |
| 428 | 997 } |
| 3092 | 998 #endif /* not NEW_GC */ |
| 428 | 999 |
| 1000 | |
| 1001 /************************************************************************/ | |
| 1002 /* Auxiliary extent structure */ | |
| 1003 /************************************************************************/ | |
| 1004 | |
| 1204 | 1005 static const struct memory_description extent_auxiliary_description[] ={ |
| 934 | 1006 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, begin_glyph) }, |
| 1007 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, end_glyph) }, | |
| 1008 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, parent) }, | |
| 1009 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, children) }, | |
| 1010 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, invisible) }, | |
| 1011 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, read_only) }, | |
| 1012 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, mouse_face) }, | |
| 1013 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, initial_redisplay_function) }, | |
| 1014 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, before_change_functions) }, | |
| 1015 { XD_LISP_OBJECT, offsetof (struct extent_auxiliary, after_change_functions) }, | |
| 1016 { XD_END } | |
| 1017 }; | |
| 428 | 1018 static Lisp_Object |
| 1019 mark_extent_auxiliary (Lisp_Object obj) | |
| 1020 { | |
| 1021 struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); | |
| 1022 mark_object (data->begin_glyph); | |
| 1023 mark_object (data->end_glyph); | |
| 1024 mark_object (data->invisible); | |
| 1025 mark_object (data->children); | |
| 1026 mark_object (data->read_only); | |
| 1027 mark_object (data->mouse_face); | |
| 1028 mark_object (data->initial_redisplay_function); | |
| 1029 mark_object (data->before_change_functions); | |
| 1030 mark_object (data->after_change_functions); | |
| 1031 return data->parent; | |
| 1032 } | |
| 1033 | |
| 934 | 1034 DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary, |
| 1035 0, /*dumpable-flag*/ | |
| 1036 mark_extent_auxiliary, internal_object_printer, | |
| 1204 | 1037 0, 0, 0, extent_auxiliary_description, |
| 1038 struct extent_auxiliary); | |
| 428 | 1039 void |
| 1040 allocate_extent_auxiliary (EXTENT ext) | |
| 1041 { | |
| 1042 Lisp_Object extent_aux; | |
| 2720 | 1043 struct extent_auxiliary *data = |
| 3017 | 1044 ALLOC_LCRECORD_TYPE (struct extent_auxiliary, &lrecord_extent_auxiliary); |
| 1045 COPY_LCRECORD (data, &extent_auxiliary_defaults); | |
| 793 | 1046 extent_aux = wrap_extent_auxiliary (data); |
| 428 | 1047 ext->plist = Fcons (extent_aux, ext->plist); |
| 1048 ext->flags.has_aux = 1; | |
| 1049 } | |
| 1050 | |
| 1051 | |
| 1052 /************************************************************************/ | |
| 1053 /* Extent info structure */ | |
| 1054 /************************************************************************/ | |
| 1055 | |
| 1056 /* An extent-info structure consists of a list of the buffer or string's | |
| 1057 extents and a "stack of extents" that lists all of the extents over | |
| 1058 a particular position. The stack-of-extents info is used for | |
| 1059 optimization purposes -- it basically caches some info that might | |
| 1060 be expensive to compute. Certain otherwise hard computations are easy | |
| 1061 given the stack of extents over a particular position, and if the | |
| 1062 stack of extents over a nearby position is known (because it was | |
| 1063 calculated at some prior point in time), it's easy to move the stack | |
| 1064 of extents to the proper position. | |
| 1065 | |
| 1066 Given that the stack of extents is an optimization, and given that | |
| 1067 it requires memory, a string's stack of extents is wiped out each | |
| 1068 time a garbage collection occurs. Therefore, any time you retrieve | |
| 1069 the stack of extents, it might not be there. If you need it to | |
| 1070 be there, use the _force version. | |
| 1071 | |
| 1072 Similarly, a string may or may not have an extent_info structure. | |
| 1073 (Generally it won't if there haven't been any extents added to the | |
| 1074 string.) So use the _force version if you need the extent_info | |
| 1075 structure to be there. */ | |
| 1076 | |
| 1077 static struct stack_of_extents *allocate_soe (void); | |
| 3092 | 1078 #ifndef NEW_GC |
| 428 | 1079 static void free_soe (struct stack_of_extents *soe); |
| 3092 | 1080 #endif /* not NEW_GC */ |
| 428 | 1081 static void soe_invalidate (Lisp_Object obj); |
| 1082 | |
| 1204 | 1083 extern const struct sized_memory_description gap_array_marker_description; |
| 1084 | |
| 1085 static const struct memory_description gap_array_marker_description_1[] = { | |
| 3092 | 1086 #ifdef NEW_GC |
| 1087 { XD_LISP_OBJECT, offsetof (Gap_Array_Marker, next) }, | |
| 1088 #else /* not NEW_GC */ | |
| 2367 | 1089 { XD_BLOCK_PTR, offsetof (Gap_Array_Marker, next), 1, |
| 2551 | 1090 { &gap_array_marker_description } }, |
| 3092 | 1091 #endif /* not NEW_GC */ |
| 1204 | 1092 { XD_END } |
| 1093 }; | |
| 1094 | |
| 3092 | 1095 #ifdef NEW_GC |
| 1096 DEFINE_LRECORD_IMPLEMENTATION ("gap-array-marker", gap_array_marker, | |
| 1097 0, /*dumpable-flag*/ | |
| 1098 0, 0, 0, 0, 0, | |
| 1099 gap_array_marker_description_1, | |
| 1100 struct gap_array_marker); | |
| 1101 #else /* not NEW_GC */ | |
| 1204 | 1102 const struct sized_memory_description gap_array_marker_description = { |
| 1103 sizeof (Gap_Array_Marker), | |
| 1104 gap_array_marker_description_1 | |
| 934 | 1105 }; |
| 3092 | 1106 #endif /* not NEW_GC */ |
| 934 | 1107 |
| 1204 | 1108 static const struct memory_description lispobj_gap_array_description_1[] = { |
| 2881 | 1109 { XD_ELEMCOUNT, offsetof (Gap_Array, gap) }, |
| 1110 { XD_BYTECOUNT, offsetof (Gap_Array, offset_past_gap) }, | |
| 1111 { XD_ELEMCOUNT, offsetof (Gap_Array, els_past_gap) }, | |
| 3092 | 1112 #ifdef NEW_GC |
| 1113 { XD_LISP_OBJECT, offsetof (Gap_Array, markers) }, | |
| 1114 #else /* not NEW_GC */ | |
| 2367 | 1115 { XD_BLOCK_PTR, offsetof (Gap_Array, markers), 1, |
| 2551 | 1116 { &gap_array_marker_description }, XD_FLAG_NO_KKCC }, |
| 3092 | 1117 #endif /* not NEW_GC */ |
| 2367 | 1118 { XD_BLOCK_ARRAY, offsetof (Gap_Array, array), XD_INDIRECT (0, 0), |
| 2551 | 1119 { &lisp_object_description } }, |
| 2367 | 1120 { XD_BLOCK_ARRAY, XD_INDIRECT (1, offsetof (Gap_Array, array)), |
| 2551 | 1121 XD_INDIRECT (2, 0), { &lisp_object_description } }, |
| 934 | 1122 { XD_END } |
| 1123 }; | |
| 1204 | 1124 |
| 3092 | 1125 #ifdef NEW_GC |
| 1126 | |
| 1127 static Bytecount | |
| 1128 size_gap_array (const void *lheader) | |
| 1129 { | |
| 1130 Gap_Array *ga = (Gap_Array *) lheader; | |
| 1131 return offsetof (Gap_Array, array) + (ga->numels + ga->gapsize) * ga->elsize; | |
| 1132 } | |
| 1133 | |
| 1134 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("gap-array", gap_array, | |
| 1135 0, /*dumpable-flag*/ | |
| 1136 0, 0, 0, 0, 0, | |
| 1137 lispobj_gap_array_description_1, | |
| 1138 size_gap_array, | |
| 1139 struct gap_array); | |
| 1140 #else /* not NEW_GC */ | |
| 1204 | 1141 static const struct sized_memory_description lispobj_gap_array_description = { |
| 1142 sizeof (Gap_Array), | |
| 1143 lispobj_gap_array_description_1 | |
| 1144 }; | |
| 1145 | |
| 1146 extern const struct sized_memory_description extent_list_marker_description; | |
| 3092 | 1147 #endif /* not NEW_GC */ |
| 1204 | 1148 |
| 1149 static const struct memory_description extent_list_marker_description_1[] = { | |
| 3092 | 1150 #ifdef NEW_GC |
| 1151 { XD_LISP_OBJECT, offsetof (Extent_List_Marker, m) }, | |
| 1152 { XD_LISP_OBJECT, offsetof (Extent_List_Marker, next) }, | |
| 1153 #else /* not NEW_GC */ | |
| 2367 | 1154 { XD_BLOCK_PTR, offsetof (Extent_List_Marker, m), 1, |
| 2551 | 1155 { &gap_array_marker_description } }, |
| 2367 | 1156 { XD_BLOCK_PTR, offsetof (Extent_List_Marker, next), 1, |
| 2551 | 1157 { &extent_list_marker_description } }, |
| 3092 | 1158 #endif /* not NEW_GC */ |
| 1204 | 1159 { XD_END } |
| 1160 }; | |
| 1161 | |
| 3092 | 1162 #ifdef NEW_GC |
| 1163 DEFINE_LRECORD_IMPLEMENTATION ("extent-list-marker", extent_list_marker, | |
| 1164 0, /*dumpable-flag*/ | |
| 1165 0, 0, 0, 0, 0, | |
| 1166 extent_list_marker_description_1, | |
| 1167 struct extent_list_marker); | |
| 1168 #else /* not NEW_GC */ | |
| 1204 | 1169 const struct sized_memory_description extent_list_marker_description = { |
| 1170 sizeof (Extent_List_Marker), | |
| 1171 extent_list_marker_description_1 | |
| 1172 }; | |
| 3092 | 1173 #endif /* not NEW_GC */ |
| 1204 | 1174 |
| 1175 static const struct memory_description extent_list_description_1[] = { | |
| 3092 | 1176 #ifdef NEW_GC |
| 1177 { XD_LISP_OBJECT, offsetof (Extent_List, start) }, | |
| 1178 { XD_LISP_OBJECT, offsetof (Extent_List, end) }, | |
| 1179 { XD_LISP_OBJECT, offsetof (Extent_List, markers) }, | |
| 1180 #else /* not NEW_GC */ | |
| 2551 | 1181 { XD_BLOCK_PTR, offsetof (Extent_List, start), 1, |
| 1182 { &lispobj_gap_array_description } }, | |
| 1183 { XD_BLOCK_PTR, offsetof (Extent_List, end), 1, | |
| 1184 { &lispobj_gap_array_description }, XD_FLAG_NO_KKCC }, | |
| 1185 { XD_BLOCK_PTR, offsetof (Extent_List, markers), 1, | |
| 1186 { &extent_list_marker_description }, XD_FLAG_NO_KKCC }, | |
| 3092 | 1187 #endif /* not NEW_GC */ |
| 1204 | 1188 { XD_END } |
| 1189 }; | |
| 1190 | |
| 3092 | 1191 #ifdef NEW_GC |
| 1192 DEFINE_LRECORD_IMPLEMENTATION ("extent-list", extent_list, | |
| 1193 0, /*dumpable-flag*/ | |
| 1194 0, 0, 0, 0, 0, | |
| 1195 extent_list_description_1, | |
| 1196 struct extent_list); | |
| 1197 #else /* not NEW_GC */ | |
| 1204 | 1198 static const struct sized_memory_description extent_list_description = { |
| 1199 sizeof (Extent_List), | |
| 1200 extent_list_description_1 | |
| 1201 }; | |
| 3092 | 1202 #endif /* not NEW_GC */ |
| 1204 | 1203 |
| 1204 static const struct memory_description stack_of_extents_description_1[] = { | |
| 3092 | 1205 #ifdef NEW_GC |
| 1206 { XD_LISP_OBJECT, offsetof (Stack_Of_Extents, extents) }, | |
| 1207 #else /* not NEW_GC */ | |
| 2551 | 1208 { XD_BLOCK_PTR, offsetof (Stack_Of_Extents, extents), 1, |
| 1209 { &extent_list_description } }, | |
| 3092 | 1210 #endif /* not NEW_GC */ |
| 1204 | 1211 { XD_END } |
| 1212 }; | |
| 1213 | |
| 3092 | 1214 #ifdef NEW_GC |
| 1215 DEFINE_LRECORD_IMPLEMENTATION ("stack-of-extents", stack_of_extents, | |
| 1216 0, /*dumpable-flag*/ | |
| 1217 0, 0, 0, 0, 0, | |
| 1218 stack_of_extents_description_1, | |
| 1219 struct stack_of_extents); | |
| 1220 #else /* not NEW_GC */ | |
| 1204 | 1221 static const struct sized_memory_description stack_of_extents_description = { |
| 1222 sizeof (Stack_Of_Extents), | |
| 1223 stack_of_extents_description_1 | |
| 1224 }; | |
| 3092 | 1225 #endif /* not NEW_GC */ |
| 1204 | 1226 |
| 1227 static const struct memory_description extent_info_description [] = { | |
| 3092 | 1228 #ifdef NEW_GC |
| 1229 { XD_LISP_OBJECT, offsetof (struct extent_info, extents) }, | |
| 1230 { XD_LISP_OBJECT, offsetof (struct extent_info, soe) }, | |
| 1231 #else /* not NEW_GC */ | |
| 2367 | 1232 { XD_BLOCK_PTR, offsetof (struct extent_info, extents), 1, |
| 2551 | 1233 { &extent_list_description } }, |
| 2367 | 1234 { XD_BLOCK_PTR, offsetof (struct extent_info, soe), 1, |
| 2551 | 1235 { &stack_of_extents_description }, XD_FLAG_NO_KKCC }, |
| 3092 | 1236 #endif /* not NEW_GC */ |
| 1204 | 1237 { XD_END } |
| 1238 }; | |
| 934 | 1239 |
| 428 | 1240 static Lisp_Object |
| 1241 mark_extent_info (Lisp_Object obj) | |
| 1242 { | |
| 1243 struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj); | |
| 1244 int i; | |
| 1245 Extent_List *list = data->extents; | |
| 1246 | |
| 1247 /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like | |
| 1248 objects that are created specially and never have their extent | |
| 1249 list initialized (or rather, it is set to zero in | |
| 1250 nuke_all_buffer_slots()). However, these objects get | |
| 1251 garbage-collected so we have to deal. | |
| 1252 | |
| 1253 (Also the list can be zero when we're dealing with a destroyed | |
| 1254 buffer.) */ | |
| 1255 | |
| 1256 if (list) | |
| 1257 { | |
| 1258 for (i = 0; i < extent_list_num_els (list); i++) | |
| 1259 { | |
| 1260 struct extent *extent = extent_list_at (list, i, 0); | |
| 793 | 1261 Lisp_Object exobj = wrap_extent (extent); |
| 1262 | |
| 428 | 1263 mark_object (exobj); |
| 1264 } | |
| 1265 } | |
| 1266 | |
| 1267 return Qnil; | |
| 1268 } | |
| 1269 | |
| 3263 | 1270 #ifdef NEW_GC |
| 1271 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, | |
| 1272 0, /*dumpable-flag*/ | |
| 1273 mark_extent_info, internal_object_printer, | |
| 1274 0, 0, 0, | |
| 1275 extent_info_description, | |
| 1276 struct extent_info); | |
| 1277 #else /* not NEW_GC */ | |
| 428 | 1278 static void |
| 1279 finalize_extent_info (void *header, int for_disksave) | |
| 1280 { | |
| 1281 struct extent_info *data = (struct extent_info *) header; | |
| 1282 | |
| 1283 if (for_disksave) | |
| 1284 return; | |
| 1285 | |
| 3092 | 1286 data->soe = 0; |
| 1287 data->extents = 0; | |
| 428 | 1288 if (data->soe) |
| 1289 { | |
| 1290 free_soe (data->soe); | |
| 1291 data->soe = 0; | |
| 1292 } | |
| 1293 if (data->extents) | |
| 1294 { | |
| 1295 free_extent_list (data->extents); | |
| 1296 data->extents = 0; | |
| 1297 } | |
| 1298 } | |
| 1299 | |
| 934 | 1300 DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, |
| 1301 0, /*dumpable-flag*/ | |
| 1302 mark_extent_info, internal_object_printer, | |
| 1303 finalize_extent_info, 0, 0, | |
| 1204 | 1304 extent_info_description, |
| 934 | 1305 struct extent_info); |
| 3263 | 1306 #endif /* not NEW_GC */ |
| 428 | 1307 |
| 1308 static Lisp_Object | |
| 1309 allocate_extent_info (void) | |
| 1310 { | |
| 1311 Lisp_Object extent_info; | |
| 1312 struct extent_info *data = | |
| 3017 | 1313 ALLOC_LCRECORD_TYPE (struct extent_info, &lrecord_extent_info); |
| 428 | 1314 |
| 793 | 1315 extent_info = wrap_extent_info (data); |
| 428 | 1316 data->extents = allocate_extent_list (); |
| 1317 data->soe = 0; | |
| 1318 return extent_info; | |
| 1319 } | |
| 1320 | |
| 1321 void | |
| 1322 flush_cached_extent_info (Lisp_Object extent_info) | |
| 1323 { | |
| 1324 struct extent_info *data = XEXTENT_INFO (extent_info); | |
| 1325 | |
| 1326 if (data->soe) | |
| 1327 { | |
| 3092 | 1328 #ifndef NEW_GC |
| 428 | 1329 free_soe (data->soe); |
| 3092 | 1330 #endif /* not NEW_GC */ |
| 428 | 1331 data->soe = 0; |
| 1332 } | |
| 1333 } | |
| 1334 | |
| 1335 | |
| 1336 /************************************************************************/ | |
| 1337 /* Buffer/string extent primitives */ | |
| 1338 /************************************************************************/ | |
| 1339 | |
| 1340 /* The functions in this section are the ONLY ones that should know | |
| 1341 about the internal implementation of the extent lists. Other functions | |
| 1342 should only know that there are two orderings on extents, the "display" | |
| 1343 order (sorted by start position, basically) and the e-order (sorted | |
| 1344 by end position, basically), and that certain operations are provided | |
| 1345 to manipulate the list. */ | |
| 1346 | |
| 1347 /* ------------------------------- */ | |
| 1348 /* basic primitives */ | |
| 1349 /* ------------------------------- */ | |
| 1350 | |
| 1351 static Lisp_Object | |
| 1352 decode_buffer_or_string (Lisp_Object object) | |
| 1353 { | |
| 1354 if (NILP (object)) | |
| 793 | 1355 object = wrap_buffer (current_buffer); |
| 428 | 1356 else if (BUFFERP (object)) |
| 1357 CHECK_LIVE_BUFFER (object); | |
| 1358 else if (STRINGP (object)) | |
| 1359 ; | |
| 1360 else | |
| 1361 dead_wrong_type_argument (Qbuffer_or_string_p, object); | |
| 1362 | |
| 1363 return object; | |
| 1364 } | |
| 1365 | |
| 1366 EXTENT | |
| 1367 extent_ancestor_1 (EXTENT e) | |
| 1368 { | |
| 1369 while (e->flags.has_parent) | |
| 1370 { | |
| 1371 /* There should be no circularities except in case of a logic | |
| 1372 error somewhere in the extent code */ | |
| 1373 e = XEXTENT (XEXTENT_AUXILIARY (XCAR (e->plist))->parent); | |
| 1374 } | |
| 1375 return e; | |
| 1376 } | |
| 1377 | |
| 1378 /* Given an extent object (string or buffer or nil), return its extent info. | |
| 1379 This may be 0 for a string. */ | |
| 1380 | |
| 1381 static struct extent_info * | |
| 1382 buffer_or_string_extent_info (Lisp_Object object) | |
| 1383 { | |
| 1384 if (STRINGP (object)) | |
| 1385 { | |
| 793 | 1386 Lisp_Object plist = XSTRING_PLIST (object); |
| 428 | 1387 if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist))) |
| 1388 return 0; | |
| 1389 return XEXTENT_INFO (XCAR (plist)); | |
| 1390 } | |
| 1391 else if (NILP (object)) | |
| 1392 return 0; | |
| 1393 else | |
| 1394 return XEXTENT_INFO (XBUFFER (object)->extent_info); | |
| 1395 } | |
| 1396 | |
| 1397 /* Given a string or buffer, return its extent list. This may be | |
| 1398 0 for a string. */ | |
| 1399 | |
| 1400 static Extent_List * | |
| 1401 buffer_or_string_extent_list (Lisp_Object object) | |
| 1402 { | |
| 1403 struct extent_info *info = buffer_or_string_extent_info (object); | |
| 1404 | |
| 1405 if (!info) | |
| 1406 return 0; | |
| 1407 return info->extents; | |
| 1408 } | |
| 1409 | |
| 1410 /* Given a string or buffer, return its extent info. If it's not there, | |
| 1411 create it. */ | |
| 1412 | |
| 1413 static struct extent_info * | |
| 1414 buffer_or_string_extent_info_force (Lisp_Object object) | |
| 1415 { | |
| 1416 struct extent_info *info = buffer_or_string_extent_info (object); | |
| 1417 | |
| 1418 if (!info) | |
| 1419 { | |
| 1420 Lisp_Object extent_info; | |
| 1421 | |
| 1422 assert (STRINGP (object)); /* should never happen for buffers -- | |
| 1423 the only buffers without an extent | |
| 1424 info are those after finalization, | |
| 1425 destroyed buffers, or special | |
| 1426 Lisp-inaccessible buffer objects. */ | |
| 1427 extent_info = allocate_extent_info (); | |
| 793 | 1428 XSTRING_PLIST (object) = Fcons (extent_info, XSTRING_PLIST (object)); |
| 428 | 1429 return XEXTENT_INFO (extent_info); |
| 1430 } | |
| 1431 | |
| 1432 return info; | |
| 1433 } | |
| 1434 | |
| 1435 /* Detach all the extents in OBJECT. Called from redisplay. */ | |
| 1436 | |
| 1437 void | |
| 1438 detach_all_extents (Lisp_Object object) | |
| 1439 { | |
| 1440 struct extent_info *data = buffer_or_string_extent_info (object); | |
| 1441 | |
| 1442 if (data) | |
| 1443 { | |
| 1444 if (data->extents) | |
| 1445 { | |
| 1446 int i; | |
| 1447 | |
| 1448 for (i = 0; i < extent_list_num_els (data->extents); i++) | |
| 1449 { | |
| 1450 EXTENT e = extent_list_at (data->extents, i, 0); | |
| 1451 /* No need to do detach_extent(). Just nuke the damn things, | |
| 1452 which results in the equivalent but faster. */ | |
| 1453 set_extent_start (e, -1); | |
| 1454 set_extent_end (e, -1); | |
| 1455 } | |
| 3466 | 1456 |
| 1457 /* But we need to clear all the lists containing extents or | |
| 1458 havoc will result. */ | |
| 1459 extent_list_delete_all (data->extents); | |
| 428 | 1460 } |
| 1461 soe_invalidate (object); | |
| 1462 } | |
| 1463 } | |
| 1464 | |
| 1465 | |
| 1466 void | |
| 1467 init_buffer_extents (struct buffer *b) | |
| 1468 { | |
| 1469 b->extent_info = allocate_extent_info (); | |
| 1470 } | |
| 1471 | |
| 1472 void | |
| 1473 uninit_buffer_extents (struct buffer *b) | |
| 1474 { | |
| 3092 | 1475 #ifndef NEW_GC |
| 428 | 1476 struct extent_info *data = XEXTENT_INFO (b->extent_info); |
| 3092 | 1477 #endif /* not NEW_GC */ |
| 428 | 1478 |
| 1479 /* Don't destroy the extents here -- there may still be children | |
| 1480 extents pointing to the extents. */ | |
| 771 | 1481 detach_all_extents (wrap_buffer (b)); |
| 3092 | 1482 #ifndef NEW_GC |
| 428 | 1483 finalize_extent_info (data, 0); |
| 3092 | 1484 #endif /* not NEW_GC */ |
| 428 | 1485 } |
| 1486 | |
| 1487 /* Retrieve the extent list that an extent is a member of; the | |
| 1488 return value will never be 0 except in destroyed buffers (in which | |
| 1489 case the only extents that can refer to this buffer are detached | |
| 1490 ones). */ | |
| 1491 | |
| 1492 #define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e)) | |
| 1493 | |
| 1494 /* ------------------------------- */ | |
| 1495 /* stack of extents */ | |
| 1496 /* ------------------------------- */ | |
| 1497 | |
| 1498 #ifdef ERROR_CHECK_EXTENTS | |
| 1499 | |
| 771 | 1500 /* See unicode.c for more about sledgehammer checks */ |
| 1501 | |
| 428 | 1502 void |
| 1503 sledgehammer_extent_check (Lisp_Object object) | |
| 1504 { | |
| 1505 int i; | |
| 1506 int endp; | |
| 1507 Extent_List *el = buffer_or_string_extent_list (object); | |
| 1508 struct buffer *buf = 0; | |
| 1509 | |
| 1510 if (!el) | |
| 1511 return; | |
| 1512 | |
| 1513 if (BUFFERP (object)) | |
| 1514 buf = XBUFFER (object); | |
| 1515 | |
| 1516 for (endp = 0; endp < 2; endp++) | |
| 1517 for (i = 1; i < extent_list_num_els (el); i++) | |
| 1518 { | |
| 1519 EXTENT e1 = extent_list_at (el, i-1, endp); | |
| 1520 EXTENT e2 = extent_list_at (el, i, endp); | |
| 1521 if (buf) | |
| 1522 { | |
| 1523 assert (extent_start (e1) <= buf->text->gpt || | |
| 1524 extent_start (e1) > buf->text->gpt + buf->text->gap_size); | |
| 1525 assert (extent_end (e1) <= buf->text->gpt || | |
| 1526 extent_end (e1) > buf->text->gpt + buf->text->gap_size); | |
| 1527 } | |
| 1528 assert (extent_start (e1) <= extent_end (e1)); | |
| 1529 assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) : | |
| 1530 (EXTENT_LESS_EQUAL (e1, e2))); | |
| 1531 } | |
| 1532 } | |
| 1533 | |
| 1534 #endif | |
| 1535 | |
| 1536 static Stack_Of_Extents * | |
| 1537 buffer_or_string_stack_of_extents (Lisp_Object object) | |
| 1538 { | |
| 1539 struct extent_info *info = buffer_or_string_extent_info (object); | |
| 1540 if (!info) | |
| 1541 return 0; | |
| 1542 return info->soe; | |
| 1543 } | |
| 1544 | |
| 1545 static Stack_Of_Extents * | |
| 1546 buffer_or_string_stack_of_extents_force (Lisp_Object object) | |
| 1547 { | |
| 1548 struct extent_info *info = buffer_or_string_extent_info_force (object); | |
| 1549 if (!info->soe) | |
| 1550 info->soe = allocate_soe (); | |
| 1551 return info->soe; | |
| 1552 } | |
| 1553 | |
| 983 | 1554 /* #### don't even think of #define'ing this, the prototype of |
| 1555 print_extent_1 has changed! */ | |
| 428 | 1556 /* #define SOE_DEBUG */ |
| 1557 | |
| 1558 #ifdef SOE_DEBUG | |
| 1559 | |
| 1560 static void print_extent_1 (char *buf, Lisp_Object extent); | |
| 1561 | |
| 1562 static void | |
| 1563 print_extent_2 (EXTENT e) | |
| 1564 { | |
| 1565 Lisp_Object extent; | |
| 1566 char buf[200]; | |
| 1567 | |
| 793 | 1568 extent = wrap_extent (e); |
| 428 | 1569 print_extent_1 (buf, extent); |
| 1570 fputs (buf, stdout); | |
| 1571 } | |
| 1572 | |
| 1573 static void | |
| 1574 soe_dump (Lisp_Object obj) | |
| 1575 { | |
| 1576 int i; | |
| 1577 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); | |
| 1578 Extent_List *sel; | |
| 1579 int endp; | |
| 1580 | |
| 1581 if (!soe) | |
| 1582 { | |
| 1583 printf ("No SOE"); | |
| 1584 return; | |
| 1585 } | |
| 1586 sel = soe->extents; | |
| 826 | 1587 printf ("SOE pos is %d (memxpos %d)\n", |
| 428 | 1588 soe->pos < 0 ? soe->pos : |
| 826 | 1589 buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), |
| 428 | 1590 soe->pos); |
| 1591 for (endp = 0; endp < 2; endp++) | |
| 1592 { | |
| 1593 printf (endp ? "SOE end:" : "SOE start:"); | |
| 1594 for (i = 0; i < extent_list_num_els (sel); i++) | |
| 1595 { | |
| 1596 EXTENT e = extent_list_at (sel, i, endp); | |
| 1597 putchar ('\t'); | |
| 1598 print_extent_2 (e); | |
| 1599 } | |
| 1600 putchar ('\n'); | |
| 1601 } | |
| 1602 putchar ('\n'); | |
| 1603 } | |
| 1604 | |
| 1605 #endif | |
| 1606 | |
| 1607 /* Insert EXTENT into OBJ's stack of extents, if necessary. */ | |
| 1608 | |
| 1609 static void | |
| 1610 soe_insert (Lisp_Object obj, EXTENT extent) | |
| 1611 { | |
| 1612 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); | |
| 1613 | |
| 1614 #ifdef SOE_DEBUG | |
| 1615 printf ("Inserting into SOE: "); | |
| 1616 print_extent_2 (extent); | |
| 1617 putchar ('\n'); | |
| 1618 #endif | |
| 1619 if (!soe || soe->pos < extent_start (extent) || | |
| 1620 soe->pos > extent_end (extent)) | |
| 1621 { | |
| 1622 #ifdef SOE_DEBUG | |
| 1623 printf ("(not needed)\n\n"); | |
| 1624 #endif | |
| 1625 return; | |
| 1626 } | |
| 1627 extent_list_insert (soe->extents, extent); | |
| 1628 #ifdef SOE_DEBUG | |
| 1629 puts ("SOE afterwards is:"); | |
| 1630 soe_dump (obj); | |
| 1631 #endif | |
| 1632 } | |
| 1633 | |
| 1634 /* Delete EXTENT from OBJ's stack of extents, if necessary. */ | |
| 1635 | |
| 1636 static void | |
| 1637 soe_delete (Lisp_Object obj, EXTENT extent) | |
| 1638 { | |
| 1639 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); | |
| 1640 | |
| 1641 #ifdef SOE_DEBUG | |
| 1642 printf ("Deleting from SOE: "); | |
| 1643 print_extent_2 (extent); | |
| 1644 putchar ('\n'); | |
| 1645 #endif | |
| 1646 if (!soe || soe->pos < extent_start (extent) || | |
| 1647 soe->pos > extent_end (extent)) | |
| 1648 { | |
| 1649 #ifdef SOE_DEBUG | |
| 1650 puts ("(not needed)\n"); | |
| 1651 #endif | |
| 1652 return; | |
| 1653 } | |
| 1654 extent_list_delete (soe->extents, extent); | |
| 1655 #ifdef SOE_DEBUG | |
| 1656 puts ("SOE afterwards is:"); | |
| 1657 soe_dump (obj); | |
| 1658 #endif | |
| 1659 } | |
| 1660 | |
| 1661 /* Move OBJ's stack of extents to lie over the specified position. */ | |
| 1662 | |
| 1663 static void | |
| 826 | 1664 soe_move (Lisp_Object obj, Memxpos pos) |
| 428 | 1665 { |
| 1666 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); | |
| 1667 Extent_List *sel = soe->extents; | |
| 1668 int numsoe = extent_list_num_els (sel); | |
| 1669 Extent_List *bel = buffer_or_string_extent_list (obj); | |
| 1670 int direction; | |
| 1671 int endp; | |
| 1672 | |
| 1673 #ifdef ERROR_CHECK_EXTENTS | |
| 1674 assert (bel); | |
| 1675 #endif | |
| 1676 | |
| 1677 #ifdef SOE_DEBUG | |
| 826 | 1678 printf ("Moving SOE from %d (memxpos %d) to %d (memxpos %d)\n", |
| 428 | 1679 soe->pos < 0 ? soe->pos : |
| 826 | 1680 buffer_or_string_memxpos_to_bytexpos (obj, soe->pos), soe->pos, |
| 1681 buffer_or_string_memxpos_to_bytexpos (obj, pos), pos); | |
| 428 | 1682 #endif |
| 1683 if (soe->pos < pos) | |
| 1684 { | |
| 1685 direction = 1; | |
| 1686 endp = 0; | |
| 1687 } | |
| 1688 else if (soe->pos > pos) | |
| 1689 { | |
| 1690 direction = -1; | |
| 1691 endp = 1; | |
| 1692 } | |
| 1693 else | |
| 1694 { | |
| 1695 #ifdef SOE_DEBUG | |
| 1696 puts ("(not needed)\n"); | |
| 1697 #endif | |
| 1698 return; | |
| 1699 } | |
| 1700 | |
| 1701 /* For DIRECTION = 1: Any extent that overlaps POS is either in the | |
| 1702 SOE (if the extent starts at or before SOE->POS) or is greater | |
| 1703 (in the display order) than any extent in the SOE (if it starts | |
| 1704 after SOE->POS). | |
| 1705 | |
| 1706 For DIRECTION = -1: Any extent that overlaps POS is either in the | |
| 1707 SOE (if the extent ends at or after SOE->POS) or is less (in the | |
| 1708 e-order) than any extent in the SOE (if it ends before SOE->POS). | |
| 1709 | |
| 1710 We proceed in two stages: | |
| 1711 | |
| 1712 1) delete all extents in the SOE that don't overlap POS. | |
| 1713 2) insert all extents into the SOE that start (or end, when | |
| 1714 DIRECTION = -1) in (SOE->POS, POS] and that overlap | |
| 1715 POS. (Don't include SOE->POS in the range because those | |
| 1716 extents would already be in the SOE.) | |
| 1717 */ | |
| 1718 | |
| 1719 /* STAGE 1. */ | |
| 1720 | |
| 1721 if (numsoe > 0) | |
| 1722 { | |
| 1723 /* Delete all extents in the SOE that don't overlap POS. | |
| 1724 This is all extents that end before (or start after, | |
| 1725 if DIRECTION = -1) POS. | |
| 1726 */ | |
| 1727 | |
| 1728 /* Deleting extents from the SOE is tricky because it changes | |
| 1729 the positions of extents. If we are deleting in the forward | |
| 1730 direction we have to call extent_list_at() on the same position | |
| 1731 over and over again because positions after the deleted element | |
| 1732 get shifted back by 1. To make life simplest, we delete forward | |
| 1733 irrespective of DIRECTION. | |
| 1734 */ | |
| 1735 int start, end; | |
| 1736 int i; | |
| 1737 | |
| 1738 if (direction > 0) | |
| 1739 { | |
| 1740 start = 0; | |
| 1741 end = extent_list_locate_from_pos (sel, pos, 1); | |
| 1742 } | |
| 1743 else | |
| 1744 { | |
| 1745 start = extent_list_locate_from_pos (sel, pos+1, 0); | |
| 1746 end = numsoe; | |
| 1747 } | |
| 1748 | |
| 1749 for (i = start; i < end; i++) | |
| 1750 extent_list_delete (sel, extent_list_at (sel, start /* see above */, | |
| 1751 !endp)); | |
| 1752 } | |
| 1753 | |
| 1754 /* STAGE 2. */ | |
| 1755 | |
| 1756 { | |
| 1757 int start_pos; | |
| 1758 | |
| 1759 if (direction < 0) | |
| 1760 start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1; | |
| 1761 else | |
| 1762 start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp); | |
| 1763 | |
| 1764 for (; start_pos >= 0 && start_pos < extent_list_num_els (bel); | |
| 1765 start_pos += direction) | |
| 1766 { | |
| 1767 EXTENT e = extent_list_at (bel, start_pos, endp); | |
| 1768 if ((direction > 0) ? | |
| 1769 (extent_start (e) > pos) : | |
| 1770 (extent_end (e) < pos)) | |
| 1771 break; /* All further extents lie on the far side of POS | |
| 1772 and thus can't overlap. */ | |
| 1773 if ((direction > 0) ? | |
| 1774 (extent_end (e) >= pos) : | |
| 1775 (extent_start (e) <= pos)) | |
| 1776 extent_list_insert (sel, e); | |
| 1777 } | |
| 1778 } | |
| 1779 | |
| 1780 soe->pos = pos; | |
| 1781 #ifdef SOE_DEBUG | |
| 1782 puts ("SOE afterwards is:"); | |
| 1783 soe_dump (obj); | |
| 1784 #endif | |
| 1785 } | |
| 1786 | |
| 1787 static void | |
| 1788 soe_invalidate (Lisp_Object obj) | |
| 1789 { | |
| 1790 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); | |
| 1791 | |
| 1792 if (soe) | |
| 1793 { | |
| 1794 extent_list_delete_all (soe->extents); | |
| 1795 soe->pos = -1; | |
| 1796 } | |
| 1797 } | |
| 1798 | |
| 1799 static struct stack_of_extents * | |
| 1800 allocate_soe (void) | |
| 1801 { | |
| 3092 | 1802 #ifdef NEW_GC |
| 1803 struct stack_of_extents *soe = | |
| 1804 alloc_lrecord_type (struct stack_of_extents, &lrecord_stack_of_extents); | |
| 1805 #else /* not NEW_GC */ | |
| 428 | 1806 struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents); |
| 3092 | 1807 #endif /* not NEW_GC */ |
| 428 | 1808 soe->extents = allocate_extent_list (); |
| 1809 soe->pos = -1; | |
| 1810 return soe; | |
| 1811 } | |
| 1812 | |
| 3092 | 1813 #ifndef NEW_GC |
| 428 | 1814 static void |
| 1815 free_soe (struct stack_of_extents *soe) | |
| 1816 { | |
| 1817 free_extent_list (soe->extents); | |
| 1726 | 1818 xfree (soe, struct stack_of_extents *); |
| 428 | 1819 } |
| 3092 | 1820 #endif /* not NEW_GC */ |
| 428 | 1821 |
| 1822 /* ------------------------------- */ | |
| 1823 /* other primitives */ | |
| 1824 /* ------------------------------- */ | |
| 1825 | |
| 1826 /* Return the start (endp == 0) or end (endp == 1) of an extent as | |
| 1827 a byte index. If you want the value as a memory index, use | |
| 1828 extent_endpoint(). If you want the value as a buffer position, | |
| 826 | 1829 use extent_endpoint_char(). */ |
| 1830 | |
| 1831 Bytexpos | |
| 1832 extent_endpoint_byte (EXTENT extent, int endp) | |
| 1833 { | |
| 1834 assert (EXTENT_LIVE_P (extent)); | |
| 1835 assert (!extent_detached_p (extent)); | |
| 1836 { | |
| 1837 Memxpos i = endp ? extent_end (extent) : extent_start (extent); | |
| 1838 Lisp_Object obj = extent_object (extent); | |
| 1839 return buffer_or_string_memxpos_to_bytexpos (obj, i); | |
| 1840 } | |
| 1841 } | |
| 1842 | |
| 1843 Charxpos | |
| 1844 extent_endpoint_char (EXTENT extent, int endp) | |
| 428 | 1845 { |
| 1846 assert (EXTENT_LIVE_P (extent)); | |
| 1847 assert (!extent_detached_p (extent)); | |
| 1848 { | |
| 826 | 1849 Memxpos i = endp ? extent_end (extent) : extent_start (extent); |
| 428 | 1850 Lisp_Object obj = extent_object (extent); |
| 826 | 1851 return buffer_or_string_memxpos_to_charxpos (obj, i); |
| 428 | 1852 } |
| 1853 } | |
| 1854 | |
| 1855 static void | |
| 826 | 1856 signal_single_extent_changed (EXTENT extent, Lisp_Object property, |
| 2286 | 1857 Bytexpos UNUSED (old_start), |
| 1858 Bytexpos UNUSED (old_end)) | |
| 826 | 1859 { |
| 1860 EXTENT anc = extent_ancestor (extent); | |
| 1861 /* Redisplay checks */ | |
| 1862 if (NILP (property) ? | |
| 1863 (!NILP (extent_face (anc)) || | |
| 1864 !NILP (extent_begin_glyph (anc)) || | |
| 1865 !NILP (extent_end_glyph (anc)) || | |
| 1866 !NILP (extent_mouse_face (anc)) || | |
| 1867 !NILP (extent_invisible (anc)) || | |
| 1868 !NILP (extent_initial_redisplay_function (anc))) : | |
| 1869 EQ (property, Qface) || | |
| 1870 EQ (property, Qmouse_face) || | |
| 1871 EQ (property, Qbegin_glyph) || | |
| 1872 EQ (property, Qend_glyph) || | |
| 1873 EQ (property, Qbegin_glyph_layout) || | |
| 1874 EQ (property, Qend_glyph_layout) || | |
| 1875 EQ (property, Qinvisible) || | |
| 1876 EQ (property, Qinitial_redisplay_function) || | |
| 1877 EQ (property, Qpriority)) | |
| 1878 { | |
| 1879 Lisp_Object object = extent_object (extent); | |
| 1880 | |
| 1881 if (extent_detached_p (extent)) | |
| 1882 return; | |
| 1883 | |
| 1884 else if (STRINGP (object)) | |
| 1885 { | |
| 1886 /* #### Changes to string extents can affect redisplay if they are | |
| 1887 in the modeline or in the gutters. | |
| 1888 | |
| 1889 If the extent is in some generated-modeline-string: when we | |
| 1890 change an extent in generated-modeline-string, this changes its | |
| 1891 parent, which is in `modeline-format', so we should force the | |
| 1892 modeline to be updated. But how to determine whether a string | |
| 1893 is a `generated-modeline-string'? Looping through all buffers | |
| 1894 is not very efficient. Should we add all | |
| 1895 `generated-modeline-string' strings to a hash table? Maybe | |
| 1896 efficiency is not the greatest concern here and there's no big | |
| 1897 loss in looping over the buffers. | |
| 1898 | |
| 1899 If the extent is in a gutter we mark the gutter as | |
| 1900 changed. This means (a) we can update extents in the gutters | |
| 1901 when we need it. (b) we don't have to update the gutters when | |
| 1902 only extents attached to buffers have changed. */ | |
| 1903 | |
| 1904 if (!in_modeline_generation) | |
| 1905 MARK_EXTENTS_CHANGED; | |
| 1906 gutter_extent_signal_changed_region_maybe | |
| 1907 (object, extent_endpoint_char (extent, 0), | |
| 1908 extent_endpoint_char (extent, 1)); | |
| 1909 } | |
| 1910 else if (BUFFERP (object)) | |
| 1911 { | |
| 1912 struct buffer *b; | |
| 1913 b = XBUFFER (object); | |
| 1914 BUF_FACECHANGE (b)++; | |
| 1915 MARK_EXTENTS_CHANGED; | |
| 1916 if (NILP (property) ? !NILP (extent_invisible (anc)) : | |
| 1917 EQ (property, Qinvisible)) | |
| 1918 MARK_CLIP_CHANGED; | |
| 1919 buffer_extent_signal_changed_region | |
| 1920 (b, extent_endpoint_char (extent, 0), | |
| 1921 extent_endpoint_char (extent, 1)); | |
| 1922 } | |
| 1923 } | |
| 1924 | |
| 1925 /* Check for syntax table property change */ | |
| 1926 if (NILP (property) ? !NILP (Fextent_property (wrap_extent (extent), | |
| 1927 Qsyntax_table, Qnil)) : | |
| 1928 EQ (property, Qsyntax_table)) | |
| 3250 | 1929 signal_syntax_cache_extent_changed (extent); |
| 826 | 1930 } |
| 1931 | |
| 1932 /* Make note that a change has happened in EXTENT. The change was either | |
| 1933 to a property or to the endpoints (but not both at once). If PROPERTY | |
| 1934 is non-nil, the change happened to that property; otherwise, the change | |
| 1935 happened to the endpoints, and the old ones are given. Currently, all | |
| 1936 endpoints changes are in the form of two signals, a detach followed by | |
| 1937 an attach, and when detaching, we are signalled before the extent is | |
| 1938 detached. (You can distinguish a detach from an attach because the | |
| 1939 latter has old_start == -1 and old_end == -1.) (#### We don't currently | |
| 1940 give the old property. If someone needs that, this will have to | |
| 1941 change.) KLUDGE: If PROPERTY is Qt, all properties may have changed | |
| 1942 because the parent was changed. #### We need to handle this properly, by | |
| 1943 mapping over properties. */ | |
| 1944 | |
| 1945 static void | |
| 1946 signal_extent_changed (EXTENT extent, Lisp_Object property, | |
| 1947 Bytexpos old_start, Bytexpos old_end, | |
| 1948 int descendants_too) | |
| 1949 { | |
| 428 | 1950 /* we could easily encounter a detached extent while traversing the |
| 1951 children, but we should never be able to encounter a dead extent. */ | |
| 1952 assert (EXTENT_LIVE_P (extent)); | |
| 1953 | |
| 1954 if (descendants_too) | |
| 1955 { | |
| 1956 Lisp_Object children = extent_children (extent); | |
| 1957 | |
| 1958 if (!NILP (children)) | |
| 1959 { | |
| 826 | 1960 /* first process all of the extent's children. We will lose |
| 1961 big-time if there are any circularities here, so we sure as | |
| 1962 hell better ensure that there aren't. */ | |
| 831 | 1963 LIST_LOOP_2 (child, XWEAK_LIST_LIST (children)) |
| 1964 signal_extent_changed (XEXTENT (child), property, old_start, | |
| 840 | 1965 old_end, descendants_too); |
| 428 | 1966 } |
| 1967 } | |
| 1968 | |
| 826 | 1969 /* now process the extent itself. */ |
| 1970 signal_single_extent_changed (extent, property, old_start, old_end); | |
| 1971 } | |
| 428 | 1972 |
| 1973 static void | |
| 826 | 1974 signal_extent_property_changed (EXTENT extent, Lisp_Object property, |
| 1975 int descendants_too) | |
| 1976 { | |
| 1977 signal_extent_changed (extent, property, 0, 0, descendants_too); | |
| 428 | 1978 } |
| 1979 | |
| 1980 static EXTENT | |
| 1981 make_extent_detached (Lisp_Object object) | |
| 1982 { | |
| 1983 EXTENT extent = allocate_extent (); | |
| 1984 | |
| 1985 assert (NILP (object) || STRINGP (object) || | |
| 1986 (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))); | |
| 1987 extent_object (extent) = object; | |
| 1988 /* Now make sure the extent info exists. */ | |
| 1989 if (!NILP (object)) | |
| 1990 buffer_or_string_extent_info_force (object); | |
| 1991 return extent; | |
| 1992 } | |
| 1993 | |
| 1994 /* A "real" extent is any extent other than the internal (not-user-visible) | |
| 1995 extents used by `map-extents'. */ | |
| 1996 | |
| 1997 static EXTENT | |
| 1998 real_extent_at_forward (Extent_List *el, int pos, int endp) | |
| 1999 { | |
| 2000 for (; pos < extent_list_num_els (el); pos++) | |
| 2001 { | |
| 2002 EXTENT e = extent_list_at (el, pos, endp); | |
| 2003 if (!extent_internal_p (e)) | |
| 2004 return e; | |
| 2005 } | |
| 2006 return 0; | |
| 2007 } | |
| 2008 | |
| 2009 static EXTENT | |
| 2010 real_extent_at_backward (Extent_List *el, int pos, int endp) | |
| 2011 { | |
| 2012 for (; pos >= 0; pos--) | |
| 2013 { | |
| 2014 EXTENT e = extent_list_at (el, pos, endp); | |
| 2015 if (!extent_internal_p (e)) | |
| 2016 return e; | |
| 2017 } | |
| 2018 return 0; | |
| 2019 } | |
| 2020 | |
| 2021 static EXTENT | |
| 2022 extent_first (Lisp_Object obj) | |
| 2023 { | |
| 2024 Extent_List *el = buffer_or_string_extent_list (obj); | |
| 2025 | |
| 2026 if (!el) | |
| 2027 return 0; | |
| 2028 return real_extent_at_forward (el, 0, 0); | |
| 2029 } | |
| 2030 | |
| 2031 #ifdef DEBUG_XEMACS | |
| 2032 static EXTENT | |
| 2033 extent_e_first (Lisp_Object obj) | |
| 2034 { | |
| 2035 Extent_List *el = buffer_or_string_extent_list (obj); | |
| 2036 | |
| 2037 if (!el) | |
| 2038 return 0; | |
| 2039 return real_extent_at_forward (el, 0, 1); | |
| 2040 } | |
| 2041 #endif | |
| 2042 | |
| 2043 static EXTENT | |
| 2044 extent_next (EXTENT e) | |
| 2045 { | |
| 2046 Extent_List *el = extent_extent_list (e); | |
| 2047 int foundp; | |
| 2048 int pos = extent_list_locate (el, e, 0, &foundp); | |
| 2049 assert (foundp); | |
| 2050 return real_extent_at_forward (el, pos+1, 0); | |
| 2051 } | |
| 2052 | |
| 2053 #ifdef DEBUG_XEMACS | |
| 2054 static EXTENT | |
| 2055 extent_e_next (EXTENT e) | |
| 2056 { | |
| 2057 Extent_List *el = extent_extent_list (e); | |
| 2058 int foundp; | |
| 2059 int pos = extent_list_locate (el, e, 1, &foundp); | |
| 2060 assert (foundp); | |
| 2061 return real_extent_at_forward (el, pos+1, 1); | |
| 2062 } | |
| 2063 #endif | |
| 2064 | |
| 2065 static EXTENT | |
| 2066 extent_last (Lisp_Object obj) | |
| 2067 { | |
| 2068 Extent_List *el = buffer_or_string_extent_list (obj); | |
| 2069 | |
| 2070 if (!el) | |
| 2071 return 0; | |
| 2072 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0); | |
| 2073 } | |
| 2074 | |
| 2075 #ifdef DEBUG_XEMACS | |
| 2076 static EXTENT | |
| 2077 extent_e_last (Lisp_Object obj) | |
| 2078 { | |
| 2079 Extent_List *el = buffer_or_string_extent_list (obj); | |
| 2080 | |
| 2081 if (!el) | |
| 2082 return 0; | |
| 2083 return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1); | |
| 2084 } | |
| 2085 #endif | |
| 2086 | |
| 2087 static EXTENT | |
| 2088 extent_previous (EXTENT e) | |
| 2089 { | |
| 2090 Extent_List *el = extent_extent_list (e); | |
| 2091 int foundp; | |
| 2092 int pos = extent_list_locate (el, e, 0, &foundp); | |
| 2093 assert (foundp); | |
| 2094 return real_extent_at_backward (el, pos-1, 0); | |
| 2095 } | |
| 2096 | |
| 2097 #ifdef DEBUG_XEMACS | |
| 2098 static EXTENT | |
| 2099 extent_e_previous (EXTENT e) | |
| 2100 { | |
| 2101 Extent_List *el = extent_extent_list (e); | |
| 2102 int foundp; | |
| 2103 int pos = extent_list_locate (el, e, 1, &foundp); | |
| 2104 assert (foundp); | |
| 2105 return real_extent_at_backward (el, pos-1, 1); | |
| 2106 } | |
| 2107 #endif | |
| 2108 | |
| 2109 static void | |
| 2110 extent_attach (EXTENT extent) | |
| 2111 { | |
| 2112 Extent_List *el = extent_extent_list (extent); | |
| 2113 | |
| 2114 extent_list_insert (el, extent); | |
| 2115 soe_insert (extent_object (extent), extent); | |
| 2116 /* only this extent changed */ | |
| 826 | 2117 signal_extent_changed (extent, Qnil, -1, -1, 0); |
| 428 | 2118 } |
| 2119 | |
| 2120 static void | |
| 2121 extent_detach (EXTENT extent) | |
| 2122 { | |
| 2123 Extent_List *el; | |
| 2124 | |
| 2125 if (extent_detached_p (extent)) | |
| 2126 return; | |
| 2127 el = extent_extent_list (extent); | |
| 2128 | |
| 2129 /* call this before messing with the extent. */ | |
| 826 | 2130 signal_extent_changed (extent, Qnil, |
| 2131 extent_endpoint_byte (extent, 0), | |
| 2132 extent_endpoint_char (extent, 0), | |
| 2133 0); | |
| 428 | 2134 extent_list_delete (el, extent); |
| 2135 soe_delete (extent_object (extent), extent); | |
| 2136 set_extent_start (extent, -1); | |
| 2137 set_extent_end (extent, -1); | |
| 2138 } | |
| 2139 | |
| 2140 /* ------------------------------- */ | |
| 2141 /* map-extents et al. */ | |
| 2142 /* ------------------------------- */ | |
| 2143 | |
| 2144 /* Returns true iff map_extents() would visit the given extent. | |
| 2145 See the comments at map_extents() for info on the overlap rule. | |
| 2146 Assumes that all validation on the extent and buffer positions has | |
| 2147 already been performed (see Fextent_in_region_p ()). | |
| 2148 */ | |
| 2149 static int | |
| 826 | 2150 extent_in_region_p (EXTENT extent, Bytexpos from, Bytexpos to, |
| 428 | 2151 unsigned int flags) |
| 2152 { | |
| 2153 Lisp_Object obj = extent_object (extent); | |
| 2154 Endpoint_Index start, end, exs, exe; | |
| 2155 int start_open, end_open; | |
| 2156 unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK; | |
| 2157 unsigned int in_region_flags = flags & ME_IN_REGION_MASK; | |
| 2158 int retval; | |
| 2159 | |
| 2160 /* A zero-length region is treated as closed-closed. */ | |
| 2161 if (from == to) | |
| 2162 { | |
| 2163 flags |= ME_END_CLOSED; | |
| 2164 flags &= ~ME_START_OPEN; | |
| 2165 } | |
| 2166 | |
| 2167 /* So is a zero-length extent. */ | |
| 2168 if (extent_start (extent) == extent_end (extent)) | |
| 2169 start_open = 0, end_open = 0; | |
| 2170 /* `all_extents_flags' will almost always be zero. */ | |
| 2171 else if (all_extents_flags == 0) | |
| 2172 { | |
| 2173 start_open = extent_start_open_p (extent); | |
| 2174 end_open = extent_end_open_p (extent); | |
| 2175 } | |
| 2176 else | |
| 2177 switch (all_extents_flags) | |
| 2178 { | |
| 2179 case ME_ALL_EXTENTS_CLOSED: start_open = 0, end_open = 0; break; | |
| 2180 case ME_ALL_EXTENTS_OPEN: start_open = 1, end_open = 1; break; | |
| 2181 case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break; | |
| 2182 case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break; | |
| 2500 | 2183 default: ABORT(); return 0; |
| 428 | 2184 } |
| 2185 | |
| 826 | 2186 start = buffer_or_string_bytexpos_to_startind (obj, from, |
| 428 | 2187 flags & ME_START_OPEN); |
| 826 | 2188 end = buffer_or_string_bytexpos_to_endind (obj, to, |
| 2189 ! (flags & ME_END_CLOSED)); | |
| 2190 exs = memxpos_to_startind (extent_start (extent), start_open); | |
| 2191 exe = memxpos_to_endind (extent_end (extent), end_open); | |
| 428 | 2192 |
| 2193 /* It's easy to determine whether an extent lies *outside* the | |
| 2194 region -- just determine whether it's completely before | |
| 2195 or completely after the region. Reject all such extents, so | |
| 2196 we're now left with only the extents that overlap the region. | |
| 2197 */ | |
| 2198 | |
| 2199 if (exs > end || exe < start) | |
| 2200 return 0; | |
| 2201 | |
| 2202 /* See if any further restrictions are called for. */ | |
| 2203 /* in_region_flags will almost always be zero. */ | |
| 2204 if (in_region_flags == 0) | |
| 2205 retval = 1; | |
| 2206 else | |
| 2207 switch (in_region_flags) | |
| 2208 { | |
| 2209 case ME_START_IN_REGION: | |
| 2210 retval = start <= exs && exs <= end; break; | |
| 2211 case ME_END_IN_REGION: | |
| 2212 retval = start <= exe && exe <= end; break; | |
| 2213 case ME_START_AND_END_IN_REGION: | |
| 2214 retval = start <= exs && exe <= end; break; | |
| 2215 case ME_START_OR_END_IN_REGION: | |
| 2216 retval = (start <= exs && exs <= end) || (start <= exe && exe <= end); | |
| 2217 break; | |
| 2218 default: | |
| 2500 | 2219 ABORT(); return 0; |
| 428 | 2220 } |
| 2221 return flags & ME_NEGATE_IN_REGION ? !retval : retval; | |
| 2222 } | |
| 2223 | |
| 2224 struct map_extents_struct | |
| 2225 { | |
| 2226 Extent_List *el; | |
| 2227 Extent_List_Marker *mkr; | |
| 2228 EXTENT range; | |
| 2229 }; | |
| 2230 | |
| 2231 static Lisp_Object | |
| 2232 map_extents_unwind (Lisp_Object obj) | |
| 2233 { | |
| 2234 struct map_extents_struct *closure = | |
| 2235 (struct map_extents_struct *) get_opaque_ptr (obj); | |
| 2236 free_opaque_ptr (obj); | |
| 2237 if (closure->range) | |
| 2238 extent_detach (closure->range); | |
| 2239 if (closure->mkr) | |
| 2240 extent_list_delete_marker (closure->el, closure->mkr); | |
| 2241 return Qnil; | |
| 2242 } | |
| 2243 | |
| 2244 /* This is the guts of `map-extents' and the other functions that | |
| 2245 map over extents. In theory the operation of this function is | |
| 2246 simple: just figure out what extents we're mapping over, and | |
| 2247 call the function on each one of them in the range. Unfortunately | |
| 2248 there are a wide variety of things that the mapping function | |
| 2249 might do, and we have to be very tricky to avoid getting messed | |
| 2250 up. Furthermore, this function needs to be very fast (it is | |
| 2251 called multiple times every time text is inserted or deleted | |
| 2252 from a buffer), and so we can't always afford the overhead of | |
| 2253 dealing with all the possible things that the mapping function | |
| 2254 might do; thus, there are many flags that can be specified | |
| 2255 indicating what the mapping function might or might not do. | |
| 2256 | |
| 2257 The result of all this is that this is the most complicated | |
| 2258 function in this file. Change it at your own risk! | |
| 2259 | |
| 2260 A potential simplification to the logic below is to determine | |
| 2261 all the extents that the mapping function should be called on | |
| 2262 before any calls are actually made and save them in an array. | |
| 2263 That introduces its own complications, however (the array | |
| 2264 needs to be marked for garbage-collection, and a static array | |
| 2265 cannot be used because map_extents() needs to be reentrant). | |
| 2266 Furthermore, the results might be a little less sensible than | |
| 2267 the logic below. */ | |
| 2268 | |
| 2269 | |
| 2270 static void | |
| 826 | 2271 map_extents (Bytexpos from, Bytexpos to, map_extents_fun fn, |
| 2272 void *arg, Lisp_Object obj, EXTENT after, | |
| 2273 unsigned int flags) | |
| 2274 { | |
| 2275 Memxpos st, en; /* range we're mapping over */ | |
| 428 | 2276 EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */ |
| 2277 Extent_List *el = 0; /* extent list we're iterating over */ | |
| 2278 Extent_List_Marker *posm = 0; /* marker for extent list, | |
| 2279 if ME_MIGHT_MODIFY_EXTENTS */ | |
| 2280 /* count and struct for unwind-protect, if ME_MIGHT_THROW */ | |
| 1292 | 2281 int count = specpdl_depth (); |
| 428 | 2282 struct map_extents_struct closure; |
| 1292 | 2283 PROFILE_DECLARE (); |
| 428 | 2284 |
| 2285 #ifdef ERROR_CHECK_EXTENTS | |
| 2286 assert (from <= to); | |
| 2287 assert (from >= buffer_or_string_absolute_begin_byte (obj) && | |
| 2288 from <= buffer_or_string_absolute_end_byte (obj) && | |
| 2289 to >= buffer_or_string_absolute_begin_byte (obj) && | |
| 2290 to <= buffer_or_string_absolute_end_byte (obj)); | |
| 2291 #endif | |
| 2292 | |
| 2293 if (after) | |
| 2294 { | |
| 2295 assert (EQ (obj, extent_object (after))); | |
| 2296 assert (!extent_detached_p (after)); | |
| 2297 } | |
| 2298 | |
| 2299 el = buffer_or_string_extent_list (obj); | |
| 1292 | 2300 if (!el || !extent_list_num_els (el)) |
| 428 | 2301 return; |
| 2302 el = 0; | |
| 2303 | |
| 1292 | 2304 PROFILE_RECORD_ENTERING_SECTION (QSin_map_extents_internal); |
| 2305 | |
| 826 | 2306 st = buffer_or_string_bytexpos_to_memxpos (obj, from); |
| 2307 en = buffer_or_string_bytexpos_to_memxpos (obj, to); | |
| 428 | 2308 |
| 2309 if (flags & ME_MIGHT_MODIFY_TEXT) | |
| 2310 { | |
| 2311 /* The mapping function might change the text in the buffer, | |
| 2312 so make an internal extent to hold the range we're mapping | |
| 2313 over. */ | |
| 2314 range = make_extent_detached (obj); | |
| 2315 set_extent_start (range, st); | |
| 2316 set_extent_end (range, en); | |
| 2317 range->flags.start_open = flags & ME_START_OPEN; | |
| 2318 range->flags.end_open = !(flags & ME_END_CLOSED); | |
| 2319 range->flags.internal = 1; | |
| 2320 range->flags.detachable = 0; | |
| 2321 extent_attach (range); | |
| 2322 } | |
| 2323 | |
| 2324 if (flags & ME_MIGHT_THROW) | |
| 2325 { | |
| 2326 /* The mapping function might throw past us so we need to use an | |
| 2327 unwind_protect() to eliminate the internal extent and range | |
| 2328 that we use. */ | |
| 2329 closure.range = range; | |
| 2330 closure.mkr = 0; | |
| 2331 record_unwind_protect (map_extents_unwind, | |
| 2332 make_opaque_ptr (&closure)); | |
| 2333 } | |
| 2334 | |
| 2335 /* ---------- Figure out where we start and what direction | |
| 2336 we move in. This is the trickiest part of this | |
| 2337 function. ---------- */ | |
| 2338 | |
| 2339 /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION | |
| 2340 was specified and ME_NEGATE_IN_REGION was not specified, our job | |
| 2341 is simple because of the presence of the display order and e-order. | |
| 2342 (Note that theoretically do something similar for | |
| 2343 ME_START_OR_END_IN_REGION, but that would require more trickiness | |
| 2344 than it's worth to avoid hitting the same extent twice.) | |
| 2345 | |
| 2346 In the general case, all the extents that overlap a range can be | |
| 2347 divided into two classes: those whose start position lies within | |
| 2348 the range (including the range's end but not including the | |
| 2349 range's start), and those that overlap the start position, | |
| 2350 i.e. those in the SOE for the start position. Or equivalently, | |
| 2351 the extents can be divided into those whose end position lies | |
| 2352 within the range and those in the SOE for the end position. Note | |
| 2353 that for this purpose we treat both the range and all extents in | |
| 2354 the buffer as closed on both ends. If this is not what the ME_ | |
| 2355 flags specified, then we've mapped over a few too many extents, | |
| 2356 but no big deal because extent_in_region_p() will filter them | |
| 2357 out. Ideally, we could move the SOE to the closer of the range's | |
| 2358 two ends and work forwards or backwards from there. However, in | |
| 2359 order to make the semantics of the AFTER argument work out, we | |
| 2360 have to always go in the same direction; so we choose to always | |
| 2361 move the SOE to the start position. | |
| 2362 | |
| 2363 When it comes time to do the SOE stage, we first call soe_move() | |
| 2364 so that the SOE gets set up. Note that the SOE might get | |
| 2365 changed while we are mapping over its contents. If we can | |
| 2366 guarantee that the SOE won't get moved to a new position, we | |
| 2367 simply need to put a marker in the SOE and we will track deletions | |
| 2368 and insertions of extents in the SOE. If the SOE might get moved, | |
| 2369 however (this would happen as a result of a recursive invocation | |
| 2370 of map-extents or a call to a redisplay-type function), then | |
| 2371 trying to track its changes is hopeless, so we just keep a | |
| 2372 marker to the first (or last) extent in the SOE and use that as | |
| 2373 our bound. | |
| 2374 | |
| 2375 Finally, if DONT_USE_SOE is defined, we don't use the SOE at all | |
| 2376 and instead just map from the beginning of the buffer. This is | |
| 2377 used for testing purposes and allows the SOE to be calculated | |
| 2378 using map_extents() instead of the other way around. */ | |
| 2379 | |
| 2380 { | |
| 2381 int range_flag; /* ME_*_IN_REGION subset of flags */ | |
| 2382 int do_soe_stage = 0; /* Are we mapping over the SOE? */ | |
| 2383 /* Does the range stage map over start or end positions? */ | |
| 2384 int range_endp; | |
| 2385 /* If type == 0, we include the start position in the range stage mapping. | |
| 2386 If type == 1, we exclude the start position in the range stage mapping. | |
| 2387 If type == 2, we begin at range_start_pos, an extent-list position. | |
| 2388 */ | |
| 2389 int range_start_type = 0; | |
| 2390 int range_start_pos = 0; | |
| 2391 int stage; | |
| 2392 | |
| 2393 range_flag = flags & ME_IN_REGION_MASK; | |
| 2394 if ((range_flag == ME_START_IN_REGION || | |
| 2395 range_flag == ME_START_AND_END_IN_REGION) && | |
| 2396 !(flags & ME_NEGATE_IN_REGION)) | |
| 2397 { | |
| 2398 /* map over start position in [range-start, range-end]. No SOE | |
| 2399 stage. */ | |
| 2400 range_endp = 0; | |
| 2401 } | |
| 2402 else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION)) | |
| 2403 { | |
| 2404 /* map over end position in [range-start, range-end]. No SOE | |
| 2405 stage. */ | |
| 2406 range_endp = 1; | |
| 2407 } | |
| 2408 else | |
| 2409 { | |
| 2410 /* Need to include the SOE extents. */ | |
| 2411 #ifdef DONT_USE_SOE | |
| 2412 /* Just brute-force it: start from the beginning. */ | |
| 2413 range_endp = 0; | |
| 2414 range_start_type = 2; | |
| 2415 range_start_pos = 0; | |
| 2416 #else | |
| 2417 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); | |
| 2418 int numsoe; | |
| 2419 | |
| 2420 /* Move the SOE to the closer end of the range. This dictates | |
| 2421 whether we map over start positions or end positions. */ | |
| 2422 range_endp = 0; | |
| 2423 soe_move (obj, st); | |
| 2424 numsoe = extent_list_num_els (soe->extents); | |
| 2425 if (numsoe) | |
| 2426 { | |
| 2427 if (flags & ME_MIGHT_MOVE_SOE) | |
| 2428 { | |
| 2429 int foundp; | |
| 2430 /* Can't map over SOE, so just extend range to cover the | |
| 2431 SOE. */ | |
| 2432 EXTENT e = extent_list_at (soe->extents, 0, 0); | |
| 2433 range_start_pos = | |
| 2434 extent_list_locate (buffer_or_string_extent_list (obj), e, 0, | |
| 2435 &foundp); | |
| 2436 assert (foundp); | |
| 2437 range_start_type = 2; | |
| 2438 } | |
| 2439 else | |
| 2440 { | |
| 2441 /* We can map over the SOE. */ | |
| 2442 do_soe_stage = 1; | |
| 2443 range_start_type = 1; | |
| 2444 } | |
| 2445 } | |
| 2446 else | |
| 2447 { | |
| 2448 /* No extents in the SOE to map over, so we act just as if | |
| 2449 ME_START_IN_REGION or ME_END_IN_REGION was specified. | |
| 2450 RANGE_ENDP already specified so no need to do anything else. */ | |
| 2451 } | |
| 2452 } | |
| 2453 #endif | |
| 2454 | |
| 2455 /* ---------- Now loop over the extents. ---------- */ | |
| 2456 | |
| 2457 /* We combine the code for the two stages because much of it | |
| 2458 overlaps. */ | |
| 2459 for (stage = 0; stage < 2; stage++) | |
| 2460 { | |
| 2461 int pos = 0; /* Position in extent list */ | |
| 2462 | |
| 2463 /* First set up start conditions */ | |
| 2464 if (stage == 0) | |
| 2465 { /* The SOE stage */ | |
| 2466 if (!do_soe_stage) | |
| 2467 continue; | |
| 2468 el = buffer_or_string_stack_of_extents_force (obj)->extents; | |
| 2469 /* We will always be looping over start extents here. */ | |
| 2470 assert (!range_endp); | |
| 2471 pos = 0; | |
| 2472 } | |
| 2473 else | |
| 2474 { /* The range stage */ | |
| 2475 el = buffer_or_string_extent_list (obj); | |
| 2476 switch (range_start_type) | |
| 2477 { | |
| 2478 case 0: | |
| 2479 pos = extent_list_locate_from_pos (el, st, range_endp); | |
| 2480 break; | |
| 2481 case 1: | |
| 2482 pos = extent_list_locate_from_pos (el, st + 1, range_endp); | |
| 2483 break; | |
| 2484 case 2: | |
| 2485 pos = range_start_pos; | |
| 2486 break; | |
| 2487 } | |
| 2488 } | |
| 2489 | |
| 2490 if (flags & ME_MIGHT_MODIFY_EXTENTS) | |
| 2491 { | |
| 2492 /* Create a marker to track changes to the extent list */ | |
| 2493 if (posm) | |
| 2494 /* Delete the marker used in the SOE stage. */ | |
| 2495 extent_list_delete_marker | |
| 2496 (buffer_or_string_stack_of_extents_force (obj)->extents, posm); | |
| 2497 posm = extent_list_make_marker (el, pos, range_endp); | |
| 2498 /* tell the unwind function about the marker. */ | |
| 2499 closure.el = el; | |
| 2500 closure.mkr = posm; | |
| 2501 } | |
| 2502 | |
| 2503 /* Now loop! */ | |
| 2504 for (;;) | |
| 2505 { | |
| 2506 EXTENT e; | |
| 2507 Lisp_Object obj2; | |
| 2508 | |
| 2509 /* ----- update position in extent list | |
| 2510 and fetch next extent ----- */ | |
| 2511 | |
| 2512 if (posm) | |
| 2513 /* fetch POS again to track extent insertions or deletions */ | |
| 2514 pos = extent_list_marker_pos (el, posm); | |
| 2515 if (pos >= extent_list_num_els (el)) | |
| 2516 break; | |
| 2517 e = extent_list_at (el, pos, range_endp); | |
| 2518 pos++; | |
| 2519 if (posm) | |
| 2520 /* now point the marker to the next one we're going to process. | |
| 2521 This ensures graceful behavior if this extent is deleted. */ | |
| 2522 extent_list_move_marker (el, posm, pos); | |
| 2523 | |
| 2524 /* ----- deal with internal extents ----- */ | |
| 2525 | |
| 2526 if (extent_internal_p (e)) | |
| 2527 { | |
| 2528 if (!(flags & ME_INCLUDE_INTERNAL)) | |
| 2529 continue; | |
| 2530 else if (e == range) | |
| 2531 { | |
| 2532 /* We're processing internal extents and we've | |
| 2533 come across our own special range extent. | |
| 2534 (This happens only in adjust_extents*() and | |
| 2535 process_extents*(), which handle text | |
| 2536 insertion and deletion.) We need to omit | |
| 2537 processing of this extent; otherwise | |
| 2538 we will probably end up prematurely | |
| 2539 terminating this loop. */ | |
| 2540 continue; | |
| 2541 } | |
| 2542 } | |
| 2543 | |
| 2544 /* ----- deal with AFTER condition ----- */ | |
| 2545 | |
| 2546 if (after) | |
| 2547 { | |
| 2548 /* if e > after, then we can stop skipping extents. */ | |
| 2549 if (EXTENT_LESS (after, e)) | |
| 2550 after = 0; | |
| 2551 else /* otherwise, skip this extent. */ | |
| 2552 continue; | |
| 2553 } | |
| 2554 | |
| 2555 /* ----- stop if we're completely outside the range ----- */ | |
| 2556 | |
| 2557 /* fetch ST and EN again to track text insertions or deletions */ | |
| 2558 if (range) | |
| 2559 { | |
| 2560 st = extent_start (range); | |
| 2561 en = extent_end (range); | |
| 2562 } | |
| 2563 if (extent_endpoint (e, range_endp) > en) | |
| 2564 { | |
| 2565 /* Can't be mapping over SOE because all extents in | |
| 2566 there should overlap ST */ | |
| 2567 assert (stage == 1); | |
| 2568 break; | |
| 2569 } | |
| 2570 | |
| 2571 /* ----- Now actually call the function ----- */ | |
| 2572 | |
| 2573 obj2 = extent_object (e); | |
| 2574 if (extent_in_region_p (e, | |
| 826 | 2575 buffer_or_string_memxpos_to_bytexpos (obj2, |
| 2576 st), | |
| 2577 buffer_or_string_memxpos_to_bytexpos (obj2, | |
| 2578 en), | |
| 428 | 2579 flags)) |
| 2580 { | |
| 2581 if ((*fn)(e, arg)) | |
| 2582 { | |
| 2583 /* Function wants us to stop mapping. */ | |
| 2584 stage = 1; /* so outer for loop will terminate */ | |
| 2585 break; | |
| 2586 } | |
| 2587 } | |
| 2588 } | |
| 2589 } | |
| 2590 /* ---------- Finished looping. ---------- */ | |
| 2591 } | |
| 2592 | |
| 1292 | 2593 if (!(flags & ME_MIGHT_THROW)) |
| 428 | 2594 { |
| 2595 /* Delete them ourselves */ | |
| 2596 if (range) | |
| 2597 extent_detach (range); | |
| 2598 if (posm) | |
| 2599 extent_list_delete_marker (el, posm); | |
| 2600 } | |
| 1292 | 2601 |
| 2602 /* This deletes the range extent and frees the marker, if ME_MIGHT_THROW. */ | |
| 2603 unbind_to (count); | |
| 2604 | |
| 2605 PROFILE_RECORD_EXITING_SECTION (QSin_map_extents_internal); | |
| 428 | 2606 } |
| 2607 | |
| 2608 /* ------------------------------- */ | |
| 2609 /* adjust_extents() */ | |
| 2610 /* ------------------------------- */ | |
| 2611 | |
| 2612 /* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This | |
| 2613 happens whenever the gap is moved or (under Mule) a character in a | |
| 2614 string is substituted for a different-length one. The reason for | |
| 2615 this is that extent endpoints behave just like markers (all memory | |
| 2616 indices do) and this adjustment correct for markers -- see | |
| 2617 adjust_markers(). Note that it is important that we visit all | |
| 2618 extent endpoints in the range, irrespective of whether the | |
| 2619 endpoints are open or closed. | |
| 2620 | |
| 2621 We could use map_extents() for this (and in fact the function | |
| 2622 was originally written that way), but the gap is in an incoherent | |
| 2623 state when this function is called and this function plays | |
| 2624 around with extent endpoints without detaching and reattaching | |
| 2625 the extents (this is provably correct and saves lots of time), | |
| 2626 so for safety we make it just look at the extent lists directly. */ | |
| 2627 | |
| 2628 void | |
| 826 | 2629 adjust_extents (Lisp_Object obj, Memxpos from, Memxpos to, int amount) |
| 428 | 2630 { |
| 2631 int endp; | |
| 2632 int pos; | |
| 2633 int startpos[2]; | |
| 2634 Extent_List *el; | |
| 2635 Stack_Of_Extents *soe; | |
| 2636 | |
| 2637 #ifdef ERROR_CHECK_EXTENTS | |
| 2638 sledgehammer_extent_check (obj); | |
| 2639 #endif | |
| 2640 el = buffer_or_string_extent_list (obj); | |
| 2641 | |
| 2642 if (!el || !extent_list_num_els(el)) | |
| 2643 return; | |
| 2644 | |
| 2645 /* IMPORTANT! Compute the starting positions of the extents to | |
| 2646 modify BEFORE doing any modification! Otherwise the starting | |
| 2647 position for the second time through the loop might get | |
| 2648 incorrectly calculated (I got bit by this bug real bad). */ | |
| 2649 startpos[0] = extent_list_locate_from_pos (el, from+1, 0); | |
| 2650 startpos[1] = extent_list_locate_from_pos (el, from+1, 1); | |
| 2651 for (endp = 0; endp < 2; endp++) | |
| 2652 { | |
| 2653 for (pos = startpos[endp]; pos < extent_list_num_els (el); | |
| 2654 pos++) | |
| 2655 { | |
| 2656 EXTENT e = extent_list_at (el, pos, endp); | |
| 2657 if (extent_endpoint (e, endp) > to) | |
| 2658 break; | |
| 2659 set_extent_endpoint (e, | |
| 2660 do_marker_adjustment (extent_endpoint (e, endp), | |
| 2661 from, to, amount), | |
| 2662 endp); | |
| 2663 } | |
| 2664 } | |
| 2665 | |
| 2666 /* The index for the buffer's SOE is a memory index and thus | |
| 2667 needs to be adjusted like a marker. */ | |
| 2668 soe = buffer_or_string_stack_of_extents (obj); | |
| 2669 if (soe && soe->pos >= 0) | |
| 2670 soe->pos = do_marker_adjustment (soe->pos, from, to, amount); | |
| 2671 } | |
| 2672 | |
| 2673 /* ------------------------------- */ | |
| 2674 /* adjust_extents_for_deletion() */ | |
| 2675 /* ------------------------------- */ | |
| 2676 | |
| 2677 struct adjust_extents_for_deletion_arg | |
| 2678 { | |
| 2679 EXTENT_dynarr *list; | |
| 2680 }; | |
| 2681 | |
| 2682 static int | |
| 2683 adjust_extents_for_deletion_mapper (EXTENT extent, void *arg) | |
| 2684 { | |
| 2685 struct adjust_extents_for_deletion_arg *closure = | |
| 2686 (struct adjust_extents_for_deletion_arg *) arg; | |
| 2687 | |
| 2688 Dynarr_add (closure->list, extent); | |
| 2689 return 0; /* continue mapping */ | |
| 2690 } | |
| 2691 | |
| 2692 /* For all extent endpoints in the range (FROM, TO], move them to the beginning | |
| 2693 of the new gap. Note that it is important that we visit all extent | |
| 2694 endpoints in the range, irrespective of whether the endpoints are open or | |
| 2695 closed. | |
| 2696 | |
| 2697 This function deals with weird stuff such as the fact that extents | |
| 2698 may get reordered. | |
| 2699 | |
| 2700 There is no string correspondent for this because you can't | |
| 2701 delete characters from a string. | |
| 2702 */ | |
| 2703 | |
| 2704 void | |
| 826 | 2705 adjust_extents_for_deletion (Lisp_Object object, Bytexpos from, |
| 2706 Bytexpos to, int gapsize, int numdel, | |
| 428 | 2707 int movegapsize) |
| 2708 { | |
| 2709 struct adjust_extents_for_deletion_arg closure; | |
| 2710 int i; | |
| 826 | 2711 Memxpos adjust_to = (Memxpos) (to + gapsize); |
| 428 | 2712 Bytecount amount = - numdel - movegapsize; |
| 826 | 2713 Memxpos oldsoe = 0, newsoe = 0; |
| 428 | 2714 Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object); |
| 2715 | |
| 2716 #ifdef ERROR_CHECK_EXTENTS | |
| 2717 sledgehammer_extent_check (object); | |
| 2718 #endif | |
| 2719 closure.list = Dynarr_new (EXTENT); | |
| 2720 | |
| 2721 /* We're going to be playing weird games below with extents and the SOE | |
| 2722 and such, so compute the list now of all the extents that we're going | |
| 2723 to muck with. If we do the mapping and adjusting together, things can | |
| 2724 get all screwed up. */ | |
| 2725 | |
| 826 | 2726 map_extents (from, to, adjust_extents_for_deletion_mapper, |
| 2727 (void *) &closure, object, 0, | |
| 2728 /* extent endpoints move like markers regardless | |
| 2729 of their open/closeness. */ | |
| 2730 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | | |
| 2731 ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL); | |
| 428 | 2732 |
| 2733 /* | |
| 2734 Old and new values for the SOE's position. (It gets adjusted | |
| 2735 like a marker, just like extent endpoints.) | |
| 2736 */ | |
| 2737 | |
| 2738 if (soe) | |
| 2739 { | |
| 2740 oldsoe = soe->pos; | |
| 2741 if (soe->pos >= 0) | |
| 2742 newsoe = do_marker_adjustment (soe->pos, | |
| 2743 adjust_to, adjust_to, | |
| 2744 amount); | |
| 2745 else | |
| 2746 newsoe = soe->pos; | |
| 2747 } | |
| 2748 | |
| 2749 for (i = 0; i < Dynarr_length (closure.list); i++) | |
| 2750 { | |
| 2751 EXTENT extent = Dynarr_at (closure.list, i); | |
| 826 | 2752 Memxpos new_start = extent_start (extent); |
| 2753 Memxpos new_end = extent_end (extent); | |
| 428 | 2754 |
| 2755 /* do_marker_adjustment() will not adjust values that should not be | |
| 2756 adjusted. We're passing the same funky arguments to | |
| 2757 do_marker_adjustment() as buffer_delete_range() does. */ | |
| 2758 new_start = | |
| 2759 do_marker_adjustment (new_start, | |
| 2760 adjust_to, adjust_to, | |
| 2761 amount); | |
| 2762 new_end = | |
| 2763 do_marker_adjustment (new_end, | |
| 2764 adjust_to, adjust_to, | |
| 2765 amount); | |
| 2766 | |
| 2767 /* We need to be very careful here so that the SOE doesn't get | |
| 2768 corrupted. We are shrinking extents out of the deleted region | |
| 2769 and simultaneously moving the SOE's pos out of the deleted | |
| 2770 region, so the SOE should contain the same extents at the end | |
| 2771 as at the beginning. However, extents may get reordered | |
| 2772 by this process, so we have to operate by pulling the extents | |
| 2773 out of the buffer and SOE, changing their bounds, and then | |
| 2774 reinserting them. In order for the SOE not to get screwed up, | |
| 2775 we have to make sure that the SOE's pos points to its old | |
| 2776 location whenever we pull an extent out, and points to its | |
| 2777 new location whenever we put the extent back in. | |
| 2778 */ | |
| 2779 | |
| 2780 if (new_start != extent_start (extent) || | |
| 2781 new_end != extent_end (extent)) | |
| 2782 { | |
| 2783 extent_detach (extent); | |
| 2784 set_extent_start (extent, new_start); | |
| 2785 set_extent_end (extent, new_end); | |
| 2786 if (soe) | |
| 2787 soe->pos = newsoe; | |
| 2788 extent_attach (extent); | |
| 2789 if (soe) | |
| 2790 soe->pos = oldsoe; | |
| 2791 } | |
| 2792 } | |
| 2793 | |
| 2794 if (soe) | |
| 2795 soe->pos = newsoe; | |
| 2796 | |
| 2797 #ifdef ERROR_CHECK_EXTENTS | |
| 2798 sledgehammer_extent_check (object); | |
| 2799 #endif | |
| 2800 Dynarr_free (closure.list); | |
| 2801 } | |
| 2802 | |
| 2803 /* ------------------------------- */ | |
| 2804 /* extent fragments */ | |
| 2805 /* ------------------------------- */ | |
| 2806 | |
| 2807 /* Imagine that the buffer is divided up into contiguous, | |
| 2808 nonoverlapping "runs" of text such that no extent | |
| 2809 starts or ends within a run (extents that abut the | |
| 2810 run don't count). | |
| 2811 | |
| 2812 An extent fragment is a structure that holds data about | |
| 2813 the run that contains a particular buffer position (if | |
| 2814 the buffer position is at the junction of two runs, the | |
| 2815 run after the position is used) -- the beginning and | |
| 2816 end of the run, a list of all of the extents in that | |
| 2817 run, the "merged face" that results from merging all of | |
| 2818 the faces corresponding to those extents, the begin and | |
| 2819 end glyphs at the beginning of the run, etc. This is | |
| 2820 the information that redisplay needs in order to | |
| 2821 display this run. | |
| 2822 | |
| 2823 Extent fragments have to be very quick to update to | |
| 2824 a new buffer position when moving linearly through | |
| 2825 the buffer. They rely on the stack-of-extents code, | |
| 2826 which does the heavy-duty algorithmic work of determining | |
| 2827 which extents overly a particular position. */ | |
| 2828 | |
| 2829 /* This function returns the position of the beginning of | |
| 2830 the first run that begins after POS, or returns POS if | |
| 2831 there are no such runs. */ | |
| 2832 | |
| 826 | 2833 static Bytexpos |
| 2834 extent_find_end_of_run (Lisp_Object obj, Bytexpos pos, int outside_accessible) | |
| 428 | 2835 { |
| 2836 Extent_List *sel; | |
| 2837 Extent_List *bel = buffer_or_string_extent_list (obj); | |
| 826 | 2838 Bytexpos pos1, pos2; |
| 428 | 2839 int elind1, elind2; |
| 826 | 2840 Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos); |
| 2841 Bytexpos limit = outside_accessible ? | |
| 428 | 2842 buffer_or_string_absolute_end_byte (obj) : |
| 826 | 2843 buffer_or_string_accessible_end_byte (obj); |
| 2844 | |
| 2845 if (!bel || !extent_list_num_els (bel)) | |
| 428 | 2846 return limit; |
| 2847 | |
| 2848 sel = buffer_or_string_stack_of_extents_force (obj)->extents; | |
| 2849 soe_move (obj, mempos); | |
| 2850 | |
| 2851 /* Find the first start position after POS. */ | |
| 2852 elind1 = extent_list_locate_from_pos (bel, mempos+1, 0); | |
| 2853 if (elind1 < extent_list_num_els (bel)) | |
| 826 | 2854 pos1 = buffer_or_string_memxpos_to_bytexpos |
| 428 | 2855 (obj, extent_start (extent_list_at (bel, elind1, 0))); |
| 2856 else | |
| 2857 pos1 = limit; | |
| 2858 | |
| 2859 /* Find the first end position after POS. The extent corresponding | |
| 2860 to this position is either in the SOE or is greater than or | |
| 2861 equal to POS1, so we just have to look in the SOE. */ | |
| 2862 elind2 = extent_list_locate_from_pos (sel, mempos+1, 1); | |
| 2863 if (elind2 < extent_list_num_els (sel)) | |
| 826 | 2864 pos2 = buffer_or_string_memxpos_to_bytexpos |
| 428 | 2865 (obj, extent_end (extent_list_at (sel, elind2, 1))); |
| 2866 else | |
| 2867 pos2 = limit; | |
| 2868 | |
| 2869 return min (min (pos1, pos2), limit); | |
| 2870 } | |
| 2871 | |
| 826 | 2872 static Bytexpos |
| 2873 extent_find_beginning_of_run (Lisp_Object obj, Bytexpos pos, | |
| 428 | 2874 int outside_accessible) |
| 2875 { | |
| 2876 Extent_List *sel; | |
| 2877 Extent_List *bel = buffer_or_string_extent_list (obj); | |
| 826 | 2878 Bytexpos pos1, pos2; |
| 428 | 2879 int elind1, elind2; |
| 826 | 2880 Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (obj, pos); |
| 2881 Bytexpos limit = outside_accessible ? | |
| 428 | 2882 buffer_or_string_absolute_begin_byte (obj) : |
| 826 | 2883 buffer_or_string_accessible_begin_byte (obj); |
| 428 | 2884 |
| 2885 if (!bel || !extent_list_num_els(bel)) | |
| 2886 return limit; | |
| 2887 | |
| 2888 sel = buffer_or_string_stack_of_extents_force (obj)->extents; | |
| 2889 soe_move (obj, mempos); | |
| 2890 | |
| 2891 /* Find the first end position before POS. */ | |
| 2892 elind1 = extent_list_locate_from_pos (bel, mempos, 1); | |
| 2893 if (elind1 > 0) | |
| 826 | 2894 pos1 = buffer_or_string_memxpos_to_bytexpos |
| 428 | 2895 (obj, extent_end (extent_list_at (bel, elind1 - 1, 1))); |
| 2896 else | |
| 2897 pos1 = limit; | |
| 2898 | |
| 2899 /* Find the first start position before POS. The extent corresponding | |
| 2900 to this position is either in the SOE or is less than or | |
| 2901 equal to POS1, so we just have to look in the SOE. */ | |
| 2902 elind2 = extent_list_locate_from_pos (sel, mempos, 0); | |
| 2903 if (elind2 > 0) | |
| 826 | 2904 pos2 = buffer_or_string_memxpos_to_bytexpos |
| 428 | 2905 (obj, extent_start (extent_list_at (sel, elind2 - 1, 0))); |
| 2906 else | |
| 2907 pos2 = limit; | |
| 2908 | |
| 2909 return max (max (pos1, pos2), limit); | |
| 2910 } | |
| 2911 | |
| 2912 struct extent_fragment * | |
| 2913 extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm) | |
| 2914 { | |
| 2915 struct extent_fragment *ef = xnew_and_zero (struct extent_fragment); | |
| 2916 | |
| 2917 ef->object = buffer_or_string; | |
| 2918 ef->frm = frm; | |
| 2919 ef->extents = Dynarr_new (EXTENT); | |
| 2920 ef->begin_glyphs = Dynarr_new (glyph_block); | |
| 2921 ef->end_glyphs = Dynarr_new (glyph_block); | |
| 2922 | |
| 2923 return ef; | |
| 2924 } | |
| 2925 | |
| 2926 void | |
| 2927 extent_fragment_delete (struct extent_fragment *ef) | |
| 2928 { | |
| 2929 Dynarr_free (ef->extents); | |
| 2930 Dynarr_free (ef->begin_glyphs); | |
| 2931 Dynarr_free (ef->end_glyphs); | |
| 1726 | 2932 xfree (ef, struct extent_fragment *); |
| 428 | 2933 } |
| 2934 | |
| 2935 static int | |
| 2936 extent_priority_sort_function (const void *humpty, const void *dumpty) | |
| 2937 { | |
| 442 | 2938 const EXTENT foo = * (const EXTENT *) humpty; |
| 2939 const EXTENT bar = * (const EXTENT *) dumpty; | |
| 428 | 2940 if (extent_priority (foo) < extent_priority (bar)) |
| 2941 return -1; | |
| 2942 return extent_priority (foo) > extent_priority (bar); | |
| 2943 } | |
| 2944 | |
| 2945 static void | |
| 2946 extent_fragment_sort_by_priority (EXTENT_dynarr *extarr) | |
| 2947 { | |
| 2948 int i; | |
| 2949 | |
| 2950 /* Sort our copy of the stack by extent_priority. We use a bubble | |
| 2951 sort here because it's going to be faster than qsort() for small | |
| 2952 numbers of extents (less than 10 or so), and 99.999% of the time | |
| 2953 there won't ever be more extents than this in the stack. */ | |
| 2954 if (Dynarr_length (extarr) < 10) | |
| 2955 { | |
| 2956 for (i = 1; i < Dynarr_length (extarr); i++) | |
| 2957 { | |
| 2958 int j = i - 1; | |
| 2959 while (j >= 0 && | |
| 2960 (extent_priority (Dynarr_at (extarr, j)) > | |
| 2961 extent_priority (Dynarr_at (extarr, j+1)))) | |
| 2962 { | |
| 2963 EXTENT tmp = Dynarr_at (extarr, j); | |
| 2964 Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1); | |
| 2965 Dynarr_at (extarr, j+1) = tmp; | |
| 2966 j--; | |
| 2967 } | |
| 2968 } | |
| 2969 } | |
| 2970 else | |
| 2971 /* But some loser programs mess up and may create a large number | |
| 2972 of extents overlapping the same spot. This will result in | |
| 2973 catastrophic behavior if we use the bubble sort above. */ | |
| 2974 qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr), | |
| 2975 sizeof (EXTENT), extent_priority_sort_function); | |
| 2976 } | |
| 2977 | |
| 2978 /* If PROP is the `invisible' property of an extent, | |
| 2979 this is 1 if the extent should be treated as invisible. */ | |
| 2980 | |
| 2981 #define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \ | |
| 2982 (EQ (buf->invisibility_spec, Qt) \ | |
| 2983 ? ! NILP (prop) \ | |
| 2984 : invisible_p (prop, buf->invisibility_spec)) | |
| 2985 | |
| 2986 /* If PROP is the `invisible' property of a extent, | |
| 2987 this is 1 if the extent should be treated as invisible | |
| 2988 and should have an ellipsis. */ | |
| 2989 | |
| 2990 #define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \ | |
| 2991 (EQ (buf->invisibility_spec, Qt) \ | |
| 2992 ? 0 \ | |
| 2993 : invisible_ellipsis_p (prop, buf->invisibility_spec)) | |
| 2994 | |
| 2995 /* This is like a combination of memq and assq. | |
| 2996 Return 1 if PROPVAL appears as an element of LIST | |
| 2997 or as the car of an element of LIST. | |
| 2998 If PROPVAL is a list, compare each element against LIST | |
| 2999 in that way, and return 1 if any element of PROPVAL is found in LIST. | |
| 3000 Otherwise return 0. | |
| 3001 This function cannot quit. */ | |
| 3002 | |
| 3003 static int | |
| 3004 invisible_p (REGISTER Lisp_Object propval, Lisp_Object list) | |
| 3005 { | |
| 3006 REGISTER Lisp_Object tail, proptail; | |
| 3007 for (tail = list; CONSP (tail); tail = XCDR (tail)) | |
| 3008 { | |
| 3009 REGISTER Lisp_Object tem; | |
| 3010 tem = XCAR (tail); | |
| 3011 if (EQ (propval, tem)) | |
| 3012 return 1; | |
| 3013 if (CONSP (tem) && EQ (propval, XCAR (tem))) | |
| 3014 return 1; | |
| 3015 } | |
| 3016 if (CONSP (propval)) | |
| 3017 for (proptail = propval; CONSP (proptail); | |
| 3018 proptail = XCDR (proptail)) | |
| 3019 { | |
| 3020 Lisp_Object propelt; | |
| 3021 propelt = XCAR (proptail); | |
| 3022 for (tail = list; CONSP (tail); tail = XCDR (tail)) | |
| 3023 { | |
| 3024 REGISTER Lisp_Object tem; | |
| 3025 tem = XCAR (tail); | |
| 3026 if (EQ (propelt, tem)) | |
| 3027 return 1; | |
| 3028 if (CONSP (tem) && EQ (propelt, XCAR (tem))) | |
| 3029 return 1; | |
| 3030 } | |
| 3031 } | |
| 3032 return 0; | |
| 3033 } | |
| 3034 | |
| 3035 /* Return 1 if PROPVAL appears as the car of an element of LIST | |
| 3036 and the cdr of that element is non-nil. | |
| 3037 If PROPVAL is a list, check each element of PROPVAL in that way, | |
| 3038 and the first time some element is found, | |
| 3039 return 1 if the cdr of that element is non-nil. | |
| 3040 Otherwise return 0. | |
| 3041 This function cannot quit. */ | |
| 3042 | |
| 3043 static int | |
| 3044 invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list) | |
| 3045 { | |
| 3046 REGISTER Lisp_Object tail, proptail; | |
| 3047 for (tail = list; CONSP (tail); tail = XCDR (tail)) | |
| 3048 { | |
| 3049 REGISTER Lisp_Object tem; | |
| 3050 tem = XCAR (tail); | |
| 3051 if (CONSP (tem) && EQ (propval, XCAR (tem))) | |
| 3052 return ! NILP (XCDR (tem)); | |
| 3053 } | |
| 3054 if (CONSP (propval)) | |
| 3055 for (proptail = propval; CONSP (proptail); | |
| 3056 proptail = XCDR (proptail)) | |
| 3057 { | |
| 3058 Lisp_Object propelt; | |
| 3059 propelt = XCAR (proptail); | |
| 3060 for (tail = list; CONSP (tail); tail = XCDR (tail)) | |
| 3061 { | |
| 3062 REGISTER Lisp_Object tem; | |
| 3063 tem = XCAR (tail); | |
| 3064 if (CONSP (tem) && EQ (propelt, XCAR (tem))) | |
| 3065 return ! NILP (XCDR (tem)); | |
| 3066 } | |
| 3067 } | |
| 3068 return 0; | |
| 3069 } | |
| 3070 | |
| 3071 face_index | |
| 3072 extent_fragment_update (struct window *w, struct extent_fragment *ef, | |
| 826 | 3073 Bytexpos pos, Lisp_Object last_glyph) |
| 428 | 3074 { |
| 3075 int i; | |
| 819 | 3076 int seen_glyph = NILP (last_glyph) ? 1 : 0; |
| 428 | 3077 Extent_List *sel = |
| 3078 buffer_or_string_stack_of_extents_force (ef->object)->extents; | |
| 3079 EXTENT lhe = 0; | |
| 3080 struct extent dummy_lhe_extent; | |
| 826 | 3081 Memxpos mempos = buffer_or_string_bytexpos_to_memxpos (ef->object, pos); |
| 428 | 3082 |
| 3083 #ifdef ERROR_CHECK_EXTENTS | |
| 3084 assert (pos >= buffer_or_string_accessible_begin_byte (ef->object) | |
| 3085 && pos <= buffer_or_string_accessible_end_byte (ef->object)); | |
| 3086 #endif | |
| 3087 | |
| 3088 Dynarr_reset (ef->extents); | |
| 3089 Dynarr_reset (ef->begin_glyphs); | |
| 3090 Dynarr_reset (ef->end_glyphs); | |
| 3091 | |
| 3092 ef->previously_invisible = ef->invisible; | |
| 3093 if (ef->invisible) | |
| 3094 { | |
| 3095 if (ef->invisible_ellipses) | |
| 3096 ef->invisible_ellipses_already_displayed = 1; | |
| 3097 } | |
| 3098 else | |
| 3099 ef->invisible_ellipses_already_displayed = 0; | |
| 3100 ef->invisible = 0; | |
| 3101 ef->invisible_ellipses = 0; | |
| 3102 | |
| 3103 /* Set up the begin and end positions. */ | |
| 3104 ef->pos = pos; | |
| 3105 ef->end = extent_find_end_of_run (ef->object, pos, 0); | |
| 3106 | |
| 3107 /* Note that extent_find_end_of_run() already moved the SOE for us. */ | |
| 3108 /* soe_move (ef->object, mempos); */ | |
| 3109 | |
| 3110 /* Determine the begin glyphs at POS. */ | |
| 3111 for (i = 0; i < extent_list_num_els (sel); i++) | |
| 3112 { | |
| 3113 EXTENT e = extent_list_at (sel, i, 0); | |
| 3114 if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e))) | |
| 3115 { | |
| 3116 Lisp_Object glyph = extent_begin_glyph (e); | |
| 4932 | 3117 if (seen_glyph) |
| 3118 { | |
| 3119 struct glyph_block gb; | |
| 3120 | |
| 3121 xzero (gb); | |
| 3122 gb.glyph = glyph; | |
| 3123 gb.extent = wrap_extent (e); | |
| 3124 Dynarr_add (ef->begin_glyphs, gb); | |
| 3125 } | |
| 819 | 3126 else if (EQ (glyph, last_glyph)) |
| 3127 seen_glyph = 1; | |
| 428 | 3128 } |
| 3129 } | |
| 3130 | |
| 3131 /* Determine the end glyphs at POS. */ | |
| 3132 for (i = 0; i < extent_list_num_els (sel); i++) | |
| 3133 { | |
| 3134 EXTENT e = extent_list_at (sel, i, 1); | |
| 3135 if (extent_end (e) == mempos && !NILP (extent_end_glyph (e))) | |
| 3136 { | |
| 3137 Lisp_Object glyph = extent_end_glyph (e); | |
| 4932 | 3138 if (seen_glyph) |
| 3139 { | |
| 3140 struct glyph_block gb; | |
| 3141 | |
| 3142 xzero (gb); | |
| 3143 gb.glyph = glyph; | |
| 3144 gb.extent = wrap_extent (e); | |
| 3145 Dynarr_add (ef->end_glyphs, gb); | |
| 3146 } | |
| 819 | 3147 else if (EQ (glyph, last_glyph)) |
| 3148 seen_glyph = 1; | |
| 428 | 3149 } |
| 3150 } | |
| 3151 | |
| 3152 /* We tried determining all the charsets used in the run here, | |
| 3153 but that fails even if we only do the current line -- display | |
| 3154 tables or non-printable characters might cause other charsets | |
| 3155 to be used. */ | |
| 3156 | |
| 3157 /* Determine whether the last-highlighted-extent is present. */ | |
| 3158 if (EXTENTP (Vlast_highlighted_extent)) | |
| 3159 lhe = XEXTENT (Vlast_highlighted_extent); | |
| 3160 | |
| 3161 /* Now add all extents that overlap the character after POS and | |
| 3162 have a non-nil face. Also check if the character is invisible. */ | |
| 3163 for (i = 0; i < extent_list_num_els (sel); i++) | |
| 3164 { | |
| 3165 EXTENT e = extent_list_at (sel, i, 0); | |
| 3166 if (extent_end (e) > mempos) | |
| 3167 { | |
| 3168 Lisp_Object invis_prop = extent_invisible (e); | |
| 3169 | |
| 3170 if (!NILP (invis_prop)) | |
| 3171 { | |
| 3172 if (!BUFFERP (ef->object)) | |
| 3173 /* #### no `string-invisibility-spec' */ | |
| 3174 ef->invisible = 1; | |
| 3175 else | |
| 3176 { | |
| 3177 if (!ef->invisible_ellipses_already_displayed && | |
| 3178 EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS | |
| 3179 (XBUFFER (ef->object), invis_prop)) | |
| 3180 { | |
| 3181 ef->invisible = 1; | |
| 3182 ef->invisible_ellipses = 1; | |
| 3183 } | |
| 3184 else if (EXTENT_PROP_MEANS_INVISIBLE | |
| 3185 (XBUFFER (ef->object), invis_prop)) | |
| 3186 ef->invisible = 1; | |
| 3187 } | |
| 3188 } | |
| 3189 | |
| 3190 /* Remember that one of the extents in the list might be our | |
| 3191 dummy extent representing the highlighting that is | |
| 3192 attached to some other extent that is currently | |
| 3193 mouse-highlighted. When an extent is mouse-highlighted, | |
| 3194 it is as if there are two extents there, of potentially | |
| 3195 different priorities: the extent being highlighted, with | |
| 3196 whatever face and priority it has; and an ephemeral | |
| 3197 extent in the `mouse-face' face with | |
| 3198 `mouse-highlight-priority'. | |
| 3199 */ | |
| 3200 | |
| 3201 if (!NILP (extent_face (e))) | |
| 3202 Dynarr_add (ef->extents, e); | |
| 3203 if (e == lhe) | |
| 3204 { | |
| 3205 Lisp_Object f; | |
| 3206 /* zeroing isn't really necessary; we only deref `priority' | |
| 3207 and `face' */ | |
| 3208 xzero (dummy_lhe_extent); | |
| 3209 set_extent_priority (&dummy_lhe_extent, | |
| 3210 mouse_highlight_priority); | |
| 3211 /* Need to break up the following expression, due to an */ | |
| 3212 /* error in the Digital UNIX 3.2g C compiler (Digital */ | |
| 3213 /* UNIX Compiler Driver 3.11). */ | |
| 3214 f = extent_mouse_face (lhe); | |
| 3215 extent_face (&dummy_lhe_extent) = f; | |
| 3216 Dynarr_add (ef->extents, &dummy_lhe_extent); | |
| 3217 } | |
| 3218 /* since we are looping anyway, we might as well do this here */ | |
| 3219 if ((!NILP(extent_initial_redisplay_function (e))) && | |
| 3220 !extent_in_red_event_p(e)) | |
| 3221 { | |
| 3222 Lisp_Object function = extent_initial_redisplay_function (e); | |
| 3223 Lisp_Object obj; | |
| 3224 | |
| 3225 /* printf ("initial redisplay function called!\n "); */ | |
| 3226 | |
| 3227 /* print_extent_2 (e); | |
| 3228 printf ("\n"); */ | |
| 3229 | |
| 3230 /* FIXME: One should probably inhibit the displaying of | |
| 3231 this extent to reduce flicker */ | |
| 793 | 3232 extent_in_red_event_p (e) = 1; |
| 428 | 3233 |
| 3234 /* call the function */ | |
| 793 | 3235 obj = wrap_extent (e); |
| 3236 if (!NILP (function)) | |
| 3237 Fenqueue_eval_event (function, obj); | |
| 428 | 3238 } |
| 3239 } | |
| 3240 } | |
| 3241 | |
| 3242 extent_fragment_sort_by_priority (ef->extents); | |
| 3243 | |
| 3244 /* Now merge the faces together into a single face. The code to | |
| 3245 do this is in faces.c because it involves manipulating faces. */ | |
| 3246 return get_extent_fragment_face_cache_index (w, ef); | |
| 3247 } | |
| 3248 | |
| 3249 | |
| 3250 /************************************************************************/ | |
| 3251 /* extent-object methods */ | |
| 3252 /************************************************************************/ | |
| 3253 | |
| 3254 /* These are the basic helper functions for handling the allocation of | |
| 3255 extent objects. They are similar to the functions for other | |
| 3256 lrecord objects. allocate_extent() is in alloc.c, not here. */ | |
| 3257 | |
| 3258 static Lisp_Object | |
| 3259 mark_extent (Lisp_Object obj) | |
| 3260 { | |
| 3261 struct extent *extent = XEXTENT (obj); | |
| 3262 | |
| 3263 mark_object (extent_object (extent)); | |
| 3264 mark_object (extent_no_chase_normal_field (extent, face)); | |
| 3265 return extent->plist; | |
| 3266 } | |
| 3267 | |
| 3268 static void | |
| 2286 | 3269 print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, |
| 3270 int UNUSED (escapeflag)) | |
| 428 | 3271 { |
| 3272 EXTENT ext = XEXTENT (obj); | |
| 3273 EXTENT anc = extent_ancestor (ext); | |
| 3274 Lisp_Object tail; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3275 Ascbyte buf[64], *bp = buf; |
| 428 | 3276 |
| 3277 /* Retrieve the ancestor and use it, for faster retrieval of properties */ | |
| 3278 | |
| 3279 if (!NILP (extent_begin_glyph (anc))) *bp++ = '*'; | |
| 3280 *bp++ = (extent_start_open_p (anc) ? '(': '['); | |
| 3281 if (extent_detached_p (ext)) | |
| 3282 strcpy (bp, "detached"); | |
| 3283 else | |
| 826 | 3284 sprintf (bp, "%ld, %ld", |
| 819 | 3285 XINT (Fextent_start_position (obj)), |
| 3286 XINT (Fextent_end_position (obj))); | |
| 428 | 3287 bp += strlen (bp); |
| 3288 *bp++ = (extent_end_open_p (anc) ? ')': ']'); | |
| 3289 if (!NILP (extent_end_glyph (anc))) *bp++ = '*'; | |
| 3290 *bp++ = ' '; | |
| 3291 | |
| 3292 if (!NILP (extent_read_only (anc))) *bp++ = '%'; | |
| 3293 if (!NILP (extent_mouse_face (anc))) *bp++ = 'H'; | |
| 3294 if (extent_unique_p (anc)) *bp++ = 'U'; | |
| 3295 else if (extent_duplicable_p (anc)) *bp++ = 'D'; | |
| 3296 if (!NILP (extent_invisible (anc))) *bp++ = 'I'; | |
| 3297 | |
| 3298 if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) || | |
| 3299 extent_unique_p (anc) || | |
| 3300 extent_duplicable_p (anc) || !NILP (extent_invisible (anc))) | |
| 3301 *bp++ = ' '; | |
| 3302 *bp = '\0'; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3303 write_ascstring (printcharfun, buf); |
| 428 | 3304 |
| 3305 tail = extent_plist_slot (anc); | |
| 3306 | |
| 3307 for (; !NILP (tail); tail = Fcdr (Fcdr (tail))) | |
| 3308 { | |
| 3309 Lisp_Object v = XCAR (XCDR (tail)); | |
| 3310 if (NILP (v)) continue; | |
| 800 | 3311 write_fmt_string_lisp (printcharfun, "%S ", 1, XCAR (tail)); |
| 428 | 3312 } |
| 3313 | |
| 800 | 3314 write_fmt_string (printcharfun, "0x%lx", (long) ext); |
| 428 | 3315 } |
| 3316 | |
| 3317 static void | |
| 3318 print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | |
| 3319 { | |
| 3320 if (escapeflag) | |
| 3321 { | |
| 442 | 3322 const char *title = ""; |
| 3323 const char *name = ""; | |
| 3324 const char *posttitle = ""; | |
| 428 | 3325 Lisp_Object obj2 = Qnil; |
| 3326 | |
| 3327 /* Destroyed extents have 't' in the object field, causing | |
| 2500 | 3328 extent_object() to ABORT (maybe). */ |
| 428 | 3329 if (EXTENT_LIVE_P (XEXTENT (obj))) |
| 3330 obj2 = extent_object (XEXTENT (obj)); | |
| 3331 | |
| 3332 if (NILP (obj2)) | |
| 3333 title = "no buffer"; | |
| 3334 else if (BUFFERP (obj2)) | |
| 3335 { | |
| 3336 if (BUFFER_LIVE_P (XBUFFER (obj2))) | |
| 3337 { | |
| 3338 title = "buffer "; | |
| 3339 name = (char *) XSTRING_DATA (XBUFFER (obj2)->name); | |
| 3340 } | |
| 3341 else | |
| 3342 { | |
| 3343 title = "Killed Buffer"; | |
| 3344 name = ""; | |
| 3345 } | |
| 3346 } | |
| 3347 else | |
| 3348 { | |
| 3349 assert (STRINGP (obj2)); | |
| 3350 title = "string \""; | |
| 3351 posttitle = "\""; | |
| 3352 name = (char *) XSTRING_DATA (obj2); | |
| 3353 } | |
| 3354 | |
| 3355 if (print_readably) | |
| 3356 { | |
| 3357 if (!EXTENT_LIVE_P (XEXTENT (obj))) | |
| 563 | 3358 printing_unreadable_object ("#<destroyed extent>"); |
| 428 | 3359 else |
| 563 | 3360 printing_unreadable_object ("#<extent 0x%lx>", |
| 428 | 3361 (long) XEXTENT (obj)); |
| 3362 } | |
| 3363 | |
| 3364 if (!EXTENT_LIVE_P (XEXTENT (obj))) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3365 write_ascstring (printcharfun, "#<destroyed extent"); |
| 428 | 3366 else |
| 3367 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3368 write_ascstring (printcharfun, "#<extent "); |
| 428 | 3369 print_extent_1 (obj, printcharfun, escapeflag); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3370 write_ascstring (printcharfun, extent_detached_p (XEXTENT (obj)) |
| 826 | 3371 ? " from " : " in "); |
| 800 | 3372 write_fmt_string (printcharfun, "%s%s%s", title, name, posttitle); |
| 428 | 3373 } |
| 3374 } | |
| 3375 else | |
| 3376 { | |
| 3377 if (print_readably) | |
| 563 | 3378 printing_unreadable_object ("#<extent>"); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3379 write_ascstring (printcharfun, "#<extent"); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3380 } |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
3381 write_ascstring (printcharfun, ">"); |
| 428 | 3382 } |
| 3383 | |
| 3384 static int | |
| 3385 properties_equal (EXTENT e1, EXTENT e2, int depth) | |
| 3386 { | |
| 3387 /* When this function is called, all indirections have been followed. | |
| 3388 Thus, the indirection checks in the various macros below will not | |
| 3389 amount to anything, and could be removed. However, the time | |
| 3390 savings would probably not be significant. */ | |
| 3391 if (!(EQ (extent_face (e1), extent_face (e2)) && | |
| 3392 extent_priority (e1) == extent_priority (e2) && | |
| 3393 internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2), | |
| 3394 depth + 1) && | |
| 3395 internal_equal (extent_end_glyph (e1), extent_end_glyph (e2), | |
| 3396 depth + 1))) | |
| 3397 return 0; | |
| 3398 | |
| 3399 /* compare the bit flags. */ | |
| 3400 { | |
| 3401 /* The has_aux field should not be relevant. */ | |
| 3402 int e1_has_aux = e1->flags.has_aux; | |
| 3403 int e2_has_aux = e2->flags.has_aux; | |
| 3404 int value; | |
| 3405 | |
| 3406 e1->flags.has_aux = e2->flags.has_aux = 0; | |
| 3407 value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags)); | |
| 3408 e1->flags.has_aux = e1_has_aux; | |
| 3409 e2->flags.has_aux = e2_has_aux; | |
| 3410 if (value) | |
| 3411 return 0; | |
| 3412 } | |
| 3413 | |
| 3414 /* compare the random elements of the plists. */ | |
| 3415 return !plists_differ (extent_no_chase_plist (e1), | |
| 3416 extent_no_chase_plist (e2), | |
| 3417 0, 0, depth + 1); | |
| 3418 } | |
| 3419 | |
| 3420 static int | |
| 3421 extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) | |
| 3422 { | |
| 3423 struct extent *e1 = XEXTENT (obj1); | |
| 3424 struct extent *e2 = XEXTENT (obj2); | |
| 3425 return | |
| 3426 (extent_start (e1) == extent_start (e2) && | |
| 3427 extent_end (e1) == extent_end (e2) && | |
| 3428 internal_equal (extent_object (e1), extent_object (e2), depth + 1) && | |
| 3429 properties_equal (extent_ancestor (e1), extent_ancestor (e2), | |
| 3430 depth)); | |
| 3431 } | |
| 3432 | |
| 665 | 3433 static Hashcode |
| 428 | 3434 extent_hash (Lisp_Object obj, int depth) |
| 3435 { | |
| 3436 struct extent *e = XEXTENT (obj); | |
| 3437 /* No need to hash all of the elements; that would take too long. | |
| 3438 Just hash the most common ones. */ | |
| 3439 return HASH3 (extent_start (e), extent_end (e), | |
| 3440 internal_hash (extent_object (e), depth + 1)); | |
| 3441 } | |
| 3442 | |
| 1204 | 3443 static const struct memory_description extent_description[] = { |
| 442 | 3444 { XD_LISP_OBJECT, offsetof (struct extent, object) }, |
| 3445 { XD_LISP_OBJECT, offsetof (struct extent, flags.face) }, | |
| 3446 { XD_LISP_OBJECT, offsetof (struct extent, plist) }, | |
| 3447 { XD_END } | |
| 3448 }; | |
| 3449 | |
| 428 | 3450 static Lisp_Object |
| 3451 extent_getprop (Lisp_Object obj, Lisp_Object prop) | |
| 3452 { | |
| 3453 return Fextent_property (obj, prop, Qunbound); | |
| 3454 } | |
| 3455 | |
| 3456 static int | |
| 3457 extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) | |
| 3458 { | |
| 3459 Fset_extent_property (obj, prop, value); | |
| 3460 return 1; | |
| 3461 } | |
| 3462 | |
| 3463 static int | |
| 3464 extent_remprop (Lisp_Object obj, Lisp_Object prop) | |
| 3465 { | |
| 826 | 3466 Lisp_Object retval = Fset_extent_property (obj, prop, Qunbound); |
| 3467 if (UNBOUNDP (retval)) | |
| 3468 return -1; | |
| 3469 else if (!NILP (retval)) | |
| 3470 return 1; | |
| 3471 else | |
| 3472 return 0; | |
| 428 | 3473 } |
| 3474 | |
| 3475 static Lisp_Object | |
| 3476 extent_plist (Lisp_Object obj) | |
| 3477 { | |
| 3478 return Fextent_properties (obj); | |
| 3479 } | |
| 3480 | |
| 934 | 3481 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, |
| 3482 1, /*dumpable-flag*/ | |
| 3483 mark_extent, | |
| 3484 print_extent, | |
| 3485 /* NOTE: If you declare a | |
| 3486 finalization method here, | |
| 3487 it will NOT be called. | |
| 3488 Shaft city. */ | |
| 3489 0, | |
| 3490 extent_equal, extent_hash, | |
| 3491 extent_description, | |
| 3492 extent_getprop, extent_putprop, | |
| 3493 extent_remprop, extent_plist, | |
| 3494 struct extent); | |
| 428 | 3495 |
| 3496 /************************************************************************/ | |
| 3497 /* basic extent accessors */ | |
| 3498 /************************************************************************/ | |
| 3499 | |
| 3500 /* These functions are for checking externally-passed extent objects | |
| 3501 and returning an extent's basic properties, which include the | |
| 3502 buffer the extent is associated with, the endpoints of the extent's | |
| 3503 range, the open/closed-ness of those endpoints, and whether the | |
| 3504 extent is detached. Manipulating these properties requires | |
| 3505 manipulating the ordered lists that hold extents; thus, functions | |
| 3506 to do that are in a later section. */ | |
| 3507 | |
| 3508 /* Given a Lisp_Object that is supposed to be an extent, make sure it | |
| 3509 is OK and return an extent pointer. Extents can be in one of four | |
| 3510 states: | |
| 3511 | |
| 3512 1) destroyed | |
| 3513 2) detached and not associated with a buffer | |
| 3514 3) detached and associated with a buffer | |
| 3515 4) attached to a buffer | |
| 3516 | |
| 3517 If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER, | |
| 3518 types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4 | |
| 3519 is allowed. | |
| 3520 */ | |
| 3521 | |
| 3522 static EXTENT | |
| 3523 decode_extent (Lisp_Object extent_obj, unsigned int flags) | |
| 3524 { | |
| 3525 EXTENT extent; | |
| 3526 Lisp_Object obj; | |
| 3527 | |
| 3528 CHECK_LIVE_EXTENT (extent_obj); | |
| 3529 extent = XEXTENT (extent_obj); | |
| 3530 obj = extent_object (extent); | |
| 3531 | |
| 3532 /* the following condition will fail if we're dealing with a freed extent */ | |
| 3533 assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj)); | |
| 3534 | |
| 3535 if (flags & DE_MUST_BE_ATTACHED) | |
| 3536 flags |= DE_MUST_HAVE_BUFFER; | |
| 3537 | |
| 3538 /* if buffer is dead, then convert extent to have no buffer. */ | |
| 3539 if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) | |
| 3540 obj = extent_object (extent) = Qnil; | |
| 3541 | |
| 3542 assert (!NILP (obj) || extent_detached_p (extent)); | |
| 3543 | |
| 3544 if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER)) | |
| 3545 || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED))) | |
| 3546 { | |
| 442 | 3547 invalid_argument ("extent doesn't belong to a buffer or string", |
| 3548 extent_obj); | |
| 428 | 3549 } |
| 3550 | |
| 3551 return extent; | |
| 3552 } | |
| 3553 | |
| 826 | 3554 /* Note that the returned value is a char position, not a byte position. */ |
| 428 | 3555 |
| 3556 static Lisp_Object | |
| 3557 extent_endpoint_external (Lisp_Object extent_obj, int endp) | |
| 3558 { | |
| 3559 EXTENT extent = decode_extent (extent_obj, 0); | |
| 3560 | |
| 3561 if (extent_detached_p (extent)) | |
| 3562 return Qnil; | |
| 3563 else | |
| 826 | 3564 return make_int (extent_endpoint_char (extent, endp)); |
| 428 | 3565 } |
| 3566 | |
| 3567 DEFUN ("extentp", Fextentp, 1, 1, 0, /* | |
| 3568 Return t if OBJECT is an extent. | |
| 3569 */ | |
| 3570 (object)) | |
| 3571 { | |
| 3572 return EXTENTP (object) ? Qt : Qnil; | |
| 3573 } | |
| 3574 | |
| 3575 DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /* | |
| 3576 Return t if OBJECT is an extent that has not been destroyed. | |
| 3577 */ | |
| 3578 (object)) | |
| 3579 { | |
| 3580 return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil; | |
| 3581 } | |
| 3582 | |
| 3583 DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /* | |
| 3584 Return t if EXTENT is detached. | |
| 3585 */ | |
| 3586 (extent)) | |
| 3587 { | |
| 3588 return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil; | |
| 3589 } | |
| 3590 | |
| 3591 DEFUN ("extent-object", Fextent_object, 1, 1, 0, /* | |
| 3592 Return object (buffer or string) that EXTENT refers to. | |
| 3593 */ | |
| 3594 (extent)) | |
| 3595 { | |
| 3596 return extent_object (decode_extent (extent, 0)); | |
| 3597 } | |
| 3598 | |
| 3599 DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /* | |
| 3600 Return start position of EXTENT, or nil if EXTENT is detached. | |
| 3601 */ | |
| 3602 (extent)) | |
| 3603 { | |
| 3604 return extent_endpoint_external (extent, 0); | |
| 3605 } | |
| 3606 | |
| 3607 DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /* | |
| 3608 Return end position of EXTENT, or nil if EXTENT is detached. | |
| 3609 */ | |
| 3610 (extent)) | |
| 3611 { | |
| 3612 return extent_endpoint_external (extent, 1); | |
| 3613 } | |
| 3614 | |
| 3615 DEFUN ("extent-length", Fextent_length, 1, 1, 0, /* | |
| 3616 Return length of EXTENT in characters. | |
| 3617 */ | |
| 3618 (extent)) | |
| 3619 { | |
| 3620 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); | |
| 826 | 3621 return make_int (extent_endpoint_char (e, 1) |
| 3622 - extent_endpoint_char (e, 0)); | |
| 428 | 3623 } |
| 3624 | |
| 3625 DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /* | |
| 3626 Find next extent after EXTENT. | |
| 3627 If EXTENT is a buffer return the first extent in the buffer; likewise | |
| 3628 for strings. | |
| 3629 Extents in a buffer are ordered in what is called the "display" | |
| 3630 order, which sorts by increasing start positions and then by *decreasing* | |
| 3631 end positions. | |
| 3632 If you want to perform an operation on a series of extents, use | |
| 3633 `map-extents' instead of this function; it is much more efficient. | |
| 3634 The primary use of this function should be to enumerate all the | |
| 3635 extents in a buffer. | |
| 3636 Note: The display order is not necessarily the order that `map-extents' | |
| 3637 processes extents in! | |
| 3638 */ | |
| 3639 (extent)) | |
| 3640 { | |
| 3641 EXTENT next; | |
| 3642 | |
| 3643 if (EXTENTP (extent)) | |
| 3644 next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); | |
| 3645 else | |
| 3646 next = extent_first (decode_buffer_or_string (extent)); | |
| 3647 | |
| 3648 if (!next) | |
| 3649 return Qnil; | |
| 793 | 3650 return wrap_extent (next); |
| 428 | 3651 } |
| 3652 | |
| 3653 DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /* | |
| 3654 Find last extent before EXTENT. | |
| 3655 If EXTENT is a buffer return the last extent in the buffer; likewise | |
| 3656 for strings. | |
| 3657 This function is analogous to `next-extent'. | |
| 3658 */ | |
| 3659 (extent)) | |
| 3660 { | |
| 3661 EXTENT prev; | |
| 3662 | |
| 3663 if (EXTENTP (extent)) | |
| 3664 prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); | |
| 3665 else | |
| 3666 prev = extent_last (decode_buffer_or_string (extent)); | |
| 3667 | |
| 3668 if (!prev) | |
| 3669 return Qnil; | |
| 793 | 3670 return wrap_extent (prev); |
| 428 | 3671 } |
| 3672 | |
| 3673 #ifdef DEBUG_XEMACS | |
| 3674 | |
| 3675 DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /* | |
| 3676 Find next extent after EXTENT using the "e" order. | |
| 3677 If EXTENT is a buffer return the first extent in the buffer; likewise | |
| 3678 for strings. | |
| 3679 */ | |
| 3680 (extent)) | |
| 3681 { | |
| 3682 EXTENT next; | |
| 3683 | |
| 3684 if (EXTENTP (extent)) | |
| 3685 next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); | |
| 3686 else | |
| 3687 next = extent_e_first (decode_buffer_or_string (extent)); | |
| 3688 | |
| 3689 if (!next) | |
| 3690 return Qnil; | |
| 793 | 3691 return wrap_extent (next); |
| 428 | 3692 } |
| 3693 | |
| 3694 DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /* | |
| 3695 Find last extent before EXTENT using the "e" order. | |
| 3696 If EXTENT is a buffer return the last extent in the buffer; likewise | |
| 3697 for strings. | |
| 3698 This function is analogous to `next-e-extent'. | |
| 3699 */ | |
| 3700 (extent)) | |
| 3701 { | |
| 3702 EXTENT prev; | |
| 3703 | |
| 3704 if (EXTENTP (extent)) | |
| 3705 prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); | |
| 3706 else | |
| 3707 prev = extent_e_last (decode_buffer_or_string (extent)); | |
| 3708 | |
| 3709 if (!prev) | |
| 3710 return Qnil; | |
| 793 | 3711 return wrap_extent (prev); |
| 428 | 3712 } |
| 3713 | |
| 3714 #endif | |
| 3715 | |
| 3716 DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /* | |
| 3717 Return the next position after POS where an extent begins or ends. | |
| 3718 If POS is at the end of the buffer or string, POS will be returned; | |
| 3719 otherwise a position greater than POS will always be returned. | |
| 444 | 3720 If OBJECT is nil, the current buffer is assumed. |
| 428 | 3721 */ |
| 3722 (pos, object)) | |
| 3723 { | |
| 3724 Lisp_Object obj = decode_buffer_or_string (object); | |
| 826 | 3725 Bytexpos xpos; |
| 3726 | |
| 3727 xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); | |
| 3728 xpos = extent_find_end_of_run (obj, xpos, 1); | |
| 3729 return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos)); | |
| 428 | 3730 } |
| 3731 | |
| 3732 DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /* | |
| 3733 Return the last position before POS where an extent begins or ends. | |
| 3734 If POS is at the beginning of the buffer or string, POS will be returned; | |
| 3735 otherwise a position less than POS will always be returned. | |
| 3736 If OBJECT is nil, the current buffer is assumed. | |
| 3737 */ | |
| 3738 (pos, object)) | |
| 3739 { | |
| 3740 Lisp_Object obj = decode_buffer_or_string (object); | |
| 826 | 3741 Bytexpos xpos; |
| 3742 | |
| 3743 xpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); | |
| 3744 xpos = extent_find_beginning_of_run (obj, xpos, 1); | |
| 3745 return make_int (buffer_or_string_bytexpos_to_charxpos (obj, xpos)); | |
| 428 | 3746 } |
| 3747 | |
| 3748 | |
| 3749 /************************************************************************/ | |
| 3750 /* parent and children stuff */ | |
| 3751 /************************************************************************/ | |
| 3752 | |
| 3753 DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /* | |
| 3754 Return the parent (if any) of EXTENT. | |
| 3755 If an extent has a parent, it derives all its properties from that extent | |
| 3756 and has no properties of its own. (The only "properties" that the | |
| 3757 extent keeps are the buffer/string it refers to and the start and end | |
| 3758 points.) It is possible for an extent's parent to itself have a parent. | |
| 3759 */ | |
| 3760 (extent)) | |
| 3761 /* do I win the prize for the strangest split infinitive? */ | |
| 3762 { | |
| 3763 EXTENT e = decode_extent (extent, 0); | |
| 3764 return extent_parent (e); | |
| 3765 } | |
| 3766 | |
| 3767 DEFUN ("extent-children", Fextent_children, 1, 1, 0, /* | |
| 3768 Return a list of the children (if any) of EXTENT. | |
| 3769 The children of an extent are all those extents whose parent is that extent. | |
| 3770 This function does not recursively trace children of children. | |
| 3771 \(To do that, use `extent-descendants'.) | |
| 3772 */ | |
| 3773 (extent)) | |
| 3774 { | |
| 3775 EXTENT e = decode_extent (extent, 0); | |
| 3776 Lisp_Object children = extent_children (e); | |
| 3777 | |
| 3778 if (!NILP (children)) | |
| 3779 return Fcopy_sequence (XWEAK_LIST_LIST (children)); | |
| 3780 else | |
| 3781 return Qnil; | |
| 3782 } | |
| 3783 | |
| 3784 static void | |
| 3785 remove_extent_from_children_list (EXTENT e, Lisp_Object child) | |
| 3786 { | |
| 3787 Lisp_Object children = extent_children (e); | |
| 3788 | |
| 3789 #ifdef ERROR_CHECK_EXTENTS | |
| 3790 assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children)))); | |
| 3791 #endif | |
| 3792 XWEAK_LIST_LIST (children) = | |
| 3793 delq_no_quit (child, XWEAK_LIST_LIST (children)); | |
| 3794 } | |
| 3795 | |
| 3796 static void | |
| 3797 add_extent_to_children_list (EXTENT e, Lisp_Object child) | |
| 3798 { | |
| 3799 Lisp_Object children = extent_children (e); | |
| 3800 | |
| 3801 if (NILP (children)) | |
| 3802 { | |
| 3803 children = make_weak_list (WEAK_LIST_SIMPLE); | |
| 3804 set_extent_no_chase_aux_field (e, children, children); | |
| 3805 } | |
| 3806 | |
| 3807 #ifdef ERROR_CHECK_EXTENTS | |
| 3808 assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children)))); | |
| 3809 #endif | |
| 3810 XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children)); | |
| 3811 } | |
| 3812 | |
| 826 | 3813 |
| 3814 static int | |
| 3815 compare_key_value_pairs (const void *humpty, const void *dumpty) | |
| 3816 { | |
| 3817 Lisp_Object_pair *foo = (Lisp_Object_pair *) humpty; | |
| 3818 Lisp_Object_pair *bar = (Lisp_Object_pair *) dumpty; | |
| 3819 if (EQ (foo->key, bar->key)) | |
| 3820 return 0; | |
| 3821 return !NILP (Fstring_lessp (foo->key, bar->key)) ? -1 : 1; | |
| 3822 } | |
| 3823 | |
| 428 | 3824 DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /* |
| 3825 Set the parent of EXTENT to PARENT (may be nil). | |
| 3826 See `extent-parent'. | |
| 3827 */ | |
| 3828 (extent, parent)) | |
| 3829 { | |
| 3830 EXTENT e = decode_extent (extent, 0); | |
| 3831 Lisp_Object cur_parent = extent_parent (e); | |
| 3832 Lisp_Object rest; | |
| 3833 | |
| 793 | 3834 extent = wrap_extent (e); |
| 428 | 3835 if (!NILP (parent)) |
| 3836 CHECK_LIVE_EXTENT (parent); | |
| 3837 if (EQ (parent, cur_parent)) | |
| 3838 return Qnil; | |
| 3839 for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest))) | |
| 3840 if (EQ (rest, extent)) | |
| 563 | 3841 signal_error (Qinvalid_change, |
| 442 | 3842 "Circular parent chain would result", |
| 3843 extent); | |
| 428 | 3844 if (NILP (parent)) |
| 3845 { | |
| 3846 remove_extent_from_children_list (XEXTENT (cur_parent), extent); | |
| 3847 set_extent_no_chase_aux_field (e, parent, Qnil); | |
| 3848 e->flags.has_parent = 0; | |
| 3849 } | |
| 3850 else | |
| 3851 { | |
| 3852 add_extent_to_children_list (XEXTENT (parent), extent); | |
| 3853 set_extent_no_chase_aux_field (e, parent, parent); | |
| 3854 e->flags.has_parent = 1; | |
| 3855 } | |
| 3856 /* changing the parent also changes the properties of all children. */ | |
| 3857 { | |
| 826 | 3858 Lisp_Object_pair_dynarr *oldprops, *newprops; |
| 3859 int i, orignewlength; | |
| 3860 | |
| 3861 /* perhaps there's a smarter way, but the following will work, | |
| 3862 and it's O(N*log N): | |
| 3863 | |
| 3864 (1) get the old props. | |
| 3865 (2) get the new props. | |
| 3866 (3) sort both. | |
| 3867 (4) loop through old props; if key not in new, add it, with value | |
| 3868 Qunbound. | |
| 3869 (5) vice-versa for new props. | |
| 3870 (6) sort both again. | |
| 3871 (7) now we have identical lists of keys; we run through and compare | |
| 3872 the values. | |
| 3873 | |
| 3874 Of course in reality the number of properties will be low, so | |
| 3875 an N^2 algorithm wouldn't be a problem, but the stuff below is just | |
| 3876 as easy to write given the existence of qsort and bsearch. | |
| 3877 */ | |
| 3878 | |
| 3879 oldprops = Dynarr_new (Lisp_Object_pair); | |
| 3880 newprops = Dynarr_new (Lisp_Object_pair); | |
| 3881 if (!NILP (cur_parent)) | |
| 3882 extent_properties (XEXTENT (cur_parent), oldprops); | |
| 3883 if (!NILP (parent)) | |
| 3884 extent_properties (XEXTENT (parent), newprops); | |
| 3885 | |
| 3886 qsort (Dynarr_atp (oldprops, 0), Dynarr_length (oldprops), | |
| 3887 sizeof (Lisp_Object_pair), compare_key_value_pairs); | |
| 3888 qsort (Dynarr_atp (newprops, 0), Dynarr_length (newprops), | |
| 3889 sizeof (Lisp_Object_pair), compare_key_value_pairs); | |
| 3890 orignewlength = Dynarr_length (newprops); | |
| 3891 for (i = 0; i < Dynarr_length (oldprops); i++) | |
| 3892 { | |
| 3893 if (!bsearch (Dynarr_atp (oldprops, i), Dynarr_atp (newprops, 0), | |
| 3894 Dynarr_length (newprops), sizeof (Lisp_Object_pair), | |
| 3895 compare_key_value_pairs)) | |
| 3896 { | |
| 3025 | 3897 Lisp_Object_pair new_; |
| 3898 new_.key = Dynarr_at (oldprops, i).key; | |
| 3899 new_.value = Qunbound; | |
| 3900 Dynarr_add (newprops, new_); | |
| 826 | 3901 } |
| 3902 } | |
| 3903 for (i = 0; i < orignewlength; i++) | |
| 3904 { | |
| 859 | 3905 if (!Dynarr_length (oldprops) || !bsearch (Dynarr_atp (newprops, i), |
| 3906 Dynarr_atp (oldprops, 0), | |
| 3907 Dynarr_length (oldprops), | |
| 3908 sizeof (Lisp_Object_pair), | |
| 3909 compare_key_value_pairs)) | |
| 826 | 3910 { |
| 3025 | 3911 Lisp_Object_pair new_; |
| 3912 new_.key = Dynarr_at (newprops, i).key; | |
| 3913 new_.value = Qunbound; | |
| 3914 Dynarr_add (oldprops, new_); | |
| 826 | 3915 } |
| 3916 } | |
| 3917 qsort (Dynarr_atp (oldprops, 0), Dynarr_length (oldprops), | |
| 3918 sizeof (Lisp_Object_pair), compare_key_value_pairs); | |
| 3919 qsort (Dynarr_atp (newprops, 0), Dynarr_length (newprops), | |
| 3920 sizeof (Lisp_Object_pair), compare_key_value_pairs); | |
| 3921 for (i = 0; i < Dynarr_length (oldprops); i++) | |
| 3922 { | |
| 3923 assert (EQ (Dynarr_at (oldprops, i).key, Dynarr_at (newprops, i).key)); | |
| 3924 if (!EQ (Dynarr_at (oldprops, i).value, Dynarr_at (newprops, i).value)) | |
| 3925 signal_extent_property_changed (e, Dynarr_at (oldprops, i).key, 1); | |
| 3926 } | |
| 3927 | |
| 3928 Dynarr_free (oldprops); | |
| 3929 Dynarr_free (newprops); | |
| 3930 #if 0 | |
| 3931 { | |
| 428 | 3932 int old_invis = (!NILP (cur_parent) && |
| 3933 !NILP (extent_invisible (XEXTENT (cur_parent)))); | |
| 3934 int new_invis = (!NILP (parent) && | |
| 3935 !NILP (extent_invisible (XEXTENT (parent)))); | |
| 3936 | |
| 3937 extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis); | |
| 3938 } | |
| 826 | 3939 #endif /* 0 */ |
| 3940 } | |
| 428 | 3941 return Qnil; |
| 3942 } | |
| 3943 | |
| 3944 | |
| 3945 /************************************************************************/ | |
| 3946 /* basic extent mutators */ | |
| 3947 /************************************************************************/ | |
| 3948 | |
| 3949 /* Note: If you track non-duplicable extents by undo, you'll get bogus | |
| 3950 undo records for transient extents via update-extent. | |
| 3951 For example, query-replace will do this. | |
| 3952 */ | |
| 3953 | |
| 3954 static void | |
| 826 | 3955 set_extent_endpoints_1 (EXTENT extent, Memxpos start, Memxpos end) |
| 428 | 3956 { |
| 3957 #ifdef ERROR_CHECK_EXTENTS | |
| 3958 Lisp_Object obj = extent_object (extent); | |
| 3959 | |
| 3960 assert (start <= end); | |
| 3961 if (BUFFERP (obj)) | |
| 3962 { | |
| 665 | 3963 assert (valid_membpos_p (XBUFFER (obj), start)); |
| 3964 assert (valid_membpos_p (XBUFFER (obj), end)); | |
| 428 | 3965 } |
| 3966 #endif | |
| 3967 | |
| 3968 /* Optimization: if the extent is already where we want it to be, | |
| 3969 do nothing. */ | |
| 3970 if (!extent_detached_p (extent) && extent_start (extent) == start && | |
| 3971 extent_end (extent) == end) | |
| 3972 return; | |
| 3973 | |
| 3974 if (extent_detached_p (extent)) | |
| 3975 { | |
| 3976 if (extent_duplicable_p (extent)) | |
| 3977 { | |
| 793 | 3978 Lisp_Object extent_obj = wrap_extent (extent); |
| 3979 | |
| 428 | 3980 record_extent (extent_obj, 1); |
| 3981 } | |
| 3982 } | |
| 3983 else | |
| 3984 extent_detach (extent); | |
| 3985 | |
| 3986 set_extent_start (extent, start); | |
| 3987 set_extent_end (extent, end); | |
| 3988 extent_attach (extent); | |
| 3989 } | |
| 3990 | |
| 3991 /* Set extent's endpoints to S and E, and put extent in buffer or string | |
| 3992 OBJECT. (If OBJECT is nil, do not change the extent's object.) */ | |
| 3993 | |
| 3994 void | |
| 826 | 3995 set_extent_endpoints (EXTENT extent, Bytexpos s, Bytexpos e, |
| 3996 Lisp_Object object) | |
| 3997 { | |
| 3998 Memxpos start, end; | |
| 428 | 3999 |
| 4000 if (NILP (object)) | |
| 4001 { | |
| 4002 object = extent_object (extent); | |
| 4003 assert (!NILP (object)); | |
| 4004 } | |
| 4005 else if (!EQ (object, extent_object (extent))) | |
| 4006 { | |
| 4007 extent_detach (extent); | |
| 4008 extent_object (extent) = object; | |
| 4009 } | |
| 4010 | |
| 4011 start = s < 0 ? extent_start (extent) : | |
| 826 | 4012 buffer_or_string_bytexpos_to_memxpos (object, s); |
| 428 | 4013 end = e < 0 ? extent_end (extent) : |
| 826 | 4014 buffer_or_string_bytexpos_to_memxpos (object, e); |
| 428 | 4015 set_extent_endpoints_1 (extent, start, end); |
| 4016 } | |
| 4017 | |
| 4018 static void | |
| 4019 set_extent_openness (EXTENT extent, int start_open, int end_open) | |
| 4020 { | |
| 4021 if (start_open != -1) | |
| 826 | 4022 { |
| 4023 extent_start_open_p (extent) = start_open; | |
| 4024 signal_extent_property_changed (extent, Qstart_open, 1); | |
| 4025 } | |
| 428 | 4026 if (end_open != -1) |
| 826 | 4027 { |
| 4028 extent_end_open_p (extent) = end_open; | |
| 4029 signal_extent_property_changed (extent, Qend_open, 1); | |
| 4030 } | |
| 428 | 4031 } |
| 4032 | |
| 4033 static EXTENT | |
| 826 | 4034 make_extent (Lisp_Object object, Bytexpos from, Bytexpos to) |
| 428 | 4035 { |
| 4036 EXTENT extent; | |
| 4037 | |
| 4038 extent = make_extent_detached (object); | |
| 4039 set_extent_endpoints (extent, from, to, Qnil); | |
| 4040 return extent; | |
| 4041 } | |
| 4042 | |
| 826 | 4043 /* Copy ORIGINAL, changing it to span FROM,TO in OBJECT. */ |
| 4044 | |
| 428 | 4045 static EXTENT |
| 826 | 4046 copy_extent (EXTENT original, Bytexpos from, Bytexpos to, Lisp_Object object) |
| 428 | 4047 { |
| 4048 EXTENT e; | |
| 4049 | |
| 4050 e = make_extent_detached (object); | |
| 4051 if (from >= 0) | |
| 4052 set_extent_endpoints (e, from, to, Qnil); | |
| 4053 | |
| 4054 e->plist = Fcopy_sequence (original->plist); | |
| 4055 memcpy (&e->flags, &original->flags, sizeof (e->flags)); | |
| 4056 if (e->flags.has_aux) | |
| 4057 { | |
| 4058 /* also need to copy the aux struct. It won't work for | |
| 4059 this extent to share the same aux struct as the original | |
| 4060 one. */ | |
| 2720 | 4061 struct extent_auxiliary *data = |
| 3017 | 4062 ALLOC_LCRECORD_TYPE (struct extent_auxiliary, |
| 428 | 4063 &lrecord_extent_auxiliary); |
| 4064 | |
| 3017 | 4065 COPY_LCRECORD (data, XEXTENT_AUXILIARY (XCAR (original->plist))); |
| 793 | 4066 XCAR (e->plist) = wrap_extent_auxiliary (data); |
| 428 | 4067 } |
| 4068 | |
| 4069 { | |
| 4070 /* we may have just added another child to the parent extent. */ | |
| 4071 Lisp_Object parent = extent_parent (e); | |
| 4072 if (!NILP (parent)) | |
| 4073 { | |
| 793 | 4074 Lisp_Object extent = wrap_extent (e); |
| 4075 | |
| 428 | 4076 add_extent_to_children_list (XEXTENT (parent), extent); |
| 4077 } | |
| 4078 } | |
| 4079 | |
| 4080 return e; | |
| 4081 } | |
| 4082 | |
| 4083 static void | |
| 4084 destroy_extent (EXTENT extent) | |
| 4085 { | |
| 4086 Lisp_Object rest, nextrest, children; | |
| 4087 Lisp_Object extent_obj; | |
| 4088 | |
| 4089 if (!extent_detached_p (extent)) | |
| 4090 extent_detach (extent); | |
| 4091 /* disassociate the extent from its children and parent */ | |
| 4092 children = extent_children (extent); | |
| 4093 if (!NILP (children)) | |
| 4094 { | |
| 4095 LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children)) | |
| 4096 Fset_extent_parent (XCAR (rest), Qnil); | |
| 4097 } | |
| 793 | 4098 extent_obj = wrap_extent (extent); |
| 428 | 4099 Fset_extent_parent (extent_obj, Qnil); |
| 4100 /* mark the extent as destroyed */ | |
| 4101 extent_object (extent) = Qt; | |
| 4102 } | |
| 4103 | |
| 4104 DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /* | |
| 4105 Make an extent for the range [FROM, TO) in BUFFER-OR-STRING. | |
| 4106 BUFFER-OR-STRING defaults to the current buffer. Insertions at point | |
| 4107 TO will be outside of the extent; insertions at FROM will be inside the | |
| 4108 extent, causing the extent to grow. (This is the same way that markers | |
| 4109 behave.) You can change the behavior of insertions at the endpoints | |
| 4110 using `set-extent-property'. The extent is initially detached if both | |
| 4111 FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil, | |
| 4112 meaning the extent is in no buffer and no string. | |
| 4113 */ | |
| 4114 (from, to, buffer_or_string)) | |
| 4115 { | |
| 4116 Lisp_Object extent_obj; | |
| 4117 Lisp_Object obj; | |
| 4118 | |
| 4119 obj = decode_buffer_or_string (buffer_or_string); | |
| 4120 if (NILP (from) && NILP (to)) | |
| 4121 { | |
| 4122 if (NILP (buffer_or_string)) | |
| 4123 obj = Qnil; | |
| 793 | 4124 extent_obj = wrap_extent (make_extent_detached (obj)); |
| 428 | 4125 } |
| 4126 else | |
| 4127 { | |
| 826 | 4128 Bytexpos start, end; |
| 428 | 4129 |
| 4130 get_buffer_or_string_range_byte (obj, from, to, &start, &end, | |
| 4131 GB_ALLOW_PAST_ACCESSIBLE); | |
| 826 | 4132 extent_obj = wrap_extent (make_extent (obj, start, end)); |
| 428 | 4133 } |
| 4134 return extent_obj; | |
| 4135 } | |
| 4136 | |
| 4137 DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /* | |
| 4138 Make a copy of EXTENT. It is initially detached. | |
| 4139 Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string. | |
| 4140 */ | |
| 4141 (extent, buffer_or_string)) | |
| 4142 { | |
| 4143 EXTENT ext = decode_extent (extent, 0); | |
| 4144 | |
| 4145 if (NILP (buffer_or_string)) | |
| 4146 buffer_or_string = extent_object (ext); | |
| 4147 else | |
| 4148 buffer_or_string = decode_buffer_or_string (buffer_or_string); | |
| 4149 | |
| 793 | 4150 return wrap_extent (copy_extent (ext, -1, -1, buffer_or_string)); |
| 428 | 4151 } |
| 4152 | |
| 4153 DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /* | |
| 4154 Remove EXTENT from its buffer and destroy it. | |
| 4155 This does not modify the buffer's text, only its display properties. | |
| 4156 The extent cannot be used thereafter. | |
| 4157 */ | |
| 4158 (extent)) | |
| 4159 { | |
| 4160 EXTENT ext; | |
| 4161 | |
| 4162 /* We do not call decode_extent() here because already-destroyed | |
| 4163 extents are OK. */ | |
| 4164 CHECK_EXTENT (extent); | |
| 4165 ext = XEXTENT (extent); | |
| 4166 | |
| 4167 if (!EXTENT_LIVE_P (ext)) | |
| 4168 return Qnil; | |
| 4169 destroy_extent (ext); | |
| 4170 return Qnil; | |
| 4171 } | |
| 4172 | |
| 4173 DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /* | |
| 4174 Remove EXTENT from its buffer in such a way that it can be re-inserted. | |
| 4175 An extent is also detached when all of its characters are all killed by a | |
| 4176 deletion, unless its `detachable' property has been unset. | |
| 4177 | |
| 4178 Extents which have the `duplicable' attribute are tracked by the undo | |
| 4179 mechanism. Detachment via `detach-extent' and string deletion is recorded, | |
| 4180 as is attachment via `insert-extent' and string insertion. Extent motion, | |
| 4181 face changes, and attachment via `make-extent' and `set-extent-endpoints' | |
| 4182 are not recorded. This means that extent changes which are to be undo-able | |
| 4183 must be performed by character editing, or by insertion and detachment of | |
| 4184 duplicable extents. | |
| 4185 */ | |
| 4186 (extent)) | |
| 4187 { | |
| 4188 EXTENT ext = decode_extent (extent, 0); | |
| 4189 | |
| 4190 if (extent_detached_p (ext)) | |
| 4191 return extent; | |
| 4192 if (extent_duplicable_p (ext)) | |
| 4193 record_extent (extent, 0); | |
| 4194 extent_detach (ext); | |
| 4195 | |
| 4196 return extent; | |
| 4197 } | |
| 4198 | |
| 4199 DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /* | |
| 4200 Set the endpoints of EXTENT to START, END. | |
| 4201 If START and END are null, call detach-extent on EXTENT. | |
| 4202 BUFFER-OR-STRING specifies the new buffer or string that the extent should | |
| 4203 be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT | |
| 4204 is in no buffer and no string, it defaults to the current buffer.) | |
| 4205 See documentation on `detach-extent' for a discussion of undo recording. | |
| 4206 */ | |
| 4207 (extent, start, end, buffer_or_string)) | |
| 4208 { | |
| 4209 EXTENT ext; | |
| 826 | 4210 Bytexpos s, e; |
| 428 | 4211 |
| 4212 ext = decode_extent (extent, 0); | |
| 4213 | |
| 4214 if (NILP (buffer_or_string)) | |
| 4215 { | |
| 4216 buffer_or_string = extent_object (ext); | |
| 4217 if (NILP (buffer_or_string)) | |
| 4218 buffer_or_string = Fcurrent_buffer (); | |
| 4219 } | |
| 4220 else | |
| 4221 buffer_or_string = decode_buffer_or_string (buffer_or_string); | |
| 4222 | |
| 4223 if (NILP (start) && NILP (end)) | |
| 4224 return Fdetach_extent (extent); | |
| 4225 | |
| 4226 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, | |
| 4227 GB_ALLOW_PAST_ACCESSIBLE); | |
| 4228 | |
| 468 | 4229 buffer_or_string_extent_info_force (buffer_or_string); |
| 428 | 4230 set_extent_endpoints (ext, s, e, buffer_or_string); |
| 4231 return extent; | |
| 4232 } | |
| 4233 | |
| 4234 | |
| 4235 /************************************************************************/ | |
| 4236 /* mapping over extents */ | |
| 4237 /************************************************************************/ | |
| 4238 | |
| 4239 static unsigned int | |
| 4240 decode_map_extents_flags (Lisp_Object flags) | |
| 4241 { | |
| 4242 unsigned int retval = 0; | |
| 4243 unsigned int all_extents_specified = 0; | |
| 4244 unsigned int in_region_specified = 0; | |
| 4245 | |
| 4246 if (EQ (flags, Qt)) /* obsoleteness compatibility */ | |
| 4247 return ME_END_CLOSED; | |
| 4248 if (NILP (flags)) | |
| 4249 return 0; | |
| 4250 if (SYMBOLP (flags)) | |
| 4251 flags = Fcons (flags, Qnil); | |
| 4252 while (!NILP (flags)) | |
| 4253 { | |
| 4254 Lisp_Object sym; | |
| 4255 CHECK_CONS (flags); | |
| 4256 sym = XCAR (flags); | |
| 4257 CHECK_SYMBOL (sym); | |
| 4258 if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) || | |
| 4259 EQ (sym, Qall_extents_closed_open) || | |
| 4260 EQ (sym, Qall_extents_open_closed)) | |
| 4261 { | |
| 4262 if (all_extents_specified) | |
| 563 | 4263 invalid_argument ("Only one `all-extents-*' flag may be specified", Qunbound); |
| 428 | 4264 all_extents_specified = 1; |
| 4265 } | |
| 4266 if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) || | |
| 4267 EQ (sym, Qstart_and_end_in_region) || | |
| 4268 EQ (sym, Qstart_or_end_in_region)) | |
| 4269 { | |
| 4270 if (in_region_specified) | |
| 563 | 4271 invalid_argument ("Only one `*-in-region' flag may be specified", Qunbound); |
| 428 | 4272 in_region_specified = 1; |
| 4273 } | |
| 4274 | |
| 4275 /* I do so love that conditional operator ... */ | |
| 4276 retval |= | |
| 4277 EQ (sym, Qend_closed) ? ME_END_CLOSED : | |
| 4278 EQ (sym, Qstart_open) ? ME_START_OPEN : | |
| 4279 EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED : | |
| 4280 EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN : | |
| 4281 EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN : | |
| 4282 EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED : | |
| 4283 EQ (sym, Qstart_in_region) ? ME_START_IN_REGION : | |
| 4284 EQ (sym, Qend_in_region) ? ME_END_IN_REGION : | |
| 4285 EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION : | |
| 4286 EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION : | |
| 4287 EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION : | |
| 563 | 4288 (invalid_constant ("Invalid `map-extents' flag", sym), 0); |
| 428 | 4289 |
| 4290 flags = XCDR (flags); | |
| 4291 } | |
| 4292 return retval; | |
| 4293 } | |
| 4294 | |
| 4295 DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /* | |
| 4296 Return whether EXTENT overlaps a specified region. | |
| 4297 This is equivalent to whether `map-extents' would visit EXTENT when called | |
| 4298 with these args. | |
| 4299 */ | |
| 4300 (extent, from, to, flags)) | |
| 4301 { | |
| 826 | 4302 Bytexpos start, end; |
| 428 | 4303 EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED); |
| 4304 Lisp_Object obj = extent_object (ext); | |
| 4305 | |
| 4306 get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL | | |
| 4307 GB_ALLOW_PAST_ACCESSIBLE); | |
| 4308 | |
| 4309 return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ? | |
| 4310 Qt : Qnil; | |
| 4311 } | |
| 4312 | |
| 4313 struct slow_map_extents_arg | |
| 4314 { | |
| 4315 Lisp_Object map_arg; | |
| 4316 Lisp_Object map_routine; | |
| 4317 Lisp_Object result; | |
| 4318 Lisp_Object property; | |
| 4319 Lisp_Object value; | |
| 4320 }; | |
| 4321 | |
| 4322 static int | |
| 4323 slow_map_extents_function (EXTENT extent, void *arg) | |
| 4324 { | |
| 4325 /* This function can GC */ | |
| 4326 struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg; | |
| 793 | 4327 Lisp_Object extent_obj = wrap_extent (extent); |
| 4328 | |
| 428 | 4329 |
| 4330 /* make sure this extent qualifies according to the PROPERTY | |
| 4331 and VALUE args */ | |
| 4332 | |
| 4333 if (!NILP (closure->property)) | |
| 4334 { | |
| 4335 Lisp_Object value = Fextent_property (extent_obj, closure->property, | |
| 4336 Qnil); | |
| 4337 if ((NILP (closure->value) && NILP (value)) || | |
| 4338 (!NILP (closure->value) && !EQ (value, closure->value))) | |
| 4339 return 0; | |
| 4340 } | |
| 4341 | |
| 4342 closure->result = call2 (closure->map_routine, extent_obj, | |
| 4343 closure->map_arg); | |
| 4344 return !NILP (closure->result); | |
| 4345 } | |
| 4346 | |
| 4347 DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /* | |
| 4348 Map FUNCTION over the extents which overlap a region in OBJECT. | |
| 4349 OBJECT is normally a buffer or string but could be an extent (see below). | |
| 4350 The region is normally bounded by [FROM, TO) (i.e. the beginning of the | |
| 4351 region is closed and the end of the region is open), but this can be | |
| 4352 changed with the FLAGS argument (see below for a complete discussion). | |
| 4353 | |
| 4354 FUNCTION is called with the arguments (extent, MAPARG). The arguments | |
| 4355 OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to | |
| 4356 the current buffer, the beginning of OBJECT, the end of OBJECT, nil, | |
| 4357 and nil, respectively. `map-extents' returns the first non-nil result | |
| 4358 produced by FUNCTION, and no more calls to FUNCTION are made after it | |
| 4359 returns non-nil. | |
| 4360 | |
| 4361 If OBJECT is an extent, FROM and TO default to the extent's endpoints, | |
| 4362 and the mapping omits that extent and its predecessors. This feature | |
| 4363 supports restarting a loop based on `map-extents'. Note: OBJECT must | |
| 4364 be attached to a buffer or string, and the mapping is done over that | |
| 4365 buffer or string. | |
| 4366 | |
| 4367 An extent overlaps the region if there is any point in the extent that is | |
| 4368 also in the region. (For the purpose of overlap, zero-length extents and | |
| 4369 regions are treated as closed on both ends regardless of their endpoints' | |
| 4370 specified open/closedness.) Note that the endpoints of an extent or region | |
| 4371 are considered to be in that extent or region if and only if the | |
| 4372 corresponding end is closed. For example, the extent [5,7] overlaps the | |
| 4373 region [2,5] because 5 is in both the extent and the region. However, (5,7] | |
| 4374 does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor | |
| 4375 \(5,7] overlaps the region [2,5) because 5 is not in the region. | |
| 4376 | |
| 4377 The optional FLAGS can be a symbol or a list of one or more symbols, | |
| 4378 modifying the behavior of `map-extents'. Allowed symbols are: | |
| 4379 | |
| 4380 end-closed The region's end is closed. | |
| 4381 | |
| 4382 start-open The region's start is open. | |
| 4383 | |
| 4384 all-extents-closed Treat all extents as closed on both ends for the | |
| 4385 purpose of determining whether they overlap the | |
| 4386 region, irrespective of their actual open- or | |
| 4387 closedness. | |
| 4388 all-extents-open Treat all extents as open on both ends. | |
| 4389 all-extents-closed-open Treat all extents as start-closed, end-open. | |
| 4390 all-extents-open-closed Treat all extents as start-open, end-closed. | |
| 4391 | |
| 4392 start-in-region In addition to the above conditions for extent | |
| 4393 overlap, the extent's start position must lie within | |
| 4394 the specified region. Note that, for this | |
| 4395 condition, open start positions are treated as if | |
| 4396 0.5 was added to the endpoint's value, and open | |
| 4397 end positions are treated as if 0.5 was subtracted | |
| 4398 from the endpoint's value. | |
| 4399 end-in-region The extent's end position must lie within the | |
| 4400 region. | |
| 4401 start-and-end-in-region Both the extent's start and end positions must lie | |
| 4402 within the region. | |
| 4403 start-or-end-in-region Either the extent's start or end position must lie | |
| 4404 within the region. | |
| 4405 | |
| 4406 negate-in-region The condition specified by a `*-in-region' flag | |
| 4407 must NOT hold for the extent to be considered. | |
| 4408 | |
| 4409 | |
| 4410 At most one of `all-extents-closed', `all-extents-open', | |
| 4411 `all-extents-closed-open', and `all-extents-open-closed' may be specified. | |
| 4412 | |
| 4413 At most one of `start-in-region', `end-in-region', | |
| 4414 `start-and-end-in-region', and `start-or-end-in-region' may be specified. | |
| 4415 | |
| 4416 If optional arg PROPERTY is non-nil, only extents with that property set | |
| 4417 on them will be visited. If optional arg VALUE is non-nil, only extents | |
| 4418 whose value for that property is `eq' to VALUE will be visited. | |
| 4419 */ | |
| 4420 (function, object, from, to, maparg, flags, property, value)) | |
| 4421 { | |
| 4422 /* This function can GC */ | |
| 4423 struct slow_map_extents_arg closure; | |
| 4424 unsigned int me_flags; | |
| 826 | 4425 Bytexpos start, end; |
| 428 | 4426 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
| 4427 EXTENT after = 0; | |
| 4428 | |
| 4429 if (EXTENTP (object)) | |
| 4430 { | |
| 4431 after = decode_extent (object, DE_MUST_BE_ATTACHED); | |
| 4432 if (NILP (from)) | |
| 4433 from = Fextent_start_position (object); | |
| 4434 if (NILP (to)) | |
| 4435 to = Fextent_end_position (object); | |
| 4436 object = extent_object (after); | |
| 4437 } | |
| 4438 else | |
| 4439 object = decode_buffer_or_string (object); | |
| 4440 | |
| 4441 get_buffer_or_string_range_byte (object, from, to, &start, &end, | |
| 4442 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE); | |
| 4443 | |
| 4444 me_flags = decode_map_extents_flags (flags); | |
| 4445 | |
| 4446 if (!NILP (property)) | |
| 4447 { | |
| 4448 if (!NILP (value)) | |
| 4449 value = canonicalize_extent_property (property, value); | |
| 4450 } | |
| 4451 | |
| 4452 GCPRO5 (function, maparg, object, property, value); | |
| 4453 | |
| 4454 closure.map_arg = maparg; | |
| 4455 closure.map_routine = function; | |
| 4456 closure.result = Qnil; | |
| 4457 closure.property = property; | |
| 4458 closure.value = value; | |
| 4459 | |
| 826 | 4460 map_extents (start, end, slow_map_extents_function, |
| 4461 (void *) &closure, object, after, | |
| 4462 /* You never know what the user might do ... */ | |
| 4463 me_flags | ME_MIGHT_CALL_ELISP); | |
| 428 | 4464 |
| 4465 UNGCPRO; | |
| 4466 return closure.result; | |
| 4467 } | |
| 4468 | |
| 4469 | |
| 4470 /************************************************************************/ | |
| 4471 /* mapping over extents -- other functions */ | |
| 4472 /************************************************************************/ | |
| 4473 | |
| 4474 /* ------------------------------- */ | |
| 4475 /* map-extent-children */ | |
| 4476 /* ------------------------------- */ | |
| 4477 | |
| 4478 struct slow_map_extent_children_arg | |
| 4479 { | |
| 4480 Lisp_Object map_arg; | |
| 4481 Lisp_Object map_routine; | |
| 4482 Lisp_Object result; | |
| 4483 Lisp_Object property; | |
| 4484 Lisp_Object value; | |
| 826 | 4485 Bytexpos start_min; |
| 4486 Bytexpos prev_start; | |
| 4487 Bytexpos prev_end; | |
| 428 | 4488 }; |
| 4489 | |
| 4490 static int | |
| 4491 slow_map_extent_children_function (EXTENT extent, void *arg) | |
| 4492 { | |
| 4493 /* This function can GC */ | |
| 4494 struct slow_map_extent_children_arg *closure = | |
| 4495 (struct slow_map_extent_children_arg *) arg; | |
| 4496 Lisp_Object extent_obj; | |
| 826 | 4497 Bytexpos start = extent_endpoint_byte (extent, 0); |
| 4498 Bytexpos end = extent_endpoint_byte (extent, 1); | |
| 428 | 4499 /* Make sure the extent starts inside the region of interest, |
| 4500 rather than just overlaps it. | |
| 4501 */ | |
| 4502 if (start < closure->start_min) | |
| 4503 return 0; | |
| 4504 /* Make sure the extent is not a child of a previous visited one. | |
| 4505 We know already, because of extent ordering, | |
| 4506 that start >= prev_start, and that if | |
| 4507 start == prev_start, then end <= prev_end. | |
| 4508 */ | |
| 4509 if (start == closure->prev_start) | |
| 4510 { | |
| 4511 if (end < closure->prev_end) | |
| 4512 return 0; | |
| 4513 } | |
| 4514 else /* start > prev_start */ | |
| 4515 { | |
| 4516 if (start < closure->prev_end) | |
| 4517 return 0; | |
| 4518 /* corner case: prev_end can be -1 if there is no prev */ | |
| 4519 } | |
| 793 | 4520 extent_obj = wrap_extent (extent); |
| 428 | 4521 |
| 4522 /* make sure this extent qualifies according to the PROPERTY | |
| 4523 and VALUE args */ | |
| 4524 | |
| 4525 if (!NILP (closure->property)) | |
| 4526 { | |
| 4527 Lisp_Object value = Fextent_property (extent_obj, closure->property, | |
| 4528 Qnil); | |
| 4529 if ((NILP (closure->value) && NILP (value)) || | |
| 4530 (!NILP (closure->value) && !EQ (value, closure->value))) | |
| 4531 return 0; | |
| 4532 } | |
| 4533 | |
| 4534 closure->result = call2 (closure->map_routine, extent_obj, | |
| 4535 closure->map_arg); | |
| 4536 | |
| 4537 /* Since the callback may change the buffer, compute all stored | |
| 4538 buffer positions here. | |
| 4539 */ | |
| 4540 closure->start_min = -1; /* no need for this any more */ | |
| 826 | 4541 closure->prev_start = extent_endpoint_byte (extent, 0); |
| 4542 closure->prev_end = extent_endpoint_byte (extent, 1); | |
| 428 | 4543 |
| 4544 return !NILP (closure->result); | |
| 4545 } | |
| 4546 | |
| 4547 DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /* | |
| 4548 Map FUNCTION over the extents in the region from FROM to TO. | |
| 4549 FUNCTION is called with arguments (extent, MAPARG). See `map-extents' | |
| 4550 for a full discussion of the arguments FROM, TO, and FLAGS. | |
| 4551 | |
| 4552 The arguments are the same as for `map-extents', but this function differs | |
| 4553 in that it only visits extents which start in the given region, and also | |
| 4554 in that, after visiting an extent E, it skips all other extents which start | |
| 4555 inside E but end before E's end. | |
| 4556 | |
| 4557 Thus, this function may be used to walk a tree of extents in a buffer: | |
| 4558 (defun walk-extents (buffer &optional ignore) | |
| 4559 (map-extent-children 'walk-extents buffer)) | |
| 4560 */ | |
| 4561 (function, object, from, to, maparg, flags, property, value)) | |
| 4562 { | |
| 4563 /* This function can GC */ | |
| 4564 struct slow_map_extent_children_arg closure; | |
| 4565 unsigned int me_flags; | |
| 826 | 4566 Bytexpos start, end; |
| 428 | 4567 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
| 4568 EXTENT after = 0; | |
| 4569 | |
| 4570 if (EXTENTP (object)) | |
| 4571 { | |
| 4572 after = decode_extent (object, DE_MUST_BE_ATTACHED); | |
| 4573 if (NILP (from)) | |
| 4574 from = Fextent_start_position (object); | |
| 4575 if (NILP (to)) | |
| 4576 to = Fextent_end_position (object); | |
| 4577 object = extent_object (after); | |
| 4578 } | |
| 4579 else | |
| 4580 object = decode_buffer_or_string (object); | |
| 4581 | |
| 4582 get_buffer_or_string_range_byte (object, from, to, &start, &end, | |
| 4583 GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE); | |
| 4584 | |
| 4585 me_flags = decode_map_extents_flags (flags); | |
| 4586 | |
| 4587 if (!NILP (property)) | |
| 4588 { | |
| 4589 if (!NILP (value)) | |
| 4590 value = canonicalize_extent_property (property, value); | |
| 4591 } | |
| 4592 | |
| 4593 GCPRO5 (function, maparg, object, property, value); | |
| 4594 | |
| 4595 closure.map_arg = maparg; | |
| 4596 closure.map_routine = function; | |
| 4597 closure.result = Qnil; | |
| 4598 closure.property = property; | |
| 4599 closure.value = value; | |
| 4600 closure.start_min = start; | |
| 4601 closure.prev_start = -1; | |
| 4602 closure.prev_end = -1; | |
| 826 | 4603 map_extents (start, end, slow_map_extent_children_function, |
| 4604 (void *) &closure, object, after, | |
| 4605 /* You never know what the user might do ... */ | |
| 4606 me_flags | ME_MIGHT_CALL_ELISP); | |
| 428 | 4607 |
| 4608 UNGCPRO; | |
| 4609 return closure.result; | |
| 4610 } | |
| 4611 | |
| 4612 /* ------------------------------- */ | |
| 4613 /* extent-at */ | |
| 4614 /* ------------------------------- */ | |
| 4615 | |
| 4616 /* find "smallest" matching extent containing pos -- (flag == 0) means | |
| 4617 all extents match, else (EXTENT_FLAGS (extent) & flag) must be true; | |
| 4618 for more than one matching extent with precisely the same endpoints, | |
| 4619 we choose the last extent in the extents_list. | |
| 4620 The search stops just before "before", if that is non-null. | |
| 4621 */ | |
| 4622 | |
| 4623 struct extent_at_arg | |
| 4624 { | |
| 442 | 4625 Lisp_Object best_match; /* or list of extents */ |
| 826 | 4626 Memxpos best_start; |
| 4627 Memxpos best_end; | |
| 428 | 4628 Lisp_Object prop; |
| 4629 EXTENT before; | |
| 442 | 4630 int all_extents; |
| 428 | 4631 }; |
| 4632 | |
| 4633 static enum extent_at_flag | |
| 4634 decode_extent_at_flag (Lisp_Object at_flag) | |
| 4635 { | |
| 4636 if (NILP (at_flag)) | |
| 4637 return EXTENT_AT_AFTER; | |
| 4638 | |
| 4639 CHECK_SYMBOL (at_flag); | |
| 4640 if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER; | |
| 4641 if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE; | |
| 4642 if (EQ (at_flag, Qat)) return EXTENT_AT_AT; | |
| 4643 | |
| 563 | 4644 invalid_constant ("Invalid AT-FLAG in `extent-at'", at_flag); |
| 1204 | 4645 RETURN_NOT_REACHED (EXTENT_AT_AFTER); |
| 428 | 4646 } |
| 4647 | |
| 4648 static int | |
| 4649 extent_at_mapper (EXTENT e, void *arg) | |
| 4650 { | |
| 4651 struct extent_at_arg *closure = (struct extent_at_arg *) arg; | |
| 4652 | |
| 4653 if (e == closure->before) | |
| 4654 return 1; | |
| 4655 | |
| 4656 /* If closure->prop is non-nil, then the extent is only acceptable | |
| 4657 if it has a non-nil value for that property. */ | |
| 4658 if (!NILP (closure->prop)) | |
| 4659 { | |
| 793 | 4660 Lisp_Object extent = wrap_extent (e); |
| 4661 | |
| 428 | 4662 if (NILP (Fextent_property (extent, closure->prop, Qnil))) |
| 4663 return 0; | |
| 4664 } | |
| 4665 | |
| 442 | 4666 if (!closure->all_extents) |
| 428 | 4667 { |
| 442 | 4668 EXTENT current; |
| 4669 | |
| 4670 if (NILP (closure->best_match)) | |
| 428 | 4671 goto accept; |
| 442 | 4672 current = XEXTENT (closure->best_match); |
| 428 | 4673 /* redundant but quick test */ |
| 442 | 4674 if (extent_start (current) > extent_start (e)) |
| 428 | 4675 return 0; |
| 4676 | |
| 4677 /* we return the "last" best fit, instead of the first -- | |
| 4678 this is because then the glyph closest to two equivalent | |
| 4679 extents corresponds to the "extent-at" the text just past | |
| 4680 that same glyph */ | |
| 4681 else if (!EXTENT_LESS_VALS (e, closure->best_start, | |
| 4682 closure->best_end)) | |
| 4683 goto accept; | |
| 4684 else | |
| 4685 return 0; | |
| 4686 accept: | |
| 793 | 4687 closure->best_match = wrap_extent (e); |
| 428 | 4688 closure->best_start = extent_start (e); |
| 4689 closure->best_end = extent_end (e); | |
| 4690 } | |
| 442 | 4691 else |
| 4692 { | |
| 793 | 4693 Lisp_Object extent = wrap_extent (e); |
| 4694 | |
| 442 | 4695 closure->best_match = Fcons (extent, closure->best_match); |
| 4696 } | |
| 428 | 4697 |
| 4698 return 0; | |
| 4699 } | |
| 4700 | |
| 826 | 4701 Lisp_Object |
| 4702 extent_at (Bytexpos position, Lisp_Object object, | |
| 4703 Lisp_Object property, EXTENT before, | |
| 4704 enum extent_at_flag at_flag, int all_extents) | |
| 428 | 4705 { |
| 4706 struct extent_at_arg closure; | |
| 442 | 4707 struct gcpro gcpro1; |
| 428 | 4708 |
| 4709 /* it might be argued that invalid positions should cause | |
| 4710 errors, but the principle of least surprise dictates that | |
| 4711 nil should be returned (extent-at is often used in | |
| 4712 response to a mouse event, and in many cases previous events | |
| 4713 have changed the buffer contents). | |
| 4714 | |
| 4715 Also, the openness stuff in the text-property code currently | |
| 4716 does not check its limits and might go off the end. */ | |
| 4717 if ((at_flag == EXTENT_AT_BEFORE | |
| 4718 ? position <= buffer_or_string_absolute_begin_byte (object) | |
| 4719 : position < buffer_or_string_absolute_begin_byte (object)) | |
| 4720 || (at_flag == EXTENT_AT_AFTER | |
| 4721 ? position >= buffer_or_string_absolute_end_byte (object) | |
| 4722 : position > buffer_or_string_absolute_end_byte (object))) | |
| 4723 return Qnil; | |
| 4724 | |
| 442 | 4725 closure.best_match = Qnil; |
| 428 | 4726 closure.prop = property; |
| 4727 closure.before = before; | |
| 442 | 4728 closure.all_extents = all_extents; |
| 4729 | |
| 4730 GCPRO1 (closure.best_match); | |
| 826 | 4731 map_extents (at_flag == EXTENT_AT_BEFORE ? prev_bytexpos (object, position) : |
| 4732 position, | |
| 4733 at_flag == EXTENT_AT_AFTER ? next_bytexpos (object, position) : | |
| 4734 position, | |
| 4735 extent_at_mapper, (void *) &closure, object, 0, | |
| 4736 ME_START_OPEN | ME_ALL_EXTENTS_CLOSED); | |
| 442 | 4737 if (all_extents) |
| 4738 closure.best_match = Fnreverse (closure.best_match); | |
| 4739 UNGCPRO; | |
| 4740 | |
| 4741 return closure.best_match; | |
| 428 | 4742 } |
| 4743 | |
| 4744 DEFUN ("extent-at", Fextent_at, 1, 5, 0, /* | |
| 4745 Find "smallest" extent at POS in OBJECT having PROPERTY set. | |
| 4746 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1); | |
| 4747 i.e. if it covers the character after POS. (However, see the definition | |
| 4748 of AT-FLAG.) "Smallest" means the extent that comes last in the display | |
| 4749 order; this normally means the extent whose start position is closest to | |
| 4750 POS. See `next-extent' for more information. | |
| 4751 OBJECT specifies a buffer or string and defaults to the current buffer. | |
| 4752 PROPERTY defaults to nil, meaning that any extent will do. | |
| 4753 Properties are attached to extents with `set-extent-property', which see. | |
| 4754 Returns nil if POS is invalid or there is no matching extent at POS. | |
| 4755 If the fourth argument BEFORE is not nil, it must be an extent; any returned | |
| 4756 extent will precede that extent. This feature allows `extent-at' to be | |
| 4757 used by a loop over extents. | |
| 4758 AT-FLAG controls how end cases are handled, and should be one of: | |
| 4759 | |
| 4760 nil or `after' An extent is at POS if it covers the character | |
| 4761 after POS. This is consistent with the way | |
| 4762 that text properties work. | |
| 4763 `before' An extent is at POS if it covers the character | |
| 4764 before POS. | |
| 4765 `at' An extent is at POS if it overlaps or abuts POS. | |
| 4766 This includes all zero-length extents at POS. | |
| 4767 | |
| 4768 Note that in all cases, the start-openness and end-openness of the extents | |
| 4769 considered is ignored. If you want to pay attention to those properties, | |
| 4770 you should use `map-extents', which gives you more control. | |
| 4771 */ | |
| 4772 (pos, object, property, before, at_flag)) | |
| 4773 { | |
| 826 | 4774 Bytexpos position; |
| 428 | 4775 EXTENT before_extent; |
| 4776 enum extent_at_flag fl; | |
| 4777 | |
| 4778 object = decode_buffer_or_string (object); | |
| 4779 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); | |
| 4780 if (NILP (before)) | |
| 4781 before_extent = 0; | |
| 4782 else | |
| 4783 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED); | |
| 4784 if (before_extent && !EQ (object, extent_object (before_extent))) | |
| 442 | 4785 invalid_argument ("extent not in specified buffer or string", object); |
| 428 | 4786 fl = decode_extent_at_flag (at_flag); |
| 4787 | |
| 826 | 4788 return extent_at (position, object, property, before_extent, fl, 0); |
| 442 | 4789 } |
| 4790 | |
| 4791 DEFUN ("extents-at", Fextents_at, 1, 5, 0, /* | |
| 4792 Find all extents at POS in OBJECT having PROPERTY set. | |
| 4793 Normally, an extent is "at" POS if it overlaps the region (POS, POS+1); | |
| 4794 i.e. if it covers the character after POS. (However, see the definition | |
| 4795 of AT-FLAG.) | |
| 4796 This provides similar functionality to `extent-list', but does so in a way | |
| 4797 that is compatible with `extent-at'. (For example, errors due to POS out of | |
| 4798 range are ignored; this makes it safer to use this function in response to | |
| 4799 a mouse event, because in many cases previous events have changed the buffer | |
| 4800 contents.) | |
| 4801 OBJECT specifies a buffer or string and defaults to the current buffer. | |
| 4802 PROPERTY defaults to nil, meaning that any extent will do. | |
| 4803 Properties are attached to extents with `set-extent-property', which see. | |
| 4804 Returns nil if POS is invalid or there is no matching extent at POS. | |
| 4805 If the fourth argument BEFORE is not nil, it must be an extent; any returned | |
| 4806 extent will precede that extent. This feature allows `extents-at' to be | |
| 4807 used by a loop over extents. | |
| 4808 AT-FLAG controls how end cases are handled, and should be one of: | |
| 4809 | |
| 4810 nil or `after' An extent is at POS if it covers the character | |
| 4811 after POS. This is consistent with the way | |
| 4812 that text properties work. | |
| 4813 `before' An extent is at POS if it covers the character | |
| 4814 before POS. | |
| 4815 `at' An extent is at POS if it overlaps or abuts POS. | |
| 4816 This includes all zero-length extents at POS. | |
| 4817 | |
| 4818 Note that in all cases, the start-openness and end-openness of the extents | |
| 4819 considered is ignored. If you want to pay attention to those properties, | |
| 4820 you should use `map-extents', which gives you more control. | |
| 4821 */ | |
| 4822 (pos, object, property, before, at_flag)) | |
| 4823 { | |
| 826 | 4824 Bytexpos position; |
| 442 | 4825 EXTENT before_extent; |
| 4826 enum extent_at_flag fl; | |
| 4827 | |
| 4828 object = decode_buffer_or_string (object); | |
| 4829 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); | |
| 4830 if (NILP (before)) | |
| 4831 before_extent = 0; | |
| 4832 else | |
| 4833 before_extent = decode_extent (before, DE_MUST_BE_ATTACHED); | |
| 4834 if (before_extent && !EQ (object, extent_object (before_extent))) | |
| 4835 invalid_argument ("extent not in specified buffer or string", object); | |
| 4836 fl = decode_extent_at_flag (at_flag); | |
| 4837 | |
| 826 | 4838 return extent_at (position, object, property, before_extent, fl, 1); |
| 428 | 4839 } |
| 4840 | |
| 4841 /* ------------------------------- */ | |
| 4842 /* verify_extent_modification() */ | |
| 4843 /* ------------------------------- */ | |
| 4844 | |
| 4845 /* verify_extent_modification() is called when a buffer or string is | |
| 4846 modified to check whether the modification is occuring inside a | |
| 4847 read-only extent. | |
| 4848 */ | |
| 4849 | |
| 4850 struct verify_extents_arg | |
| 4851 { | |
| 4852 Lisp_Object object; | |
| 826 | 4853 Memxpos start; |
| 4854 Memxpos end; | |
| 428 | 4855 Lisp_Object iro; /* value of inhibit-read-only */ |
| 4856 }; | |
| 4857 | |
| 4858 static int | |
| 4859 verify_extent_mapper (EXTENT extent, void *arg) | |
| 4860 { | |
| 4861 struct verify_extents_arg *closure = (struct verify_extents_arg *) arg; | |
| 4862 Lisp_Object prop = extent_read_only (extent); | |
| 4863 | |
| 4864 if (NILP (prop)) | |
| 4865 return 0; | |
| 4866 | |
| 4867 if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro))) | |
| 4868 return 0; | |
| 4869 | |
| 4870 #if 0 /* Nobody seems to care for this any more -sb */ | |
| 4871 /* Allow deletion if the extent is completely contained in | |
| 4872 the region being deleted. | |
| 4873 This is important for supporting tokens which are internally | |
| 4874 write-protected, but which can be killed and yanked as a whole. | |
| 4875 Ignore open/closed distinctions at this point. | |
| 4876 -- Rose | |
| 4877 */ | |
| 4878 if (closure->start != closure->end && | |
| 4879 extent_start (extent) >= closure->start && | |
| 4880 extent_end (extent) <= closure->end) | |
| 4881 return 0; | |
| 4882 #endif | |
| 4883 | |
| 4884 while (1) | |
| 4885 Fsignal (Qbuffer_read_only, (list1 (closure->object))); | |
| 4886 | |
| 1204 | 4887 RETURN_NOT_REACHED(0); |
| 428 | 4888 } |
| 4889 | |
| 4890 /* Value of Vinhibit_read_only is precomputed and passed in for | |
| 4891 efficiency */ | |
| 4892 | |
| 4893 void | |
| 826 | 4894 verify_extent_modification (Lisp_Object object, Bytexpos from, Bytexpos to, |
| 428 | 4895 Lisp_Object inhibit_read_only_value) |
| 4896 { | |
| 4897 int closed; | |
| 4898 struct verify_extents_arg closure; | |
| 4899 | |
| 4900 /* If insertion, visit closed-endpoint extents touching the insertion | |
| 4901 point because the text would go inside those extents. If deletion, | |
| 4902 treat the range as open on both ends so that touching extents are not | |
| 4903 visited. Note that we assume that an insertion is occurring if the | |
| 4904 changed range has zero length, and a deletion otherwise. This | |
| 4905 fails if a change (i.e. non-insertion, non-deletion) is happening. | |
| 4906 As far as I know, this doesn't currently occur in XEmacs. --ben */ | |
| 4907 closed = (from==to); | |
| 4908 closure.object = object; | |
| 826 | 4909 closure.start = buffer_or_string_bytexpos_to_memxpos (object, from); |
| 4910 closure.end = buffer_or_string_bytexpos_to_memxpos (object, to); | |
| 428 | 4911 closure.iro = inhibit_read_only_value; |
| 4912 | |
| 826 | 4913 map_extents (from, to, verify_extent_mapper, (void *) &closure, |
| 4914 object, 0, closed ? ME_END_CLOSED : ME_START_OPEN); | |
| 428 | 4915 } |
| 4916 | |
| 4917 /* ------------------------------------ */ | |
| 4918 /* process_extents_for_insertion() */ | |
| 4919 /* ------------------------------------ */ | |
| 4920 | |
| 4921 struct process_extents_for_insertion_arg | |
| 4922 { | |
| 826 | 4923 Bytexpos opoint; |
| 428 | 4924 int length; |
| 4925 Lisp_Object object; | |
| 4926 }; | |
| 4927 | |
| 4928 /* A region of length LENGTH was just inserted at OPOINT. Modify all | |
| 4929 of the extents as required for the insertion, based on their | |
| 4930 start-open/end-open properties. | |
| 4931 */ | |
| 4932 | |
| 4933 static int | |
| 4934 process_extents_for_insertion_mapper (EXTENT extent, void *arg) | |
| 4935 { | |
| 4936 struct process_extents_for_insertion_arg *closure = | |
| 4937 (struct process_extents_for_insertion_arg *) arg; | |
| 826 | 4938 Memxpos indice = buffer_or_string_bytexpos_to_memxpos (closure->object, |
| 4939 closure->opoint); | |
| 428 | 4940 |
| 4941 /* When this function is called, one end of the newly-inserted text should | |
| 4942 be adjacent to some endpoint of the extent, or disjoint from it. If | |
| 4943 the insertion overlaps any existing extent, something is wrong. | |
| 4944 */ | |
| 4945 #ifdef ERROR_CHECK_EXTENTS | |
| 4946 if (extent_start (extent) > indice && | |
| 4947 extent_start (extent) < indice + closure->length) | |
| 2500 | 4948 ABORT (); |
| 428 | 4949 if (extent_end (extent) > indice && |
| 4950 extent_end (extent) < indice + closure->length) | |
| 2500 | 4951 ABORT (); |
| 428 | 4952 #endif |
| 4953 | |
| 4954 /* The extent-adjustment code adjusted the extent's endpoints as if | |
| 468 | 4955 all extents were closed-open -- endpoints at the insertion point |
| 4956 remain unchanged. We need to fix the other kinds of extents: | |
| 4957 | |
| 4958 1. Start position of start-open extents needs to be moved. | |
| 4959 | |
| 4960 2. End position of end-closed extents needs to be moved. | |
| 4961 | |
| 4962 Note that both conditions hold for zero-length (] extents at the | |
| 4963 insertion point. But under these rules, zero-length () extents | |
| 4964 would get adjusted such that their start is greater than their | |
| 4965 end; instead of allowing that, we treat them as [) extents by | |
| 4966 modifying condition #1 to not fire nothing when dealing with a | |
| 4967 zero-length open-open extent. | |
| 4968 | |
| 4969 Existence of zero-length open-open extents is unfortunately an | |
| 4970 inelegant part of the extent model, but there is no way around | |
| 4971 it. */ | |
| 428 | 4972 |
| 4973 { | |
| 826 | 4974 Memxpos new_start = extent_start (extent); |
| 4975 Memxpos new_end = extent_end (extent); | |
| 468 | 4976 |
| 4977 if (indice == extent_start (extent) && extent_start_open_p (extent) | |
| 4978 /* zero-length () extents are exempt; see comment above. */ | |
| 4979 && !(new_start == new_end && extent_end_open_p (extent)) | |
| 4980 ) | |
| 428 | 4981 new_start += closure->length; |
| 4982 if (indice == extent_end (extent) && !extent_end_open_p (extent)) | |
| 4983 new_end += closure->length; | |
| 468 | 4984 |
| 428 | 4985 set_extent_endpoints_1 (extent, new_start, new_end); |
| 4986 } | |
| 4987 | |
| 4988 return 0; | |
| 4989 } | |
| 4990 | |
| 4991 void | |
| 826 | 4992 process_extents_for_insertion (Lisp_Object object, Bytexpos opoint, |
| 428 | 4993 Bytecount length) |
| 4994 { | |
| 4995 struct process_extents_for_insertion_arg closure; | |
| 4996 | |
| 4997 closure.opoint = opoint; | |
| 4998 closure.length = length; | |
| 4999 closure.object = object; | |
| 5000 | |
| 826 | 5001 map_extents (opoint, opoint + length, |
| 5002 process_extents_for_insertion_mapper, | |
| 5003 (void *) &closure, object, 0, | |
| 5004 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS | | |
| 5005 ME_INCLUDE_INTERNAL); | |
| 428 | 5006 } |
| 5007 | |
| 5008 /* ------------------------------------ */ | |
| 5009 /* process_extents_for_deletion() */ | |
| 5010 /* ------------------------------------ */ | |
| 5011 | |
| 5012 struct process_extents_for_deletion_arg | |
| 5013 { | |
| 826 | 5014 Memxpos start, end; |
| 428 | 5015 int destroy_included_extents; |
| 5016 }; | |
| 5017 | |
| 5018 /* This function is called when we're about to delete the range [from, to]. | |
| 5019 Detach all of the extents that are completely inside the range [from, to], | |
| 5020 if they're detachable or open-open. */ | |
| 5021 | |
| 5022 static int | |
| 5023 process_extents_for_deletion_mapper (EXTENT extent, void *arg) | |
| 5024 { | |
| 5025 struct process_extents_for_deletion_arg *closure = | |
| 5026 (struct process_extents_for_deletion_arg *) arg; | |
| 5027 | |
| 5028 /* If the extent lies completely within the range that | |
| 5029 is being deleted, then nuke the extent if it's detachable | |
| 5030 (otherwise, it will become a zero-length extent). */ | |
| 5031 | |
| 5032 if (closure->start <= extent_start (extent) && | |
| 5033 extent_end (extent) <= closure->end) | |
| 5034 { | |
| 5035 if (extent_detachable_p (extent)) | |
| 5036 { | |
| 5037 if (closure->destroy_included_extents) | |
| 5038 destroy_extent (extent); | |
| 5039 else | |
| 5040 extent_detach (extent); | |
| 5041 } | |
| 5042 } | |
| 5043 | |
| 5044 return 0; | |
| 5045 } | |
| 5046 | |
| 5047 /* DESTROY_THEM means destroy the extents instead of just deleting them. | |
| 5048 It is unused currently, but perhaps might be used (there used to | |
| 5049 be a function process_extents_for_destruction(), #if 0'd out, | |
| 5050 that did the equivalent). */ | |
| 5051 void | |
| 826 | 5052 process_extents_for_deletion (Lisp_Object object, Bytexpos from, |
| 5053 Bytexpos to, int destroy_them) | |
| 428 | 5054 { |
| 5055 struct process_extents_for_deletion_arg closure; | |
| 5056 | |
| 826 | 5057 closure.start = buffer_or_string_bytexpos_to_memxpos (object, from); |
| 5058 closure.end = buffer_or_string_bytexpos_to_memxpos (object, to); | |
| 428 | 5059 closure.destroy_included_extents = destroy_them; |
| 5060 | |
| 826 | 5061 map_extents (from, to, process_extents_for_deletion_mapper, |
| 5062 (void *) &closure, object, 0, | |
| 5063 ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS); | |
| 428 | 5064 } |
| 5065 | |
| 5066 /* ------------------------------- */ | |
| 5067 /* report_extent_modification() */ | |
| 5068 /* ------------------------------- */ | |
| 826 | 5069 |
| 5070 struct report_extent_modification_closure | |
| 5071 { | |
| 428 | 5072 Lisp_Object buffer; |
| 826 | 5073 Charxpos start, end; |
| 428 | 5074 int afterp; |
| 5075 int speccount; | |
| 5076 }; | |
| 5077 | |
| 5078 static Lisp_Object | |
| 5079 report_extent_modification_restore (Lisp_Object buffer) | |
| 5080 { | |
| 5081 if (current_buffer != XBUFFER (buffer)) | |
| 5082 Fset_buffer (buffer); | |
| 5083 return Qnil; | |
| 5084 } | |
| 5085 | |
| 5086 static int | |
| 5087 report_extent_modification_mapper (EXTENT extent, void *arg) | |
| 5088 { | |
| 5089 struct report_extent_modification_closure *closure = | |
| 5090 (struct report_extent_modification_closure *)arg; | |
| 5091 Lisp_Object exobj, startobj, endobj; | |
| 5092 Lisp_Object hook = (closure->afterp | |
| 5093 ? extent_after_change_functions (extent) | |
| 5094 : extent_before_change_functions (extent)); | |
| 5095 if (NILP (hook)) | |
| 5096 return 0; | |
| 5097 | |
| 793 | 5098 exobj = wrap_extent (extent); |
| 5099 startobj = make_int (closure->start); | |
| 5100 endobj = make_int (closure->end); | |
| 428 | 5101 |
| 5102 /* Now that we are sure to call elisp, set up an unwind-protect so | |
| 5103 inside_change_hook gets restored in case we throw. Also record | |
| 5104 the current buffer, in case we change it. Do the recording only | |
| 438 | 5105 once. |
| 5106 | |
| 5107 One confusing thing here is that our caller never actually calls | |
| 771 | 5108 unbind_to (closure.speccount). This is because |
| 826 | 5109 map_extents() unbinds before, and with a smaller |
| 771 | 5110 speccount. The additional unbind_to_1() in |
| 438 | 5111 report_extent_modification() would cause XEmacs to abort. */ |
| 428 | 5112 if (closure->speccount == -1) |
| 5113 { | |
| 5114 closure->speccount = specpdl_depth (); | |
| 5115 record_unwind_protect (report_extent_modification_restore, | |
| 5116 Fcurrent_buffer ()); | |
| 5117 } | |
| 5118 | |
| 5119 /* The functions will expect closure->buffer to be the current | |
| 5120 buffer, so change it if it isn't. */ | |
| 5121 if (current_buffer != XBUFFER (closure->buffer)) | |
| 5122 Fset_buffer (closure->buffer); | |
| 5123 | |
| 5124 /* #### It's a shame that we can't use any of the existing run_hook* | |
| 5125 functions here. This is so because all of them work with | |
| 5126 symbols, to be able to retrieve default values of local hooks. | |
| 438 | 5127 <sigh> |
| 5128 | |
| 5129 #### Idea: we could set up a dummy symbol, and call the hook | |
| 5130 functions on *that*. */ | |
| 428 | 5131 |
| 5132 if (!CONSP (hook) || EQ (XCAR (hook), Qlambda)) | |
| 5133 call3 (hook, exobj, startobj, endobj); | |
| 5134 else | |
| 5135 { | |
| 2367 | 5136 EXTERNAL_LIST_LOOP_2 (elt, hook) |
| 438 | 5137 /* #### Shouldn't this perform the same Fset_buffer() check as |
| 5138 above? */ | |
| 2367 | 5139 call3 (elt, exobj, startobj, endobj); |
| 428 | 5140 } |
| 5141 return 0; | |
| 5142 } | |
| 5143 | |
| 5144 void | |
| 665 | 5145 report_extent_modification (Lisp_Object buffer, Charbpos start, Charbpos end, |
| 438 | 5146 int afterp) |
| 428 | 5147 { |
| 5148 struct report_extent_modification_closure closure; | |
| 5149 | |
| 5150 closure.buffer = buffer; | |
| 5151 closure.start = start; | |
| 5152 closure.end = end; | |
| 5153 closure.afterp = afterp; | |
| 5154 closure.speccount = -1; | |
| 5155 | |
| 826 | 5156 map_extents (charbpos_to_bytebpos (XBUFFER (buffer), start), |
| 5157 charbpos_to_bytebpos (XBUFFER (buffer), end), | |
| 5158 report_extent_modification_mapper, (void *)&closure, | |
| 428 | 5159 buffer, NULL, ME_MIGHT_CALL_ELISP); |
| 5160 } | |
| 5161 | |
| 5162 | |
| 5163 /************************************************************************/ | |
| 5164 /* extent properties */ | |
| 5165 /************************************************************************/ | |
| 5166 | |
| 5167 static void | |
| 5168 set_extent_invisible (EXTENT extent, Lisp_Object value) | |
| 5169 { | |
| 5170 if (!EQ (extent_invisible (extent), value)) | |
| 5171 { | |
| 5172 set_extent_invisible_1 (extent, value); | |
| 826 | 5173 signal_extent_property_changed (extent, Qinvisible, 1); |
| 428 | 5174 } |
| 5175 } | |
| 5176 | |
| 5177 /* This function does "memoization" -- similar to the interning | |
| 5178 that happens with symbols. Given a list of faces, an equivalent | |
| 5179 list is returned such that if this function is called twice with | |
| 5180 input that is `equal', the resulting outputs will be `eq'. | |
| 5181 | |
| 5182 Note that the inputs and outputs are in general *not* `equal' -- | |
| 5183 faces in symbol form become actual face objects in the output. | |
| 5184 This is necessary so that temporary faces stay around. */ | |
| 5185 | |
| 5186 static Lisp_Object | |
| 5187 memoize_extent_face_internal (Lisp_Object list) | |
| 5188 { | |
| 5189 int len; | |
| 5190 int thelen; | |
| 5191 Lisp_Object cons, thecons; | |
| 5192 Lisp_Object oldtail, tail; | |
| 5193 struct gcpro gcpro1; | |
| 5194 | |
| 5195 if (NILP (list)) | |
| 5196 return Qnil; | |
| 5197 if (!CONSP (list)) | |
| 5198 return Fget_face (list); | |
| 5199 | |
| 5200 /* To do the memoization, we use a hash table mapping from | |
| 5201 external lists to internal lists. We do `equal' comparisons | |
| 5202 on the keys so the memoization works correctly. | |
| 5203 | |
| 5204 Note that we canonicalize things so that the keys in the | |
| 5205 hash table (the external lists) always contain symbols and | |
| 5206 the values (the internal lists) always contain face objects. | |
| 5207 | |
| 5208 We also maintain a "reverse" table that maps from the internal | |
| 5209 lists to the external equivalents. The idea here is twofold: | |
| 5210 | |
| 5211 1) `extent-face' wants to return a list containing face symbols | |
| 5212 rather than face objects. | |
| 5213 2) We don't want things to get quite so messed up if the user | |
| 5214 maliciously side-effects the returned lists. | |
| 5215 */ | |
| 5216 | |
| 5217 len = XINT (Flength (list)); | |
| 5218 thelen = XINT (Flength (Vextent_face_reusable_list)); | |
| 5219 oldtail = Qnil; | |
| 5220 tail = Qnil; | |
| 5221 GCPRO1 (oldtail); | |
| 5222 | |
| 5223 /* We canonicalize the given list into another list. | |
| 5224 We try to avoid consing except when necessary, so we have | |
| 5225 a reusable list. | |
| 5226 */ | |
| 5227 | |
| 5228 if (thelen < len) | |
| 5229 { | |
| 5230 cons = Vextent_face_reusable_list; | |
| 5231 while (!NILP (XCDR (cons))) | |
| 5232 cons = XCDR (cons); | |
| 5233 XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil); | |
| 5234 } | |
| 5235 else if (thelen > len) | |
| 5236 { | |
| 5237 int i; | |
| 5238 | |
| 5239 /* Truncate the list temporarily so it's the right length; | |
| 5240 remember the old tail. */ | |
| 5241 cons = Vextent_face_reusable_list; | |
| 5242 for (i = 0; i < len - 1; i++) | |
| 5243 cons = XCDR (cons); | |
| 5244 tail = cons; | |
| 5245 oldtail = XCDR (cons); | |
| 5246 XCDR (cons) = Qnil; | |
| 5247 } | |
| 5248 | |
| 5249 thecons = Vextent_face_reusable_list; | |
| 2367 | 5250 { |
| 5251 EXTERNAL_LIST_LOOP_2 (face, list) | |
| 5252 { | |
| 5253 face = Fget_face (face); | |
| 5254 | |
| 5255 XCAR (thecons) = Fface_name (face); | |
| 5256 thecons = XCDR (thecons); | |
| 5257 } | |
| 5258 } | |
| 428 | 5259 |
| 5260 list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table, | |
| 5261 Qnil); | |
| 5262 if (NILP (list)) | |
| 5263 { | |
| 5264 Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list); | |
| 5265 Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list); | |
| 5266 | |
| 5267 LIST_LOOP (cons, facelist) | |
| 5268 { | |
| 5269 XCAR (cons) = Fget_face (XCAR (cons)); | |
| 5270 } | |
| 5271 Fputhash (symlist, facelist, Vextent_face_memoize_hash_table); | |
| 5272 Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table); | |
| 5273 list = facelist; | |
| 5274 } | |
| 5275 | |
| 5276 /* Now restore the truncated tail of the reusable list, if necessary. */ | |
| 5277 if (!NILP (tail)) | |
| 5278 XCDR (tail) = oldtail; | |
| 5279 | |
| 5280 UNGCPRO; | |
| 5281 return list; | |
| 5282 } | |
| 5283 | |
| 5284 static Lisp_Object | |
| 5285 external_of_internal_memoized_face (Lisp_Object face) | |
| 5286 { | |
| 5287 if (NILP (face)) | |
| 5288 return Qnil; | |
| 5289 else if (!CONSP (face)) | |
| 5290 return XFACE (face)->name; | |
| 5291 else | |
| 5292 { | |
| 5293 face = Fgethash (face, Vextent_face_reverse_memoize_hash_table, | |
| 5294 Qunbound); | |
| 5295 assert (!UNBOUNDP (face)); | |
| 5296 return face; | |
| 5297 } | |
| 5298 } | |
| 5299 | |
| 826 | 5300 /* The idea here is that if we're given a list of faces, we |
| 5301 need to "memoize" this so that two lists of faces that are `equal' | |
| 5302 turn into the same object. When `set-extent-face' is called, we | |
| 5303 "memoize" into a list of actual faces; when `extent-face' is called, | |
| 5304 we do a reverse lookup to get the list of symbols. */ | |
| 5305 | |
| 428 | 5306 static Lisp_Object |
| 5307 canonicalize_extent_property (Lisp_Object prop, Lisp_Object value) | |
| 5308 { | |
| 5309 if (EQ (prop, Qface) || EQ (prop, Qmouse_face)) | |
| 5310 value = (external_of_internal_memoized_face | |
| 5311 (memoize_extent_face_internal (value))); | |
| 5312 return value; | |
| 5313 } | |
| 5314 | |
| 5315 /* Do we need a lisp-level function ? */ | |
| 826 | 5316 DEFUN ("set-extent-initial-redisplay-function", |
| 5317 Fset_extent_initial_redisplay_function, | |
| 444 | 5318 2,2,0, /* |
| 428 | 5319 Note: This feature is experimental! |
| 5320 | |
| 5321 Set initial-redisplay-function of EXTENT to the function | |
| 5322 FUNCTION. | |
| 5323 | |
| 5324 The first time the EXTENT is (re)displayed, an eval event will be | |
| 5325 dispatched calling FUNCTION with EXTENT as its only argument. | |
| 5326 */ | |
| 5327 (extent, function)) | |
| 5328 { | |
| 826 | 5329 /* #### This is totally broken. */ |
| 5330 EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); | |
| 428 | 5331 |
| 5332 e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/ | |
| 826 | 5333 set_extent_initial_redisplay_function (e, function); |
| 5334 extent_in_red_event_p (e) = 0; /* If the function changed we can spawn | |
| 428 | 5335 new events */ |
| 826 | 5336 signal_extent_property_changed (e, Qinitial_redisplay_function, 1); |
| 428 | 5337 return function; |
| 5338 } | |
| 5339 | |
| 5340 DEFUN ("extent-face", Fextent_face, 1, 1, 0, /* | |
| 5341 Return the name of the face in which EXTENT is displayed, or nil | |
| 5342 if the extent's face is unspecified. This might also return a list | |
| 5343 of face names. | |
| 5344 */ | |
| 5345 (extent)) | |
| 5346 { | |
| 5347 Lisp_Object face; | |
| 5348 | |
| 5349 CHECK_EXTENT (extent); | |
| 5350 face = extent_face (XEXTENT (extent)); | |
| 5351 | |
| 5352 return external_of_internal_memoized_face (face); | |
| 5353 } | |
| 5354 | |
| 5355 DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /* | |
| 5356 Make the given EXTENT have the graphic attributes specified by FACE. | |
| 5357 FACE can also be a list of faces, and all faces listed will apply, | |
| 5358 with faces earlier in the list taking priority over those later in the | |
| 5359 list. | |
| 5360 */ | |
| 5361 (extent, face)) | |
| 5362 { | |
| 5363 EXTENT e = decode_extent(extent, 0); | |
| 5364 Lisp_Object orig_face = face; | |
| 5365 | |
| 5366 /* retrieve the ancestor for efficiency and proper redisplay noting. */ | |
| 5367 e = extent_ancestor (e); | |
| 5368 | |
| 5369 face = memoize_extent_face_internal (face); | |
| 5370 | |
| 5371 extent_face (e) = face; | |
| 826 | 5372 signal_extent_property_changed (e, Qface, 1); |
| 428 | 5373 |
| 5374 return orig_face; | |
| 5375 } | |
| 5376 | |
| 5377 | |
| 5378 DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /* | |
| 5379 Return the face used to highlight EXTENT when the mouse passes over it. | |
| 5380 The return value will be a face name, a list of face names, or nil | |
| 5381 if the extent's mouse face is unspecified. | |
| 5382 */ | |
| 5383 (extent)) | |
| 5384 { | |
| 5385 Lisp_Object face; | |
| 5386 | |
| 5387 CHECK_EXTENT (extent); | |
| 5388 face = extent_mouse_face (XEXTENT (extent)); | |
| 5389 | |
| 5390 return external_of_internal_memoized_face (face); | |
| 5391 } | |
| 5392 | |
| 5393 DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /* | |
| 5394 Set the face used to highlight EXTENT when the mouse passes over it. | |
| 5395 FACE can also be a list of faces, and all faces listed will apply, | |
| 5396 with faces earlier in the list taking priority over those later in the | |
| 5397 list. | |
| 5398 */ | |
| 5399 (extent, face)) | |
| 5400 { | |
| 5401 EXTENT e; | |
| 5402 Lisp_Object orig_face = face; | |
| 5403 | |
| 5404 CHECK_EXTENT (extent); | |
| 5405 e = XEXTENT (extent); | |
| 5406 /* retrieve the ancestor for efficiency and proper redisplay noting. */ | |
| 5407 e = extent_ancestor (e); | |
| 5408 | |
| 5409 face = memoize_extent_face_internal (face); | |
| 5410 | |
| 5411 set_extent_mouse_face (e, face); | |
| 826 | 5412 signal_extent_property_changed (e, Qmouse_face, 1); |
| 428 | 5413 |
| 5414 return orig_face; | |
| 5415 } | |
| 5416 | |
| 5417 void | |
| 5418 set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp, | |
| 5419 glyph_layout layout) | |
| 5420 { | |
| 5421 extent = extent_ancestor (extent); | |
| 5422 | |
| 5423 if (!endp) | |
| 5424 { | |
| 5425 set_extent_begin_glyph (extent, glyph); | |
| 647 | 5426 set_extent_begin_glyph_layout (extent, layout); |
| 826 | 5427 signal_extent_property_changed (extent, Qbegin_glyph, 1); |
| 5428 signal_extent_property_changed (extent, Qbegin_glyph_layout, 1); | |
| 428 | 5429 } |
| 5430 else | |
| 5431 { | |
| 5432 set_extent_end_glyph (extent, glyph); | |
| 647 | 5433 set_extent_end_glyph_layout (extent, layout); |
| 826 | 5434 signal_extent_property_changed (extent, Qend_glyph, 1); |
| 5435 signal_extent_property_changed (extent, Qend_glyph_layout, 1); | |
| 428 | 5436 } |
| 5437 } | |
| 5438 | |
| 5439 static Lisp_Object | |
| 5440 glyph_layout_to_symbol (glyph_layout layout) | |
| 5441 { | |
| 5442 switch (layout) | |
| 5443 { | |
| 5444 case GL_TEXT: return Qtext; | |
| 5445 case GL_OUTSIDE_MARGIN: return Qoutside_margin; | |
| 5446 case GL_INSIDE_MARGIN: return Qinside_margin; | |
| 5447 case GL_WHITESPACE: return Qwhitespace; | |
| 5448 default: | |
| 2500 | 5449 ABORT (); |
| 428 | 5450 return Qnil; /* unreached */ |
| 5451 } | |
| 5452 } | |
| 5453 | |
| 5454 static glyph_layout | |
| 5455 symbol_to_glyph_layout (Lisp_Object layout_obj) | |
| 5456 { | |
| 5457 if (NILP (layout_obj)) | |
| 5458 return GL_TEXT; | |
| 5459 | |
| 5460 CHECK_SYMBOL (layout_obj); | |
| 5461 if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN; | |
| 5462 if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN; | |
| 5463 if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE; | |
| 5464 if (EQ (layout_obj, Qtext)) return GL_TEXT; | |
| 5465 | |
| 563 | 5466 invalid_constant ("Unknown glyph layout type", layout_obj); |
| 1204 | 5467 RETURN_NOT_REACHED (GL_TEXT); |
| 428 | 5468 } |
| 5469 | |
| 5470 static Lisp_Object | |
| 5471 set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp, | |
| 5472 Lisp_Object layout_obj) | |
| 5473 { | |
| 442 | 5474 EXTENT extent = decode_extent (extent_obj, 0); |
| 428 | 5475 glyph_layout layout = symbol_to_glyph_layout (layout_obj); |
| 5476 | |
| 5477 /* Make sure we've actually been given a valid glyph or it's nil | |
| 5478 (meaning we're deleting a glyph from an extent). */ | |
| 5479 if (!NILP (glyph)) | |
| 5480 CHECK_BUFFER_GLYPH (glyph); | |
| 5481 | |
| 5482 set_extent_glyph (extent, glyph, endp, layout); | |
| 5483 return glyph; | |
| 5484 } | |
| 5485 | |
| 5486 DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /* | |
| 5487 Display a bitmap, subwindow or string at the beginning of EXTENT. | |
| 5488 BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'. | |
| 5489 */ | |
| 5490 (extent, begin_glyph, layout)) | |
| 5491 { | |
| 5492 return set_extent_glyph_1 (extent, begin_glyph, 0, layout); | |
| 5493 } | |
| 5494 | |
| 5495 DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /* | |
| 5496 Display a bitmap, subwindow or string at the end of EXTENT. | |
| 5497 END-GLYPH must be a glyph object. The layout policy defaults to `text'. | |
| 5498 */ | |
| 5499 (extent, end_glyph, layout)) | |
| 5500 { | |
| 5501 return set_extent_glyph_1 (extent, end_glyph, 1, layout); | |
| 5502 } | |
| 5503 | |
| 5504 DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /* | |
| 5505 Return the glyph object displayed at the beginning of EXTENT. | |
| 5506 If there is none, nil is returned. | |
| 5507 */ | |
| 5508 (extent)) | |
| 5509 { | |
| 5510 return extent_begin_glyph (decode_extent (extent, 0)); | |
| 5511 } | |
| 5512 | |
| 5513 DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /* | |
| 5514 Return the glyph object displayed at the end of EXTENT. | |
| 5515 If there is none, nil is returned. | |
| 5516 */ | |
| 5517 (extent)) | |
| 5518 { | |
| 5519 return extent_end_glyph (decode_extent (extent, 0)); | |
| 5520 } | |
| 5521 | |
| 5522 DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /* | |
| 5523 Set the layout policy of EXTENT's begin glyph. | |
| 5524 Access this using the `extent-begin-glyph-layout' function. | |
| 5525 */ | |
| 5526 (extent, layout)) | |
| 5527 { | |
| 5528 EXTENT e = decode_extent (extent, 0); | |
| 5529 e = extent_ancestor (e); | |
| 647 | 5530 set_extent_begin_glyph_layout (e, symbol_to_glyph_layout (layout)); |
| 826 | 5531 signal_extent_property_changed (e, Qbegin_glyph_layout, 1); |
| 428 | 5532 return layout; |
| 5533 } | |
| 5534 | |
| 5535 DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /* | |
| 5536 Set the layout policy of EXTENT's end glyph. | |
| 5537 Access this using the `extent-end-glyph-layout' function. | |
| 5538 */ | |
| 5539 (extent, layout)) | |
| 5540 { | |
| 5541 EXTENT e = decode_extent (extent, 0); | |
| 5542 e = extent_ancestor (e); | |
| 647 | 5543 set_extent_end_glyph_layout (e, symbol_to_glyph_layout (layout)); |
| 826 | 5544 signal_extent_property_changed (e, Qend_glyph_layout, 1); |
| 428 | 5545 return layout; |
| 5546 } | |
| 5547 | |
| 5548 DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /* | |
| 5549 Return the layout policy associated with EXTENT's begin glyph. | |
| 5550 Set this using the `set-extent-begin-glyph-layout' function. | |
| 5551 */ | |
| 5552 (extent)) | |
| 5553 { | |
| 5554 EXTENT e = decode_extent (extent, 0); | |
| 5555 return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e)); | |
| 5556 } | |
| 5557 | |
| 5558 DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /* | |
| 5559 Return the layout policy associated with EXTENT's end glyph. | |
| 5560 Set this using the `set-extent-end-glyph-layout' function. | |
| 5561 */ | |
| 5562 (extent)) | |
| 5563 { | |
| 5564 EXTENT e = decode_extent (extent, 0); | |
| 5565 return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e)); | |
| 5566 } | |
| 5567 | |
| 5568 DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /* | |
| 5569 Set the display priority of EXTENT to PRIORITY (an integer). | |
| 5570 When the extent attributes are being merged for display, the priority | |
| 5571 is used to determine which extent takes precedence in the event of a | |
| 5572 conflict (two extents whose faces both specify font, for example: the | |
| 5573 font of the extent with the higher priority will be used). | |
| 5574 Extents are created with priority 0; priorities may be negative. | |
| 5575 */ | |
| 5576 (extent, priority)) | |
| 5577 { | |
| 5578 EXTENT e = decode_extent (extent, 0); | |
| 5579 | |
| 5580 CHECK_INT (priority); | |
| 5581 e = extent_ancestor (e); | |
| 5582 set_extent_priority (e, XINT (priority)); | |
| 826 | 5583 signal_extent_property_changed (e, Qpriority, 1); |
| 428 | 5584 return priority; |
| 5585 } | |
| 5586 | |
| 5587 DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /* | |
| 5588 Return the display priority of EXTENT; see `set-extent-priority'. | |
| 5589 */ | |
| 5590 (extent)) | |
| 5591 { | |
| 5592 EXTENT e = decode_extent (extent, 0); | |
| 5593 return make_int (extent_priority (e)); | |
| 5594 } | |
| 5595 | |
| 5596 DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /* | |
| 5597 Change a property of an extent. | |
| 5598 PROPERTY may be any symbol; the value stored may be accessed with | |
| 5599 the `extent-property' function. | |
| 2758 | 5600 |
| 428 | 5601 The following symbols have predefined meanings: |
| 5602 | |
| 5603 detached Removes the extent from its buffer; setting this is | |
| 5604 the same as calling `detach-extent'. | |
| 5605 | |
| 5606 destroyed Removes the extent from its buffer, and makes it | |
| 5607 unusable in the future; this is the same calling | |
| 5608 `delete-extent'. | |
| 5609 | |
| 5610 priority Change redisplay priority; same as `set-extent-priority'. | |
| 5611 | |
| 5612 start-open Whether the set of characters within the extent is | |
| 5613 treated being open on the left, that is, whether | |
| 5614 the start position is an exclusive, rather than | |
| 5615 inclusive, boundary. If true, then characters | |
| 5616 inserted exactly at the beginning of the extent | |
| 5617 will remain outside of the extent; otherwise they | |
| 5618 will go into the extent, extending it. | |
| 5619 | |
| 5620 end-open Whether the set of characters within the extent is | |
| 5621 treated being open on the right, that is, whether | |
| 5622 the end position is an exclusive, rather than | |
| 5623 inclusive, boundary. If true, then characters | |
| 5624 inserted exactly at the end of the extent will | |
| 5625 remain outside of the extent; otherwise they will | |
| 5626 go into the extent, extending it. | |
| 5627 | |
| 5628 By default, extents have the `end-open' but not the | |
| 5629 `start-open' property set. | |
| 5630 | |
| 5631 read-only Text within this extent will be unmodifiable. | |
| 5632 | |
| 5633 initial-redisplay-function (EXPERIMENTAL) | |
| 5634 function to be called the first time (part of) the extent | |
| 5635 is redisplayed. It will be called with the extent as its | |
| 5636 first argument. | |
| 1041 | 5637 Note: The function will not be called immediately |
| 5638 during redisplay, an eval event will be dispatched. | |
| 428 | 5639 |
| 5640 detachable Whether the extent gets detached (as with | |
| 5641 `detach-extent') when all the text within the | |
| 5642 extent is deleted. This is true by default. If | |
| 5643 this property is not set, the extent becomes a | |
| 5644 zero-length extent when its text is deleted. (In | |
| 5645 such a case, the `start-open' property is | |
| 5646 automatically removed if both the `start-open' and | |
| 5647 `end-open' properties are set, since zero-length | |
| 5648 extents open on both ends are not allowed.) | |
| 5649 | |
| 5650 face The face in which to display the text. Setting | |
| 5651 this is the same as calling `set-extent-face'. | |
| 5652 | |
| 1041 | 5653 mouse-face If non-nil, the extent will be highlighted in this |
| 5654 face when the mouse moves over it. | |
| 428 | 5655 |
| 5656 pointer If non-nil, and a valid pointer glyph, this specifies | |
| 5657 the shape of the mouse pointer while over the extent. | |
| 5658 | |
| 5659 highlight Obsolete: Setting this property is equivalent to | |
| 1041 | 5660 setting a `mouse-face' property of `highlight'. |
| 5661 Reading this property returns non-nil if | |
| 5662 the extent has a non-nil `mouse-face' property. | |
| 428 | 5663 |
| 5664 duplicable Whether this extent should be copied into strings, | |
| 5665 so that kill, yank, and undo commands will restore | |
| 5666 or copy it. `duplicable' extents are copied from | |
| 5667 an extent into a string when `buffer-substring' or | |
| 5668 a similar function creates a string. The extents | |
| 5669 in a string are copied into other strings created | |
| 5670 from the string using `concat' or `substring'. | |
| 5671 When `insert' or a similar function inserts the | |
| 5672 string into a buffer, the extents are copied back | |
| 5673 into the buffer. | |
| 5674 | |
| 5675 unique Meaningful only in conjunction with `duplicable'. | |
| 5676 When this is set, there may be only one instance | |
| 5677 of this extent attached at a time: if it is copied | |
| 5678 to the kill ring and then yanked, the extent is | |
| 5679 not copied. If, however, it is killed (removed | |
| 5680 from the buffer) and then yanked, it will be | |
| 5681 re-attached at the new position. | |
| 5682 | |
| 5683 invisible If the value is non-nil, text under this extent | |
| 5684 may be treated as not present for the purpose of | |
| 5685 redisplay, or may be displayed using an ellipsis | |
| 5686 or other marker; see `buffer-invisibility-spec' | |
| 5687 and `invisible-text-glyph'. In all cases, | |
| 5688 however, the text is still visible to other | |
| 5689 functions that examine a buffer's text. | |
| 5690 | |
| 5691 keymap This keymap is consulted for mouse clicks on this | |
| 5692 extent, or keypresses made while point is within the | |
| 5693 extent. | |
| 5694 | |
| 5695 copy-function This is a hook that is run when a duplicable extent | |
| 5696 is about to be copied from a buffer to a string (or | |
| 5697 the kill ring). It is called with three arguments, | |
| 5698 the extent, and the buffer-positions within it | |
| 5699 which are being copied. If this function returns | |
| 5700 nil, then the extent will not be copied; otherwise | |
| 5701 it will. | |
| 5702 | |
| 5703 paste-function This is a hook that is run when a duplicable extent is | |
| 5704 about to be copied from a string (or the kill ring) | |
| 5705 into a buffer. It is called with three arguments, | |
| 5706 the original extent, and the buffer positions which | |
| 5707 the copied extent will occupy. (This hook is run | |
| 5708 after the corresponding text has already been | |
| 5709 inserted into the buffer.) Note that the extent | |
| 5710 argument may be detached when this function is run. | |
| 5711 If this function returns nil, no extent will be | |
| 5712 inserted. Otherwise, there will be an extent | |
| 5713 covering the range in question. | |
| 5714 | |
| 5715 If the original extent is not attached to a buffer, | |
| 5716 then it will be re-attached at this range. | |
| 5717 Otherwise, a copy will be made, and that copy | |
| 5718 attached here. | |
| 5719 | |
| 5720 The copy-function and paste-function are meaningful | |
| 5721 only for extents with the `duplicable' flag set, | |
| 5722 and if they are not specified, behave as if `t' was | |
| 5723 the returned value. When these hooks are invoked, | |
| 5724 the current buffer is the buffer which the extent | |
| 5725 is being copied from/to, respectively. | |
| 5726 | |
| 5727 begin-glyph A glyph to be displayed at the beginning of the extent, | |
| 5728 or nil. | |
| 5729 | |
| 5730 end-glyph A glyph to be displayed at the end of the extent, | |
| 5731 or nil. | |
| 5732 | |
| 5733 begin-glyph-layout The layout policy (one of `text', `whitespace', | |
| 5734 `inside-margin', or `outside-margin') of the extent's | |
| 5735 begin glyph. | |
| 5736 | |
| 1041 | 5737 end-glyph-layout The layout policy of the extent's end glyph. |
| 5738 | |
| 5739 syntax-table A cons or a syntax table object. If a cons, the car must | |
| 2767 | 5740 be an integer (interpreted as a syntax code, applicable |
| 5741 to all characters in the extent). Otherwise, syntax of | |
| 5742 characters in the extent is looked up in the syntax | |
| 5743 table. You should use the text property API to | |
| 5744 manipulate this property. (This may be required in the | |
| 5745 future.) | |
| 5746 | |
| 5747 The following property is available if `atomic-extents.el'--part of the | |
| 5748 `edit-utils' package--has been loaded: | |
| 2758 | 5749 |
| 5750 atomic When set, point will never fall inside the extent. | |
| 5751 Not as useful as you might think, as | |
| 5752 `delete-backward-char' still removes characters one by | |
| 2767 | 5753 one. This property as currently implemented is a |
| 5754 kludge, and be prepared for it to go away if and when we | |
| 5755 implement something better. | |
| 2758 | 5756 |
| 428 | 5757 */ |
| 5758 (extent, property, value)) | |
| 5759 { | |
| 5760 /* This function can GC if property is `keymap' */ | |
| 5761 EXTENT e = decode_extent (extent, 0); | |
| 826 | 5762 int signal_change = 0; |
| 5763 | |
| 5764 /* If VALUE is unbound, the property is being removed through `remprop'. | |
| 5765 Return Qunbound if removal disallowed, Qt if anything removed, | |
| 5766 Qnil otherwise. */ | |
| 5767 | |
| 5768 /* Keep in synch with stuff below. */ | |
| 5769 if (UNBOUNDP (value)) | |
| 5770 { | |
| 5771 int retval; | |
| 5772 | |
| 5773 if (EQ (property, Qread_only) | |
| 5774 || EQ (property, Qunique) | |
| 5775 || EQ (property, Qduplicable) | |
| 5776 || EQ (property, Qinvisible) | |
| 5777 || EQ (property, Qdetachable) | |
| 5778 || EQ (property, Qdetached) | |
| 5779 || EQ (property, Qdestroyed) | |
| 5780 || EQ (property, Qpriority) | |
| 5781 || EQ (property, Qface) | |
| 5782 || EQ (property, Qinitial_redisplay_function) | |
| 5783 || EQ (property, Qafter_change_functions) | |
| 5784 || EQ (property, Qbefore_change_functions) | |
| 5785 || EQ (property, Qmouse_face) | |
| 5786 || EQ (property, Qhighlight) | |
| 5787 || EQ (property, Qbegin_glyph_layout) | |
| 5788 || EQ (property, Qend_glyph_layout) | |
| 5789 || EQ (property, Qglyph_layout) | |
| 5790 || EQ (property, Qbegin_glyph) | |
| 5791 || EQ (property, Qend_glyph) | |
| 5792 || EQ (property, Qstart_open) | |
| 5793 || EQ (property, Qend_open) | |
| 5794 || EQ (property, Qstart_closed) | |
| 5795 || EQ (property, Qend_closed) | |
| 5796 || EQ (property, Qkeymap)) | |
| 5797 return Qunbound; | |
| 5798 | |
| 5799 retval = external_remprop (extent_plist_addr (e), property, 0, | |
| 5800 ERROR_ME); | |
| 5801 if (retval) | |
| 5802 signal_extent_property_changed (e, property, 1); | |
| 5803 return retval ? Qt : Qnil; | |
| 5804 } | |
| 428 | 5805 |
| 5806 if (EQ (property, Qread_only)) | |
| 826 | 5807 { |
| 5808 set_extent_read_only (e, value); | |
| 5809 signal_change = 1; | |
| 5810 } | |
| 428 | 5811 else if (EQ (property, Qunique)) |
| 826 | 5812 { |
| 5813 extent_unique_p (e) = !NILP (value); | |
| 5814 signal_change = 1; | |
| 5815 } | |
| 428 | 5816 else if (EQ (property, Qduplicable)) |
| 826 | 5817 { |
| 5818 extent_duplicable_p (e) = !NILP (value); | |
| 5819 signal_change = 1; | |
| 5820 } | |
| 428 | 5821 else if (EQ (property, Qinvisible)) |
| 5822 set_extent_invisible (e, value); | |
| 5823 else if (EQ (property, Qdetachable)) | |
| 826 | 5824 { |
| 5825 extent_detachable_p (e) = !NILP (value); | |
| 5826 signal_change = 1; | |
| 5827 } | |
| 428 | 5828 else if (EQ (property, Qdetached)) |
| 5829 { | |
| 5830 if (NILP (value)) | |
| 826 | 5831 invalid_operation ("can only set `detached' to t", Qunbound); |
| 428 | 5832 Fdetach_extent (extent); |
| 5833 } | |
| 5834 else if (EQ (property, Qdestroyed)) | |
| 5835 { | |
| 5836 if (NILP (value)) | |
| 826 | 5837 invalid_operation ("can only set `destroyed' to t", Qunbound); |
| 428 | 5838 Fdelete_extent (extent); |
| 5839 } | |
| 5840 else if (EQ (property, Qpriority)) | |
| 5841 Fset_extent_priority (extent, value); | |
| 5842 else if (EQ (property, Qface)) | |
| 5843 Fset_extent_face (extent, value); | |
| 5844 else if (EQ (property, Qinitial_redisplay_function)) | |
| 5845 Fset_extent_initial_redisplay_function (extent, value); | |
| 5846 else if (EQ (property, Qbefore_change_functions)) | |
| 826 | 5847 { |
| 5848 set_extent_before_change_functions (e, value); | |
| 5849 signal_change = 1; | |
| 5850 } | |
| 428 | 5851 else if (EQ (property, Qafter_change_functions)) |
| 826 | 5852 { |
| 5853 set_extent_after_change_functions (e, value); | |
| 5854 signal_change = 1; | |
| 5855 } | |
| 428 | 5856 else if (EQ (property, Qmouse_face)) |
| 5857 Fset_extent_mouse_face (extent, value); | |
| 5858 /* Obsolete: */ | |
| 5859 else if (EQ (property, Qhighlight)) | |
| 5860 Fset_extent_mouse_face (extent, Qhighlight); | |
| 5861 else if (EQ (property, Qbegin_glyph_layout)) | |
| 5862 Fset_extent_begin_glyph_layout (extent, value); | |
| 5863 else if (EQ (property, Qend_glyph_layout)) | |
| 5864 Fset_extent_end_glyph_layout (extent, value); | |
| 5865 /* For backwards compatibility. We use begin glyph because it is by | |
| 5866 far the more used of the two. */ | |
| 5867 else if (EQ (property, Qglyph_layout)) | |
| 5868 Fset_extent_begin_glyph_layout (extent, value); | |
| 5869 else if (EQ (property, Qbegin_glyph)) | |
| 5870 Fset_extent_begin_glyph (extent, value, Qnil); | |
| 5871 else if (EQ (property, Qend_glyph)) | |
| 5872 Fset_extent_end_glyph (extent, value, Qnil); | |
| 5873 else if (EQ (property, Qstart_open)) | |
| 5874 set_extent_openness (e, !NILP (value), -1); | |
| 5875 else if (EQ (property, Qend_open)) | |
| 5876 set_extent_openness (e, -1, !NILP (value)); | |
| 5877 /* Support (but don't document...) the obvious *_closed antonyms. */ | |
| 5878 else if (EQ (property, Qstart_closed)) | |
| 5879 set_extent_openness (e, NILP (value), -1); | |
| 5880 else if (EQ (property, Qend_closed)) | |
| 5881 set_extent_openness (e, -1, NILP (value)); | |
| 5882 else | |
| 5883 { | |
| 5884 if (EQ (property, Qkeymap)) | |
| 5885 while (!NILP (value) && NILP (Fkeymapp (value))) | |
| 5886 value = wrong_type_argument (Qkeymapp, value); | |
| 5887 | |
| 5888 external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME); | |
| 826 | 5889 signal_change = 1; |
| 428 | 5890 } |
| 5891 | |
| 826 | 5892 if (signal_change) |
| 5893 signal_extent_property_changed (e, property, 1); | |
| 428 | 5894 return value; |
| 5895 } | |
| 5896 | |
| 5897 DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /* | |
| 5898 Change some properties of EXTENT. | |
| 5899 PLIST is a property list. | |
| 5900 For a list of built-in properties, see `set-extent-property'. | |
| 5901 */ | |
| 5902 (extent, plist)) | |
| 5903 { | |
| 5904 /* This function can GC, if one of the properties is `keymap' */ | |
| 5905 Lisp_Object property, value; | |
| 5906 struct gcpro gcpro1; | |
| 5907 GCPRO1 (plist); | |
| 5908 | |
| 5909 plist = Fcopy_sequence (plist); | |
| 5910 Fcanonicalize_plist (plist, Qnil); | |
| 5911 | |
| 5912 while (!NILP (plist)) | |
| 5913 { | |
| 5914 property = Fcar (plist); plist = Fcdr (plist); | |
| 5915 value = Fcar (plist); plist = Fcdr (plist); | |
| 5916 Fset_extent_property (extent, property, value); | |
| 5917 } | |
| 5918 UNGCPRO; | |
| 5919 return Qnil; | |
| 5920 } | |
| 5921 | |
| 5922 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /* | |
| 5923 Return EXTENT's value for property PROPERTY. | |
| 444 | 5924 If no such property exists, DEFAULT is returned. |
| 428 | 5925 See `set-extent-property' for the built-in property names. |
| 5926 */ | |
| 5927 (extent, property, default_)) | |
| 5928 { | |
| 5929 EXTENT e = decode_extent (extent, 0); | |
| 5930 | |
| 5931 if (EQ (property, Qdetached)) | |
| 5932 return extent_detached_p (e) ? Qt : Qnil; | |
| 5933 else if (EQ (property, Qdestroyed)) | |
| 5934 return !EXTENT_LIVE_P (e) ? Qt : Qnil; | |
| 5935 else if (EQ (property, Qstart_open)) | |
| 5936 return extent_normal_field (e, start_open) ? Qt : Qnil; | |
| 5937 else if (EQ (property, Qend_open)) | |
| 5938 return extent_normal_field (e, end_open) ? Qt : Qnil; | |
| 5939 else if (EQ (property, Qunique)) | |
| 5940 return extent_normal_field (e, unique) ? Qt : Qnil; | |
| 5941 else if (EQ (property, Qduplicable)) | |
| 5942 return extent_normal_field (e, duplicable) ? Qt : Qnil; | |
| 5943 else if (EQ (property, Qdetachable)) | |
| 5944 return extent_normal_field (e, detachable) ? Qt : Qnil; | |
| 5945 /* Support (but don't document...) the obvious *_closed antonyms. */ | |
| 5946 else if (EQ (property, Qstart_closed)) | |
| 5947 return extent_start_open_p (e) ? Qnil : Qt; | |
| 5948 else if (EQ (property, Qend_closed)) | |
| 5949 return extent_end_open_p (e) ? Qnil : Qt; | |
| 5950 else if (EQ (property, Qpriority)) | |
| 5951 return make_int (extent_priority (e)); | |
| 5952 else if (EQ (property, Qread_only)) | |
| 5953 return extent_read_only (e); | |
| 5954 else if (EQ (property, Qinvisible)) | |
| 5955 return extent_invisible (e); | |
| 5956 else if (EQ (property, Qface)) | |
| 5957 return Fextent_face (extent); | |
| 5958 else if (EQ (property, Qinitial_redisplay_function)) | |
| 5959 return extent_initial_redisplay_function (e); | |
| 5960 else if (EQ (property, Qbefore_change_functions)) | |
| 5961 return extent_before_change_functions (e); | |
| 5962 else if (EQ (property, Qafter_change_functions)) | |
| 5963 return extent_after_change_functions (e); | |
| 5964 else if (EQ (property, Qmouse_face)) | |
| 5965 return Fextent_mouse_face (extent); | |
| 5966 /* Obsolete: */ | |
| 5967 else if (EQ (property, Qhighlight)) | |
| 5968 return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil; | |
| 5969 else if (EQ (property, Qbegin_glyph_layout)) | |
| 5970 return Fextent_begin_glyph_layout (extent); | |
| 5971 else if (EQ (property, Qend_glyph_layout)) | |
| 5972 return Fextent_end_glyph_layout (extent); | |
| 5973 /* For backwards compatibility. We use begin glyph because it is by | |
| 5974 far the more used of the two. */ | |
| 5975 else if (EQ (property, Qglyph_layout)) | |
| 5976 return Fextent_begin_glyph_layout (extent); | |
| 5977 else if (EQ (property, Qbegin_glyph)) | |
| 5978 return extent_begin_glyph (e); | |
| 5979 else if (EQ (property, Qend_glyph)) | |
| 5980 return extent_end_glyph (e); | |
| 5981 else | |
| 5982 { | |
| 5983 Lisp_Object value = external_plist_get (extent_plist_addr (e), | |
| 5984 property, 0, ERROR_ME); | |
| 5985 return UNBOUNDP (value) ? default_ : value; | |
| 5986 } | |
| 5987 } | |
| 5988 | |
| 826 | 5989 static void |
| 5990 extent_properties (EXTENT e, Lisp_Object_pair_dynarr *props) | |
| 5991 { | |
| 5992 Lisp_Object face, anc_obj; | |
| 428 | 5993 glyph_layout layout; |
| 826 | 5994 EXTENT anc; |
| 5995 | |
| 5996 #define ADD_PROP(miftaaH, maal) \ | |
| 5997 do { \ | |
| 5998 Lisp_Object_pair p; \ | |
| 5999 p.key = miftaaH; \ | |
| 6000 p.value = maal; \ | |
| 6001 Dynarr_add (props, p); \ | |
| 6002 } while (0) | |
| 6003 | |
| 428 | 6004 if (!EXTENT_LIVE_P (e)) |
| 826 | 6005 { |
| 6006 ADD_PROP (Qdestroyed, Qt); | |
| 6007 return; | |
| 6008 } | |
| 428 | 6009 |
| 6010 anc = extent_ancestor (e); | |
| 793 | 6011 anc_obj = wrap_extent (anc); |
| 428 | 6012 |
| 6013 /* For efficiency, use the ancestor for all properties except detached */ | |
| 826 | 6014 { |
| 6015 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, extent_plist_slot (anc)) | |
| 6016 ADD_PROP (key, value); | |
| 6017 } | |
| 428 | 6018 |
| 6019 if (!NILP (face = Fextent_face (anc_obj))) | |
| 826 | 6020 ADD_PROP (Qface, face); |
| 428 | 6021 |
| 6022 if (!NILP (face = Fextent_mouse_face (anc_obj))) | |
| 826 | 6023 ADD_PROP (Qmouse_face, face); |
| 428 | 6024 |
| 6025 if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT) | |
| 6026 { | |
| 6027 Lisp_Object sym = glyph_layout_to_symbol (layout); | |
| 826 | 6028 ADD_PROP (Qglyph_layout, sym); /* compatibility */ |
| 6029 ADD_PROP (Qbegin_glyph_layout, sym); | |
| 428 | 6030 } |
| 6031 | |
| 6032 if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT) | |
| 826 | 6033 ADD_PROP (Qend_glyph_layout, glyph_layout_to_symbol (layout)); |
| 428 | 6034 |
| 6035 if (!NILP (extent_end_glyph (anc))) | |
| 826 | 6036 ADD_PROP (Qend_glyph, extent_end_glyph (anc)); |
| 428 | 6037 |
| 6038 if (!NILP (extent_begin_glyph (anc))) | |
| 826 | 6039 ADD_PROP (Qbegin_glyph, extent_begin_glyph (anc)); |
| 428 | 6040 |
| 6041 if (extent_priority (anc) != 0) | |
| 826 | 6042 ADD_PROP (Qpriority, make_int (extent_priority (anc))); |
| 428 | 6043 |
| 6044 if (!NILP (extent_initial_redisplay_function (anc))) | |
| 826 | 6045 ADD_PROP (Qinitial_redisplay_function, |
| 6046 extent_initial_redisplay_function (anc)); | |
| 428 | 6047 |
| 6048 if (!NILP (extent_before_change_functions (anc))) | |
| 826 | 6049 ADD_PROP (Qbefore_change_functions, extent_before_change_functions (anc)); |
| 428 | 6050 |
| 6051 if (!NILP (extent_after_change_functions (anc))) | |
| 826 | 6052 ADD_PROP (Qafter_change_functions, extent_after_change_functions (anc)); |
| 428 | 6053 |
| 6054 if (!NILP (extent_invisible (anc))) | |
| 826 | 6055 ADD_PROP (Qinvisible, extent_invisible (anc)); |
| 428 | 6056 |
| 6057 if (!NILP (extent_read_only (anc))) | |
| 826 | 6058 ADD_PROP (Qread_only, extent_read_only (anc)); |
| 428 | 6059 |
| 6060 if (extent_normal_field (anc, end_open)) | |
| 826 | 6061 ADD_PROP (Qend_open, Qt); |
| 428 | 6062 |
| 6063 if (extent_normal_field (anc, start_open)) | |
| 826 | 6064 ADD_PROP (Qstart_open, Qt); |
| 428 | 6065 |
| 6066 if (extent_normal_field (anc, detachable)) | |
| 826 | 6067 ADD_PROP (Qdetachable, Qt); |
| 428 | 6068 |
| 6069 if (extent_normal_field (anc, duplicable)) | |
| 826 | 6070 ADD_PROP (Qduplicable, Qt); |
| 428 | 6071 |
| 6072 if (extent_normal_field (anc, unique)) | |
| 826 | 6073 ADD_PROP (Qunique, Qt); |
| 428 | 6074 |
| 6075 /* detached is not an inherited property */ | |
| 6076 if (extent_detached_p (e)) | |
| 826 | 6077 ADD_PROP (Qdetached, Qt); |
| 6078 | |
| 6079 #undef ADD_PROP | |
| 6080 } | |
| 6081 | |
| 6082 DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* | |
| 6083 Return a property list of the attributes of EXTENT. | |
| 6084 Do not modify this list; use `set-extent-property' instead. | |
| 6085 */ | |
| 6086 (extent)) | |
| 6087 { | |
| 6088 EXTENT e; | |
| 6089 Lisp_Object result = Qnil; | |
| 6090 Lisp_Object_pair_dynarr *props; | |
| 6091 int i; | |
| 6092 | |
| 6093 CHECK_EXTENT (extent); | |
| 6094 e = XEXTENT (extent); | |
| 6095 props = Dynarr_new (Lisp_Object_pair); | |
| 6096 extent_properties (e, props); | |
| 6097 | |
| 6098 for (i = 0; i < Dynarr_length (props); i++) | |
| 6099 result = cons3 (Dynarr_at (props, i).key, Dynarr_at (props, i).value, | |
| 6100 result); | |
| 6101 | |
| 6102 Dynarr_free (props); | |
| 428 | 6103 return result; |
| 6104 } | |
| 6105 | |
| 6106 | |
| 6107 /************************************************************************/ | |
| 6108 /* highlighting */ | |
| 6109 /************************************************************************/ | |
| 6110 | |
| 6111 /* The display code looks into the Vlast_highlighted_extent variable to | |
| 6112 correctly display highlighted extents. This updates that variable, | |
| 6113 and marks the appropriate buffers as needing some redisplay. | |
| 6114 */ | |
| 6115 static void | |
| 6116 do_highlight (Lisp_Object extent_obj, int highlight_p) | |
| 6117 { | |
| 6118 if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) || | |
| 6119 (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil)))) | |
| 6120 return; | |
| 6121 if (EXTENTP (Vlast_highlighted_extent) && | |
| 6122 EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent))) | |
| 6123 { | |
| 6124 /* do not recurse on descendants. Only one extent is highlighted | |
| 6125 at a time. */ | |
| 826 | 6126 /* A bit of a lie. */ |
| 6127 signal_extent_property_changed (XEXTENT (Vlast_highlighted_extent), | |
| 6128 Qface, 0); | |
| 428 | 6129 } |
| 6130 Vlast_highlighted_extent = Qnil; | |
| 6131 if (!NILP (extent_obj) | |
| 6132 && BUFFERP (extent_object (XEXTENT (extent_obj))) | |
| 6133 && highlight_p) | |
| 6134 { | |
| 826 | 6135 signal_extent_property_changed (XEXTENT (extent_obj), Qface, 0); |
| 428 | 6136 Vlast_highlighted_extent = extent_obj; |
| 6137 } | |
| 6138 } | |
| 6139 | |
| 6140 DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /* | |
| 6141 Highlight or unhighlight the given extent. | |
| 6142 If the second arg is non-nil, it will be highlighted, else dehighlighted. | |
| 6143 This is the same as `highlight-extent', except that it will work even | |
| 6144 on extents without the `mouse-face' property. | |
| 6145 */ | |
| 6146 (extent, highlight_p)) | |
| 6147 { | |
| 6148 if (NILP (extent)) | |
| 6149 highlight_p = Qnil; | |
| 6150 else | |
| 793 | 6151 extent = wrap_extent (decode_extent (extent, DE_MUST_BE_ATTACHED)); |
| 428 | 6152 do_highlight (extent, !NILP (highlight_p)); |
| 6153 return Qnil; | |
| 6154 } | |
| 6155 | |
| 6156 DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /* | |
| 6157 Highlight EXTENT, if it is highlightable. | |
| 6158 \(that is, if it has the `mouse-face' property). | |
| 6159 If the second arg is non-nil, it will be highlighted, else dehighlighted. | |
| 6160 Highlighted extents are displayed as if they were merged with the face | |
| 6161 or faces specified by the `mouse-face' property. | |
| 6162 */ | |
| 6163 (extent, highlight_p)) | |
| 6164 { | |
| 6165 if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent)))) | |
| 6166 return Qnil; | |
| 6167 else | |
| 6168 return Fforce_highlight_extent (extent, highlight_p); | |
| 6169 } | |
| 6170 | |
| 6171 | |
| 6172 /************************************************************************/ | |
| 6173 /* strings and extents */ | |
| 6174 /************************************************************************/ | |
| 6175 | |
| 6176 /* copy/paste hooks */ | |
| 6177 | |
| 6178 static int | |
| 826 | 6179 run_extent_copy_paste_internal (EXTENT e, Charxpos from, Charxpos to, |
| 428 | 6180 Lisp_Object object, |
| 6181 Lisp_Object prop) | |
| 6182 { | |
| 6183 /* This function can GC */ | |
| 6184 Lisp_Object extent; | |
| 6185 Lisp_Object copy_fn; | |
| 793 | 6186 extent = wrap_extent (e); |
| 428 | 6187 copy_fn = Fextent_property (extent, prop, Qnil); |
| 6188 if (!NILP (copy_fn)) | |
| 6189 { | |
| 6190 Lisp_Object flag; | |
| 6191 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 6192 GCPRO3 (extent, copy_fn, object); | |
| 6193 if (BUFFERP (object)) | |
| 6194 flag = call3_in_buffer (XBUFFER (object), copy_fn, extent, | |
| 6195 make_int (from), make_int (to)); | |
| 6196 else | |
| 6197 flag = call3 (copy_fn, extent, make_int (from), make_int (to)); | |
| 6198 UNGCPRO; | |
| 6199 if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent))) | |
| 6200 return 0; | |
| 6201 } | |
| 6202 return 1; | |
| 6203 } | |
| 6204 | |
| 6205 static int | |
| 826 | 6206 run_extent_copy_function (EXTENT e, Bytexpos from, Bytexpos to) |
| 428 | 6207 { |
| 6208 Lisp_Object object = extent_object (e); | |
| 6209 /* This function can GC */ | |
| 6210 return run_extent_copy_paste_internal | |
| 826 | 6211 (e, buffer_or_string_bytexpos_to_charxpos (object, from), |
| 6212 buffer_or_string_bytexpos_to_charxpos (object, to), object, | |
| 428 | 6213 Qcopy_function); |
| 6214 } | |
| 6215 | |
| 6216 static int | |
| 826 | 6217 run_extent_paste_function (EXTENT e, Bytexpos from, Bytexpos to, |
| 428 | 6218 Lisp_Object object) |
| 6219 { | |
| 6220 /* This function can GC */ | |
| 6221 return run_extent_copy_paste_internal | |
| 826 | 6222 (e, buffer_or_string_bytexpos_to_charxpos (object, from), |
| 6223 buffer_or_string_bytexpos_to_charxpos (object, to), object, | |
| 428 | 6224 Qpaste_function); |
| 6225 } | |
| 6226 | |
| 826 | 6227 static int |
| 6228 run_extent_paste_function_char (EXTENT e, Charxpos from, Charxpos to, | |
| 6229 Lisp_Object object) | |
| 6230 { | |
| 6231 /* This function can GC */ | |
| 6232 return run_extent_copy_paste_internal (e, from, to, object, Qpaste_function); | |
| 6233 } | |
| 6234 | |
| 428 | 6235 static Lisp_Object |
| 826 | 6236 insert_extent (EXTENT extent, Bytexpos new_start, Bytexpos new_end, |
| 428 | 6237 Lisp_Object object, int run_hooks) |
| 6238 { | |
| 6239 /* This function can GC */ | |
| 6240 if (!EQ (extent_object (extent), object)) | |
| 6241 goto copy_it; | |
| 6242 | |
| 6243 if (extent_detached_p (extent)) | |
| 6244 { | |
| 6245 if (run_hooks && | |
| 6246 !run_extent_paste_function (extent, new_start, new_end, object)) | |
| 6247 /* The paste-function said don't re-attach this extent here. */ | |
| 6248 return Qnil; | |
| 6249 else | |
| 826 | 6250 set_extent_endpoints (extent, new_start, new_end, Qnil); |
| 428 | 6251 } |
| 6252 else | |
| 6253 { | |
| 826 | 6254 Bytexpos exstart = extent_endpoint_byte (extent, 0); |
| 6255 Bytexpos exend = extent_endpoint_byte (extent, 1); | |
| 428 | 6256 |
| 6257 if (exend < new_start || exstart > new_end) | |
| 6258 goto copy_it; | |
| 6259 else | |
| 6260 { | |
| 6261 new_start = min (exstart, new_start); | |
| 6262 new_end = max (exend, new_end); | |
| 6263 if (exstart != new_start || exend != new_end) | |
| 826 | 6264 set_extent_endpoints (extent, new_start, new_end, Qnil); |
| 428 | 6265 } |
| 6266 } | |
| 6267 | |
| 793 | 6268 return wrap_extent (extent); |
| 428 | 6269 |
| 6270 copy_it: | |
| 6271 if (run_hooks && | |
| 6272 !run_extent_paste_function (extent, new_start, new_end, object)) | |
| 6273 /* The paste-function said don't attach a copy of the extent here. */ | |
| 6274 return Qnil; | |
| 6275 else | |
| 793 | 6276 return wrap_extent (copy_extent (extent, new_start, new_end, object)); |
| 428 | 6277 } |
| 6278 | |
| 6279 DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /* | |
| 6280 Insert EXTENT from START to END in BUFFER-OR-STRING. | |
| 6281 BUFFER-OR-STRING defaults to the current buffer if omitted. | |
| 826 | 6282 If EXTENT is already on the same object, and overlaps or is adjacent to |
| 6283 the given range, its range is merely extended to include the new range. | |
| 6284 Otherwise, a copy is made of the extent at the new position and object. | |
| 6285 When a copy is made, the new extent is returned, copy/paste hooks are run, | |
| 6286 and the change is noted for undo recording. When no copy is made, nil is | |
| 6287 returned. See documentation on `detach-extent' for a discussion of undo | |
| 6288 recording. | |
| 6289 | |
| 428 | 6290 The fourth arg, NO-HOOKS, can be used to inhibit the running of the |
| 826 | 6291 extent's `paste-function' property if it has one. |
| 6292 | |
| 6293 It's not really clear why this function exists any more. It was a holdover | |
| 6294 from a much older implementation of extents, before extents could really | |
| 6295 exist on strings. | |
| 428 | 6296 */ |
| 6297 (extent, start, end, no_hooks, buffer_or_string)) | |
| 6298 { | |
| 6299 EXTENT ext = decode_extent (extent, 0); | |
| 6300 Lisp_Object copy; | |
| 826 | 6301 Bytexpos s, e; |
| 428 | 6302 |
| 6303 buffer_or_string = decode_buffer_or_string (buffer_or_string); | |
| 6304 get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, | |
| 6305 GB_ALLOW_PAST_ACCESSIBLE); | |
| 6306 | |
| 6307 copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks)); | |
| 6308 if (EXTENTP (copy)) | |
| 6309 { | |
| 6310 if (extent_duplicable_p (XEXTENT (copy))) | |
| 6311 record_extent (copy, 1); | |
| 6312 } | |
| 6313 return copy; | |
| 6314 } | |
| 6315 | |
| 6316 | |
| 6317 /* adding buffer extents to a string */ | |
| 6318 | |
| 6319 struct add_string_extents_arg | |
| 6320 { | |
| 826 | 6321 Bytexpos from; |
| 428 | 6322 Bytecount length; |
| 6323 Lisp_Object string; | |
| 6324 }; | |
| 6325 | |
| 6326 static int | |
| 6327 add_string_extents_mapper (EXTENT extent, void *arg) | |
| 6328 { | |
| 6329 /* This function can GC */ | |
| 6330 struct add_string_extents_arg *closure = | |
| 6331 (struct add_string_extents_arg *) arg; | |
| 826 | 6332 Bytecount start = extent_endpoint_byte (extent, 0) - closure->from; |
| 6333 Bytecount end = extent_endpoint_byte (extent, 1) - closure->from; | |
| 428 | 6334 |
| 6335 if (extent_duplicable_p (extent)) | |
| 6336 { | |
| 6337 start = max (start, 0); | |
| 6338 end = min (end, closure->length); | |
| 6339 | |
| 6340 /* Run the copy-function to give an extent the option of | |
| 6341 not being copied into the string (or kill ring). | |
| 6342 */ | |
| 6343 if (extent_duplicable_p (extent) && | |
| 6344 !run_extent_copy_function (extent, start + closure->from, | |
| 6345 end + closure->from)) | |
| 6346 return 0; | |
| 6347 copy_extent (extent, start, end, closure->string); | |
| 6348 } | |
| 6349 | |
| 6350 return 0; | |
| 6351 } | |
| 6352 | |
| 826 | 6353 struct add_string_extents_the_hard_way_arg |
| 6354 { | |
| 6355 Charxpos from; | |
| 6356 Charcount length; | |
| 6357 Lisp_Object string; | |
| 6358 }; | |
| 6359 | |
| 6360 static int | |
| 6361 add_string_extents_the_hard_way_mapper (EXTENT extent, void *arg) | |
| 6362 { | |
| 6363 /* This function can GC */ | |
| 6364 struct add_string_extents_arg *closure = | |
| 6365 (struct add_string_extents_arg *) arg; | |
| 6366 Charcount start = extent_endpoint_char (extent, 0) - closure->from; | |
| 6367 Charcount end = extent_endpoint_char (extent, 1) - closure->from; | |
| 6368 | |
| 6369 if (extent_duplicable_p (extent)) | |
| 6370 { | |
| 6371 start = max (start, 0); | |
| 6372 end = min (end, closure->length); | |
| 6373 | |
| 6374 /* Run the copy-function to give an extent the option of | |
| 6375 not being copied into the string (or kill ring). | |
| 6376 */ | |
| 6377 if (extent_duplicable_p (extent) && | |
| 6378 !run_extent_copy_function (extent, start + closure->from, | |
| 6379 end + closure->from)) | |
| 6380 return 0; | |
| 6381 copy_extent (extent, | |
| 6382 string_index_char_to_byte (closure->string, start), | |
| 6383 string_index_char_to_byte (closure->string, end), | |
| 6384 closure->string); | |
| 6385 } | |
| 6386 | |
| 6387 return 0; | |
| 6388 } | |
| 6389 | |
| 428 | 6390 /* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to |
| 6391 the string STRING. */ | |
| 6392 void | |
| 826 | 6393 add_string_extents (Lisp_Object string, struct buffer *buf, Bytexpos opoint, |
| 428 | 6394 Bytecount length) |
| 6395 { | |
| 6396 /* This function can GC */ | |
| 6397 struct gcpro gcpro1, gcpro2; | |
| 6398 Lisp_Object buffer; | |
| 6399 | |
| 771 | 6400 buffer = wrap_buffer (buf); |
| 428 | 6401 GCPRO2 (buffer, string); |
| 826 | 6402 |
| 6403 if (XSTRING_FORMAT (string) == BUF_FORMAT (buf)) | |
| 6404 { | |
| 6405 struct add_string_extents_arg closure; | |
| 6406 closure.from = opoint; | |
| 6407 closure.length = length; | |
| 6408 closure.string = string; | |
| 6409 map_extents (opoint, opoint + length, add_string_extents_mapper, | |
| 6410 (void *) &closure, buffer, 0, | |
| 6411 /* ignore extents that just abut the region */ | |
| 6412 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6413 /* we are calling E-Lisp (the extent's copy function) | |
| 6414 so anything might happen */ | |
| 6415 ME_MIGHT_CALL_ELISP); | |
| 6416 } | |
| 6417 else | |
| 6418 { | |
| 6419 struct add_string_extents_the_hard_way_arg closure; | |
| 6420 closure.from = bytebpos_to_charbpos (buf, opoint); | |
| 6421 closure.length = (bytebpos_to_charbpos (buf, opoint + length) - | |
| 6422 closure.from); | |
| 6423 closure.string = string; | |
| 6424 | |
| 6425 /* If the string and buffer are in different formats, things get | |
| 6426 tricky; the only reasonable way to do the operation is entirely in | |
| 6427 char offsets, which are invariant to format changes. In practice, | |
| 6428 this won't be time-consuming because the byte/char conversions are | |
| 6429 mostly in the buffer, which will be in a fixed-width format. */ | |
| 6430 map_extents (opoint, opoint + length, | |
| 6431 add_string_extents_the_hard_way_mapper, | |
| 6432 (void *) &closure, buffer, 0, | |
| 6433 /* ignore extents that just abut the region */ | |
| 6434 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6435 /* we are calling E-Lisp (the extent's copy function) | |
| 6436 so anything might happen */ | |
| 6437 ME_MIGHT_CALL_ELISP); | |
| 6438 | |
| 6439 } | |
| 6440 | |
| 428 | 6441 UNGCPRO; |
| 6442 } | |
| 6443 | |
| 6444 struct splice_in_string_extents_arg | |
| 6445 { | |
| 6446 Bytecount pos; | |
| 6447 Bytecount length; | |
| 826 | 6448 Bytexpos opoint; |
| 428 | 6449 Lisp_Object buffer; |
| 6450 }; | |
| 6451 | |
| 6452 static int | |
| 6453 splice_in_string_extents_mapper (EXTENT extent, void *arg) | |
| 6454 { | |
| 6455 /* This function can GC */ | |
| 6456 struct splice_in_string_extents_arg *closure = | |
| 6457 (struct splice_in_string_extents_arg *) arg; | |
| 6458 /* BASE_START and BASE_END are the limits in the buffer of the string | |
| 6459 that was just inserted. | |
| 826 | 6460 |
| 428 | 6461 NEW_START and NEW_END are the prospective buffer positions of the |
| 6462 extent that is going into the buffer. */ | |
| 826 | 6463 Bytexpos base_start = closure->opoint; |
| 6464 Bytexpos base_end = base_start + closure->length; | |
| 6465 Bytexpos new_start = (base_start + extent_endpoint_byte (extent, 0) - | |
| 6466 closure->pos); | |
| 6467 Bytexpos new_end = (base_start + extent_endpoint_byte (extent, 1) - | |
| 428 | 6468 closure->pos); |
| 6469 | |
| 6470 if (new_start < base_start) | |
| 6471 new_start = base_start; | |
| 6472 if (new_end > base_end) | |
| 6473 new_end = base_end; | |
| 6474 if (new_end <= new_start) | |
| 6475 return 0; | |
| 6476 | |
| 6477 if (!extent_duplicable_p (extent)) | |
| 6478 return 0; | |
| 6479 | |
| 6480 if (!inside_undo && | |
| 6481 !run_extent_paste_function (extent, new_start, new_end, | |
| 6482 closure->buffer)) | |
| 6483 return 0; | |
| 6484 copy_extent (extent, new_start, new_end, closure->buffer); | |
| 6485 | |
| 6486 return 0; | |
| 6487 } | |
| 6488 | |
| 826 | 6489 struct splice_in_string_extents_the_hard_way_arg |
| 6490 { | |
| 6491 Charcount pos; | |
| 6492 Charcount length; | |
| 6493 Charxpos opoint; | |
| 6494 Lisp_Object buffer; | |
| 6495 }; | |
| 6496 | |
| 6497 static int | |
| 6498 splice_in_string_extents_the_hard_way_mapper (EXTENT extent, void *arg) | |
| 6499 { | |
| 6500 /* This function can GC */ | |
| 6501 struct splice_in_string_extents_arg *closure = | |
| 6502 (struct splice_in_string_extents_arg *) arg; | |
| 6503 /* BASE_START and BASE_END are the limits in the buffer of the string | |
| 6504 that was just inserted. | |
| 6505 | |
| 6506 NEW_START and NEW_END are the prospective buffer positions of the | |
| 6507 extent that is going into the buffer. */ | |
| 6508 Charxpos base_start = closure->opoint; | |
| 6509 Charxpos base_end = base_start + closure->length; | |
| 6510 Charxpos new_start = (base_start + extent_endpoint_char (extent, 0) - | |
| 6511 closure->pos); | |
| 6512 Charxpos new_end = (base_start + extent_endpoint_char (extent, 1) - | |
| 6513 closure->pos); | |
| 6514 | |
| 6515 if (new_start < base_start) | |
| 6516 new_start = base_start; | |
| 6517 if (new_end > base_end) | |
| 6518 new_end = base_end; | |
| 6519 if (new_end <= new_start) | |
| 6520 return 0; | |
| 6521 | |
| 6522 if (!extent_duplicable_p (extent)) | |
| 6523 return 0; | |
| 6524 | |
| 6525 if (!inside_undo && | |
| 6526 !run_extent_paste_function_char (extent, new_start, new_end, | |
| 6527 closure->buffer)) | |
| 6528 return 0; | |
| 6529 copy_extent (extent, | |
| 6530 charbpos_to_bytebpos (XBUFFER (closure->buffer), new_start), | |
| 6531 charbpos_to_bytebpos (XBUFFER (closure->buffer), new_end), | |
| 6532 closure->buffer); | |
| 6533 | |
| 6534 return 0; | |
| 6535 } | |
| 6536 | |
| 428 | 6537 /* We have just inserted a section of STRING (starting at POS, of |
| 6538 length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary | |
| 6539 to get the string's extents into the buffer. */ | |
| 6540 | |
| 6541 void | |
| 6542 splice_in_string_extents (Lisp_Object string, struct buffer *buf, | |
| 826 | 6543 Bytexpos opoint, Bytecount length, Bytecount pos) |
| 6544 { | |
| 428 | 6545 struct gcpro gcpro1, gcpro2; |
| 793 | 6546 Lisp_Object buffer = wrap_buffer (buf); |
| 6547 | |
| 428 | 6548 GCPRO2 (buffer, string); |
| 826 | 6549 if (XSTRING_FORMAT (string) == BUF_FORMAT (buf)) |
| 6550 { | |
| 6551 struct splice_in_string_extents_arg closure; | |
| 6552 closure.opoint = opoint; | |
| 6553 closure.pos = pos; | |
| 6554 closure.length = length; | |
| 6555 closure.buffer = buffer; | |
| 6556 map_extents (pos, pos + length, | |
| 6557 splice_in_string_extents_mapper, | |
| 6558 (void *) &closure, string, 0, | |
| 6559 /* ignore extents that just abut the region */ | |
| 6560 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6561 /* we are calling E-Lisp (the extent's copy function) | |
| 6562 so anything might happen */ | |
| 6563 ME_MIGHT_CALL_ELISP); | |
| 6564 } | |
| 6565 else | |
| 6566 { | |
| 6567 struct splice_in_string_extents_the_hard_way_arg closure; | |
| 6568 closure.opoint = bytebpos_to_charbpos (buf, opoint); | |
| 6569 closure.pos = string_index_byte_to_char (string, pos); | |
| 6570 closure.length = string_offset_byte_to_char_len (string, pos, length); | |
| 6571 closure.buffer = buffer; | |
| 6572 | |
| 6573 /* If the string and buffer are in different formats, things get | |
| 6574 tricky; the only reasonable way to do the operation is entirely in | |
| 6575 char offsets, which are invariant to format changes. In practice, | |
| 6576 this won't be time-consuming because the byte/char conversions are | |
| 6577 mostly in the buffer, which will be in a fixed-width format. */ | |
| 6578 map_extents (pos, pos + length, | |
| 6579 splice_in_string_extents_the_hard_way_mapper, | |
| 6580 (void *) &closure, string, 0, | |
| 6581 /* ignore extents that just abut the region */ | |
| 6582 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6583 /* we are calling E-Lisp (the extent's copy function) | |
| 6584 so anything might happen */ | |
| 6585 ME_MIGHT_CALL_ELISP); | |
| 6586 | |
| 6587 } | |
| 428 | 6588 UNGCPRO; |
| 6589 } | |
| 6590 | |
| 6591 struct copy_string_extents_arg | |
| 6592 { | |
| 6593 Bytecount new_pos; | |
| 6594 Bytecount old_pos; | |
| 6595 Bytecount length; | |
| 6596 Lisp_Object new_string; | |
| 6597 }; | |
| 6598 | |
| 6599 struct copy_string_extents_1_arg | |
| 6600 { | |
| 6601 Lisp_Object parent_in_question; | |
| 6602 EXTENT found_extent; | |
| 6603 }; | |
| 6604 | |
| 6605 static int | |
| 6606 copy_string_extents_mapper (EXTENT extent, void *arg) | |
| 6607 { | |
| 6608 struct copy_string_extents_arg *closure = | |
| 6609 (struct copy_string_extents_arg *) arg; | |
| 6610 Bytecount old_start, old_end, new_start, new_end; | |
| 6611 | |
| 826 | 6612 old_start = extent_endpoint_byte (extent, 0); |
| 6613 old_end = extent_endpoint_byte (extent, 1); | |
| 428 | 6614 |
| 6615 old_start = max (closure->old_pos, old_start); | |
| 6616 old_end = min (closure->old_pos + closure->length, old_end); | |
| 6617 | |
| 6618 if (old_start >= old_end) | |
| 6619 return 0; | |
| 6620 | |
| 6621 new_start = old_start + closure->new_pos - closure->old_pos; | |
| 6622 new_end = old_end + closure->new_pos - closure->old_pos; | |
| 6623 | |
| 6624 copy_extent (extent, new_start, new_end, closure->new_string); | |
| 6625 return 0; | |
| 6626 } | |
| 6627 | |
| 6628 /* The string NEW_STRING was partially constructed from OLD_STRING. | |
| 6629 In particular, the section of length LEN starting at NEW_POS in | |
| 6630 NEW_STRING came from the section of the same length starting at | |
| 6631 OLD_POS in OLD_STRING. Copy the extents as appropriate. */ | |
| 6632 | |
| 6633 void | |
| 6634 copy_string_extents (Lisp_Object new_string, Lisp_Object old_string, | |
| 6635 Bytecount new_pos, Bytecount old_pos, | |
| 6636 Bytecount length) | |
| 6637 { | |
| 6638 struct copy_string_extents_arg closure; | |
| 6639 struct gcpro gcpro1, gcpro2; | |
| 6640 | |
| 6641 closure.new_pos = new_pos; | |
| 6642 closure.old_pos = old_pos; | |
| 6643 closure.new_string = new_string; | |
| 6644 closure.length = length; | |
| 6645 GCPRO2 (new_string, old_string); | |
| 826 | 6646 map_extents (old_pos, old_pos + length, |
| 6647 copy_string_extents_mapper, | |
| 6648 (void *) &closure, old_string, 0, | |
| 6649 /* ignore extents that just abut the region */ | |
| 6650 ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | | |
| 6651 /* we are calling E-Lisp (the extent's copy function) | |
| 6652 so anything might happen */ | |
| 6653 ME_MIGHT_CALL_ELISP); | |
| 428 | 6654 UNGCPRO; |
| 6655 } | |
| 6656 | |
| 6657 /* Checklist for sanity checking: | |
| 6658 - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent | |
| 6659 - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer | |
| 6660 */ | |
| 6661 | |
| 6662 | |
| 6663 /************************************************************************/ | |
| 6664 /* text properties */ | |
| 6665 /************************************************************************/ | |
| 6666 | |
| 6667 /* Text properties | |
| 6668 Originally this stuff was implemented in lisp (all of the functionality | |
| 6669 exists to make that possible) but speed was a problem. | |
| 6670 */ | |
| 6671 | |
| 6672 Lisp_Object Qtext_prop; | |
| 6673 Lisp_Object Qtext_prop_extent_paste_function; | |
| 6674 | |
| 826 | 6675 /* Retrieve the value of the property PROP of the text at position POSITION |
| 6676 in OBJECT. TEXT-PROPS-ONLY means only look at extents with the | |
| 6677 `text-prop' property, i.e. extents created by the text property | |
| 6678 routines. Otherwise, all extents are examined. &&#### finish Note that | |
| 6679 the default extent_at_flag is EXTENT_AT_DEFAULT (same as | |
| 6680 EXTENT_AT_AFTER). */ | |
| 6681 Lisp_Object | |
| 6682 get_char_property (Bytexpos position, Lisp_Object prop, | |
| 6683 Lisp_Object object, enum extent_at_flag fl, | |
| 6684 int text_props_only) | |
| 428 | 6685 { |
| 6686 Lisp_Object extent; | |
| 6687 | |
| 6688 /* text_props_only specifies whether we only consider text-property | |
| 3025 | 6689 extents (those with the `text-prop' property set) or all extents. */ |
| 428 | 6690 if (!text_props_only) |
| 826 | 6691 extent = extent_at (position, object, prop, 0, fl, 0); |
| 428 | 6692 else |
| 6693 { | |
| 6694 EXTENT prior = 0; | |
| 6695 while (1) | |
| 6696 { | |
| 826 | 6697 extent = extent_at (position, object, Qtext_prop, prior, fl, 0); |
| 428 | 6698 if (NILP (extent)) |
| 6699 return Qnil; | |
| 6700 if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil))) | |
| 6701 break; | |
| 6702 prior = XEXTENT (extent); | |
| 6703 } | |
| 6704 } | |
| 6705 | |
| 6706 if (!NILP (extent)) | |
| 6707 return Fextent_property (extent, prop, Qnil); | |
| 6708 if (!NILP (Vdefault_text_properties)) | |
| 6709 return Fplist_get (Vdefault_text_properties, prop, Qnil); | |
| 6710 return Qnil; | |
| 6711 } | |
| 6712 | |
| 6713 static Lisp_Object | |
| 826 | 6714 get_char_property_char (Lisp_Object pos, Lisp_Object prop, Lisp_Object object, |
| 6715 Lisp_Object at_flag, int text_props_only) | |
| 6716 { | |
| 6717 Bytexpos position; | |
| 428 | 6718 int invert = 0; |
| 6719 | |
| 6720 object = decode_buffer_or_string (object); | |
| 6721 position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); | |
| 6722 | |
| 6723 /* We canonicalize the start/end-open/closed properties to the | |
| 6724 non-default version -- "adding" the default property really | |
| 6725 needs to remove the non-default one. See below for more | |
| 6726 on this. */ | |
| 6727 if (EQ (prop, Qstart_closed)) | |
| 6728 { | |
| 6729 prop = Qstart_open; | |
| 6730 invert = 1; | |
| 6731 } | |
| 6732 | |
| 6733 if (EQ (prop, Qend_open)) | |
| 6734 { | |
| 6735 prop = Qend_closed; | |
| 6736 invert = 1; | |
| 6737 } | |
| 6738 | |
| 6739 { | |
| 6740 Lisp_Object val = | |
| 826 | 6741 get_char_property (position, prop, object, |
| 6742 decode_extent_at_flag (at_flag), | |
| 6743 text_props_only); | |
| 428 | 6744 if (invert) |
| 6745 val = NILP (val) ? Qt : Qnil; | |
| 6746 return val; | |
| 6747 } | |
| 6748 } | |
| 6749 | |
| 6750 DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /* | |
| 6751 Return the value of the PROP property at the given position. | |
| 6752 Optional arg OBJECT specifies the buffer or string to look in, and | |
| 6753 defaults to the current buffer. | |
| 6754 Optional arg AT-FLAG controls what it means for a property to be "at" | |
| 6755 a position, and has the same meaning as in `extent-at'. | |
| 6756 This examines only those properties added with `put-text-property'. | |
| 6757 See also `get-char-property'. | |
| 6758 */ | |
| 6759 (pos, prop, object, at_flag)) | |
| 6760 { | |
| 826 | 6761 return get_char_property_char (pos, prop, object, at_flag, 1); |
| 428 | 6762 } |
| 6763 | |
| 6764 DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /* | |
| 6765 Return the value of the PROP property at the given position. | |
| 6766 Optional arg OBJECT specifies the buffer or string to look in, and | |
| 6767 defaults to the current buffer. | |
| 6768 Optional arg AT-FLAG controls what it means for a property to be "at" | |
| 6769 a position, and has the same meaning as in `extent-at'. | |
| 6770 This examines properties on all extents. | |
| 6771 See also `get-text-property'. | |
| 6772 */ | |
| 6773 (pos, prop, object, at_flag)) | |
| 6774 { | |
| 826 | 6775 return get_char_property_char (pos, prop, object, at_flag, 0); |
| 428 | 6776 } |
| 6777 | |
| 6778 /* About start/end-open/closed: | |
| 6779 | |
| 6780 These properties have to be handled specially because of their | |
| 6781 strange behavior. If I put the "start-open" property on a region, | |
| 6782 then *all* text-property extents in the region have to have their | |
| 6783 start be open. This is unlike all other properties, which don't | |
| 6784 affect the extents of text properties other than their own. | |
| 6785 | |
| 6786 So: | |
| 6787 | |
| 6788 1) We have to map start-closed to (not start-open) and end-open | |
| 6789 to (not end-closed) -- i.e. adding the default is really the | |
| 6790 same as remove the non-default property. It won't work, for | |
| 6791 example, to have both "start-open" and "start-closed" on | |
| 6792 the same region. | |
| 6793 2) Whenever we add one of these properties, we go through all | |
| 6794 text-property extents in the region and set the appropriate | |
| 6795 open/closedness on them. | |
| 6796 3) Whenever we change a text-property extent for a property, | |
| 6797 we have to make sure we set the open/closedness properly. | |
| 6798 | |
| 6799 (2) and (3) together rely on, and maintain, the invariant | |
| 6800 that the open/closedness of text-property extents is correct | |
| 6801 at the beginning and end of each operation. | |
| 6802 */ | |
| 6803 | |
| 6804 struct put_text_prop_arg | |
| 6805 { | |
| 6806 Lisp_Object prop, value; /* The property and value we are storing */ | |
| 826 | 6807 Bytexpos start, end; /* The region into which we are storing it */ |
| 428 | 6808 Lisp_Object object; |
| 6809 Lisp_Object the_extent; /* Our chosen extent; this is used for | |
| 6810 communication between subsequent passes. */ | |
| 6811 int changed_p; /* Output: whether we have modified anything */ | |
| 6812 }; | |
| 6813 | |
| 6814 static int | |
| 6815 put_text_prop_mapper (EXTENT e, void *arg) | |
| 6816 { | |
| 6817 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; | |
| 6818 | |
| 6819 Lisp_Object object = closure->object; | |
| 6820 Lisp_Object value = closure->value; | |
| 826 | 6821 Bytexpos e_start, e_end; |
| 6822 Bytexpos start = closure->start; | |
| 6823 Bytexpos end = closure->end; | |
| 428 | 6824 Lisp_Object extent, e_val; |
| 6825 int is_eq; | |
| 6826 | |
| 793 | 6827 extent = wrap_extent (e); |
| 428 | 6828 |
| 3025 | 6829 /* Note: in some cases when the property itself is `start-open' |
| 6830 or `end-closed', the checks to set the openness may do a bit | |
| 428 | 6831 of extra work; but it won't hurt because we then fix up the |
| 6832 openness later on in put_text_prop_openness_mapper(). */ | |
| 6833 if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop)) | |
| 6834 /* It's not for this property; do nothing. */ | |
| 6835 return 0; | |
| 6836 | |
| 826 | 6837 e_start = extent_endpoint_byte (e, 0); |
| 6838 e_end = extent_endpoint_byte (e, 1); | |
| 428 | 6839 e_val = Fextent_property (extent, closure->prop, Qnil); |
| 6840 is_eq = EQ (value, e_val); | |
| 6841 | |
| 6842 if (!NILP (value) && NILP (closure->the_extent) && is_eq) | |
| 6843 { | |
| 6844 /* We want there to be an extent here at the end, and we haven't picked | |
| 6845 one yet, so use this one. Extend it as necessary. We only reuse an | |
| 6846 extent which has an EQ value for the prop in question to avoid | |
| 6847 side-effecting the kill ring (that is, we never change the property | |
| 6848 on an extent after it has been created.) | |
| 6849 */ | |
| 6850 if (e_start != start || e_end != end) | |
| 6851 { | |
| 826 | 6852 Bytexpos new_start = min (e_start, start); |
| 6853 Bytexpos new_end = max (e_end, end); | |
| 428 | 6854 set_extent_endpoints (e, new_start, new_end, Qnil); |
| 6855 /* If we changed the endpoint, then we need to set its | |
| 6856 openness. */ | |
| 6857 set_extent_openness (e, new_start != e_start | |
| 826 | 6858 ? !NILP (get_char_property |
| 428 | 6859 (start, Qstart_open, object, |
| 6860 EXTENT_AT_AFTER, 1)) : -1, | |
| 6861 new_end != e_end | |
| 826 | 6862 ? NILP (get_char_property |
| 6863 (prev_bytexpos (object, end), | |
| 6864 Qend_closed, object, | |
| 428 | 6865 EXTENT_AT_AFTER, 1)) |
| 6866 : -1); | |
| 6867 closure->changed_p = 1; | |
| 6868 } | |
| 6869 closure->the_extent = extent; | |
| 6870 } | |
| 6871 | |
| 6872 /* Even if we're adding a prop, at this point, we want all other extents of | |
| 6873 this prop to go away (as now they overlap). So the theory here is that, | |
| 6874 when we are adding a prop to a region that has multiple (disjoint) | |
| 6875 occurrences of that prop in it already, we pick one of those and extend | |
| 6876 it, and remove the others. | |
| 6877 */ | |
| 6878 | |
| 6879 else if (EQ (extent, closure->the_extent)) | |
| 6880 { | |
| 6881 /* just in case map-extents hits it again (does that happen?) */ | |
| 6882 ; | |
| 6883 } | |
| 6884 else if (e_start >= start && e_end <= end) | |
| 6885 { | |
| 6886 /* Extent is contained in region; remove it. Don't destroy or modify | |
| 6887 it, because we don't want to change the attributes pointed to by the | |
| 6888 duplicates in the kill ring. | |
| 6889 */ | |
| 6890 extent_detach (e); | |
| 6891 closure->changed_p = 1; | |
| 6892 } | |
| 6893 else if (!NILP (closure->the_extent) && | |
| 6894 is_eq && | |
| 6895 e_start <= end && | |
| 6896 e_end >= start) | |
| 6897 { | |
| 6898 EXTENT te = XEXTENT (closure->the_extent); | |
| 6899 /* This extent overlaps, and has the same prop/value as the extent we've | |
| 6900 decided to reuse, so we can remove this existing extent as well (the | |
| 6901 whole thing, even the part outside of the region) and extend | |
| 6902 the-extent to cover it, resulting in the minimum number of extents in | |
| 6903 the buffer. | |
| 6904 */ | |
| 826 | 6905 Bytexpos the_start = extent_endpoint_byte (te, 0); |
| 6906 Bytexpos the_end = extent_endpoint_byte (te, 1); | |
| 428 | 6907 if (e_start != the_start && /* note AND not OR -- hmm, why is this |
| 6908 the case? I think it's because the | |
| 6909 assumption that the text-property | |
| 6910 extents don't overlap makes it | |
| 6911 OK; changing it to an OR would | |
| 6912 result in changed_p sometimes getting | |
| 6913 falsely marked. Is this bad? */ | |
| 6914 e_end != the_end) | |
| 6915 { | |
| 826 | 6916 Bytexpos new_start = min (e_start, the_start); |
| 6917 Bytexpos new_end = max (e_end, the_end); | |
| 428 | 6918 set_extent_endpoints (te, new_start, new_end, Qnil); |
| 6919 /* If we changed the endpoint, then we need to set its | |
| 6920 openness. We are setting the endpoint to be the same as | |
| 6921 that of the extent we're about to remove, and we assume | |
| 6922 (the invariant mentioned above) that extent has the | |
| 6923 proper endpoint setting, so we just use it. */ | |
| 6924 set_extent_openness (te, new_start != e_start ? | |
| 6925 (int) extent_start_open_p (e) : -1, | |
| 6926 new_end != e_end ? | |
| 6927 (int) extent_end_open_p (e) : -1); | |
| 6928 closure->changed_p = 1; | |
| 6929 } | |
| 6930 extent_detach (e); | |
| 6931 } | |
| 6932 else if (e_end <= end) | |
| 6933 { | |
| 6934 /* Extent begins before start but ends before end, so we can just | |
| 6935 decrease its end position. | |
| 6936 */ | |
| 6937 if (e_end != start) | |
| 6938 { | |
| 6939 set_extent_endpoints (e, e_start, start, Qnil); | |
| 826 | 6940 set_extent_openness (e, -1, |
| 6941 NILP (get_char_property | |
| 6942 (prev_bytexpos (object, start), | |
| 6943 Qend_closed, object, | |
| 6944 EXTENT_AT_AFTER, 1))); | |
| 428 | 6945 closure->changed_p = 1; |
| 6946 } | |
| 6947 } | |
| 6948 else if (e_start >= start) | |
| 6949 { | |
| 6950 /* Extent ends after end but begins after start, so we can just | |
| 6951 increase its start position. | |
| 6952 */ | |
| 6953 if (e_start != end) | |
| 6954 { | |
| 6955 set_extent_endpoints (e, end, e_end, Qnil); | |
| 826 | 6956 set_extent_openness (e, !NILP (get_char_property |
| 428 | 6957 (end, Qstart_open, object, |
| 6958 EXTENT_AT_AFTER, 1)), -1); | |
| 6959 closure->changed_p = 1; | |
| 6960 } | |
| 6961 } | |
| 6962 else | |
| 6963 { | |
| 6964 /* Otherwise, `extent' straddles the region. We need to split it. | |
| 6965 */ | |
| 6966 set_extent_endpoints (e, e_start, start, Qnil); | |
| 826 | 6967 set_extent_openness (e, -1, NILP (get_char_property |
| 6968 (prev_bytexpos (object, start), | |
| 6969 Qend_closed, object, | |
| 428 | 6970 EXTENT_AT_AFTER, 1))); |
| 6971 set_extent_openness (copy_extent (e, end, e_end, extent_object (e)), | |
| 826 | 6972 !NILP (get_char_property |
| 428 | 6973 (end, Qstart_open, object, |
| 6974 EXTENT_AT_AFTER, 1)), -1); | |
| 6975 closure->changed_p = 1; | |
| 6976 } | |
| 6977 | |
| 6978 return 0; /* to continue mapping. */ | |
| 6979 } | |
| 6980 | |
| 6981 static int | |
| 6982 put_text_prop_openness_mapper (EXTENT e, void *arg) | |
| 6983 { | |
| 6984 struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; | |
| 826 | 6985 Bytexpos e_start, e_end; |
| 6986 Bytexpos start = closure->start; | |
| 6987 Bytexpos end = closure->end; | |
| 793 | 6988 Lisp_Object extent = wrap_extent (e); |
| 6989 | |
| 826 | 6990 e_start = extent_endpoint_byte (e, 0); |
| 6991 e_end = extent_endpoint_byte (e, 1); | |
| 428 | 6992 |
| 6993 if (NILP (Fextent_property (extent, Qtext_prop, Qnil))) | |
| 6994 { | |
| 6995 /* It's not a text-property extent; do nothing. */ | |
| 6996 ; | |
| 6997 } | |
| 6998 /* Note end conditions and NILP/!NILP's carefully. */ | |
| 6999 else if (EQ (closure->prop, Qstart_open) | |
| 7000 && e_start >= start && e_start < end) | |
| 7001 set_extent_openness (e, !NILP (closure->value), -1); | |
| 7002 else if (EQ (closure->prop, Qend_closed) | |
| 7003 && e_end > start && e_end <= end) | |
| 7004 set_extent_openness (e, -1, NILP (closure->value)); | |
| 7005 | |
| 7006 return 0; /* to continue mapping. */ | |
| 7007 } | |
| 7008 | |
| 7009 static int | |
| 826 | 7010 put_text_prop (Bytexpos start, Bytexpos end, Lisp_Object object, |
| 428 | 7011 Lisp_Object prop, Lisp_Object value, |
| 7012 int duplicable_p) | |
| 7013 { | |
| 7014 /* This function can GC */ | |
| 7015 struct put_text_prop_arg closure; | |
| 7016 | |
| 7017 if (start == end) /* There are no characters in the region. */ | |
| 7018 return 0; | |
| 7019 | |
| 7020 /* convert to the non-default versions, since a nil property is | |
| 7021 the same as it not being present. */ | |
| 7022 if (EQ (prop, Qstart_closed)) | |
| 7023 { | |
| 7024 prop = Qstart_open; | |
| 7025 value = NILP (value) ? Qt : Qnil; | |
| 7026 } | |
| 7027 else if (EQ (prop, Qend_open)) | |
| 7028 { | |
| 7029 prop = Qend_closed; | |
| 7030 value = NILP (value) ? Qt : Qnil; | |
| 7031 } | |
| 7032 | |
| 7033 value = canonicalize_extent_property (prop, value); | |
| 7034 | |
| 7035 closure.prop = prop; | |
| 7036 closure.value = value; | |
| 7037 closure.start = start; | |
| 7038 closure.end = end; | |
| 7039 closure.object = object; | |
| 7040 closure.changed_p = 0; | |
| 7041 closure.the_extent = Qnil; | |
| 7042 | |
| 826 | 7043 map_extents (start, end, |
| 7044 put_text_prop_mapper, | |
| 7045 (void *) &closure, object, 0, | |
| 7046 /* get all extents that abut the region */ | |
| 7047 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | | |
| 7048 #if 0 | |
| 7049 /* it might move the SOE because the callback function calls | |
| 7050 get_char_property(), which calls extent_at(), which calls | |
| 7051 map_extents() | |
| 7052 | |
| 7053 #### this was comment out before, and nothing seemed broken; | |
| 7054 #### but when I added the above comment and uncommented it, | |
| 7055 #### text property operations (e.g. font-lock) suddenly | |
| 7056 #### became *WAY* slow, and dominated font-lock, when a | |
| 7057 #### single extent spanning the entire buffer | |
| 7058 #### existed. --ben */ | |
| 7059 ME_MIGHT_MOVE_SOE | | |
| 7060 #endif | |
| 7061 /* it might QUIT or error if the user has | |
| 7062 fucked with the extent plist. */ | |
| 7063 ME_MIGHT_THROW | | |
| 7064 ME_MIGHT_MODIFY_EXTENTS); | |
| 428 | 7065 |
| 7066 /* If we made it through the loop without reusing an extent | |
| 7067 (and we want there to be one) make it now. | |
| 7068 */ | |
| 7069 if (!NILP (value) && NILP (closure.the_extent)) | |
| 7070 { | |
| 826 | 7071 Lisp_Object extent = |
| 7072 wrap_extent (make_extent (object, start, end)); | |
| 793 | 7073 |
| 428 | 7074 closure.changed_p = 1; |
| 7075 Fset_extent_property (extent, Qtext_prop, prop); | |
| 7076 Fset_extent_property (extent, prop, value); | |
| 7077 if (duplicable_p) | |
| 7078 { | |
| 7079 extent_duplicable_p (XEXTENT (extent)) = 1; | |
| 7080 Fset_extent_property (extent, Qpaste_function, | |
| 7081 Qtext_prop_extent_paste_function); | |
| 7082 } | |
| 7083 set_extent_openness (XEXTENT (extent), | |
| 826 | 7084 !NILP (get_char_property |
| 428 | 7085 (start, Qstart_open, object, |
| 7086 EXTENT_AT_AFTER, 1)), | |
| 826 | 7087 NILP (get_char_property |
| 7088 (prev_bytexpos (object, end), | |
| 7089 Qend_closed, object, | |
| 428 | 7090 EXTENT_AT_AFTER, 1))); |
| 7091 } | |
| 7092 | |
| 7093 if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed)) | |
| 7094 { | |
| 826 | 7095 map_extents (start, end, put_text_prop_openness_mapper, |
| 7096 (void *) &closure, object, 0, | |
| 7097 /* get all extents that abut the region */ | |
| 7098 ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | | |
| 7099 ME_MIGHT_MODIFY_EXTENTS); | |
| 428 | 7100 } |
| 7101 | |
| 7102 return closure.changed_p; | |
| 7103 } | |
| 7104 | |
| 7105 DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /* | |
| 7106 Adds the given property/value to all characters in the specified region. | |
| 7107 The property is conceptually attached to the characters rather than the | |
| 7108 region. The properties are copied when the characters are copied/pasted. | |
| 7109 Fifth argument OBJECT is the buffer or string containing the text, and | |
| 7110 defaults to the current buffer. | |
| 7111 */ | |
| 7112 (start, end, prop, value, object)) | |
| 7113 { | |
| 7114 /* This function can GC */ | |
| 826 | 7115 Bytexpos s, e; |
| 428 | 7116 |
| 7117 object = decode_buffer_or_string (object); | |
| 7118 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7119 put_text_prop (s, e, object, prop, value, 1); | |
| 7120 return prop; | |
| 7121 } | |
| 7122 | |
| 7123 DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property, | |
| 7124 4, 5, 0, /* | |
| 7125 Adds the given property/value to all characters in the specified region. | |
| 7126 The property is conceptually attached to the characters rather than the | |
| 7127 region, however the properties will not be copied when the characters | |
| 7128 are copied. | |
| 7129 Fifth argument OBJECT is the buffer or string containing the text, and | |
| 7130 defaults to the current buffer. | |
| 7131 */ | |
| 7132 (start, end, prop, value, object)) | |
| 7133 { | |
| 7134 /* This function can GC */ | |
| 826 | 7135 Bytexpos s, e; |
| 428 | 7136 |
| 7137 object = decode_buffer_or_string (object); | |
| 7138 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7139 put_text_prop (s, e, object, prop, value, 0); | |
| 7140 return prop; | |
| 7141 } | |
| 7142 | |
| 7143 DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /* | |
| 7144 Add properties to the characters from START to END. | |
| 7145 The third argument PROPS is a property list specifying the property values | |
| 7146 to add. The optional fourth argument, OBJECT, is the buffer or string | |
| 7147 containing the text and defaults to the current buffer. Returns t if | |
| 7148 any property was changed, nil otherwise. | |
| 7149 */ | |
| 7150 (start, end, props, object)) | |
| 7151 { | |
| 7152 /* This function can GC */ | |
| 7153 int changed = 0; | |
| 826 | 7154 Bytexpos s, e; |
| 428 | 7155 |
| 7156 object = decode_buffer_or_string (object); | |
| 7157 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7158 CHECK_LIST (props); | |
| 7159 for (; !NILP (props); props = Fcdr (Fcdr (props))) | |
| 7160 { | |
| 7161 Lisp_Object prop = XCAR (props); | |
| 7162 Lisp_Object value = Fcar (XCDR (props)); | |
| 7163 changed |= put_text_prop (s, e, object, prop, value, 1); | |
| 7164 } | |
| 7165 return changed ? Qt : Qnil; | |
| 7166 } | |
| 7167 | |
| 7168 | |
| 7169 DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties, | |
| 7170 3, 4, 0, /* | |
| 7171 Add nonduplicable properties to the characters from START to END. | |
| 7172 \(The properties will not be copied when the characters are copied.) | |
| 7173 The third argument PROPS is a property list specifying the property values | |
| 7174 to add. The optional fourth argument, OBJECT, is the buffer or string | |
| 7175 containing the text and defaults to the current buffer. Returns t if | |
| 7176 any property was changed, nil otherwise. | |
| 7177 */ | |
| 7178 (start, end, props, object)) | |
| 7179 { | |
| 7180 /* This function can GC */ | |
| 7181 int changed = 0; | |
| 826 | 7182 Bytexpos s, e; |
| 428 | 7183 |
| 7184 object = decode_buffer_or_string (object); | |
| 7185 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7186 CHECK_LIST (props); | |
| 7187 for (; !NILP (props); props = Fcdr (Fcdr (props))) | |
| 7188 { | |
| 7189 Lisp_Object prop = XCAR (props); | |
| 7190 Lisp_Object value = Fcar (XCDR (props)); | |
| 7191 changed |= put_text_prop (s, e, object, prop, value, 0); | |
| 7192 } | |
| 7193 return changed ? Qt : Qnil; | |
| 7194 } | |
| 7195 | |
| 7196 DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /* | |
| 7197 Remove the given properties from all characters in the specified region. | |
| 7198 PROPS should be a plist, but the values in that plist are ignored (treated | |
| 7199 as nil). Returns t if any property was changed, nil otherwise. | |
| 7200 Fourth argument OBJECT is the buffer or string containing the text, and | |
| 7201 defaults to the current buffer. | |
| 7202 */ | |
| 7203 (start, end, props, object)) | |
| 7204 { | |
| 7205 /* This function can GC */ | |
| 7206 int changed = 0; | |
| 826 | 7207 Bytexpos s, e; |
| 428 | 7208 |
| 7209 object = decode_buffer_or_string (object); | |
| 7210 get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); | |
| 7211 CHECK_LIST (props); | |
| 7212 for (; !NILP (props); props = Fcdr (Fcdr (props))) | |
| 7213 { | |
| 7214 Lisp_Object prop = XCAR (props); | |
| 7215 changed |= put_text_prop (s, e, object, prop, Qnil, 1); | |
| 7216 } | |
| 7217 return changed ? Qt : Qnil; | |
| 7218 } | |
| 7219 | |
| 7220 /* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert' | |
| 7221 or whatever) we attach the properties to the buffer by calling | |
| 7222 `put-text-property' instead of by simply allowing the extent to be copied or | |
| 7223 re-attached. Then we return nil, telling the extents code not to attach it | |
| 7224 again. By handing the insertion hackery in this way, we make kill/yank | |
| 7225 behave consistently with put-text-property and not fragment the extents | |
| 7226 (since text-prop extents must partition, not overlap). | |
| 7227 | |
| 7228 The lisp implementation of this was probably fast enough, but since I moved | |
| 7229 the rest of the put-text-prop code here, I moved this as well for | |
| 7230 completeness. | |
| 7231 */ | |
| 7232 DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function, | |
| 7233 3, 3, 0, /* | |
| 7234 Used as the `paste-function' property of `text-prop' extents. | |
| 7235 */ | |
| 7236 (extent, from, to)) | |
| 7237 { | |
| 7238 /* This function can GC */ | |
| 7239 Lisp_Object prop, val; | |
| 7240 | |
| 7241 prop = Fextent_property (extent, Qtext_prop, Qnil); | |
| 7242 if (NILP (prop)) | |
| 563 | 7243 signal_error (Qinternal_error, |
| 442 | 7244 "Internal error: no text-prop", extent); |
| 428 | 7245 val = Fextent_property (extent, prop, Qnil); |
| 7246 #if 0 | |
| 7247 /* removed by bill perry, 2/9/97 | |
| 7248 ** This little bit of code would not allow you to have a text property | |
| 7249 ** with a value of Qnil. This is bad bad bad. | |
| 7250 */ | |
| 7251 if (NILP (val)) | |
| 563 | 7252 signal_error_2 (Qinternal_error, |
| 442 | 7253 "Internal error: no text-prop", |
| 7254 extent, prop); | |
| 428 | 7255 #endif |
| 7256 Fput_text_property (from, to, prop, val, Qnil); | |
| 7257 return Qnil; /* important! */ | |
| 7258 } | |
| 7259 | |
| 826 | 7260 Bytexpos |
| 2506 | 7261 next_previous_single_property_change (Bytexpos pos, Lisp_Object prop, |
| 7262 Lisp_Object object, Bytexpos limit, | |
| 7263 Boolint next, Boolint text_props_only) | |
| 826 | 7264 { |
| 7265 Lisp_Object extent, value; | |
| 7266 int limit_was_nil; | |
| 2506 | 7267 enum extent_at_flag at_flag = next ? EXTENT_AT_AFTER : EXTENT_AT_BEFORE; |
| 826 | 7268 if (limit < 0) |
| 7269 { | |
| 2506 | 7270 limit = (next ? buffer_or_string_accessible_end_byte : |
| 7271 buffer_or_string_accessible_begin_byte) (object); | |
| 826 | 7272 limit_was_nil = 1; |
| 7273 } | |
| 7274 else | |
| 7275 limit_was_nil = 0; | |
| 7276 | |
| 2506 | 7277 /* Retrieve initial property value to compare against */ |
| 7278 extent = extent_at (pos, object, prop, 0, at_flag, 0); | |
| 7279 /* If we only want text-prop extents, ignore all others */ | |
| 7280 if (text_props_only && !NILP (extent) && | |
| 7281 NILP (Fextent_property (extent, Qtext_prop, Qnil))) | |
| 7282 extent = Qnil; | |
| 826 | 7283 if (!NILP (extent)) |
| 7284 value = Fextent_property (extent, prop, Qnil); | |
| 7285 else | |
| 7286 value = Qnil; | |
| 7287 | |
| 7288 while (1) | |
| 7289 { | |
| 2506 | 7290 pos = (next ? extent_find_end_of_run : extent_find_beginning_of_run) |
| 7291 (object, pos, 1); | |
| 7292 if (next ? pos >= limit : pos <= limit) | |
| 7293 break; /* property is the same all the way to the beginning/end */ | |
| 7294 extent = extent_at (pos, object, prop, 0, at_flag, 0); | |
| 7295 /* If we only want text-prop extents, ignore all others */ | |
| 7296 if (text_props_only && !NILP (extent) && | |
| 7297 NILP (Fextent_property (extent, Qtext_prop, Qnil))) | |
| 7298 extent = Qnil; | |
| 826 | 7299 if ((NILP (extent) && !NILP (value)) || |
| 7300 (!NILP (extent) && !EQ (value, | |
| 7301 Fextent_property (extent, prop, Qnil)))) | |
| 7302 return pos; | |
| 7303 } | |
| 7304 | |
| 7305 if (limit_was_nil) | |
| 7306 return -1; | |
| 7307 else | |
| 7308 return limit; | |
| 7309 } | |
| 7310 | |
| 2506 | 7311 static Lisp_Object |
| 7312 next_previous_single_property_change_fn (Lisp_Object pos, Lisp_Object prop, | |
| 7313 Lisp_Object object, Lisp_Object limit, | |
| 7314 Boolint next, Boolint text_props_only) | |
| 7315 { | |
| 7316 Bytexpos xpos; | |
| 7317 Bytexpos blim; | |
| 7318 | |
| 7319 object = decode_buffer_or_string (object); | |
| 7320 xpos = get_buffer_or_string_pos_byte (object, pos, 0); | |
| 7321 blim = !NILP (limit) ? get_buffer_or_string_pos_byte (object, limit, 0) : -1; | |
| 7322 blim = next_previous_single_property_change (xpos, prop, object, blim, | |
| 7323 next, text_props_only); | |
| 7324 | |
| 7325 if (blim < 0) | |
| 7326 return Qnil; | |
| 826 | 7327 else |
| 2506 | 7328 return make_int (buffer_or_string_bytexpos_to_charxpos (object, blim)); |
| 826 | 7329 } |
| 428 | 7330 |
| 7331 DEFUN ("next-single-property-change", Fnext_single_property_change, | |
| 7332 2, 4, 0, /* | |
| 7333 Return the position of next property change for a specific property. | |
| 7334 Scans characters forward from POS till it finds a change in the PROP | |
| 7335 property, then returns the position of the change. The optional third | |
| 7336 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7337 buffer). | |
| 7338 The property values are compared with `eq'. | |
| 444 | 7339 Return nil if the property is constant all the way to the end of OBJECT. |
| 428 | 7340 If the value is non-nil, it is a position greater than POS, never equal. |
| 7341 | |
| 7342 If the optional fourth argument LIMIT is non-nil, don't search | |
| 7343 past position LIMIT; return LIMIT if nothing is found before LIMIT. | |
| 7344 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7345 a particular character, it is undefined which value is considered to be | |
| 7346 the value of PROP. (Note that this situation will not happen if you always | |
| 7347 use the text-property primitives.) | |
| 2506 | 7348 |
| 7349 This function looks only at extents created using the text-property primitives. | |
| 7350 To look at all extents, use `next-single-char-property-change'. | |
| 428 | 7351 */ |
| 7352 (pos, prop, object, limit)) | |
| 7353 { | |
| 2506 | 7354 return next_previous_single_property_change_fn (pos, prop, object, limit, |
| 7355 1, 1); | |
| 826 | 7356 } |
| 428 | 7357 |
| 7358 DEFUN ("previous-single-property-change", Fprevious_single_property_change, | |
| 7359 2, 4, 0, /* | |
| 7360 Return the position of next property change for a specific property. | |
| 7361 Scans characters backward from POS till it finds a change in the PROP | |
| 7362 property, then returns the position of the change. The optional third | |
| 7363 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7364 buffer). | |
| 7365 The property values are compared with `eq'. | |
| 444 | 7366 Return nil if the property is constant all the way to the start of OBJECT. |
| 428 | 7367 If the value is non-nil, it is a position less than POS, never equal. |
| 7368 | |
| 7369 If the optional fourth argument LIMIT is non-nil, don't search back | |
| 7370 past position LIMIT; return LIMIT if nothing is found until LIMIT. | |
| 7371 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7372 a particular character, it is undefined which value is considered to be | |
| 7373 the value of PROP. (Note that this situation will not happen if you always | |
| 7374 use the text-property primitives.) | |
| 2506 | 7375 |
| 7376 This function looks only at extents created using the text-property primitives. | |
| 7377 To look at all extents, use `next-single-char-property-change'. | |
| 7378 */ | |
| 7379 (pos, prop, object, limit)) | |
| 7380 { | |
| 7381 return next_previous_single_property_change_fn (pos, prop, object, limit, | |
| 7382 0, 1); | |
| 7383 } | |
| 7384 | |
| 7385 DEFUN ("next-single-char-property-change", Fnext_single_char_property_change, | |
| 7386 2, 4, 0, /* | |
| 7387 Return the position of next property change for a specific property. | |
| 7388 Scans characters forward from POS till it finds a change in the PROP | |
| 7389 property, then returns the position of the change. The optional third | |
| 7390 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7391 buffer). | |
| 7392 The property values are compared with `eq'. | |
| 7393 Return nil if the property is constant all the way to the end of OBJECT. | |
| 7394 If the value is non-nil, it is a position greater than POS, never equal. | |
| 7395 | |
| 7396 If the optional fourth argument LIMIT is non-nil, don't search | |
| 7397 past position LIMIT; return LIMIT if nothing is found before LIMIT. | |
| 7398 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7399 a particular character, it is undefined which value is considered to be | |
| 7400 the value of PROP. (Note that this situation will not happen if you always | |
| 7401 use the text-property primitives.) | |
| 7402 | |
| 7403 This function looks at all extents. To look at only extents created using the | |
| 7404 text-property primitives, use `next-single-char-property-change'. | |
| 428 | 7405 */ |
| 7406 (pos, prop, object, limit)) | |
| 7407 { | |
| 2506 | 7408 return next_previous_single_property_change_fn (pos, prop, object, limit, |
| 7409 1, 0); | |
| 7410 } | |
| 7411 | |
| 7412 DEFUN ("previous-single-char-property-change", | |
| 7413 Fprevious_single_char_property_change, | |
| 7414 2, 4, 0, /* | |
| 7415 Return the position of next property change for a specific property. | |
| 7416 Scans characters backward from POS till it finds a change in the PROP | |
| 7417 property, then returns the position of the change. The optional third | |
| 7418 argument OBJECT is the buffer or string to scan (defaults to the current | |
| 7419 buffer). | |
| 7420 The property values are compared with `eq'. | |
| 7421 Return nil if the property is constant all the way to the start of OBJECT. | |
| 7422 If the value is non-nil, it is a position less than POS, never equal. | |
| 7423 | |
| 7424 If the optional fourth argument LIMIT is non-nil, don't search back | |
| 7425 past position LIMIT; return LIMIT if nothing is found until LIMIT. | |
| 7426 If two or more extents with conflicting non-nil values for PROP overlap | |
| 7427 a particular character, it is undefined which value is considered to be | |
| 7428 the value of PROP. (Note that this situation will not happen if you always | |
| 7429 use the text-property primitives.) | |
| 7430 | |
| 7431 This function looks at all extents. To look at only extents created using the | |
| 7432 text-property primitives, use `next-single-char-property-change'. | |
| 7433 */ | |
| 7434 (pos, prop, object, limit)) | |
| 7435 { | |
| 7436 return next_previous_single_property_change_fn (pos, prop, object, limit, | |
| 7437 0, 0); | |
| 428 | 7438 } |
| 7439 | |
| 7440 #ifdef MEMORY_USAGE_STATS | |
| 7441 | |
| 7442 int | |
| 2286 | 7443 compute_buffer_extent_usage (struct buffer *UNUSED (b), |
| 7444 struct overhead_stats *UNUSED (ovstats)) | |
| 428 | 7445 { |
| 7446 /* #### not yet written */ | |
| 7447 return 0; | |
| 7448 } | |
| 7449 | |
| 7450 #endif /* MEMORY_USAGE_STATS */ | |
| 7451 | |
| 7452 | |
| 7453 /************************************************************************/ | |
| 7454 /* initialization */ | |
| 7455 /************************************************************************/ | |
| 7456 | |
| 7457 void | |
| 7458 syms_of_extents (void) | |
| 7459 { | |
| 442 | 7460 INIT_LRECORD_IMPLEMENTATION (extent); |
| 7461 INIT_LRECORD_IMPLEMENTATION (extent_info); | |
| 7462 INIT_LRECORD_IMPLEMENTATION (extent_auxiliary); | |
| 3092 | 7463 #ifdef NEW_GC |
| 7464 INIT_LRECORD_IMPLEMENTATION (gap_array_marker); | |
| 7465 INIT_LRECORD_IMPLEMENTATION (gap_array); | |
| 7466 INIT_LRECORD_IMPLEMENTATION (extent_list_marker); | |
| 7467 INIT_LRECORD_IMPLEMENTATION (extent_list); | |
| 7468 INIT_LRECORD_IMPLEMENTATION (stack_of_extents); | |
| 3263 | 7469 #endif /* NEW_GC */ |
| 442 | 7470 |
| 563 | 7471 DEFSYMBOL (Qextentp); |
| 7472 DEFSYMBOL (Qextent_live_p); | |
| 7473 | |
| 7474 DEFSYMBOL (Qall_extents_closed); | |
| 7475 DEFSYMBOL (Qall_extents_open); | |
| 7476 DEFSYMBOL (Qall_extents_closed_open); | |
| 7477 DEFSYMBOL (Qall_extents_open_closed); | |
| 7478 DEFSYMBOL (Qstart_in_region); | |
| 7479 DEFSYMBOL (Qend_in_region); | |
| 7480 DEFSYMBOL (Qstart_and_end_in_region); | |
| 7481 DEFSYMBOL (Qstart_or_end_in_region); | |
| 7482 DEFSYMBOL (Qnegate_in_region); | |
| 7483 | |
| 7484 DEFSYMBOL (Qdetached); | |
| 7485 DEFSYMBOL (Qdestroyed); | |
| 7486 DEFSYMBOL (Qbegin_glyph); | |
| 7487 DEFSYMBOL (Qend_glyph); | |
| 7488 DEFSYMBOL (Qstart_open); | |
| 7489 DEFSYMBOL (Qend_open); | |
| 7490 DEFSYMBOL (Qstart_closed); | |
| 7491 DEFSYMBOL (Qend_closed); | |
| 7492 DEFSYMBOL (Qread_only); | |
| 7493 /* DEFSYMBOL (Qhighlight); in faces.c */ | |
| 7494 DEFSYMBOL (Qunique); | |
| 7495 DEFSYMBOL (Qduplicable); | |
| 7496 DEFSYMBOL (Qdetachable); | |
| 7497 DEFSYMBOL (Qpriority); | |
| 7498 DEFSYMBOL (Qmouse_face); | |
| 7499 DEFSYMBOL (Qinitial_redisplay_function); | |
| 7500 | |
| 7501 | |
| 7502 DEFSYMBOL (Qglyph_layout); /* backwards compatibility */ | |
| 7503 DEFSYMBOL (Qbegin_glyph_layout); | |
| 7504 DEFSYMBOL (Qend_glyph_layout); | |
| 7505 DEFSYMBOL (Qoutside_margin); | |
| 7506 DEFSYMBOL (Qinside_margin); | |
| 7507 DEFSYMBOL (Qwhitespace); | |
| 428 | 7508 /* Qtext defined in general.c */ |
| 7509 | |
| 563 | 7510 DEFSYMBOL (Qpaste_function); |
| 7511 DEFSYMBOL (Qcopy_function); | |
| 7512 | |
| 7513 DEFSYMBOL (Qtext_prop); | |
| 7514 DEFSYMBOL (Qtext_prop_extent_paste_function); | |
| 428 | 7515 |
| 7516 DEFSUBR (Fextentp); | |
| 7517 DEFSUBR (Fextent_live_p); | |
| 7518 DEFSUBR (Fextent_detached_p); | |
| 7519 DEFSUBR (Fextent_start_position); | |
| 7520 DEFSUBR (Fextent_end_position); | |
| 7521 DEFSUBR (Fextent_object); | |
| 7522 DEFSUBR (Fextent_length); | |
| 7523 | |
| 7524 DEFSUBR (Fmake_extent); | |
| 7525 DEFSUBR (Fcopy_extent); | |
| 7526 DEFSUBR (Fdelete_extent); | |
| 7527 DEFSUBR (Fdetach_extent); | |
| 7528 DEFSUBR (Fset_extent_endpoints); | |
| 7529 DEFSUBR (Fnext_extent); | |
| 7530 DEFSUBR (Fprevious_extent); | |
| 1204 | 7531 #ifdef DEBUG_XEMACS |
| 428 | 7532 DEFSUBR (Fnext_e_extent); |
| 7533 DEFSUBR (Fprevious_e_extent); | |
| 7534 #endif | |
| 7535 DEFSUBR (Fnext_extent_change); | |
| 7536 DEFSUBR (Fprevious_extent_change); | |
| 7537 | |
| 7538 DEFSUBR (Fextent_parent); | |
| 7539 DEFSUBR (Fextent_children); | |
| 7540 DEFSUBR (Fset_extent_parent); | |
| 7541 | |
| 7542 DEFSUBR (Fextent_in_region_p); | |
| 7543 DEFSUBR (Fmap_extents); | |
| 7544 DEFSUBR (Fmap_extent_children); | |
| 7545 DEFSUBR (Fextent_at); | |
| 442 | 7546 DEFSUBR (Fextents_at); |
| 428 | 7547 |
| 7548 DEFSUBR (Fset_extent_initial_redisplay_function); | |
| 7549 DEFSUBR (Fextent_face); | |
| 7550 DEFSUBR (Fset_extent_face); | |
| 7551 DEFSUBR (Fextent_mouse_face); | |
| 7552 DEFSUBR (Fset_extent_mouse_face); | |
| 7553 DEFSUBR (Fset_extent_begin_glyph); | |
| 7554 DEFSUBR (Fset_extent_end_glyph); | |
| 7555 DEFSUBR (Fextent_begin_glyph); | |
| 7556 DEFSUBR (Fextent_end_glyph); | |
| 7557 DEFSUBR (Fset_extent_begin_glyph_layout); | |
| 7558 DEFSUBR (Fset_extent_end_glyph_layout); | |
| 7559 DEFSUBR (Fextent_begin_glyph_layout); | |
| 7560 DEFSUBR (Fextent_end_glyph_layout); | |
| 7561 DEFSUBR (Fset_extent_priority); | |
| 7562 DEFSUBR (Fextent_priority); | |
| 7563 DEFSUBR (Fset_extent_property); | |
| 7564 DEFSUBR (Fset_extent_properties); | |
| 7565 DEFSUBR (Fextent_property); | |
| 7566 DEFSUBR (Fextent_properties); | |
| 7567 | |
| 7568 DEFSUBR (Fhighlight_extent); | |
| 7569 DEFSUBR (Fforce_highlight_extent); | |
| 7570 | |
| 7571 DEFSUBR (Finsert_extent); | |
| 7572 | |
| 7573 DEFSUBR (Fget_text_property); | |
| 7574 DEFSUBR (Fget_char_property); | |
| 7575 DEFSUBR (Fput_text_property); | |
| 7576 DEFSUBR (Fput_nonduplicable_text_property); | |
| 7577 DEFSUBR (Fadd_text_properties); | |
| 7578 DEFSUBR (Fadd_nonduplicable_text_properties); | |
| 7579 DEFSUBR (Fremove_text_properties); | |
| 7580 DEFSUBR (Ftext_prop_extent_paste_function); | |
| 7581 DEFSUBR (Fnext_single_property_change); | |
| 7582 DEFSUBR (Fprevious_single_property_change); | |
| 2506 | 7583 DEFSUBR (Fnext_single_char_property_change); |
| 7584 DEFSUBR (Fprevious_single_char_property_change); | |
| 428 | 7585 } |
| 7586 | |
| 7587 void | |
| 7588 reinit_vars_of_extents (void) | |
| 7589 { | |
| 7590 extent_auxiliary_defaults.begin_glyph = Qnil; | |
| 7591 extent_auxiliary_defaults.end_glyph = Qnil; | |
| 7592 extent_auxiliary_defaults.parent = Qnil; | |
| 7593 extent_auxiliary_defaults.children = Qnil; | |
| 7594 extent_auxiliary_defaults.priority = 0; | |
| 7595 extent_auxiliary_defaults.invisible = Qnil; | |
| 7596 extent_auxiliary_defaults.read_only = Qnil; | |
| 7597 extent_auxiliary_defaults.mouse_face = Qnil; | |
| 7598 extent_auxiliary_defaults.initial_redisplay_function = Qnil; | |
| 7599 extent_auxiliary_defaults.before_change_functions = Qnil; | |
| 7600 extent_auxiliary_defaults.after_change_functions = Qnil; | |
| 7601 } | |
| 7602 | |
| 7603 void | |
| 7604 vars_of_extents (void) | |
| 7605 { | |
| 7606 DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /* | |
| 7607 The priority to use for the mouse-highlighting pseudo-extent | |
| 7608 that is used to highlight extents with the `mouse-face' attribute set. | |
| 7609 See `set-extent-priority'. | |
| 7610 */ ); | |
| 7611 /* Set mouse-highlight-priority (which ends up being used both for the | |
| 7612 mouse-highlighting pseudo-extent and the primary selection extent) | |
| 7613 to a very high value because very few extents should override it. | |
| 7614 1000 gives lots of room below it for different-prioritized extents. | |
| 7615 10 doesn't. ediff, for example, likes to use priorities around 100. | |
| 7616 --ben */ | |
| 7617 mouse_highlight_priority = /* 10 */ 1000; | |
| 7618 | |
| 7619 DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /* | |
| 7620 Property list giving default values for text properties. | |
| 7621 Whenever a character does not specify a value for a property, the value | |
| 7622 stored in this list is used instead. This only applies when the | |
| 7623 functions `get-text-property' or `get-char-property' are called. | |
| 7624 */ ); | |
| 7625 Vdefault_text_properties = Qnil; | |
| 7626 | |
| 7627 staticpro (&Vlast_highlighted_extent); | |
| 7628 Vlast_highlighted_extent = Qnil; | |
| 7629 | |
| 7630 Vextent_face_reusable_list = Fcons (Qnil, Qnil); | |
| 7631 staticpro (&Vextent_face_reusable_list); | |
| 771 | 7632 |
| 428 | 7633 staticpro (&Vextent_face_memoize_hash_table); |
| 7634 /* The memoize hash table maps from lists of symbols to lists of | |
| 7635 faces. It needs to be `equal' to implement the memoization. | |
| 7636 The reverse table maps in the other direction and just needs | |
| 7637 to do `eq' comparison because the lists of faces are already | |
| 7638 memoized. */ | |
| 7639 Vextent_face_memoize_hash_table = | |
| 7640 make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); | |
| 7641 staticpro (&Vextent_face_reverse_memoize_hash_table); | |
| 7642 Vextent_face_reverse_memoize_hash_table = | |
| 7643 make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); | |
| 1292 | 7644 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
7645 QSin_map_extents_internal = build_defer_string ("(in map-extents-internal)"); |
| 1292 | 7646 staticpro (&QSin_map_extents_internal); |
| 7647 } |