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 | |
8 | the Free Software Foundation; either version 1, or (at your option) | |
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 | { | |
37 | XSET (buf, Lisp_Buffer, XMARKER (marker)->buffer); | |
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 | ||
68 | XFASTINT (pos) = i; | |
69 | return pos; | |
70 | } | |
71 | return Qnil; | |
72 | } | |
73 | ||
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) |
dcfdbac7 JB |
91 | || (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer)) |
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); | |
125 | m->chain = b->markers; | |
126 | b->markers = marker; | |
127 | m->buffer = b; | |
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) || |
dcfdbac7 JB |
148 | (XTYPE (pos) == Lisp_Marker && !XMARKER (pos)->buffer)) |
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); | |
183 | m->chain = b->markers; | |
184 | b->markers = marker; | |
185 | m->buffer = b; | |
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; | |
199 | register int omark; | |
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 | ||
209 | tail = b->markers; | |
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 JB |
219 | { |
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 (); | |
226 | } | |
227 | else | |
228 | { | |
229 | omark = XMARKBIT (XMARKER (prev)->chain); | |
230 | XMARKER (prev)->chain = next; | |
231 | XSETMARKBIT (XMARKER (prev)->chain, omark); | |
232 | } | |
233 | break; | |
234 | } | |
235 | else | |
236 | prev = tail; | |
237 | tail = next; | |
238 | } | |
239 | XMARKER (marker)->buffer = 0; | |
240 | } | |
241 | ||
242 | marker_position (marker) | |
243 | Lisp_Object marker; | |
244 | { | |
245 | register struct Lisp_Marker *m = XMARKER (marker); | |
246 | register struct buffer *buf = m->buffer; | |
247 | register int i = m->bufpos; | |
248 | ||
249 | if (!buf) | |
250 | error ("Marker does not point anywhere"); | |
251 | ||
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); | |
256 | ||
257 | if (i < BUF_BEG (buf) || i > BUF_Z (buf)) | |
258 | abort (); | |
259 | ||
260 | return i; | |
261 | } | |
262 | ||
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; | |
269 | { | |
270 | register Lisp_Object new; | |
271 | ||
272 | while (1) | |
273 | { | |
274 | if (XTYPE (marker) == Lisp_Int | |
275 | || XTYPE (marker) == Lisp_Marker) | |
276 | { | |
277 | new = Fmake_marker (); | |
278 | Fset_marker (new, marker, | |
279 | ((XTYPE (marker) == Lisp_Marker) | |
280 | ? Fmarker_buffer (marker) | |
281 | : Qnil)); | |
282 | return new; | |
283 | } | |
284 | else | |
285 | marker = wrong_type_argument (Qinteger_or_marker_p, marker); | |
286 | } | |
287 | } | |
288 | \f | |
289 | syms_of_marker () | |
290 | { | |
291 | defsubr (&Smarker_position); | |
292 | defsubr (&Smarker_buffer); | |
293 | defsubr (&Sset_marker); | |
294 | defsubr (&Scopy_marker); | |
295 | } |