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