GNU Emacs 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 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
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 "config.h"
+#include <config.h>
#include "lisp.h"
#include "buffer.h"
CHECK_MARKER (marker, 0);
if (XMARKER (marker)->buffer)
{
- XSET (buf, Lisp_Buffer, XMARKER (marker)->buffer);
+ XSETBUFFER (buf, XMARKER (marker)->buffer);
/* Return marker's buffer only if it is not dead. */
- if (!NULL (XBUFFER (buf)->name))
+ if (!NILP (XBUFFER (buf)->name))
return buf;
}
return Qnil;
if (i < BUF_BEG (buf) || i > BUF_Z (buf))
abort ();
- XFASTINT (pos) = i;
+ XSETFASTINT (pos, i);
return pos;
}
return Qnil;
}
-
+\f
DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
- "Position MARKER before character number NUMBER in BUFFER.\n\
+ "Position MARKER before character number POSITION in BUFFER.\n\
BUFFER defaults to the current buffer.\n\
-If NUMBER is nil, makes marker point nowhere.\n\
+If POSITION is nil, makes marker point nowhere.\n\
Then it no longer slows down editing in any buffer.\n\
Returns MARKER.")
- (marker, pos, buffer)
- Lisp_Object marker, pos, buffer;
+ (marker, position, buffer)
+ Lisp_Object marker, position, buffer;
{
register int charno;
register struct buffer *b;
CHECK_MARKER (marker, 0);
/* If position is nil or a marker that points nowhere,
make this marker point nowhere. */
- if (NULL (pos)
- || (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
+ if (NILP (position)
+ || (MARKERP (position) && !XMARKER (position)->buffer))
{
unchain_marker (marker);
return marker;
}
- CHECK_NUMBER_COERCE_MARKER (pos, 1);
- if (NULL (buffer))
+ CHECK_NUMBER_COERCE_MARKER (position, 1);
+ if (NILP (buffer))
b = current_buffer;
else
{
}
}
- charno = XINT (pos);
+ charno = XINT (position);
m = XMARKER (marker);
if (charno < BUF_BEG (b))
if (m->buffer != b)
{
unchain_marker (marker);
- m->chain = b->markers;
- b->markers = marker;
m->buffer = b;
+ m->chain = BUF_MARKERS (b);
+ BUF_MARKERS (b) = marker;
}
return marker;
CHECK_MARKER (marker, 0);
/* If position is nil or a marker that points nowhere,
make this marker point nowhere. */
- if (NULL (pos) ||
- (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
+ if (NILP (pos) ||
+ (MARKERP (pos) && !XMARKER (pos)->buffer))
{
unchain_marker (marker);
return marker;
}
CHECK_NUMBER_COERCE_MARKER (pos, 1);
- if (NULL (buffer))
+ if (NILP (buffer))
b = current_buffer;
else
{
if (m->buffer != b)
{
unchain_marker (marker);
- m->chain = b->markers;
- b->markers = marker;
m->buffer = b;
+ m->chain = BUF_MARKERS (b);
+ BUF_MARKERS (b) = marker;
}
return marker;
register Lisp_Object marker;
{
register Lisp_Object tail, prev, next;
- register int omark;
+ register EMACS_INT omark;
register struct buffer *b;
b = XMARKER (marker)->buffer;
if (EQ (b->name, Qnil))
abort ();
- tail = b->markers;
+ tail = BUF_MARKERS (b);
prev = Qnil;
while (XSYMBOL (tail) != XSYMBOL (Qnil))
{
if (XMARKER (marker) == XMARKER (tail))
{
- if (NULL (prev))
+ if (NILP (prev))
{
- b->markers = next;
- /* Deleting first marker from the buffer's chain.
- Crash if new first marker in chain does not say
- it belongs to this buffer. */
- if (!EQ (next, Qnil) && b != XMARKER (next)->buffer)
+ BUF_MARKERS (b) = next;
+ /* Deleting first marker from the buffer's chain. Crash
+ if new first marker in chain does not say it belongs
+ to the same buffer, or at least that they have the same
+ base buffer. */
+ if (!NILP (next) && b->text != XMARKER (next)->buffer->text)
abort ();
}
else
XMARKER (marker)->buffer = 0;
}
+/* Return the buffer position of marker MARKER, as a C integer. */
+
+int
marker_position (marker)
Lisp_Object marker;
{
return i;
}
-
-DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
+\f
+DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
"Return a new marker pointing at the same place as MARKER.\n\
If argument is a number, makes a new marker pointing\n\
-at that position in the current buffer.")
- (marker)
- register Lisp_Object marker;
+at that position in the current buffer.\n\
+The optional argument TYPE specifies the insertion type of the new marker;\n\
+see `marker-insertion-type'.")
+ (marker, type)
+ register Lisp_Object marker, type;
{
register Lisp_Object new;
- while (1)
+ if (INTEGERP (marker) || MARKERP (marker))
{
- if (XTYPE (marker) == Lisp_Int
- || XTYPE (marker) == Lisp_Marker)
- {
- new = Fmake_marker ();
- Fset_marker (new, marker,
- ((XTYPE (marker) == Lisp_Marker)
- ? Fmarker_buffer (marker)
- : Qnil));
- return new;
- }
- else
- marker = wrong_type_argument (Qinteger_or_marker_p, marker);
+ 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);
+}
+
+DEFUN ("marker-insertion-type", Fmarker_insertion_type,
+ Smarker_insertion_type, 1, 1, 0,
+ "Return insertion type of MARKER: t if it stays after inserted text.\n\
+nil means the marker stays before text inserted there.")
+ (marker)
+ register Lisp_Object marker;
+{
+ register Lisp_Object buf;
+ CHECK_MARKER (marker, 0);
+ return XMARKER (marker)->insertion_type ? Qt : Qnil;
+}
+
+DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
+ Sset_marker_insertion_type, 2, 2, 0,
+ "Set the insertion-type of MARKER to TYPE.\n\
+If TYPE is t, it means the marker advances when you insert text at it.\n\
+If TYPE is nil, it means the marker stays behind when you insert text at it.")
+ (marker, type)
+ Lisp_Object marker, type;
+{
+ CHECK_MARKER (marker, 0);
+
+ XMARKER (marker)->insertion_type = ! NILP (type);
+ return type;
+}
+
+DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
+ 1, 1, 0,
+ "Return t if there are markers pointing at POSITION in the currentbuffer.")
+ (position)
+ Lisp_Object position;
+{
+ register Lisp_Object tail;
+ register int charno;
+
+ charno = XINT (position);
+
+ if (charno < BEG)
+ charno = BEG;
+ if (charno > Z)
+ charno = Z;
+ if (charno > GPT) charno += GAP_SIZE;
+
+ for (tail = BUF_MARKERS (current_buffer);
+ XSYMBOL (tail) != XSYMBOL (Qnil);
+ tail = XMARKER (tail)->chain)
+ if (XMARKER (tail)->bufpos == charno)
+ return Qt;
+
+ return Qnil;
}
\f
syms_of_marker ()
defsubr (&Smarker_buffer);
defsubr (&Sset_marker);
defsubr (&Scopy_marker);
+ defsubr (&Smarker_insertion_type);
+ defsubr (&Sset_marker_insertion_type);
+ defsubr (&Sbuffer_has_markers_at);
}