Mercurial > emacs
annotate src/marker.c @ 9702:50dd719378b4
(syms_of_window): Fix missing \n\'s.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Wed, 26 Oct 1994 06:22:14 +0000 |
parents | 77eba75a44a0 |
children | c78d0bb85d30 |
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 | |
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 | |
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 } | |
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. */ | |
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->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. */ | |
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->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; | |
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 | |
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 { | |
484 | 218 if (NILP (prev)) |
118 | 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 { | |
9121
faecbbbcceb4
(Fset_marker, set_marker_restricted, Fcopy_marker): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8829
diff
changeset
|
274 if (INTEGERP (marker) || MARKERP (marker)) |
118 | 275 { |
276 new = Fmake_marker (); | |
277 Fset_marker (new, marker, | |
9121
faecbbbcceb4
(Fset_marker, set_marker_restricted, Fcopy_marker): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
8829
diff
changeset
|
278 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil)); |
118 | 279 return new; |
280 } | |
281 else | |
282 marker = wrong_type_argument (Qinteger_or_marker_p, marker); | |
283 } | |
284 } | |
285 | |
286 syms_of_marker () | |
287 { | |
288 defsubr (&Smarker_position); | |
289 defsubr (&Smarker_buffer); | |
290 defsubr (&Sset_marker); | |
291 defsubr (&Scopy_marker); | |
292 } |