Mercurial > hg > xemacs-beta
annotate src/marker.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 | d674024a8674 |
| children | e813cf16c015 |
| rev | line source |
|---|---|
| 428 | 1 /* Markers: examining, setting and killing. |
| 2 Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. | |
| 800 | 3 Copyright (C) 2002 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: FSF 19.30. */ | |
| 23 | |
| 24 /* This file has been Mule-ized. */ | |
| 25 | |
| 26 /* Note that markers are currently kept in an unordered list. | |
| 27 This means that marker operations may be inefficient if | |
| 28 there are a bunch of markers in the buffer. This probably | |
| 29 won't have a significant impact on redisplay (which uses | |
| 30 markers), but if it does, it wouldn't be too hard to change | |
| 31 to an ordered gap array. (Just copy the code from extents.c.) | |
| 32 */ | |
| 33 | |
| 34 #include <config.h> | |
| 35 #include "lisp.h" | |
| 36 | |
| 37 #include "buffer.h" | |
| 38 | |
| 39 static Lisp_Object | |
| 40 mark_marker (Lisp_Object obj) | |
| 41 { | |
| 440 | 42 Lisp_Marker *marker = XMARKER (obj); |
| 428 | 43 Lisp_Object buf; |
| 44 /* DO NOT mark through the marker's chain. | |
| 45 The buffer's markers chain does not preserve markers from gc; | |
| 46 Instead, markers are removed from the chain when they are freed | |
| 47 by gc. | |
| 48 */ | |
| 49 if (!marker->buffer) | |
| 50 return (Qnil); | |
| 51 | |
| 793 | 52 buf = wrap_buffer (marker->buffer); |
| 428 | 53 return (buf); |
| 54 } | |
| 55 | |
| 56 static void | |
| 2286 | 57 print_marker (Lisp_Object obj, Lisp_Object printcharfun, |
| 58 int UNUSED (escapeflag)) | |
| 428 | 59 { |
| 440 | 60 Lisp_Marker *marker = XMARKER (obj); |
| 428 | 61 |
| 62 if (print_readably) | |
| 563 | 63 printing_unreadable_object ("#<marker 0x%lx>", (long) marker); |
| 428 | 64 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
65 write_ascstring (printcharfun, GETTEXT ("#<marker ")); |
| 428 | 66 if (!marker->buffer) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
67 write_ascstring (printcharfun, GETTEXT ("in no buffer")); |
| 428 | 68 else |
| 69 { | |
| 826 | 70 write_fmt_string (printcharfun, "at %ld in ", |
| 71 (long) marker_position (obj)); | |
| 428 | 72 print_internal (marker->buffer->name, printcharfun, 0); |
| 73 } | |
| 826 | 74 if (marker->insertion_type) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
75 write_ascstring (printcharfun, " insertion-type=t"); |
| 800 | 76 write_fmt_string (printcharfun, " 0x%lx>", (long) marker); |
| 428 | 77 } |
| 78 | |
| 79 static int | |
| 2286 | 80 marker_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) |
| 428 | 81 { |
| 440 | 82 Lisp_Marker *marker1 = XMARKER (obj1); |
| 83 Lisp_Marker *marker2 = XMARKER (obj2); | |
| 428 | 84 |
| 85 return ((marker1->buffer == marker2->buffer) && | |
| 665 | 86 (marker1->membpos == marker2->membpos || |
| 428 | 87 /* All markers pointing nowhere are equal */ |
| 88 !marker1->buffer)); | |
| 89 } | |
| 90 | |
| 2515 | 91 static Hashcode |
| 2286 | 92 marker_hash (Lisp_Object obj, int UNUSED (depth)) |
| 428 | 93 { |
| 2515 | 94 Hashcode hash = (Hashcode) XMARKER (obj)->buffer; |
| 428 | 95 if (hash) |
| 665 | 96 hash = HASH2 (hash, XMARKER (obj)->membpos); |
| 428 | 97 return hash; |
| 98 } | |
| 99 | |
| 1204 | 100 static const struct memory_description marker_description[] = { |
| 2551 | 101 { XD_LISP_OBJECT, offsetof (Lisp_Marker, next), 0, { 0 }, XD_FLAG_NO_KKCC }, |
| 102 { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev), 0, { 0 }, XD_FLAG_NO_KKCC }, | |
| 440 | 103 { XD_LISP_OBJECT, offsetof (Lisp_Marker, buffer) }, |
| 428 | 104 { XD_END } |
| 105 }; | |
| 106 | |
| 3263 | 107 #ifdef NEW_GC |
| 2720 | 108 static void |
| 109 finalize_marker (void *header, int for_disksave) | |
| 110 { | |
| 111 if (!for_disksave) | |
| 112 { | |
| 113 Lisp_Object tem = wrap_marker (header); | |
| 114 unchain_marker (tem); | |
| 115 } | |
| 116 } | |
| 117 | |
| 118 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, | |
| 119 1, /*dumpable-flag*/ | |
| 120 mark_marker, print_marker, | |
| 121 finalize_marker, | |
| 122 marker_equal, marker_hash, | |
| 123 marker_description, Lisp_Marker); | |
| 3263 | 124 #else /* not NEW_GC */ |
| 934 | 125 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, |
| 126 1, /*dumpable-flag*/ | |
| 127 mark_marker, print_marker, 0, | |
| 1204 | 128 marker_equal, marker_hash, |
| 129 marker_description, Lisp_Marker); | |
| 3263 | 130 #endif /* not NEW_GC */ |
| 428 | 131 |
| 132 /* Operations on markers. */ | |
| 133 | |
| 134 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /* | |
| 135 Return the buffer that MARKER points into, or nil if none. | |
| 136 Return nil if MARKER points into a dead buffer or doesn't point anywhere. | |
| 137 */ | |
| 138 (marker)) | |
| 139 { | |
| 140 struct buffer *buf; | |
| 141 CHECK_MARKER (marker); | |
| 142 /* Return marker's buffer only if it is not dead. */ | |
| 143 if ((buf = XMARKER (marker)->buffer) && BUFFER_LIVE_P (buf)) | |
| 144 { | |
| 793 | 145 return wrap_buffer (buf); |
| 428 | 146 } |
| 147 return Qnil; | |
| 148 } | |
| 149 | |
| 150 DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /* | |
| 151 Return the position MARKER points at, as a character number. | |
| 152 Return `nil' if marker doesn't point anywhere. | |
| 153 */ | |
| 154 (marker)) | |
| 155 { | |
| 156 CHECK_MARKER (marker); | |
| 157 return XMARKER (marker)->buffer ? make_int (marker_position (marker)) : Qnil; | |
| 158 } | |
| 159 | |
| 160 #if 0 /* useful debugging function */ | |
| 161 | |
| 162 static void | |
| 163 check_marker_circularities (struct buffer *buf) | |
| 164 { | |
| 440 | 165 Lisp_Marker *tortoise, *hare; |
| 428 | 166 |
| 167 tortoise = BUF_MARKERS (buf); | |
| 168 hare = tortoise; | |
| 169 | |
| 170 if (!tortoise) | |
| 171 return; | |
| 172 | |
| 173 while (1) | |
| 174 { | |
| 175 assert (hare->buffer == buf); | |
| 176 hare = hare->next; | |
| 177 if (!hare) | |
| 178 return; | |
| 179 assert (hare->buffer == buf); | |
| 180 hare = hare->next; | |
| 181 if (!hare) | |
| 182 return; | |
| 183 tortoise = tortoise->next; | |
| 184 assert (tortoise != hare); | |
| 185 } | |
| 186 } | |
| 187 | |
| 188 #endif | |
| 189 | |
| 190 static Lisp_Object | |
| 444 | 191 set_marker_internal (Lisp_Object marker, Lisp_Object position, |
| 192 Lisp_Object buffer, int restricted_p) | |
| 428 | 193 { |
| 665 | 194 Charbpos charno; |
| 428 | 195 struct buffer *b; |
| 440 | 196 Lisp_Marker *m; |
| 428 | 197 int point_p; |
| 198 | |
| 199 CHECK_MARKER (marker); | |
| 200 | |
| 201 point_p = POINT_MARKER_P (marker); | |
| 202 | |
| 203 /* If position is nil or a marker that points nowhere, | |
| 204 make this marker point nowhere. */ | |
| 444 | 205 if (NILP (position) || |
| 206 (MARKERP (position) && !XMARKER (position)->buffer)) | |
| 428 | 207 { |
| 208 if (point_p) | |
| 563 | 209 invalid_operation ("Can't make point-marker point nowhere", |
| 210 marker); | |
| 428 | 211 if (XMARKER (marker)->buffer) |
| 212 unchain_marker (marker); | |
| 213 return marker; | |
| 214 } | |
| 215 | |
| 444 | 216 CHECK_INT_COERCE_MARKER (position); |
| 428 | 217 if (NILP (buffer)) |
| 218 b = current_buffer; | |
| 219 else | |
| 220 { | |
| 221 CHECK_BUFFER (buffer); | |
| 222 b = XBUFFER (buffer); | |
| 223 /* If buffer is dead, set marker to point nowhere. */ | |
| 224 if (!BUFFER_LIVE_P (XBUFFER (buffer))) | |
| 225 { | |
| 226 if (point_p) | |
| 563 | 227 invalid_operation |
| 428 | 228 ("Can't move point-marker in a killed buffer", marker); |
| 229 if (XMARKER (marker)->buffer) | |
| 230 unchain_marker (marker); | |
| 231 return marker; | |
| 232 } | |
| 233 } | |
| 234 | |
| 444 | 235 charno = XINT (position); |
| 428 | 236 m = XMARKER (marker); |
| 237 | |
| 238 if (restricted_p) | |
| 239 { | |
| 240 if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b); | |
| 241 if (charno > BUF_ZV (b)) charno = BUF_ZV (b); | |
| 242 } | |
| 243 else | |
| 244 { | |
| 245 if (charno < BUF_BEG (b)) charno = BUF_BEG (b); | |
| 246 if (charno > BUF_Z (b)) charno = BUF_Z (b); | |
| 247 } | |
| 248 | |
| 249 if (point_p) | |
| 250 { | |
| 251 #ifndef moving_point_by_moving_its_marker_is_a_bug | |
| 252 BUF_SET_PT (b, charno); /* this will move the marker */ | |
| 253 #else /* It's not a feature, so it must be a bug */ | |
| 563 | 254 invalid_operation ("DEBUG: attempt to move point via point-marker", |
| 255 marker); | |
| 428 | 256 #endif |
| 257 } | |
| 258 else | |
| 259 { | |
| 665 | 260 m->membpos = charbpos_to_membpos (b, charno); |
| 428 | 261 } |
| 262 | |
| 263 if (m->buffer != b) | |
| 264 { | |
| 265 if (point_p) | |
| 563 | 266 invalid_operation ("Can't change buffer of point-marker", marker); |
| 428 | 267 if (m->buffer != 0) |
| 268 unchain_marker (marker); | |
| 269 m->buffer = b; | |
| 270 marker_next (m) = BUF_MARKERS (b); | |
| 271 marker_prev (m) = 0; | |
| 272 if (BUF_MARKERS (b)) | |
| 273 marker_prev (BUF_MARKERS (b)) = m; | |
| 274 BUF_MARKERS (b) = m; | |
| 275 } | |
| 276 | |
| 277 return marker; | |
| 278 } | |
| 279 | |
| 280 | |
| 281 DEFUN ("set-marker", Fset_marker, 2, 3, 0, /* | |
| 444 | 282 Move MARKER to position POSITION in BUFFER. |
| 283 POSITION can be a marker, an integer or nil. If POSITION is an | |
| 284 integer, make MARKER point before the POSITIONth character in BUFFER. | |
| 285 If POSITION is nil, makes MARKER point nowhere. Then it no longer | |
| 286 slows down editing in any buffer. If POSITION is less than 1, move | |
| 287 MARKER to the beginning of BUFFER. If POSITION is greater than the | |
| 288 size of BUFFER, move MARKER to the end of BUFFER. | |
| 428 | 289 BUFFER defaults to the current buffer. |
| 444 | 290 If this marker was returned by (point-marker t), then changing its |
| 291 position moves point. You cannot change its buffer or make it point | |
| 292 nowhere. | |
| 293 The return value is MARKER. | |
| 428 | 294 */ |
| 444 | 295 (marker, position, buffer)) |
| 428 | 296 { |
| 444 | 297 return set_marker_internal (marker, position, buffer, 0); |
| 428 | 298 } |
| 299 | |
| 300 | |
| 301 /* This version of Fset_marker won't let the position | |
| 302 be outside the visible part. */ | |
| 303 Lisp_Object | |
| 444 | 304 set_marker_restricted (Lisp_Object marker, Lisp_Object position, |
| 305 Lisp_Object buffer) | |
| 428 | 306 { |
| 444 | 307 return set_marker_internal (marker, position, buffer, 1); |
| 428 | 308 } |
| 309 | |
| 310 | |
| 311 /* This is called during garbage collection, | |
| 312 so we must be careful to ignore and preserve mark bits, | |
| 313 including those in chain fields of markers. */ | |
| 314 | |
| 315 void | |
| 316 unchain_marker (Lisp_Object m) | |
| 317 { | |
| 440 | 318 Lisp_Marker *marker = XMARKER (m); |
| 428 | 319 struct buffer *b = marker->buffer; |
| 320 | |
| 321 if (b == 0) | |
| 322 return; | |
| 323 | |
| 800 | 324 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 325 assert (BUFFER_LIVE_P (b)); |
| 326 #endif | |
| 327 | |
| 328 if (marker_next (marker)) | |
| 329 marker_prev (marker_next (marker)) = marker_prev (marker); | |
| 330 if (marker_prev (marker)) | |
| 331 marker_next (marker_prev (marker)) = marker_next (marker); | |
| 332 else | |
| 333 BUF_MARKERS (b) = marker_next (marker); | |
| 334 | |
| 800 | 335 #ifdef ERROR_CHECK_STRUCTURES |
| 428 | 336 assert (marker != XMARKER (b->point_marker)); |
| 337 #endif | |
| 338 | |
| 339 marker->buffer = 0; | |
| 340 } | |
| 341 | |
| 665 | 342 Bytebpos |
| 826 | 343 byte_marker_position (Lisp_Object marker) |
| 428 | 344 { |
| 440 | 345 Lisp_Marker *m = XMARKER (marker); |
| 428 | 346 struct buffer *buf = m->buffer; |
| 665 | 347 Bytebpos pos; |
| 428 | 348 |
| 349 if (!buf) | |
| 563 | 350 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 351 |
| 352 /* FSF claims that marker indices could end up denormalized, i.e. | |
| 353 in the gap. This is way bogus if it ever happens, and means | |
| 354 something fucked up elsewhere. Since I've overhauled all this | |
| 355 shit, I don't think this can happen. In any case, the following | |
| 356 macro has an assert() in it that will catch these denormalized | |
| 357 positions. */ | |
| 665 | 358 pos = membpos_to_bytebpos (buf, m->membpos); |
| 428 | 359 |
| 360 return pos; | |
| 361 } | |
| 362 | |
| 665 | 363 Charbpos |
| 428 | 364 marker_position (Lisp_Object marker) |
| 365 { | |
| 366 struct buffer *buf = XMARKER (marker)->buffer; | |
| 367 | |
| 368 if (!buf) | |
| 563 | 369 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 370 |
| 826 | 371 return bytebpos_to_charbpos (buf, byte_marker_position (marker)); |
| 428 | 372 } |
| 373 | |
| 374 void | |
| 826 | 375 set_byte_marker_position (Lisp_Object marker, Bytebpos pos) |
| 428 | 376 { |
| 440 | 377 Lisp_Marker *m = XMARKER (marker); |
| 428 | 378 struct buffer *buf = m->buffer; |
| 379 | |
| 380 if (!buf) | |
| 563 | 381 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 382 |
| 665 | 383 m->membpos = bytebpos_to_membpos (buf, pos); |
| 428 | 384 } |
| 385 | |
| 386 void | |
| 665 | 387 set_marker_position (Lisp_Object marker, Charbpos pos) |
| 428 | 388 { |
| 389 struct buffer *buf = XMARKER (marker)->buffer; | |
| 390 | |
| 391 if (!buf) | |
| 563 | 392 invalid_argument ("Marker does not point anywhere", Qunbound); |
| 428 | 393 |
| 826 | 394 set_byte_marker_position (marker, charbpos_to_bytebpos (buf, pos)); |
| 428 | 395 } |
| 396 | |
| 397 static Lisp_Object | |
| 398 copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum) | |
| 399 { | |
| 3025 | 400 REGISTER Lisp_Object new_; |
| 428 | 401 |
| 402 while (1) | |
| 403 { | |
| 404 if (INTP (marker) || MARKERP (marker)) | |
| 405 { | |
| 406 if (noseeum) | |
| 3025 | 407 new_ = noseeum_make_marker (); |
| 428 | 408 else |
| 3025 | 409 new_ = Fmake_marker (); |
| 410 Fset_marker (new_, marker, | |
| 428 | 411 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil)); |
| 3025 | 412 XMARKER (new_)->insertion_type = !NILP (type); |
| 413 return new_; | |
| 428 | 414 } |
| 415 else | |
| 416 marker = wrong_type_argument (Qinteger_or_marker_p, marker); | |
| 417 } | |
| 418 | |
| 1204 | 419 RETURN_NOT_REACHED (Qnil); /* not reached */ |
| 428 | 420 } |
| 421 | |
| 422 DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /* | |
| 444 | 423 Return a new marker pointing at the same place as MARKER-OR-INTEGER. |
| 424 If MARKER-OR-INTEGER is an integer, return a new marker pointing | |
| 428 | 425 at that position in the current buffer. |
| 444 | 426 Optional argument MARKER-TYPE specifies the insertion type of the new |
| 427 marker; see `marker-insertion-type'. | |
| 428 | 428 */ |
| 444 | 429 (marker_or_integer, marker_type)) |
| 428 | 430 { |
| 444 | 431 return copy_marker_1 (marker_or_integer, marker_type, 0); |
| 428 | 432 } |
| 433 | |
| 434 Lisp_Object | |
| 444 | 435 noseeum_copy_marker (Lisp_Object marker, Lisp_Object marker_type) |
| 428 | 436 { |
| 444 | 437 return copy_marker_1 (marker, marker_type, 1); |
| 428 | 438 } |
| 439 | |
| 440 DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /* | |
| 441 Return insertion type of MARKER: t if it stays after inserted text. | |
| 442 nil means the marker stays before text inserted there. | |
| 443 */ | |
| 444 (marker)) | |
| 445 { | |
| 446 CHECK_MARKER (marker); | |
| 447 return XMARKER (marker)->insertion_type ? Qt : Qnil; | |
| 448 } | |
| 449 | |
| 450 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /* | |
| 451 Set the insertion-type of MARKER to TYPE. | |
| 452 If TYPE is t, it means the marker advances when you insert text at it. | |
| 453 If TYPE is nil, it means the marker stays behind when you insert text at it. | |
| 454 */ | |
| 455 (marker, type)) | |
| 456 { | |
| 457 CHECK_MARKER (marker); | |
| 458 | |
| 459 XMARKER (marker)->insertion_type = ! NILP (type); | |
| 460 return type; | |
| 461 } | |
| 462 | |
| 463 /* #### What is the possible use of this? It looks quite useless to | |
| 464 me, because there is no way to find *which* markers are positioned | |
| 465 at POSITION. Additional bogosity bonus: (buffer-has-markers-at | |
| 466 (point)) will always return t because of the `point-marker'. The | |
| 467 same goes for the position of mark. Bletch! | |
| 468 | |
| 469 Someone should discuss this with Stallman, but I don't have the | |
| 470 stomach. In fact, this function sucks so badly that I'm disabling | |
| 471 it by default (although I've debugged it). If you want to use it, | |
| 472 use extents instead. --hniksic */ | |
| 473 #if 0 | |
| 826 | 474 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /* |
| 428 | 475 Return t if there are markers pointing at POSITION in the current buffer. |
| 476 */ | |
| 477 (position)) | |
| 478 { | |
| 440 | 479 Lisp_Marker *marker; |
| 665 | 480 Membpos pos; |
| 428 | 481 |
| 665 | 482 /* A small optimization trick: convert POS to membpos now, rather |
| 483 than converting every marker's memory index to charbpos. */ | |
| 484 pos = bytebpos_to_membpos (current_buffer, | |
| 428 | 485 get_buffer_pos_byte (current_buffer, position, |
| 486 GB_COERCE_RANGE)); | |
| 487 | |
| 488 for (marker = BUF_MARKERS (current_buffer); | |
| 489 marker; | |
| 490 marker = marker_next (marker)) | |
| 491 { | |
| 665 | 492 /* We use marker->membpos, so we don't have to go through the |
| 428 | 493 unwieldy operation of creating a Lisp_Object for |
| 494 marker_position() every time around. */ | |
| 665 | 495 if (marker->membpos == pos) |
| 428 | 496 return Qt; |
| 497 } | |
| 498 | |
| 499 return Qnil; | |
| 500 } | |
| 501 #endif /* 0 */ | |
| 502 | |
| 503 #ifdef MEMORY_USAGE_STATS | |
| 504 | |
| 505 int | |
| 506 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats) | |
| 507 { | |
| 440 | 508 Lisp_Marker *m; |
| 428 | 509 int total = 0; |
| 510 int overhead; | |
| 511 | |
| 512 for (m = BUF_MARKERS (b); m; m = m->next) | |
| 440 | 513 total += sizeof (Lisp_Marker); |
| 428 | 514 ovstats->was_requested += total; |
| 3263 | 515 #ifdef NEW_GC |
| 2720 | 516 overhead = mc_alloced_storage_size (total, 0); |
| 3263 | 517 #else /* not NEW_GC */ |
| 428 | 518 overhead = fixed_type_block_overhead (total); |
| 3263 | 519 #endif /* not NEW_GC */ |
| 428 | 520 /* #### claiming this is all malloc overhead is not really right, |
| 521 but it has to go somewhere. */ | |
| 522 ovstats->malloc_overhead += overhead; | |
| 523 return total + overhead; | |
| 524 } | |
| 525 | |
| 526 #endif /* MEMORY_USAGE_STATS */ | |
| 527 | |
| 528 | |
| 529 void | |
| 530 syms_of_marker (void) | |
| 531 { | |
| 442 | 532 INIT_LRECORD_IMPLEMENTATION (marker); |
| 533 | |
| 428 | 534 DEFSUBR (Fmarker_position); |
| 535 DEFSUBR (Fmarker_buffer); | |
| 536 DEFSUBR (Fset_marker); | |
| 537 DEFSUBR (Fcopy_marker); | |
| 538 DEFSUBR (Fmarker_insertion_type); | |
| 539 DEFSUBR (Fset_marker_insertion_type); | |
| 540 #if 0 /* FSFmacs crock */ | |
| 541 DEFSUBR (Fbuffer_has_markers_at); | |
| 542 #endif | |
| 543 } | |
| 544 | |
| 545 void | |
| 546 init_buffer_markers (struct buffer *b) | |
| 547 { | |
| 793 | 548 Lisp_Object buf = wrap_buffer (b); |
| 428 | 549 |
| 550 b->mark = Fmake_marker (); | |
| 551 BUF_MARKERS (b) = 0; | |
| 552 b->point_marker = Fmake_marker (); | |
| 553 Fset_marker (b->point_marker, | |
| 554 /* For indirect buffers, point is already set. */ | |
| 555 b->base_buffer ? make_int (BUF_PT (b)) : make_int (1), | |
| 556 buf); | |
| 557 } | |
| 558 | |
| 559 void | |
| 560 uninit_buffer_markers (struct buffer *b) | |
| 561 { | |
| 562 /* Unchain all markers of this buffer | |
| 563 and leave them pointing nowhere. */ | |
| 440 | 564 REGISTER Lisp_Marker *m, *next; |
| 428 | 565 for (m = BUF_MARKERS (b); m; m = next) |
| 566 { | |
| 567 m->buffer = 0; | |
| 568 next = marker_next (m); | |
| 569 marker_next (m) = 0; | |
| 570 marker_prev (m) = 0; | |
| 571 } | |
| 572 BUF_MARKERS (b) = 0; | |
| 573 } |