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