src/marker.c

   1 /* Markers: examining, setting and deleting.
   2    Copyright (C) 1985, 1997, 1998, 2002, 2003, 2004,
   3                  2005 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 2, 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      (marker)
 465      Lisp_Object marker;
 466 {
 467   CHECK_MARKER (marker);
 468   if (XMARKER (marker)->buffer)
 469     return make_number (XMARKER (marker)->charpos);
 470
 471   return Qnil;
 472 }
 473 \f
 474 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
 475        doc: /* Position MARKER before character number POSITION in BUFFER.
 476 BUFFER defaults to the current buffer.
 477 If POSITION is nil, makes marker point nowhere.
 478 Then it no longer slows down editing in any buffer.
 479 Returns MARKER.  */)
 480      (marker, position, buffer)
 481      Lisp_Object marker, position, buffer;
 482 {
 483   register int charno, bytepos;
 484   register struct buffer *b;
 485   register struct Lisp_Marker *m;
 486
 487   CHECK_MARKER (marker);
 488   m = XMARKER (marker);
 489
 490   /* If position is nil or a marker that points nowhere,
 491      make this marker point nowhere.  */
 492   if (NILP (position)
 493       || (MARKERP (position) && !XMARKER (position)->buffer))
 494     {
 495       unchain_marker (m);
 496       return marker;
 497     }
 498
 499   if (NILP (buffer))
 500     b = current_buffer;
 501   else
 502     {
 503       CHECK_BUFFER (buffer);
 504       b = XBUFFER (buffer);
 505       /* If buffer is dead, set marker to point nowhere.  */
 506       if (EQ (b->name, Qnil))
 507         {
 508           unchain_marker (m);
 509           return marker;
 510         }
 511     }
 512
 513   /* Optimize the special case where we are copying the position
 514      of an existing marker, and MARKER is already in the same buffer.  */
 515   if (MARKERP (position) && b == XMARKER (position)->buffer
 516       && b == m->buffer)
 517     {
 518       m->bytepos = XMARKER (position)->bytepos;
 519       m->charpos = XMARKER (position)->charpos;
 520       return marker;
 521     }
 522
 523   CHECK_NUMBER_COERCE_MARKER (position);
 524
 525   charno = XINT (position);
 526
 527   if (charno < BUF_BEG (b))
 528     charno = BUF_BEG (b);
 529   if (charno > BUF_Z (b))
 530     charno = BUF_Z (b);
 531
 532   bytepos = buf_charpos_to_bytepos (b, charno);
 533
 534   /* Every character is at least one byte.  */
 535   if (charno > bytepos)
 536     abort ();
 537
 538   m->bytepos = bytepos;
 539   m->charpos = charno;
 540
 541   if (m->buffer != b)
 542     {
 543       unchain_marker (m);
 544       m->buffer = b;
 545       m->next = BUF_MARKERS (b);
 546       BUF_MARKERS (b) = m;
 547     }
 548
 549   return marker;
 550 }
 551
 552 /* This version of Fset_marker won't let the position
 553    be outside the visible part.  */
 554
 555 Lisp_Object
 556 set_marker_restricted (marker, pos, buffer)
 557      Lisp_Object marker, pos, buffer;
 558 {
 559   register int charno, bytepos;
 560   register struct buffer *b;
 561   register struct Lisp_Marker *m;
 562
 563   CHECK_MARKER (marker);
 564   m = XMARKER (marker);
 565
 566   /* If position is nil or a marker that points nowhere,
 567      make this marker point nowhere.  */
 568   if (NILP (pos)
 569       || (MARKERP (pos) && !XMARKER (pos)->buffer))
 570     {
 571       unchain_marker (m);
 572       return marker;
 573     }
 574
 575   if (NILP (buffer))
 576     b = current_buffer;
 577   else
 578     {
 579       CHECK_BUFFER (buffer);
 580       b = XBUFFER (buffer);
 581       /* If buffer is dead, set marker to point nowhere.  */
 582       if (EQ (b->name, Qnil))
 583         {
 584           unchain_marker (m);
 585           return marker;
 586         }
 587     }
 588
 589   /* Optimize the special case where we are copying the position
 590      of an existing marker, and MARKER is already in the same buffer.  */
 591   if (MARKERP (pos) && b == XMARKER (pos)->buffer
 592       && b == m->buffer)
 593     {
 594       m->bytepos = XMARKER (pos)->bytepos;
 595       m->charpos = XMARKER (pos)->charpos;
 596       return marker;
 597     }
 598
 599   CHECK_NUMBER_COERCE_MARKER (pos);
 600
 601   charno = XINT (pos);
 602
 603   if (charno < BUF_BEGV (b))
 604     charno = BUF_BEGV (b);
 605   if (charno > BUF_ZV (b))
 606     charno = BUF_ZV (b);
 607
 608   bytepos = buf_charpos_to_bytepos (b, charno);
 609
 610   /* Every character is at least one byte.  */
 611   if (charno > bytepos)
 612     abort ();
 613
 614   m->bytepos = bytepos;
 615   m->charpos = charno;
 616
 617   if (m->buffer != b)
 618     {
 619       unchain_marker (m);
 620       m->buffer = b;
 621       m->next = BUF_MARKERS (b);
 622       BUF_MARKERS (b) = m;
 623     }
 624
 625   return marker;
 626 }
 627 \f
 628 /* Set the position of MARKER, specifying both the
 629    character position and the corresponding byte position.  */
 630
 631 Lisp_Object
 632 set_marker_both (marker, buffer, charpos, bytepos)
 633      Lisp_Object marker, buffer;
 634      int charpos, bytepos;
 635 {
 636   register struct buffer *b;
 637   register struct Lisp_Marker *m;
 638
 639   CHECK_MARKER (marker);
 640   m = XMARKER (marker);
 641
 642   if (NILP (buffer))
 643     b = current_buffer;
 644   else
 645     {
 646       CHECK_BUFFER (buffer);
 647       b = XBUFFER (buffer);
 648       /* If buffer is dead, set marker to point nowhere.  */
 649       if (EQ (b->name, Qnil))
 650         {
 651           unchain_marker (m);
 652           return marker;
 653         }
 654     }
 655
 656   /* In a single-byte buffer, the two positions must be equal.  */
 657   if (BUF_Z (b) == BUF_Z_BYTE (b)
 658       && charpos != bytepos)
 659     abort ();
 660   /* Every character is at least one byte.  */
 661   if (charpos > bytepos)
 662     abort ();
 663
 664   m->bytepos = bytepos;
 665   m->charpos = charpos;
 666
 667   if (m->buffer != b)
 668     {
 669       unchain_marker (m);
 670       m->buffer = b;
 671       m->next = BUF_MARKERS (b);
 672       BUF_MARKERS (b) = m;
 673     }
 674
 675   return marker;
 676 }
 677
 678 /* This version of set_marker_both won't let the position
 679    be outside the visible part.  */
 680
 681 Lisp_Object
 682 set_marker_restricted_both (marker, buffer, charpos, bytepos)
 683      Lisp_Object marker, buffer;
 684      int charpos, bytepos;
 685 {
 686   register struct buffer *b;
 687   register struct Lisp_Marker *m;
 688
 689   CHECK_MARKER (marker);
 690   m = XMARKER (marker);
 691
 692   if (NILP (buffer))
 693     b = current_buffer;
 694   else
 695     {
 696       CHECK_BUFFER (buffer);
 697       b = XBUFFER (buffer);
 698       /* If buffer is dead, set marker to point nowhere.  */
 699       if (EQ (b->name, Qnil))
 700         {
 701           unchain_marker (m);
 702           return marker;
 703         }
 704     }
 705
 706   if (charpos < BUF_BEGV (b))
 707     charpos = BUF_BEGV (b);
 708   if (charpos > BUF_ZV (b))
 709     charpos = BUF_ZV (b);
 710   if (bytepos < BUF_BEGV_BYTE (b))
 711     bytepos = BUF_BEGV_BYTE (b);
 712   if (bytepos > BUF_ZV_BYTE (b))
 713     bytepos = BUF_ZV_BYTE (b);
 714
 715   /* In a single-byte buffer, the two positions must be equal.  */
 716   if (BUF_Z (b) == BUF_Z_BYTE (b)
 717       && charpos != bytepos)
 718     abort ();
 719   /* Every character is at least one byte.  */
 720   if (charpos > bytepos)
 721     abort ();
 722
 723   m->bytepos = bytepos;
 724   m->charpos = charpos;
 725
 726   if (m->buffer != b)
 727     {
 728       unchain_marker (m);
 729       m->buffer = b;
 730       m->next = BUF_MARKERS (b);
 731       BUF_MARKERS (b) = m;
 732     }
 733
 734   return marker;
 735 }
 736 \f
 737 /* Remove MARKER from the chain of whatever buffer it is in.
 738    Leave it "in no buffer".
 739
 740    This is called during garbage collection,
 741    so we must be careful to ignore and preserve mark bits,
 742    including those in chain fields of markers.  */
 743
 744 void
 745 unchain_marker (marker)
 746      register struct Lisp_Marker *marker;
 747 {
 748   register struct Lisp_Marker *tail, *prev, *next;
 749   register struct buffer *b;
 750
 751   b = marker->buffer;
 752   if (b == 0)
 753     return;
 754
 755   if (EQ (b->name, Qnil))
 756     abort ();
 757
 758   marker->buffer = 0;
 759
 760   tail = BUF_MARKERS (b);
 761   prev = NULL;
 762   while (tail)
 763     {
 764       next = tail->next;
 765
 766       if (marker == tail)
 767         {
 768           if (!prev)
 769             {
 770               BUF_MARKERS (b) = next;
 771               /* Deleting first marker from the buffer's chain.  Crash
 772                  if new first marker in chain does not say it belongs
 773                  to the same buffer, or at least that they have the same
 774                  base buffer.  */
 775               if (next && b->text != next->buffer->text)
 776                 abort ();
 777             }
 778           else
 779             prev->next = next;
 780           /* We have removed the marker from the chain;
 781              no need to scan the rest of the chain.  */
 782           return;
 783         }
 784       else
 785         prev = tail;
 786       tail = next;
 787     }
 788
 789   /* Marker was not in its chain.  */
 790   abort ();
 791 }
 792
 793 /* Return the char position of marker MARKER, as a C integer.  */
 794
 795 int
 796 marker_position (marker)
 797      Lisp_Object marker;
 798 {
 799   register struct Lisp_Marker *m = XMARKER (marker);
 800   register struct buffer *buf = m->buffer;
 801
 802   if (!buf)
 803     error ("Marker does not point anywhere");
 804
 805   return m->charpos;
 806 }
 807
 808 /* Return the byte position of marker MARKER, as a C integer.  */
 809
 810 int
 811 marker_byte_position (marker)
 812      Lisp_Object marker;
 813 {
 814   register struct Lisp_Marker *m = XMARKER (marker);
 815   register struct buffer *buf = m->buffer;
 816   register int i = m->bytepos;
 817
 818   if (!buf)
 819     error ("Marker does not point anywhere");
 820
 821   if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
 822     abort ();
 823
 824   return i;
 825 }
 826 \f
 827 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
 828        doc: /* Return a new marker pointing at the same place as MARKER.
 829 If argument is a number, makes a new marker pointing
 830 at that position in the current buffer.
 831 The optional argument TYPE specifies the insertion type of the new marker;
 832 see `marker-insertion-type'.  */)
 833      (marker, type)
 834      register Lisp_Object marker, type;
 835 {
 836   register Lisp_Object new;
 837
 838   if (! (INTEGERP (marker) || MARKERP (marker)))
 839     marker = wrong_type_argument (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 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) */