/* Buffer manipulation primitives for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995
+ Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, 1998
Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/param.h>
+#include <errno.h>
+
+extern int errno;
#ifndef MAXPATHLEN
/* in 4.1, param.h fails to define this. */
#endif /* not MAXPATHLEN */
#include <config.h>
+#ifdef STDC_HEADERS
+#include <stdlib.h>
+#endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
#include "lisp.h"
#include "intervals.h"
#include "window.h"
#include "commands.h"
#include "buffer.h"
+#include "charset.h"
#include "region-cache.h"
#include "indent.h"
#include "blockinput.h"
+#include "frame.h"
struct buffer *current_buffer; /* the current buffer */
buffer-local slots. If a slot contains Qnil, then the
corresponding buffer slot may contain a value of any type. If a
slot contains an integer, then prospective values' tags must be
- equal to that integer. When a tag does not match, the function
- buffer_slot_type_mismatch will signal an error. */
+ equal to that integer (except nil is always allowed).
+ When a tag does not match, the function
+ buffer_slot_type_mismatch will signal an error.
+
+ If a slot here contains -1, the corresponding variable is read-only. */
struct buffer buffer_local_types;
+/* Flags indicating which built-in buffer-local variables
+ are permanent locals. */
+static int buffer_permanent_local_flags;
+
Lisp_Object Fset_buffer ();
void set_buffer_internal ();
+void set_buffer_internal_1 ();
static void call_overlay_mod_hooks ();
static void swap_out_buffer_local_variables ();
+static void reset_buffer_local_variables ();
/* Alist of all buffer names vs the buffers. */
/* This used to be a variable, but is no longer,
/* List of functions to call before changing an unmodified buffer. */
Lisp_Object Vfirst_change_hook;
+
Lisp_Object Qfirst_change_hook;
+Lisp_Object Qbefore_change_functions;
+Lisp_Object Qafter_change_functions;
Lisp_Object Qfundamental_mode, Qmode_class, Qpermanent_local;
/* For debugging; temporary. See set_buffer_internal. */
/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
+void
nsberror (spec)
Lisp_Object spec;
{
error ("Invalid buffer argument");
}
\f
-DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 0, 0,
- "Return a list of all existing live buffers.")
- ()
+DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0,
+ "Return non-nil if OBJECT is a buffer which has not been killed.\n\
+Value is nil if OBJECT is not a buffer or if it has been killed.")
+ (object)
+ Lisp_Object object;
+{
+ return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name))
+ ? Qt : Qnil);
+}
+
+DEFUN ("buffer-list", Fbuffer_list, Sbuffer_list, 0, 1, 0,
+ "Return a list of all existing live buffers.\n\
+If the optional arg FRAME is a frame, we return that frame's buffer list.")
+ (frame)
+ Lisp_Object frame;
{
- return Fmapcar (Qcdr, Vbuffer_alist);
+ Lisp_Object framelist, general;
+ general = Fmapcar (Qcdr, Vbuffer_alist);
+
+ if (FRAMEP (frame))
+ {
+ Lisp_Object tail;
+
+ CHECK_FRAME (frame, 1);
+
+ framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
+
+ /* Remove from GENERAL any buffer that duplicates one in FRAMELIST. */
+ tail = framelist;
+ while (! NILP (tail))
+ {
+ general = Fdelq (XCONS (tail)->car, general);
+ tail = XCONS (tail)->cdr;
+ }
+ return nconc2 (framelist, general);
+ }
+
+ return general;
}
/* Like Fassoc, but use Fstring_equal to compare
return Qnil;
}
+Lisp_Object
+get_truename_buffer (filename)
+ register Lisp_Object filename;
+{
+ register Lisp_Object tail, buf, tem;
+
+ for (tail = Vbuffer_alist; CONSP (tail); tail = XCONS (tail)->cdr)
+ {
+ buf = Fcdr (XCONS (tail)->car);
+ if (!BUFFERP (buf)) continue;
+ if (!STRINGP (XBUFFER (buf)->file_truename)) continue;
+ tem = Fstring_equal (XBUFFER (buf)->file_truename, filename);
+ if (!NILP (tem))
+ return buf;
+ }
+ return Qnil;
+}
+
/* Incremented for each buffer created, to assign the buffer number. */
int buffer_count;
BUF_GAP_SIZE (b) = 20;
BLOCK_INPUT;
- BUFFER_ALLOC (BUF_BEG_ADDR (b), BUF_GAP_SIZE (b));
+ /* We allocate extra 1-byte at the tail and keep it always '\0' for
+ anchoring a search. */
+ BUFFER_ALLOC (BUF_BEG_ADDR (b), (BUF_GAP_SIZE (b) + 1));
UNBLOCK_INPUT;
if (! BUF_BEG_ADDR (b))
buffer_memory_full ();
BUF_BEGV (b) = 1;
BUF_ZV (b) = 1;
BUF_Z (b) = 1;
+ BUF_PT_BYTE (b) = 1;
+ BUF_GPT_BYTE (b) = 1;
+ BUF_BEGV_BYTE (b) = 1;
+ BUF_ZV_BYTE (b) = 1;
+ BUF_Z_BYTE (b) = 1;
BUF_MODIFF (b) = 1;
+ BUF_OVERLAY_MODIFF (b) = 1;
BUF_SAVE_MODIFF (b) = 1;
BUF_INTERVALS (b) = 0;
+ *(BUF_GPT_ADDR (b)) = *(BUF_Z_ADDR (b)) = 0; /* Put an anchor '\0'. */
b->newline_cache = 0;
b->width_run_cache = 0;
b->undo_list = Qt;
reset_buffer (b);
- reset_buffer_local_variables (b);
+ reset_buffer_local_variables (b, 1);
/* Put this in the alist of all live buffers. */
XSETBUFFER (buf, b);
return buf;
}
-DEFUN ("make-indirect-buffer",
- Fmake_indirect_buffer, Smake_indirect_buffer, 2, 2,
+DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, 2, 2,
"bMake indirect buffer (to buffer): \nBName of indirect buffer: ",
- "Create and return an indirect buffer for buffer BASE, named NAME.\n\
-BASE should be an existing buffer (or buffer name).\n\
+ "Create and return an indirect buffer for buffer BASE-BUFFER, named NAME.\n\
+BASE-BUFFER should be an existing buffer (or buffer name).\n\
NAME should be a string which is not the name of an existing buffer.")
(base_buffer, name)
register Lisp_Object base_buffer, name;
BUF_BEGV (b) = BUF_BEGV (b->base_buffer);
BUF_ZV (b) = BUF_ZV (b->base_buffer);
BUF_PT (b) = BUF_PT (b->base_buffer);
+ BUF_BEGV_BYTE (b) = BUF_BEGV_BYTE (b->base_buffer);
+ BUF_ZV_BYTE (b) = BUF_ZV_BYTE (b->base_buffer);
+ BUF_PT_BYTE (b) = BUF_PT_BYTE (b->base_buffer);
b->newline_cache = 0;
b->width_run_cache = 0;
b->name = name;
reset_buffer (b);
- reset_buffer_local_variables (b);
+ reset_buffer_local_variables (b, 1);
/* Put this in the alist of all live buffers. */
XSETBUFFER (buf, b);
if (NILP (b->base_buffer->pt_marker))
{
b->base_buffer->pt_marker = Fmake_marker ();
- Fset_marker (b->base_buffer->pt_marker,
- make_number (BUF_PT (b->base_buffer)), base_buffer);
+ set_marker_both (b->base_buffer->pt_marker, base_buffer,
+ BUF_PT (b->base_buffer),
+ BUF_PT_BYTE (b->base_buffer));
}
if (NILP (b->base_buffer->begv_marker))
{
b->base_buffer->begv_marker = Fmake_marker ();
- Fset_marker (b->base_buffer->begv_marker,
- make_number (BUF_BEGV (b->base_buffer)), base_buffer);
+ set_marker_both (b->base_buffer->begv_marker, base_buffer,
+ BUF_BEGV (b->base_buffer),
+ BUF_BEGV_BYTE (b->base_buffer));
}
if (NILP (b->base_buffer->zv_marker))
{
b->base_buffer->zv_marker = Fmake_marker ();
- Fset_marker (b->base_buffer->zv_marker,
- make_number (BUF_ZV (b->base_buffer)), base_buffer);
+ set_marker_both (b->base_buffer->zv_marker, base_buffer,
+ BUF_ZV (b->base_buffer),
+ BUF_ZV_BYTE (b->base_buffer));
+ XMARKER (b->base_buffer->zv_marker)->insertion_type = 1;
}
/* Give the indirect buffer markers for its narrowing. */
- b->pt_marker = Fpoint_marker ();
- b->begv_marker = Fpoint_min_marker ();
- b->zv_marker = Fpoint_max_marker ();
+ b->pt_marker = Fmake_marker ();
+ set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b));
+ b->begv_marker = Fmake_marker ();
+ set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b));
+ b->zv_marker = Fmake_marker ();
+ set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b));
+ XMARKER (b->zv_marker)->insertion_type = 1;
return buf;
}
b->modtime = 0;
XSETFASTINT (b->save_length, 0);
b->last_window_start = 1;
+ /* It is more conservative to start out "changed" than "unchanged". */
+ b->clip_changed = 1;
b->backed_up = Qnil;
b->auto_save_modified = 0;
b->auto_save_failure_time = -1;
b->mark_active = Qnil;
b->point_before_scroll = Qnil;
b->file_format = Qnil;
+ b->last_selected_window = Qnil;
+ XSETINT (b->display_count, 0);
+ b->extra2 = Qnil;
+ b->extra3 = Qnil;
+ b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters;
}
/* Reset buffer B's local variables info.
Don't use this on a buffer that has already been in use;
it does not treat permanent locals consistently.
- Instead, use Fkill_all_local_variables. */
+ Instead, use Fkill_all_local_variables.
-reset_buffer_local_variables (b)
+ If PERMANENT_TOO is 1, then we reset permanent built-in
+ buffer-local variables. If PERMANENT_TOO is 0,
+ we preserve those. */
+
+static void
+reset_buffer_local_variables (b, permanent_too)
register struct buffer *b;
+ int permanent_too;
{
register int offset;
+ int dont_reset;
+
+ /* Decide which built-in local variables to reset. */
+ if (permanent_too)
+ dont_reset = 0;
+ else
+ dont_reset = buffer_permanent_local_flags;
/* Reset the major mode to Fundamental, together with all the
things that depend on the major mode.
b->abbrev_table = Vfundamental_mode_abbrev_table;
b->mode_name = QSFundamental;
b->minor_modes = Qnil;
+
+ /* If the standard case table has been altered and invalidated,
+ fix up its insides first. */
+ if (! (CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[0])
+ && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[1])
+ && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2])))
+ Fset_standard_case_table (Vascii_downcase_table);
+
b->downcase_table = Vascii_downcase_table;
- b->upcase_table = Vascii_upcase_table;
- b->case_canon_table = Vascii_canon_table;
- b->case_eqv_table = Vascii_eqv_table;
- b->buffer_file_type = Qnil;
+ b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0];
+ b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1];
+ b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2];
b->invisibility_spec = Qt;
+#ifndef DOS_NT
+ b->buffer_file_type = Qnil;
+#endif
#if 0
b->sort_table = XSTRING (Vascii_sort_table);
b->folding_sort_table = XSTRING (Vascii_folding_sort_table);
#endif /* 0 */
- /* Reset all per-buffer variables to their defaults. */
+ /* Reset all (or most) per-buffer variables to their defaults. */
b->local_var_alist = Qnil;
- b->local_var_flags = 0;
+ b->local_var_flags &= dont_reset;
/* For each slot that has a default value,
copy that into the slot. */
offset += sizeof (Lisp_Object)) /* sizeof EMACS_INT == sizeof Lisp_Object */
{
int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags));
- if (flag > 0 || flag == -2)
- *(Lisp_Object *)(offset + (char *)b) =
- *(Lisp_Object *)(offset + (char *)&buffer_defaults);
+ if ((flag > 0
+ /* Don't reset a permanent local. */
+ && ! (dont_reset & flag))
+ || flag == -2)
+ *(Lisp_Object *)(offset + (char *)b)
+ = *(Lisp_Object *)(offset + (char *)&buffer_defaults);
}
}
(buffer, visible_ok)
register Lisp_Object buffer, visible_ok;
{
- register Lisp_Object tail, buf, notsogood, tem;
+ Lisp_Object Fset_buffer_major_mode ();
+ register Lisp_Object tail, buf, notsogood, tem, pred, add_ons;
notsogood = Qnil;
- for (tail = Vbuffer_alist; !NILP (tail); tail = Fcdr (tail))
+ tail = Vbuffer_alist;
+ pred = frame_buffer_predicate ();
+
+ /* Consider buffers that have been seen in the selected frame
+ before other buffers. */
+
+ tem = frame_buffer_list ();
+ add_ons = Qnil;
+ while (CONSP (tem))
+ {
+ if (BUFFERP (XCONS (tem)->car))
+ add_ons = Fcons (Fcons (Qnil, XCONS (tem)->car), add_ons);
+ tem = XCONS (tem)->cdr;
+ }
+ tail = nconc2 (Fnreverse (add_ons), tail);
+
+ for (; !NILP (tail); tail = Fcdr (tail))
{
buf = Fcdr (Fcar (tail));
if (EQ (buf, buffer))
continue;
if (XSTRING (XBUFFER (buf)->name)->data[0] == ' ')
continue;
-#ifdef MULTI_FRAME
/* If the selected frame has a buffer_predicate,
disregard buffers that don't fit the predicate. */
- tem = frame_buffer_predicate ();
- if (!NILP (tem))
+ if (!NILP (pred))
{
- tem = call1 (tem, buf);
+ tem = call1 (pred, buf);
if (NILP (tem))
continue;
}
-#endif
if (NILP (visible_ok))
tem = Fget_buffer_window (buf, Qt);
}
if (!NILP (notsogood))
return notsogood;
- return Fget_buffer_create (build_string ("*scratch*"));
+ buf = Fget_buffer_create (build_string ("*scratch*"));
+ Fset_buffer_major_mode (buf);
+ return buf;
}
\f
-DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo, 0, 1,
-0,
+DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, Sbuffer_disable_undo,
+ 0, 1, "",
"Make BUFFER stop keeping undo information.\n\
No argument or nil as argument means do this for the current buffer.")
(buffer)
before the buffer is actually killed. The buffer to be killed is current\n\
when the hook functions are called.\n\n\
Any processes that have this buffer as the `process-buffer' are killed\n\
-with `delete-process'.")
- (bufname)
- Lisp_Object bufname;
+with SIGHUP.")
+ (buffer)
+ Lisp_Object buffer;
{
Lisp_Object buf;
register struct buffer *b;
register struct Lisp_Marker *m;
struct gcpro gcpro1, gcpro2;
- if (NILP (bufname))
+ if (NILP (buffer))
buf = Fcurrent_buffer ();
else
- buf = Fget_buffer (bufname);
+ buf = Fget_buffer (buffer);
if (NILP (buf))
- nsberror (bufname);
+ nsberror (buffer);
b = XBUFFER (buf);
+ /* Avoid trouble for buffer already dead. */
+ if (NILP (b->name))
+ return Qnil;
+
/* Query if the buffer is still modified. */
if (INTERACTIVE && !NILP (b->filename)
&& BUF_MODIFF (b) > BUF_SAVE_MODIFF (b))
{
- GCPRO2 (buf, bufname);
+ GCPRO1 (buf);
tem = do_yes_or_no_p (format1 ("Buffer %s modified; kill anyway? ",
XSTRING (b->name)->data));
UNGCPRO;
GCPRO1 (buf);
for (other = all_buffers; other; other = other->next)
- if (other->base_buffer == b)
+ /* all_buffers contains dead buffers too;
+ don't re-kill them. */
+ if (other->base_buffer == b && !NILP (other->name))
{
Lisp_Object buf;
XSETBUFFER (buf, other);
tem = Vinhibit_quit;
Vinhibit_quit = Qt;
+ replace_buffer_in_all_windows (buf);
Vbuffer_alist = Fdelq (Frassq (buf, Vbuffer_alist), Vbuffer_alist);
- Freplace_buffer_in_windows (buf);
+ frames_discard_buffer (buf);
Vinhibit_quit = tem;
/* Delete any auto-save file, if we saved it in this session. */
if (STRINGP (b->auto_save_file_name)
- && b->auto_save_modified != 0)
+ && b->auto_save_modified != 0
+ && BUF_SAVE_MODIFF (b) < b->auto_save_modified)
{
Lisp_Object tem;
tem = Fsymbol_value (intern ("delete-auto-save-files"));
internal_delete_file (b->auto_save_file_name);
}
- if (! b->base_buffer)
+ if (b->base_buffer)
+ {
+ /* Unchain all markers that belong to this indirect buffer.
+ Don't unchain the markers that belong to the base buffer
+ or its other indirect buffers. */
+ for (tem = BUF_MARKERS (b); !NILP (tem); )
+ {
+ Lisp_Object next;
+ m = XMARKER (tem);
+ next = m->chain;
+ if (m->buffer == b)
+ unchain_marker (tem);
+ tem = next;
+ }
+ }
+ else
{
- /* Unchain all markers of this buffer
+ /* Unchain all markers of this buffer and its indirect buffers.
and leave them pointing nowhere. */
- for (tem = BUF_MARKERS (b); !EQ (tem, Qnil); )
+ for (tem = BUF_MARKERS (b); !NILP (tem); )
{
m = XMARKER (tem);
m->buffer = 0;
if they happened to remain encached in their symbols.
This gets rid of them for certain. */
swap_out_buffer_local_variables (b);
- reset_buffer_local_variables (b);
+ reset_buffer_local_variables (b, 1);
b->name = Qnil;
selected buffers are always closer to the front of the list. This
means that other_buffer is more likely to choose a relevant buffer. */
+void
record_buffer (buf)
Lisp_Object buf;
{
else
XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
- XCONS(link)->cdr = Vbuffer_alist;
+ XCONS (link)->cdr = Vbuffer_alist;
Vbuffer_alist = link;
+
+ /* Now move this buffer to the front of frame_buffer_list also. */
+
+ prev = Qnil;
+ for (link = frame_buffer_list (); CONSP (link); link = XCONS (link)->cdr)
+ {
+ if (EQ (XCONS (link)->car, buf))
+ break;
+ prev = link;
+ }
+
+ /* Effectively do delq. */
+
+ if (CONSP (link))
+ {
+ if (NILP (prev))
+ set_frame_buffer_list (XCONS (frame_buffer_list ())->cdr);
+ else
+ XCONS (prev)->cdr = XCONS (XCONS (prev)->cdr)->cdr;
+
+ XCONS (link)->cdr = frame_buffer_list ();
+ set_frame_buffer_list (link);
+ }
+ else
+ set_frame_buffer_list (Fcons (buf, frame_buffer_list ()));
}
DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, Sset_buffer_major_mode, 1, 1, 0,
"Set an appropriate major mode for BUFFER, according to `default-major-mode'.\n\
Use this function before selecting the buffer, since it may need to inspect\n\
the current buffer's major mode.")
- (buf)
- Lisp_Object buf;
+ (buffer)
+ Lisp_Object buffer;
{
int count;
Lisp_Object function;
record_unwind_protect (save_excursion_restore, save_excursion_save ());
- Fset_buffer (buf);
+ Fset_buffer (buffer);
call0 (function);
return unbind_to (count, Qnil);
WARNING: This is NOT the way to work on another buffer temporarily\n\
within a Lisp program! Use `set-buffer' instead. That avoids messing with\n\
the window-buffer correspondences.")
- (bufname, norecord)
- Lisp_Object bufname, norecord;
+ (buffer, norecord)
+ Lisp_Object buffer, norecord;
{
register Lisp_Object buf;
Lisp_Object tem;
if (!NILP (tem))
error ("Cannot switch buffers in a dedicated window");
- if (NILP (bufname))
+ if (NILP (buffer))
buf = Fother_buffer (Fcurrent_buffer (), Qnil);
else
{
- buf = Fget_buffer (bufname);
+ buf = Fget_buffer (buffer);
if (NILP (buf))
{
- buf = Fget_buffer_create (bufname);
+ buf = Fget_buffer_create (buffer);
Fset_buffer_major_mode (buf);
}
}
return buf;
}
-DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 2, 0,
+DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 3, 0,
"Select buffer BUFFER in some window, preferably a different one.\n\
If BUFFER is nil, then some other buffer is chosen.\n\
If `pop-up-windows' is non-nil, windows can be split to do this.\n\
If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\
-window even if BUFFER is already visible in the selected window.")
- (bufname, other)
- Lisp_Object bufname, other;
+window even if BUFFER is already visible in the selected window.\n\
+This uses the function `display-buffer' as a subroutine; see the documentation\n\
+of `display-buffer' for additional customization information.\n\
+\n\
+Optional third arg NORECORD non-nil means\n\
+do not put this buffer at the front of the list of recently selected ones.")
+ (buffer, other_window, norecord)
+ Lisp_Object buffer, other_window, norecord;
{
register Lisp_Object buf;
- if (NILP (bufname))
+ if (NILP (buffer))
buf = Fother_buffer (Fcurrent_buffer (), Qnil);
else
{
- buf = Fget_buffer (bufname);
+ buf = Fget_buffer (buffer);
if (NILP (buf))
{
- buf = Fget_buffer_create (bufname);
+ buf = Fget_buffer_create (buffer);
Fset_buffer_major_mode (buf);
}
}
Fset_buffer (buf);
- record_buffer (buf);
- Fselect_window (Fdisplay_buffer (buf, other));
+ if (NILP (norecord))
+ record_buffer (buf);
+ Fselect_window (Fdisplay_buffer (buf, other_window, Qnil));
return buf;
}
return buf;
}
\f
-/* Set the current buffer to b */
+/* Set the current buffer to B. */
void
set_buffer_internal (b)
return;
windows_or_buffers_changed = 1;
+ set_buffer_internal_1 (b);
+}
+
+/* Set the current buffer to B, and do not set windows_or_buffers_changed.
+ This is used by redisplay. */
+
+void
+set_buffer_internal_1 (b)
+ register struct buffer *b;
+{
+ register struct buffer *old_buf;
+ register Lisp_Object tail, valcontents;
+ Lisp_Object tem;
+
+ if (current_buffer == b)
+ return;
+
old_buf = current_buffer;
current_buffer = b;
last_known_column_point = -1; /* invalidate indentation cache */
{
Lisp_Object obuf;
XSETBUFFER (obuf, old_buf);
- Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf);
+ set_marker_both (old_buf->pt_marker, obuf,
+ BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
}
if (! NILP (old_buf->begv_marker))
{
Lisp_Object obuf;
XSETBUFFER (obuf, old_buf);
- Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf);
+ set_marker_both (old_buf->begv_marker, obuf,
+ BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
}
if (! NILP (old_buf->zv_marker))
{
Lisp_Object obuf;
XSETBUFFER (obuf, old_buf);
- Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf);
+ set_marker_both (old_buf->zv_marker, obuf,
+ BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
}
}
/* If the new current buffer has markers to record PT, BEGV and ZV
when it is not current, fetch them now. */
if (! NILP (b->pt_marker))
- BUF_PT (b) = marker_position (b->pt_marker);
+ {
+ BUF_PT (b) = marker_position (b->pt_marker);
+ BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
+ }
if (! NILP (b->begv_marker))
- BUF_BEGV (b) = marker_position (b->begv_marker);
+ {
+ BUF_BEGV (b) = marker_position (b->begv_marker);
+ BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
+ }
if (! NILP (b->zv_marker))
- BUF_ZV (b) = marker_position (b->zv_marker);
+ {
+ BUF_ZV (b) = marker_position (b->zv_marker);
+ BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
+ }
/* Look down buffer's list of local Lisp variables
to find and update any that forward into C variables. */
valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
if ((BUFFER_LOCAL_VALUEP (valcontents)
|| SOME_BUFFER_LOCAL_VALUEP (valcontents))
- && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car,
+ && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
(BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
/* Just reference the variable
to cause it to become set for this buffer. */
valcontents = XSYMBOL (XCONS (XCONS (tail)->car)->car)->value;
if ((BUFFER_LOCAL_VALUEP (valcontents)
|| SOME_BUFFER_LOCAL_VALUEP (valcontents))
- && (tem = XBUFFER_LOCAL_VALUE (valcontents)->car,
+ && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
(BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
/* Just reference the variable
to cause it to become set for this buffer. */
{
Lisp_Object obuf;
XSETBUFFER (obuf, old_buf);
- Fset_marker (old_buf->pt_marker, BUF_PT (old_buf), obuf);
+ set_marker_both (old_buf->pt_marker, obuf,
+ BUF_PT (old_buf), BUF_PT_BYTE (old_buf));
}
if (! NILP (old_buf->begv_marker))
{
Lisp_Object obuf;
XSETBUFFER (obuf, old_buf);
- Fset_marker (old_buf->begv_marker, BUF_BEGV (old_buf), obuf);
+ set_marker_both (old_buf->begv_marker, obuf,
+ BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf));
}
if (! NILP (old_buf->zv_marker))
{
Lisp_Object obuf;
XSETBUFFER (obuf, old_buf);
- Fset_marker (old_buf->zv_marker, BUF_ZV (old_buf), obuf);
+ set_marker_both (old_buf->zv_marker, obuf,
+ BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf));
}
}
/* If the new current buffer has markers to record PT, BEGV and ZV
when it is not current, fetch them now. */
if (! NILP (b->pt_marker))
- BUF_PT (b) = marker_position (b->pt_marker);
+ {
+ BUF_PT (b) = marker_position (b->pt_marker);
+ BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker);
+ }
if (! NILP (b->begv_marker))
- BUF_BEGV (b) = marker_position (b->begv_marker);
+ {
+ BUF_BEGV (b) = marker_position (b->begv_marker);
+ BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker);
+ }
if (! NILP (b->zv_marker))
- BUF_ZV (b) = marker_position (b->zv_marker);
+ {
+ BUF_ZV (b) = marker_position (b->zv_marker);
+ BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker);
+ }
}
DEFUN ("set-buffer", Fset_buffer, Sset_buffer, 1, 1, 0,
This function does not display the buffer, so its effect ends\n\
when the current command terminates.\n\
Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently.")
- (bufname)
- register Lisp_Object bufname;
+ (buffer)
+ register Lisp_Object buffer;
{
- register Lisp_Object buffer;
- buffer = Fget_buffer (bufname);
- if (NILP (buffer))
- nsberror (bufname);
- if (NILP (XBUFFER (buffer)->name))
+ register Lisp_Object buf;
+ buf = Fget_buffer (buffer);
+ if (NILP (buf))
+ nsberror (buffer);
+ if (NILP (XBUFFER (buf)->name))
error ("Selecting deleted buffer");
- set_buffer_internal (XBUFFER (buffer));
- return buffer;
+ set_buffer_internal (XBUFFER (buf));
+ return buf;
+}
+
+/* Set the current buffer to BUFFER provided it is alive. */
+
+Lisp_Object
+set_buffer_if_live (buffer)
+ Lisp_Object buffer;
+{
+ if (! NILP (XBUFFER (buffer)->name))
+ Fset_buffer (buffer);
+ return Qnil;
}
\f
DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only,
If BUFFER is nil or omitted, bury the current buffer.\n\
Also, if BUFFER is nil or omitted, remove the current buffer from the\n\
selected window if it is displayed there.")
- (buf)
- register Lisp_Object buf;
+ (buffer)
+ register Lisp_Object buffer;
{
/* Figure out what buffer we're going to bury. */
- if (NILP (buf))
+ if (NILP (buffer))
{
- XSETBUFFER (buf, current_buffer);
+ XSETBUFFER (buffer, current_buffer);
/* If we're burying the current buffer, unshow it. */
- Fswitch_to_buffer (Fother_buffer (buf, Qnil), Qnil);
+ Fswitch_to_buffer (Fother_buffer (buffer, Qnil), Qnil);
}
else
{
Lisp_Object buf1;
- buf1 = Fget_buffer (buf);
+ buf1 = Fget_buffer (buffer);
if (NILP (buf1))
- nsberror (buf);
- buf = buf1;
+ nsberror (buffer);
+ buffer = buf1;
}
- /* Move buf to the end of the buffer list. */
+ /* Move buffer to the end of the buffer list. */
{
register Lisp_Object aelt, link;
- aelt = Frassq (buf, Vbuffer_alist);
+ aelt = Frassq (buffer, Vbuffer_alist);
link = Fmemq (aelt, Vbuffer_alist);
Vbuffer_alist = Fdelq (aelt, Vbuffer_alist);
XCONS (link)->cdr = Qnil;
Vbuffer_alist = nconc2 (Vbuffer_alist, link);
}
+ frames_bury_buffer (buffer);
+
return Qnil;
}
\f
return Qnil;
}
+void
validate_region (b, e)
register Lisp_Object *b, *e;
{
args_out_of_range (*b, *e);
}
\f
+/* Advance BYTE_POS up to a character boundary
+ and return the adjusted position. */
+
+static int
+advance_to_char_boundary (byte_pos)
+ int byte_pos;
+{
+ int c;
+
+ if (byte_pos == BEG)
+ /* Beginning of buffer is always a character boundary. */
+ return 1;
+
+ c = FETCH_BYTE (byte_pos);
+ if (! CHAR_HEAD_P (c))
+ {
+ /* We should advance BYTE_POS only when C is a constituen of a
+ multibyte sequence. */
+ DEC_POS (byte_pos);
+ INC_POS (byte_pos);
+ /* If C is a constituent of a multibyte sequence, BYTE_POS was
+ surely advance to the correct character boundary. If C is
+ not, BYTE_POS was unchanged. */
+ }
+
+ return byte_pos;
+}
+
+DEFUN ("set-buffer-multibyte", Fset_buffer_multibyte, Sset_buffer_multibyte,
+ 1, 1, 0,
+ "Set the multibyte flag of the current buffer to FLAG.\n\
+If FLAG is t, this makes the buffer a multibyte buffer.\n\
+If FLAG is nil, this makes the buffer a single-byte buffer.\n\
+The buffer contents remain unchanged as a sequence of bytes\n\
+but the contents viewed as characters do change.")
+ (flag)
+ Lisp_Object flag;
+{
+ Lisp_Object tail, markers;
+
+ /* Do nothing if nothing actually changes. */
+ if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters))
+ return flag;
+
+ /* It would be better to update the list,
+ but this is good enough for now. */
+ if (! EQ (current_buffer->undo_list, Qt))
+ current_buffer->undo_list = Qnil;
+
+ /* If the cached position is for this buffer, clear it out. */
+ clear_charpos_cache (current_buffer);
+
+ if (NILP (flag))
+ {
+ /* Do this first, so it can use CHAR_TO_BYTE
+ to calculate the old correspondences. */
+ set_intervals_multibyte (0);
+
+ current_buffer->enable_multibyte_characters = Qnil;
+
+ Z = Z_BYTE;
+ BEGV = BEGV_BYTE;
+ ZV = ZV_BYTE;
+ GPT = GPT_BYTE;
+ TEMP_SET_PT_BOTH (PT_BYTE, PT_BYTE);
+
+ tail = BUF_MARKERS (current_buffer);
+ while (XSYMBOL (tail) != XSYMBOL (Qnil))
+ {
+ XMARKER (tail)->charpos = XMARKER (tail)->bytepos;
+ tail = XMARKER (tail)->chain;
+ }
+ }
+ else
+ {
+ /* Be sure not to have a multibyte sequence striding over the GAP.
+ Ex: We change this: "...abc\201\241\241 _GAP_ \241\241\241..."
+ to: "...abc _GAP_ \201\241\241\241\241\241..." */
+
+ if (GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
+ && ! CHAR_HEAD_P (*(GAP_END_ADDR)))
+ {
+ unsigned char *p = GPT_ADDR - 1;
+
+ while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--;
+ if (BASE_LEADING_CODE_P (*p))
+ {
+ int new_gpt = GPT_BYTE - (GPT_ADDR - p);
+
+ move_gap_both (new_gpt, new_gpt);
+ }
+ }
+
+ /* Do this first, so that chars_in_text asks the right question.
+ set_intervals_multibyte needs it too. */
+ current_buffer->enable_multibyte_characters = Qt;
+
+ GPT_BYTE = advance_to_char_boundary (GPT_BYTE);
+ GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG;
+
+ Z = chars_in_text (GAP_END_ADDR, Z_BYTE - GPT_BYTE) + GPT;
+
+ BEGV_BYTE = advance_to_char_boundary (BEGV_BYTE);
+ if (BEGV_BYTE > GPT_BYTE)
+ BEGV = chars_in_text (GAP_END_ADDR, BEGV_BYTE - GPT_BYTE) + GPT;
+ else
+ BEGV = chars_in_text (BEG_ADDR, BEGV_BYTE - BEG_BYTE) + BEG;
+
+ ZV_BYTE = advance_to_char_boundary (ZV_BYTE);
+ if (ZV_BYTE > GPT_BYTE)
+ ZV = chars_in_text (GAP_END_ADDR, ZV_BYTE - GPT_BYTE) + GPT;
+ else
+ ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG;
+
+ {
+ int pt_byte = advance_to_char_boundary (PT_BYTE);
+ int pt;
+
+ if (pt_byte > GPT_BYTE)
+ pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT;
+ else
+ pt = chars_in_text (BEG_ADDR, pt_byte - BEG_BYTE) + BEG;
+ TEMP_SET_PT_BOTH (pt, pt_byte);
+ }
+
+ tail = markers = BUF_MARKERS (current_buffer);
+ BUF_MARKERS (current_buffer) = Qnil;
+
+ while (XSYMBOL (tail) != XSYMBOL (Qnil))
+ {
+ XMARKER (tail)->bytepos
+ = advance_to_char_boundary (XMARKER (tail)->bytepos);
+ XMARKER (tail)->charpos = BYTE_TO_CHAR (XMARKER (tail)->bytepos);
+
+ tail = XMARKER (tail)->chain;
+ }
+ BUF_MARKERS (current_buffer) = markers;
+
+ /* Do this last, so it can calculate the new correspondences
+ between chars and bytes. */
+ set_intervals_multibyte (1);
+ }
+
+ return flag;
+}
+\f
DEFUN ("kill-all-local-variables", Fkill_all_local_variables, Skill_all_local_variables,
0, 0, 0,
"Switch to Fundamental mode by killing current buffer's local variables.\n\
/* Actually eliminate all local bindings of this buffer. */
- reset_buffer_local_variables (current_buffer);
+ reset_buffer_local_variables (current_buffer, 0);
/* Redisplay mode lines; we are changing major mode. */
sym = XCONS (XCONS (alist)->car)->car;
/* Need not do anything if some other buffer's binding is now encached. */
- tem = XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->car;
+ tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer;
if (XBUFFER (tem) == current_buffer)
{
/* Symbol is set up for this buffer's old local value.
Set it up for the current buffer with the default value. */
- tem = XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->cdr;
+ tem = XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr;
/* Store the symbol's current value into the alist entry
it is currently set up for. This is so that, if the
local is marked permanent, and we make it local again
later in Fkill_all_local_variables, we don't lose the value. */
XCONS (XCONS (tem)->car)->cdr
- = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->car);
+ = do_symval_forwarding (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue);
/* Switch to the symbol's default-value alist entry. */
XCONS (tem)->car = tem;
/* Mark it as current for buffer B. */
- XCONS (XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->cdr)->car
- = buffer;
+ XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->buffer = buffer;
/* Store the current value into any forwarding in the symbol. */
- store_symval_forwarding (sym, XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->car,
+ store_symval_forwarding (sym,
+ XBUFFER_LOCAL_VALUE (XSYMBOL (sym)->value)->realvalue,
XCONS (tem)->cdr);
}
}
*prev_ptr = prev;
return idx;
}
+\f
+/* Find all the overlays in the current buffer that overlap the range BEG-END
+ or are empty at BEG.
+
+ Return the number found, and store them in a vector in *VEC_PTR.
+ Store in *LEN_PTR the size allocated for the vector.
+ Store in *NEXT_PTR the next position after POS where an overlay starts,
+ or ZV if there are no more overlays.
+ Store in *PREV_PTR the previous position before POS where an overlay ends,
+ or BEGV if there are no previous overlays.
+ NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
+
+ *VEC_PTR and *LEN_PTR should contain a valid vector and size
+ when this function is called.
+
+ If EXTEND is non-zero, we make the vector bigger if necessary.
+ If EXTEND is zero, we never extend the vector,
+ and we store only as many overlays as will fit.
+ But we still return the total number of overlays. */
+
+int
+overlays_in (beg, end, extend, vec_ptr, len_ptr, next_ptr, prev_ptr)
+ int beg, end;
+ int extend;
+ Lisp_Object **vec_ptr;
+ int *len_ptr;
+ int *next_ptr;
+ int *prev_ptr;
+{
+ Lisp_Object tail, overlay, ostart, oend, result;
+ int idx = 0;
+ int len = *len_ptr;
+ Lisp_Object *vec = *vec_ptr;
+ int next = ZV;
+ int prev = BEGV;
+ int inhibit_storing = 0;
+
+ for (tail = current_buffer->overlays_before;
+ GC_CONSP (tail);
+ tail = XCONS (tail)->cdr)
+ {
+ int startpos, endpos;
+
+ overlay = XCONS (tail)->car;
+
+ ostart = OVERLAY_START (overlay);
+ oend = OVERLAY_END (overlay);
+ endpos = OVERLAY_POSITION (oend);
+ if (endpos < beg)
+ {
+ if (prev < endpos)
+ prev = endpos;
+ break;
+ }
+ startpos = OVERLAY_POSITION (ostart);
+ /* Count an interval if it either overlaps the range
+ or is empty at the start of the range. */
+ if ((beg < endpos && startpos < end)
+ || (startpos == endpos && beg == endpos))
+ {
+ if (idx == len)
+ {
+ /* The supplied vector is full.
+ Either make it bigger, or don't store any more in it. */
+ if (extend)
+ {
+ *len_ptr = len *= 2;
+ vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
+ *vec_ptr = vec;
+ }
+ else
+ inhibit_storing = 1;
+ }
+ if (!inhibit_storing)
+ vec[idx] = overlay;
+ /* Keep counting overlays even if we can't return them all. */
+ idx++;
+ }
+ else if (startpos < next)
+ next = startpos;
+ }
+
+ for (tail = current_buffer->overlays_after;
+ GC_CONSP (tail);
+ tail = XCONS (tail)->cdr)
+ {
+ int startpos, endpos;
+
+ overlay = XCONS (tail)->car;
+
+ ostart = OVERLAY_START (overlay);
+ oend = OVERLAY_END (overlay);
+ startpos = OVERLAY_POSITION (ostart);
+ if (end < startpos)
+ {
+ if (startpos < next)
+ next = startpos;
+ break;
+ }
+ endpos = OVERLAY_POSITION (oend);
+ /* Count an interval if it either overlaps the range
+ or is empty at the start of the range. */
+ if ((beg < endpos && startpos < end)
+ || (startpos == endpos && beg == endpos))
+ {
+ if (idx == len)
+ {
+ if (extend)
+ {
+ *len_ptr = len *= 2;
+ vec = (Lisp_Object *) xrealloc (vec, len * sizeof (Lisp_Object));
+ *vec_ptr = vec;
+ }
+ else
+ inhibit_storing = 1;
+ }
+
+ if (!inhibit_storing)
+ vec[idx] = overlay;
+ idx++;
+ }
+ else if (endpos < beg && endpos > prev)
+ prev = endpos;
+ }
+
+ if (next_ptr)
+ *next_ptr = next;
+ if (prev_ptr)
+ *prev_ptr = prev;
+ return idx;
+}
+\f
/* Fast function to just test if we're at an overlay boundary. */
int
overlay_touches_p (pos)
};
static int
-compare_overlays (s1, s2)
- struct sortvec *s1, *s2;
+compare_overlays (v1, v2)
+ const void *v1, *v2;
{
+ const struct sortvec *s1 = (const struct sortvec *) v1;
+ const struct sortvec *s2 = (const struct sortvec *) v2;
if (s1->priority != s2->priority)
return s1->priority - s2->priority;
if (s1->beg != s2->beg)
\f
struct sortstr
{
- Lisp_Object string;
+ Lisp_Object string, string2;
int size;
int priority;
};
+struct sortstrlist
+{
+ struct sortstr *buf; /* An array that expands as needed; never freed. */
+ int size; /* Allocated length of that array. */
+ int used; /* How much of the array is currently in use. */
+ int bytes; /* Total length of the strings in buf. */
+};
+
+/* Buffers for storing information about the overlays touching a given
+ position. These could be automatic variables in overlay_strings, but
+ it's more efficient to hold onto the memory instead of repeatedly
+ allocating and freeing it. */
+static struct sortstrlist overlay_heads, overlay_tails;
+static unsigned char *overlay_str_buf;
+
+/* Allocated length of overlay_str_buf. */
+static int overlay_str_len;
+
/* A comparison function suitable for passing to qsort. */
static int
cmp_for_strings (as1, as2)
return 0;
}
-/* Buffers for storing the overlays touching a given position.
- These are expanded as needed, but never freed. */
-static struct sortstr *overlay_heads, *overlay_tails;
-static char *overlay_str_buf;
+static void
+record_overlay_string (ssl, str, str2, pri, size)
+ struct sortstrlist *ssl;
+ Lisp_Object str, str2, pri;
+ int size;
+{
+ int nbytes;
-/* Allocated length of those buffers. */
-static int overlay_heads_len, overlay_tails_len, overlay_str_len;
+ if (ssl->used == ssl->size)
+ {
+ if (ssl->buf)
+ ssl->size *= 2;
+ else
+ ssl->size = 5;
+ ssl->buf = ((struct sortstr *)
+ xrealloc (ssl->buf, ssl->size * sizeof (struct sortstr)));
+ }
+ ssl->buf[ssl->used].string = str;
+ ssl->buf[ssl->used].string2 = str2;
+ ssl->buf[ssl->used].size = size;
+ ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0);
+ ssl->used++;
+
+ if (NILP (current_buffer->enable_multibyte_characters))
+ nbytes = XSTRING (str)->size;
+ else if (! STRING_MULTIBYTE (str))
+ nbytes = count_size_as_multibyte (XSTRING (str)->data,
+ STRING_BYTES (XSTRING (str)));
+ else
+ nbytes = STRING_BYTES (XSTRING (str));
+
+ ssl->bytes += nbytes;
+
+ if (STRINGP (str2))
+ {
+ if (NILP (current_buffer->enable_multibyte_characters))
+ nbytes = XSTRING (str2)->size;
+ else if (! STRING_MULTIBYTE (str2))
+ nbytes = count_size_as_multibyte (XSTRING (str2)->data,
+ STRING_BYTES (XSTRING (str2)));
+ else
+ nbytes = STRING_BYTES (XSTRING (str2));
+
+ ssl->bytes += nbytes;
+ }
+}
/* Return the concatenation of the strings associated with overlays that
begin or end at POS, ignoring overlays that are specific to a window
other than W. The strings are concatenated in the appropriate order:
shorter overlays nest inside longer ones, and higher priority inside
- lower. Returns the string length, and stores the contents indirectly
- through PSTR, if that variable is non-null. The string may be
- overwritten by subsequent calls. */
+ lower. Normally all of the after-strings come first, but zero-sized
+ overlays have their after-strings ride along with the before-strings
+ because it would look strange to print them inside-out.
+
+ Returns the string length, and stores the contents indirectly through
+ PSTR, if that variable is non-null. The string may be overwritten by
+ subsequent calls. */
+
int
overlay_strings (pos, w, pstr)
int pos;
struct window *w;
- char **pstr;
+ unsigned char **pstr;
{
- Lisp_Object ov, overlay, window, str, tem;
- int ntail = 0, nhead = 0;
- int total = 0;
+ Lisp_Object ov, overlay, window, str;
int startpos, endpos;
+ int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
+ overlay_heads.used = overlay_heads.bytes = 0;
+ overlay_tails.used = overlay_tails.bytes = 0;
for (ov = current_buffer->overlays_before; CONSP (ov); ov = XCONS (ov)->cdr)
{
overlay = XCONS (ov)->car;
window = Foverlay_get (overlay, Qwindow);
if (WINDOWP (window) && XWINDOW (window) != w)
continue;
- if (endpos == pos)
- {
- str = Foverlay_get (overlay, Qafter_string);
- if (STRINGP (str))
- {
- if (ntail == overlay_tails_len)
- {
- if (! overlay_tails)
- {
- overlay_tails_len = 5;
- overlay_tails = ((struct sortstr *)
- xmalloc (5 * sizeof (struct sortstr)));
- }
- else
- {
- overlay_tails_len *= 2;
- overlay_tails = ((struct sortstr *)
- xrealloc ((overlay_tails_len
- * sizeof (struct sortstr))));
- }
- }
- overlay_tails[ntail].string = str;
- overlay_tails[ntail].size = endpos - startpos;
- tem = Foverlay_get (overlay, Qpriority);
- overlay_tails[ntail].priority = (INTEGERP (tem) ? XINT (tem) : 0);
- ntail++;
- total += XSTRING (str)->size;
- }
- }
- if (startpos == pos)
- {
- str = Foverlay_get (overlay, Qbefore_string);
- if (STRINGP (str))
- {
- if (nhead == overlay_heads_len)
- {
- if (! overlay_heads)
- {
- overlay_heads_len = 5;
- overlay_heads = ((struct sortstr *)
- xmalloc (5 * sizeof (struct sortstr)));
- }
- else
- {
- overlay_heads_len *= 2;
- overlay_heads = ((struct sortstr *)
- xrealloc ((overlay_heads_len
- * sizeof (struct sortstr))));
- }
- }
- overlay_heads[nhead].string = str;
- overlay_heads[nhead].size = endpos - startpos;
- tem = Foverlay_get (overlay, Qpriority);
- overlay_heads[nhead].priority = (INTEGERP (tem) ? XINT (tem) : 0);
- nhead++;
- total += XSTRING (str)->size;
- }
- }
+ if (startpos == pos
+ && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
+ record_overlay_string (&overlay_heads, str,
+ (startpos == endpos
+ ? Foverlay_get (overlay, Qafter_string)
+ : Qnil),
+ Foverlay_get (overlay, Qpriority),
+ endpos - startpos);
+ else if (endpos == pos
+ && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
+ record_overlay_string (&overlay_tails, str, Qnil,
+ Foverlay_get (overlay, Qpriority),
+ endpos - startpos);
}
for (ov = current_buffer->overlays_after; CONSP (ov); ov = XCONS (ov)->cdr)
{
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
if (startpos > pos)
break;
- if (endpos == pos)
- {
- str = Foverlay_get (overlay, Qafter_string);
- if (STRINGP (str))
- {
- if (ntail == overlay_tails_len)
- {
- if (! overlay_tails)
- {
- overlay_tails_len = 5;
- overlay_tails = ((struct sortstr *)
- xmalloc (5 * sizeof (struct sortstr)));
- }
- else
- {
- overlay_tails_len *= 2;
- overlay_tails = ((struct sortstr *)
- xrealloc ((overlay_tails_len
- * sizeof (struct sortstr))));
- }
- }
- overlay_tails[ntail].string = str;
- overlay_tails[ntail].size = endpos - startpos;
- tem = Foverlay_get (overlay, Qpriority);
- overlay_tails[ntail].priority = (INTEGERP (tem) ? XINT (tem) : 0);
- ntail++;
- total += XSTRING (str)->size;
- }
- }
- if (startpos == pos)
- {
- str = Foverlay_get (overlay, Qbefore_string);
- if (STRINGP (str))
- {
- if (nhead == overlay_heads_len)
- {
- if (! overlay_heads)
- {
- overlay_heads_len = 5;
- overlay_heads = ((struct sortstr *)
- xmalloc (5 * sizeof (struct sortstr)));
- }
- else
- {
- overlay_heads_len *= 2;
- overlay_heads = ((struct sortstr *)
- xrealloc ((overlay_heads_len
- * sizeof (struct sortstr))));
- }
- }
- overlay_heads[nhead].string = str;
- overlay_heads[nhead].size = endpos - startpos;
- tem = Foverlay_get (overlay, Qpriority);
- overlay_heads[nhead].priority = (INTEGERP (tem) ? XINT (tem) : 0);
- nhead++;
- total += XSTRING (str)->size;
- }
- }
+ if (endpos != pos && startpos != pos)
+ continue;
+ window = Foverlay_get (overlay, Qwindow);
+ if (WINDOWP (window) && XWINDOW (window) != w)
+ continue;
+ if (startpos == pos
+ && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
+ record_overlay_string (&overlay_heads, str,
+ (startpos == endpos
+ ? Foverlay_get (overlay, Qafter_string)
+ : Qnil),
+ Foverlay_get (overlay, Qpriority),
+ endpos - startpos);
+ else if (endpos == pos
+ && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
+ record_overlay_string (&overlay_tails, str, Qnil,
+ Foverlay_get (overlay, Qpriority),
+ endpos - startpos);
}
- if (ntail > 1)
- qsort (overlay_tails, ntail, sizeof (struct sortstr), cmp_for_strings);
- if (nhead > 1)
- qsort (overlay_heads, nhead, sizeof (struct sortstr), cmp_for_strings);
- if (total)
+ if (overlay_tails.used > 1)
+ qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
+ cmp_for_strings);
+ if (overlay_heads.used > 1)
+ qsort (overlay_heads.buf, overlay_heads.used, sizeof (struct sortstr),
+ cmp_for_strings);
+ if (overlay_heads.bytes || overlay_tails.bytes)
{
+ Lisp_Object tem;
int i;
- char *p;
+ unsigned char *p;
+ int total = overlay_heads.bytes + overlay_tails.bytes;
if (total > overlay_str_len)
{
- if (! overlay_str_buf)
- overlay_str_buf = (char *)xmalloc (total);
- else
- overlay_str_buf = (char *)xrealloc (overlay_str_buf, total);
overlay_str_len = total;
+ overlay_str_buf = (unsigned char *)xrealloc (overlay_str_buf,
+ total);
}
p = overlay_str_buf;
- for (i = ntail; --i >= 0;)
+ for (i = overlay_tails.used; --i >= 0;)
{
- tem = overlay_tails[i].string;
- bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size);
- p += XSTRING (tem)->size;
+ int nbytes;
+ tem = overlay_tails.buf[i].string;
+ nbytes = copy_text (XSTRING (tem)->data, p,
+ STRING_BYTES (XSTRING (tem)),
+ STRING_MULTIBYTE (tem), multibyte);
+ p += nbytes;
}
- for (i = 0; i < nhead; ++i)
+ for (i = 0; i < overlay_heads.used; ++i)
{
- tem = overlay_heads[i].string;
- bcopy (XSTRING (tem)->data, p, XSTRING (tem)->size);
- p += XSTRING (tem)->size;
+ int nbytes;
+ tem = overlay_heads.buf[i].string;
+ nbytes = copy_text (XSTRING (tem)->data, p,
+ STRING_BYTES (XSTRING (tem)),
+ STRING_MULTIBYTE (tem), multibyte);
+ p += nbytes;
+ tem = overlay_heads.buf[i].string2;
+ if (STRINGP (tem))
+ {
+ nbytes = copy_text (XSTRING (tem)->data, p,
+ STRING_BYTES (XSTRING (tem)),
+ STRING_MULTIBYTE (tem), multibyte);
+ p += nbytes;
+ }
}
+ if (p != overlay_str_buf + total)
+ abort ();
if (pstr)
*pstr = overlay_str_buf;
+ return total;
}
- return total;
+ return 0;
}
\f
/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
if (startpos > endpos)
{
int tem;
- Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
- Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
+ Fset_marker (OVERLAY_START (overlay), make_number (endpos),
+ Qnil);
+ Fset_marker (OVERLAY_END (overlay), make_number (startpos),
+ Qnil);
tem = startpos; startpos = endpos; endpos = tem;
}
/* Add it to the end of the wrong list. Later on,
if (startpos > endpos)
{
int tem;
- Fset_marker (OVERLAY_START (overlay), endpos, Qnil);
- Fset_marker (OVERLAY_END (overlay), startpos, Qnil);
+ Fset_marker (OVERLAY_START (overlay), make_number (endpos),
+ Qnil);
+ Fset_marker (OVERLAY_END (overlay), make_number (startpos),
+ Qnil);
tem = startpos; startpos = endpos; endpos = tem;
}
if (endpos < XINT (current_buffer->overlay_center))
recenter_overlay_lists (current_buffer,
XINT (current_buffer->overlay_center));
}
+
+/* We have two types of overlay: the one whose ending marker is
+ after-insertion-marker (this is the usual case) and the one whose
+ ending marker is before-insertion-marker. When `overlays_before'
+ contains overlays of the latter type and the former type in this
+ order and both overlays end at inserting position, inserting a text
+ increases only the ending marker of the latter type, which results
+ in incorrect ordering of `overlays_before'.
+
+ This function fixes ordering of overlays in the slot
+ `overlays_before' of the buffer *BP. Before the insertion, `point'
+ was at PREV, and now is at POS. */
+
+void
+fix_overlays_before (bp, prev, pos)
+ struct buffer *bp;
+ int prev, pos;
+{
+ Lisp_Object *tailp = &bp->overlays_before;
+ Lisp_Object *right_place;
+ int end;
+
+ /* After the insertion, the several overlays may be in incorrect
+ order. The possibility is that, in the list `overlays_before',
+ an overlay which ends at POS appears after an overlay which ends
+ at PREV. Since POS is greater than PREV, we must fix the
+ ordering of these overlays, by moving overlays ends at POS before
+ the overlays ends at PREV. */
+
+ /* At first, find a place where disordered overlays should be linked
+ in. It is where an overlay which end before POS exists. (i.e. an
+ overlay whose ending marker is after-insertion-marker if disorder
+ exists). */
+ while (!NILP (*tailp)
+ && ((end = OVERLAY_POSITION (OVERLAY_END (XCONS (*tailp)->car)))
+ >= pos))
+ tailp = &XCONS (*tailp)->cdr;
+
+ /* If we don't find such an overlay,
+ or the found one ends before PREV,
+ or the found one is the last one in the list,
+ we don't have to fix anything. */
+ if (NILP (*tailp)
+ || end < prev
+ || NILP (XCONS (*tailp)->cdr))
+ return;
+
+ right_place = tailp;
+ tailp = &XCONS (*tailp)->cdr;
+
+ /* Now, end position of overlays in the list *TAILP should be before
+ or equal to PREV. In the loop, an overlay which ends at POS is
+ moved ahead to the place pointed by RIGHT_PLACE. If we found an
+ overlay which ends before PREV, the remaining overlays are in
+ correct order. */
+ while (!NILP (*tailp))
+ {
+ end = OVERLAY_POSITION (OVERLAY_END (XCONS (*tailp)->car));
+
+ if (end == pos)
+ { /* This overlay is disordered. */
+ Lisp_Object found = *tailp;
+
+ /* Unlink the found overlay. */
+ *tailp = XCONS (found)->cdr;
+ /* Move an overlay at RIGHT_PLACE to the next of the found one. */
+ XCONS (found)->cdr = *right_place;
+ /* Link it into the right place. */
+ *right_place = found;
+ }
+ else if (end == prev)
+ tailp = &XCONS (*tailp)->cdr;
+ else /* No more disordered overlay. */
+ break;
+ }
+}
\f
DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
"Return t if OBJECT is an overlay.")
return (OVERLAYP (object) ? Qt : Qnil);
}
-DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 3, 0,
+DEFUN ("make-overlay", Fmake_overlay, Smake_overlay, 2, 5, 0,
"Create a new overlay with range BEG to END in BUFFER.\n\
If omitted, BUFFER defaults to the current buffer.\n\
-BEG and END may be integers or markers.")
- (beg, end, buffer)
+BEG and END may be integers or markers.\n\
+The fourth arg FRONT-ADVANCE, if non-nil, makes the\n\
+front delimiter advance when text is inserted there.\n\
+The fifth arg REAR-ADVANCE, if non-nil, makes the\n\
+rear delimiter advance when text is inserted there.")
+ (beg, end, buffer, front_advance, rear_advance)
Lisp_Object beg, end, buffer;
+ Lisp_Object front_advance, rear_advance;
{
Lisp_Object overlay;
struct buffer *b;
beg = Fset_marker (Fmake_marker (), beg, buffer);
end = Fset_marker (Fmake_marker (), end, buffer);
+ if (!NILP (front_advance))
+ XMARKER (beg)->insertion_type = 1;
+ if (!NILP (rear_advance))
+ XMARKER (end)->insertion_type = 1;
+
overlay = allocate_misc ();
XMISCTYPE (overlay) = Lisp_Misc_Overlay;
XOVERLAY (overlay)->start = beg;
return overlay;
}
+\f
+/* Mark a section of BUF as needing redisplay because of overlays changes. */
+
+static void
+modify_overlay (buf, start, end)
+ struct buffer *buf;
+ int start, end;
+{
+ if (start == end)
+ return;
+
+ if (start > end)
+ {
+ int temp = start;
+ start = end; end = temp;
+ }
+
+ /* If this is a buffer not in the selected window,
+ we must do other windows. */
+ if (buf != XBUFFER (XWINDOW (selected_window)->buffer))
+ windows_or_buffers_changed = 1;
+ /* If it's not current, we can't use beg_unchanged, end_unchanged for it. */
+ else if (buf != current_buffer)
+ windows_or_buffers_changed = 1;
+ /* If multiple windows show this buffer, we must do other windows. */
+ else if (buffer_shared > 1)
+ windows_or_buffers_changed = 1;
+ else
+ {
+ if (unchanged_modified == MODIFF
+ && overlay_unchanged_modified == OVERLAY_MODIFF)
+ {
+ beg_unchanged = start - BEG;
+ end_unchanged = Z - end;
+ }
+ else
+ {
+ if (Z - end < end_unchanged)
+ end_unchanged = Z - end;
+ if (start - BEG < beg_unchanged)
+ beg_unchanged = start - BEG;
+ }
+ }
+
+ ++BUF_OVERLAY_MODIFF (buf);
+}
+
+\f\f
+Lisp_Object Fdelete_overlay ();
DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
"Set the endpoints of OVERLAY to BEG and END in BUFFER.\n\
/* Redisplay where the overlay was. */
if (!NILP (obuffer))
{
- Lisp_Object o_beg;
- Lisp_Object o_end;
+ int o_beg;
+ int o_end;
- o_beg = OVERLAY_START (overlay);
- o_end = OVERLAY_END (overlay);
- o_beg = OVERLAY_POSITION (o_beg);
- o_end = OVERLAY_POSITION (o_end);
+ o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
+ o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
- redisplay_region (ob, XINT (o_beg), XINT (o_end));
+ modify_overlay (ob, o_beg, o_end);
}
/* Redisplay where the overlay is going to be. */
- redisplay_region (b, XINT (beg), XINT (end));
-
- /* Don't limit redisplay to the selected window. */
- windows_or_buffers_changed = 1;
+ modify_overlay (b, XINT (beg), XINT (end));
}
else
/* Redisplay the area the overlay has just left, or just enclosed. */
{
- Lisp_Object o_beg;
- Lisp_Object o_end;
+ int o_beg, o_end;
int change_beg, change_end;
- o_beg = OVERLAY_START (overlay);
- o_end = OVERLAY_END (overlay);
- o_beg = OVERLAY_POSITION (o_beg);
- o_end = OVERLAY_POSITION (o_end);
+ o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
+ o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (XINT (o_beg) == XINT (beg))
- redisplay_region (b, XINT (o_end), XINT (end));
- else if (XINT (o_end) == XINT (end))
- redisplay_region (b, XINT (o_beg), XINT (beg));
+ if (o_beg == XINT (beg))
+ modify_overlay (b, o_end, XINT (end));
+ else if (o_end == XINT (end))
+ modify_overlay (b, o_beg, XINT (beg));
else
{
- if (XINT (beg) < XINT (o_beg)) o_beg = beg;
- if (XINT (end) > XINT (o_end)) o_end = end;
- redisplay_region (b, XINT (o_beg), XINT (o_end));
+ if (XINT (beg) < o_beg) o_beg = XINT (beg);
+ if (XINT (end) > o_end) o_end = XINT (end);
+ modify_overlay (b, o_beg, o_end);
}
}
b->overlays_before = Fdelq (overlay, b->overlays_before);
b->overlays_after = Fdelq (overlay, b->overlays_after);
- redisplay_region (b,
+ modify_overlay (b,
marker_position (OVERLAY_START (overlay)),
marker_position (OVERLAY_END (overlay)));
return result;
}
+DEFUN ("overlays-in", Foverlays_in, Soverlays_in, 2, 2, 0,
+ "Return a list of the overlays that overlap the region BEG ... END.\n\
+Overlap means that at least one character is contained within the overlay\n\
+and also contained within the specified region.\n\
+Empty overlays are included in the result if they are located at BEG\n\
+or between BEG and END.")
+ (beg, end)
+ Lisp_Object beg, end;
+{
+ int noverlays;
+ Lisp_Object *overlay_vec;
+ int len;
+ Lisp_Object result;
+
+ CHECK_NUMBER_COERCE_MARKER (beg, 0);
+ CHECK_NUMBER_COERCE_MARKER (end, 0);
+
+ len = 10;
+ overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+
+ /* Put all the overlays we want in a vector in overlay_vec.
+ Store the length in len. */
+ noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len,
+ (int *) 0, (int *) 0);
+
+ /* Make a list of them all. */
+ result = Flist (noverlays, overlay_vec);
+
+ xfree (overlay_vec);
+ return result;
+}
+
DEFUN ("next-overlay-change", Fnext_overlay_change, Snext_overlay_change,
1, 1, 0,
"Return the next position after POS where an overlay starts or ends.\n\
DEFUN ("previous-overlay-change", Fprevious_overlay_change,
Sprevious_overlay_change, 1, 1, 0,
"Return the previous position before POS where an overlay starts or ends.\n\
-If there are no more overlay boundaries after POS, return (point-min).")
+If there are no more overlay boundaries before POS, return (point-min).")
(pos)
Lisp_Object pos;
{
Lisp_Object *overlay_vec;
int len;
int i;
+ Lisp_Object tail;
CHECK_NUMBER_COERCE_MARKER (pos, 0);
len = 10;
overlay_vec = (Lisp_Object *) xmalloc (len * sizeof (Lisp_Object));
+ /* At beginning of buffer, we know the answer;
+ avoid bug subtracting 1 below. */
+ if (XINT (pos) == BEGV)
+ return pos;
+
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len.
prevpos gets the position of an overlay end. */
noverlays = overlays_at (XINT (pos), 1, &overlay_vec, &len,
(int *) 0, &prevpos);
- /* If any of these overlays starts before endpos,
+ /* If any of these overlays starts after prevpos,
maybe use its starting point instead. */
for (i = 0; i < noverlays; i++)
{
prevpos = ostartpos;
}
+ /* If any overlay ends at pos, consider its starting point too. */
+ for (tail = current_buffer->overlays_before;
+ GC_CONSP (tail);
+ tail = XCONS (tail)->cdr)
+ {
+ Lisp_Object overlay, ostart;
+ int ostartpos;
+
+ overlay = XCONS (tail)->car;
+
+ ostart = OVERLAY_START (overlay);
+ ostartpos = OVERLAY_POSITION (ostart);
+ if (ostartpos > prevpos && ostartpos < XINT (pos))
+ prevpos = ostartpos;
+ }
+
xfree (overlay_vec);
return make_number (prevpos);
}
}
\f
DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0,
- "Get the property of overlay OVERLAY with property name NAME.")
+ "Get the property of overlay OVERLAY with property name PROP.")
(overlay, prop)
Lisp_Object overlay, prop;
{
if (! NILP (buffer))
{
if (changed)
- redisplay_region (XBUFFER (buffer),
+ modify_overlay (XBUFFER (buffer),
marker_position (OVERLAY_START (overlay)),
marker_position (OVERLAY_END (overlay)));
if (EQ (prop, Qevaporate) && ! NILP (value)
return value;
}
\f
+/* Subroutine of report_overlay_modification. */
+
+/* Lisp vector holding overlay hook functions to call.
+ Vector elements come in pairs.
+ Each even-index element is a list of hook functions.
+ The following odd-index element is the overlay they came from.
+
+ Before the buffer change, we fill in this vector
+ as we call overlay hook functions.
+ After the buffer change, we get the functions to call from this vector.
+ This way we always call the same functions before and after the change. */
+static Lisp_Object last_overlay_modification_hooks;
+
+/* Number of elements actually used in last_overlay_modification_hooks. */
+static int last_overlay_modification_hooks_used;
+
+/* Add one functionlist/overlay pair
+ to the end of last_overlay_modification_hooks. */
+
+static void
+add_overlay_mod_hooklist (functionlist, overlay)
+ Lisp_Object functionlist, overlay;
+{
+ int oldsize = XVECTOR (last_overlay_modification_hooks)->size;
+
+ if (last_overlay_modification_hooks_used == oldsize)
+ {
+ Lisp_Object old;
+ old = last_overlay_modification_hooks;
+ last_overlay_modification_hooks
+ = Fmake_vector (make_number (oldsize * 2), Qnil);
+ bcopy (XVECTOR (old)->contents,
+ XVECTOR (last_overlay_modification_hooks)->contents,
+ sizeof (Lisp_Object) * oldsize);
+ }
+ XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = functionlist;
+ XVECTOR (last_overlay_modification_hooks)->contents[last_overlay_modification_hooks_used++] = overlay;
+}
+\f
/* Run the modification-hooks of overlays that include
any part of the text in START to END.
- Run the insert-before-hooks of overlay starting at END,
+ If this change is an insertion, also
+ run the insert-before-hooks of overlay starting at END,
and the insert-after-hooks of overlay ending at START.
This is called both before and after the modification.
AFTER is nonzero when we call after the modification.
- ARG1, ARG2, ARG3 are arguments to pass to the hook functions. */
+ ARG1, ARG2, ARG3 are arguments to pass to the hook functions.
+ When AFTER is nonzero, they are the start position,
+ the position after the inserted new text,
+ and the length of deleted or replaced old text. */
void
report_overlay_modification (start, end, after, arg1, arg2, arg3)
Lisp_Object arg1, arg2, arg3;
{
Lisp_Object prop, overlay, tail;
- int insertion = EQ (start, end);
+ /* 1 if this change is an insertion. */
+ int insertion = (after ? XFASTINT (arg3) == 0 : EQ (start, end));
int tail_copied;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
tail = Qnil;
GCPRO5 (overlay, tail, arg1, arg2, arg3);
+ if (after)
+ {
+ /* Call the functions recorded in last_overlay_modification_hooks
+ rather than scanning the overlays again.
+ First copy the vector contents, in case some of these hooks
+ do subsequent modification of the buffer. */
+ int size = last_overlay_modification_hooks_used;
+ Lisp_Object *copy = (Lisp_Object *) alloca (size * sizeof (Lisp_Object));
+ int i;
+
+ bcopy (XVECTOR (last_overlay_modification_hooks)->contents,
+ copy, size * sizeof (Lisp_Object));
+ gcpro1.var = copy;
+ gcpro1.nvars = size;
+
+ for (i = 0; i < size;)
+ {
+ Lisp_Object prop, overlay;
+ prop = copy[i++];
+ overlay = copy[i++];
+ call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
+ }
+ UNGCPRO;
+ return;
+ }
+
+ /* We are being called before a change.
+ Scan the overlays to find the functions to call. */
+ last_overlay_modification_hooks_used = 0;
tail_copied = 0;
for (tail = current_buffer->overlays_before;
CONSP (tail);
if (XFASTINT (start) > endpos)
break;
startpos = OVERLAY_POSITION (ostart);
- if (XFASTINT (end) == startpos && insertion)
+ if (insertion && (XFASTINT (start) == startpos
+ || XFASTINT (end) == startpos))
{
prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
if (!NILP (prop))
call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
}
}
- if (XFASTINT (start) == endpos && insertion)
+ if (insertion && (XFASTINT (start) == endpos
+ || XFASTINT (end) == endpos))
{
prop = Foverlay_get (overlay, Qinsert_behind_hooks);
if (!NILP (prop))
endpos = OVERLAY_POSITION (oend);
if (XFASTINT (end) < startpos)
break;
- if (XFASTINT (end) == startpos && insertion)
+ if (insertion && (XFASTINT (start) == startpos
+ || XFASTINT (end) == startpos))
{
prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
if (!NILP (prop))
call_overlay_mod_hooks (prop, overlay, after, arg1, arg2, arg3);
}
}
- if (XFASTINT (start) == endpos && insertion)
+ if (insertion && (XFASTINT (start) == endpos
+ || XFASTINT (end) == endpos))
{
prop = Foverlay_get (overlay, Qinsert_behind_hooks);
if (!NILP (prop))
Lisp_Object arg1, arg2, arg3;
{
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
GCPRO4 (list, arg1, arg2, arg3);
+ if (! after)
+ add_overlay_mod_hooklist (list, overlay);
+
while (!NILP (list))
{
if (NILP (arg3))
}
\f
/* Somebody has tried to store a value with an unacceptable type
- into the buffer-local slot with offset OFFSET. */
+ in the slot with offset OFFSET. */
+
void
buffer_slot_type_mismatch (offset)
int offset;
case Lisp_Int: type_name = "integers"; break;
case Lisp_String: type_name = "strings"; break;
case Lisp_Symbol: type_name = "symbols"; break;
+
default:
abort ();
}
- error ("only %s should be stored in the buffer-local variable %s",
+ error ("Only %s should be stored in the buffer-local variable %s",
type_name, XSYMBOL (sym)->name->data);
}
\f
+void
init_buffer_once ()
{
register Lisp_Object tem;
+ buffer_permanent_local_flags = 0;
+
/* Make sure all markable slots in buffer_defaults
are initialized reasonably, so mark_buffer won't choke. */
reset_buffer (&buffer_defaults);
- reset_buffer_local_variables (&buffer_defaults);
+ reset_buffer_local_variables (&buffer_defaults, 1);
reset_buffer (&buffer_local_symbols);
- reset_buffer_local_variables (&buffer_local_symbols);
+ reset_buffer_local_variables (&buffer_local_symbols, 1);
/* Prevent GC from getting confused. */
buffer_defaults.text = &buffer_defaults.own_text;
buffer_local_symbols.text = &buffer_local_symbols.own_text;
XSETFASTINT (buffer_defaults.tab_width, 8);
buffer_defaults.truncate_lines = Qnil;
buffer_defaults.ctl_arrow = Qt;
+ buffer_defaults.direction_reversed = Qnil;
#ifdef DOS_NT
buffer_defaults.buffer_file_type = Qnil; /* TEXT */
#endif
+ buffer_defaults.enable_multibyte_characters = Qt;
+ buffer_defaults.buffer_file_coding_system = Qnil;
XSETFASTINT (buffer_defaults.fill_column, 70);
XSETFASTINT (buffer_defaults.left_margin, 0);
buffer_defaults.cache_long_line_scans = Qnil;
buffer_defaults.file_truename = Qnil;
+ XSETFASTINT (buffer_defaults.display_count, 0);
/* Assign the local-flags to the slots that have default values.
The local flag is a bit that is used in the buffer
XSETINT (buffer_local_flags.point_before_scroll, -1);
XSETINT (buffer_local_flags.file_truename, -1);
XSETINT (buffer_local_flags.invisibility_spec, -1);
+ XSETINT (buffer_local_flags.file_format, -1);
+ XSETINT (buffer_local_flags.display_count, -1);
+ XSETINT (buffer_local_flags.enable_multibyte_characters, -1);
XSETFASTINT (buffer_local_flags.mode_line_format, 1);
XSETFASTINT (buffer_local_flags.abbrev_mode, 2);
XSETFASTINT (buffer_local_flags.left_margin, 0x800);
XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000);
XSETFASTINT (buffer_local_flags.display_table, 0x2000);
- XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
- XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
- XSETFASTINT (buffer_local_flags.file_format, 0x20000);
#ifdef DOS_NT
XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000);
+ /* Make this one a permanent local. */
+ buffer_permanent_local_flags |= 0x4000;
#endif
-
+ XSETFASTINT (buffer_local_flags.syntax_table, 0x8000);
+ XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000);
+ XSETFASTINT (buffer_local_flags.category_table, 0x20000);
+ XSETFASTINT (buffer_local_flags.direction_reversed, 0x40000);
+ XSETFASTINT (buffer_local_flags.buffer_file_coding_system, 0x80000);
+ /* Make this one a permanent local. */
+ buffer_permanent_local_flags |= 0x80000;
+
Vbuffer_alist = Qnil;
current_buffer = 0;
all_buffers = 0;
Qkill_buffer_hook = intern ("kill-buffer-hook");
Vprin1_to_string_buffer = Fget_buffer_create (build_string (" prin1"));
+
/* super-magic invisible buffer */
Vbuffer_alist = Qnil;
Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
}
+void
init_buffer ()
{
char buf[MAXPATHLEN+1];
int rc;
Fset_buffer (Fget_buffer_create (build_string ("*scratch*")));
+ if (NILP (buffer_defaults.enable_multibyte_characters))
+ Fset_buffer_multibyte (Qnil);
/* If PWD is accurate, use it instead of calling getwd. This is faster
when PWD is right, and may avoid a fatal error. */
&& dotstat.st_dev == pwdstat.st_dev
&& strlen (pwd) < MAXPATHLEN)
strcpy (buf, pwd);
+#ifdef HAVE_GETCWD
+ else if (getcwd (buf, MAXPATHLEN+1) == 0)
+ fatal ("`getcwd' failed: %s\n", strerror (errno));
+#else
else if (getwd (buf) == 0)
fatal ("`getwd' failed: %s\n", buf);
+#endif
#ifndef VMS
/* Maybe this should really use some standard subroutine
buf[rc + 1] = '\0';
}
#endif /* not VMS */
+
current_buffer->directory = build_string (buf);
+ /* Add /: to the front of the name
+ if it would otherwise be treated as magic. */
+ temp = Ffind_file_name_handler (current_buffer->directory, Qt);
+ if (! NILP (temp)
+ /* If the default dir is just /, TEMP is non-nil
+ because of the ange-ftp completion handler.
+ However, it is not necessary to turn / into /:/.
+ So avoid doing that. */
+ && strcmp ("/", XSTRING (current_buffer->directory)->data))
+ current_buffer->directory
+ = concat2 (build_string ("/:"), current_buffer->directory);
+
temp = get_minibuffer (0);
XBUFFER (temp)->directory = current_buffer->directory;
}
/* initialize the buffer routines */
+void
syms_of_buffer ()
{
extern Lisp_Object Qdisabled;
+ staticpro (&last_overlay_modification_hooks);
+ last_overlay_modification_hooks
+ = Fmake_vector (make_number (10), Qnil);
+
staticpro (&Vbuffer_defaults);
staticpro (&Vbuffer_local_symbols);
staticpro (&Qfundamental_mode);
staticpro (&Qprotected_field);
staticpro (&Qpermanent_local);
staticpro (&Qkill_buffer_hook);
+ Qoverlayp = intern ("overlayp");
staticpro (&Qoverlayp);
Qevaporate = intern ("evaporate");
staticpro (&Qevaporate);
- staticpro (&Qmodification_hooks);
Qmodification_hooks = intern ("modification-hooks");
- staticpro (&Qinsert_in_front_hooks);
+ staticpro (&Qmodification_hooks);
Qinsert_in_front_hooks = intern ("insert-in-front-hooks");
- staticpro (&Qinsert_behind_hooks);
+ staticpro (&Qinsert_in_front_hooks);
Qinsert_behind_hooks = intern ("insert-behind-hooks");
- staticpro (&Qget_file_buffer);
+ staticpro (&Qinsert_behind_hooks);
Qget_file_buffer = intern ("get-file-buffer");
+ staticpro (&Qget_file_buffer);
Qpriority = intern ("priority");
staticpro (&Qpriority);
Qwindow = intern ("window");
staticpro (&Qbefore_string);
Qafter_string = intern ("after-string");
staticpro (&Qafter_string);
-
- Qoverlayp = intern ("overlayp");
+ Qfirst_change_hook = intern ("first-change-hook");
+ staticpro (&Qfirst_change_hook);
+ Qbefore_change_functions = intern ("before-change-functions");
+ staticpro (&Qbefore_change_functions);
+ Qafter_change_functions = intern ("after-change-functions");
+ staticpro (&Qafter_change_functions);
Fput (Qprotected_field, Qerror_conditions,
Fcons (Qprotected_field, Fcons (Qerror, Qnil)));
"Default value of `ctl-arrow' for buffers that do not override it.\n\
This is the same as (default-value 'ctl-arrow).");
+ DEFVAR_LISP_NOPRO ("default-direction-reversed",
+ &buffer_defaults.direction_reversed,
+ "Default value of `direction_reversed' for buffers that do not override it.\n\
+ This is the same as (default-value 'direction-reversed).");
+
+ DEFVAR_LISP_NOPRO ("default-enable-multibyte-characters",
+ &buffer_defaults.enable_multibyte_characters,
+ "Default value of `enable-multibyte-characters' for buffers not overriding it.\n\
+ This is the same as (default-value 'enable-multibyte-characters).");
+
+ DEFVAR_LISP_NOPRO ("default-buffer-file-coding-system",
+ &buffer_defaults.buffer_file_coding_system,
+ "Default value of `buffer-file-coding-system' for buffers not overriding it.\n\
+ This is the same as (default-value 'buffer-file-coding-system).");
+
DEFVAR_LISP_NOPRO ("default-truncate-lines",
&buffer_defaults.truncate_lines,
"Default value of `truncate-lines' for buffers that do not override it.\n\
(%-constructs are allowed when the string is the entire mode-line-format\n\
or when it is found in a cons-cell or a list)\n\
%b -- print buffer name. %f -- print visited file name.\n\
+ %F -- print frame name.\n\
%* -- print %, * or hyphen. %+ -- print *, % or hyphen.\n\
% means buffer is read-only and * means it is modified.\n\
For a modified read-only buffer, %* gives % and %+ gives *.\n\
%s -- print process status. %l -- print the current line number.\n\
+ %c -- print the current column number (this makes editing slower).\n\
+ To make the column number update correctly in all cases,\n\
+ `column-number-mode' must be non-nil.\n\
%p -- print percent of buffer above top of window, or Top, Bot or All.\n\
%P -- print percent of buffer above bottom of window, perhaps plus Top,\n\
or print Bottom or All.\n\
%n -- print Narrow if appropriate.\n\
- %t -- print T if files is text, B if binary.\n\
+ %t -- print T if file is text, B if binary.\n\
%[ -- print one [ for each recursive editing level. %] similar.\n\
%% -- print %. %- -- print infinitely many dashes.\n\
Decimal digits after the % specify field width to which to pad.");
DEFVAR_PER_BUFFER ("ctl-arrow", ¤t_buffer->ctl_arrow, Qnil,
"*Non-nil means display control chars with uparrow.\n\
-Nil means use backslash and octal digits.\n\
+A value of nil means use backslash and octal digits.\n\
Automatically becomes buffer-local when set in any fashion.\n\
This variable does not apply to characters whose display is specified\n\
in the current display table (if there is one).");
+ DEFVAR_PER_BUFFER ("enable-multibyte-characters",
+ ¤t_buffer->enable_multibyte_characters,
+ make_number (-1),
+ "*Non-nil means the buffer contents are regarded as multi-byte form\n\
+of characters, not a binary code. This affects the display, file I/O,\n\
+and behaviors of various editing commands.");
+
+ DEFVAR_PER_BUFFER ("buffer-file-coding-system",
+ ¤t_buffer->buffer_file_coding_system, Qnil,
+ "Coding system to be used for encoding the buffer contents on saving.\n\
+If it is nil, the buffer is saved without any code conversion unless\n\
+some coding system is specified in file-coding-system-alist\n\
+for the buffer file.\n\
+\n\
+This variable is never applied to a way of decoding\n\
+a file while reading it.");
+
+ DEFVAR_PER_BUFFER ("direction-reversed", ¤t_buffer->direction_reversed,
+ Qnil,
+ "*Non-nil means lines in the buffer are displayed right to left.");
+
DEFVAR_PER_BUFFER ("truncate-lines", ¤t_buffer->truncate_lines, Qnil,
"*Non-nil means do not display continuation lines;\n\
give each line of text one screen line.\n\
DEFVAR_PER_BUFFER ("auto-fill-function", ¤t_buffer->auto_fill_function,
Qnil,
"Function called (if non-nil) to perform auto-fill.\n\
-It is called after self-inserting a space at a column beyond `fill-column'.\n\
+It is called after self-inserting a space or newline.\n\
Each buffer has its own value of this variable.\n\
-NOTE: This variable is not an ordinary hook;\n\
-It may not be a list of functions.");
+NOTE: This variable is not a hook;\n\
+its value may not be a list of functions.");
DEFVAR_PER_BUFFER ("buffer-file-name", ¤t_buffer->filename,
make_number (Lisp_String),
DEFVAR_PER_BUFFER ("buffer-file-truename", ¤t_buffer->file_truename,
make_number (Lisp_String),
- "Truename of file visited in current buffer, or nil if not visiting a file.\n\
+ "Abbreviated truename of file visited in current buffer, or nil if none.\n\
The truename of a file is calculated by `file-truename'\n\
and then abbreviated with `abbreviate-file-name'.\n\
Each buffer has its own value of this variable.");
Qnil,
"Display table that controls display of the contents of current buffer.\n\
Automatically becomes buffer-local when set in any fashion.\n\
-The display table is a vector created with `make-display-table'.\n\
-The first 256 elements control how to display each possible text character.\n\
-Each value should be a vector of characters or nil;\n\
+The display table is a char-table created with `make-display-table'.\n\
+The ordinary char-table elements control how to display each possible text\n\
+character. Each value should be a vector of characters or nil;\n\
nil means display the character in the default fashion.\n\
-The remaining six elements control the display of\n\
- the end of a truncated screen line (element 256, a single character);\n\
- the end of a continued line (element 257, a single character);\n\
+There are six extra slots to control the display of\n\
+ the end of a truncated screen line (extra-slot 0, a single character);\n\
+ the end of a continued line (extra-slot 1, a single character);\n\
the escape character used to display character codes in octal\n\
- (element 258, a single character);\n\
- the character used as an arrow for control characters (element 259,\n\
+ (extra-slot 2, a single character);\n\
+ the character used as an arrow for control characters (extra-slot 3,\n\
a single character);\n\
- the decoration indicating the presence of invisible lines (element 260,\n\
+ the decoration indicating the presence of invisible lines (extra-slot 4,\n\
a vector of characters);\n\
the character used to draw the border between side-by-side windows\n\
- (element 261, a single character).\n\
+ (extra-slot 5, a single character).\n\
+See also the functions `display-table-slot' and `set-display-table-slot'.\n\
If this variable is nil, the value of `standard-display-table' is used.\n\
Each window can have its own, overriding display table.");
#endif
"Don't ask.");
*/
DEFVAR_LISP ("before-change-function", &Vbefore_change_function,
- "Function to call before each text change.\n\
+ "If non-nil, a function to call before each text change (obsolete).\n\
Two arguments are passed to the function: the positions of\n\
the beginning and end of the range of old text to be changed.\n\
\(For an insertion, the beginning and end are at the same place.)\n\
That's because these variables are temporarily set to nil.\n\
As a result, a hook function cannot straightforwardly alter the value of\n\
these variables. See the Emacs Lisp manual for a way of\n\
-accomplishing an equivalent result by using other variables.");
+accomplishing an equivalent result by using other variables.\n\n\
+This variable is obsolete; use `before-change-functions' instead.");
Vbefore_change_function = Qnil;
DEFVAR_LISP ("after-change-function", &Vafter_change_function,
- "Function to call after each text change.\n\
+ "If non-nil, a Function to call after each text change (obsolete).\n\
Three arguments are passed to the function: the positions of\n\
the beginning and end of the range of changed text,\n\
and the length of the pre-change text replaced by that range.\n\
\(For an insertion, the pre-change length is zero;\n\
-for a deletion, that length is the number of characters deleted,\n\
+for a deletion, that length is the number of bytes deleted,\n\
and the post-change beginning and end are at the same place.)\n\
\n\
Buffer changes made while executing the `after-change-function'\n\
That's because these variables are temporarily set to nil.\n\
As a result, a hook function cannot straightforwardly alter the value of\n\
these variables. See the Emacs Lisp manual for a way of\n\
-accomplishing an equivalent result by using other variables.");
+accomplishing an equivalent result by using other variables.\n\n\
+This variable is obsolete; use `after-change-functions' instead.");
Vafter_change_function = Qnil;
DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions,
"List of function to call after each text change.\n\
Three arguments are passed to each function: the positions of\n\
the beginning and end of the range of changed text,\n\
-and the length of the pre-change text replaced by that range.\n\
+and the length in bytes of the pre-change text replaced by that range.\n\
\(For an insertion, the pre-change length is zero;\n\
-for a deletion, that length is the number of characters deleted,\n\
+for a deletion, that length is the number of bytes deleted,\n\
and the post-change beginning and end are at the same place.)\n\
\n\
Buffer changes made while executing the `after-change-functions'\n\
"A list of functions to call before changing a buffer which is unmodified.\n\
The functions are run using the `run-hooks' function.");
Vfirst_change_hook = Qnil;
- Qfirst_change_hook = intern ("first-change-hook");
- staticpro (&Qfirst_change_hook);
#if 0 /* The doc string is too long for some compilers,
but make-docfile can find it in this comment. */
"List of undo entries in current buffer.\n\
Recent changes come first; older changes follow newer.\n\
\n\
-An entry (START . END) represents an insertion which begins at\n\
-position START and ends at position END.\n\
+An entry (BEG . END) represents an insertion which begins at\n\
+position BEG and ends at position END.\n\
\n\
An entry (TEXT . POSITION) represents the deletion of the string TEXT\n\
from (abs POSITION). If POSITION is positive, point was at the front\n\
was modified between BEG and END. PROPERTY is the property name,\n\
and VALUE is the old value.\n\
\n\
+An entry (MARKER . DISTANCE) indicates that the marker MARKER\n\
+was adjusted in position by the offset DISTANCE (an integer).\n\
+\n\
An entry of the form POSITION indicates that point was at the buffer\n\
location given by the integer. Undoing an entry of this form places\n\
point at POSITION.\n\
then characters with property value PROP are invisible,\n\
and they have an ellipsis as well if ELLIPSIS is non-nil.");
+ DEFVAR_PER_BUFFER ("buffer-display-count",
+ ¤t_buffer->display_count, Qnil,
+ "A number incremented each time the buffer is displayed in a window.");
+
DEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode,
- "*Non-nil means deactivate the mark when the buffer contents change.");
+ "*Non-nil means deactivate the mark when the buffer contents change.\n\
+Non-nil also enables highlighting of the region whenever the mark is active.\n\
+The variable `highlight-nonselected-windows' controls whether to highlight\n\
+all windows or just the selected window.");
Vtransient_mark_mode = Qnil;
DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only,
"List of functions called with no args to query before killing a buffer.");
Vkill_buffer_query_functions = Qnil;
+ defsubr (&Sbuffer_live_p);
defsubr (&Sbuffer_list);
defsubr (&Sget_buffer);
defsubr (&Sget_file_buffer);
defsubr (&Sbuffer_disable_undo);
defsubr (&Sbuffer_enable_undo);
defsubr (&Skill_buffer);
- defsubr (&Serase_buffer);
defsubr (&Sset_buffer_major_mode);
defsubr (&Sswitch_to_buffer);
defsubr (&Spop_to_buffer);
defsubr (&Sset_buffer);
defsubr (&Sbarf_if_buffer_read_only);
defsubr (&Sbury_buffer);
+ defsubr (&Serase_buffer);
+ defsubr (&Sset_buffer_multibyte);
defsubr (&Skill_all_local_variables);
defsubr (&Soverlayp);
defsubr (&Soverlay_buffer);
defsubr (&Soverlay_properties);
defsubr (&Soverlays_at);
+ defsubr (&Soverlays_in);
defsubr (&Snext_overlay_change);
defsubr (&Sprevious_overlay_change);
defsubr (&Soverlay_recenter);
defsubr (&Soverlay_put);
}
+void
keys_of_buffer ()
{
initial_define_key (control_x_map, 'b', "switch-to-buffer");
HCoop / bpt / emacs.git / blobdiff