Mercurial > emacs
annotate src/marker.c @ 13713:f85b6bd0f925
(fill-context-prefix): Doc fix.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Wed, 13 Dec 1995 02:09:24 +0000 |
parents | e518c2be8d7b |
children | c6a1708f37d4 |
rev | line source |
---|---|
118 | 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 | |
12244 | 8 the Free Software Foundation; either version 2, or (at your option) |
118 | 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 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
484
diff
changeset
|
21 #include <config.h> |
118 | 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 { | |
9275
bb50d17f7441
(Fmarker_buffer): Use new accessor macros instead of calling XSET directly.
Karl Heuer <kwzh@gnu.org>
parents:
9121
diff
changeset
|
37 XSETBUFFER (buf, XMARKER (marker)->buffer); |
118 | 38 /* Return marker's buffer only if it is not dead. */ |
484 | 39 if (!NILP (XBUFFER (buf)->name)) |
118 | 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 | |
9315
77eba75a44a0
(Fmarker_position): Don't use XFASTINT as an lvalue.
Karl Heuer <kwzh@gnu.org>
parents:
9275
diff
changeset
|
68 XSETFASTINT (pos, i); |
118 | 69 return pos; |
70 } | |
71 return Qnil; | |
72 } | |
12999
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
73 |
118 | 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. */ | |
484 | 90 if (NILP (pos) |
9121
faecbbbcceb4
(Fset_marker, set_marker_restricted, Fcopy_marker): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8829
diff
changeset
|
91 || (MARKERP (pos) && !XMARKER (pos)->buffer)) |
118 | 92 { |
93 unchain_marker (marker); | |
94 return marker; | |
95 } | |
96 | |
97 CHECK_NUMBER_COERCE_MARKER (pos, 1); | |
484 | 98 if (NILP (buffer)) |
118 | 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->buffer = b; | |
10315
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
126 m->chain = BUF_MARKERS (b); |
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
127 BUF_MARKERS (b) = marker; |
118 | 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. */ | |
484 | 147 if (NILP (pos) || |
9121
faecbbbcceb4
(Fset_marker, set_marker_restricted, Fcopy_marker): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8829
diff
changeset
|
148 (MARKERP (pos) && !XMARKER (pos)->buffer)) |
118 | 149 { |
150 unchain_marker (marker); | |
151 return marker; | |
152 } | |
153 | |
154 CHECK_NUMBER_COERCE_MARKER (pos, 1); | |
484 | 155 if (NILP (buffer)) |
118 | 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->buffer = b; | |
10315
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
184 m->chain = BUF_MARKERS (b); |
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
185 BUF_MARKERS (b) = marker; |
118 | 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; | |
8829
6f0d48241807
(unchain_marker): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
199 register EMACS_INT omark; |
118 | 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 | |
10315
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
209 tail = BUF_MARKERS (b); |
118 | 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 { | |
484 | 218 if (NILP (prev)) |
118 | 219 { |
10315
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
220 BUF_MARKERS (b) = next; |
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
221 /* Deleting first marker from the buffer's chain. Crash |
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
222 if new first marker in chain does not say it belongs |
10999
84076f6a1f1b
(unchain_marker): Allow differing buffers
Richard M. Stallman <rms@gnu.org>
parents:
10315
diff
changeset
|
223 to the same buffer, or at least that they have the same |
84076f6a1f1b
(unchain_marker): Allow differing buffers
Richard M. Stallman <rms@gnu.org>
parents:
10315
diff
changeset
|
224 base buffer. */ |
84076f6a1f1b
(unchain_marker): Allow differing buffers
Richard M. Stallman <rms@gnu.org>
parents:
10315
diff
changeset
|
225 if (!NILP (next) && b->text != XMARKER (next)->buffer->text) |
118 | 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 | |
10315
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
243 /* Return the buffer position of marker MARKER, as a C integer. */ |
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
244 |
c78d0bb85d30
Use BUF_MARKERS throughout.
Richard M. Stallman <rms@gnu.org>
parents:
9315
diff
changeset
|
245 int |
118 | 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 } | |
12999
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
266 |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
267 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0, |
118 | 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\ | |
12999
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
270 at that position in the current buffer.\n\ |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
271 The optional argument TYPE specifies the insertion type of the new marker;\n\ |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
272 see `marker-insertion-type'.") |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
273 (marker, type) |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
274 register Lisp_Object marker, type; |
118 | 275 { |
276 register Lisp_Object new; | |
277 | |
12999
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
278 if (INTEGERP (marker) || MARKERP (marker)) |
118 | 279 { |
12999
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
280 new = Fmake_marker (); |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
281 Fset_marker (new, marker, |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
282 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil)); |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
283 XMARKER (new)->insertion_type = !NILP (type); |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
284 return new; |
118 | 285 } |
12999
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
286 else |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
287 marker = wrong_type_argument (Qinteger_or_marker_p, marker); |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
288 } |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
289 |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
290 DEFUN ("marker-insertion-type", Fmarker_insertion_type, |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
291 Smarker_insertion_type, 1, 1, 0, |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
292 "Return insertion type of MARKER: t if it stays after inserted text.\n\ |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
293 nil means the marker stays before text inserted there.") |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
294 (marker) |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
295 register Lisp_Object marker; |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
296 { |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
297 register Lisp_Object buf; |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
298 CHECK_MARKER (marker, 0); |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
299 return XMARKER (marker)->insertion_type ? Qt : Qnil; |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
300 } |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
301 |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
302 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
303 Sset_marker_insertion_type, 2, 2, 0, |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
304 "Set the insertion-type of MARKER to TYPE.\n\ |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
305 If TYPE is t, it means the marker advances when you insert text at it.\n\ |
13327
e518c2be8d7b
(Fset_marker_insertion_type): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12999
diff
changeset
|
306 If TYPE is nil, it means the marker stays behind when you insert text at it.") |
12999
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
307 (marker, type) |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
308 Lisp_Object marker, type; |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
309 { |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
310 CHECK_MARKER (marker, 0); |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
311 |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
312 XMARKER (marker)->insertion_type = ! NILP (type); |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
313 return type; |
118 | 314 } |
315 | |
316 syms_of_marker () | |
317 { | |
318 defsubr (&Smarker_position); | |
319 defsubr (&Smarker_buffer); | |
320 defsubr (&Sset_marker); | |
321 defsubr (&Scopy_marker); | |
12999
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
322 defsubr (&Smarker_insertion_type); |
b889a50f71db
(Fcopy_marker): New arg TYPE.
Richard M. Stallman <rms@gnu.org>
parents:
12244
diff
changeset
|
323 defsubr (&Sset_marker_insertion_type); |
118 | 324 } |