src/marker.c

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