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);
58 error("printing unreadable object #<marker 0x%lx>",
61 write_c_string(GETTEXT("#<marker "), printcharfun);
63 write_c_string(GETTEXT("in no buffer"), printcharfun);
65 write_fmt_str(printcharfun, "at %ld in ", (long)marker_position(obj));
66 print_internal(marker->buffer->name, printcharfun, 0);
68 write_fmt_str(printcharfun, " 0x%lx>", (long)marker);
71 static int marker_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
73 Lisp_Marker *marker1 = XMARKER(obj1);
74 Lisp_Marker *marker2 = XMARKER(obj2);
76 return ((marker1->buffer == marker2->buffer) &&
77 (marker1->memind == marker2->memind ||
78 /* All markers pointing nowhere are equal */
82 static unsigned long marker_hash(Lisp_Object obj, int depth)
84 unsigned long hash = (unsigned long)XMARKER(obj)->buffer;
86 hash = HASH2(hash, XMARKER(obj)->memind);
90 static const struct lrecord_description marker_description[] = {
91 {XD_LISP_OBJECT, offsetof(Lisp_Marker, next)},
92 {XD_LISP_OBJECT, offsetof(Lisp_Marker, prev)},
93 {XD_LISP_OBJECT, offsetof(Lisp_Marker, buffer)},
97 DEFINE_BASIC_LRECORD_IMPLEMENTATION("marker", marker,
98 mark_marker, print_marker, 0,
99 marker_equal, marker_hash,
100 marker_description, Lisp_Marker);
102 /* Operations on markers. */
104 DEFUN("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
105 Return the buffer that MARKER points into, or nil if none.
106 Return nil if MARKER points into a dead buffer or doesn't point anywhere.
111 CHECK_MARKER(marker);
112 /* Return marker's buffer only if it is not dead. */
113 if ((buf = XMARKER(marker)->buffer) && BUFFER_LIVE_P(buf)) {
115 XSETBUFFER(buffer, buf);
121 DEFUN("marker-position", Fmarker_position, 1, 1, 0, /*
122 Return the position MARKER points at, as a character number.
123 Return `nil' if marker doesn't point anywhere.
127 CHECK_MARKER(marker);
128 return XMARKER(marker)->
129 buffer ? make_int(marker_position(marker)) : Qnil;
132 #if 0 /* useful debugging function */
134 static void check_marker_circularities(struct buffer *buf)
136 Lisp_Marker *tortoise, *hare;
138 tortoise = BUF_MARKERS(buf);
145 assert(hare->buffer == buf);
149 assert(hare->buffer == buf);
153 tortoise = tortoise->next;
154 assert(tortoise != hare);
161 set_marker_internal(Lisp_Object marker, Lisp_Object position,
162 Lisp_Object buffer, int restricted_p)
169 CHECK_MARKER(marker);
171 point_p = POINT_MARKER_P(marker);
173 /* If position is nil or a marker that points nowhere,
174 make this marker point nowhere. */
175 if (NILP(position) || (MARKERP(position) && !XMARKER(position)->buffer)) {
178 ("Can't make point-marker point nowhere", marker);
179 if (XMARKER(marker)->buffer)
180 unchain_marker(marker);
184 CHECK_INT_COERCE_MARKER(position);
188 CHECK_BUFFER(buffer);
190 /* If buffer is dead, set marker to point nowhere. */
191 if (!BUFFER_LIVE_P(XBUFFER(buffer))) {
194 ("Can't move point-marker in a killed buffer",
196 if (XMARKER(marker)->buffer)
197 unchain_marker(marker);
202 charno = XINT(position);
206 if (charno < BUF_BEGV(b))
207 charno = BUF_BEGV(b);
208 if (charno > BUF_ZV(b))
211 if (charno < BUF_BEG(b))
213 if (charno > BUF_Z(b))
218 #ifndef moving_point_by_moving_its_marker_is_a_bug
219 BUF_SET_PT(b, charno); /* this will move the marker */
220 #else /* It's not a feature, so it must be a bug */
222 ("DEBUG: attempt to move point via point-marker", marker);
225 m->memind = bufpos_to_memind(b, charno);
228 if (m->buffer != b) {
231 ("Can't change buffer of point-marker", marker);
233 unchain_marker(marker);
235 marker_next(m) = BUF_MARKERS(b);
238 marker_prev(BUF_MARKERS(b)) = m;
245 DEFUN("set-marker", Fset_marker, 2, 3, 0, /*
246 Move MARKER to position POSITION in BUFFER.
247 POSITION can be a marker, an integer or nil. If POSITION is an
248 integer, make MARKER point before the POSITIONth character in BUFFER.
249 If POSITION is nil, makes MARKER point nowhere. Then it no longer
250 slows down editing in any buffer. If POSITION is less than 1, move
251 MARKER to the beginning of BUFFER. If POSITION is greater than the
252 size of BUFFER, move MARKER to the end of BUFFER.
253 BUFFER defaults to the current buffer.
254 If this marker was returned by (point-marker t), then changing its
255 position moves point. You cannot change its buffer or make it point
257 The return value is MARKER.
259 (marker, position, buffer))
261 return set_marker_internal(marker, position, buffer, 0);
264 /* This version of Fset_marker won't let the position
265 be outside the visible part. */
267 set_marker_restricted(Lisp_Object marker, Lisp_Object position,
270 return set_marker_internal(marker, position, buffer, 1);
273 /* This is called during garbage collection,
274 so we must be careful to ignore and preserve mark bits,
275 including those in chain fields of markers. */
277 void unchain_marker(Lisp_Object m)
279 Lisp_Marker *marker = XMARKER(m);
280 struct buffer *b = marker->buffer;
285 #ifdef ERROR_CHECK_GC
286 assert(BUFFER_LIVE_P(b));
289 if (marker_next(marker))
290 marker_prev(marker_next(marker)) = marker_prev(marker);
291 if (marker_prev(marker))
292 marker_next(marker_prev(marker)) = marker_next(marker);
294 BUF_MARKERS(b) = marker_next(marker);
296 #ifdef ERROR_CHECK_GC
297 assert(marker != XMARKER(b->point_marker));
303 Bytind bi_marker_position(Lisp_Object marker)
305 Lisp_Marker *m = XMARKER(marker);
306 struct buffer *buf = m->buffer;
310 error("Marker does not point anywhere");
312 /* FSF claims that marker indices could end up denormalized, i.e.
313 in the gap. This is way bogus if it ever happens, and means
314 something fucked up elsewhere. Since I've overhauled all this
315 shit, I don't think this can happen. In any case, the following
316 macro has an assert() in it that will catch these denormalized
318 pos = memind_to_bytind(buf, m->memind);
320 #ifdef ERROR_CHECK_BUFPOS
321 if (pos < BI_BUF_BEG(buf) || pos > BI_BUF_Z(buf))
328 Bufpos marker_position(Lisp_Object marker)
330 struct buffer *buf = XMARKER(marker)->buffer;
333 error("Marker does not point anywhere");
335 return bytind_to_bufpos(buf, bi_marker_position(marker));
338 void set_bi_marker_position(Lisp_Object marker, Bytind pos)
340 Lisp_Marker *m = XMARKER(marker);
341 struct buffer *buf = m->buffer;
344 error("Marker does not point anywhere");
346 #ifdef ERROR_CHECK_BUFPOS
347 if (pos < BI_BUF_BEG(buf) || pos > BI_BUF_Z(buf))
351 m->memind = bytind_to_memind(buf, pos);
354 void set_marker_position(Lisp_Object marker, Bufpos pos)
356 struct buffer *buf = XMARKER(marker)->buffer;
359 error("Marker does not point anywhere");
361 set_bi_marker_position(marker, bufpos_to_bytind(buf, pos));
365 copy_marker_1(Lisp_Object marker, Lisp_Object type, int noseeum)
367 REGISTER Lisp_Object new;
370 if (INTP(marker) || MARKERP(marker)) {
372 new = noseeum_make_marker();
374 new = Fmake_marker();
375 Fset_marker(new, marker,
376 (MARKERP(marker) ? Fmarker_buffer(marker) :
378 XMARKER(new)->insertion_type = !NILP(type);
382 wrong_type_argument(Qinteger_or_marker_p, marker);
385 RETURN_NOT_REACHED(Qnil) /* not reached */
388 DEFUN("copy-marker", Fcopy_marker, 1, 2, 0, /*
389 Return a new marker pointing at the same place as MARKER-OR-INTEGER.
390 If MARKER-OR-INTEGER is an integer, return a new marker pointing
391 at that position in the current buffer.
392 Optional argument MARKER-TYPE specifies the insertion type of the new
393 marker; see `marker-insertion-type'.
395 (marker_or_integer, marker_type))
397 return copy_marker_1(marker_or_integer, marker_type, 0);
400 Lisp_Object noseeum_copy_marker(Lisp_Object marker, Lisp_Object marker_type)
402 return copy_marker_1(marker, marker_type, 1);
405 DEFUN("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /*
406 Return insertion type of MARKER: t if it stays after inserted text.
407 nil means the marker stays before text inserted there.
411 CHECK_MARKER(marker);
412 return XMARKER(marker)->insertion_type ? Qt : Qnil;
415 DEFUN("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /*
416 Set the insertion-type of MARKER to TYPE.
417 If TYPE is t, it means the marker advances when you insert text at it.
418 If TYPE is nil, it means the marker stays behind when you insert text at it.
422 CHECK_MARKER(marker);
424 XMARKER(marker)->insertion_type = !NILP(type);
428 /* #### What is the possible use of this? It looks quite useless to
429 me, because there is no way to find *which* markers are positioned
430 at POSITION. Additional bogosity bonus: (buffer-has-markers-at
431 (point)) will always return t because of the `point-marker'. The
432 same goes for the position of mark. Bletch!
434 Someone should discuss this with Stallman, but I don't have the
435 stomach. In fact, this function sucks so badly that I'm disabling
436 it by default (although I've debugged it). If you want to use it,
437 use extents instead. --hniksic */
439 xxDEFUN("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
440 Return t if there are markers pointing at POSITION in the current buffer.
447 /* A small optimization trick: convert POS to memind now, rather
448 than converting every marker's memory index to bufpos. */
449 pos = bytind_to_memind(current_buffer,
450 get_buffer_pos_byte(current_buffer, position,
453 for (marker = BUF_MARKERS(current_buffer);
454 marker; marker = marker_next(marker)) {
455 /* We use marker->memind, so we don't have to go through the
456 unwieldy operation of creating a Lisp_Object for
457 marker_position() every time around. */
458 if (marker->memind == pos)
466 #if defined MEMORY_USAGE_STATS && !(defined HAVE_BDWGC && defined EF_USE_BDWGC)
469 compute_buffer_marker_usage(struct buffer *b, struct overhead_stats *ovstats)
475 for (m = BUF_MARKERS(b); m; m = m->next)
476 total += sizeof(Lisp_Marker);
477 ovstats->was_requested += total;
478 overhead = fixed_type_block_overhead(total);
479 /* #### claiming this is all malloc overhead is not really right,
480 but it has to go somewhere. */
481 ovstats->malloc_overhead += overhead;
482 return total + overhead;
485 #endif /* MEMORY_USAGE_STATS */
487 void syms_of_marker(void)
489 INIT_LRECORD_IMPLEMENTATION(marker);
491 DEFSUBR(Fmarker_position);
492 DEFSUBR(Fmarker_buffer);
493 DEFSUBR(Fset_marker);
494 DEFSUBR(Fcopy_marker);
495 DEFSUBR(Fmarker_insertion_type);
496 DEFSUBR(Fset_marker_insertion_type);
497 #if 0 /* FSFmacs crock */
498 DEFSUBR(Fbuffer_has_markers_at);
502 void init_buffer_markers(struct buffer *b)
507 b->mark = Fmake_marker();
509 b->point_marker = Fmake_marker();
510 Fset_marker(b->point_marker,
511 /* For indirect buffers, point is already set. */
512 b->base_buffer ? make_int(BUF_PT(b)) : make_int(1), buf);
515 void uninit_buffer_markers(struct buffer *b)
517 /* Unchain all markers of this buffer
518 and leave them pointing nowhere. */
519 REGISTER Lisp_Marker *m, *next;
520 for (m = BUF_MARKERS(b); m; m = next) {
522 next = marker_next(m);