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