src/marker.c

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