1 /* Markers: examining, setting and killing.
2 Copyright (C) 1985, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; 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. */
21 /* Synched up with: FSF 19.30. */
23 /* This file has been Mule-ized. */
25 /* Note that markers are currently kept in an unordered list.
26 This means that marker operations may be inefficient if
27 there are a bunch of markers in the buffer. This probably
28 won't have a significant impact on redisplay (which uses
29 markers), but if it does, it wouldn't be too hard to change
30 to an ordered gap array. (Just copy the code from extents.c.)
39 mark_marker (Lisp_Object obj)
41 Lisp_Marker *marker = XMARKER (obj);
43 /* DO NOT mark through the marker's chain.
44 The buffer's markers chain does not preserve markers from gc;
45 Instead, markers are removed from the chain when they are freed
51 XSETBUFFER (buf, marker->buffer);
56 print_marker (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
58 Lisp_Marker *marker = XMARKER (obj);
62 error ("printing unreadable object #<marker 0x%lx>", (long) marker);
64 write_c_string (GETTEXT ("#<marker "), printcharfun);
66 write_c_string (GETTEXT ("in no buffer"), printcharfun);
69 sprintf (buf, "at %ld in ", (long) marker_position (obj));
70 write_c_string (buf, printcharfun);
71 print_internal (marker->buffer->name, printcharfun, 0);
73 sprintf (buf, " 0x%lx>", (long) marker);
74 write_c_string (buf, printcharfun);
78 marker_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
80 Lisp_Marker *marker1 = XMARKER (obj1);
81 Lisp_Marker *marker2 = XMARKER (obj2);
83 return ((marker1->buffer == marker2->buffer) &&
84 (marker1->memind == marker2->memind ||
85 /* All markers pointing nowhere are equal */
90 marker_hash (Lisp_Object obj, int depth)
92 unsigned long hash = (unsigned long) XMARKER (obj)->buffer;
94 hash = HASH2 (hash, XMARKER (obj)->memind);
98 static const struct lrecord_description marker_description[] = {
99 { XD_LISP_OBJECT, offsetof (Lisp_Marker, next) },
100 { XD_LISP_OBJECT, offsetof (Lisp_Marker, prev) },
101 { XD_LISP_OBJECT, offsetof (Lisp_Marker, buffer) },
105 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker,
106 mark_marker, print_marker, 0,
107 marker_equal, marker_hash, marker_description,
110 /* Operations on markers. */
112 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
113 Return the buffer that MARKER points into, or nil if none.
114 Return nil if MARKER points into a dead buffer or doesn't point anywhere.
119 CHECK_MARKER (marker);
120 /* Return marker's buffer only if it is not dead. */
121 if ((buf = XMARKER (marker)->buffer) && BUFFER_LIVE_P (buf))
124 XSETBUFFER (buffer, buf);
130 DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /*
131 Return the position MARKER points at, as a character number.
132 Return `nil' if marker doesn't point anywhere.
136 CHECK_MARKER (marker);
137 return XMARKER (marker)->buffer ? make_int (marker_position (marker)) : Qnil;
140 #if 0 /* useful debugging function */
143 check_marker_circularities (struct buffer *buf)
145 Lisp_Marker *tortoise, *hare;
147 tortoise = BUF_MARKERS (buf);
155 assert (hare->buffer == buf);
159 assert (hare->buffer == buf);
163 tortoise = tortoise->next;
164 assert (tortoise != hare);
171 set_marker_internal (Lisp_Object marker, Lisp_Object position,
172 Lisp_Object buffer, int restricted_p)
179 CHECK_MARKER (marker);
181 point_p = POINT_MARKER_P (marker);
183 /* If position is nil or a marker that points nowhere,
184 make this marker point nowhere. */
185 if (NILP (position) ||
186 (MARKERP (position) && !XMARKER (position)->buffer))
189 signal_simple_error ("Can't make point-marker point nowhere",
191 if (XMARKER (marker)->buffer)
192 unchain_marker (marker);
196 CHECK_INT_COERCE_MARKER (position);
201 CHECK_BUFFER (buffer);
202 b = XBUFFER (buffer);
203 /* If buffer is dead, set marker to point nowhere. */
204 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
208 ("Can't move point-marker in a killed buffer", marker);
209 if (XMARKER (marker)->buffer)
210 unchain_marker (marker);
215 charno = XINT (position);
216 m = XMARKER (marker);
220 if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b);
221 if (charno > BUF_ZV (b)) charno = BUF_ZV (b);
225 if (charno < BUF_BEG (b)) charno = BUF_BEG (b);
226 if (charno > BUF_Z (b)) charno = BUF_Z (b);
231 #ifndef moving_point_by_moving_its_marker_is_a_bug
232 BUF_SET_PT (b, charno); /* this will move the marker */
233 #else /* It's not a feature, so it must be a bug */
234 signal_simple_error ("DEBUG: attempt to move point via point-marker",
240 m->memind = bufpos_to_memind (b, charno);
246 signal_simple_error ("Can't change buffer of point-marker", marker);
248 unchain_marker (marker);
250 marker_next (m) = BUF_MARKERS (b);
253 marker_prev (BUF_MARKERS (b)) = m;
261 DEFUN ("set-marker", Fset_marker, 2, 3, 0, /*
262 Move MARKER to position POSITION in BUFFER.
263 POSITION can be a marker, an integer or nil. If POSITION is an
264 integer, make MARKER point before the POSITIONth character in BUFFER.
265 If POSITION is nil, makes MARKER point nowhere. Then it no longer
266 slows down editing in any buffer. If POSITION is less than 1, move
267 MARKER to the beginning of BUFFER. If POSITION is greater than the
268 size of BUFFER, move MARKER to the end of BUFFER.
269 BUFFER defaults to the current buffer.
270 If this marker was returned by (point-marker t), then changing its
271 position moves point. You cannot change its buffer or make it point
273 The return value is MARKER.
275 (marker, position, buffer))
277 return set_marker_internal (marker, position, buffer, 0);
281 /* This version of Fset_marker won't let the position
282 be outside the visible part. */
284 set_marker_restricted (Lisp_Object marker, Lisp_Object position,
287 return set_marker_internal (marker, position, buffer, 1);
291 /* This is called during garbage collection,
292 so we must be careful to ignore and preserve mark bits,
293 including those in chain fields of markers. */
296 unchain_marker (Lisp_Object m)
298 Lisp_Marker *marker = XMARKER (m);
299 struct buffer *b = marker->buffer;
304 #ifdef ERROR_CHECK_GC
305 assert (BUFFER_LIVE_P (b));
308 if (marker_next (marker))
309 marker_prev (marker_next (marker)) = marker_prev (marker);
310 if (marker_prev (marker))
311 marker_next (marker_prev (marker)) = marker_next (marker);
313 BUF_MARKERS (b) = marker_next (marker);
315 #ifdef ERROR_CHECK_GC
316 assert (marker != XMARKER (b->point_marker));
323 bi_marker_position (Lisp_Object marker)
325 Lisp_Marker *m = XMARKER (marker);
326 struct buffer *buf = m->buffer;
330 error ("Marker does not point anywhere");
332 /* FSF claims that marker indices could end up denormalized, i.e.
333 in the gap. This is way bogus if it ever happens, and means
334 something fucked up elsewhere. Since I've overhauled all this
335 shit, I don't think this can happen. In any case, the following
336 macro has an assert() in it that will catch these denormalized
338 pos = memind_to_bytind (buf, m->memind);
340 #ifdef ERROR_CHECK_BUFPOS
341 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
349 marker_position (Lisp_Object marker)
351 struct buffer *buf = XMARKER (marker)->buffer;
354 error ("Marker does not point anywhere");
356 return bytind_to_bufpos (buf, bi_marker_position (marker));
360 set_bi_marker_position (Lisp_Object marker, Bytind pos)
362 Lisp_Marker *m = XMARKER (marker);
363 struct buffer *buf = m->buffer;
366 error ("Marker does not point anywhere");
368 #ifdef ERROR_CHECK_BUFPOS
369 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
373 m->memind = bytind_to_memind (buf, pos);
377 set_marker_position (Lisp_Object marker, Bufpos pos)
379 struct buffer *buf = XMARKER (marker)->buffer;
382 error ("Marker does not point anywhere");
384 set_bi_marker_position (marker, bufpos_to_bytind (buf, pos));
388 copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum)
390 REGISTER Lisp_Object new;
394 if (INTP (marker) || MARKERP (marker))
397 new = noseeum_make_marker ();
399 new = Fmake_marker ();
400 Fset_marker (new, marker,
401 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
402 XMARKER (new)->insertion_type = !NILP (type);
406 marker = wrong_type_argument (Qinteger_or_marker_p, marker);
409 RETURN_NOT_REACHED (Qnil) /* not reached */
412 DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /*
413 Return a new marker pointing at the same place as MARKER-OR-INTEGER.
414 If MARKER-OR-INTEGER is an integer, return a new marker pointing
415 at that position in the current buffer.
416 Optional argument MARKER-TYPE specifies the insertion type of the new
417 marker; see `marker-insertion-type'.
419 (marker_or_integer, marker_type))
421 return copy_marker_1 (marker_or_integer, marker_type, 0);
425 noseeum_copy_marker (Lisp_Object marker, Lisp_Object marker_type)
427 return copy_marker_1 (marker, marker_type, 1);
430 DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /*
431 Return insertion type of MARKER: t if it stays after inserted text.
432 nil means the marker stays before text inserted there.
436 CHECK_MARKER (marker);
437 return XMARKER (marker)->insertion_type ? Qt : Qnil;
440 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /*
441 Set the insertion-type of MARKER to TYPE.
442 If TYPE is t, it means the marker advances when you insert text at it.
443 If TYPE is nil, it means the marker stays behind when you insert text at it.
447 CHECK_MARKER (marker);
449 XMARKER (marker)->insertion_type = ! NILP (type);
453 /* #### What is the possible use of this? It looks quite useless to
454 me, because there is no way to find *which* markers are positioned
455 at POSITION. Additional bogosity bonus: (buffer-has-markers-at
456 (point)) will always return t because of the `point-marker'. The
457 same goes for the position of mark. Bletch!
459 Someone should discuss this with Stallman, but I don't have the
460 stomach. In fact, this function sucks so badly that I'm disabling
461 it by default (although I've debugged it). If you want to use it,
462 use extents instead. --hniksic */
464 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
465 Return t if there are markers pointing at POSITION in the current buffer.
472 /* A small optimization trick: convert POS to memind now, rather
473 than converting every marker's memory index to bufpos. */
474 pos = bytind_to_memind (current_buffer,
475 get_buffer_pos_byte (current_buffer, position,
478 for (marker = BUF_MARKERS (current_buffer);
480 marker = marker_next (marker))
482 /* We use marker->memind, so we don't have to go through the
483 unwieldy operation of creating a Lisp_Object for
484 marker_position() every time around. */
485 if (marker->memind == pos)
493 #ifdef MEMORY_USAGE_STATS
496 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats)
502 for (m = BUF_MARKERS (b); m; m = m->next)
503 total += sizeof (Lisp_Marker);
504 ovstats->was_requested += total;
505 overhead = fixed_type_block_overhead (total);
506 /* #### claiming this is all malloc overhead is not really right,
507 but it has to go somewhere. */
508 ovstats->malloc_overhead += overhead;
509 return total + overhead;
512 #endif /* MEMORY_USAGE_STATS */
516 syms_of_marker (void)
518 INIT_LRECORD_IMPLEMENTATION (marker);
520 DEFSUBR (Fmarker_position);
521 DEFSUBR (Fmarker_buffer);
522 DEFSUBR (Fset_marker);
523 DEFSUBR (Fcopy_marker);
524 DEFSUBR (Fmarker_insertion_type);
525 DEFSUBR (Fset_marker_insertion_type);
526 #if 0 /* FSFmacs crock */
527 DEFSUBR (Fbuffer_has_markers_at);
532 init_buffer_markers (struct buffer *b)
537 b->mark = Fmake_marker ();
539 b->point_marker = Fmake_marker ();
540 Fset_marker (b->point_marker,
541 /* For indirect buffers, point is already set. */
542 b->base_buffer ? make_int (BUF_PT (b)) : make_int (1),
547 uninit_buffer_markers (struct buffer *b)
549 /* Unchain all markers of this buffer
550 and leave them pointing nowhere. */
551 REGISTER Lisp_Marker *m, *next;
552 for (m = BUF_MARKERS (b); m; m = next)
555 next = marker_next (m);