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