src/marker.c

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