marker.c 21.7 KB
Newer Older
1
/* Markers: examining, setting and deleting.
Paul Eggert's avatar
Paul Eggert committed
2
   Copyright (C) 1985, 1997-1998, 2001-2019 Free Software Foundation,
3
   Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
18
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
19 20


21
#include <config.h>
22

Jim Blandy's avatar
Jim Blandy committed
23
#include "lisp.h"
24
#include "character.h"
25
#include "buffer.h"
Jim Blandy's avatar
Jim Blandy committed
26

27 28 29
/* Record one cached position found recently by
   buf_charpos_to_bytepos or buf_bytepos_to_charpos.  */

30 31
static ptrdiff_t cached_charpos;
static ptrdiff_t cached_bytepos;
32
static struct buffer *cached_buffer;
33
static EMACS_INT cached_modiff;
34

35 36 37 38 39
/* Juanma Barranquero <lekktu@gmail.com> reported ~3x increased
   bootstrap time when byte_char_debug_check is enabled; so this
   is never turned on by --enable-checking configure option.  */

#ifdef MARKER_DEBUG
40

41
extern int count_markers (struct buffer *) EXTERNALLY_VISIBLE;
42
extern ptrdiff_t verify_bytepos (ptrdiff_t charpos) EXTERNALLY_VISIBLE;
43 44 45 46

static void
byte_char_debug_check (struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos)
{
Dmitry Antipov's avatar
Dmitry Antipov committed
47 48 49 50
  ptrdiff_t nchars;

  if (NILP (BVAR (b, enable_multibyte_characters)))
    return;
51 52

  if (bytepos > BUF_GPT_BYTE (b))
Dmitry Antipov's avatar
Dmitry Antipov committed
53 54 55 56 57
    nchars
      = multibyte_chars_in_text (BUF_BEG_ADDR (b),
				 BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b))
      + multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
				 bytepos - BUF_GPT_BYTE (b));
58 59 60 61 62
  else
    nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
				      bytepos - BUF_BEG_BYTE (b));

  if (charpos - 1 != nchars)
63
    emacs_abort ();
64 65
}

66
#else /* not MARKER_DEBUG */
67

68
#define byte_char_debug_check(b, charpos, bytepos) do { } while (0)
69

70
#endif /* MARKER_DEBUG */
71

Andreas Schwab's avatar
Andreas Schwab committed
72
void
73
clear_charpos_cache (struct buffer *b)
74 75 76 77
{
  if (cached_buffer == b)
    cached_buffer = 0;
}
78 79 80 81

/* Converting between character positions and byte positions.  */

/* There are several places in the buffer where we know
Juanma Barranquero's avatar
Juanma Barranquero committed
82
   the correspondence: BEG, BEGV, PT, GPT, ZV and Z,
83 84 85
   and everywhere there is a marker.  So we find the one of these places
   that is closest to the specified position, and scan from there.  */

86
/* This macro is a subroutine of buf_charpos_to_bytepos.
87 88 89 90 91
   Note that it is desirable that BYTEPOS is not evaluated
   except when we really want its value.  */

#define CONSIDER(CHARPOS, BYTEPOS)					\
{									\
92
  ptrdiff_t this_charpos = (CHARPOS);					\
93
  bool changed = 0;							\
94 95
									\
  if (this_charpos == charpos)						\
96
    {									\
97
      ptrdiff_t value = (BYTEPOS);				       	\
98 99
									\
      byte_char_debug_check (b, charpos, value);			\
100 101
      return value;							\
    }									\
102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
  else if (this_charpos > charpos)					\
    {									\
      if (this_charpos < best_above)					\
	{								\
	  best_above = this_charpos;					\
	  best_above_byte = (BYTEPOS);					\
	  changed = 1;							\
	}								\
    }									\
  else if (this_charpos > best_below)					\
    {									\
      best_below = this_charpos;					\
      best_below_byte = (BYTEPOS);					\
      changed = 1;							\
    }									\
									\
  if (changed)								\
    {									\
      if (best_above - best_below == best_above_byte - best_below_byte)	\
121
        {								\
122
	  ptrdiff_t value = best_below_byte + (charpos - best_below);	\
123 124
									\
	  byte_char_debug_check (b, charpos, value);			\
125 126
	  return value;							\
	}								\
127 128 129
    }									\
}

130 131 132 133 134 135
static void
CHECK_MARKER (Lisp_Object x)
{
  CHECK_TYPE (MARKERP (x), Qmarkerp, x);
}

136
/* Return the byte position corresponding to CHARPOS in B.  */
137

138 139
ptrdiff_t
buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
140
{
141
  struct Lisp_Marker *tail;
142 143
  ptrdiff_t best_above, best_above_byte;
  ptrdiff_t best_below, best_below_byte;
144

145
  eassert (BUF_BEG (b) <= charpos && charpos <= BUF_Z (b));
146 147 148 149 150 151 152 153 154 155

  best_above = BUF_Z (b);
  best_above_byte = BUF_Z_BYTE (b);

  /* If this buffer has as many characters as bytes,
     each character must be one byte.
     This takes care of the case where enable-multibyte-characters is nil.  */
  if (best_above == best_above_byte)
    return charpos;

156 157
  best_below = BEG;
  best_below_byte = BEG_BYTE;
158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175

  /* We find in best_above and best_above_byte
     the closest known point above CHARPOS,
     and in best_below and best_below_byte
     the closest known point below CHARPOS,

     If at any point we can tell that the space between those
     two best approximations is all single-byte,
     we interpolate the result immediately.  */

  CONSIDER (BUF_PT (b), BUF_PT_BYTE (b));
  CONSIDER (BUF_GPT (b), BUF_GPT_BYTE (b));
  CONSIDER (BUF_BEGV (b), BUF_BEGV_BYTE (b));
  CONSIDER (BUF_ZV (b), BUF_ZV_BYTE (b));

  if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
    CONSIDER (cached_charpos, cached_bytepos);

176
  for (tail = BUF_MARKERS (b); tail; tail = tail->next)
177
    {
178
      CONSIDER (tail->charpos, tail->bytepos);
179 180 181 182 183 184 185 186 187 188 189 190 191 192

      /* If we are down to a range of 50 chars,
	 don't bother checking any other markers;
	 scan the intervening chars directly now.  */
      if (best_above - best_below < 50)
	break;
    }

  /* We get here if we did not exactly hit one of the known places.
     We have one known above and one known below.
     Scan, counting characters, from whichever one is closer.  */

  if (charpos - best_below < best_above - charpos)
    {
193
      bool record = charpos - best_below > 5000;
194 195 196 197 198 199 200 201 202 203 204

      while (best_below != charpos)
	{
	  best_below++;
	  BUF_INC_POS (b, best_below_byte);
	}

      /* If this position is quite far from the nearest known position,
	 cache the correspondence by creating a marker here.
	 It will last until the next GC.  */
      if (record)
205
	build_marker (b, best_below, best_below_byte);
206

Dmitry Antipov's avatar
Dmitry Antipov committed
207
      byte_char_debug_check (b, best_below, best_below_byte);
208

209 210 211 212 213 214 215 216 217
      cached_buffer = b;
      cached_modiff = BUF_MODIFF (b);
      cached_charpos = best_below;
      cached_bytepos = best_below_byte;

      return best_below_byte;
    }
  else
    {
218
      bool record = best_above - charpos > 5000;
219 220 221 222 223 224 225 226 227 228 229

      while (best_above != charpos)
	{
	  best_above--;
	  BUF_DEC_POS (b, best_above_byte);
	}

      /* If this position is quite far from the nearest known position,
	 cache the correspondence by creating a marker here.
	 It will last until the next GC.  */
      if (record)
230
	build_marker (b, best_above, best_above_byte);
231

Dmitry Antipov's avatar
Dmitry Antipov committed
232
      byte_char_debug_check (b, best_above, best_above_byte);
233

234 235 236 237 238 239 240 241 242 243
      cached_buffer = b;
      cached_modiff = BUF_MODIFF (b);
      cached_charpos = best_above;
      cached_bytepos = best_above_byte;

      return best_above_byte;
    }
}

#undef CONSIDER
244

245
/* This macro is a subroutine of buf_bytepos_to_charpos.
246 247 248 249
   It is used when BYTEPOS is actually the byte position.  */

#define CONSIDER(BYTEPOS, CHARPOS)					\
{									\
250
  ptrdiff_t this_bytepos = (BYTEPOS);					\
251 252 253
  int changed = 0;							\
									\
  if (this_bytepos == bytepos)						\
254
    {									\
255
      ptrdiff_t value = (CHARPOS);				       	\
256 257
									\
      byte_char_debug_check (b, value, bytepos);			\
258 259
      return value;							\
    }									\
260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278
  else if (this_bytepos > bytepos)					\
    {									\
      if (this_bytepos < best_above_byte)				\
	{								\
	  best_above = (CHARPOS);					\
	  best_above_byte = this_bytepos;				\
	  changed = 1;							\
	}								\
    }									\
  else if (this_bytepos > best_below_byte)				\
    {									\
      best_below = (CHARPOS);						\
      best_below_byte = this_bytepos;					\
      changed = 1;							\
    }									\
									\
  if (changed)								\
    {									\
      if (best_above - best_below == best_above_byte - best_below_byte)	\
279
	{								\
280
	  ptrdiff_t value = best_below + (bytepos - best_below_byte);	\
281 282
									\
	  byte_char_debug_check (b, value, bytepos);			\
283 284
	  return value;							\
	}								\
285 286 287
    }									\
}

288 289
/* Return the character position corresponding to BYTEPOS in B.  */

290 291
ptrdiff_t
buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
292
{
293
  struct Lisp_Marker *tail;
294 295
  ptrdiff_t best_above, best_above_byte;
  ptrdiff_t best_below, best_below_byte;
296

297
  eassert (BUF_BEG_BYTE (b) <= bytepos && bytepos <= BUF_Z_BYTE (b));
298 299 300 301 302 303 304 305 306 307

  best_above = BUF_Z (b);
  best_above_byte = BUF_Z_BYTE (b);

  /* If this buffer has as many characters as bytes,
     each character must be one byte.
     This takes care of the case where enable-multibyte-characters is nil.  */
  if (best_above == best_above_byte)
    return bytepos;

308 309
  best_below = BEG;
  best_below_byte = BEG_BYTE;
310 311 312 313 314 315 316 317 318

  CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
  CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
  CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
  CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));

  if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
    CONSIDER (cached_bytepos, cached_charpos);

319
  for (tail = BUF_MARKERS (b); tail; tail = tail->next)
320
    {
321
      CONSIDER (tail->bytepos, tail->charpos);
322 323 324 325 326 327 328 329 330 331 332 333 334 335

      /* If we are down to a range of 50 chars,
	 don't bother checking any other markers;
	 scan the intervening chars directly now.  */
      if (best_above - best_below < 50)
	break;
    }

  /* We get here if we did not exactly hit one of the known places.
     We have one known above and one known below.
     Scan, counting characters, from whichever one is closer.  */

  if (bytepos - best_below_byte < best_above_byte - bytepos)
    {
336
      bool record = bytepos - best_below_byte > 5000;
337 338 339 340 341 342 343 344 345

      while (best_below_byte < bytepos)
	{
	  best_below++;
	  BUF_INC_POS (b, best_below_byte);
	}

      /* If this position is quite far from the nearest known position,
	 cache the correspondence by creating a marker here.
346 347 348
	 It will last until the next GC.
	 But don't do it if BUF_MARKERS is nil;
	 that is a signal from Fset_buffer_multibyte.  */
349
      if (record && BUF_MARKERS (b))
350
	build_marker (b, best_below, best_below_byte);
351

Dmitry Antipov's avatar
Dmitry Antipov committed
352
      byte_char_debug_check (b, best_below, best_below_byte);
353

354 355 356 357 358 359 360 361 362
      cached_buffer = b;
      cached_modiff = BUF_MODIFF (b);
      cached_charpos = best_below;
      cached_bytepos = best_below_byte;

      return best_below;
    }
  else
    {
363
      bool record = best_above_byte - bytepos > 5000;
364 365 366 367 368 369 370 371 372

      while (best_above_byte > bytepos)
	{
	  best_above--;
	  BUF_DEC_POS (b, best_above_byte);
	}

      /* If this position is quite far from the nearest known position,
	 cache the correspondence by creating a marker here.
373 374 375
	 It will last until the next GC.
	 But don't do it if BUF_MARKERS is nil;
	 that is a signal from Fset_buffer_multibyte.  */
376
      if (record && BUF_MARKERS (b))
377
	build_marker (b, best_above, best_above_byte);
378

Dmitry Antipov's avatar
Dmitry Antipov committed
379
      byte_char_debug_check (b, best_above, best_above_byte);
380

381 382 383 384 385 386 387 388 389 390 391
      cached_buffer = b;
      cached_modiff = BUF_MODIFF (b);
      cached_charpos = best_above;
      cached_bytepos = best_above_byte;

      return best_above;
    }
}

#undef CONSIDER

Jim Blandy's avatar
Jim Blandy committed
392 393
/* Operations on markers. */

Paul Eggert's avatar
Paul Eggert committed
394
DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
395 396
       doc: /* Return the buffer that MARKER points into, or nil if none.
Returns nil if MARKER points into a dead buffer.  */)
397
  (register Lisp_Object marker)
Jim Blandy's avatar
Jim Blandy committed
398 399
{
  register Lisp_Object buf;
400
  CHECK_MARKER (marker);
Jim Blandy's avatar
Jim Blandy committed
401 402
  if (XMARKER (marker)->buffer)
    {
403
      XSETBUFFER (buf, XMARKER (marker)->buffer);
404 405 406 407
      /* If the buffer is dead, we're in trouble: the buffer pointer here
	 does not preserve the buffer from being GC'd (it's weak), so
	 markers have to be unlinked from their buffer as soon as the buffer
	 is killed.  */
408
      eassert (BUFFER_LIVE_P (XBUFFER (buf)));
409
      return buf;
Jim Blandy's avatar
Jim Blandy committed
410 411 412 413
    }
  return Qnil;
}

Paul Eggert's avatar
Paul Eggert committed
414
DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
415
       doc: /* Return the position of MARKER, or nil if it points nowhere.  */)
416
  (Lisp_Object marker)
Jim Blandy's avatar
Jim Blandy committed
417
{
418
  CHECK_MARKER (marker);
Jim Blandy's avatar
Jim Blandy committed
419
  if (XMARKER (marker)->buffer)
420
    return make_number (XMARKER (marker)->charpos);
Jim Blandy's avatar
Jim Blandy committed
421 422 423

  return Qnil;
}
424 425 426

/* Change M so it points to B at CHARPOS and BYTEPOS.  */

427
static void
428 429 430
attach_marker (struct Lisp_Marker *m, struct buffer *b,
	       ptrdiff_t charpos, ptrdiff_t bytepos)
{
431 432 433 434 435 436
  /* In a single-byte buffer, two positions must be equal.
     Otherwise, every character is at least one byte.  */
  if (BUF_Z (b) == BUF_Z_BYTE (b))
    eassert (charpos == bytepos);
  else
    eassert (charpos <= bytepos);
437 438 439 440 441 442 443 444 445 446 447 448 449

  m->charpos = charpos;
  m->bytepos = bytepos;

  if (m->buffer != b)
    {
      unchain_marker (m);
      m->buffer = b;
      m->next = BUF_MARKERS (b);
      BUF_MARKERS (b) = m;
    }
}

450 451 452
/* If BUFFER is nil, return current buffer pointer.  Next, check
   whether BUFFER is a buffer object and return buffer pointer
   corresponding to BUFFER if BUFFER is live, or NULL otherwise.  */
Jim Blandy's avatar
Jim Blandy committed
453

454
static struct buffer *
455 456
live_buffer (Lisp_Object buffer)
{
457 458
  struct buffer *b = decode_buffer (buffer);
  return BUFFER_LIVE_P (b) ? b : NULL;
Jim Blandy's avatar
Jim Blandy committed
459 460
}

461 462
/* Internal function to set MARKER in BUFFER at POSITION.  Non-zero
   RESTRICTED means limit the POSITION by the visible part of BUFFER.  */
Jim Blandy's avatar
Jim Blandy committed
463

464
static Lisp_Object
465
set_marker_internal (Lisp_Object marker, Lisp_Object position,
466
		     Lisp_Object buffer, bool restricted)
Jim Blandy's avatar
Jim Blandy committed
467
{
468 469
  struct Lisp_Marker *m;
  struct buffer *b = live_buffer (buffer);
Jim Blandy's avatar
Jim Blandy committed
470

471
  CHECK_MARKER (marker);
472 473
  m = XMARKER (marker);

474 475 476 477 478 479 480 481 482 483 484
  /* Set MARKER to point nowhere if BUFFER is dead, or
     POSITION is nil or a marker points to nowhere.  */
  if (NILP (position)
      || (MARKERP (position) && !XMARKER (position)->buffer)
      || !b)
    unchain_marker (m);

  /* Optimize the special case where we are copying the position of
     an existing marker, and MARKER is already in the same buffer.  */
  else if (MARKERP (position) && b == XMARKER (position)->buffer
	   && b == m->buffer)
Jim Blandy's avatar
Jim Blandy committed
485
    {
486 487
      m->bytepos = XMARKER (position)->bytepos;
      m->charpos = XMARKER (position)->charpos;
Jim Blandy's avatar
Jim Blandy committed
488 489 490 491
    }

  else
    {
492
      register ptrdiff_t charpos, bytepos;
493

494
      /* Do not use CHECK_NUMBER_COERCE_MARKER because we
Paul Eggert's avatar
Paul Eggert committed
495
	 don't want to call buf_charpos_to_bytepos if POSITION
496 497 498 499 500 501 502 503 504 505 506 507 508 509
	 is a marker and so we know the bytepos already.  */
      if (INTEGERP (position))
	charpos = XINT (position), bytepos = -1;
      else if (MARKERP (position))
	{
	  charpos = XMARKER (position)->charpos;
	  bytepos = XMARKER (position)->bytepos;
	}
      else
	wrong_type_argument (Qinteger_or_marker_p, position);

      charpos = clip_to_bounds
	(restricted ? BUF_BEGV (b) : BUF_BEG (b), charpos,
	 restricted ? BUF_ZV (b) : BUF_Z (b));
510 511 512 513 514
      /* Don't believe BYTEPOS if it comes from a different buffer,
	 since that buffer might have a very different correspondence
	 between character and byte positions.  */
      if (bytepos == -1
	  || !(MARKERP (position) && XMARKER (position)->buffer == b))
515 516 517 518 519 520
	bytepos = buf_charpos_to_bytepos (b, charpos);
      else
	bytepos = clip_to_bounds
	  (restricted ? BUF_BEGV_BYTE (b) : BUF_BEG_BYTE (b),
	   bytepos, restricted ? BUF_ZV_BYTE (b) : BUF_Z_BYTE (b));

521
      attach_marker (m, b, charpos, bytepos);
Jim Blandy's avatar
Jim Blandy committed
522
    }
523 524
  return marker;
}
Jim Blandy's avatar
Jim Blandy committed
525

526
DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
527 528
       doc: /* Position MARKER before character number POSITION in BUFFER.
If BUFFER is omitted or nil, it defaults to the current buffer.  If
529 530
POSITION is nil, makes marker point nowhere so it no longer slows down
editing in any buffer.  Returns MARKER.  */)
531 532
  (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
{
Paul Eggert's avatar
Paul Eggert committed
533
  return set_marker_internal (marker, position, buffer, false);
534
}
535

536
/* Like the above, but won't let the position be outside the visible part.  */
537

538 539 540 541
Lisp_Object
set_marker_restricted (Lisp_Object marker, Lisp_Object position,
		       Lisp_Object buffer)
{
Paul Eggert's avatar
Paul Eggert committed
542
  return set_marker_internal (marker, position, buffer, true);
Jim Blandy's avatar
Jim Blandy committed
543
}
544

545 546
/* Set the position of MARKER, specifying both the
   character position and the corresponding byte position.  */
Jim Blandy's avatar
Jim Blandy committed
547

548
Lisp_Object
549 550
set_marker_both (Lisp_Object marker, Lisp_Object buffer,
		 ptrdiff_t charpos, ptrdiff_t bytepos)
551 552
{
  register struct Lisp_Marker *m;
553
  register struct buffer *b = live_buffer (buffer);
554

555
  CHECK_MARKER (marker);
556
  m = XMARKER (marker);
557

558 559
  if (b)
    attach_marker (m, b, charpos, bytepos);
560
  else
561
    unchain_marker (m);
562 563 564
  return marker;
}

565
/* Like the above, but won't let the position be outside the visible part.  */
566

567
Lisp_Object
568 569
set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer,
			    ptrdiff_t charpos, ptrdiff_t bytepos)
570 571
{
  register struct Lisp_Marker *m;
572
  register struct buffer *b = live_buffer (buffer);
573

574
  CHECK_MARKER (marker);
575
  m = XMARKER (marker);
576

577
  if (b)
578
    {
579 580
      attach_marker
	(m, b,
581 582
	 clip_to_bounds (BUF_BEGV (b), charpos, BUF_ZV (b)),
	 clip_to_bounds (BUF_BEGV_BYTE (b), bytepos, BUF_ZV_BYTE (b)));
583
    }
584 585
  else
    unchain_marker (m);
586 587
  return marker;
}
588

Paul Eggert's avatar
Paul Eggert committed
589 590 591 592 593 594 595 596 597
/* Detach a marker so that it no longer points anywhere and no longer
   slows down editing.  Do not free the marker, though, as a change
   function could have inserted it into an undo list (Bug#30931).  */
void
detach_marker (Lisp_Object marker)
{
  Fset_marker (marker, Qnil, Qnil);
}

598 599 600 601
/* Remove MARKER from the chain of whatever buffer it is in,
   leaving it points to nowhere.  This is called during garbage
   collection, so we must be careful to ignore and preserve
   mark bits, including those in chain fields of markers.  */
Jim Blandy's avatar
Jim Blandy committed
602

603
void
604
unchain_marker (register struct Lisp_Marker *marker)
Jim Blandy's avatar
Jim Blandy committed
605
{
606
  register struct buffer *b = marker->buffer;
Jim Blandy's avatar
Jim Blandy committed
607

608
  if (b)
Jim Blandy's avatar
Jim Blandy committed
609
    {
610 611 612
      register struct Lisp_Marker *tail, **prev;

      /* No dead buffers here.  */
613
      eassert (BUFFER_LIVE_P (b));
614 615 616 617 618 619 620 621 622

      marker->buffer = NULL;
      prev = &BUF_MARKERS (b);

      for (tail = BUF_MARKERS (b); tail; prev = &tail->next, tail = *prev)
	if (marker == tail)
	  {
	    if (*prev == BUF_MARKERS (b))
	      {
623
		/* Deleting first marker from the buffer's chain.  Crash
624 625 626 627
		   if new first marker in chain does not say it belongs
		   to the same buffer, or at least that they have the same
		   base buffer.  */
		if (tail->next && b->text != tail->next->buffer->text)
628
		  emacs_abort ();
629 630 631 632 633 634 635 636 637
	      }
	    *prev = tail->next;
	    /* We have removed the marker from the chain;
	       no need to scan the rest of the chain.  */
	    break;
	  }

      /* Error if marker was not in it's chain.  */
      eassert (tail != NULL);
Jim Blandy's avatar
Jim Blandy committed
638 639 640
    }
}

641
/* Return the char position of marker MARKER, as a C integer.  */
642

643
ptrdiff_t
644
marker_position (Lisp_Object marker)
Jim Blandy's avatar
Jim Blandy committed
645 646 647
{
  register struct Lisp_Marker *m = XMARKER (marker);
  register struct buffer *buf = m->buffer;
648 649 650 651

  if (!buf)
    error ("Marker does not point anywhere");

652 653
  eassert (BUF_BEG (buf) <= m->charpos && m->charpos <= BUF_Z (buf));

654 655 656 657 658
  return m->charpos;
}

/* Return the byte position of marker MARKER, as a C integer.  */

659
ptrdiff_t
660
marker_byte_position (Lisp_Object marker)
661 662 663
{
  register struct Lisp_Marker *m = XMARKER (marker);
  register struct buffer *buf = m->buffer;
Jim Blandy's avatar
Jim Blandy committed
664 665 666 667

  if (!buf)
    error ("Marker does not point anywhere");

668
  eassert (BUF_BEG_BYTE (buf) <= m->bytepos && m->bytepos <= BUF_Z_BYTE (buf));
Jim Blandy's avatar
Jim Blandy committed
669

670
  return m->bytepos;
Jim Blandy's avatar
Jim Blandy committed
671
}
672

Paul Eggert's avatar
Paul Eggert committed
673
DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
674 675 676
       doc: /* Return a new marker pointing at the same place as MARKER.
If argument is a number, makes a new marker pointing
at that position in the current buffer.
677
If MARKER is not specified, the new marker does not point anywhere.
678 679
The optional argument TYPE specifies the insertion type of the new marker;
see `marker-insertion-type'.  */)
680
  (register Lisp_Object marker, Lisp_Object type)
Jim Blandy's avatar
Jim Blandy committed
681 682 683
{
  register Lisp_Object new;

684
  if (!NILP (marker))
685
  CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
686 687 688 689 690 691

  new = Fmake_marker ();
  Fset_marker (new, marker,
	       (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
  XMARKER (new)->insertion_type = !NILP (type);
  return new;
692 693 694 695
}

DEFUN ("marker-insertion-type", Fmarker_insertion_type,
       Smarker_insertion_type, 1, 1, 0,
696
       doc: /* Return insertion type of MARKER: t if it stays after inserted text.
697
The value nil means the marker stays before text inserted there.  */)
698
  (register Lisp_Object marker)
699
{
700
  CHECK_MARKER (marker);
701 702 703 704 705
  return XMARKER (marker)->insertion_type ? Qt : Qnil;
}

DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
       Sset_marker_insertion_type, 2, 2, 0,
706 707 708
       doc: /* Set the insertion-type of MARKER to TYPE.
If TYPE is t, it means the marker advances when you insert text at it.
If TYPE is nil, it means the marker stays behind when you insert text at it.  */)
709
  (Lisp_Object marker, Lisp_Object type)
710
{
711
  CHECK_MARKER (marker);
712 713 714

  XMARKER (marker)->insertion_type = ! NILP (type);
  return type;
Jim Blandy's avatar
Jim Blandy committed
715
}
716 717

DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
718 719
       1, 1, 0,
       doc: /* Return t if there are markers pointing at POSITION in the current buffer.  */)
720
  (Lisp_Object position)
721
{
722
  register struct Lisp_Marker *tail;
723
  register ptrdiff_t charpos;
724

725
  charpos = clip_to_bounds (BEG, XINT (position), Z);
726

727
  for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
728
    if (tail->charpos == charpos)
729 730 731 732
      return Qt;

  return Qnil;
}
733

734
#ifdef MARKER_DEBUG
735

736 737 738
/* For debugging -- count the markers in buffer BUF.  */

int
739
count_markers (struct buffer *buf)
740 741
{
  int total = 0;
742
  struct Lisp_Marker *tail;
743

744
  for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
745 746 747 748
    total++;

  return total;
}
749

750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768
/* For debugging -- recompute the bytepos corresponding
   to CHARPOS in the simplest, most reliable way.  */

ptrdiff_t
verify_bytepos (ptrdiff_t charpos)
{
  ptrdiff_t below = 1;
  ptrdiff_t below_byte = 1;

  while (below != charpos)
    {
      below++;
      BUF_INC_POS (current_buffer, below_byte);
    }

  return below_byte;
}

#endif /* MARKER_DEBUG */
Jim Blandy's avatar
Jim Blandy committed
769

770
void
771
syms_of_marker (void)
Jim Blandy's avatar
Jim Blandy committed
772 773 774 775 776
{
  defsubr (&Smarker_position);
  defsubr (&Smarker_buffer);
  defsubr (&Sset_marker);
  defsubr (&Scopy_marker);
777 778
  defsubr (&Smarker_insertion_type);
  defsubr (&Sset_marker_insertion_type);
779
  defsubr (&Sbuffer_has_markers_at);
Jim Blandy's avatar
Jim Blandy committed
780
}