20537
|
1 /* Markers: examining, setting and deleting.
|
20706
|
2 Copyright (C) 1985, 1997, 1998 Free Software Foundation, Inc.
|
118
|
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
|
14186
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
19 Boston, MA 02111-1307, USA. */
|
118
|
20
|
|
21
|
4696
|
22 #include <config.h>
|
118
|
23 #include "lisp.h"
|
|
24 #include "buffer.h"
|
20537
|
25 #include "charset.h"
|
118
|
26
|
20537
|
27 /* Record one cached position found recently by
|
|
28 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
|
|
29
|
|
30 static int cached_charpos;
|
|
31 static int cached_bytepos;
|
|
32 static struct buffer *cached_buffer;
|
|
33 static int cached_modiff;
|
20678
|
34
|
31830
|
35 static void byte_char_debug_check P_ ((struct buffer *, int, int));
|
|
36
|
20872
|
37 /* Nonzero means enable debugging checks on byte/char correspondences. */
|
|
38
|
|
39 static int byte_debug_flag;
|
|
40
|
21514
|
41 void
|
20678
|
42 clear_charpos_cache (b)
|
|
43 struct buffer *b;
|
|
44 {
|
|
45 if (cached_buffer == b)
|
|
46 cached_buffer = 0;
|
|
47 }
|
20537
|
48
|
|
49 /* Converting between character positions and byte positions. */
|
|
50
|
|
51 /* There are several places in the buffer where we know
|
|
52 the corrspondence: BEG, BEGV, PT, GPT, ZV and Z,
|
|
53 and everywhere there is a marker. So we find the one of these places
|
|
54 that is closest to the specified position, and scan from there. */
|
|
55
|
|
56 /* charpos_to_bytepos returns the byte position corresponding to CHARPOS. */
|
|
57
|
|
58 /* This macro is a subroutine of charpos_to_bytepos.
|
|
59 Note that it is desirable that BYTEPOS is not evaluated
|
|
60 except when we really want its value. */
|
|
61
|
|
62 #define CONSIDER(CHARPOS, BYTEPOS) \
|
|
63 { \
|
|
64 int this_charpos = (CHARPOS); \
|
|
65 int changed = 0; \
|
|
66 \
|
|
67 if (this_charpos == charpos) \
|
20872
|
68 { \
|
|
69 int value = (BYTEPOS); \
|
|
70 if (byte_debug_flag) \
|
|
71 byte_char_debug_check (b, charpos, value); \
|
|
72 return value; \
|
|
73 } \
|
20537
|
74 else if (this_charpos > charpos) \
|
|
75 { \
|
|
76 if (this_charpos < best_above) \
|
|
77 { \
|
|
78 best_above = this_charpos; \
|
|
79 best_above_byte = (BYTEPOS); \
|
|
80 changed = 1; \
|
|
81 } \
|
|
82 } \
|
|
83 else if (this_charpos > best_below) \
|
|
84 { \
|
|
85 best_below = this_charpos; \
|
|
86 best_below_byte = (BYTEPOS); \
|
|
87 changed = 1; \
|
|
88 } \
|
|
89 \
|
|
90 if (changed) \
|
|
91 { \
|
|
92 if (best_above - best_below == best_above_byte - best_below_byte) \
|
20872
|
93 { \
|
|
94 int value = best_below_byte + (charpos - best_below); \
|
|
95 if (byte_debug_flag) \
|
|
96 byte_char_debug_check (b, charpos, value); \
|
|
97 return value; \
|
|
98 } \
|
20537
|
99 } \
|
|
100 }
|
|
101
|
31830
|
102 static void
|
20872
|
103 byte_char_debug_check (b, charpos, bytepos)
|
|
104 struct buffer *b;
|
|
105 int charpos, bytepos;
|
|
106 {
|
|
107 int nchars = 0;
|
|
108
|
|
109 if (bytepos > BUF_GPT_BYTE (b))
|
|
110 {
|
21219
|
111 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
|
|
112 BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b));
|
|
113 nchars += multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
|
|
114 bytepos - BUF_GPT_BYTE (b));
|
20872
|
115 }
|
|
116 else
|
21219
|
117 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
|
|
118 bytepos - BUF_BEG_BYTE (b));
|
20872
|
119
|
|
120 if (charpos - 1 != nchars)
|
|
121 abort ();
|
|
122 }
|
|
123
|
|
124 int
|
20537
|
125 charpos_to_bytepos (charpos)
|
|
126 int charpos;
|
|
127 {
|
|
128 return buf_charpos_to_bytepos (current_buffer, charpos);
|
|
129 }
|
|
130
|
|
131 int
|
|
132 buf_charpos_to_bytepos (b, charpos)
|
|
133 struct buffer *b;
|
|
134 int charpos;
|
|
135 {
|
|
136 Lisp_Object tail;
|
|
137 int best_above, best_above_byte;
|
|
138 int best_below, best_below_byte;
|
|
139
|
|
140 if (charpos < BUF_BEG (b) || charpos > BUF_Z (b))
|
|
141 abort ();
|
|
142
|
|
143 best_above = BUF_Z (b);
|
|
144 best_above_byte = BUF_Z_BYTE (b);
|
|
145
|
|
146 /* If this buffer has as many characters as bytes,
|
|
147 each character must be one byte.
|
|
148 This takes care of the case where enable-multibyte-characters is nil. */
|
|
149 if (best_above == best_above_byte)
|
|
150 return charpos;
|
|
151
|
|
152 best_below = 1;
|
|
153 best_below_byte = 1;
|
|
154
|
|
155 /* We find in best_above and best_above_byte
|
|
156 the closest known point above CHARPOS,
|
|
157 and in best_below and best_below_byte
|
|
158 the closest known point below CHARPOS,
|
|
159
|
|
160 If at any point we can tell that the space between those
|
|
161 two best approximations is all single-byte,
|
|
162 we interpolate the result immediately. */
|
|
163
|
|
164 CONSIDER (BUF_PT (b), BUF_PT_BYTE (b));
|
|
165 CONSIDER (BUF_GPT (b), BUF_GPT_BYTE (b));
|
|
166 CONSIDER (BUF_BEGV (b), BUF_BEGV_BYTE (b));
|
|
167 CONSIDER (BUF_ZV (b), BUF_ZV_BYTE (b));
|
|
168
|
|
169 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
|
|
170 CONSIDER (cached_charpos, cached_bytepos);
|
|
171
|
|
172 tail = BUF_MARKERS (b);
|
28417
4b675266db04
* lisp.h (XCONS, XSTRING, XSYMBOL, XFLOAT, XPROCESS, XWINDOW, XSUBR, XBUFFER):
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
173 while (! NILP (tail))
|
20537
|
174 {
|
20563
|
175 CONSIDER (XMARKER (tail)->charpos, XMARKER (tail)->bytepos);
|
20537
|
176
|
|
177 /* If we are down to a range of 50 chars,
|
|
178 don't bother checking any other markers;
|
|
179 scan the intervening chars directly now. */
|
|
180 if (best_above - best_below < 50)
|
|
181 break;
|
|
182
|
|
183 tail = XMARKER (tail)->chain;
|
|
184 }
|
|
185
|
|
186 /* We get here if we did not exactly hit one of the known places.
|
|
187 We have one known above and one known below.
|
|
188 Scan, counting characters, from whichever one is closer. */
|
|
189
|
|
190 if (charpos - best_below < best_above - charpos)
|
|
191 {
|
|
192 int record = charpos - best_below > 5000;
|
|
193
|
|
194 while (best_below != charpos)
|
|
195 {
|
|
196 best_below++;
|
|
197 BUF_INC_POS (b, best_below_byte);
|
|
198 }
|
|
199
|
|
200 /* If this position is quite far from the nearest known position,
|
|
201 cache the correspondence by creating a marker here.
|
|
202 It will last until the next GC. */
|
|
203 if (record)
|
|
204 {
|
21497
|
205 Lisp_Object marker, buffer;
|
20537
|
206 marker = Fmake_marker ();
|
21497
|
207 XSETBUFFER (buffer, b);
|
|
208 set_marker_both (marker, buffer, best_below, best_below_byte);
|
20537
|
209 }
|
|
210
|
20872
|
211 if (byte_debug_flag)
|
|
212 byte_char_debug_check (b, charpos, best_below_byte);
|
|
213
|
20537
|
214 cached_buffer = b;
|
|
215 cached_modiff = BUF_MODIFF (b);
|
|
216 cached_charpos = best_below;
|
|
217 cached_bytepos = best_below_byte;
|
|
218
|
|
219 return best_below_byte;
|
|
220 }
|
|
221 else
|
|
222 {
|
|
223 int record = best_above - charpos > 5000;
|
|
224
|
|
225 while (best_above != charpos)
|
|
226 {
|
|
227 best_above--;
|
|
228 BUF_DEC_POS (b, best_above_byte);
|
|
229 }
|
|
230
|
|
231 /* If this position is quite far from the nearest known position,
|
|
232 cache the correspondence by creating a marker here.
|
|
233 It will last until the next GC. */
|
|
234 if (record)
|
|
235 {
|
21497
|
236 Lisp_Object marker, buffer;
|
20537
|
237 marker = Fmake_marker ();
|
21497
|
238 XSETBUFFER (buffer, b);
|
|
239 set_marker_both (marker, buffer, best_above, best_above_byte);
|
20537
|
240 }
|
|
241
|
20872
|
242 if (byte_debug_flag)
|
|
243 byte_char_debug_check (b, charpos, best_above_byte);
|
|
244
|
20537
|
245 cached_buffer = b;
|
|
246 cached_modiff = BUF_MODIFF (b);
|
|
247 cached_charpos = best_above;
|
|
248 cached_bytepos = best_above_byte;
|
|
249
|
|
250 return best_above_byte;
|
|
251 }
|
|
252 }
|
|
253
|
|
254 #undef CONSIDER
|
|
255
|
|
256 /* bytepos_to_charpos returns the char position corresponding to BYTEPOS. */
|
|
257
|
|
258 /* This macro is a subroutine of bytepos_to_charpos.
|
|
259 It is used when BYTEPOS is actually the byte position. */
|
|
260
|
|
261 #define CONSIDER(BYTEPOS, CHARPOS) \
|
|
262 { \
|
|
263 int this_bytepos = (BYTEPOS); \
|
|
264 int changed = 0; \
|
|
265 \
|
|
266 if (this_bytepos == bytepos) \
|
20872
|
267 { \
|
|
268 int value = (CHARPOS); \
|
|
269 if (byte_debug_flag) \
|
|
270 byte_char_debug_check (b, value, bytepos); \
|
|
271 return value; \
|
|
272 } \
|
20537
|
273 else if (this_bytepos > bytepos) \
|
|
274 { \
|
|
275 if (this_bytepos < best_above_byte) \
|
|
276 { \
|
|
277 best_above = (CHARPOS); \
|
|
278 best_above_byte = this_bytepos; \
|
|
279 changed = 1; \
|
|
280 } \
|
|
281 } \
|
|
282 else if (this_bytepos > best_below_byte) \
|
|
283 { \
|
|
284 best_below = (CHARPOS); \
|
|
285 best_below_byte = this_bytepos; \
|
|
286 changed = 1; \
|
|
287 } \
|
|
288 \
|
|
289 if (changed) \
|
|
290 { \
|
|
291 if (best_above - best_below == best_above_byte - best_below_byte) \
|
20872
|
292 { \
|
|
293 int value = best_below + (bytepos - best_below_byte); \
|
|
294 if (byte_debug_flag) \
|
|
295 byte_char_debug_check (b, value, bytepos); \
|
|
296 return value; \
|
|
297 } \
|
20537
|
298 } \
|
|
299 }
|
|
300
|
|
301 int
|
|
302 bytepos_to_charpos (bytepos)
|
|
303 int bytepos;
|
|
304 {
|
|
305 return buf_bytepos_to_charpos (current_buffer, bytepos);
|
|
306 }
|
|
307
|
|
308 int
|
|
309 buf_bytepos_to_charpos (b, bytepos)
|
|
310 struct buffer *b;
|
|
311 int bytepos;
|
|
312 {
|
|
313 Lisp_Object tail;
|
|
314 int best_above, best_above_byte;
|
|
315 int best_below, best_below_byte;
|
|
316
|
|
317 if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
|
|
318 abort ();
|
|
319
|
|
320 best_above = BUF_Z (b);
|
|
321 best_above_byte = BUF_Z_BYTE (b);
|
|
322
|
|
323 /* If this buffer has as many characters as bytes,
|
|
324 each character must be one byte.
|
|
325 This takes care of the case where enable-multibyte-characters is nil. */
|
|
326 if (best_above == best_above_byte)
|
|
327 return bytepos;
|
|
328
|
|
329 best_below = 1;
|
|
330 best_below_byte = 1;
|
|
331
|
|
332 CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
|
|
333 CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
|
|
334 CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
|
|
335 CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
|
|
336
|
|
337 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
|
|
338 CONSIDER (cached_bytepos, cached_charpos);
|
|
339
|
|
340 tail = BUF_MARKERS (b);
|
28417
4b675266db04
* lisp.h (XCONS, XSTRING, XSYMBOL, XFLOAT, XPROCESS, XWINDOW, XSUBR, XBUFFER):
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
341 while (! NILP (tail))
|
20537
|
342 {
|
20563
|
343 CONSIDER (XMARKER (tail)->bytepos, XMARKER (tail)->charpos);
|
20537
|
344
|
|
345 /* If we are down to a range of 50 chars,
|
|
346 don't bother checking any other markers;
|
|
347 scan the intervening chars directly now. */
|
|
348 if (best_above - best_below < 50)
|
|
349 break;
|
|
350
|
|
351 tail = XMARKER (tail)->chain;
|
|
352 }
|
|
353
|
|
354 /* We get here if we did not exactly hit one of the known places.
|
|
355 We have one known above and one known below.
|
|
356 Scan, counting characters, from whichever one is closer. */
|
|
357
|
|
358 if (bytepos - best_below_byte < best_above_byte - bytepos)
|
|
359 {
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
360 int record = bytepos - best_below_byte > 5000;
|
20537
|
361
|
|
362 while (best_below_byte < bytepos)
|
|
363 {
|
|
364 best_below++;
|
|
365 BUF_INC_POS (b, best_below_byte);
|
|
366 }
|
|
367
|
|
368 /* If this position is quite far from the nearest known position,
|
|
369 cache the correspondence by creating a marker here.
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
370 It will last until the next GC.
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
371 But don't do it if BUF_MARKERS is nil;
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
372 that is a signal from Fset_buffer_multibyte. */
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
373 if (record && ! NILP (BUF_MARKERS (b)))
|
20537
|
374 {
|
21497
|
375 Lisp_Object marker, buffer;
|
20537
|
376 marker = Fmake_marker ();
|
21497
|
377 XSETBUFFER (buffer, b);
|
|
378 set_marker_both (marker, buffer, best_below, best_below_byte);
|
20537
|
379 }
|
|
380
|
20872
|
381 if (byte_debug_flag)
|
|
382 byte_char_debug_check (b, best_below, bytepos);
|
|
383
|
20537
|
384 cached_buffer = b;
|
|
385 cached_modiff = BUF_MODIFF (b);
|
|
386 cached_charpos = best_below;
|
|
387 cached_bytepos = best_below_byte;
|
|
388
|
|
389 return best_below;
|
|
390 }
|
|
391 else
|
|
392 {
|
|
393 int record = best_above_byte - bytepos > 5000;
|
|
394
|
|
395 while (best_above_byte > bytepos)
|
|
396 {
|
|
397 best_above--;
|
|
398 BUF_DEC_POS (b, best_above_byte);
|
|
399 }
|
|
400
|
|
401 /* If this position is quite far from the nearest known position,
|
|
402 cache the correspondence by creating a marker here.
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
403 It will last until the next GC.
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
404 But don't do it if BUF_MARKERS is nil;
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
405 that is a signal from Fset_buffer_multibyte. */
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
406 if (record && ! NILP (BUF_MARKERS (b)))
|
20537
|
407 {
|
21497
|
408 Lisp_Object marker, buffer;
|
20537
|
409 marker = Fmake_marker ();
|
21497
|
410 XSETBUFFER (buffer, b);
|
|
411 set_marker_both (marker, buffer, best_above, best_above_byte);
|
20537
|
412 }
|
|
413
|
20872
|
414 if (byte_debug_flag)
|
|
415 byte_char_debug_check (b, best_above, bytepos);
|
|
416
|
20537
|
417 cached_buffer = b;
|
|
418 cached_modiff = BUF_MODIFF (b);
|
|
419 cached_charpos = best_above;
|
|
420 cached_bytepos = best_above_byte;
|
|
421
|
|
422 return best_above;
|
|
423 }
|
|
424 }
|
|
425
|
|
426 #undef CONSIDER
|
|
427
|
118
|
428 /* Operations on markers. */
|
|
429
|
|
430 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
|
|
431 "Return the buffer that MARKER points into, or nil if none.\n\
|
|
432 Returns nil if MARKER points into a dead buffer.")
|
|
433 (marker)
|
|
434 register Lisp_Object marker;
|
|
435 {
|
|
436 register Lisp_Object buf;
|
|
437 CHECK_MARKER (marker, 0);
|
|
438 if (XMARKER (marker)->buffer)
|
|
439 {
|
9275
bb50d17f7441
(Fmarker_buffer): Use new accessor macros instead of calling XSET directly.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
440 XSETBUFFER (buf, XMARKER (marker)->buffer);
|
118
|
441 /* Return marker's buffer only if it is not dead. */
|
484
|
442 if (!NILP (XBUFFER (buf)->name))
|
118
|
443 return buf;
|
|
444 }
|
|
445 return Qnil;
|
|
446 }
|
|
447
|
|
448 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
|
|
449 "Return the position MARKER points at, as a character number.")
|
|
450 (marker)
|
|
451 Lisp_Object marker;
|
|
452 {
|
|
453 register Lisp_Object pos;
|
|
454 register int i;
|
|
455 register struct buffer *buf;
|
|
456
|
|
457 CHECK_MARKER (marker, 0);
|
|
458 if (XMARKER (marker)->buffer)
|
20537
|
459 return make_number (XMARKER (marker)->charpos);
|
118
|
460
|
|
461 return Qnil;
|
|
462 }
|
12999
|
463
|
118
|
464 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
|
14082
|
465 "Position MARKER before character number POSITION in BUFFER.\n\
|
118
|
466 BUFFER defaults to the current buffer.\n\
|
14082
|
467 If POSITION is nil, makes marker point nowhere.\n\
|
118
|
468 Then it no longer slows down editing in any buffer.\n\
|
|
469 Returns MARKER.")
|
14082
|
470 (marker, position, buffer)
|
|
471 Lisp_Object marker, position, buffer;
|
118
|
472 {
|
20537
|
473 register int charno, bytepos;
|
118
|
474 register struct buffer *b;
|
|
475 register struct Lisp_Marker *m;
|
|
476
|
|
477 CHECK_MARKER (marker, 0);
|
|
478 /* If position is nil or a marker that points nowhere,
|
|
479 make this marker point nowhere. */
|
14082
|
480 if (NILP (position)
|
|
481 || (MARKERP (position) && !XMARKER (position)->buffer))
|
118
|
482 {
|
|
483 unchain_marker (marker);
|
|
484 return marker;
|
|
485 }
|
|
486
|
484
|
487 if (NILP (buffer))
|
118
|
488 b = current_buffer;
|
|
489 else
|
|
490 {
|
|
491 CHECK_BUFFER (buffer, 1);
|
|
492 b = XBUFFER (buffer);
|
|
493 /* If buffer is dead, set marker to point nowhere. */
|
|
494 if (EQ (b->name, Qnil))
|
|
495 {
|
|
496 unchain_marker (marker);
|
|
497 return marker;
|
|
498 }
|
|
499 }
|
|
500
|
20537
|
501 m = XMARKER (marker);
|
|
502
|
|
503 /* Optimize the special case where we are copying the position
|
|
504 of an existing marker, and MARKER is already in the same buffer. */
|
|
505 if (MARKERP (position) && b == XMARKER (position)->buffer
|
|
506 && b == m->buffer)
|
|
507 {
|
20563
|
508 m->bytepos = XMARKER (position)->bytepos;
|
20537
|
509 m->charpos = XMARKER (position)->charpos;
|
|
510 return marker;
|
|
511 }
|
|
512
|
|
513 CHECK_NUMBER_COERCE_MARKER (position, 1);
|
|
514
|
14082
|
515 charno = XINT (position);
|
118
|
516
|
|
517 if (charno < BUF_BEG (b))
|
|
518 charno = BUF_BEG (b);
|
|
519 if (charno > BUF_Z (b))
|
|
520 charno = BUF_Z (b);
|
20537
|
521
|
|
522 bytepos = buf_charpos_to_bytepos (b, charno);
|
|
523
|
|
524 /* Every character is at least one byte. */
|
|
525 if (charno > bytepos)
|
|
526 abort ();
|
|
527
|
20563
|
528 m->bytepos = bytepos;
|
20537
|
529 m->charpos = charno;
|
118
|
530
|
|
531 if (m->buffer != b)
|
|
532 {
|
|
533 unchain_marker (marker);
|
|
534 m->buffer = b;
|
10315
|
535 m->chain = BUF_MARKERS (b);
|
|
536 BUF_MARKERS (b) = marker;
|
118
|
537 }
|
|
538
|
|
539 return marker;
|
|
540 }
|
|
541
|
|
542 /* This version of Fset_marker won't let the position
|
|
543 be outside the visible part. */
|
|
544
|
|
545 Lisp_Object
|
|
546 set_marker_restricted (marker, pos, buffer)
|
|
547 Lisp_Object marker, pos, buffer;
|
|
548 {
|
20537
|
549 register int charno, bytepos;
|
118
|
550 register struct buffer *b;
|
|
551 register struct Lisp_Marker *m;
|
|
552
|
|
553 CHECK_MARKER (marker, 0);
|
|
554 /* If position is nil or a marker that points nowhere,
|
|
555 make this marker point nowhere. */
|
20537
|
556 if (NILP (pos)
|
|
557 || (MARKERP (pos) && !XMARKER (pos)->buffer))
|
118
|
558 {
|
|
559 unchain_marker (marker);
|
|
560 return marker;
|
|
561 }
|
|
562
|
484
|
563 if (NILP (buffer))
|
118
|
564 b = current_buffer;
|
|
565 else
|
|
566 {
|
|
567 CHECK_BUFFER (buffer, 1);
|
|
568 b = XBUFFER (buffer);
|
|
569 /* If buffer is dead, set marker to point nowhere. */
|
|
570 if (EQ (b->name, Qnil))
|
|
571 {
|
|
572 unchain_marker (marker);
|
|
573 return marker;
|
|
574 }
|
|
575 }
|
|
576
|
20537
|
577 m = XMARKER (marker);
|
|
578
|
|
579 /* Optimize the special case where we are copying the position
|
|
580 of an existing marker, and MARKER is already in the same buffer. */
|
|
581 if (MARKERP (pos) && b == XMARKER (pos)->buffer
|
|
582 && b == m->buffer)
|
|
583 {
|
20563
|
584 m->bytepos = XMARKER (pos)->bytepos;
|
20537
|
585 m->charpos = XMARKER (pos)->charpos;
|
|
586 return marker;
|
|
587 }
|
|
588
|
|
589 CHECK_NUMBER_COERCE_MARKER (pos, 1);
|
|
590
|
118
|
591 charno = XINT (pos);
|
|
592
|
|
593 if (charno < BUF_BEGV (b))
|
|
594 charno = BUF_BEGV (b);
|
|
595 if (charno > BUF_ZV (b))
|
|
596 charno = BUF_ZV (b);
|
20537
|
597
|
|
598 bytepos = buf_charpos_to_bytepos (b, charno);
|
|
599
|
|
600 /* Every character is at least one byte. */
|
|
601 if (charno > bytepos)
|
|
602 abort ();
|
|
603
|
20563
|
604 m->bytepos = bytepos;
|
20537
|
605 m->charpos = charno;
|
|
606
|
|
607 if (m->buffer != b)
|
|
608 {
|
|
609 unchain_marker (marker);
|
|
610 m->buffer = b;
|
|
611 m->chain = BUF_MARKERS (b);
|
|
612 BUF_MARKERS (b) = marker;
|
|
613 }
|
|
614
|
|
615 return marker;
|
|
616 }
|
|
617
|
|
618 /* Set the position of MARKER, specifying both the
|
|
619 character position and the corresponding byte position. */
|
|
620
|
|
621 Lisp_Object
|
|
622 set_marker_both (marker, buffer, charpos, bytepos)
|
|
623 Lisp_Object marker, buffer;
|
|
624 int charpos, bytepos;
|
|
625 {
|
|
626 register struct buffer *b;
|
|
627 register struct Lisp_Marker *m;
|
|
628
|
|
629 CHECK_MARKER (marker, 0);
|
|
630
|
|
631 if (NILP (buffer))
|
|
632 b = current_buffer;
|
|
633 else
|
|
634 {
|
|
635 CHECK_BUFFER (buffer, 1);
|
|
636 b = XBUFFER (buffer);
|
|
637 /* If buffer is dead, set marker to point nowhere. */
|
|
638 if (EQ (b->name, Qnil))
|
|
639 {
|
|
640 unchain_marker (marker);
|
|
641 return marker;
|
|
642 }
|
|
643 }
|
|
644
|
|
645 m = XMARKER (marker);
|
|
646
|
|
647 /* In a single-byte buffer, the two positions must be equal. */
|
|
648 if (BUF_Z (b) == BUF_Z_BYTE (b)
|
|
649 && charpos != bytepos)
|
|
650 abort ();
|
|
651 /* Every character is at least one byte. */
|
|
652 if (charpos > bytepos)
|
|
653 abort ();
|
|
654
|
20563
|
655 m->bytepos = bytepos;
|
20537
|
656 m->charpos = charpos;
|
118
|
657
|
|
658 if (m->buffer != b)
|
|
659 {
|
|
660 unchain_marker (marker);
|
|
661 m->buffer = b;
|
10315
|
662 m->chain = BUF_MARKERS (b);
|
|
663 BUF_MARKERS (b) = marker;
|
118
|
664 }
|
|
665
|
|
666 return marker;
|
|
667 }
|
|
668
|
20537
|
669 /* This version of set_marker_both won't let the position
|
|
670 be outside the visible part. */
|
|
671
|
|
672 Lisp_Object
|
|
673 set_marker_restricted_both (marker, buffer, charpos, bytepos)
|
|
674 Lisp_Object marker, buffer;
|
|
675 int charpos, bytepos;
|
|
676 {
|
|
677 register struct buffer *b;
|
|
678 register struct Lisp_Marker *m;
|
|
679
|
|
680 CHECK_MARKER (marker, 0);
|
|
681
|
|
682 if (NILP (buffer))
|
|
683 b = current_buffer;
|
|
684 else
|
|
685 {
|
|
686 CHECK_BUFFER (buffer, 1);
|
|
687 b = XBUFFER (buffer);
|
|
688 /* If buffer is dead, set marker to point nowhere. */
|
|
689 if (EQ (b->name, Qnil))
|
|
690 {
|
|
691 unchain_marker (marker);
|
|
692 return marker;
|
|
693 }
|
|
694 }
|
|
695
|
|
696 m = XMARKER (marker);
|
|
697
|
|
698 if (charpos < BUF_BEGV (b))
|
|
699 charpos = BUF_BEGV (b);
|
|
700 if (charpos > BUF_ZV (b))
|
|
701 charpos = BUF_ZV (b);
|
|
702 if (bytepos < BUF_BEGV_BYTE (b))
|
|
703 bytepos = BUF_BEGV_BYTE (b);
|
|
704 if (bytepos > BUF_ZV_BYTE (b))
|
|
705 bytepos = BUF_ZV_BYTE (b);
|
|
706
|
|
707 /* In a single-byte buffer, the two positions must be equal. */
|
|
708 if (BUF_Z (b) == BUF_Z_BYTE (b)
|
|
709 && charpos != bytepos)
|
|
710 abort ();
|
|
711 /* Every character is at least one byte. */
|
|
712 if (charpos > bytepos)
|
|
713 abort ();
|
|
714
|
20563
|
715 m->bytepos = bytepos;
|
20537
|
716 m->charpos = charpos;
|
|
717
|
|
718 if (m->buffer != b)
|
|
719 {
|
|
720 unchain_marker (marker);
|
|
721 m->buffer = b;
|
|
722 m->chain = BUF_MARKERS (b);
|
|
723 BUF_MARKERS (b) = marker;
|
|
724 }
|
|
725
|
|
726 return marker;
|
|
727 }
|
|
728
|
118
|
729 /* This is called during garbage collection,
|
|
730 so we must be careful to ignore and preserve mark bits,
|
|
731 including those in chain fields of markers. */
|
|
732
|
20301
|
733 void
|
118
|
734 unchain_marker (marker)
|
|
735 register Lisp_Object marker;
|
|
736 {
|
|
737 register Lisp_Object tail, prev, next;
|
8829
|
738 register EMACS_INT omark;
|
118
|
739 register struct buffer *b;
|
|
740
|
|
741 b = XMARKER (marker)->buffer;
|
|
742 if (b == 0)
|
|
743 return;
|
|
744
|
|
745 if (EQ (b->name, Qnil))
|
|
746 abort ();
|
|
747
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
748 XMARKER (marker)->buffer = 0;
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
749
|
10315
|
750 tail = BUF_MARKERS (b);
|
118
|
751 prev = Qnil;
|
28417
4b675266db04
* lisp.h (XCONS, XSTRING, XSYMBOL, XFLOAT, XPROCESS, XWINDOW, XSUBR, XBUFFER):
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
752 while (! GC_NILP (tail))
|
118
|
753 {
|
|
754 next = XMARKER (tail)->chain;
|
|
755 XUNMARK (next);
|
|
756
|
|
757 if (XMARKER (marker) == XMARKER (tail))
|
|
758 {
|
484
|
759 if (NILP (prev))
|
118
|
760 {
|
10315
|
761 BUF_MARKERS (b) = next;
|
|
762 /* Deleting first marker from the buffer's chain. Crash
|
|
763 if new first marker in chain does not say it belongs
|
10999
|
764 to the same buffer, or at least that they have the same
|
|
765 base buffer. */
|
|
766 if (!NILP (next) && b->text != XMARKER (next)->buffer->text)
|
118
|
767 abort ();
|
|
768 }
|
|
769 else
|
|
770 {
|
|
771 omark = XMARKBIT (XMARKER (prev)->chain);
|
|
772 XMARKER (prev)->chain = next;
|
|
773 XSETMARKBIT (XMARKER (prev)->chain, omark);
|
|
774 }
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
775 /* We have removed the marker from the chain;
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
776 no need to scan the rest of the chain. */
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
777 return;
|
118
|
778 }
|
|
779 else
|
|
780 prev = tail;
|
|
781 tail = next;
|
|
782 }
|
22022
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
783
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
784 /* Marker was not in its chain. */
|
64ac294567a6
(unchain_marker): Abort if the marker is not in its buffer's chain.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
785 abort ();
|
118
|
786 }
|
|
787
|
20537
|
788 /* Return the char position of marker MARKER, as a C integer. */
|
10315
|
789
|
|
790 int
|
118
|
791 marker_position (marker)
|
|
792 Lisp_Object marker;
|
|
793 {
|
|
794 register struct Lisp_Marker *m = XMARKER (marker);
|
|
795 register struct buffer *buf = m->buffer;
|
20537
|
796
|
|
797 if (!buf)
|
|
798 error ("Marker does not point anywhere");
|
|
799
|
|
800 return m->charpos;
|
|
801 }
|
|
802
|
|
803 /* Return the byte position of marker MARKER, as a C integer. */
|
|
804
|
|
805 int
|
|
806 marker_byte_position (marker)
|
|
807 Lisp_Object marker;
|
|
808 {
|
|
809 register struct Lisp_Marker *m = XMARKER (marker);
|
|
810 register struct buffer *buf = m->buffer;
|
20563
|
811 register int i = m->bytepos;
|
118
|
812
|
|
813 if (!buf)
|
|
814 error ("Marker does not point anywhere");
|
|
815
|
20537
|
816 if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
|
118
|
817 abort ();
|
|
818
|
|
819 return i;
|
|
820 }
|
12999
|
821
|
|
822 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
|
118
|
823 "Return a new marker pointing at the same place as MARKER.\n\
|
|
824 If argument is a number, makes a new marker pointing\n\
|
12999
|
825 at that position in the current buffer.\n\
|
|
826 The optional argument TYPE specifies the insertion type of the new marker;\n\
|
|
827 see `marker-insertion-type'.")
|
|
828 (marker, type)
|
|
829 register Lisp_Object marker, type;
|
118
|
830 {
|
|
831 register Lisp_Object new;
|
|
832
|
22744
|
833 if (! (INTEGERP (marker) || MARKERP (marker)))
|
12999
|
834 marker = wrong_type_argument (Qinteger_or_marker_p, marker);
|
22744
|
835
|
|
836 new = Fmake_marker ();
|
|
837 Fset_marker (new, marker,
|
|
838 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
|
|
839 XMARKER (new)->insertion_type = !NILP (type);
|
|
840 return new;
|
12999
|
841 }
|
|
842
|
|
843 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
|
|
844 Smarker_insertion_type, 1, 1, 0,
|
|
845 "Return insertion type of MARKER: t if it stays after inserted text.\n\
|
|
846 nil means the marker stays before text inserted there.")
|
|
847 (marker)
|
|
848 register Lisp_Object marker;
|
|
849 {
|
|
850 register Lisp_Object buf;
|
|
851 CHECK_MARKER (marker, 0);
|
|
852 return XMARKER (marker)->insertion_type ? Qt : Qnil;
|
|
853 }
|
|
854
|
|
855 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
|
|
856 Sset_marker_insertion_type, 2, 2, 0,
|
|
857 "Set the insertion-type of MARKER to TYPE.\n\
|
|
858 If TYPE is t, it means the marker advances when you insert text at it.\n\
|
13327
|
859 If TYPE is nil, it means the marker stays behind when you insert text at it.")
|
12999
|
860 (marker, type)
|
|
861 Lisp_Object marker, type;
|
|
862 {
|
|
863 CHECK_MARKER (marker, 0);
|
|
864
|
|
865 XMARKER (marker)->insertion_type = ! NILP (type);
|
|
866 return type;
|
118
|
867 }
|
16418
|
868
|
|
869 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
|
|
870 1, 1, 0,
|
20537
|
871 "Return t if there are markers pointing at POSITION in the current buffer.")
|
16418
|
872 (position)
|
|
873 Lisp_Object position;
|
|
874 {
|
|
875 register Lisp_Object tail;
|
|
876 register int charno;
|
|
877
|
|
878 charno = XINT (position);
|
|
879
|
|
880 if (charno < BEG)
|
|
881 charno = BEG;
|
|
882 if (charno > Z)
|
|
883 charno = Z;
|
|
884
|
|
885 for (tail = BUF_MARKERS (current_buffer);
|
21458
|
886 !NILP (tail);
|
16418
|
887 tail = XMARKER (tail)->chain)
|
20537
|
888 if (XMARKER (tail)->charpos == charno)
|
16418
|
889 return Qt;
|
|
890
|
|
891 return Qnil;
|
|
892 }
|
118
|
893
|
20301
|
894 void
|
118
|
895 syms_of_marker ()
|
|
896 {
|
|
897 defsubr (&Smarker_position);
|
|
898 defsubr (&Smarker_buffer);
|
|
899 defsubr (&Sset_marker);
|
|
900 defsubr (&Scopy_marker);
|
12999
|
901 defsubr (&Smarker_insertion_type);
|
|
902 defsubr (&Sset_marker_insertion_type);
|
16418
|
903 defsubr (&Sbuffer_has_markers_at);
|
20872
|
904
|
|
905 DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
|
|
906 "Non-nil enables debugging checks in byte/char position conversions.");
|
|
907 byte_debug_flag = 0;
|
|
908
|
118
|
909 }
|