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