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