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