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