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.)
40 mark_marker (Lisp_Object obj, void (*markobj) (Lisp_Object))
42 struct Lisp_Marker *marker = XMARKER (obj);
44 /* DO NOT mark through the marker's chain.
45 The buffer's markers chain does not preserve markers from gc;
46 Instead, markers are removed from the chain when they are freed
52 XSETBUFFER (buf, marker->buffer);
57 print_marker (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
59 struct Lisp_Marker *marker = XMARKER (obj);
63 error ("printing unreadable object #<marker 0x%lx>", (long) marker);
65 write_c_string (GETTEXT ("#<marker "), printcharfun);
67 write_c_string (GETTEXT ("in no buffer"), printcharfun);
70 sprintf (buf, "at %d in ", marker_position (obj));
71 write_c_string (buf, printcharfun);
72 print_internal (marker->buffer->name, printcharfun, 0);
74 sprintf (buf, " 0x%lx>", (long) marker);
75 write_c_string (buf, printcharfun);
79 marker_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
81 struct Lisp_Marker *marker1 = XMARKER (obj1);
82 struct Lisp_Marker *marker2 = XMARKER (obj2);
84 return ((marker1->buffer == marker2->buffer) &&
85 (marker1->memind == marker2->memind ||
86 /* All markers pointing nowhere are equal */
91 marker_hash (Lisp_Object obj, int depth)
93 unsigned long hash = (unsigned long) XMARKER (obj)->buffer;
95 hash = HASH2 (hash, XMARKER (obj)->memind);
99 static const struct lrecord_description marker_description[] = {
100 { XD_LISP_OBJECT, offsetof(struct Lisp_Marker, next), 3 },
104 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker,
105 mark_marker, print_marker, 0,
106 marker_equal, marker_hash, marker_description,
109 /* Operations on markers. */
111 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
112 Return the buffer that MARKER points into, or nil if none.
113 Return nil if MARKER points into a dead buffer or doesn't point anywhere.
118 CHECK_MARKER (marker);
119 /* Return marker's buffer only if it is not dead. */
120 if ((buf = XMARKER (marker)->buffer) && BUFFER_LIVE_P (buf))
123 XSETBUFFER (buffer, buf);
129 DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /*
130 Return the position MARKER points at, as a character number.
131 Return `nil' if marker doesn't point anywhere.
135 CHECK_MARKER (marker);
136 return XMARKER (marker)->buffer ? make_int (marker_position (marker)) : Qnil;
139 #if 0 /* useful debugging function */
142 check_marker_circularities (struct buffer *buf)
144 struct Lisp_Marker *tortoise, *hare;
146 tortoise = BUF_MARKERS (buf);
154 assert (hare->buffer == buf);
158 assert (hare->buffer == buf);
162 tortoise = tortoise->next;
163 assert (tortoise != hare);
170 set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer,
175 struct Lisp_Marker *m;
178 CHECK_MARKER (marker);
180 point_p = POINT_MARKER_P (marker);
182 /* If position is nil or a marker that points nowhere,
183 make this marker point nowhere. */
185 (MARKERP (pos) && !XMARKER (pos)->buffer))
188 signal_simple_error ("Can't make point-marker point nowhere",
190 if (XMARKER (marker)->buffer)
191 unchain_marker (marker);
195 CHECK_INT_COERCE_MARKER (pos);
200 CHECK_BUFFER (buffer);
201 b = XBUFFER (buffer);
202 /* If buffer is dead, set marker to point nowhere. */
203 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
207 ("Can't move point-marker in a killed buffer", marker);
208 if (XMARKER (marker)->buffer)
209 unchain_marker (marker);
215 m = XMARKER (marker);
219 if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b);
220 if (charno > BUF_ZV (b)) charno = BUF_ZV (b);
224 if (charno < BUF_BEG (b)) charno = BUF_BEG (b);
225 if (charno > BUF_Z (b)) charno = BUF_Z (b);
230 #ifndef moving_point_by_moving_its_marker_is_a_bug
231 BUF_SET_PT (b, charno); /* this will move the marker */
232 #else /* It's not a feature, so it must be a bug */
233 signal_simple_error ("DEBUG: attempt to move point via point-marker",
239 m->memind = bufpos_to_memind (b, charno);
245 signal_simple_error ("Can't change buffer of point-marker", marker);
247 unchain_marker (marker);
249 marker_next (m) = BUF_MARKERS (b);
252 marker_prev (BUF_MARKERS (b)) = m;
260 DEFUN ("set-marker", Fset_marker, 2, 3, 0, /*
261 Position MARKER before character number NUMBER in BUFFER.
262 BUFFER defaults to the current buffer.
263 If NUMBER is nil, makes marker point nowhere.
264 Then it no longer slows down editing in any buffer.
265 If this marker was returned by (point-marker t), then changing its position
266 moves point. You cannot change its buffer or make it point nowhere.
269 (marker, number, buffer))
271 return set_marker_internal (marker, number, buffer, 0);
275 /* This version of Fset_marker won't let the position
276 be outside the visible part. */
278 set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
280 return set_marker_internal (marker, pos, buffer, 1);
284 /* This is called during garbage collection,
285 so we must be careful to ignore and preserve mark bits,
286 including those in chain fields of markers. */
289 unchain_marker (Lisp_Object m)
291 struct Lisp_Marker *marker = XMARKER (m);
292 struct buffer *b = marker->buffer;
297 #ifdef ERROR_CHECK_GC
298 assert (BUFFER_LIVE_P (b));
301 if (marker_next (marker))
302 marker_prev (marker_next (marker)) = marker_prev (marker);
303 if (marker_prev (marker))
304 marker_next (marker_prev (marker)) = marker_next (marker);
306 BUF_MARKERS (b) = marker_next (marker);
308 #ifdef ERROR_CHECK_GC
309 assert (marker != XMARKER (b->point_marker));
316 bi_marker_position (Lisp_Object marker)
318 struct Lisp_Marker *m = XMARKER (marker);
319 struct buffer *buf = m->buffer;
323 error ("Marker does not point anywhere");
325 /* FSF claims that marker indices could end up denormalized, i.e.
326 in the gap. This is way bogus if it ever happens, and means
327 something fucked up elsewhere. Since I've overhauled all this
328 shit, I don't think this can happen. In any case, the following
329 macro has an assert() in it that will catch these denormalized
331 pos = memind_to_bytind (buf, m->memind);
333 #ifdef ERROR_CHECK_BUFPOS
334 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
342 marker_position (Lisp_Object marker)
344 struct buffer *buf = XMARKER (marker)->buffer;
347 error ("Marker does not point anywhere");
349 return bytind_to_bufpos (buf, bi_marker_position (marker));
353 set_bi_marker_position (Lisp_Object marker, Bytind pos)
355 struct Lisp_Marker *m = XMARKER (marker);
356 struct buffer *buf = m->buffer;
359 error ("Marker does not point anywhere");
361 #ifdef ERROR_CHECK_BUFPOS
362 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
366 m->memind = bytind_to_memind (buf, pos);
370 set_marker_position (Lisp_Object marker, Bufpos pos)
372 struct buffer *buf = XMARKER (marker)->buffer;
375 error ("Marker does not point anywhere");
377 set_bi_marker_position (marker, bufpos_to_bytind (buf, pos));
381 copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum)
383 REGISTER Lisp_Object new;
387 if (INTP (marker) || MARKERP (marker))
390 new = noseeum_make_marker ();
392 new = Fmake_marker ();
393 Fset_marker (new, marker,
394 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
395 XMARKER (new)->insertion_type = !NILP (type);
399 marker = wrong_type_argument (Qinteger_or_marker_p, marker);
402 RETURN_NOT_REACHED (Qnil) /* not reached */
405 DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /*
406 Return a new marker pointing at the same place as MARKER.
407 If argument is a number, makes a new marker pointing
408 at that position in the current buffer.
409 The optional argument TYPE specifies the insertion type of the new marker;
410 see `marker-insertion-type'.
414 return copy_marker_1 (marker, type, 0);
418 noseeum_copy_marker (Lisp_Object marker, Lisp_Object type)
420 return copy_marker_1 (marker, type, 1);
423 DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /*
424 Return insertion type of MARKER: t if it stays after inserted text.
425 nil means the marker stays before text inserted there.
429 CHECK_MARKER (marker);
430 return XMARKER (marker)->insertion_type ? Qt : Qnil;
433 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /*
434 Set the insertion-type of MARKER to TYPE.
435 If TYPE is t, it means the marker advances when you insert text at it.
436 If TYPE is nil, it means the marker stays behind when you insert text at it.
440 CHECK_MARKER (marker);
442 XMARKER (marker)->insertion_type = ! NILP (type);
446 /* #### What is the possible use of this? It looks quite useless to
447 me, because there is no way to find *which* markers are positioned
448 at POSITION. Additional bogosity bonus: (buffer-has-markers-at
449 (point)) will always return t because of the `point-marker'. The
450 same goes for the position of mark. Bletch!
452 Someone should discuss this with Stallman, but I don't have the
453 stomach. In fact, this function sucks so badly that I'm disabling
454 it by default (although I've debugged it). If you want to use it,
455 use extents instead. --hniksic */
457 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
458 Return t if there are markers pointing at POSITION in the current buffer.
462 struct Lisp_Marker *marker;
465 /* A small optimization trick: convert POS to memind now, rather
466 than converting every marker's memory index to bufpos. */
467 pos = bytind_to_memind (current_buffer,
468 get_buffer_pos_byte (current_buffer, position,
471 for (marker = BUF_MARKERS (current_buffer);
473 marker = marker_next (marker))
475 /* We use marker->memind, so we don't have to go through the
476 unwieldy operation of creating a Lisp_Object for
477 marker_position() every time around. */
478 if (marker->memind == pos)
486 #ifdef MEMORY_USAGE_STATS
489 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats)
491 struct Lisp_Marker *m;
495 for (m = BUF_MARKERS (b); m; m = m->next)
496 total += sizeof (struct Lisp_Marker);
497 ovstats->was_requested += total;
498 overhead = fixed_type_block_overhead (total);
499 /* #### claiming this is all malloc overhead is not really right,
500 but it has to go somewhere. */
501 ovstats->malloc_overhead += overhead;
502 return total + overhead;
505 #endif /* MEMORY_USAGE_STATS */
509 syms_of_marker (void)
511 DEFSUBR (Fmarker_position);
512 DEFSUBR (Fmarker_buffer);
513 DEFSUBR (Fset_marker);
514 DEFSUBR (Fcopy_marker);
515 DEFSUBR (Fmarker_insertion_type);
516 DEFSUBR (Fset_marker_insertion_type);
517 #if 0 /* FSFmacs crock */
518 DEFSUBR (Fbuffer_has_markers_at);
523 init_buffer_markers (struct buffer *b)
528 b->mark = Fmake_marker ();
530 b->point_marker = Fmake_marker ();
531 Fset_marker (b->point_marker,
532 /* For indirect buffers, point is already set. */
533 b->base_buffer ? make_int (BUF_PT (b)) : make_int (1),
538 uninit_buffer_markers (struct buffer *b)
540 /* Unchain all markers of this buffer
541 and leave them pointing nowhere. */
542 REGISTER struct Lisp_Marker *m, *next;
543 for (m = BUF_MARKERS (b); m; m = next)
546 next = marker_next (m);