[bpt/emacs.git] / src / marker.c

/* Markers: examining, setting and killing.
   Copyright (C) 1985 Free Software Foundation, Inc.

This file is part of GNU Emacs.

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 2, or (at your option)
any later version.

GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */


#include <config.h>
#include "lisp.h"
#include "buffer.h"

/* Operations on markers. */

DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
  "Return the buffer that MARKER points into, or nil if none.\n\
Returns nil if MARKER points into a dead buffer.")
  (marker)
     register Lisp_Object marker;
{
  register Lisp_Object buf;
  CHECK_MARKER (marker, 0);
  if (XMARKER (marker)->buffer)
    {
      XSETBUFFER (buf, XMARKER (marker)->buffer);
      /* Return marker's buffer only if it is not dead.  */
      if (!NILP (XBUFFER (buf)->name))
	return buf;
    }
  return Qnil;
}

DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
  "Return the position MARKER points at, as a character number.")
  (marker)
     Lisp_Object marker;
{
  register Lisp_Object pos;
  register int i;
  register struct buffer *buf;

  CHECK_MARKER (marker, 0);
  if (XMARKER (marker)->buffer)
    {
      buf = XMARKER (marker)->buffer;
      i = XMARKER (marker)->bufpos;

      if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
	i -= BUF_GAP_SIZE (buf);
      else if (i > BUF_GPT (buf))
	i = BUF_GPT (buf);

      if (i < BUF_BEG (buf) || i > BUF_Z (buf))
	abort ();

      XSETFASTINT (pos, i);
      return pos;
    }
  return Qnil;
}
\f
DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
  "Position MARKER before character number POSITION in BUFFER.\n\
BUFFER defaults to the current buffer.\n\
If POSITION is nil, makes marker point nowhere.\n\
Then it no longer slows down editing in any buffer.\n\
Returns MARKER.")
  (marker, position, buffer)
     Lisp_Object marker, position, buffer;
{
  register int charno;
  register struct buffer *b;
  register struct Lisp_Marker *m;

  CHECK_MARKER (marker, 0);
  /* If position is nil or a marker that points nowhere,
     make this marker point nowhere.  */
  if (NILP (position)
      || (MARKERP (position) && !XMARKER (position)->buffer))
    {
      unchain_marker (marker);
      return marker;
    }

  CHECK_NUMBER_COERCE_MARKER (position, 1);
  if (NILP (buffer))
    b = current_buffer;
  else
    {
      CHECK_BUFFER (buffer, 1);
      b = XBUFFER (buffer);
      /* If buffer is dead, set marker to point nowhere.  */
      if (EQ (b->name, Qnil))
	{
	  unchain_marker (marker);
	  return marker;
	}
    }

  charno = XINT (position);
  m = XMARKER (marker);

  if (charno < BUF_BEG (b))
    charno = BUF_BEG (b);
  if (charno > BUF_Z (b))
    charno = BUF_Z (b);
  if (charno > BUF_GPT (b)) charno += BUF_GAP_SIZE (b);
  m->bufpos = charno;

  if (m->buffer != b)
    {
      unchain_marker (marker);
      m->buffer = b;
      m->chain = BUF_MARKERS (b);
      BUF_MARKERS (b) = marker;
    }
  
  return marker;
}

/* This version of Fset_marker won't let the position
   be outside the visible part.  */

Lisp_Object 
set_marker_restricted (marker, pos, buffer)
     Lisp_Object marker, pos, buffer;
{
  register int charno;
  register struct buffer *b;
  register struct Lisp_Marker *m;

  CHECK_MARKER (marker, 0);
  /* If position is nil or a marker that points nowhere,
     make this marker point nowhere.  */
  if (NILP (pos) ||
      (MARKERP (pos) && !XMARKER (pos)->buffer))
    {
      unchain_marker (marker);
      return marker;
    }

  CHECK_NUMBER_COERCE_MARKER (pos, 1);
  if (NILP (buffer))
    b = current_buffer;
  else
    {
      CHECK_BUFFER (buffer, 1);
      b = XBUFFER (buffer);
      /* If buffer is dead, set marker to point nowhere.  */
      if (EQ (b->name, Qnil))
	{
	  unchain_marker (marker);
	  return marker;
	}
    }

  charno = XINT (pos);
  m = XMARKER (marker);

  if (charno < BUF_BEGV (b))
    charno = BUF_BEGV (b);
  if (charno > BUF_ZV (b))
    charno = BUF_ZV (b);
  if (charno > BUF_GPT (b))
    charno += BUF_GAP_SIZE (b);
  m->bufpos = charno;

  if (m->buffer != b)
    {
      unchain_marker (marker);
      m->buffer = b;
      m->chain = BUF_MARKERS (b);
      BUF_MARKERS (b) = marker;
    }
  
  return marker;
}

/* This is called during garbage collection,
   so we must be careful to ignore and preserve mark bits,
   including those in chain fields of markers.  */

unchain_marker (marker)
     register Lisp_Object marker;
{
  register Lisp_Object tail, prev, next;
  register EMACS_INT omark;
  register struct buffer *b;

  b = XMARKER (marker)->buffer;
  if (b == 0)
    return;

  if (EQ (b->name, Qnil))
    abort ();

  tail = BUF_MARKERS (b);
  prev = Qnil;
  while (XSYMBOL (tail) != XSYMBOL (Qnil))
    {
      next = XMARKER (tail)->chain;
      XUNMARK (next);

      if (XMARKER (marker) == XMARKER (tail))
	{
	  if (NILP (prev))
	    {
	      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
	    {
	      omark = XMARKBIT (XMARKER (prev)->chain);
	      XMARKER (prev)->chain = next;
	      XSETMARKBIT (XMARKER (prev)->chain, omark);
	    }
	  break;
	}
      else
	prev = tail;
      tail = next;
    }
  XMARKER (marker)->buffer = 0;
}

/* Return the buffer position of marker MARKER, as a C integer.  */

int
marker_position (marker)
     Lisp_Object marker;
{
  register struct Lisp_Marker *m = XMARKER (marker);
  register struct buffer *buf = m->buffer;
  register int i = m->bufpos;

  if (!buf)
    error ("Marker does not point anywhere");

  if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
    i -= BUF_GAP_SIZE (buf);
  else if (i > BUF_GPT (buf))
    i = BUF_GPT (buf);

  if (i < BUF_BEG (buf) || i > BUF_Z (buf))
    abort ();

  return i;
}
\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.\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;

  if (INTEGERP (marker) || MARKERP (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_position);
  defsubr (&Smarker_buffer);
  defsubr (&Sset_marker);
  defsubr (&Scopy_marker);
  defsubr (&Smarker_insertion_type);
  defsubr (&Sset_marker_insertion_type);
  defsubr (&Sbuffer_has_markers_at);
}
Commit	Line	Data
dcfdbac7 JB	1	/* Markers: examining, setting and killing.
	2	Copyright (C) 1985 Free Software Foundation, Inc.
	3
	4	This file is part of GNU Emacs.
	5
	6	GNU Emacs is free software; you can redistribute it and/or modify
	7	it under the terms of the GNU General Public License as published by
7c938215	8	the Free Software Foundation; either version 2, or (at your option)
dcfdbac7 JB	9	any later version.
	10
	11	GNU Emacs is distributed in the hope that it will be useful,
	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
	15
	16	You should have received a copy of the GNU General Public License
	17	along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313 EN	18	the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3b7ad313 EN	19	Boston, MA 02111-1307, USA. */
dcfdbac7 JB	20
dcfdbac7 JB	21
18160b98	22	#include <config.h>
dcfdbac7 JB	23	#include "lisp.h"
	24	#include "buffer.h"
	25
	26	/* Operations on markers. */
	27
	28	DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
	29	"Return the buffer that MARKER points into, or nil if none.\n\
	30	Returns nil if MARKER points into a dead buffer.")
	31	(marker)
	32	register Lisp_Object marker;
	33	{
	34	register Lisp_Object buf;
	35	CHECK_MARKER (marker, 0);
	36	if (XMARKER (marker)->buffer)
	37	{
0e11d869	38	XSETBUFFER (buf, XMARKER (marker)->buffer);
dcfdbac7	39	/* Return marker's buffer only if it is not dead. */
d427b66a	40	if (!NILP (XBUFFER (buf)->name))
dcfdbac7 JB	41	return buf;
	42	}
	43	return Qnil;
	44	}
	45
	46	DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
	47	"Return the position MARKER points at, as a character number.")
	48	(marker)
	49	Lisp_Object marker;
	50	{
	51	register Lisp_Object pos;
	52	register int i;
	53	register struct buffer *buf;
	54
	55	CHECK_MARKER (marker, 0);
	56	if (XMARKER (marker)->buffer)
	57	{
	58	buf = XMARKER (marker)->buffer;
	59	i = XMARKER (marker)->bufpos;
	60
	61	if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
	62	i -= BUF_GAP_SIZE (buf);
	63	else if (i > BUF_GPT (buf))
	64	i = BUF_GPT (buf);
	65
	66	if (i < BUF_BEG (buf) \|\| i > BUF_Z (buf))
	67	abort ();
	68
c5802b21	69	XSETFASTINT (pos, i);
dcfdbac7 JB	70	return pos;
	71	}
	72	return Qnil;
	73	}
fc299663	74	\f
dcfdbac7	75	DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
9be191c9	76	"Position MARKER before character number POSITION in BUFFER.\n\
dcfdbac7	77	BUFFER defaults to the current buffer.\n\
9be191c9	78	If POSITION is nil, makes marker point nowhere.\n\
dcfdbac7 JB	79	Then it no longer slows down editing in any buffer.\n\
dcfdbac7 JB	80	Returns MARKER.")
9be191c9 EN	81	(marker, position, buffer)
9be191c9 EN	82	Lisp_Object marker, position, buffer;
dcfdbac7 JB	83	{
	84	register int charno;
	85	register struct buffer *b;
	86	register struct Lisp_Marker *m;
	87
	88	CHECK_MARKER (marker, 0);
	89	/* If position is nil or a marker that points nowhere,
	90	make this marker point nowhere. */
9be191c9 EN	91	if (NILP (position)
9be191c9 EN	92	\|\| (MARKERP (position) && !XMARKER (position)->buffer))
dcfdbac7 JB	93	{
	94	unchain_marker (marker);
	95	return marker;
	96	}
	97
9be191c9	98	CHECK_NUMBER_COERCE_MARKER (position, 1);
d427b66a	99	if (NILP (buffer))
dcfdbac7 JB	100	b = current_buffer;
	101	else
	102	{
	103	CHECK_BUFFER (buffer, 1);
	104	b = XBUFFER (buffer);
	105	/* If buffer is dead, set marker to point nowhere. */
	106	if (EQ (b->name, Qnil))
	107	{
	108	unchain_marker (marker);
	109	return marker;
	110	}
	111	}
	112
9be191c9	113	charno = XINT (position);
dcfdbac7 JB	114	m = XMARKER (marker);
	115
	116	if (charno < BUF_BEG (b))
	117	charno = BUF_BEG (b);
	118	if (charno > BUF_Z (b))
	119	charno = BUF_Z (b);
	120	if (charno > BUF_GPT (b)) charno += BUF_GAP_SIZE (b);
	121	m->bufpos = charno;
	122
	123	if (m->buffer != b)
	124	{
	125	unchain_marker (marker);
dcfdbac7	126	m->buffer = b;
d281a86a RS	127	m->chain = BUF_MARKERS (b);
d281a86a RS	128	BUF_MARKERS (b) = marker;
dcfdbac7 JB	129	}
	130
	131	return marker;
	132	}
	133
	134	/* This version of Fset_marker won't let the position
	135	be outside the visible part. */
	136
	137	Lisp_Object
	138	set_marker_restricted (marker, pos, buffer)
	139	Lisp_Object marker, pos, buffer;
	140	{
	141	register int charno;
	142	register struct buffer *b;
	143	register struct Lisp_Marker *m;
	144
	145	CHECK_MARKER (marker, 0);
	146	/* If position is nil or a marker that points nowhere,
	147	make this marker point nowhere. */
d427b66a	148	if (NILP (pos) \|\|
e8e68e49	149	(MARKERP (pos) && !XMARKER (pos)->buffer))
dcfdbac7 JB	150	{
	151	unchain_marker (marker);
	152	return marker;
	153	}
	154
	155	CHECK_NUMBER_COERCE_MARKER (pos, 1);
d427b66a	156	if (NILP (buffer))
dcfdbac7 JB	157	b = current_buffer;
	158	else
	159	{
	160	CHECK_BUFFER (buffer, 1);
	161	b = XBUFFER (buffer);
	162	/* If buffer is dead, set marker to point nowhere. */
	163	if (EQ (b->name, Qnil))
	164	{
	165	unchain_marker (marker);
	166	return marker;
	167	}
	168	}
	169
	170	charno = XINT (pos);
	171	m = XMARKER (marker);
	172
	173	if (charno < BUF_BEGV (b))
	174	charno = BUF_BEGV (b);
	175	if (charno > BUF_ZV (b))
	176	charno = BUF_ZV (b);
	177	if (charno > BUF_GPT (b))
	178	charno += BUF_GAP_SIZE (b);
	179	m->bufpos = charno;
	180
	181	if (m->buffer != b)
	182	{
	183	unchain_marker (marker);
dcfdbac7	184	m->buffer = b;
d281a86a RS	185	m->chain = BUF_MARKERS (b);
d281a86a RS	186	BUF_MARKERS (b) = marker;
dcfdbac7 JB	187	}
	188
	189	return marker;
	190	}
	191
	192	/* This is called during garbage collection,
	193	so we must be careful to ignore and preserve mark bits,
	194	including those in chain fields of markers. */
	195
	196	unchain_marker (marker)
	197	register Lisp_Object marker;
	198	{
	199	register Lisp_Object tail, prev, next;
609b3978	200	register EMACS_INT omark;
dcfdbac7 JB	201	register struct buffer *b;
	202
	203	b = XMARKER (marker)->buffer;
	204	if (b == 0)
	205	return;
	206
	207	if (EQ (b->name, Qnil))
	208	abort ();
	209
d281a86a	210	tail = BUF_MARKERS (b);
dcfdbac7 JB	211	prev = Qnil;
	212	while (XSYMBOL (tail) != XSYMBOL (Qnil))
	213	{
	214	next = XMARKER (tail)->chain;
	215	XUNMARK (next);
	216
	217	if (XMARKER (marker) == XMARKER (tail))
	218	{
d427b66a	219	if (NILP (prev))
dcfdbac7	220	{
d281a86a RS	221	BUF_MARKERS (b) = next;
	222	/* Deleting first marker from the buffer's chain. Crash
	223	if new first marker in chain does not say it belongs
3686a8de RS	224	to the same buffer, or at least that they have the same
	225	base buffer. */
	226	if (!NILP (next) && b->text != XMARKER (next)->buffer->text)
dcfdbac7 JB	227	abort ();
	228	}
	229	else
	230	{
	231	omark = XMARKBIT (XMARKER (prev)->chain);
	232	XMARKER (prev)->chain = next;
	233	XSETMARKBIT (XMARKER (prev)->chain, omark);
	234	}
	235	break;
	236	}
	237	else
	238	prev = tail;
	239	tail = next;
	240	}
	241	XMARKER (marker)->buffer = 0;
	242	}
	243
d281a86a RS	244	/* Return the buffer position of marker MARKER, as a C integer. */
	245
	246	int
dcfdbac7 JB	247	marker_position (marker)
	248	Lisp_Object marker;
	249	{
	250	register struct Lisp_Marker *m = XMARKER (marker);
	251	register struct buffer *buf = m->buffer;
	252	register int i = m->bufpos;
	253
	254	if (!buf)
	255	error ("Marker does not point anywhere");
	256
	257	if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
	258	i -= BUF_GAP_SIZE (buf);
	259	else if (i > BUF_GPT (buf))
	260	i = BUF_GPT (buf);
	261
	262	if (i < BUF_BEG (buf) \|\| i > BUF_Z (buf))
	263	abort ();
	264
	265	return i;
	266	}
fc299663 RS	267	\f
fc299663 RS	268	DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
dcfdbac7 JB	269	"Return a new marker pointing at the same place as MARKER.\n\
dcfdbac7 JB	270	If argument is a number, makes a new marker pointing\n\
fc299663 RS	271	at that position in the current buffer.\n\
	272	The optional argument TYPE specifies the insertion type of the new marker;\n\
	273	see `marker-insertion-type'.")
	274	(marker, type)
	275	register Lisp_Object marker, type;
dcfdbac7 JB	276	{
	277	register Lisp_Object new;
	278
fc299663	279	if (INTEGERP (marker) \|\| MARKERP (marker))
dcfdbac7	280	{
fc299663 RS	281	new = Fmake_marker ();
	282	Fset_marker (new, marker,
	283	(MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
	284	XMARKER (new)->insertion_type = !NILP (type);
	285	return new;
dcfdbac7	286	}
fc299663 RS	287	else
	288	marker = wrong_type_argument (Qinteger_or_marker_p, marker);
	289	}
	290
	291	DEFUN ("marker-insertion-type", Fmarker_insertion_type,
	292	Smarker_insertion_type, 1, 1, 0,
	293	"Return insertion type of MARKER: t if it stays after inserted text.\n\
	294	nil means the marker stays before text inserted there.")
	295	(marker)
	296	register Lisp_Object marker;
	297	{
	298	register Lisp_Object buf;
	299	CHECK_MARKER (marker, 0);
	300	return XMARKER (marker)->insertion_type ? Qt : Qnil;
	301	}
	302
	303	DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
	304	Sset_marker_insertion_type, 2, 2, 0,
	305	"Set the insertion-type of MARKER to TYPE.\n\
	306	If TYPE is t, it means the marker advances when you insert text at it.\n\
efa9a160	307	If TYPE is nil, it means the marker stays behind when you insert text at it.")
fc299663 RS	308	(marker, type)
	309	Lisp_Object marker, type;
	310	{
	311	CHECK_MARKER (marker, 0);
	312
	313	XMARKER (marker)->insertion_type = ! NILP (type);
	314	return type;
dcfdbac7	315	}
9e5896c6 RS	316
	317	DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
	318	1, 1, 0,
	319	"Return t if there are markers pointing at POSITION in the currentbuffer.")
	320	(position)
	321	Lisp_Object position;
	322	{
	323	register Lisp_Object tail;
	324	register int charno;
	325
	326	charno = XINT (position);
	327
	328	if (charno < BEG)
	329	charno = BEG;
	330	if (charno > Z)
	331	charno = Z;
	332	if (charno > GPT) charno += GAP_SIZE;
	333
	334	for (tail = BUF_MARKERS (current_buffer);
	335	XSYMBOL (tail) != XSYMBOL (Qnil);
	336	tail = XMARKER (tail)->chain)
	337	if (XMARKER (tail)->bufpos == charno)
	338	return Qt;
	339
	340	return Qnil;
	341	}
dcfdbac7 JB	342	\f
	343	syms_of_marker ()
	344	{
	345	defsubr (&Smarker_position);
	346	defsubr (&Smarker_buffer);
	347	defsubr (&Sset_marker);
	348	defsubr (&Scopy_marker);
fc299663 RS	349	defsubr (&Smarker_insertion_type);
fc299663 RS	350	defsubr (&Sset_marker_insertion_type);
9e5896c6	351	defsubr (&Sbuffer_has_markers_at);
dcfdbac7	352	}