Mercurial > hg > xemacs-beta
view 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 |
line wrap: on
line source
/* Markers: examining, setting and killing. Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 2002 Ben Wing. This file is part of XEmacs. XEmacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* Synched up with: FSF 19.30. */ /* This file has been Mule-ized. */ /* Note that markers are currently kept in an unordered list. This means that marker operations may be inefficient if there are a bunch of markers in the buffer. This probably won't have a significant impact on redisplay (which uses markers), but if it does, it wouldn't be too hard to change to an ordered gap array. (Just copy the code from extents.c.) */ #include <config.h> #include "lisp.h" #include "buffer.h" static Lisp_Object mark_marker (Lisp_Object obj) { Lisp_Marker *marker = XMARKER (obj); Lisp_Object buf; /* DO NOT mark through the marker's chain. The buffer's markers chain does not preserve markers from gc; Instead, markers are removed from the chain when they are freed by gc. */ if (!marker->buffer) return (Qnil); buf = wrap_buffer (marker->buffer); return (buf); } static void print_marker (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) { Lisp_Marker *marker = XMARKER (obj); if (print_readably) printing_unreadable_object ("#<marker 0x%lx>", (long) marker); write_ascstring (printcharfun, GETTEXT ("#<marker ")); if (!marker->buffer) write_ascstring (printcharfun, GETTEXT ("in no buffer")); else { write_fmt_string (printcharfun, "at %ld in ", (long) marker_position (obj)); print_internal (marker->buffer->name, printcharfun, 0); } if (marker->insertion_type) write_ascstring (printcharfun, " insertion-type=t"); write_fmt_string (printcharfun, " 0x%lx>", (long) marker); } static int marker_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) { Lisp_Marker *marker1 = XMARKER (obj1); Lisp_Marker *marker2 = XMARKER (obj2); return ((marker1->buffer == marker2->buffer) && (marker1->membpos == marker2->membpos || /* All markers pointing nowhere are equal */ !marker1->buffer)); } static Hashcode marker_hash (Lisp_Object obj, int UNUSED (depth)) { Hashcode hash = (Hashcode) XMARKER (obj)->buffer; if (hash) hash = HASH2 (hash, XMARKER (obj)->membpos); return hash; } static const struct memory_description marker_description[] = { { XD_LISP_OBJECT, offsetof (Lisp_Marker, next), 0, { 0 }, XD_FLAG_NO_KKCC }, { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev), 0, { 0 }, XD_FLAG_NO_KKCC }, { XD_LISP_OBJECT, offsetof (Lisp_Marker, buffer) }, { XD_END } }; #ifdef NEW_GC static void finalize_marker (void *header, int for_disksave) { if (!for_disksave) { Lisp_Object tem = wrap_marker (header); unchain_marker (tem); } } DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, 1, /*dumpable-flag*/ mark_marker, print_marker, finalize_marker, marker_equal, marker_hash, marker_description, Lisp_Marker); #else /* not NEW_GC */ DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker, 1, /*dumpable-flag*/ mark_marker, print_marker, 0, marker_equal, marker_hash, marker_description, Lisp_Marker); #endif /* not NEW_GC */ /* Operations on markers. */ DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /* Return the buffer that MARKER points into, or nil if none. Return nil if MARKER points into a dead buffer or doesn't point anywhere. */ (marker)) { struct buffer *buf; CHECK_MARKER (marker); /* Return marker's buffer only if it is not dead. */ if ((buf = XMARKER (marker)->buffer) && BUFFER_LIVE_P (buf)) { return wrap_buffer (buf); } return Qnil; } DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /* Return the position MARKER points at, as a character number. Return `nil' if marker doesn't point anywhere. */ (marker)) { CHECK_MARKER (marker); return XMARKER (marker)->buffer ? make_int (marker_position (marker)) : Qnil; } #if 0 /* useful debugging function */ static void check_marker_circularities (struct buffer *buf) { Lisp_Marker *tortoise, *hare; tortoise = BUF_MARKERS (buf); hare = tortoise; if (!tortoise) return; while (1) { assert (hare->buffer == buf); hare = hare->next; if (!hare) return; assert (hare->buffer == buf); hare = hare->next; if (!hare) return; tortoise = tortoise->next; assert (tortoise != hare); } } #endif static Lisp_Object set_marker_internal (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer, int restricted_p) { Charbpos charno; struct buffer *b; Lisp_Marker *m; int point_p; CHECK_MARKER (marker); point_p = POINT_MARKER_P (marker); /* If position is nil or a marker that points nowhere, make this marker point nowhere. */ if (NILP (position) || (MARKERP (position) && !XMARKER (position)->buffer)) { if (point_p) invalid_operation ("Can't make point-marker point nowhere", marker); if (XMARKER (marker)->buffer) unchain_marker (marker); return marker; } CHECK_INT_COERCE_MARKER (position); if (NILP (buffer)) b = current_buffer; else { CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ if (!BUFFER_LIVE_P (XBUFFER (buffer))) { if (point_p) invalid_operation ("Can't move point-marker in a killed buffer", marker); if (XMARKER (marker)->buffer) unchain_marker (marker); return marker; } } charno = XINT (position); m = XMARKER (marker); if (restricted_p) { if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b); if (charno > BUF_ZV (b)) charno = BUF_ZV (b); } else { if (charno < BUF_BEG (b)) charno = BUF_BEG (b); if (charno > BUF_Z (b)) charno = BUF_Z (b); } if (point_p) { #ifndef moving_point_by_moving_its_marker_is_a_bug BUF_SET_PT (b, charno); /* this will move the marker */ #else /* It's not a feature, so it must be a bug */ invalid_operation ("DEBUG: attempt to move point via point-marker", marker); #endif } else { m->membpos = charbpos_to_membpos (b, charno); } if (m->buffer != b) { if (point_p) invalid_operation ("Can't change buffer of point-marker", marker); if (m->buffer != 0) unchain_marker (marker); m->buffer = b; marker_next (m) = BUF_MARKERS (b); marker_prev (m) = 0; if (BUF_MARKERS (b)) marker_prev (BUF_MARKERS (b)) = m; BUF_MARKERS (b) = m; } return marker; } DEFUN ("set-marker", Fset_marker, 2, 3, 0, /* Move MARKER to position POSITION in BUFFER. POSITION can be a marker, an integer or nil. If POSITION is an integer, make MARKER point before the POSITIONth character in BUFFER. If POSITION is nil, makes MARKER point nowhere. Then it no longer slows down editing in any buffer. If POSITION is less than 1, move MARKER to the beginning of BUFFER. If POSITION is greater than the size of BUFFER, move MARKER to the end of BUFFER. BUFFER defaults to the current buffer. If this marker was returned by (point-marker t), then changing its position moves point. You cannot change its buffer or make it point nowhere. The return value is MARKER. */ (marker, position, buffer)) { return set_marker_internal (marker, position, buffer, 0); } /* This version of Fset_marker won't let the position be outside the visible part. */ Lisp_Object set_marker_restricted (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer) { return set_marker_internal (marker, position, buffer, 1); } /* This is called during garbage collection, so we must be careful to ignore and preserve mark bits, including those in chain fields of markers. */ void unchain_marker (Lisp_Object m) { Lisp_Marker *marker = XMARKER (m); struct buffer *b = marker->buffer; if (b == 0) return; #ifdef ERROR_CHECK_STRUCTURES assert (BUFFER_LIVE_P (b)); #endif if (marker_next (marker)) marker_prev (marker_next (marker)) = marker_prev (marker); if (marker_prev (marker)) marker_next (marker_prev (marker)) = marker_next (marker); else BUF_MARKERS (b) = marker_next (marker); #ifdef ERROR_CHECK_STRUCTURES assert (marker != XMARKER (b->point_marker)); #endif marker->buffer = 0; } Bytebpos byte_marker_position (Lisp_Object marker) { Lisp_Marker *m = XMARKER (marker); struct buffer *buf = m->buffer; Bytebpos pos; if (!buf) invalid_argument ("Marker does not point anywhere", Qunbound); /* FSF claims that marker indices could end up denormalized, i.e. in the gap. This is way bogus if it ever happens, and means something fucked up elsewhere. Since I've overhauled all this shit, I don't think this can happen. In any case, the following macro has an assert() in it that will catch these denormalized positions. */ pos = membpos_to_bytebpos (buf, m->membpos); return pos; } Charbpos marker_position (Lisp_Object marker) { struct buffer *buf = XMARKER (marker)->buffer; if (!buf) invalid_argument ("Marker does not point anywhere", Qunbound); return bytebpos_to_charbpos (buf, byte_marker_position (marker)); } void set_byte_marker_position (Lisp_Object marker, Bytebpos pos) { Lisp_Marker *m = XMARKER (marker); struct buffer *buf = m->buffer; if (!buf) invalid_argument ("Marker does not point anywhere", Qunbound); m->membpos = bytebpos_to_membpos (buf, pos); } void set_marker_position (Lisp_Object marker, Charbpos pos) { struct buffer *buf = XMARKER (marker)->buffer; if (!buf) invalid_argument ("Marker does not point anywhere", Qunbound); set_byte_marker_position (marker, charbpos_to_bytebpos (buf, pos)); } static Lisp_Object copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum) { REGISTER Lisp_Object new_; while (1) { if (INTP (marker) || MARKERP (marker)) { if (noseeum) new_ = noseeum_make_marker (); else new_ = Fmake_marker (); Fset_marker (new_, marker, (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil)); XMARKER (new_)->insertion_type = !NILP (type); return new_; } else marker = wrong_type_argument (Qinteger_or_marker_p, marker); } RETURN_NOT_REACHED (Qnil); /* not reached */ } DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /* Return a new marker pointing at the same place as MARKER-OR-INTEGER. If MARKER-OR-INTEGER is an integer, return a new marker pointing at that position in the current buffer. Optional argument MARKER-TYPE specifies the insertion type of the new marker; see `marker-insertion-type'. */ (marker_or_integer, marker_type)) { return copy_marker_1 (marker_or_integer, marker_type, 0); } Lisp_Object noseeum_copy_marker (Lisp_Object marker, Lisp_Object marker_type) { return copy_marker_1 (marker, marker_type, 1); } DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /* Return insertion type of MARKER: t if it stays after inserted text. nil means the marker stays before text inserted there. */ (marker)) { CHECK_MARKER (marker); return XMARKER (marker)->insertion_type ? Qt : Qnil; } DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /* Set the insertion-type of MARKER to TYPE. If TYPE is t, it means the marker advances when you insert text at it. If TYPE is nil, it means the marker stays behind when you insert text at it. */ (marker, type)) { CHECK_MARKER (marker); XMARKER (marker)->insertion_type = ! NILP (type); return type; } /* #### What is the possible use of this? It looks quite useless to me, because there is no way to find *which* markers are positioned at POSITION. Additional bogosity bonus: (buffer-has-markers-at (point)) will always return t because of the `point-marker'. The same goes for the position of mark. Bletch! Someone should discuss this with Stallman, but I don't have the stomach. In fact, this function sucks so badly that I'm disabling it by default (although I've debugged it). If you want to use it, use extents instead. --hniksic */ #if 0 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /* Return t if there are markers pointing at POSITION in the current buffer. */ (position)) { Lisp_Marker *marker; Membpos pos; /* A small optimization trick: convert POS to membpos now, rather than converting every marker's memory index to charbpos. */ pos = bytebpos_to_membpos (current_buffer, get_buffer_pos_byte (current_buffer, position, GB_COERCE_RANGE)); for (marker = BUF_MARKERS (current_buffer); marker; marker = marker_next (marker)) { /* We use marker->membpos, so we don't have to go through the unwieldy operation of creating a Lisp_Object for marker_position() every time around. */ if (marker->membpos == pos) return Qt; } return Qnil; } #endif /* 0 */ #ifdef MEMORY_USAGE_STATS int compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats) { Lisp_Marker *m; int total = 0; int overhead; for (m = BUF_MARKERS (b); m; m = m->next) total += sizeof (Lisp_Marker); ovstats->was_requested += total; #ifdef NEW_GC overhead = mc_alloced_storage_size (total, 0); #else /* not NEW_GC */ overhead = fixed_type_block_overhead (total); #endif /* not NEW_GC */ /* #### claiming this is all malloc overhead is not really right, but it has to go somewhere. */ ovstats->malloc_overhead += overhead; return total + overhead; } #endif /* MEMORY_USAGE_STATS */ void syms_of_marker (void) { INIT_LRECORD_IMPLEMENTATION (marker); DEFSUBR (Fmarker_position); DEFSUBR (Fmarker_buffer); DEFSUBR (Fset_marker); DEFSUBR (Fcopy_marker); DEFSUBR (Fmarker_insertion_type); DEFSUBR (Fset_marker_insertion_type); #if 0 /* FSFmacs crock */ DEFSUBR (Fbuffer_has_markers_at); #endif } void init_buffer_markers (struct buffer *b) { Lisp_Object buf = wrap_buffer (b); b->mark = Fmake_marker (); BUF_MARKERS (b) = 0; b->point_marker = Fmake_marker (); Fset_marker (b->point_marker, /* For indirect buffers, point is already set. */ b->base_buffer ? make_int (BUF_PT (b)) : make_int (1), buf); } void uninit_buffer_markers (struct buffer *b) { /* Unchain all markers of this buffer and leave them pointing nowhere. */ REGISTER Lisp_Marker *m, *next; for (m = BUF_MARKERS (b); m; m = next) { m->buffer = 0; next = marker_next (m); marker_next (m) = 0; marker_prev (m) = 0; } BUF_MARKERS (b) = 0; }