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