src/marker.c

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