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