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 obj1, Lisp_Object obj2, int depth)
80 struct Lisp_Marker *marker1 = XMARKER (obj1);
81 struct 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 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker,
99 mark_marker, print_marker, 0,
100 marker_equal, marker_hash,
103 /* Operations on markers. */
105 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
106 Return the buffer that MARKER points into, or nil if none.
107 Return nil if MARKER points into a dead buffer or doesn't point anywhere.
112 CHECK_MARKER (marker);
113 /* Return marker's buffer only if it is not dead. */
114 if ((buf = XMARKER (marker)->buffer) && BUFFER_LIVE_P (buf))
117 XSETBUFFER (buffer, buf);
123 DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /*
124 Return the position MARKER points at, as a character number.
125 Return `nil' if marker doesn't point anywhere.
129 CHECK_MARKER (marker);
130 return XMARKER (marker)->buffer ? make_int (marker_position (marker)) : Qnil;
133 #if 0 /* useful debugging function */
136 check_marker_circularities (struct buffer *buf)
138 struct Lisp_Marker *tortoise, *hare;
140 tortoise = BUF_MARKERS (buf);
148 assert (hare->buffer == buf);
152 assert (hare->buffer == buf);
156 tortoise = tortoise->next;
157 assert (tortoise != hare);
164 set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer,
169 struct Lisp_Marker *m;
172 CHECK_MARKER (marker);
174 point_p = POINT_MARKER_P (marker);
176 /* If position is nil or a marker that points nowhere,
177 make this marker point nowhere. */
179 (MARKERP (pos) && !XMARKER (pos)->buffer))
182 signal_simple_error ("Can't make point-marker point nowhere",
184 if (XMARKER (marker)->buffer)
185 unchain_marker (marker);
189 CHECK_INT_COERCE_MARKER (pos);
194 CHECK_BUFFER (buffer);
195 b = XBUFFER (buffer);
196 /* If buffer is dead, set marker to point nowhere. */
197 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
201 ("Can't move point-marker in a killed buffer", marker);
202 if (XMARKER (marker)->buffer)
203 unchain_marker (marker);
209 m = XMARKER (marker);
213 if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b);
214 if (charno > BUF_ZV (b)) charno = BUF_ZV (b);
218 if (charno < BUF_BEG (b)) charno = BUF_BEG (b);
219 if (charno > BUF_Z (b)) charno = BUF_Z (b);
224 #ifndef moving_point_by_moving_its_marker_is_a_bug
225 BUF_SET_PT (b, charno); /* this will move the marker */
226 #else /* It's not a feature, so it must be a bug */
227 signal_simple_error ("DEBUG: attempt to move point via point-marker",
233 m->memind = bufpos_to_memind (b, charno);
239 signal_simple_error ("Can't change buffer of point-marker", marker);
241 unchain_marker (marker);
243 marker_next (m) = BUF_MARKERS (b);
246 marker_prev (BUF_MARKERS (b)) = m;
254 DEFUN ("set-marker", Fset_marker, 2, 3, 0, /*
255 Position MARKER before character number NUMBER in BUFFER.
256 BUFFER defaults to the current buffer.
257 If NUMBER is nil, makes marker point nowhere.
258 Then it no longer slows down editing in any buffer.
259 If this marker was returned by (point-marker t), then changing its position
260 moves point. You cannot change its buffer or make it point nowhere.
263 (marker, number, buffer))
265 return set_marker_internal (marker, number, buffer, 0);
269 /* This version of Fset_marker won't let the position
270 be outside the visible part. */
272 set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
274 return set_marker_internal (marker, pos, buffer, 1);
278 /* This is called during garbage collection,
279 so we must be careful to ignore and preserve mark bits,
280 including those in chain fields of markers. */
283 unchain_marker (Lisp_Object m)
285 struct Lisp_Marker *marker = XMARKER (m);
286 struct buffer *b = marker->buffer;
291 #ifdef ERROR_CHECK_GC
292 assert (BUFFER_LIVE_P (b));
295 if (marker_next (marker))
296 marker_prev (marker_next (marker)) = marker_prev (marker);
297 if (marker_prev (marker))
298 marker_next (marker_prev (marker)) = marker_next (marker);
300 BUF_MARKERS (b) = marker_next (marker);
302 #ifdef ERROR_CHECK_GC
303 assert (marker != XMARKER (b->point_marker));
310 bi_marker_position (Lisp_Object marker)
312 struct Lisp_Marker *m = XMARKER (marker);
313 struct buffer *buf = m->buffer;
317 error ("Marker does not point anywhere");
319 /* FSF claims that marker indices could end up denormalized, i.e.
320 in the gap. This is way bogus if it ever happens, and means
321 something fucked up elsewhere. Since I've overhauled all this
322 shit, I don't think this can happen. In any case, the following
323 macro has an assert() in it that will catch these denormalized
325 pos = memind_to_bytind (buf, m->memind);
327 #ifdef ERROR_CHECK_BUFPOS
328 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
336 marker_position (Lisp_Object marker)
338 struct buffer *buf = XMARKER (marker)->buffer;
341 error ("Marker does not point anywhere");
343 return bytind_to_bufpos (buf, bi_marker_position (marker));
347 set_bi_marker_position (Lisp_Object marker, Bytind pos)
349 struct Lisp_Marker *m = XMARKER (marker);
350 struct buffer *buf = m->buffer;
353 error ("Marker does not point anywhere");
355 #ifdef ERROR_CHECK_BUFPOS
356 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
360 m->memind = bytind_to_memind (buf, pos);
364 set_marker_position (Lisp_Object marker, Bufpos pos)
366 struct buffer *buf = XMARKER (marker)->buffer;
369 error ("Marker does not point anywhere");
371 set_bi_marker_position (marker, bufpos_to_bytind (buf, pos));
375 copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum)
377 REGISTER Lisp_Object new;
381 if (INTP (marker) || MARKERP (marker))
384 new = noseeum_make_marker ();
386 new = Fmake_marker ();
387 Fset_marker (new, marker,
388 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
389 XMARKER (new)->insertion_type = !NILP (type);
393 marker = wrong_type_argument (Qinteger_or_marker_p, marker);
396 RETURN_NOT_REACHED (Qnil) /* not reached */
399 DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /*
400 Return a new marker pointing at the same place as MARKER.
401 If argument is a number, makes a new marker pointing
402 at that position in the current buffer.
403 The optional argument TYPE specifies the insertion type of the new marker;
404 see `marker-insertion-type'.
408 return copy_marker_1 (marker, type, 0);
412 noseeum_copy_marker (Lisp_Object marker, Lisp_Object type)
414 return copy_marker_1 (marker, type, 1);
417 DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /*
418 Return insertion type of MARKER: t if it stays after inserted text.
419 nil means the marker stays before text inserted there.
423 CHECK_MARKER (marker);
424 return XMARKER (marker)->insertion_type ? Qt : Qnil;
427 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /*
428 Set the insertion-type of MARKER to TYPE.
429 If TYPE is t, it means the marker advances when you insert text at it.
430 If TYPE is nil, it means the marker stays behind when you insert text at it.
434 CHECK_MARKER (marker);
436 XMARKER (marker)->insertion_type = ! NILP (type);
440 /* #### What is the possible use of this? It looks quite useless to
441 me, because there is no way to find *which* markers are positioned
442 at POSITION. Additional bogosity bonus: (buffer-has-markers-at
443 (point)) will always return t because of the `point-marker'. The
444 same goes for the position of mark. Bletch!
446 Someone should discuss this with Stallman, but I don't have the
447 stomach. In fact, this function sucks so badly that I'm disabling
448 it by default (although I've debugged it). If you want to use it,
449 use extents instead. --hniksic */
451 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
452 Return t if there are markers pointing at POSITION in the current buffer.
456 struct Lisp_Marker *marker;
459 /* A small optimization trick: convert POS to memind now, rather
460 than converting every marker's memory index to bufpos. */
461 pos = bytind_to_memind (current_buffer,
462 get_buffer_pos_byte (current_buffer, position,
465 for (marker = BUF_MARKERS (current_buffer);
467 marker = marker_next (marker))
469 /* We use marker->memind, so we don't have to go through the
470 unwieldy operation of creating a Lisp_Object for
471 marker_position() every time around. */
472 if (marker->memind == pos)
480 #ifdef MEMORY_USAGE_STATS
483 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats)
485 struct Lisp_Marker *m;
489 for (m = BUF_MARKERS (b); m; m = m->next)
490 total += sizeof (struct Lisp_Marker);
491 ovstats->was_requested += total;
492 overhead = fixed_type_block_overhead (total);
493 /* #### claiming this is all malloc overhead is not really right,
494 but it has to go somewhere. */
495 ovstats->malloc_overhead += overhead;
496 return total + overhead;
499 #endif /* MEMORY_USAGE_STATS */
503 syms_of_marker (void)
505 DEFSUBR (Fmarker_position);
506 DEFSUBR (Fmarker_buffer);
507 DEFSUBR (Fset_marker);
508 DEFSUBR (Fcopy_marker);
509 DEFSUBR (Fmarker_insertion_type);
510 DEFSUBR (Fset_marker_insertion_type);
511 #if 0 /* FSFmacs crock */
512 DEFSUBR (Fbuffer_has_markers_at);
517 init_buffer_markers (struct buffer *b)
522 b->mark = Fmake_marker ();
524 b->point_marker = Fmake_marker ();
525 Fset_marker (b->point_marker,
526 /* For indirect buffers, point is already set. */
527 b->base_buffer ? make_int (BUF_PT (b)) : make_int (1),
532 uninit_buffer_markers (struct buffer *b)
534 /* Unchain all markers of this buffer
535 and leave them pointing nowhere. */
536 REGISTER struct Lisp_Marker *m, *next;
537 for (m = BUF_MARKERS (b); m; m = next)
540 next = marker_next (m);