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, void (*markobj) (Lisp_Object))
41 struct 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 struct 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 %d in ", 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 o1, Lisp_Object o2, int depth)
80 struct buffer *b1 = XMARKER (o1)->buffer;
81 if (b1 != XMARKER (o2)->buffer)
84 /* All markers pointing nowhere are equal */
87 return ((XMARKER (o1)->memind == XMARKER (o2)->memind));
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 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker,
100 mark_marker, print_marker, 0,
101 marker_equal, marker_hash,
104 /* Operations on markers. */
106 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
107 Return the buffer that MARKER points into, or nil if none.
108 Return nil if MARKER points into a dead buffer or doesn't point anywhere.
113 CHECK_MARKER (marker);
114 /* Return marker's buffer only if it is not dead. */
115 if ((buf = XMARKER (marker)->buffer) && BUFFER_LIVE_P (buf))
118 XSETBUFFER (buffer, buf);
124 DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /*
125 Return the position MARKER points at, as a character number.
126 Return `nil' if marker doesn't point anywhere.
130 CHECK_MARKER (marker);
131 return XMARKER (marker)->buffer ? make_int (marker_position (marker)) : Qnil;
134 #if 0 /* useful debugging function */
137 check_marker_circularities (struct buffer *buf)
139 struct Lisp_Marker *tortoise, *hare;
141 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 pos, Lisp_Object buffer,
170 struct Lisp_Marker *m;
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. */
180 (MARKERP (pos) && !XMARKER (pos)->buffer))
183 signal_simple_error ("can't make point-marker point nowhere",
185 if (XMARKER (marker)->buffer)
186 unchain_marker (marker);
190 CHECK_INT_COERCE_MARKER (pos);
195 CHECK_BUFFER (buffer);
196 b = XBUFFER (buffer);
197 /* If buffer is dead, set marker to point nowhere. */
198 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
202 ("can't move point-marker in a killed buffer", marker);
203 if (XMARKER (marker)->buffer)
204 unchain_marker (marker);
210 m = XMARKER (marker);
214 if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b);
215 if (charno > BUF_ZV (b)) charno = BUF_ZV (b);
219 if (charno < BUF_BEG (b)) charno = BUF_BEG (b);
220 if (charno > BUF_Z (b)) charno = BUF_Z (b);
225 #ifndef moving_point_by_moving_its_marker_is_a_bug
226 BUF_SET_PT (b, charno); /* this will move the marker */
227 #else /* It's not a feature, so it must be a bug */
228 signal_simple_error ("DEBUG: attempt to move point via point-marker",
234 m->memind = bufpos_to_memind (b, charno);
240 signal_simple_error ("can't change buffer of point-marker", marker);
242 unchain_marker (marker);
244 marker_next (m) = BUF_MARKERS (b);
247 marker_prev (BUF_MARKERS (b)) = m;
255 DEFUN ("set-marker", Fset_marker, 2, 3, 0, /*
256 Position MARKER before character number NUMBER in BUFFER.
257 BUFFER defaults to the current buffer.
258 If NUMBER is nil, makes marker point nowhere.
259 Then it no longer slows down editing in any buffer.
260 If this marker was returned by (point-marker t), then changing its position
261 moves point. You cannot change its buffer or make it point nowhere.
264 (marker, number, buffer))
266 return set_marker_internal (marker, number, buffer, 0);
270 /* This version of Fset_marker won't let the position
271 be outside the visible part. */
273 set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
275 return set_marker_internal (marker, pos, buffer, 1);
279 /* This is called during garbage collection,
280 so we must be careful to ignore and preserve mark bits,
281 including those in chain fields of markers. */
284 unchain_marker (Lisp_Object m)
286 struct Lisp_Marker *marker = XMARKER (m);
287 struct buffer *b = marker->buffer;
292 #ifdef ERROR_CHECK_GC
293 assert (BUFFER_LIVE_P (b));
296 if (marker_next (marker))
297 marker_prev (marker_next (marker)) = marker_prev (marker);
298 if (marker_prev (marker))
299 marker_next (marker_prev (marker)) = marker_next (marker);
301 BUF_MARKERS (b) = marker_next (marker);
303 #ifdef ERROR_CHECK_GC
304 assert (marker != XMARKER (b->point_marker));
311 bi_marker_position (Lisp_Object marker)
313 struct Lisp_Marker *m = XMARKER (marker);
314 struct buffer *buf = m->buffer;
318 error ("Marker does not point anywhere");
320 /* FSF claims that marker indices could end up denormalized, i.e.
321 in the gap. This is way bogus if it ever happens, and means
322 something fucked up elsewhere. Since I've overhauled all this
323 shit, I don't think this can happen. In any case, the following
324 macro has an assert() in it that will catch these denormalized
326 pos = memind_to_bytind (buf, m->memind);
328 #ifdef ERROR_CHECK_BUFPOS
329 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
337 marker_position (Lisp_Object marker)
339 struct buffer *buf = XMARKER (marker)->buffer;
342 error ("Marker does not point anywhere");
344 return bytind_to_bufpos (buf, bi_marker_position (marker));
348 set_bi_marker_position (Lisp_Object marker, Bytind pos)
350 struct Lisp_Marker *m = XMARKER (marker);
351 struct buffer *buf = m->buffer;
354 error ("Marker does not point anywhere");
356 #ifdef ERROR_CHECK_BUFPOS
357 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
361 m->memind = bytind_to_memind (buf, pos);
365 set_marker_position (Lisp_Object marker, Bufpos pos)
367 struct buffer *buf = XMARKER (marker)->buffer;
370 error ("Marker does not point anywhere");
372 set_bi_marker_position (marker, bufpos_to_bytind (buf, pos));
376 copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum)
378 REGISTER Lisp_Object new;
382 if (INTP (marker) || MARKERP (marker))
385 new = noseeum_make_marker ();
387 new = Fmake_marker ();
388 Fset_marker (new, marker,
389 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
390 XMARKER (new)->insertion_type = !NILP (type);
394 marker = wrong_type_argument (Qinteger_or_marker_p, marker);
397 RETURN_NOT_REACHED (Qnil) /* not reached */
400 DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /*
401 Return a new marker pointing at the same place as MARKER.
402 If argument is a number, makes a new marker pointing
403 at that position in the current buffer.
404 The optional argument TYPE specifies the insertion type of the new marker;
405 see `marker-insertion-type'.
409 return copy_marker_1 (marker, type, 0);
413 noseeum_copy_marker (Lisp_Object marker, Lisp_Object type)
415 return copy_marker_1 (marker, type, 1);
418 DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /*
419 Return insertion type of MARKER: t if it stays after inserted text.
420 nil means the marker stays before text inserted there.
424 CHECK_MARKER (marker);
425 return XMARKER (marker)->insertion_type ? Qt : Qnil;
428 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /*
429 Set the insertion-type of MARKER to TYPE.
430 If TYPE is t, it means the marker advances when you insert text at it.
431 If TYPE is nil, it means the marker stays behind when you insert text at it.
435 CHECK_MARKER (marker);
437 XMARKER (marker)->insertion_type = ! NILP (type);
441 /* #### What is the possible use of this? It looks quite useless to
442 me, because there is no way to find *which* markers are positioned
443 at POSITION. Additional bogosity bonus: (buffer-has-markers-at
444 (point)) will always return t because of the `point-marker'. The
445 same goes for the position of mark. Bletch!
447 Someone should discuss this with Stallman, but I don't have the
448 stomach. In fact, this function sucks so badly that I'm disabling
449 it by default (although I've debugged it). If you want to use it,
450 use extents instead. --hniksic */
452 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
453 Return t if there are markers pointing at POSITION in the current buffer.
457 struct Lisp_Marker *marker;
460 /* A small optimization trick: convert POS to memind now, rather
461 than converting every marker's memory index to bufpos. */
462 pos = bytind_to_memind (current_buffer,
463 get_buffer_pos_byte (current_buffer, position,
466 for (marker = BUF_MARKERS (current_buffer);
468 marker = marker_next (marker))
470 /* We use marker->memind, so we don't have to go through the
471 unwieldy operation of creating a Lisp_Object for
472 marker_position() every time around. */
473 if (marker->memind == pos)
481 #ifdef MEMORY_USAGE_STATS
484 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats)
486 struct Lisp_Marker *m;
490 for (m = BUF_MARKERS (b); m; m = m->next)
491 total += sizeof (struct Lisp_Marker);
492 ovstats->was_requested += total;
493 overhead = fixed_type_block_overhead (total);
494 /* #### claiming this is all malloc overhead is not really right,
495 but it has to go somewhere. */
496 ovstats->malloc_overhead += overhead;
497 return total + overhead;
500 #endif /* MEMORY_USAGE_STATS */
504 syms_of_marker (void)
506 DEFSUBR (Fmarker_position);
507 DEFSUBR (Fmarker_buffer);
508 DEFSUBR (Fset_marker);
509 DEFSUBR (Fcopy_marker);
510 DEFSUBR (Fmarker_insertion_type);
511 DEFSUBR (Fset_marker_insertion_type);
512 #if 0 /* FSFmacs crock */
513 DEFSUBR (Fbuffer_has_markers_at);
518 init_buffer_markers (struct buffer *b)
523 b->mark = Fmake_marker ();
525 b->point_marker = Fmake_marker ();
526 Fset_marker (b->point_marker, make_int (1), buf);
530 uninit_buffer_markers (struct buffer *b)
532 /* Unchain all markers of this buffer
533 and leave them pointing nowhere. */
534 REGISTER struct Lisp_Marker *m, *next;
535 for (m = BUF_MARKERS (b); m; m = next)
538 next = marker_next (m);