marker.c 23.7 KB
Newer Older
1
/* Markers: examining, setting and deleting.
Paul Eggert's avatar
Paul Eggert committed
2
   Copyright (C) 1985, 1997-1998, 2001-2020 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 modiff_count 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 = false;							\
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
  else if (this_charpos > charpos)					\
    {									\
      if (this_charpos < best_above)					\
	{								\
	  best_above = this_charpos;					\
	  best_above_byte = (BYTEPOS);					\
108
	  changed = true;						\
109 110 111 112 113 114
	}								\
    }									\
  else if (this_charpos > best_below)					\
    {									\
      best_below = this_charpos;					\
      best_below_byte = (BYTEPOS);					\
115
      changed = true;							\
116 117 118 119 120
    }									\
									\
  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 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
/* When converting bytes from/to chars, we look through the list of
   markers to try and find a good starting point (since markers keep
   track of both bytepos and charpos at the same time).
   But if there are many markers, it can take too much time to find a "good"
   marker from which to start.  Worse yet: if it takes a long time and we end
   up finding a nearby markers, we won't add a new marker to cache this
   result, so next time around we'll have to go through this same long list
   to (re)find this best marker.  So the further down the list of
   markers we go, the less demanding we are w.r.t what is a good marker.

   The previous code used INITIAL=50 and INCREMENT=0 and this lead to
   really poor performance when there are many markers.
   I haven't tried to tweak INITIAL, but experiments on my trusty Thinkpad
   T61 using various artificial test cases seem to suggest that INCREMENT=50
   might be "the best compromise": it significantly improved the
   worst case and it was rarely slower and never by much.

   The asymptotic behavior is still poor, tho, so in largish buffers with many
Paul Eggert's avatar
Paul Eggert committed
154
   overlays (e.g. 300KB and 30K overlays), it can still be a bottleneck.  */
155 156 157
#define BYTECHAR_DISTANCE_INITIAL 50
#define BYTECHAR_DISTANCE_INCREMENT 50

158
/* Return the byte position corresponding to CHARPOS in B.  */
159

160 161
ptrdiff_t
buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
162
{
163
  struct Lisp_Marker *tail;
164 165
  ptrdiff_t best_above, best_above_byte;
  ptrdiff_t best_below, best_below_byte;
166
  ptrdiff_t distance = BYTECHAR_DISTANCE_INITIAL;
167

168
  eassert (BUF_BEG (b) <= charpos && charpos <= BUF_Z (b));
169 170 171 172 173 174 175 176 177 178

  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;

179 180
  best_below = BEG;
  best_below_byte = BEG_BYTE;
181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198

  /* 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);

199
  for (tail = BUF_MARKERS (b); tail; tail = tail->next)
200
    {
201
      CONSIDER (tail->charpos, tail->bytepos);
202 203 204 205

      /* If we are down to a range of 50 chars,
	 don't bother checking any other markers;
	 scan the intervening chars directly now.  */
206 207
      if (best_above - charpos < distance
          || charpos - best_below < distance)
208
	break;
209 210
      else
        distance += BYTECHAR_DISTANCE_INCREMENT;
211 212 213 214 215 216 217 218
    }

  /* 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)
    {
219
      bool record = charpos - best_below > 5000;
220 221 222 223

      while (best_below != charpos)
	{
	  best_below++;
224
	  best_below_byte += buf_next_char_len (b, best_below_byte);
225 226 227 228 229 230
	}

      /* 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)
231
	build_marker (b, best_below, best_below_byte);
232

Dmitry Antipov's avatar
Dmitry Antipov committed
233
      byte_char_debug_check (b, best_below, best_below_byte);
234

235 236 237 238 239 240 241 242 243
      cached_buffer = b;
      cached_modiff = BUF_MODIFF (b);
      cached_charpos = best_below;
      cached_bytepos = best_below_byte;

      return best_below_byte;
    }
  else
    {
244
      bool record = best_above - charpos > 5000;
245 246 247 248

      while (best_above != charpos)
	{
	  best_above--;
249
	  best_above_byte -= buf_prev_char_len (b, best_above_byte);
250 251 252 253 254 255
	}

      /* 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)
256
	build_marker (b, best_above, best_above_byte);
257

Dmitry Antipov's avatar
Dmitry Antipov committed
258
      byte_char_debug_check (b, best_above, best_above_byte);
259

260 261 262 263 264 265 266 267 268 269
      cached_buffer = b;
      cached_modiff = BUF_MODIFF (b);
      cached_charpos = best_above;
      cached_bytepos = best_above_byte;

      return best_above_byte;
    }
}

#undef CONSIDER
270

271
/* This macro is a subroutine of buf_bytepos_to_charpos.
272 273 274 275
   It is used when BYTEPOS is actually the byte position.  */

#define CONSIDER(BYTEPOS, CHARPOS)					\
{									\
276
  ptrdiff_t this_bytepos = (BYTEPOS);					\
277
  int changed = false;							\
278 279
									\
  if (this_bytepos == bytepos)						\
280
    {									\
281
      ptrdiff_t value = (CHARPOS);				       	\
282 283
									\
      byte_char_debug_check (b, value, bytepos);			\
284 285
      return value;							\
    }									\
286 287 288 289 290 291
  else if (this_bytepos > bytepos)					\
    {									\
      if (this_bytepos < best_above_byte)				\
	{								\
	  best_above = (CHARPOS);					\
	  best_above_byte = this_bytepos;				\
292
	  changed = true;						\
293 294 295 296 297 298
	}								\
    }									\
  else if (this_bytepos > best_below_byte)				\
    {									\
      best_below = (CHARPOS);						\
      best_below_byte = this_bytepos;					\
299
      changed = true;							\
300 301 302 303 304
    }									\
									\
  if (changed)								\
    {									\
      if (best_above - best_below == best_above_byte - best_below_byte)	\
305
	{								\
306
	  ptrdiff_t value = best_below + (bytepos - best_below_byte);	\
307 308
									\
	  byte_char_debug_check (b, value, bytepos);			\
309 310
	  return value;							\
	}								\
311 312 313
    }									\
}

314 315
/* Return the character position corresponding to BYTEPOS in B.  */

316 317
ptrdiff_t
buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
318
{
319
  struct Lisp_Marker *tail;
320 321
  ptrdiff_t best_above, best_above_byte;
  ptrdiff_t best_below, best_below_byte;
322
  ptrdiff_t distance = BYTECHAR_DISTANCE_INITIAL;
323

324
  eassert (BUF_BEG_BYTE (b) <= bytepos && bytepos <= BUF_Z_BYTE (b));
325 326 327 328 329 330 331 332 333 334

  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;

335 336 337 338
  /* Check bytepos is not in the middle of a character. */
  eassert (bytepos >= BUF_Z_BYTE (b)
           || CHAR_HEAD_P (BUF_FETCH_BYTE (b, bytepos)));

339 340
  best_below = BEG;
  best_below_byte = BEG_BYTE;
341 342 343 344 345 346 347 348 349

  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);

350
  for (tail = BUF_MARKERS (b); tail; tail = tail->next)
351
    {
352
      CONSIDER (tail->bytepos, tail->charpos);
353 354 355 356

      /* If we are down to a range of 50 chars,
	 don't bother checking any other markers;
	 scan the intervening chars directly now.  */
357 358
      if (best_above - bytepos < distance
          || bytepos - best_below < distance)
359
	break;
360 361
      else
        distance += BYTECHAR_DISTANCE_INCREMENT;
362 363 364 365 366 367 368 369
    }

  /* 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)
    {
370
      bool record = bytepos - best_below_byte > 5000;
371 372 373 374

      while (best_below_byte < bytepos)
	{
	  best_below++;
375
	  best_below_byte += buf_next_char_len (b, best_below_byte);
376 377 378 379
	}

      /* If this position is quite far from the nearest known position,
	 cache the correspondence by creating a marker here.
380 381 382
	 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.  */
383
      if (record && BUF_MARKERS (b))
384
	build_marker (b, best_below, best_below_byte);
385

Dmitry Antipov's avatar
Dmitry Antipov committed
386
      byte_char_debug_check (b, best_below, best_below_byte);
387

388 389 390 391 392 393 394 395 396
      cached_buffer = b;
      cached_modiff = BUF_MODIFF (b);
      cached_charpos = best_below;
      cached_bytepos = best_below_byte;

      return best_below;
    }
  else
    {
397
      bool record = best_above_byte - bytepos > 5000;
398 399 400 401

      while (best_above_byte > bytepos)
	{
	  best_above--;
402
	  best_above_byte -= buf_prev_char_len (b, best_above_byte);
403 404 405 406
	}

      /* If this position is quite far from the nearest known position,
	 cache the correspondence by creating a marker here.
407 408 409
	 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.  */
410
      if (record && BUF_MARKERS (b))
411
	build_marker (b, best_above, best_above_byte);
412

Dmitry Antipov's avatar
Dmitry Antipov committed
413
      byte_char_debug_check (b, best_above, best_above_byte);
414

415 416 417 418 419 420 421 422 423 424 425
      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
426 427
/* Operations on markers. */

Paul Eggert's avatar
Paul Eggert committed
428
DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
429 430
       doc: /* Return the buffer that MARKER points into, or nil if none.
Returns nil if MARKER points into a dead buffer.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
431
  (register Lisp_Object marker)
Jim Blandy's avatar
Jim Blandy committed
432 433
{
  register Lisp_Object buf;
434
  CHECK_MARKER (marker);
Jim Blandy's avatar
Jim Blandy committed
435 436
  if (XMARKER (marker)->buffer)
    {
437
      XSETBUFFER (buf, XMARKER (marker)->buffer);
438 439 440 441
      /* 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.  */
442
      eassert (BUFFER_LIVE_P (XBUFFER (buf)));
443
      return buf;
Jim Blandy's avatar
Jim Blandy committed
444 445 446 447
    }
  return Qnil;
}

Paul Eggert's avatar
Paul Eggert committed
448
DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
449
       doc: /* Return the position of MARKER, or nil if it points nowhere.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
450
  (Lisp_Object marker)
Jim Blandy's avatar
Jim Blandy committed
451
{
452
  CHECK_MARKER (marker);
Jim Blandy's avatar
Jim Blandy committed
453
  if (XMARKER (marker)->buffer)
454
    return make_fixnum (XMARKER (marker)->charpos);
Jim Blandy's avatar
Jim Blandy committed
455 456 457

  return Qnil;
}
458 459 460

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

461
static void
462 463 464
attach_marker (struct Lisp_Marker *m, struct buffer *b,
	       ptrdiff_t charpos, ptrdiff_t bytepos)
{
465 466 467 468 469 470
  /* 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);
471 472 473 474 475 476 477 478 479 480 481 482 483

  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;
    }
}

484 485 486
/* 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
487

488
static struct buffer *
489 490
live_buffer (Lisp_Object buffer)
{
491 492
  struct buffer *b = decode_buffer (buffer);
  return BUFFER_LIVE_P (b) ? b : NULL;
Jim Blandy's avatar
Jim Blandy committed
493 494
}

495 496
/* 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
497

498
static Lisp_Object
499
set_marker_internal (Lisp_Object marker, Lisp_Object position,
500
		     Lisp_Object buffer, bool restricted)
Jim Blandy's avatar
Jim Blandy committed
501
{
502 503
  struct Lisp_Marker *m;
  struct buffer *b = live_buffer (buffer);
Jim Blandy's avatar
Jim Blandy committed
504

505
  CHECK_MARKER (marker);
506 507
  m = XMARKER (marker);

508 509 510 511 512 513 514 515 516 517 518
  /* 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
519
    {
520 521
      m->bytepos = XMARKER (position)->bytepos;
      m->charpos = XMARKER (position)->charpos;
Jim Blandy's avatar
Jim Blandy committed
522 523 524 525
    }

  else
    {
526
      register ptrdiff_t charpos, bytepos;
527

528
      /* Do not use CHECK_FIXNUM_COERCE_MARKER because we
Paul Eggert's avatar
Paul Eggert committed
529
	 don't want to call buf_charpos_to_bytepos if POSITION
530
	 is a marker and so we know the bytepos already.  */
531
      if (FIXNUMP (position))
532 533 534 535 536 537 538 539 540 541 542 543
	{
#if EMACS_INT_MAX > PTRDIFF_MAX
	  /* A --with-wide-int build.  */
	  EMACS_INT cpos = XFIXNUM (position);
	  if (cpos > PTRDIFF_MAX)
	    cpos = PTRDIFF_MAX;
	  charpos = cpos;
	  bytepos = -1;
#else
	  charpos = XFIXNUM (position), bytepos = -1;
#endif
	}
544 545 546 547 548 549 550 551 552 553 554
      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));
555 556 557 558 559
      /* 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))
560 561 562 563 564 565
	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));

566
      attach_marker (m, b, charpos, bytepos);
Jim Blandy's avatar
Jim Blandy committed
567
    }
568 569
  return marker;
}
Jim Blandy's avatar
Jim Blandy committed
570

571
DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
572 573
       doc: /* Position MARKER before character number POSITION in BUFFER.
If BUFFER is omitted or nil, it defaults to the current buffer.  If
574 575
POSITION is nil, makes marker point nowhere so it no longer slows down
editing in any buffer.  Returns MARKER.  */)
576 577
  (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer)
{
Paul Eggert's avatar
Paul Eggert committed
578
  return set_marker_internal (marker, position, buffer, false);
579
}
580

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

583 584 585 586
Lisp_Object
set_marker_restricted (Lisp_Object marker, Lisp_Object position,
		       Lisp_Object buffer)
{
Paul Eggert's avatar
Paul Eggert committed
587
  return set_marker_internal (marker, position, buffer, true);
Jim Blandy's avatar
Jim Blandy committed
588
}
589

590 591
/* Set the position of MARKER, specifying both the
   character position and the corresponding byte position.  */
Jim Blandy's avatar
Jim Blandy committed
592

593
Lisp_Object
594 595
set_marker_both (Lisp_Object marker, Lisp_Object buffer,
		 ptrdiff_t charpos, ptrdiff_t bytepos)
596 597
{
  register struct Lisp_Marker *m;
598
  register struct buffer *b = live_buffer (buffer);
599

600
  CHECK_MARKER (marker);
601
  m = XMARKER (marker);
602

603 604
  if (b)
    attach_marker (m, b, charpos, bytepos);
605
  else
606
    unchain_marker (m);
607 608 609
  return marker;
}

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

612
Lisp_Object
613 614
set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer,
			    ptrdiff_t charpos, ptrdiff_t bytepos)
615 616
{
  register struct Lisp_Marker *m;
617
  register struct buffer *b = live_buffer (buffer);
618

619
  CHECK_MARKER (marker);
620
  m = XMARKER (marker);
621

622
  if (b)
623
    {
624 625
      attach_marker
	(m, b,
626 627
	 clip_to_bounds (BUF_BEGV (b), charpos, BUF_ZV (b)),
	 clip_to_bounds (BUF_BEGV_BYTE (b), bytepos, BUF_ZV_BYTE (b)));
628
    }
629 630
  else
    unchain_marker (m);
631 632
  return marker;
}
633

Paul Eggert's avatar
Paul Eggert committed
634 635 636 637 638 639 640 641 642
/* 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);
}

643 644 645 646
/* 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
647

648
void
649
unchain_marker (register struct Lisp_Marker *marker)
Jim Blandy's avatar
Jim Blandy committed
650
{
651
  register struct buffer *b = marker->buffer;
Jim Blandy's avatar
Jim Blandy committed
652

653
  if (b)
Jim Blandy's avatar
Jim Blandy committed
654
    {
655 656 657
      register struct Lisp_Marker *tail, **prev;

      /* No dead buffers here.  */
658
      eassert (BUFFER_LIVE_P (b));
659 660 661 662 663 664 665 666 667

      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))
	      {
668
		/* Deleting first marker from the buffer's chain.  Crash
669 670 671 672
		   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)
673
		  emacs_abort ();
674 675 676 677 678 679 680 681 682
	      }
	    *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
683 684 685
    }
}

686
/* Return the char position of marker MARKER, as a C integer.  */
687

688
ptrdiff_t
689
marker_position (Lisp_Object marker)
Jim Blandy's avatar
Jim Blandy committed
690 691 692
{
  register struct Lisp_Marker *m = XMARKER (marker);
  register struct buffer *buf = m->buffer;
693 694 695 696

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

697 698
  eassert (BUF_BEG (buf) <= m->charpos && m->charpos <= BUF_Z (buf));

699 700 701 702 703
  return m->charpos;
}

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

704
ptrdiff_t
705
marker_byte_position (Lisp_Object marker)
706 707 708
{
  register struct Lisp_Marker *m = XMARKER (marker);
  register struct buffer *buf = m->buffer;
Jim Blandy's avatar
Jim Blandy committed
709 710 711 712

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

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

715
  return m->bytepos;
Jim Blandy's avatar
Jim Blandy committed
716
}
717

Paul Eggert's avatar
Paul Eggert committed
718
DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0,
719 720 721
       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.
722
If MARKER is not specified, the new marker does not point anywhere.
723 724
The optional argument TYPE specifies the insertion type of the new marker;
see `marker-insertion-type'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
725
  (register Lisp_Object marker, Lisp_Object type)
Jim Blandy's avatar
Jim Blandy committed
726 727 728
{
  register Lisp_Object new;

729
  if (!NILP (marker))
730
  CHECK_TYPE (FIXNUMP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
731 732 733 734 735 736

  new = Fmake_marker ();
  Fset_marker (new, marker,
	       (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
  XMARKER (new)->insertion_type = !NILP (type);
  return new;
737 738 739 740
}

DEFUN ("marker-insertion-type", Fmarker_insertion_type,
       Smarker_insertion_type, 1, 1, 0,
741
       doc: /* Return insertion type of MARKER: t if it stays after inserted text.
742
The value nil means the marker stays before text inserted there.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
743
  (register Lisp_Object marker)
744
{
745
  CHECK_MARKER (marker);
746 747 748 749 750
  return XMARKER (marker)->insertion_type ? Qt : Qnil;
}

DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
       Sset_marker_insertion_type, 2, 2, 0,
751 752 753
       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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
754
  (Lisp_Object marker, Lisp_Object type)
755
{
756
  CHECK_MARKER (marker);
757 758 759

  XMARKER (marker)->insertion_type = ! NILP (type);
  return type;
Jim Blandy's avatar
Jim Blandy committed
760
}
761 762

DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
763 764
       1, 1, 0,
       doc: /* Return t if there are markers pointing at POSITION in the current buffer.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
765
  (Lisp_Object position)
766
{
767
  register struct Lisp_Marker *tail;
768
  register ptrdiff_t charpos;
769

Tom Tromey's avatar
Tom Tromey committed
770
  charpos = clip_to_bounds (BEG, XFIXNUM (position), Z);
771

772
  for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
773
    if (tail->charpos == charpos)
774 775 776 777
      return Qt;

  return Qnil;
}
778

779
#ifdef MARKER_DEBUG
780

781 782 783
/* For debugging -- count the markers in buffer BUF.  */

int
784
count_markers (struct buffer *buf)
785 786
{
  int total = 0;
787
  struct Lisp_Marker *tail;
788

789
  for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
790 791 792 793
    total++;

  return total;
}
794

795 796 797 798 799 800
/* For debugging -- recompute the bytepos corresponding
   to CHARPOS in the simplest, most reliable way.  */

ptrdiff_t
verify_bytepos (ptrdiff_t charpos)
{
801
  ptrdiff_t below = BEG;
802
  ptrdiff_t below_byte = BEG_BYTE;
803 804 805 806

  while (below != charpos)
    {
      below++;
807
      below_byte += buf_next_char_len (current_buffer, below_byte);
808 809 810 811 812 813
    }

  return below_byte;
}

#endif /* MARKER_DEBUG */
Jim Blandy's avatar
Jim Blandy committed
814

815
void
816
syms_of_marker (void)
Jim Blandy's avatar
Jim Blandy committed
817 818 819 820 821
{
  defsubr (&Smarker_position);
  defsubr (&Smarker_buffer);
  defsubr (&Sset_marker);
  defsubr (&Scopy_marker);
822 823
  defsubr (&Smarker_insertion_type);
  defsubr (&Sset_marker_insertion_type);
824
  defsubr (&Sbuffer_has_markers_at);
Jim Blandy's avatar
Jim Blandy committed
825
}