src/marker.c

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