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