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 2, 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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
26 /* Operations on markers. */
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.")
32 register Lisp_Object marker
;
34 register Lisp_Object buf
;
35 CHECK_MARKER (marker
, 0);
36 if (XMARKER (marker
)->buffer
)
38 XSETBUFFER (buf
, XMARKER (marker
)->buffer
);
39 /* Return marker's buffer only if it is not dead. */
40 if (!NILP (XBUFFER (buf
)->name
))
46 DEFUN ("marker-position", Fmarker_position
, Smarker_position
, 1, 1, 0,
47 "Return the position MARKER points at, as a character number.")
51 register Lisp_Object pos
;
53 register struct buffer
*buf
;
55 CHECK_MARKER (marker
, 0);
56 if (XMARKER (marker
)->buffer
)
58 buf
= XMARKER (marker
)->buffer
;
59 i
= XMARKER (marker
)->bufpos
;
61 if (i
> BUF_GPT (buf
) + BUF_GAP_SIZE (buf
))
62 i
-= BUF_GAP_SIZE (buf
);
63 else if (i
> BUF_GPT (buf
))
66 if (i
< BUF_BEG (buf
) || i
> BUF_Z (buf
))
75 DEFUN ("set-marker", Fset_marker
, Sset_marker
, 2, 3, 0,
76 "Position MARKER before character number POSITION in BUFFER.\n\
77 BUFFER defaults to the current buffer.\n\
78 If POSITION is nil, makes marker point nowhere.\n\
79 Then it no longer slows down editing in any buffer.\n\
81 (marker
, position
, buffer
)
82 Lisp_Object marker
, position
, buffer
;
85 register struct buffer
*b
;
86 register struct Lisp_Marker
*m
;
88 CHECK_MARKER (marker
, 0);
89 /* If position is nil or a marker that points nowhere,
90 make this marker point nowhere. */
92 || (MARKERP (position
) && !XMARKER (position
)->buffer
))
94 unchain_marker (marker
);
98 CHECK_NUMBER_COERCE_MARKER (position
, 1);
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
))
108 unchain_marker (marker
);
113 charno
= XINT (position
);
114 m
= XMARKER (marker
);
116 if (charno
< BUF_BEG (b
))
117 charno
= BUF_BEG (b
);
118 if (charno
> BUF_Z (b
))
120 if (charno
> BUF_GPT (b
)) charno
+= BUF_GAP_SIZE (b
);
125 unchain_marker (marker
);
127 m
->chain
= BUF_MARKERS (b
);
128 BUF_MARKERS (b
) = marker
;
134 /* This version of Fset_marker won't let the position
135 be outside the visible part. */
138 set_marker_restricted (marker
, pos
, buffer
)
139 Lisp_Object marker
, pos
, buffer
;
142 register struct buffer
*b
;
143 register struct Lisp_Marker
*m
;
145 CHECK_MARKER (marker
, 0);
146 /* If position is nil or a marker that points nowhere,
147 make this marker point nowhere. */
149 (MARKERP (pos
) && !XMARKER (pos
)->buffer
))
151 unchain_marker (marker
);
155 CHECK_NUMBER_COERCE_MARKER (pos
, 1);
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
))
165 unchain_marker (marker
);
171 m
= XMARKER (marker
);
173 if (charno
< BUF_BEGV (b
))
174 charno
= BUF_BEGV (b
);
175 if (charno
> BUF_ZV (b
))
177 if (charno
> BUF_GPT (b
))
178 charno
+= BUF_GAP_SIZE (b
);
183 unchain_marker (marker
);
185 m
->chain
= BUF_MARKERS (b
);
186 BUF_MARKERS (b
) = marker
;
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. */
197 unchain_marker (marker
)
198 register Lisp_Object marker
;
200 register Lisp_Object tail
, prev
, next
;
201 register EMACS_INT omark
;
202 register struct buffer
*b
;
204 b
= XMARKER (marker
)->buffer
;
208 if (EQ (b
->name
, Qnil
))
211 tail
= BUF_MARKERS (b
);
213 while (XSYMBOL (tail
) != XSYMBOL (Qnil
))
215 next
= XMARKER (tail
)->chain
;
218 if (XMARKER (marker
) == XMARKER (tail
))
222 BUF_MARKERS (b
) = next
;
223 /* Deleting first marker from the buffer's chain. Crash
224 if new first marker in chain does not say it belongs
225 to the same buffer, or at least that they have the same
227 if (!NILP (next
) && b
->text
!= XMARKER (next
)->buffer
->text
)
232 omark
= XMARKBIT (XMARKER (prev
)->chain
);
233 XMARKER (prev
)->chain
= next
;
234 XSETMARKBIT (XMARKER (prev
)->chain
, omark
);
242 XMARKER (marker
)->buffer
= 0;
245 /* Return the buffer position of marker MARKER, as a C integer. */
248 marker_position (marker
)
251 register struct Lisp_Marker
*m
= XMARKER (marker
);
252 register struct buffer
*buf
= m
->buffer
;
253 register int i
= m
->bufpos
;
256 error ("Marker does not point anywhere");
258 if (i
> BUF_GPT (buf
) + BUF_GAP_SIZE (buf
))
259 i
-= BUF_GAP_SIZE (buf
);
260 else if (i
> BUF_GPT (buf
))
263 if (i
< BUF_BEG (buf
) || i
> BUF_Z (buf
))
269 DEFUN ("copy-marker", Fcopy_marker
, Scopy_marker
, 1, 2, 0,
270 "Return a new marker pointing at the same place as MARKER.\n\
271 If argument is a number, makes a new marker pointing\n\
272 at that position in the current buffer.\n\
273 The optional argument TYPE specifies the insertion type of the new marker;\n\
274 see `marker-insertion-type'.")
276 register Lisp_Object marker
, type
;
278 register Lisp_Object
new;
280 if (INTEGERP (marker
) || MARKERP (marker
))
282 new = Fmake_marker ();
283 Fset_marker (new, marker
,
284 (MARKERP (marker
) ? Fmarker_buffer (marker
) : Qnil
));
285 XMARKER (new)->insertion_type
= !NILP (type
);
289 marker
= wrong_type_argument (Qinteger_or_marker_p
, marker
);
292 DEFUN ("marker-insertion-type", Fmarker_insertion_type
,
293 Smarker_insertion_type
, 1, 1, 0,
294 "Return insertion type of MARKER: t if it stays after inserted text.\n\
295 nil means the marker stays before text inserted there.")
297 register Lisp_Object marker
;
299 register Lisp_Object buf
;
300 CHECK_MARKER (marker
, 0);
301 return XMARKER (marker
)->insertion_type
? Qt
: Qnil
;
304 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type
,
305 Sset_marker_insertion_type
, 2, 2, 0,
306 "Set the insertion-type of MARKER to TYPE.\n\
307 If TYPE is t, it means the marker advances when you insert text at it.\n\
308 If TYPE is nil, it means the marker stays behind when you insert text at it.")
310 Lisp_Object marker
, type
;
312 CHECK_MARKER (marker
, 0);
314 XMARKER (marker
)->insertion_type
= ! NILP (type
);
318 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at
, Sbuffer_has_markers_at
,
320 "Return t if there are markers pointing at POSITION in the currentbuffer.")
322 Lisp_Object position
;
324 register Lisp_Object tail
;
327 charno
= XINT (position
);
333 if (charno
> GPT
) charno
+= GAP_SIZE
;
335 for (tail
= BUF_MARKERS (current_buffer
);
336 XSYMBOL (tail
) != XSYMBOL (Qnil
);
337 tail
= XMARKER (tail
)->chain
)
338 if (XMARKER (tail
)->bufpos
== charno
)
347 defsubr (&Smarker_position
);
348 defsubr (&Smarker_buffer
);
349 defsubr (&Sset_marker
);
350 defsubr (&Scopy_marker
);
351 defsubr (&Smarker_insertion_type
);
352 defsubr (&Sset_marker_insertion_type
);
353 defsubr (&Sbuffer_has_markers_at
);