1 /* Markers: examining, setting and killing.
2 Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
4 This file is part of SXEmacs
6 SXEmacs 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.
11 SXEmacs 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.
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* Synched up with: FSF 19.30. */
22 /* This file has been Mule-ized. */
24 /* Note that markers are currently kept in an unordered list.
25 This means that marker operations may be inefficient if
26 there are a bunch of markers in the buffer. This probably
27 won't have a significant impact on redisplay (which uses
28 markers), but if it does, it wouldn't be too hard to change
29 to an ordered gap array. (Just copy the code from extents.c.)
37 static Lisp_Object mark_marker(Lisp_Object obj)
39 Lisp_Marker *marker = XMARKER(obj);
41 /* DO NOT mark through the marker's chain.
42 The buffer's markers chain does not preserve markers from gc;
43 Instead, markers are removed from the chain when they are freed
49 XSETBUFFER(buf, marker->buffer);
54 print_marker(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
56 Lisp_Marker *marker = XMARKER(obj);
60 error("printing unreadable object #<marker 0x%lx>",
63 write_c_string(GETTEXT("#<marker "), printcharfun);
65 write_c_string(GETTEXT("in no buffer"), printcharfun);
67 sprintf(buf, "at %ld in ", (long)marker_position(obj));
68 write_c_string(buf, printcharfun);
69 print_internal(marker->buffer->name, printcharfun, 0);
71 sprintf(buf, " 0x%lx>", (long)marker);
72 write_c_string(buf, printcharfun);
75 static int marker_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
77 Lisp_Marker *marker1 = XMARKER(obj1);
78 Lisp_Marker *marker2 = XMARKER(obj2);
80 return ((marker1->buffer == marker2->buffer) &&
81 (marker1->memind == marker2->memind ||
82 /* All markers pointing nowhere are equal */
86 static unsigned long marker_hash(Lisp_Object obj, int depth)
88 unsigned long hash = (unsigned long)XMARKER(obj)->buffer;
90 hash = HASH2(hash, XMARKER(obj)->memind);
94 static const struct lrecord_description marker_description[] = {
95 {XD_LISP_OBJECT, offsetof(Lisp_Marker, next)},
96 {XD_LISP_OBJECT, offsetof(Lisp_Marker, prev)},
97 {XD_LISP_OBJECT, offsetof(Lisp_Marker, buffer)},
101 DEFINE_BASIC_LRECORD_IMPLEMENTATION("marker", marker,
102 mark_marker, print_marker, 0,
103 marker_equal, marker_hash,
104 marker_description, Lisp_Marker);
106 /* Operations on markers. */
108 DEFUN("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
109 Return the buffer that MARKER points into, or nil if none.
110 Return nil if MARKER points into a dead buffer or doesn't point anywhere.
115 CHECK_MARKER(marker);
116 /* Return marker's buffer only if it is not dead. */
117 if ((buf = XMARKER(marker)->buffer) && BUFFER_LIVE_P(buf)) {
119 XSETBUFFER(buffer, buf);
125 DEFUN("marker-position", Fmarker_position, 1, 1, 0, /*
126 Return the position MARKER points at, as a character number.
127 Return `nil' if marker doesn't point anywhere.
131 CHECK_MARKER(marker);
132 return XMARKER(marker)->
133 buffer ? make_int(marker_position(marker)) : Qnil;
136 #if 0 /* useful debugging function */
138 static void check_marker_circularities(struct buffer *buf)
140 Lisp_Marker *tortoise, *hare;
142 tortoise = BUF_MARKERS(buf);
149 assert(hare->buffer == buf);
153 assert(hare->buffer == buf);
157 tortoise = tortoise->next;
158 assert(tortoise != hare);
165 set_marker_internal(Lisp_Object marker, Lisp_Object position,
166 Lisp_Object buffer, int restricted_p)
173 CHECK_MARKER(marker);
175 point_p = POINT_MARKER_P(marker);
177 /* If position is nil or a marker that points nowhere,
178 make this marker point nowhere. */
179 if (NILP(position) || (MARKERP(position) && !XMARKER(position)->buffer)) {
182 ("Can't make point-marker point nowhere", marker);
183 if (XMARKER(marker)->buffer)
184 unchain_marker(marker);
188 CHECK_INT_COERCE_MARKER(position);
192 CHECK_BUFFER(buffer);
194 /* If buffer is dead, set marker to point nowhere. */
195 if (!BUFFER_LIVE_P(XBUFFER(buffer))) {
198 ("Can't move point-marker in a killed buffer",
200 if (XMARKER(marker)->buffer)
201 unchain_marker(marker);
206 charno = XINT(position);
210 if (charno < BUF_BEGV(b))
211 charno = BUF_BEGV(b);
212 if (charno > BUF_ZV(b))
215 if (charno < BUF_BEG(b))
217 if (charno > BUF_Z(b))
222 #ifndef moving_point_by_moving_its_marker_is_a_bug
223 BUF_SET_PT(b, charno); /* this will move the marker */
224 #else /* It's not a feature, so it must be a bug */
226 ("DEBUG: attempt to move point via point-marker", marker);
229 m->memind = bufpos_to_memind(b, charno);
232 if (m->buffer != b) {
235 ("Can't change buffer of point-marker", marker);
237 unchain_marker(marker);
239 marker_next(m) = BUF_MARKERS(b);
242 marker_prev(BUF_MARKERS(b)) = m;
249 DEFUN("set-marker", Fset_marker, 2, 3, 0, /*
250 Move MARKER to position POSITION in BUFFER.
251 POSITION can be a marker, an integer or nil. If POSITION is an
252 integer, make MARKER point before the POSITIONth character in BUFFER.
253 If POSITION is nil, makes MARKER point nowhere. Then it no longer
254 slows down editing in any buffer. If POSITION is less than 1, move
255 MARKER to the beginning of BUFFER. If POSITION is greater than the
256 size of BUFFER, move MARKER to the end of BUFFER.
257 BUFFER defaults to the current buffer.
258 If this marker was returned by (point-marker t), then changing its
259 position moves point. You cannot change its buffer or make it point
261 The return value is MARKER.
263 (marker, position, buffer))
265 return set_marker_internal(marker, position, buffer, 0);
268 /* This version of Fset_marker won't let the position
269 be outside the visible part. */
271 set_marker_restricted(Lisp_Object marker, Lisp_Object position,
274 return set_marker_internal(marker, position, buffer, 1);
277 /* This is called during garbage collection,
278 so we must be careful to ignore and preserve mark bits,
279 including those in chain fields of markers. */
281 void unchain_marker(Lisp_Object m)
283 Lisp_Marker *marker = XMARKER(m);
284 struct buffer *b = marker->buffer;
289 #ifdef ERROR_CHECK_GC
290 assert(BUFFER_LIVE_P(b));
293 if (marker_next(marker))
294 marker_prev(marker_next(marker)) = marker_prev(marker);
295 if (marker_prev(marker))
296 marker_next(marker_prev(marker)) = marker_next(marker);
298 BUF_MARKERS(b) = marker_next(marker);
300 #ifdef ERROR_CHECK_GC
301 assert(marker != XMARKER(b->point_marker));
307 Bytind bi_marker_position(Lisp_Object marker)
309 Lisp_Marker *m = XMARKER(marker);
310 struct buffer *buf = m->buffer;
314 error("Marker does not point anywhere");
316 /* FSF claims that marker indices could end up denormalized, i.e.
317 in the gap. This is way bogus if it ever happens, and means
318 something fucked up elsewhere. Since I've overhauled all this
319 shit, I don't think this can happen. In any case, the following
320 macro has an assert() in it that will catch these denormalized
322 pos = memind_to_bytind(buf, m->memind);
324 #ifdef ERROR_CHECK_BUFPOS
325 if (pos < BI_BUF_BEG(buf) || pos > BI_BUF_Z(buf))
332 Bufpos marker_position(Lisp_Object marker)
334 struct buffer *buf = XMARKER(marker)->buffer;
337 error("Marker does not point anywhere");
339 return bytind_to_bufpos(buf, bi_marker_position(marker));
342 void set_bi_marker_position(Lisp_Object marker, Bytind pos)
344 Lisp_Marker *m = XMARKER(marker);
345 struct buffer *buf = m->buffer;
348 error("Marker does not point anywhere");
350 #ifdef ERROR_CHECK_BUFPOS
351 if (pos < BI_BUF_BEG(buf) || pos > BI_BUF_Z(buf))
355 m->memind = bytind_to_memind(buf, pos);
358 void set_marker_position(Lisp_Object marker, Bufpos pos)
360 struct buffer *buf = XMARKER(marker)->buffer;
363 error("Marker does not point anywhere");
365 set_bi_marker_position(marker, bufpos_to_bytind(buf, pos));
369 copy_marker_1(Lisp_Object marker, Lisp_Object type, int noseeum)
371 REGISTER Lisp_Object new;
374 if (INTP(marker) || MARKERP(marker)) {
376 new = noseeum_make_marker();
378 new = Fmake_marker();
379 Fset_marker(new, marker,
380 (MARKERP(marker) ? Fmarker_buffer(marker) :
382 XMARKER(new)->insertion_type = !NILP(type);
386 wrong_type_argument(Qinteger_or_marker_p, marker);
389 RETURN_NOT_REACHED(Qnil) /* not reached */
392 DEFUN("copy-marker", Fcopy_marker, 1, 2, 0, /*
393 Return a new marker pointing at the same place as MARKER-OR-INTEGER.
394 If MARKER-OR-INTEGER is an integer, return a new marker pointing
395 at that position in the current buffer.
396 Optional argument MARKER-TYPE specifies the insertion type of the new
397 marker; see `marker-insertion-type'.
399 (marker_or_integer, marker_type))
401 return copy_marker_1(marker_or_integer, marker_type, 0);
404 Lisp_Object noseeum_copy_marker(Lisp_Object marker, Lisp_Object marker_type)
406 return copy_marker_1(marker, marker_type, 1);
409 DEFUN("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /*
410 Return insertion type of MARKER: t if it stays after inserted text.
411 nil means the marker stays before text inserted there.
415 CHECK_MARKER(marker);
416 return XMARKER(marker)->insertion_type ? Qt : Qnil;
419 DEFUN("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /*
420 Set the insertion-type of MARKER to TYPE.
421 If TYPE is t, it means the marker advances when you insert text at it.
422 If TYPE is nil, it means the marker stays behind when you insert text at it.
426 CHECK_MARKER(marker);
428 XMARKER(marker)->insertion_type = !NILP(type);
432 /* #### What is the possible use of this? It looks quite useless to
433 me, because there is no way to find *which* markers are positioned
434 at POSITION. Additional bogosity bonus: (buffer-has-markers-at
435 (point)) will always return t because of the `point-marker'. The
436 same goes for the position of mark. Bletch!
438 Someone should discuss this with Stallman, but I don't have the
439 stomach. In fact, this function sucks so badly that I'm disabling
440 it by default (although I've debugged it). If you want to use it,
441 use extents instead. --hniksic */
443 xxDEFUN("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
444 Return t if there are markers pointing at POSITION in the current buffer.
451 /* A small optimization trick: convert POS to memind now, rather
452 than converting every marker's memory index to bufpos. */
453 pos = bytind_to_memind(current_buffer,
454 get_buffer_pos_byte(current_buffer, position,
457 for (marker = BUF_MARKERS(current_buffer);
458 marker; marker = marker_next(marker)) {
459 /* We use marker->memind, so we don't have to go through the
460 unwieldy operation of creating a Lisp_Object for
461 marker_position() every time around. */
462 if (marker->memind == pos)
470 #if defined MEMORY_USAGE_STATS && !(defined HAVE_BDWGC && defined EF_USE_BDWGC)
473 compute_buffer_marker_usage(struct buffer *b, struct overhead_stats *ovstats)
479 for (m = BUF_MARKERS(b); m; m = m->next)
480 total += sizeof(Lisp_Marker);
481 ovstats->was_requested += total;
482 overhead = fixed_type_block_overhead(total);
483 /* #### claiming this is all malloc overhead is not really right,
484 but it has to go somewhere. */
485 ovstats->malloc_overhead += overhead;
486 return total + overhead;
489 #endif /* MEMORY_USAGE_STATS */
491 void syms_of_marker(void)
493 INIT_LRECORD_IMPLEMENTATION(marker);
495 DEFSUBR(Fmarker_position);
496 DEFSUBR(Fmarker_buffer);
497 DEFSUBR(Fset_marker);
498 DEFSUBR(Fcopy_marker);
499 DEFSUBR(Fmarker_insertion_type);
500 DEFSUBR(Fset_marker_insertion_type);
501 #if 0 /* FSFmacs crock */
502 DEFSUBR(Fbuffer_has_markers_at);
506 void init_buffer_markers(struct buffer *b)
511 b->mark = Fmake_marker();
513 b->point_marker = Fmake_marker();
514 Fset_marker(b->point_marker,
515 /* For indirect buffers, point is already set. */
516 b->base_buffer ? make_int(BUF_PT(b)) : make_int(1), buf);
519 void uninit_buffer_markers(struct buffer *b)
521 /* Unchain all markers of this buffer
522 and leave them pointing nowhere. */
523 REGISTER Lisp_Marker *m, *next;
524 for (m = BUF_MARKERS(b); m; m = next) {
526 next = marker_next(m);