Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-483
[bpt/emacs.git] / src / marker.c
1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997, 1998, 2003 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21
22 #include <config.h>
23 #include "lisp.h"
24 #include "buffer.h"
25 #include "charset.h"
26
27 /* Record one cached position found recently by
28 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
29
30 static int cached_charpos;
31 static int cached_bytepos;
32 static struct buffer *cached_buffer;
33 static int cached_modiff;
34
35 static void byte_char_debug_check P_ ((struct buffer *, int, int));
36
37 /* Nonzero means enable debugging checks on byte/char correspondences. */
38
39 static int byte_debug_flag;
40
41 void
42 clear_charpos_cache (b)
43 struct buffer *b;
44 {
45 if (cached_buffer == b)
46 cached_buffer = 0;
47 }
48 \f
49 /* Converting between character positions and byte positions. */
50
51 /* There are several places in the buffer where we know
52 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
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) \
68 { \
69 int value = (BYTEPOS); \
70 if (byte_debug_flag) \
71 byte_char_debug_check (b, charpos, value); \
72 return value; \
73 } \
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) \
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 } \
99 } \
100 }
101
102 static void
103 byte_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 {
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));
115 }
116 else
117 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
118 bytepos - BUF_BEG_BYTE (b));
119
120 if (charpos - 1 != nchars)
121 abort ();
122 }
123
124 int
125 charpos_to_bytepos (charpos)
126 int charpos;
127 {
128 return buf_charpos_to_bytepos (current_buffer, charpos);
129 }
130
131 int
132 buf_charpos_to_bytepos (b, charpos)
133 struct buffer *b;
134 int charpos;
135 {
136 struct Lisp_Marker *tail;
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
152 best_below = BEG;
153 best_below_byte = BEG_BYTE;
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
172 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
173 {
174 CONSIDER (tail->charpos, tail->bytepos);
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;
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 {
202 Lisp_Object marker, buffer;
203 marker = Fmake_marker ();
204 XSETBUFFER (buffer, b);
205 set_marker_both (marker, buffer, best_below, best_below_byte);
206 }
207
208 if (byte_debug_flag)
209 byte_char_debug_check (b, charpos, best_below_byte);
210
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 {
233 Lisp_Object marker, buffer;
234 marker = Fmake_marker ();
235 XSETBUFFER (buffer, b);
236 set_marker_both (marker, buffer, best_above, best_above_byte);
237 }
238
239 if (byte_debug_flag)
240 byte_char_debug_check (b, charpos, best_above_byte);
241
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
252
253 /* Used for debugging: recompute the bytepos corresponding to CHARPOS
254 in the simplest, most reliable way. */
255
256 int
257 verify_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 }
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) \
282 { \
283 int value = (CHARPOS); \
284 if (byte_debug_flag) \
285 byte_char_debug_check (b, value, bytepos); \
286 return value; \
287 } \
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) \
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 } \
313 } \
314 }
315
316 int
317 bytepos_to_charpos (bytepos)
318 int bytepos;
319 {
320 return buf_bytepos_to_charpos (current_buffer, bytepos);
321 }
322
323 int
324 buf_bytepos_to_charpos (b, bytepos)
325 struct buffer *b;
326 int bytepos;
327 {
328 struct Lisp_Marker *tail;
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
344 best_below = BEG;
345 best_below_byte = BEG_BYTE;
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
355 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
356 {
357 CONSIDER (tail->bytepos, tail->charpos);
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;
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 {
372 int record = bytepos - best_below_byte > 5000;
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.
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. */
385 if (record && BUF_MARKERS (b))
386 {
387 Lisp_Object marker, buffer;
388 marker = Fmake_marker ();
389 XSETBUFFER (buffer, b);
390 set_marker_both (marker, buffer, best_below, best_below_byte);
391 }
392
393 if (byte_debug_flag)
394 byte_char_debug_check (b, best_below, bytepos);
395
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.
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. */
418 if (record && BUF_MARKERS (b))
419 {
420 Lisp_Object marker, buffer;
421 marker = Fmake_marker ();
422 XSETBUFFER (buffer, b);
423 set_marker_both (marker, buffer, best_above, best_above_byte);
424 }
425
426 if (byte_debug_flag)
427 byte_char_debug_check (b, best_above, bytepos);
428
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
440 /* Operations on markers. */
441
442 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
443 doc: /* Return the buffer that MARKER points into, or nil if none.
444 Returns nil if MARKER points into a dead buffer. */)
445 (marker)
446 register Lisp_Object marker;
447 {
448 register Lisp_Object buf;
449 CHECK_MARKER (marker);
450 if (XMARKER (marker)->buffer)
451 {
452 XSETBUFFER (buf, XMARKER (marker)->buffer);
453 /* Return marker's buffer only if it is not dead. */
454 if (!NILP (XBUFFER (buf)->name))
455 return buf;
456 }
457 return Qnil;
458 }
459
460 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
461 doc: /* Return the position MARKER points at, as a character number. */)
462 (marker)
463 Lisp_Object marker;
464 {
465 CHECK_MARKER (marker);
466 if (XMARKER (marker)->buffer)
467 return make_number (XMARKER (marker)->charpos);
468
469 return Qnil;
470 }
471 \f
472 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
473 doc: /* Position MARKER before character number POSITION in BUFFER.
474 BUFFER defaults to the current buffer.
475 If POSITION is nil, makes marker point nowhere.
476 Then it no longer slows down editing in any buffer.
477 Returns MARKER. */)
478 (marker, position, buffer)
479 Lisp_Object marker, position, buffer;
480 {
481 register int charno, bytepos;
482 register struct buffer *b;
483 register struct Lisp_Marker *m;
484
485 CHECK_MARKER (marker);
486 m = XMARKER (marker);
487
488 /* If position is nil or a marker that points nowhere,
489 make this marker point nowhere. */
490 if (NILP (position)
491 || (MARKERP (position) && !XMARKER (position)->buffer))
492 {
493 unchain_marker (m);
494 return marker;
495 }
496
497 if (NILP (buffer))
498 b = current_buffer;
499 else
500 {
501 CHECK_BUFFER (buffer);
502 b = XBUFFER (buffer);
503 /* If buffer is dead, set marker to point nowhere. */
504 if (EQ (b->name, Qnil))
505 {
506 unchain_marker (m);
507 return marker;
508 }
509 }
510
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 {
516 m->bytepos = XMARKER (position)->bytepos;
517 m->charpos = XMARKER (position)->charpos;
518 return marker;
519 }
520
521 CHECK_NUMBER_COERCE_MARKER (position);
522
523 charno = XINT (position);
524
525 if (charno < BUF_BEG (b))
526 charno = BUF_BEG (b);
527 if (charno > BUF_Z (b))
528 charno = BUF_Z (b);
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
536 m->bytepos = bytepos;
537 m->charpos = charno;
538
539 if (m->buffer != b)
540 {
541 unchain_marker (m);
542 m->buffer = b;
543 m->next = BUF_MARKERS (b);
544 BUF_MARKERS (b) = m;
545 }
546
547 return marker;
548 }
549
550 /* This version of Fset_marker won't let the position
551 be outside the visible part. */
552
553 Lisp_Object
554 set_marker_restricted (marker, pos, buffer)
555 Lisp_Object marker, pos, buffer;
556 {
557 register int charno, bytepos;
558 register struct buffer *b;
559 register struct Lisp_Marker *m;
560
561 CHECK_MARKER (marker);
562 m = XMARKER (marker);
563
564 /* If position is nil or a marker that points nowhere,
565 make this marker point nowhere. */
566 if (NILP (pos)
567 || (MARKERP (pos) && !XMARKER (pos)->buffer))
568 {
569 unchain_marker (m);
570 return marker;
571 }
572
573 if (NILP (buffer))
574 b = current_buffer;
575 else
576 {
577 CHECK_BUFFER (buffer);
578 b = XBUFFER (buffer);
579 /* If buffer is dead, set marker to point nowhere. */
580 if (EQ (b->name, Qnil))
581 {
582 unchain_marker (m);
583 return marker;
584 }
585 }
586
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 {
592 m->bytepos = XMARKER (pos)->bytepos;
593 m->charpos = XMARKER (pos)->charpos;
594 return marker;
595 }
596
597 CHECK_NUMBER_COERCE_MARKER (pos);
598
599 charno = XINT (pos);
600
601 if (charno < BUF_BEGV (b))
602 charno = BUF_BEGV (b);
603 if (charno > BUF_ZV (b))
604 charno = BUF_ZV (b);
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
612 m->bytepos = bytepos;
613 m->charpos = charno;
614
615 if (m->buffer != b)
616 {
617 unchain_marker (m);
618 m->buffer = b;
619 m->next = BUF_MARKERS (b);
620 BUF_MARKERS (b) = m;
621 }
622
623 return marker;
624 }
625 \f
626 /* Set the position of MARKER, specifying both the
627 character position and the corresponding byte position. */
628
629 Lisp_Object
630 set_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
637 CHECK_MARKER (marker);
638 m = XMARKER (marker);
639
640 if (NILP (buffer))
641 b = current_buffer;
642 else
643 {
644 CHECK_BUFFER (buffer);
645 b = XBUFFER (buffer);
646 /* If buffer is dead, set marker to point nowhere. */
647 if (EQ (b->name, Qnil))
648 {
649 unchain_marker (m);
650 return marker;
651 }
652 }
653
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
662 m->bytepos = bytepos;
663 m->charpos = charpos;
664
665 if (m->buffer != b)
666 {
667 unchain_marker (m);
668 m->buffer = b;
669 m->next = BUF_MARKERS (b);
670 BUF_MARKERS (b) = m;
671 }
672
673 return marker;
674 }
675
676 /* This version of set_marker_both won't let the position
677 be outside the visible part. */
678
679 Lisp_Object
680 set_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
687 CHECK_MARKER (marker);
688 m = XMARKER (marker);
689
690 if (NILP (buffer))
691 b = current_buffer;
692 else
693 {
694 CHECK_BUFFER (buffer);
695 b = XBUFFER (buffer);
696 /* If buffer is dead, set marker to point nowhere. */
697 if (EQ (b->name, Qnil))
698 {
699 unchain_marker (m);
700 return marker;
701 }
702 }
703
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
721 m->bytepos = bytepos;
722 m->charpos = charpos;
723
724 if (m->buffer != b)
725 {
726 unchain_marker (m);
727 m->buffer = b;
728 m->next = BUF_MARKERS (b);
729 BUF_MARKERS (b) = m;
730 }
731
732 return marker;
733 }
734 \f
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,
739 so we must be careful to ignore and preserve mark bits,
740 including those in chain fields of markers. */
741
742 void
743 unchain_marker (marker)
744 register struct Lisp_Marker *marker;
745 {
746 register struct Lisp_Marker *tail, *prev, *next;
747 register struct buffer *b;
748
749 b = marker->buffer;
750 if (b == 0)
751 return;
752
753 if (EQ (b->name, Qnil))
754 abort ();
755
756 marker->buffer = 0;
757
758 tail = BUF_MARKERS (b);
759 prev = NULL;
760 while (tail)
761 {
762 next = tail->next;
763
764 if (marker == tail)
765 {
766 if (!prev)
767 {
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
771 to the same buffer, or at least that they have the same
772 base buffer. */
773 if (next && b->text != next->buffer->text)
774 abort ();
775 }
776 else
777 prev->next = next;
778 /* We have removed the marker from the chain;
779 no need to scan the rest of the chain. */
780 return;
781 }
782 else
783 prev = tail;
784 tail = next;
785 }
786
787 /* Marker was not in its chain. */
788 abort ();
789 }
790
791 /* Return the char position of marker MARKER, as a C integer. */
792
793 int
794 marker_position (marker)
795 Lisp_Object marker;
796 {
797 register struct Lisp_Marker *m = XMARKER (marker);
798 register struct buffer *buf = m->buffer;
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
808 int
809 marker_byte_position (marker)
810 Lisp_Object marker;
811 {
812 register struct Lisp_Marker *m = XMARKER (marker);
813 register struct buffer *buf = m->buffer;
814 register int i = m->bytepos;
815
816 if (!buf)
817 error ("Marker does not point anywhere");
818
819 if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
820 abort ();
821
822 return i;
823 }
824 \f
825 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
826 doc: /* Return a new marker pointing at the same place as MARKER.
827 If argument is a number, makes a new marker pointing
828 at that position in the current buffer.
829 The optional argument TYPE specifies the insertion type of the new marker;
830 see `marker-insertion-type'. */)
831 (marker, type)
832 register Lisp_Object marker, type;
833 {
834 register Lisp_Object new;
835
836 if (! (INTEGERP (marker) || MARKERP (marker)))
837 marker = wrong_type_argument (Qinteger_or_marker_p, marker);
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;
844 }
845
846 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
847 Smarker_insertion_type, 1, 1, 0,
848 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
849 nil means the marker stays before text inserted there. */)
850 (marker)
851 register Lisp_Object marker;
852 {
853 CHECK_MARKER (marker);
854 return XMARKER (marker)->insertion_type ? Qt : Qnil;
855 }
856
857 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
858 Sset_marker_insertion_type, 2, 2, 0,
859 doc: /* Set the insertion-type of MARKER to TYPE.
860 If TYPE is t, it means the marker advances when you insert text at it.
861 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
862 (marker, type)
863 Lisp_Object marker, type;
864 {
865 CHECK_MARKER (marker);
866
867 XMARKER (marker)->insertion_type = ! NILP (type);
868 return type;
869 }
870
871 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
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;
876 {
877 register struct Lisp_Marker *tail;
878 register int charno;
879
880 charno = XINT (position);
881
882 if (charno < BEG)
883 charno = BEG;
884 if (charno > Z)
885 charno = Z;
886
887 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
888 if (tail->charpos == charno)
889 return Qt;
890
891 return Qnil;
892 }
893
894 /* For debugging -- count the markers in buffer BUF. */
895
896 int
897 count_markers (buf)
898 struct buffer *buf;
899 {
900 int total = 0;
901 struct Lisp_Marker *tail;
902
903 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
904 total++;
905
906 return total;
907 }
908 \f
909 void
910 syms_of_marker ()
911 {
912 defsubr (&Smarker_position);
913 defsubr (&Smarker_buffer);
914 defsubr (&Sset_marker);
915 defsubr (&Scopy_marker);
916 defsubr (&Smarker_insertion_type);
917 defsubr (&Sset_marker_insertion_type);
918 defsubr (&Sbuffer_has_markers_at);
919
920 DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
921 doc: /* Non-nil enables debugging checks in byte/char position conversions. */);
922 byte_debug_flag = 0;
923 }
924
925 /* arch-tag: 50aa418f-cdd0-4838-b64b-94aa4b2a3b74
926 (do not change this comment) */