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
 256 /* Used for debugging: recompute the bytepos corresponding to CHARPOS
 257    in the simplest, most reliable way.  */
 258
 259 int
 260 verify_bytepos (charpos)
 261 {
 262   int below = 1;
 263   int below_byte = 1;
 264
 265   while (below != charpos)
 266     {
 267       below++;
 268       BUF_INC_POS (current_buffer, below_byte);
 269     }
 270
 271   return below_byte;
 272 }
 273 \f
 274 /* bytepos_to_charpos returns the char position corresponding to BYTEPOS.  */
 275
 276 /* This macro is a subroutine of bytepos_to_charpos.
 277    It is used when BYTEPOS is actually the byte position.  */
 278
 279 #define CONSIDER(BYTEPOS, CHARPOS)                                      \
 280 {                                                                       \
 281   int this_bytepos = (BYTEPOS);                                         \
 282   int changed = 0;                                                      \
 283                                                                         \
 284   if (this_bytepos == bytepos)                                          \
 285     {                                                                   \
 286       int value = (CHARPOS);                                            \
 287       if (byte_debug_flag)                                              \
 288         byte_char_debug_check (b, value, bytepos);                      \
 289       return value;                                                     \
 290     }                                                                   \
 291   else if (this_bytepos > bytepos)                                      \
 292     {                                                                   \
 293       if (this_bytepos < best_above_byte)                               \
 294         {                                                               \
 295           best_above = (CHARPOS);                                       \
 296           best_above_byte = this_bytepos;                               \
 297           changed = 1;                                                  \
 298         }                                                               \
 299     }                                                                   \
 300   else if (this_bytepos > best_below_byte)                              \
 301     {                                                                   \
 302       best_below = (CHARPOS);                                           \
 303       best_below_byte = this_bytepos;                                   \
 304       changed = 1;                                                      \
 305     }                                                                   \
 306                                                                         \
 307   if (changed)                                                          \
 308     {                                                                   \
 309       if (best_above - best_below == best_above_byte - best_below_byte) \
 310         {                                                               \
 311           int value = best_below + (bytepos - best_below_byte);         \
 312           if (byte_debug_flag)                                          \
 313             byte_char_debug_check (b, value, bytepos);                  \
 314           return value;                                                 \
 315         }                                                               \
 316     }                                                                   \
 317 }
 318
 319 int
 320 bytepos_to_charpos (bytepos)
 321      int bytepos;
 322 {
 323   return buf_bytepos_to_charpos (current_buffer, bytepos);
 324 }
 325
 326 int
 327 buf_bytepos_to_charpos (b, bytepos)
 328      struct buffer *b;
 329      int bytepos;
 330 {
 331   Lisp_Object tail;
 332   int best_above, best_above_byte;
 333   int best_below, best_below_byte;
 334
 335   if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
 336     abort ();
 337
 338   best_above = BUF_Z (b);
 339   best_above_byte = BUF_Z_BYTE (b);
 340
 341   /* If this buffer has as many characters as bytes,
 342      each character must be one byte.
 343      This takes care of the case where enable-multibyte-characters is nil.  */
 344   if (best_above == best_above_byte)
 345     return bytepos;
 346
 347   best_below = BEG;
 348   best_below_byte = BEG_BYTE;
 349
 350   CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
 351   CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
 352   CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
 353   CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
 354
 355   if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
 356     CONSIDER (cached_bytepos, cached_charpos);
 357
 358   tail = BUF_MARKERS (b);
 359   while (! NILP (tail))
 360     {
 361       CONSIDER (XMARKER (tail)->bytepos, XMARKER (tail)->charpos);
 362
 363       /* If we are down to a range of 50 chars,
 364          don't bother checking any other markers;
 365          scan the intervening chars directly now.  */
 366       if (best_above - best_below < 50)
 367         break;
 368
 369       tail = XMARKER (tail)->chain;
 370     }
 371
 372   /* We get here if we did not exactly hit one of the known places.
 373      We have one known above and one known below.
 374      Scan, counting characters, from whichever one is closer.  */
 375
 376   if (bytepos - best_below_byte < best_above_byte - bytepos)
 377     {
 378       int record = bytepos - best_below_byte > 5000;
 379
 380       while (best_below_byte < bytepos)
 381         {
 382           best_below++;
 383           BUF_INC_POS (b, best_below_byte);
 384         }
 385
 386       /* If this position is quite far from the nearest known position,
 387          cache the correspondence by creating a marker here.
 388          It will last until the next GC.
 389          But don't do it if BUF_MARKERS is nil;
 390          that is a signal from Fset_buffer_multibyte.  */
 391       if (record && ! NILP (BUF_MARKERS (b)))
 392         {
 393           Lisp_Object marker, buffer;
 394           marker = Fmake_marker ();
 395           XSETBUFFER (buffer, b);
 396           set_marker_both (marker, buffer, best_below, best_below_byte);
 397         }
 398
 399       if (byte_debug_flag)
 400         byte_char_debug_check (b, best_below, bytepos);
 401
 402       cached_buffer = b;
 403       cached_modiff = BUF_MODIFF (b);
 404       cached_charpos = best_below;
 405       cached_bytepos = best_below_byte;
 406
 407       return best_below;
 408     }
 409   else
 410     {
 411       int record = best_above_byte - bytepos > 5000;
 412
 413       while (best_above_byte > bytepos)
 414         {
 415           best_above--;
 416           BUF_DEC_POS (b, best_above_byte);
 417         }
 418
 419       /* If this position is quite far from the nearest known position,
 420          cache the correspondence by creating a marker here.
 421          It will last until the next GC.
 422          But don't do it if BUF_MARKERS is nil;
 423          that is a signal from Fset_buffer_multibyte.  */
 424       if (record && ! NILP (BUF_MARKERS (b)))
 425         {
 426           Lisp_Object marker, buffer;
 427           marker = Fmake_marker ();
 428           XSETBUFFER (buffer, b);
 429           set_marker_both (marker, buffer, best_above, best_above_byte);
 430         }
 431
 432       if (byte_debug_flag)
 433         byte_char_debug_check (b, best_above, bytepos);
 434
 435       cached_buffer = b;
 436       cached_modiff = BUF_MODIFF (b);
 437       cached_charpos = best_above;
 438       cached_bytepos = best_above_byte;
 439
 440       return best_above;
 441     }
 442 }
 443
 444 #undef CONSIDER
 445 \f
 446 /* Operations on markers. */
 447
 448 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
 449        doc: /* Return the buffer that MARKER points into, or nil if none.
 450 Returns nil if MARKER points into a dead buffer.  */)
 451      (marker)
 452      register Lisp_Object marker;
 453 {
 454   register Lisp_Object buf;
 455   CHECK_MARKER (marker);
 456   if (XMARKER (marker)->buffer)
 457     {
 458       XSETBUFFER (buf, XMARKER (marker)->buffer);
 459       /* Return marker's buffer only if it is not dead.  */
 460       if (!NILP (XBUFFER (buf)->name))
 461         return buf;
 462     }
 463   return Qnil;
 464 }
 465
 466 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
 467        doc: /* Return the position MARKER points at, as a character number.  */)
 468      (marker)
 469      Lisp_Object marker;
 470 {
 471   CHECK_MARKER (marker);
 472   if (XMARKER (marker)->buffer)
 473     return make_number (XMARKER (marker)->charpos);
 474
 475   return Qnil;
 476 }
 477 \f
 478 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
 479        doc: /* Position MARKER before character number POSITION in BUFFER.
 480 BUFFER defaults to the current buffer.
 481 If POSITION is nil, makes marker point nowhere.
 482 Then it no longer slows down editing in any buffer.
 483 Returns MARKER.  */)
 484      (marker, position, buffer)
 485      Lisp_Object marker, position, buffer;
 486 {
 487   register int charno, bytepos;
 488   register struct buffer *b;
 489   register struct Lisp_Marker *m;
 490
 491   CHECK_MARKER (marker);
 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 (marker);
 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 (marker);
 511           return marker;
 512         }
 513     }
 514
 515   m = XMARKER (marker);
 516
 517   /* Optimize the special case where we are copying the position
 518      of an existing marker, and MARKER is already in the same buffer.  */
 519   if (MARKERP (position) && b == XMARKER (position)->buffer
 520       && b == m->buffer)
 521     {
 522       m->bytepos = XMARKER (position)->bytepos;
 523       m->charpos = XMARKER (position)->charpos;
 524       return marker;
 525     }
 526
 527   CHECK_NUMBER_COERCE_MARKER (position);
 528
 529   charno = XINT (position);
 530
 531   if (charno < BUF_BEG (b))
 532     charno = BUF_BEG (b);
 533   if (charno > BUF_Z (b))
 534     charno = BUF_Z (b);
 535
 536   bytepos = buf_charpos_to_bytepos (b, charno);
 537
 538   /* Every character is at least one byte.  */
 539   if (charno > bytepos)
 540     abort ();
 541
 542   m->bytepos = bytepos;
 543   m->charpos = charno;
 544
 545   if (m->buffer != b)
 546     {
 547       unchain_marker (marker);
 548       m->buffer = b;
 549       m->chain = BUF_MARKERS (b);
 550       BUF_MARKERS (b) = marker;
 551     }
 552
 553   return marker;
 554 }
 555
 556 /* This version of Fset_marker won't let the position
 557    be outside the visible part.  */
 558
 559 Lisp_Object
 560 set_marker_restricted (marker, pos, buffer)
 561      Lisp_Object marker, pos, buffer;
 562 {
 563   register int charno, bytepos;
 564   register struct buffer *b;
 565   register struct Lisp_Marker *m;
 566
 567   CHECK_MARKER (marker);
 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 (marker);
 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 (marker);
 587           return marker;
 588         }
 589     }
 590
 591   m = XMARKER (marker);
 592
 593   /* Optimize the special case where we are copying the position
 594      of an existing marker, and MARKER is already in the same buffer.  */
 595   if (MARKERP (pos) && b == XMARKER (pos)->buffer
 596       && b == m->buffer)
 597     {
 598       m->bytepos = XMARKER (pos)->bytepos;
 599       m->charpos = XMARKER (pos)->charpos;
 600       return marker;
 601     }
 602
 603   CHECK_NUMBER_COERCE_MARKER (pos);
 604
 605   charno = XINT (pos);
 606
 607   if (charno < BUF_BEGV (b))
 608     charno = BUF_BEGV (b);
 609   if (charno > BUF_ZV (b))
 610     charno = BUF_ZV (b);
 611
 612   bytepos = buf_charpos_to_bytepos (b, charno);
 613
 614   /* Every character is at least one byte.  */
 615   if (charno > bytepos)
 616     abort ();
 617
 618   m->bytepos = bytepos;
 619   m->charpos = charno;
 620
 621   if (m->buffer != b)
 622     {
 623       unchain_marker (marker);
 624       m->buffer = b;
 625       m->chain = BUF_MARKERS (b);
 626       BUF_MARKERS (b) = marker;
 627     }
 628
 629   return marker;
 630 }
 631 \f
 632 /* Set the position of MARKER, specifying both the
 633    character position and the corresponding byte position.  */
 634
 635 Lisp_Object
 636 set_marker_both (marker, buffer, charpos, bytepos)
 637      Lisp_Object marker, buffer;
 638      int charpos, bytepos;
 639 {
 640   register struct buffer *b;
 641   register struct Lisp_Marker *m;
 642
 643   CHECK_MARKER (marker);
 644
 645   if (NILP (buffer))
 646     b = current_buffer;
 647   else
 648     {
 649       CHECK_BUFFER (buffer);
 650       b = XBUFFER (buffer);
 651       /* If buffer is dead, set marker to point nowhere.  */
 652       if (EQ (b->name, Qnil))
 653         {
 654           unchain_marker (marker);
 655           return marker;
 656         }
 657     }
 658
 659   m = XMARKER (marker);
 660
 661   /* In a single-byte buffer, the two positions must be equal.  */
 662   if (BUF_Z (b) == BUF_Z_BYTE (b)
 663       && charpos != bytepos)
 664     abort ();
 665   /* Every character is at least one byte.  */
 666   if (charpos > bytepos)
 667     abort ();
 668
 669   m->bytepos = bytepos;
 670   m->charpos = charpos;
 671
 672   if (m->buffer != b)
 673     {
 674       unchain_marker (marker);
 675       m->buffer = b;
 676       m->chain = BUF_MARKERS (b);
 677       BUF_MARKERS (b) = marker;
 678     }
 679
 680   return marker;
 681 }
 682
 683 /* This version of set_marker_both won't let the position
 684    be outside the visible part.  */
 685
 686 Lisp_Object
 687 set_marker_restricted_both (marker, buffer, charpos, bytepos)
 688      Lisp_Object marker, buffer;
 689      int charpos, bytepos;
 690 {
 691   register struct buffer *b;
 692   register struct Lisp_Marker *m;
 693
 694   CHECK_MARKER (marker);
 695
 696   if (NILP (buffer))
 697     b = current_buffer;
 698   else
 699     {
 700       CHECK_BUFFER (buffer);
 701       b = XBUFFER (buffer);
 702       /* If buffer is dead, set marker to point nowhere.  */
 703       if (EQ (b->name, Qnil))
 704         {
 705           unchain_marker (marker);
 706           return marker;
 707         }
 708     }
 709
 710   m = XMARKER (marker);
 711
 712   if (charpos < BUF_BEGV (b))
 713     charpos = BUF_BEGV (b);
 714   if (charpos > BUF_ZV (b))
 715     charpos = BUF_ZV (b);
 716   if (bytepos < BUF_BEGV_BYTE (b))
 717     bytepos = BUF_BEGV_BYTE (b);
 718   if (bytepos > BUF_ZV_BYTE (b))
 719     bytepos = BUF_ZV_BYTE (b);
 720
 721   /* In a single-byte buffer, the two positions must be equal.  */
 722   if (BUF_Z (b) == BUF_Z_BYTE (b)
 723       && charpos != bytepos)
 724     abort ();
 725   /* Every character is at least one byte.  */
 726   if (charpos > bytepos)
 727     abort ();
 728
 729   m->bytepos = bytepos;
 730   m->charpos = charpos;
 731
 732   if (m->buffer != b)
 733     {
 734       unchain_marker (marker);
 735       m->buffer = b;
 736       m->chain = BUF_MARKERS (b);
 737       BUF_MARKERS (b) = marker;
 738     }
 739
 740   return marker;
 741 }
 742 \f
 743 /* Remove MARKER from the chain of whatever buffer it is in.
 744    Leave it "in no buffer".
 745
 746    This is called during garbage collection,
 747    so we must be careful to ignore and preserve mark bits,
 748    including those in chain fields of markers.  */
 749
 750 void
 751 unchain_marker (marker)
 752      register Lisp_Object marker;
 753 {
 754   register Lisp_Object tail, prev, next;
 755   register EMACS_INT omark;
 756   register struct buffer *b;
 757
 758   b = XMARKER (marker)->buffer;
 759   if (b == 0)
 760     return;
 761
 762   if (EQ (b->name, Qnil))
 763     abort ();
 764
 765   XMARKER (marker)->buffer = 0;
 766
 767   tail = BUF_MARKERS (b);
 768   prev = Qnil;
 769   while (! GC_NILP (tail))
 770     {
 771       next = XMARKER (tail)->chain;
 772       XUNMARK (next);
 773
 774       if (XMARKER (marker) == XMARKER (tail))
 775         {
 776           if (NILP (prev))
 777             {
 778               BUF_MARKERS (b) = next;
 779               /* Deleting first marker from the buffer's chain.  Crash
 780                  if new first marker in chain does not say it belongs
 781                  to the same buffer, or at least that they have the same
 782                  base buffer.  */
 783               if (!NILP (next) && b->text != XMARKER (next)->buffer->text)
 784                 abort ();
 785             }
 786           else
 787             {
 788               omark = XMARKBIT (XMARKER (prev)->chain);
 789               XMARKER (prev)->chain = next;
 790               XSETMARKBIT (XMARKER (prev)->chain, omark);
 791             }
 792           /* We have removed the marker from the chain;
 793              no need to scan the rest of the chain.  */
 794           return;
 795         }
 796       else
 797         prev = tail;
 798       tail = next;
 799     }
 800
 801   /* Marker was not in its chain.  */
 802   abort ();
 803 }
 804
 805 /* Return the char position of marker MARKER, as a C integer.  */
 806
 807 int
 808 marker_position (marker)
 809      Lisp_Object marker;
 810 {
 811   register struct Lisp_Marker *m = XMARKER (marker);
 812   register struct buffer *buf = m->buffer;
 813
 814   if (!buf)
 815     error ("Marker does not point anywhere");
 816
 817   return m->charpos;
 818 }
 819
 820 /* Return the byte position of marker MARKER, as a C integer.  */
 821
 822 int
 823 marker_byte_position (marker)
 824      Lisp_Object marker;
 825 {
 826   register struct Lisp_Marker *m = XMARKER (marker);
 827   register struct buffer *buf = m->buffer;
 828   register int i = m->bytepos;
 829
 830   if (!buf)
 831     error ("Marker does not point anywhere");
 832
 833   if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
 834     abort ();
 835
 836   return i;
 837 }
 838 \f
 839 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
 840        doc: /* Return a new marker pointing at the same place as MARKER.
 841 If argument is a number, makes a new marker pointing
 842 at that position in the current buffer.
 843 The optional argument TYPE specifies the insertion type of the new marker;
 844 see `marker-insertion-type'.  */)
 845      (marker, type)
 846      register Lisp_Object marker, type;
 847 {
 848   register Lisp_Object new;
 849
 850   if (! (INTEGERP (marker) || MARKERP (marker)))
 851     marker = wrong_type_argument (Qinteger_or_marker_p, marker);
 852
 853   new = Fmake_marker ();
 854   Fset_marker (new, marker,
 855                (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
 856   XMARKER (new)->insertion_type = !NILP (type);
 857   return new;
 858 }
 859
 860 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
 861        Smarker_insertion_type, 1, 1, 0,
 862        doc: /* Return insertion type of MARKER: t if it stays after inserted text.
 863 nil means the marker stays before text inserted there.  */)
 864      (marker)
 865      register Lisp_Object marker;
 866 {
 867   CHECK_MARKER (marker);
 868   return XMARKER (marker)->insertion_type ? Qt : Qnil;
 869 }
 870
 871 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
 872        Sset_marker_insertion_type, 2, 2, 0,
 873        doc: /* Set the insertion-type of MARKER to TYPE.
 874 If TYPE is t, it means the marker advances when you insert text at it.
 875 If TYPE is nil, it means the marker stays behind when you insert text at it.  */)
 876      (marker, type)
 877      Lisp_Object marker, type;
 878 {
 879   CHECK_MARKER (marker);
 880
 881   XMARKER (marker)->insertion_type = ! NILP (type);
 882   return type;
 883 }
 884
 885 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
 886        1, 1, 0,
 887        doc: /* Return t if there are markers pointing at POSITION in the current buffer.  */)
 888      (position)
 889      Lisp_Object position;
 890 {
 891   register Lisp_Object tail;
 892   register int charno;
 893
 894   charno = XINT (position);
 895
 896   if (charno < BEG)
 897     charno = BEG;
 898   if (charno > Z)
 899     charno = Z;
 900
 901   for (tail = BUF_MARKERS (current_buffer);
 902        !NILP (tail);
 903        tail = XMARKER (tail)->chain)
 904     if (XMARKER (tail)->charpos == charno)
 905       return Qt;
 906
 907   return Qnil;
 908 }
 909
 910 /* For debugging -- count the markers in buffer BUF.  */
 911
 912 int
 913 count_markers (buf)
 914      struct buffer *buf;
 915 {
 916   int total = 0;
 917   Lisp_Object tail;
 918
 919   for (tail = BUF_MARKERS (buf);
 920        !NILP (tail);
 921        tail = XMARKER (tail)->chain)
 922     total++;
 923
 924   return total;
 925 }
 926 \f
 927 void
 928 syms_of_marker ()
 929 {
 930   defsubr (&Smarker_position);
 931   defsubr (&Smarker_buffer);
 932   defsubr (&Sset_marker);
 933   defsubr (&Scopy_marker);
 934   defsubr (&Smarker_insertion_type);
 935   defsubr (&Sset_marker_insertion_type);
 936   defsubr (&Sbuffer_has_markers_at);
 937
 938   DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
 939                doc: /* Non-nil enables debugging checks in byte/char position conversions.  */);
 940   byte_debug_flag = 0;
 941 }