Add functions to gnutls.c for exporting certificate details
[emacs.git] / src / marker.c
blobd377efbc4faf10ea0711e887f37017584d5a23ba
1 /* Markers: examining, setting and deleting.
2 Copyright (C) 1985, 1997-1998, 2001-2014 Free Software Foundation,
3 Inc.
5 This file is part of GNU Emacs.
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 3 of the License, or
10 (at your option) any later version.
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.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
23 #include "lisp.h"
24 #include "character.h"
25 #include "buffer.h"
27 /* Record one cached position found recently by
28 buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
30 static ptrdiff_t cached_charpos;
31 static ptrdiff_t cached_bytepos;
32 static struct buffer *cached_buffer;
33 static EMACS_INT cached_modiff;
35 /* Juanma Barranquero <lekktu@gmail.com> reported ~3x increased
36 bootstrap time when byte_char_debug_check is enabled; so this
37 is never turned on by --enable-checking configure option. */
39 #ifdef MARKER_DEBUG
41 extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
42 extern ptrdiff_t verify_bytepos (ptrdiff_t charpos) EXTERNALLY_VISIBLE;
44 static void
45 byte_char_debug_check (struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos)
47 ptrdiff_t nchars;
49 if (NILP (BVAR (b, enable_multibyte_characters)))
50 return;
52 if (bytepos > BUF_GPT_BYTE (b))
53 nchars
54 = multibyte_chars_in_text (BUF_BEG_ADDR (b),
55 BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b))
56 + multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
57 bytepos - BUF_GPT_BYTE (b));
58 else
59 nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
60 bytepos - BUF_BEG_BYTE (b));
62 if (charpos - 1 != nchars)
63 emacs_abort ();
66 #else /* not MARKER_DEBUG */
68 #define byte_char_debug_check(b, charpos, bytepos) do { } while (0)
70 #endif /* MARKER_DEBUG */
72 void
73 clear_charpos_cache (struct buffer *b)
75 if (cached_buffer == b)
76 cached_buffer = 0;
79 /* Converting between character positions and byte positions. */
81 /* There are several places in the buffer where we know
82 the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
83 and everywhere there is a marker. So we find the one of these places
84 that is closest to the specified position, and scan from there. */
86 /* This macro is a subroutine of buf_charpos_to_bytepos.
87 Note that it is desirable that BYTEPOS is not evaluated
88 except when we really want its value. */
90 #define CONSIDER(CHARPOS, BYTEPOS) \
91 { \
92 ptrdiff_t this_charpos = (CHARPOS); \
93 bool changed = 0; \
95 if (this_charpos == charpos) \
96 { \
97 ptrdiff_t value = (BYTEPOS); \
99 byte_char_debug_check (b, charpos, value); \
100 return value; \
102 else if (this_charpos > charpos) \
104 if (this_charpos < best_above) \
106 best_above = this_charpos; \
107 best_above_byte = (BYTEPOS); \
108 changed = 1; \
111 else if (this_charpos > best_below) \
113 best_below = this_charpos; \
114 best_below_byte = (BYTEPOS); \
115 changed = 1; \
118 if (changed) \
120 if (best_above - best_below == best_above_byte - best_below_byte) \
122 ptrdiff_t value = best_below_byte + (charpos - best_below); \
124 byte_char_debug_check (b, charpos, value); \
125 return value; \
130 static void
131 CHECK_MARKER (Lisp_Object x)
133 CHECK_TYPE (MARKERP (x), Qmarkerp, x);
136 /* Return the byte position corresponding to CHARPOS in B. */
138 ptrdiff_t
139 buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
141 struct Lisp_Marker *tail;
142 ptrdiff_t best_above, best_above_byte;
143 ptrdiff_t best_below, best_below_byte;
145 eassert (BUF_BEG (b) <= charpos && charpos <= BUF_Z (b));
147 best_above = BUF_Z (b);
148 best_above_byte = BUF_Z_BYTE (b);
150 /* If this buffer has as many characters as bytes,
151 each character must be one byte.
152 This takes care of the case where enable-multibyte-characters is nil. */
153 if (best_above == best_above_byte)
154 return charpos;
156 best_below = BEG;
157 best_below_byte = BEG_BYTE;
159 /* We find in best_above and best_above_byte
160 the closest known point above CHARPOS,
161 and in best_below and best_below_byte
162 the closest known point below CHARPOS,
164 If at any point we can tell that the space between those
165 two best approximations is all single-byte,
166 we interpolate the result immediately. */
168 CONSIDER (BUF_PT (b), BUF_PT_BYTE (b));
169 CONSIDER (BUF_GPT (b), BUF_GPT_BYTE (b));
170 CONSIDER (BUF_BEGV (b), BUF_BEGV_BYTE (b));
171 CONSIDER (BUF_ZV (b), BUF_ZV_BYTE (b));
173 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
174 CONSIDER (cached_charpos, cached_bytepos);
176 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
178 CONSIDER (tail->charpos, tail->bytepos);
180 /* If we are down to a range of 50 chars,
181 don't bother checking any other markers;
182 scan the intervening chars directly now. */
183 if (best_above - best_below < 50)
184 break;
187 /* We get here if we did not exactly hit one of the known places.
188 We have one known above and one known below.
189 Scan, counting characters, from whichever one is closer. */
191 if (charpos - best_below < best_above - charpos)
193 bool record = charpos - best_below > 5000;
195 while (best_below != charpos)
197 best_below++;
198 BUF_INC_POS (b, best_below_byte);
201 /* If this position is quite far from the nearest known position,
202 cache the correspondence by creating a marker here.
203 It will last until the next GC. */
204 if (record)
205 build_marker (b, best_below, best_below_byte);
207 byte_char_debug_check (b, best_below, best_below_byte);
209 cached_buffer = b;
210 cached_modiff = BUF_MODIFF (b);
211 cached_charpos = best_below;
212 cached_bytepos = best_below_byte;
214 return best_below_byte;
216 else
218 bool record = best_above - charpos > 5000;
220 while (best_above != charpos)
222 best_above--;
223 BUF_DEC_POS (b, best_above_byte);
226 /* If this position is quite far from the nearest known position,
227 cache the correspondence by creating a marker here.
228 It will last until the next GC. */
229 if (record)
230 build_marker (b, best_above, best_above_byte);
232 byte_char_debug_check (b, best_above, best_above_byte);
234 cached_buffer = b;
235 cached_modiff = BUF_MODIFF (b);
236 cached_charpos = best_above;
237 cached_bytepos = best_above_byte;
239 return best_above_byte;
243 #undef CONSIDER
245 /* This macro is a subroutine of buf_bytepos_to_charpos.
246 It is used when BYTEPOS is actually the byte position. */
248 #define CONSIDER(BYTEPOS, CHARPOS) \
250 ptrdiff_t this_bytepos = (BYTEPOS); \
251 int changed = 0; \
253 if (this_bytepos == bytepos) \
255 ptrdiff_t value = (CHARPOS); \
257 byte_char_debug_check (b, value, bytepos); \
258 return value; \
260 else if (this_bytepos > bytepos) \
262 if (this_bytepos < best_above_byte) \
264 best_above = (CHARPOS); \
265 best_above_byte = this_bytepos; \
266 changed = 1; \
269 else if (this_bytepos > best_below_byte) \
271 best_below = (CHARPOS); \
272 best_below_byte = this_bytepos; \
273 changed = 1; \
276 if (changed) \
278 if (best_above - best_below == best_above_byte - best_below_byte) \
280 ptrdiff_t value = best_below + (bytepos - best_below_byte); \
282 byte_char_debug_check (b, value, bytepos); \
283 return value; \
288 /* Return the character position corresponding to BYTEPOS in B. */
290 ptrdiff_t
291 buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
293 struct Lisp_Marker *tail;
294 ptrdiff_t best_above, best_above_byte;
295 ptrdiff_t best_below, best_below_byte;
297 eassert (BUF_BEG_BYTE (b) <= bytepos && bytepos <= BUF_Z_BYTE (b));
299 best_above = BUF_Z (b);
300 best_above_byte = BUF_Z_BYTE (b);
302 /* If this buffer has as many characters as bytes,
303 each character must be one byte.
304 This takes care of the case where enable-multibyte-characters is nil. */
305 if (best_above == best_above_byte)
306 return bytepos;
308 best_below = BEG;
309 best_below_byte = BEG_BYTE;
311 CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
312 CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
313 CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
314 CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
316 if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
317 CONSIDER (cached_bytepos, cached_charpos);
319 for (tail = BUF_MARKERS (b); tail; tail = tail->next)
321 CONSIDER (tail->bytepos, tail->charpos);
323 /* If we are down to a range of 50 chars,
324 don't bother checking any other markers;
325 scan the intervening chars directly now. */
326 if (best_above - best_below < 50)
327 break;
330 /* We get here if we did not exactly hit one of the known places.
331 We have one known above and one known below.
332 Scan, counting characters, from whichever one is closer. */
334 if (bytepos - best_below_byte < best_above_byte - bytepos)
336 bool record = bytepos - best_below_byte > 5000;
338 while (best_below_byte < bytepos)
340 best_below++;
341 BUF_INC_POS (b, best_below_byte);
344 /* If this position is quite far from the nearest known position,
345 cache the correspondence by creating a marker here.
346 It will last until the next GC.
347 But don't do it if BUF_MARKERS is nil;
348 that is a signal from Fset_buffer_multibyte. */
349 if (record && BUF_MARKERS (b))
350 build_marker (b, best_below, best_below_byte);
352 byte_char_debug_check (b, best_below, best_below_byte);
354 cached_buffer = b;
355 cached_modiff = BUF_MODIFF (b);
356 cached_charpos = best_below;
357 cached_bytepos = best_below_byte;
359 return best_below;
361 else
363 bool record = best_above_byte - bytepos > 5000;
365 while (best_above_byte > bytepos)
367 best_above--;
368 BUF_DEC_POS (b, best_above_byte);
371 /* If this position is quite far from the nearest known position,
372 cache the correspondence by creating a marker here.
373 It will last until the next GC.
374 But don't do it if BUF_MARKERS is nil;
375 that is a signal from Fset_buffer_multibyte. */
376 if (record && BUF_MARKERS (b))
377 build_marker (b, best_above, best_above_byte);
379 byte_char_debug_check (b, best_above, best_above_byte);
381 cached_buffer = b;
382 cached_modiff = BUF_MODIFF (b);
383 cached_charpos = best_above;
384 cached_bytepos = best_above_byte;
386 return best_above;
390 #undef CONSIDER
392 /* Operations on markers. */
394 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
395 doc: /* Return the buffer that MARKER points into, or nil if none.
396 Returns nil if MARKER points into a dead buffer. */)
397 (register Lisp_Object marker)
399 register Lisp_Object buf;
400 CHECK_MARKER (marker);
401 if (XMARKER (marker)->buffer)
403 XSETBUFFER (buf, XMARKER (marker)->buffer);
404 /* If the buffer is dead, we're in trouble: the buffer pointer here
405 does not preserve the buffer from being GC'd (it's weak), so
406 markers have to be unlinked from their buffer as soon as the buffer
407 is killed. */
408 eassert (BUFFER_LIVE_P (XBUFFER (buf)));
409 return buf;
411 return Qnil;
414 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
415 doc: /* Return the position MARKER points at, as a character number.
416 Returns nil if MARKER points nowhere. */)
417 (Lisp_Object marker)
419 CHECK_MARKER (marker);
420 if (XMARKER (marker)->buffer)
421 return make_number (XMARKER (marker)->charpos);
423 return Qnil;
426 /* Change M so it points to B at CHARPOS and BYTEPOS. */
428 static void
429 attach_marker (struct Lisp_Marker *m, struct buffer *b,
430 ptrdiff_t charpos, ptrdiff_t bytepos)
432 /* In a single-byte buffer, two positions must be equal.
433 Otherwise, every character is at least one byte. */
434 if (BUF_Z (b) == BUF_Z_BYTE (b))
435 eassert (charpos == bytepos);
436 else
437 eassert (charpos <= bytepos);
439 m->charpos = charpos;
440 m->bytepos = bytepos;
442 if (m->buffer != b)
444 unchain_marker (m);
445 m->buffer = b;
446 m->next = BUF_MARKERS (b);
447 BUF_MARKERS (b) = m;
451 /* If BUFFER is nil, return current buffer pointer. Next, check
452 whether BUFFER is a buffer object and return buffer pointer
453 corresponding to BUFFER if BUFFER is live, or NULL otherwise. */
455 static struct buffer *
456 live_buffer (Lisp_Object buffer)
458 struct buffer *b = decode_buffer (buffer);
459 return BUFFER_LIVE_P (b) ? b : NULL;
462 /* Internal function to set MARKER in BUFFER at POSITION. Non-zero
463 RESTRICTED means limit the POSITION by the visible part of BUFFER. */
465 static Lisp_Object
466 set_marker_internal (Lisp_Object marker, Lisp_Object position,
467 Lisp_Object buffer, bool restricted)
469 struct Lisp_Marker *m;
470 struct buffer *b = live_buffer (buffer);
472 CHECK_MARKER (marker);
473 m = XMARKER (marker);
475 /* Set MARKER to point nowhere if BUFFER is dead, or
476 POSITION is nil or a marker points to nowhere. */
477 if (NILP (position)
478 || (MARKERP (position) && !XMARKER (position)->buffer)
479 || !b)
480 unchain_marker (m);
482 /* Optimize the special case where we are copying the position of
483 an existing marker, and MARKER is already in the same buffer. */
484 else if (MARKERP (position) && b == XMARKER (position)->buffer
485 && b == m->buffer)
487 m->bytepos = XMARKER (position)->bytepos;
488 m->charpos = XMARKER (position)->charpos;
491 else
493 register ptrdiff_t charpos, bytepos;
495 /* Do not use CHECK_NUMBER_COERCE_MARKER because we
496 don't want to call buf_charpos_to_bytepos if POSITION
497 is a marker and so we know the bytepos already. */
498 if (INTEGERP (position))
499 charpos = XINT (position), bytepos = -1;
500 else if (MARKERP (position))
502 charpos = XMARKER (position)->charpos;
503 bytepos = XMARKER (position)->bytepos;
505 else
506 wrong_type_argument (Qinteger_or_marker_p, position);
508 charpos = clip_to_bounds
509 (restricted ? BUF_BEGV (b) : BUF_BEG (b), charpos,
510 restricted ? BUF_ZV (b) : BUF_Z (b));
511 if (bytepos == -1)
512 bytepos = buf_charpos_to_bytepos (b, charpos);
513 else
514 bytepos = clip_to_bounds
515 (restricted ? BUF_BEGV_BYTE (b) : BUF_BEG_BYTE (b),
516 bytepos, restricted ? BUF_ZV_BYTE (b) : BUF_Z_BYTE (b));
518 attach_marker (m, b, charpos, bytepos);
520 return marker;
523 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
524 doc: /* Position MARKER before character number POSITION in BUFFER.
525 If BUFFER is omitted or nil, it defaults to the current buffer. If
526 POSITION is nil, makes marker point nowhere so it no longer slows down
527 editing in any buffer. Returns MARKER. */)
528 (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
530 return set_marker_internal (marker, position, buffer, 0);
533 /* Like the above, but won't let the position be outside the visible part. */
535 Lisp_Object
536 set_marker_restricted (Lisp_Object marker, Lisp_Object position,
537 Lisp_Object buffer)
539 return set_marker_internal (marker, position, buffer, 1);
542 /* Set the position of MARKER, specifying both the
543 character position and the corresponding byte position. */
545 Lisp_Object
546 set_marker_both (Lisp_Object marker, Lisp_Object buffer,
547 ptrdiff_t charpos, ptrdiff_t bytepos)
549 register struct Lisp_Marker *m;
550 register struct buffer *b = live_buffer (buffer);
552 CHECK_MARKER (marker);
553 m = XMARKER (marker);
555 if (b)
556 attach_marker (m, b, charpos, bytepos);
557 else
558 unchain_marker (m);
559 return marker;
562 /* Like the above, but won't let the position be outside the visible part. */
564 Lisp_Object
565 set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer,
566 ptrdiff_t charpos, ptrdiff_t bytepos)
568 register struct Lisp_Marker *m;
569 register struct buffer *b = live_buffer (buffer);
571 CHECK_MARKER (marker);
572 m = XMARKER (marker);
574 if (b)
576 attach_marker
577 (m, b,
578 clip_to_bounds (BUF_BEGV (b), charpos, BUF_ZV (b)),
579 clip_to_bounds (BUF_BEGV_BYTE (b), bytepos, BUF_ZV_BYTE (b)));
581 else
582 unchain_marker (m);
583 return marker;
586 /* Remove MARKER from the chain of whatever buffer it is in,
587 leaving it points to nowhere. This is called during garbage
588 collection, so we must be careful to ignore and preserve
589 mark bits, including those in chain fields of markers. */
591 void
592 unchain_marker (register struct Lisp_Marker *marker)
594 register struct buffer *b = marker->buffer;
596 if (b)
598 register struct Lisp_Marker *tail, **prev;
600 /* No dead buffers here. */
601 eassert (BUFFER_LIVE_P (b));
603 marker->buffer = NULL;
604 prev = &BUF_MARKERS (b);
606 for (tail = BUF_MARKERS (b); tail; prev = &tail->next, tail = *prev)
607 if (marker == tail)
609 if (*prev == BUF_MARKERS (b))
611 /* Deleting first marker from the buffer's chain. Crash
612 if new first marker in chain does not say it belongs
613 to the same buffer, or at least that they have the same
614 base buffer. */
615 if (tail->next && b->text != tail->next->buffer->text)
616 emacs_abort ();
618 *prev = tail->next;
619 /* We have removed the marker from the chain;
620 no need to scan the rest of the chain. */
621 break;
624 /* Error if marker was not in it's chain. */
625 eassert (tail != NULL);
629 /* Return the char position of marker MARKER, as a C integer. */
631 ptrdiff_t
632 marker_position (Lisp_Object marker)
634 register struct Lisp_Marker *m = XMARKER (marker);
635 register struct buffer *buf = m->buffer;
637 if (!buf)
638 error ("Marker does not point anywhere");
640 eassert (BUF_BEG (buf) <= m->charpos && m->charpos <= BUF_Z (buf));
642 return m->charpos;
645 /* Return the byte position of marker MARKER, as a C integer. */
647 ptrdiff_t
648 marker_byte_position (Lisp_Object marker)
650 register struct Lisp_Marker *m = XMARKER (marker);
651 register struct buffer *buf = m->buffer;
653 if (!buf)
654 error ("Marker does not point anywhere");
656 eassert (BUF_BEG_BYTE (buf) <= m->bytepos && m->bytepos <= BUF_Z_BYTE (buf));
658 return m->bytepos;
661 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
662 doc: /* Return a new marker pointing at the same place as MARKER.
663 If argument is a number, makes a new marker pointing
664 at that position in the current buffer.
665 If MARKER is not specified, the new marker does not point anywhere.
666 The optional argument TYPE specifies the insertion type of the new marker;
667 see `marker-insertion-type'. */)
668 (register Lisp_Object marker, Lisp_Object type)
670 register Lisp_Object new;
672 if (!NILP (marker))
673 CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
675 new = Fmake_marker ();
676 Fset_marker (new, marker,
677 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
678 XMARKER (new)->insertion_type = !NILP (type);
679 return new;
682 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
683 Smarker_insertion_type, 1, 1, 0,
684 doc: /* Return insertion type of MARKER: t if it stays after inserted text.
685 The value nil means the marker stays before text inserted there. */)
686 (register Lisp_Object marker)
688 CHECK_MARKER (marker);
689 return XMARKER (marker)->insertion_type ? Qt : Qnil;
692 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
693 Sset_marker_insertion_type, 2, 2, 0,
694 doc: /* Set the insertion-type of MARKER to TYPE.
695 If TYPE is t, it means the marker advances when you insert text at it.
696 If TYPE is nil, it means the marker stays behind when you insert text at it. */)
697 (Lisp_Object marker, Lisp_Object type)
699 CHECK_MARKER (marker);
701 XMARKER (marker)->insertion_type = ! NILP (type);
702 return type;
705 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
706 1, 1, 0,
707 doc: /* Return t if there are markers pointing at POSITION in the current buffer. */)
708 (Lisp_Object position)
710 register struct Lisp_Marker *tail;
711 register ptrdiff_t charpos;
713 charpos = clip_to_bounds (BEG, XINT (position), Z);
715 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
716 if (tail->charpos == charpos)
717 return Qt;
719 return Qnil;
722 #ifdef MARKER_DEBUG
724 /* For debugging -- count the markers in buffer BUF. */
727 count_markers (struct buffer *buf)
729 int total = 0;
730 struct Lisp_Marker *tail;
732 for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
733 total++;
735 return total;
738 /* For debugging -- recompute the bytepos corresponding
739 to CHARPOS in the simplest, most reliable way. */
741 ptrdiff_t
742 verify_bytepos (ptrdiff_t charpos)
744 ptrdiff_t below = 1;
745 ptrdiff_t below_byte = 1;
747 while (below != charpos)
749 below++;
750 BUF_INC_POS (current_buffer, below_byte);
753 return below_byte;
756 #endif /* MARKER_DEBUG */
758 void
759 syms_of_marker (void)
761 defsubr (&Smarker_position);
762 defsubr (&Smarker_buffer);
763 defsubr (&Sset_marker);
764 defsubr (&Scopy_marker);
765 defsubr (&Smarker_insertion_type);
766 defsubr (&Sset_marker_insertion_type);
767 defsubr (&Sbuffer_has_markers_at);