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