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