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
 625   if (NILP (buffer))
 626     b = current_buffer;
 627   else
 628     {
 629       CHECK_BUFFER (buffer, 1);
 630       b = XBUFFER (buffer);
 631       /* If buffer is dead, set marker to point nowhere.  */
 632       if (EQ (b->name, Qnil))
 633         {
 634           unchain_marker (marker);
 635           return marker;
 636         }
 637     }
 638
 639   m = XMARKER (marker);
 640
 641   /* In a single-byte buffer, the two positions must be equal.  */
 642   if (BUF_Z (b) == BUF_Z_BYTE (b)
 643       && charpos != bytepos)
 644     abort ();
 645   /* Every character is at least one byte.  */
 646   if (charpos > bytepos)
 647     abort ();
 648
 649   m->bytepos = bytepos;
 650   m->charpos = charpos;
 651
 652   if (m->buffer != b)
 653     {
 654       unchain_marker (marker);
 655       m->buffer = b;
 656       m->chain = BUF_MARKERS (b);
 657       BUF_MARKERS (b) = marker;
 658     }
 659
 660   return marker;
 661 }
 662
 663 /* This version of set_marker_both won't let the position
 664    be outside the visible part.  */
 665
 666 Lisp_Object
 667 set_marker_restricted_both (marker, buffer, charpos, bytepos)
 668      Lisp_Object marker, buffer;
 669      int charpos, bytepos;
 670 {
 671   register struct buffer *b;
 672   register struct Lisp_Marker *m;
 673
 674   CHECK_MARKER (marker, 0);
 675
 676   if (NILP (buffer))
 677     b = current_buffer;
 678   else
 679     {
 680       CHECK_BUFFER (buffer, 1);
 681       b = XBUFFER (buffer);
 682       /* If buffer is dead, set marker to point nowhere.  */
 683       if (EQ (b->name, Qnil))
 684         {
 685           unchain_marker (marker);
 686           return marker;
 687         }
 688     }
 689
 690   m = XMARKER (marker);
 691
 692   if (charpos < BUF_BEGV (b))
 693     charpos = BUF_BEGV (b);
 694   if (charpos > BUF_ZV (b))
 695     charpos = BUF_ZV (b);
 696   if (bytepos < BUF_BEGV_BYTE (b))
 697     bytepos = BUF_BEGV_BYTE (b);
 698   if (bytepos > BUF_ZV_BYTE (b))
 699     bytepos = BUF_ZV_BYTE (b);
 700
 701   /* In a single-byte buffer, the two positions must be equal.  */
 702   if (BUF_Z (b) == BUF_Z_BYTE (b)
 703       && charpos != bytepos)
 704     abort ();
 705   /* Every character is at least one byte.  */
 706   if (charpos > bytepos)
 707     abort ();
 708
 709   m->bytepos = bytepos;
 710   m->charpos = charpos;
 711
 712   if (m->buffer != b)
 713     {
 714       unchain_marker (marker);
 715       m->buffer = b;
 716       m->chain = BUF_MARKERS (b);
 717       BUF_MARKERS (b) = marker;
 718     }
 719
 720   return marker;
 721 }
 722 \f
 723 /* This is called during garbage collection,
 724    so we must be careful to ignore and preserve mark bits,
 725    including those in chain fields of markers.  */
 726
 727 void
 728 unchain_marker (marker)
 729      register Lisp_Object marker;
 730 {
 731   register Lisp_Object tail, prev, next;
 732   register EMACS_INT omark;
 733   register struct buffer *b;
 734
 735   b = XMARKER (marker)->buffer;
 736   if (b == 0)
 737     return;
 738
 739   if (EQ (b->name, Qnil))
 740     abort ();
 741
 742   tail = BUF_MARKERS (b);
 743   prev = Qnil;
 744   while (XSYMBOL (tail) != XSYMBOL (Qnil))
 745     {
 746       next = XMARKER (tail)->chain;
 747       XUNMARK (next);
 748
 749       if (XMARKER (marker) == XMARKER (tail))
 750         {
 751           if (NILP (prev))
 752             {
 753               BUF_MARKERS (b) = next;
 754               /* Deleting first marker from the buffer's chain.  Crash
 755                  if new first marker in chain does not say it belongs
 756                  to the same buffer, or at least that they have the same
 757                  base buffer.  */
 758               if (!NILP (next) && b->text != XMARKER (next)->buffer->text)
 759                 abort ();
 760             }
 761           else
 762             {
 763               omark = XMARKBIT (XMARKER (prev)->chain);
 764               XMARKER (prev)->chain = next;
 765               XSETMARKBIT (XMARKER (prev)->chain, omark);
 766             }
 767           break;
 768         }
 769       else
 770         prev = tail;
 771       tail = next;
 772     }
 773   XMARKER (marker)->buffer = 0;
 774 }
 775
 776 /* Return the char position of marker MARKER, as a C integer.  */
 777
 778 int
 779 marker_position (marker)
 780      Lisp_Object marker;
 781 {
 782   register struct Lisp_Marker *m = XMARKER (marker);
 783   register struct buffer *buf = m->buffer;
 784
 785   if (!buf)
 786     error ("Marker does not point anywhere");
 787
 788   return m->charpos;
 789 }
 790
 791 /* Return the byte position of marker MARKER, as a C integer.  */
 792
 793 int
 794 marker_byte_position (marker)
 795      Lisp_Object marker;
 796 {
 797   register struct Lisp_Marker *m = XMARKER (marker);
 798   register struct buffer *buf = m->buffer;
 799   register int i = m->bytepos;
 800
 801   if (!buf)
 802     error ("Marker does not point anywhere");
 803
 804   if (i < BUF_BEG_BYTE (buf) || i > BUF_Z_BYTE (buf))
 805     abort ();
 806
 807   return i;
 808 }
 809 \f
 810 DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0,
 811   "Return a new marker pointing at the same place as MARKER.\n\
 812 If argument is a number, makes a new marker pointing\n\
 813 at that position in the current buffer.\n\
 814 The optional argument TYPE specifies the insertion type of the new marker;\n\
 815 see `marker-insertion-type'.")
 816   (marker, type)
 817      register Lisp_Object marker, type;
 818 {
 819   register Lisp_Object new;
 820
 821   if (INTEGERP (marker) || MARKERP (marker))
 822     {
 823       new = Fmake_marker ();
 824       Fset_marker (new, marker,
 825                    (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
 826       XMARKER (new)->insertion_type = !NILP (type);
 827       return new;
 828     }
 829   else
 830     marker = wrong_type_argument (Qinteger_or_marker_p, marker);
 831 }
 832
 833 DEFUN ("marker-insertion-type", Fmarker_insertion_type,
 834        Smarker_insertion_type, 1, 1, 0,
 835   "Return insertion type of MARKER: t if it stays after inserted text.\n\
 836 nil means the marker stays before text inserted there.")
 837   (marker)
 838      register Lisp_Object marker;
 839 {
 840   register Lisp_Object buf;
 841   CHECK_MARKER (marker, 0);
 842   return XMARKER (marker)->insertion_type ? Qt : Qnil;
 843 }
 844
 845 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type,
 846        Sset_marker_insertion_type, 2, 2, 0,
 847   "Set the insertion-type of MARKER to TYPE.\n\
 848 If TYPE is t, it means the marker advances when you insert text at it.\n\
 849 If TYPE is nil, it means the marker stays behind when you insert text at it.")
 850   (marker, type)
 851      Lisp_Object marker, type;
 852 {
 853   CHECK_MARKER (marker, 0);
 854
 855   XMARKER (marker)->insertion_type = ! NILP (type);
 856   return type;
 857 }
 858
 859 DEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, Sbuffer_has_markers_at,
 860   1, 1, 0,
 861   "Return t if there are markers pointing at POSITION in the current buffer.")
 862   (position)
 863       Lisp_Object position;
 864 {
 865   register Lisp_Object tail;
 866   register int charno;
 867
 868   charno = XINT (position);
 869
 870   if (charno < BEG)
 871     charno = BEG;
 872   if (charno > Z)
 873     charno = Z;
 874
 875   for (tail = BUF_MARKERS (current_buffer);
 876        !NILP (tail);
 877        tail = XMARKER (tail)->chain)
 878     if (XMARKER (tail)->charpos == charno)
 879       return Qt;
 880
 881   return Qnil;
 882 }
 883 \f
 884 void
 885 syms_of_marker ()
 886 {
 887   defsubr (&Smarker_position);
 888   defsubr (&Smarker_buffer);
 889   defsubr (&Sset_marker);
 890   defsubr (&Scopy_marker);
 891   defsubr (&Smarker_insertion_type);
 892   defsubr (&Sset_marker_insertion_type);
 893   defsubr (&Sbuffer_has_markers_at);
 894
 895   DEFVAR_BOOL ("byte-debug-flag", &byte_debug_flag,
 896    "Non-nil enables debugging checks in byte/char position conversions.");
 897   byte_debug_flag = 0;
 898
 899 }