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 {
 260   int below = 1;
 261   int below_byte = 1;
 262
 263   while (below != charpos)
 264     {
 265       below++;
 266       BUF_INC_POS (current_buffer, below_byte);
 267     }
 268
 269   return below_byte;
 270 }
 271 \f
 272 /* bytepos_to_charpos returns the char position corresponding to BYTEPOS.  */
 273
 274 /* This macro is a subroutine of bytepos_to_charpos.
 275    It is used when BYTEPOS is actually the byte position.  */
 276
 277 #define CONSIDER(BYTEPOS, CHARPOS)                                      \
 278 {                                                                       \
 279   int this_bytepos = (BYTEPOS);                                         \
 280   int changed = 0;                                                      \
 281                                                                         \
 282   if (this_bytepos == bytepos)                                          \
 283     {                                                                   \
 284       int value = (CHARPOS);                                            \
 285       if (byte_debug_flag)                                              \
 286         byte_char_debug_check (b, value, bytepos);                      \
 287       return value;                                                     \
 288     }                                                                   \
 289   else if (this_bytepos > bytepos)                                      \
 290     {                                                                   \
 291       if (this_bytepos < best_above_byte)                               \
 292         {                                                               \
 293           best_above = (CHARPOS);                                       \
 294           best_above_byte = this_bytepos;                               \
 295           changed = 1;                                                  \
 296         }                                                               \
 297     }                                                                   \
 298   else if (this_bytepos > best_below_byte)                              \
 299     {                                                                   \
 300       best_below = (CHARPOS);                                           \
 301       best_below_byte = this_bytepos;                                   \
 302       changed = 1;                                                      \
 303     }                                                                   \
 304                                                                         \
 305   if (changed)                                                          \
 306     {                                                                   \
 307       if (best_above - best_below == best_above_byte - best_below_byte) \
 308         {                                                               \
 309           int value = best_below + (bytepos - best_below_byte);         \
 310           if (byte_debug_flag)                                          \
 311             byte_char_debug_check (b, value, bytepos);                  \
 312           return value;                                                 \
 313         }                                                               \
 314     }                                                                   \
 315 }
 316
 317 int
 318 bytepos_to_charpos (bytepos)
 319      int bytepos;
 320 {
 321   return buf_bytepos_to_charpos (current_buffer, bytepos);
 322 }
 323
 324 int
 325 buf_bytepos_to_charpos (b, bytepos)
 326      struct buffer *b;
 327      int bytepos;
 328 {
 329   struct Lisp_Marker *tail;
 330   int best_above, best_above_byte;
 331   int best_below, best_below_byte;
 332
 333   if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b))
 334     abort ();
 335
 336   best_above = BUF_Z (b);
 337   best_above_byte = BUF_Z_BYTE (b);
 338
 339   /* If this buffer has as many characters as bytes,
 340      each character must be one byte.
 341      This takes care of the case where enable-multibyte-characters is nil.  */
 342   if (best_above == best_above_byte)
 343     return bytepos;
 344
 345   best_below = BEG;
 346   best_below_byte = BEG_BYTE;
 347
 348   CONSIDER (BUF_PT_BYTE (b), BUF_PT (b));
 349   CONSIDER (BUF_GPT_BYTE (b), BUF_GPT (b));
 350   CONSIDER (BUF_BEGV_BYTE (b), BUF_BEGV (b));
 351   CONSIDER (BUF_ZV_BYTE (b), BUF_ZV (b));
 352
 353   if (b == cached_buffer && BUF_MODIFF (b) == cached_modiff)
 354     CONSIDER (cached_bytepos, cached_charpos);
 355
 356   for (tail = BUF_MARKERS (b); tail; tail = tail->next)
 357     {
 358       CONSIDER (tail->bytepos, tail->charpos);
 359
 360       /* If we are down to a range of 50 chars,
 361          don't bother checking any other markers;
 362          scan the intervening chars directly now.  */
 363       if (best_above - best_below < 50)
 364         break;
 365     }
 366
 367   /* We get here if we did not exactly hit one of the known places.
 368      We have one known above and one known below.
 369      Scan, counting characters, from whichever one is closer.  */
 370
 371   if (bytepos - best_below_byte < best_above_byte - bytepos)
 372     {
 373       int record = bytepos - best_below_byte > 5000;
 374
 375       while (best_below_byte < bytepos)
 376         {
 377           best_below++;
 378           BUF_INC_POS (b, best_below_byte);
 379         }
 380
 381       /* If this position is quite far from the nearest known position,
 382          cache the correspondence by creating a marker here.
 383          It will last until the next GC.
 384          But don't do it if BUF_MARKERS is nil;
 385          that is a signal from Fset_buffer_multibyte.  */
 386       if (record && BUF_MARKERS (b))
 387         {
 388           Lisp_Object marker, buffer;
 389           marker = Fmake_marker ();
 390           XSETBUFFER (buffer, b);
 391           set_marker_both (marker, buffer, best_below, best_below_byte);
 392         }
 393
 394       if (byte_debug_flag)
 395         byte_char_debug_check (b, best_below, bytepos);
 396
 397       cached_buffer = b;
 398       cached_modiff = BUF_MODIFF (b);
 399       cached_charpos = best_below;
 400       cached_bytepos = best_below_byte;
 401
 402       return best_below;
 403     }
 404   else
 405     {
 406       int record = best_above_byte - bytepos > 5000;
 407
 408       while (best_above_byte > bytepos)
 409         {
 410           best_above--;
 411           BUF_DEC_POS (b, best_above_byte);
 412         }
 413
 414       /* If this position is quite far from the nearest known position,
 415          cache the correspondence by creating a marker here.
 416          It will last until the next GC.
 417          But don't do it if BUF_MARKERS is nil;
 418          that is a signal from Fset_buffer_multibyte.  */
 419       if (record && BUF_MARKERS (b))
 420         {
 421           Lisp_Object marker, buffer;
 422           marker = Fmake_marker ();
 423           XSETBUFFER (buffer, b);
 424           set_marker_both (marker, buffer, best_above, best_above_byte);
 425         }
 426
 427       if (byte_debug_flag)
 428         byte_char_debug_check (b, best_above, bytepos);
 429
 430       cached_buffer = b;
 431       cached_modiff = BUF_MODIFF (b);
 432       cached_charpos = best_above;
 433       cached_bytepos = best_above_byte;
 434
 435       return best_above;
 436     }
 437 }
 438
 439 #undef CONSIDER
 440 \f
 441 /* Operations on markers. */
 442
 443 DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
 444        doc: /* Return the buffer that MARKER points into, or nil if none.
 445 Returns nil if MARKER points into a dead buffer.  */)
 446      (marker)
 447      register Lisp_Object marker;
 448 {
 449   register Lisp_Object buf;
 450   CHECK_MARKER (marker);
 451   if (XMARKER (marker)->buffer)
 452     {
 453       XSETBUFFER (buf, XMARKER (marker)->buffer);
 454       /* Return marker's buffer only if it is not dead.  */
 455       if (!NILP (XBUFFER (buf)->name))
 456         return buf;
 457     }
 458   return Qnil;
 459 }
 460
 461 DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
 462        doc: /* Return the position MARKER points at, as a character number.  */)
 463      (marker)
 464      Lisp_Object marker;
 465 {
 466   CHECK_MARKER (marker);
 467   if (XMARKER (marker)->buffer)
 468     return make_number (XMARKER (marker)->charpos);
 469
 470   return Qnil;
 471 }
 472 \f
 473 DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
 474        doc: /* Position MARKER before character number POSITION in BUFFER.
 475 BUFFER defaults to the current buffer.
 476 If POSITION is nil, makes marker point nowhere.
 477 Then it no longer slows down editing in any buffer.
 478 Returns MARKER.  */)
 479      (marker, position, buffer)
 480      Lisp_Object marker, position, buffer;
 481 {
 482   register int charno, bytepos;
 483   register struct buffer *b;
 484   register struct Lisp_Marker *m;
 485
 486   CHECK_MARKER (marker);
 487   m = XMARKER (marker);
 488
 489   /* If position is nil or a marker that points nowhere,
 490      make this marker point nowhere.  */
 491   if (NILP (position)
 492       || (MARKERP (position) && !XMARKER (position)->buffer))
 493     {
 494       unchain_marker (m);
 495       return marker;
 496     }
 497
 498   if (NILP (buffer))
 499     b = current_buffer;
 500   else
 501     {
 502       CHECK_BUFFER (buffer);
 503       b = XBUFFER (buffer);
 504       /* If buffer is dead, set marker to point nowhere.  */
 505       if (EQ (b->name, Qnil))
 506         {
 507           unchain_marker (m);
 508           return marker;
 509         }
 510     }
 511
 512   /* Optimize the special case where we are copying the position
 513      of an existing marker, and MARKER is already in the same buffer.  */
 514   if (MARKERP (position) && b == XMARKER (position)->buffer
 515       && b == m->buffer)
 516     {
 517       m->bytepos = XMARKER (position)->bytepos;
 518       m->charpos = XMARKER (position)->charpos;
 519       return marker;
 520     }
 521
 522   CHECK_NUMBER_COERCE_MARKER (position);
 523
 524   charno = XINT (position);
 525
 526   if (charno < BUF_BEG (b))
 527     charno = BUF_BEG (b);
 528   if (charno > BUF_Z (b))
 529     charno = BUF_Z (b);
 530
 531   bytepos = buf_charpos_to_bytepos (b, charno);
 532
 533   /* Every character is at least one byte.  */
 534   if (charno > bytepos)
 535     abort ();
 536
 537   m->bytepos = bytepos;
 538   m->charpos = charno;
 539
 540   if (m->buffer != b)
 541     {
 542       unchain_marker (m);
 543       m->buffer = b;
 544       m->next = BUF_MARKERS (b);
 545       BUF_MARKERS (b) = m;
 546     }
 547
 548   return marker;
 549 }
 550
 551 /* This version of Fset_marker won't let the position
 552    be outside the visible part.  */
 553
 554 Lisp_Object
 555 set_marker_restricted (marker, pos, buffer)
 556      Lisp_Object marker, pos, buffer;
 557 {
 558   register int charno, bytepos;
 559   register struct buffer *b;
 560   register struct Lisp_Marker *m;
 561
 562   CHECK_MARKER (marker);
 563   m = XMARKER (marker);
 564
 565   /* If position is nil or a marker that points nowhere,
 566      make this marker point nowhere.  */
 567   if (NILP (pos)
 568       || (MARKERP (pos) && !XMARKER (pos)->buffer))
 569     {
 570       unchain_marker (m);
 571       return marker;
 572     }
 573
 574   if (NILP (buffer))
 575     b = current_buffer;
 576   else
 577     {
 578       CHECK_BUFFER (buffer);
 579       b = XBUFFER (buffer);
 580       /* If buffer is dead, set marker to point nowhere.  */
 581       if (EQ (b->name, Qnil))
 582         {
 583           unchain_marker (m);
 584           return marker;
 585         }
 586     }
 587
 588   /* Optimize the special case where we are copying the position
 589      of an existing marker, and MARKER is already in the same buffer.  */
 590   if (MARKERP (pos) && b == XMARKER (pos)->buffer
 591       && b == m->buffer)
 592     {
 593       m->bytepos = XMARKER (pos)->bytepos;
 594       m->charpos = XMARKER (pos)->charpos;
 595       return marker;
 596     }
 597
 598   CHECK_NUMBER_COERCE_MARKER (pos);
 599
 600   charno = XINT (pos);
 601
 602   if (charno < BUF_BEGV (b))
 603     charno = BUF_BEGV (b);
 604   if (charno > BUF_ZV (b))
 605     charno = BUF_ZV (b);
 606
 607   bytepos = buf_charpos_to_bytepos (b, charno);
 608
 609   /* Every character is at least one byte.  */
 610   if (charno > bytepos)
 611     abort ();
 612
 613   m->bytepos = bytepos;
 614   m->charpos = charno;
 615
 616   if (m->buffer != b)
 617     {
 618       unchain_marker (m);
 619       m->buffer = b;
 620       m->next = BUF_MARKERS (b);
 621       BUF_MARKERS (b) = m;
 622     }
 623
 624   return marker;
 625 }
 626 \f
 627 /* Set the position of MARKER, specifying both the
 628    character position and the corresponding byte position.  */
 629
 630 Lisp_Object
 631 set_marker_both (marker, buffer, charpos, bytepos)
 632      Lisp_Object marker, buffer;
 633      int charpos, bytepos;
 634 {
 635   register struct buffer *b;
 636   register struct Lisp_Marker *m;
 637
 638   CHECK_MARKER (marker);
 639   m = XMARKER (marker);
 640
 641   if (NILP (buffer))
 642     b = current_buffer;
 643   else
 644     {
 645       CHECK_BUFFER (buffer);
 646       b = XBUFFER (buffer);
 647       /* If buffer is dead, set marker to point nowhere.  */
 648       if (EQ (b->name, Qnil))
 649         {
 650           unchain_marker (m);
 651           return marker;
 652         }
 653     }
 654
 655   /* In a single-byte buffer, the two positions must be equal.  */
 656   if (BUF_Z (b) == BUF_Z_BYTE (b)
 657       && charpos != bytepos)
 658     abort ();
 659   /* Every character is at least one byte.  */
 660   if (charpos > bytepos)
 661     abort ();
 662
 663   m->bytepos = bytepos;
 664   m->charpos = charpos;
 665
 666   if (m->buffer != b)
 667     {
 668       unchain_marker (m);
 669       m->buffer = b;
 670       m->next = BUF_MARKERS (b);
 671       BUF_MARKERS (b) = m;
 672     }
 673
 674   return marker;
 675 }
 676
 677 /* This version of set_marker_both won't let the position
 678    be outside the visible part.  */
 679
 680 Lisp_Object
 681 set_marker_restricted_both (marker, buffer, charpos, bytepos)
 682      Lisp_Object marker, buffer;
 683      int charpos, bytepos;
 684 {
 685   register struct buffer *b;
 686   register struct Lisp_Marker *m;
 687
 688   CHECK_MARKER (marker);
 689   m = XMARKER (marker);
 690
 691   if (NILP (buffer))
 692     b = current_buffer;
 693   else
 694     {
 695       CHECK_BUFFER (buffer);
 696       b = XBUFFER (buffer);
 697       /* If buffer is dead, set marker to point nowhere.  */
 698       if (EQ (b->name, Qnil))
 699         {
 700           unchain_marker (m);
 701           return marker;
 702         }
 703     }
 704
 705   if (charpos < BUF_BEGV (b))
 706     charpos = BUF_BEGV (b);
 707   if (charpos > BUF_ZV (b))
 708     charpos = BUF_ZV (b);
 709   if (bytepos < BUF_BEGV_BYTE (b))
 710     bytepos = BUF_BEGV_BYTE (b);
 711   if (bytepos > BUF_ZV_BYTE (b))
 712     bytepos = BUF_ZV_BYTE (b);
 713
 714   /* In a single-byte buffer, the two positions must be equal.  */
 715   if (BUF_Z (b) == BUF_Z_BYTE (b)
 716       && charpos != bytepos)
 717     abort ();
 718   /* Every character is at least one byte.  */
 719   if (charpos > bytepos)
 720     abort ();
 721
 722   m->bytepos = bytepos;
 723   m->charpos = charpos;
 724
 725   if (m->buffer != b)
 726     {
 727       unchain_marker (m);
 728       m->buffer = b;
 729       m->next = BUF_MARKERS (b);
 730       BUF_MARKERS (b) = m;
 731     }
 732
 733   return marker;
 734 }
 735 \f
 736 /* Remove MARKER from the chain of whatever buffer it is in.
 737    Leave it "in no buffer".
 738
 739    This is called during garbage collection,
 740    so we must be careful to ignore and preserve mark bits,
 741    including those in chain fields of markers.  */
 742
 743 void
 744 unchain_marker (marker)
 745      register struct Lisp_Marker *marker;
 746 {
 747   register struct Lisp_Marker *tail, *prev, *next;
 748   register struct buffer *b;
 749
 750   b = marker->buffer;
 751   if (b == 0)
 752     return;
 753
 754   if (EQ (b->name, Qnil))
 755     abort ();
 756
 757   marker->buffer = 0;
 758
 759   tail = BUF_MARKERS (b);
 760   prev = NULL;
 761   while (tail)
 762     {
 763       next = tail->next;
 764
 765       if (marker == tail)
 766         {
 767           if (!prev)
 768             {
 769               BUF_MARKERS (b) = next;
 770               /* Deleting first marker from the buffer's chain.  Crash
 771                  if new first marker in chain does not say it belongs
 772                  to the same buffer, or at least that they have the same
 773                  base buffer.  */
 774               if (next && b->text != next->buffer->text)
 775                 abort ();
 776             }
 777           else
 778             prev->next = next;
 779           /* We have removed the marker from the chain;
 780              no need to scan the rest of the chain.  */
 781           return;
 782         }
 783       else
 784         prev = tail;
 785       tail = next;
 786     }
 787
 788   /* Marker was not in its chain.  */
 789   abort ();
 790 }
 791
 792 /* Return the char position of marker MARKER, as a C integer.  */
 793
 794 int
 795 marker_position (marker)
 796      Lisp_Object marker;
 797 {
 798   register struct Lisp_Marker *m = XMARKER (marker);
 799   register struct buffer *buf = m->buffer;
 800
 801   if (!buf)
 802     error ("Marker does not point anywhere");
 803
 804   return m->charpos;
 805 }
 806
 807 /* Return the byte position of marker MARKER, as a C integer.  */
 808
 809 int
 810 marker_byte_position (marker)
 811      Lisp_Object marker;
 812 {
 813   register struct Lisp_Marker *m = XMARKER (marker);
 814   register struct buffer *buf = m->buffer;
 815   register int i = m->bytepos;
 816
 817   if (!buf)
 818     error ("Marker does not point anywhere");
 819
 820   if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
 821     abort ();
 822
 823   return i;
 824 }
 825 \f
 826 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
 827        doc: /* Return a new marker pointing at the same place as MARKER.
 828 If argument is a number, makes a new marker pointing
 829 at that position in the current buffer.
 830 The optional argument TYPE specifies the insertion type of the new marker;
 831 see `marker-insertion-type'.  */)
 832      (marker, type)
 833      register Lisp_Object marker, type;
 834 {
 835   register Lisp_Object new;
 836
 837   if (! (INTEGERP (marker) || MARKERP (marker)))
 838     marker = wrong_type_argument (Qinteger_or_marker_p, marker);
 839
 840   new = Fmake_marker ();
 841   Fset_marker (new, marker,
 842                (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
 843   XMARKER (new)->insertion_type = !NILP (type);
 844   return new;
 845 }
 846
 847 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
 848        Smarker_insertion_type, 1, 1, 0,
 849        doc: /* Return insertion type of MARKER: t if it stays after inserted text.
 850 nil means the marker stays before text inserted there.  */)
 851      (marker)
 852      register Lisp_Object marker;
 853 {
 854   CHECK_MARKER (marker);
 855   return XMARKER (marker)->insertion_type ? Qt : Qnil;
 856 }
 857
 858 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
 859        Sset_marker_insertion_type, 2, 2, 0,
 860        doc: /* Set the insertion-type of MARKER to TYPE.
 861 If TYPE is t, it means the marker advances when you insert text at it.
 862 If TYPE is nil, it means the marker stays behind when you insert text at it.  */)
 863      (marker, type)
 864      Lisp_Object marker, type;
 865 {
 866   CHECK_MARKER (marker);
 867
 868   XMARKER (marker)->insertion_type = ! NILP (type);
 869   return type;
 870 }
 871
 872 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
 873        1, 1, 0,
 874        doc: /* Return t if there are markers pointing at POSITION in the current buffer.  */)
 875      (position)
 876      Lisp_Object position;
 877 {
 878   register struct Lisp_Marker *tail;
 879   register int charno;
 880
 881   charno = XINT (position);
 882
 883   if (charno < BEG)
 884     charno = BEG;
 885   if (charno > Z)
 886     charno = Z;
 887
 888   for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
 889     if (tail->charpos == charno)
 890       return Qt;
 891
 892   return Qnil;
 893 }
 894
 895 /* For debugging -- count the markers in buffer BUF.  */
 896
 897 int
 898 count_markers (buf)
 899      struct buffer *buf;
 900 {
 901   int total = 0;
 902   struct Lisp_Marker *tail;
 903
 904   for (tail = BUF_MARKERS (buf); tail; tail = tail->next)
 905     total++;
 906
 907   return total;
 908 }
 909 \f
 910 void
 911 syms_of_marker ()
 912 {
 913   defsubr (&Smarker_position);
 914   defsubr (&Smarker_buffer);
 915   defsubr (&Sset_marker);
 916   defsubr (&Scopy_marker);
 917   defsubr (&Smarker_insertion_type);
 918   defsubr (&Sset_marker_insertion_type);
 919   defsubr (&Sbuffer_has_markers_at);
 920
 921   DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
 922                doc: /* Non-nil enables debugging checks in byte/char position conversions.  */);
 923   byte_debug_flag = 0;
 924 }
 925
 926 /* arch-tag: 50aa418f-cdd0-4838-b64b-94aa4b2a3b74
 927    (do not change this comment) */