src/marker.c

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