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