src/marker.c

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