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)
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. */
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.")
31 register Lisp_Object marker
;
33 register Lisp_Object buf
;
34 CHECK_MARKER (marker
, 0);
35 if (XMARKER (marker
)->buffer
)
37 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
38 /* Return marker's buffer only if it is not dead. */
39 if (!NILP (XBUFFER (buf
)->name
))
45 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
46 "Return the position MARKER points at, as a character number.")
50 register Lisp_Object pos
;
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
))
65 if (i
< BUF_BEG (buf
) || i
> BUF_Z (buf
))
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\
81 Lisp_Object marker
, pos
, buffer
;
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. */
91 || (MARKERP (pos
) && !XMARKER (pos
)->buffer
))
93 unchain_marker (marker
);
97 CHECK_NUMBER_COERCE_MARKER (pos
, 1);
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
);
113 m
= XMARKER (marker
);
115 if (charno
< BUF_BEG (b
))
116 charno
= BUF_BEG (b
);
117 if (charno
> BUF_Z (b
))
119 if (charno
> BUF_GPT (b
)) charno
+= BUF_GAP_SIZE (b
);
124 unchain_marker (marker
);
126 m
->chain
= BUF_MARKERS (b
);
127 BUF_MARKERS (b
) = marker
;
133 /* This version of Fset_marker won't let the position
134 be outside the visible part. */
137 set_marker_restricted (marker
, pos
, buffer
)
138 Lisp_Object marker
, pos
, buffer
;
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. */
148 (MARKERP (pos
) && !XMARKER (pos
)->buffer
))
150 unchain_marker (marker
);
154 CHECK_NUMBER_COERCE_MARKER (pos
, 1);
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
);
170 m
= XMARKER (marker
);
172 if (charno
< BUF_BEGV (b
))
173 charno
= BUF_BEGV (b
);
174 if (charno
> BUF_ZV (b
))
176 if (charno
> BUF_GPT (b
))
177 charno
+= BUF_GAP_SIZE (b
);
182 unchain_marker (marker
);
184 m
->chain
= BUF_MARKERS (b
);
185 BUF_MARKERS (b
) = 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 EMACS_INT omark
;
200 register struct buffer
*b
;
202 b
= XMARKER (marker
)->buffer
;
206 if (EQ (b
->name
, Qnil
))
209 tail
= BUF_MARKERS (b
);
211 while (XSYMBOL (tail
) != XSYMBOL (Qnil
))
213 next
= XMARKER (tail
)->chain
;
216 if (XMARKER (marker
) == XMARKER (tail
))
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
223 to the same buffer, or at least that they have the same
225 if (!NILP (next
) && b
->text
!= XMARKER (next
)->buffer
->text
)
230 omark
= XMARKBIT (XMARKER (prev
)->chain
);
231 XMARKER (prev
)->chain
= next
;
232 XSETMARKBIT (XMARKER (prev
)->chain
, omark
);
240 XMARKER (marker
)->buffer
= 0;
243 /* Return the buffer position of marker MARKER, as a C integer. */
246 marker_position (marker
)
249 register struct Lisp_Marker
*m
= XMARKER (marker
);
250 register struct buffer
*buf
= m
->buffer
;
251 register int i
= m
->bufpos
;
254 error ("Marker does not point anywhere");
256 if (i
> BUF_GPT (buf
) + BUF_GAP_SIZE (buf
))
257 i
-= BUF_GAP_SIZE (buf
);
258 else if (i
> BUF_GPT (buf
))
261 if (i
< BUF_BEG (buf
) || i
> BUF_Z (buf
))
267 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 1, 1, 0,
268 "Return a new marker pointing at the same place as MARKER.\n\
269 If argument is a number, makes a new marker pointing\n\
270 at that position in the current buffer.")
272 register Lisp_Object marker
;
274 register Lisp_Object
new;
278 if (INTEGERP (marker
) || MARKERP (marker
))
280 new = Fmake_marker ();
281 Fset_marker (new, marker
,
282 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
286 marker
= wrong_type_argument (Qinteger_or_marker_p
, marker
);
292 defsubr (&Smarker_position
);
293 defsubr (&Smarker_buffer
);
294 defsubr (&Sset_marker
);
295 defsubr (&Scopy_marker
);