*** empty log message ***
[emacs.git] / src / marker.c
blob6c26e72fae4737431b6126d3f5ecaa932f905350
1 /* Markers: examining, setting and killing.
2 Copyright (C) 1985 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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
8 the Free Software Foundation; either version 1, or (at your option)
9 any later version.
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.
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. */
21 #include "config.h"
22 #include "lisp.h"
23 #include "buffer.h"
25 /* Operations on markers. */
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;
33 register Lisp_Object buf;
34 CHECK_MARKER (marker, 0);
35 if (XMARKER (marker)->buffer)
37 XSET (buf, Lisp_Buffer, XMARKER (marker)->buffer);
38 /* Return marker's buffer only if it is not dead. */
39 if (!NILP (XBUFFER (buf)->name))
40 return buf;
42 return Qnil;
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;
50 register Lisp_Object pos;
51 register int i;
52 register struct buffer *buf;
54 CHECK_MARKER (marker, 0);
55 if (XMARKER (marker)->buffer)
57 buf = XMARKER (marker)->buffer;
58 i = XMARKER (marker)->bufpos;
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);
65 if (i < BUF_BEG (buf) || i > BUF_Z (buf))
66 abort ();
68 XFASTINT (pos) = i;
69 return pos;
71 return Qnil;
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;
83 register int charno;
84 register struct buffer *b;
85 register struct Lisp_Marker *m;
87 CHECK_MARKER (marker, 0);
88 /* If position is nil or a marker that points nowhere,
89 make this marker point nowhere. */
90 if (NILP (pos)
91 || (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
93 unchain_marker (marker);
94 return marker;
97 CHECK_NUMBER_COERCE_MARKER (pos, 1);
98 if (NILP (buffer))
99 b = current_buffer;
100 else
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))
107 unchain_marker (marker);
108 return marker;
112 charno = XINT (pos);
113 m = XMARKER (marker);
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;
122 if (m->buffer != b)
124 unchain_marker (marker);
125 m->chain = b->markers;
126 b->markers = marker;
127 m->buffer = b;
130 return marker;
133 /* This version of Fset_marker won't let the position
134 be outside the visible part. */
136 Lisp_Object
137 set_marker_restricted (marker, pos, buffer)
138 Lisp_Object marker, pos, buffer;
140 register int charno;
141 register struct buffer *b;
142 register struct Lisp_Marker *m;
144 CHECK_MARKER (marker, 0);
145 /* If position is nil or a marker that points nowhere,
146 make this marker point nowhere. */
147 if (NILP (pos) ||
148 (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer))
150 unchain_marker (marker);
151 return marker;
154 CHECK_NUMBER_COERCE_MARKER (pos, 1);
155 if (NILP (buffer))
156 b = current_buffer;
157 else
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))
164 unchain_marker (marker);
165 return marker;
169 charno = XINT (pos);
170 m = XMARKER (marker);
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;
180 if (m->buffer != b)
182 unchain_marker (marker);
183 m->chain = b->markers;
184 b->markers = marker;
185 m->buffer = b;
188 return marker;
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. */
195 unchain_marker (marker)
196 register Lisp_Object marker;
198 register Lisp_Object tail, prev, next;
199 register int omark;
200 register struct buffer *b;
202 b = XMARKER (marker)->buffer;
203 if (b == 0)
204 return;
206 if (EQ (b->name, Qnil))
207 abort ();
209 tail = b->markers;
210 prev = Qnil;
211 while (XSYMBOL (tail) != XSYMBOL (Qnil))
213 next = XMARKER (tail)->chain;
214 XUNMARK (next);
216 if (XMARKER (marker) == XMARKER (tail))
218 if (NILP (prev))
220 b->markers = next;
221 /* Deleting first marker from the buffer's chain.
222 Crash if new first marker in chain does not say
223 it belongs to this buffer. */
224 if (!EQ (next, Qnil) && b != XMARKER (next)->buffer)
225 abort ();
227 else
229 omark = XMARKBIT (XMARKER (prev)->chain);
230 XMARKER (prev)->chain = next;
231 XSETMARKBIT (XMARKER (prev)->chain, omark);
233 break;
235 else
236 prev = tail;
237 tail = next;
239 XMARKER (marker)->buffer = 0;
242 marker_position (marker)
243 Lisp_Object marker;
245 register struct Lisp_Marker *m = XMARKER (marker);
246 register struct buffer *buf = m->buffer;
247 register int i = m->bufpos;
249 if (!buf)
250 error ("Marker does not point anywhere");
252 if (i > BUF_GPT (buf) + BUF_GAP_SIZE (buf))
253 i -= BUF_GAP_SIZE (buf);
254 else if (i > BUF_GPT (buf))
255 i = BUF_GPT (buf);
257 if (i < BUF_BEG (buf) || i > BUF_Z (buf))
258 abort ();
260 return i;
263 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
264 "Return a new marker pointing at the same place as MARKER.\n\
265 If argument is a number, makes a new marker pointing\n\
266 at that position in the current buffer.")
267 (marker)
268 register Lisp_Object marker;
270 register Lisp_Object new;
272 while (1)
274 if (XTYPE (marker) == Lisp_Int
275 || XTYPE (marker) == Lisp_Marker)
277 new = Fmake_marker ();
278 Fset_marker (new, marker,
279 ((XTYPE (marker) == Lisp_Marker)
280 ? Fmarker_buffer (marker)
281 : Qnil));
282 return new;
284 else
285 marker = wrong_type_argument (Qinteger_or_marker_p, marker);
289 syms_of_marker ()
291 defsubr (&Smarker_position);
292 defsubr (&Smarker_buffer);
293 defsubr (&Sset_marker);
294 defsubr (&Scopy_marker);