src/marker.c

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