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