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