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       /* If the buffer is dead, we're in trouble: the buffer pointer here
 456          does not preserve the buffer from being GC'd (it's weak), so
 457          markers have to be unlinked from their buffer as soon as the buffer
 458          is killed.  */
 459       eassert (!NILP (XBUFFER (buf)->name));
 460       return buf;
 461     }
 462   return Qnil;
 463 }
 464
 465 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
 466        doc: /* Return the position MARKER points at, as a character number.
 467 Returns nil if MARKER points nowhere.  */)
 468      (marker)
 469      Lisp_Object marker;
 470 {
 471   CHECK_MARKER (marker);
 472   if (XMARKER (marker)->buffer)
 473     return make_number (XMARKER (marker)->charpos);
 474
 475   return Qnil;
 476 }
 477 \f
 478 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
 479        doc: /* Position MARKER before character number POSITION in BUFFER.
 480 BUFFER defaults to the current buffer.
 481 If POSITION is nil, makes marker point nowhere.
 482 Then it no longer slows down editing in any buffer.
 483 Returns MARKER.  */)
 484      (marker, position, buffer)
 485      Lisp_Object marker, position, buffer;
 486 {
 487   register int charno, bytepos;
 488   register struct buffer *b;
 489   register struct Lisp_Marker *m;
 490
 491   CHECK_MARKER (marker);
 492   m = XMARKER (marker);
 493
 494   /* If position is nil or a marker that points nowhere,
 495      make this marker point nowhere.  */
 496   if (NILP (position)
 497       || (MARKERP (position) && !XMARKER (position)->buffer))
 498     {
 499       unchain_marker (m);
 500       return marker;
 501     }
 502
 503   if (NILP (buffer))
 504     b = current_buffer;
 505   else
 506     {
 507       CHECK_BUFFER (buffer);
 508       b = XBUFFER (buffer);
 509       /* If buffer is dead, set marker to point nowhere.  */
 510       if (EQ (b->name, Qnil))
 511         {
 512           unchain_marker (m);
 513           return marker;
 514         }
 515     }
 516
 517   /* Optimize the special case where we are copying the position
 518      of an existing marker, and MARKER is already in the same buffer.  */
 519   if (MARKERP (position) && b == XMARKER (position)->buffer
 520       && b == m->buffer)
 521     {
 522       m->bytepos = XMARKER (position)->bytepos;
 523       m->charpos = XMARKER (position)->charpos;
 524       return marker;
 525     }
 526
 527   CHECK_NUMBER_COERCE_MARKER (position);
 528
 529   charno = XINT (position);
 530
 531   if (charno < BUF_BEG (b))
 532     charno = BUF_BEG (b);
 533   if (charno > BUF_Z (b))
 534     charno = BUF_Z (b);
 535
 536   bytepos = buf_charpos_to_bytepos (b, charno);
 537
 538   /* Every character is at least one byte.  */
 539   if (charno > bytepos)
 540     abort ();
 541
 542   m->bytepos = bytepos;
 543   m->charpos = charno;
 544
 545   if (m->buffer != b)
 546     {
 547       unchain_marker (m);
 548       m->buffer = b;
 549       m->next = BUF_MARKERS (b);
 550       BUF_MARKERS (b) = m;
 551     }
 552
 553   return marker;
 554 }
 555
 556 /* This version of Fset_marker won't let the position
 557    be outside the visible part.  */
 558
 559 Lisp_Object
 560 set_marker_restricted (marker, pos, buffer)
 561      Lisp_Object marker, pos, buffer;
 562 {
 563   register int charno, bytepos;
 564   register struct buffer *b;
 565   register struct Lisp_Marker *m;
 566
 567   CHECK_MARKER (marker);
 568   m = XMARKER (marker);
 569
 570   /* If position is nil or a marker that points nowhere,
 571      make this marker point nowhere.  */
 572   if (NILP (pos)
 573       || (MARKERP (pos) && !XMARKER (pos)->buffer))
 574     {
 575       unchain_marker (m);
 576       return marker;
 577     }
 578
 579   if (NILP (buffer))
 580     b = current_buffer;
 581   else
 582     {
 583       CHECK_BUFFER (buffer);
 584       b = XBUFFER (buffer);
 585       /* If buffer is dead, set marker to point nowhere.  */
 586       if (EQ (b->name, Qnil))
 587         {
 588           unchain_marker (m);
 589           return marker;
 590         }
 591     }
 592
 593   /* Optimize the special case where we are copying the position
 594      of an existing marker, and MARKER is already in the same buffer.  */
 595   if (MARKERP (pos) && b == XMARKER (pos)->buffer
 596       && b == m->buffer)
 597     {
 598       m->bytepos = XMARKER (pos)->bytepos;
 599       m->charpos = XMARKER (pos)->charpos;
 600       return marker;
 601     }
 602
 603   CHECK_NUMBER_COERCE_MARKER (pos);
 604
 605   charno = XINT (pos);
 606
 607   if (charno < BUF_BEGV (b))
 608     charno = BUF_BEGV (b);
 609   if (charno > BUF_ZV (b))
 610     charno = BUF_ZV (b);
 611
 612   bytepos = buf_charpos_to_bytepos (b, charno);
 613
 614   /* Every character is at least one byte.  */
 615   if (charno > bytepos)
 616     abort ();
 617
 618   m->bytepos = bytepos;
 619   m->charpos = charno;
 620
 621   if (m->buffer != b)
 622     {
 623       unchain_marker (m);
 624       m->buffer = b;
 625       m->next = BUF_MARKERS (b);
 626       BUF_MARKERS (b) = m;
 627     }
 628
 629   return marker;
 630 }
 631 \f
 632 /* Set the position of MARKER, specifying both the
 633    character position and the corresponding byte position.  */
 634
 635 Lisp_Object
 636 set_marker_both (marker, buffer, charpos, bytepos)
 637      Lisp_Object marker, buffer;
 638      int charpos, bytepos;
 639 {
 640   register struct buffer *b;
 641   register struct Lisp_Marker *m;
 642
 643   CHECK_MARKER (marker);
 644   m = XMARKER (marker);
 645
 646   if (NILP (buffer))
 647     b = current_buffer;
 648   else
 649     {
 650       CHECK_BUFFER (buffer);
 651       b = XBUFFER (buffer);
 652       /* If buffer is dead, set marker to point nowhere.  */
 653       if (EQ (b->name, Qnil))
 654         {
 655           unchain_marker (m);
 656           return marker;
 657         }
 658     }
 659
 660   /* In a single-byte buffer, the two positions must be equal.  */
 661   if (BUF_Z (b) == BUF_Z_BYTE (b)
 662       && charpos != bytepos)
 663     abort ();
 664   /* Every character is at least one byte.  */
 665   if (charpos > bytepos)
 666     abort ();
 667
 668   m->bytepos = bytepos;
 669   m->charpos = charpos;
 670
 671   if (m->buffer != b)
 672     {
 673       unchain_marker (m);
 674       m->buffer = b;
 675       m->next = BUF_MARKERS (b);
 676       BUF_MARKERS (b) = m;
 677     }
 678
 679   return marker;
 680 }
 681
 682 /* This version of set_marker_both won't let the position
 683    be outside the visible part.  */
 684
 685 Lisp_Object
 686 set_marker_restricted_both (marker, buffer, charpos, bytepos)
 687      Lisp_Object marker, buffer;
 688      int charpos, bytepos;
 689 {
 690   register struct buffer *b;
 691   register struct Lisp_Marker *m;
 692
 693   CHECK_MARKER (marker);
 694   m = XMARKER (marker);
 695
 696   if (NILP (buffer))
 697     b = current_buffer;
 698   else
 699     {
 700       CHECK_BUFFER (buffer);
 701       b = XBUFFER (buffer);
 702       /* If buffer is dead, set marker to point nowhere.  */
 703       if (EQ (b->name, Qnil))
 704         {
 705           unchain_marker (m);
 706           return marker;
 707         }
 708     }
 709
 710   if (charpos < BUF_BEGV (b))
 711     charpos = BUF_BEGV (b);
 712   if (charpos > BUF_ZV (b))
 713     charpos = BUF_ZV (b);
 714   if (bytepos < BUF_BEGV_BYTE (b))
 715     bytepos = BUF_BEGV_BYTE (b);
 716   if (bytepos > BUF_ZV_BYTE (b))
 717     bytepos = BUF_ZV_BYTE (b);
 718
 719   /* In a single-byte buffer, the two positions must be equal.  */
 720   if (BUF_Z (b) == BUF_Z_BYTE (b)
 721       && charpos != bytepos)
 722     abort ();
 723   /* Every character is at least one byte.  */
 724   if (charpos > bytepos)
 725     abort ();
 726
 727   m->bytepos = bytepos;
 728   m->charpos = charpos;
 729
 730   if (m->buffer != b)
 731     {
 732       unchain_marker (m);
 733       m->buffer = b;
 734       m->next = BUF_MARKERS (b);
 735       BUF_MARKERS (b) = m;
 736     }
 737
 738   return marker;
 739 }
 740 \f
 741 /* Remove MARKER from the chain of whatever buffer it is in.
 742    Leave it "in no buffer".
 743
 744    This is called during garbage collection,
 745    so we must be careful to ignore and preserve mark bits,
 746    including those in chain fields of markers.  */
 747
 748 void
 749 unchain_marker (marker)
 750      register struct Lisp_Marker *marker;
 751 {
 752   register struct Lisp_Marker *tail, *prev, *next;
 753   register struct buffer *b;
 754
 755   b = marker->buffer;
 756   if (b == 0)
 757     return;
 758
 759   if (EQ (b->name, Qnil))
 760     abort ();
 761
 762   marker->buffer = 0;
 763
 764   tail = BUF_MARKERS (b);
 765   prev = NULL;
 766   while (tail)
 767     {
 768       next = tail->next;
 769
 770       if (marker == tail)
 771         {
 772           if (!prev)
 773             {
 774               BUF_MARKERS (b) = next;
 775               /* Deleting first marker from the buffer's chain.  Crash
 776                  if new first marker in chain does not say it belongs
 777                  to the same buffer, or at least that they have the same
 778                  base buffer.  */
 779               if (next && b->text != next->buffer->text)
 780                 abort ();
 781             }
 782           else
 783             prev->next = next;
 784           /* We have removed the marker from the chain;
 785              no need to scan the rest of the chain.  */
 786           return;
 787         }
 788       else
 789         prev = tail;
 790       tail = next;
 791     }
 792
 793   /* Marker was not in its chain.  */
 794   abort ();
 795 }
 796
 797 /* Return the char position of marker MARKER, as a C integer.  */
 798
 799 int
 800 marker_position (marker)
 801      Lisp_Object marker;
 802 {
 803   register struct Lisp_Marker *m = XMARKER (marker);
 804   register struct buffer *buf = m->buffer;
 805
 806   if (!buf)
 807     error ("Marker does not point anywhere");
 808
 809   return m->charpos;
 810 }
 811
 812 /* Return the byte position of marker MARKER, as a C integer.  */
 813
 814 int
 815 marker_byte_position (marker)
 816      Lisp_Object marker;
 817 {
 818   register struct Lisp_Marker *m = XMARKER (marker);
 819   register struct buffer *buf = m->buffer;
 820   register int i = m->bytepos;
 821
 822   if (!buf)
 823     error ("Marker does not point anywhere");
 824
 825   if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
 826     abort ();
 827
 828   return i;
 829 }
 830 \f
 831 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
 832        doc: /* Return a new marker pointing at the same place as MARKER.
 833 If argument is a number, makes a new marker pointing
 834 at that position in the current buffer.
 835 The optional argument TYPE specifies the insertion type of the new marker;
 836 see `marker-insertion-type'.  */)
 837      (marker, type)
 838      register Lisp_Object marker, type;
 839 {
 840   register Lisp_Object new;
 841
 842   CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker);
 843
 844   new = Fmake_marker ();
 845   Fset_marker (new, marker,
 846                (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
 847   XMARKER (new)->insertion_type = !NILP (type);
 848   return new;
 849 }
 850
 851 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
 852        Smarker_insertion_type, 1, 1, 0,
 853        doc: /* Return insertion type of MARKER: t if it stays after inserted text.
 854 The value nil means the marker stays before text inserted there.  */)
 855      (marker)
 856      register Lisp_Object marker;
 857 {
 858   CHECK_MARKER (marker);
 859   return XMARKER (marker)->insertion_type ? Qt : Qnil;
 860 }
 861
 862 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
 863        Sset_marker_insertion_type, 2, 2, 0,
 864        doc: /* Set the insertion-type of MARKER to TYPE.
 865 If TYPE is t, it means the marker advances when you insert text at it.
 866 If TYPE is nil, it means the marker stays behind when you insert text at it.  */)
 867      (marker, type)
 868      Lisp_Object marker, type;
 869 {
 870   CHECK_MARKER (marker);
 871
 872   XMARKER (marker)->insertion_type = ! NILP (type);
 873   return type;
 874 }
 875
 876 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
 877        1, 1, 0,
 878        doc: /* Return t if there are markers pointing at POSITION in the current buffer.  */)
 879      (position)
 880      Lisp_Object position;
 881 {
 882   register struct Lisp_Marker *tail;
 883   register int charno;
 884
 885   charno = XINT (position);
 886
 887   if (charno < BEG)
 888     charno = BEG;
 889   if (charno > Z)
 890     charno = Z;
 891
 892   for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
 893     if (tail->charpos == charno)
 894       return Qt;
 895
 896   return Qnil;
 897 }
 898
 899 /* For debugging -- count the markers in buffer BUF.  */
 900
 901 int
 902 count_markers (buf)
 903      struct buffer *buf;
 904 {
 905   int total = 0;
 906   struct Lisp_Marker *tail;
 907
 908   for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
 909     total++;
 910
 911   return total;
 912 }
 913 \f
 914 void
 915 syms_of_marker ()
 916 {
 917   defsubr (&Smarker_position);
 918   defsubr (&Smarker_buffer);
 919   defsubr (&Sset_marker);
 920   defsubr (&Scopy_marker);
 921   defsubr (&Smarker_insertion_type);
 922   defsubr (&Sset_marker_insertion_type);
 923   defsubr (&Sbuffer_has_markers_at);
 924
 925   DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
 926                doc: /* Non-nil enables debugging checks in byte/char position conversions.  */);
 927   byte_debug_flag = 0;
 928 }
 929
 930 /* arch-tag: 50aa418f-cdd0-4838-b64b-94aa4b2a3b74
 931    (do not change this comment) */