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 corrspondence: 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 = 1;
 153   best_below_byte = 1;
 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 = 1;
 330   best_below_byte = 1;
 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   "Return the buffer that MARKER points into, or nil if none.\n\
 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, 0);
 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   "Return the position MARKER points at, as a character number.")
 450   (marker)
 451      Lisp_Object marker;
 452 {
 453   CHECK_MARKER (marker, 0);
 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   "Position MARKER before character number POSITION in BUFFER.\n\
 462 BUFFER defaults to the current buffer.\n\
 463 If POSITION is nil, makes marker point nowhere.\n\
 464 Then it no longer slows down editing in any buffer.\n\
 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, 0);
 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, 1);
 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, 1);
 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, 0);
 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, 1);
 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, 1);
 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, 0);
 626
 627   if (NILP (buffer))
 628     b = current_buffer;
 629   else
 630     {
 631       CHECK_BUFFER (buffer, 1);
 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, 0);
 677
 678   if (NILP (buffer))
 679     b = current_buffer;
 680   else
 681     {
 682       CHECK_BUFFER (buffer, 1);
 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 /* This is called during garbage collection,
 726    so we must be careful to ignore and preserve mark bits,
 727    including those in chain fields of markers.  */
 728
 729 void
 730 unchain_marker (marker)
 731      register Lisp_Object marker;
 732 {
 733   register Lisp_Object tail, prev, next;
 734   register EMACS_INT omark;
 735   register struct buffer *b;
 736
 737   b = XMARKER (marker)->buffer;
 738   if (b == 0)
 739     return;
 740
 741   if (EQ (b->name, Qnil))
 742     abort ();
 743
 744   XMARKER (marker)->buffer = 0;
 745
 746   tail = BUF_MARKERS (b);
 747   prev = Qnil;
 748   while (! GC_NILP (tail))
 749     {
 750       next = XMARKER (tail)->chain;
 751       XUNMARK (next);
 752
 753       if (XMARKER (marker) == XMARKER (tail))
 754         {
 755           if (NILP (prev))
 756             {
 757               BUF_MARKERS (b) = next;
 758               /* Deleting first marker from the buffer's chain.  Crash
 759                  if new first marker in chain does not say it belongs
 760                  to the same buffer, or at least that they have the same
 761                  base buffer.  */
 762               if (!NILP (next) && b->text != XMARKER (next)->buffer->text)
 763                 abort ();
 764             }
 765           else
 766             {
 767               omark = XMARKBIT (XMARKER (prev)->chain);
 768               XMARKER (prev)->chain = next;
 769               XSETMARKBIT (XMARKER (prev)->chain, omark);
 770             }
 771           /* We have removed the marker from the chain;
 772              no need to scan the rest of the chain.  */
 773           return;
 774         }
 775       else
 776         prev = tail;
 777       tail = next;
 778     }
 779
 780   /* Marker was not in its chain.  */
 781   abort ();
 782 }
 783
 784 /* Return the char position of marker MARKER, as a C integer.  */
 785
 786 int
 787 marker_position (marker)
 788      Lisp_Object marker;
 789 {
 790   register struct Lisp_Marker *m = XMARKER (marker);
 791   register struct buffer *buf = m->buffer;
 792
 793   if (!buf)
 794     error ("Marker does not point anywhere");
 795
 796   return m->charpos;
 797 }
 798
 799 /* Return the byte position of marker MARKER, as a C integer.  */
 800
 801 int
 802 marker_byte_position (marker)
 803      Lisp_Object marker;
 804 {
 805   register struct Lisp_Marker *m = XMARKER (marker);
 806   register struct buffer *buf = m->buffer;
 807   register int i = m->bytepos;
 808
 809   if (!buf)
 810     error ("Marker does not point anywhere");
 811
 812   if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
 813     abort ();
 814
 815   return i;
 816 }
 817 \f
 818 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
 819   "Return a new marker pointing at the same place as MARKER.\n\
 820 If argument is a number, makes a new marker pointing\n\
 821 at that position in the current buffer.\n\
 822 The optional argument TYPE specifies the insertion type of the new marker;\n\
 823 see `marker-insertion-type'.")
 824   (marker, type)
 825      register Lisp_Object marker, type;
 826 {
 827   register Lisp_Object new;
 828
 829   if (! (INTEGERP (marker) || MARKERP (marker)))
 830     marker = wrong_type_argument (Qinteger_or_marker_p, marker);
 831
 832   new = Fmake_marker ();
 833   Fset_marker (new, marker,
 834                (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
 835   XMARKER (new)->insertion_type = !NILP (type);
 836   return new;
 837 }
 838
 839 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
 840        Smarker_insertion_type, 1, 1, 0,
 841   "Return insertion type of MARKER: t if it stays after inserted text.\n\
 842 nil means the marker stays before text inserted there.")
 843   (marker)
 844      register Lisp_Object marker;
 845 {
 846   CHECK_MARKER (marker, 0);
 847   return XMARKER (marker)->insertion_type ? Qt : Qnil;
 848 }
 849
 850 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
 851        Sset_marker_insertion_type, 2, 2, 0,
 852   "Set the insertion-type of MARKER to TYPE.\n\
 853 If TYPE is t, it means the marker advances when you insert text at it.\n\
 854 If TYPE is nil, it means the marker stays behind when you insert text at it.")
 855   (marker, type)
 856      Lisp_Object marker, type;
 857 {
 858   CHECK_MARKER (marker, 0);
 859
 860   XMARKER (marker)->insertion_type = ! NILP (type);
 861   return type;
 862 }
 863
 864 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
 865   1, 1, 0,
 866   "Return t if there are markers pointing at POSITION in the current buffer.")
 867   (position)
 868       Lisp_Object position;
 869 {
 870   register Lisp_Object tail;
 871   register int charno;
 872
 873   charno = XINT (position);
 874
 875   if (charno < BEG)
 876     charno = BEG;
 877   if (charno > Z)
 878     charno = Z;
 879
 880   for (tail = BUF_MARKERS (current_buffer);
 881        !NILP (tail);
 882        tail = XMARKER (tail)->chain)
 883     if (XMARKER (tail)->charpos == charno)
 884       return Qt;
 885
 886   return Qnil;
 887 }
 888 \f
 889 void
 890 syms_of_marker ()
 891 {
 892   defsubr (&Smarker_position);
 893   defsubr (&Smarker_buffer);
 894   defsubr (&Sset_marker);
 895   defsubr (&Scopy_marker);
 896   defsubr (&Smarker_insertion_type);
 897   defsubr (&Sset_marker_insertion_type);
 898   defsubr (&Sbuffer_has_markers_at);
 899
 900   DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
 901    "Non-nil enables debugging checks in byte/char position conversions.");
 902   byte_debug_flag = 0;
 903
 904 }