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 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 %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 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 static const struct lrecord_description marker_description[] = {
99 { XD_LISP_OBJECT, offsetof(struct Lisp_Marker, next), 3 },
103 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("marker", marker,
104 mark_marker, print_marker, 0,
105 marker_equal, marker_hash, marker_description,
108 /* Operations on markers. */
110 DEFUN ("marker-buffer", Fmarker_buffer, 1, 1, 0, /*
111 Return the buffer that MARKER points into, or nil if none.
112 Return nil if MARKER points into a dead buffer or doesn't point anywhere.
117 CHECK_MARKER (marker);
118 /* Return marker's buffer only if it is not dead. */
119 if ((buf = XMARKER (marker)->buffer) && BUFFER_LIVE_P (buf))
122 XSETBUFFER (buffer, buf);
128 DEFUN ("marker-position", Fmarker_position, 1, 1, 0, /*
129 Return the position MARKER points at, as a character number.
130 Return `nil' if marker doesn't point anywhere.
134 CHECK_MARKER (marker);
135 return XMARKER (marker)->buffer ? make_int (marker_position (marker)) : Qnil;
138 #if 0 /* useful debugging function */
141 check_marker_circularities (struct buffer *buf)
143 struct Lisp_Marker *tortoise, *hare;
145 tortoise = BUF_MARKERS (buf);
153 assert (hare->buffer == buf);
157 assert (hare->buffer == buf);
161 tortoise = tortoise->next;
162 assert (tortoise != hare);
169 set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer,
174 struct Lisp_Marker *m;
177 CHECK_MARKER (marker);
179 point_p = POINT_MARKER_P (marker);
181 /* If position is nil or a marker that points nowhere,
182 make this marker point nowhere. */
184 (MARKERP (pos) && !XMARKER (pos)->buffer))
187 signal_simple_error ("Can't make point-marker point nowhere",
189 if (XMARKER (marker)->buffer)
190 unchain_marker (marker);
194 CHECK_INT_COERCE_MARKER (pos);
199 CHECK_BUFFER (buffer);
200 b = XBUFFER (buffer);
201 /* If buffer is dead, set marker to point nowhere. */
202 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
206 ("Can't move point-marker in a killed buffer", marker);
207 if (XMARKER (marker)->buffer)
208 unchain_marker (marker);
214 m = XMARKER (marker);
218 if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b);
219 if (charno > BUF_ZV (b)) charno = BUF_ZV (b);
223 if (charno < BUF_BEG (b)) charno = BUF_BEG (b);
224 if (charno > BUF_Z (b)) charno = BUF_Z (b);
229 #ifndef moving_point_by_moving_its_marker_is_a_bug
230 BUF_SET_PT (b, charno); /* this will move the marker */
231 #else /* It's not a feature, so it must be a bug */
232 signal_simple_error ("DEBUG: attempt to move point via point-marker",
238 m->memind = bufpos_to_memind (b, charno);
244 signal_simple_error ("Can't change buffer of point-marker", marker);
246 unchain_marker (marker);
248 marker_next (m) = BUF_MARKERS (b);
251 marker_prev (BUF_MARKERS (b)) = m;
259 DEFUN ("set-marker", Fset_marker, 2, 3, 0, /*
260 Position MARKER before character number NUMBER in BUFFER.
261 BUFFER defaults to the current buffer.
262 If NUMBER is nil, makes marker point nowhere.
263 Then it no longer slows down editing in any buffer.
264 If this marker was returned by (point-marker t), then changing its position
265 moves point. You cannot change its buffer or make it point nowhere.
268 (marker, number, buffer))
270 return set_marker_internal (marker, number, buffer, 0);
274 /* This version of Fset_marker won't let the position
275 be outside the visible part. */
277 set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
279 return set_marker_internal (marker, pos, buffer, 1);
283 /* This is called during garbage collection,
284 so we must be careful to ignore and preserve mark bits,
285 including those in chain fields of markers. */
288 unchain_marker (Lisp_Object m)
290 struct Lisp_Marker *marker = XMARKER (m);
291 struct buffer *b = marker->buffer;
296 #ifdef ERROR_CHECK_GC
297 assert (BUFFER_LIVE_P (b));
300 if (marker_next (marker))
301 marker_prev (marker_next (marker)) = marker_prev (marker);
302 if (marker_prev (marker))
303 marker_next (marker_prev (marker)) = marker_next (marker);
305 BUF_MARKERS (b) = marker_next (marker);
307 #ifdef ERROR_CHECK_GC
308 assert (marker != XMARKER (b->point_marker));
315 bi_marker_position (Lisp_Object marker)
317 struct Lisp_Marker *m = XMARKER (marker);
318 struct buffer *buf = m->buffer;
322 error ("Marker does not point anywhere");
324 /* FSF claims that marker indices could end up denormalized, i.e.
325 in the gap. This is way bogus if it ever happens, and means
326 something fucked up elsewhere. Since I've overhauled all this
327 shit, I don't think this can happen. In any case, the following
328 macro has an assert() in it that will catch these denormalized
330 pos = memind_to_bytind (buf, m->memind);
332 #ifdef ERROR_CHECK_BUFPOS
333 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
341 marker_position (Lisp_Object marker)
343 struct buffer *buf = XMARKER (marker)->buffer;
346 error ("Marker does not point anywhere");
348 return bytind_to_bufpos (buf, bi_marker_position (marker));
352 set_bi_marker_position (Lisp_Object marker, Bytind pos)
354 struct Lisp_Marker *m = XMARKER (marker);
355 struct buffer *buf = m->buffer;
358 error ("Marker does not point anywhere");
360 #ifdef ERROR_CHECK_BUFPOS
361 if (pos < BI_BUF_BEG (buf) || pos > BI_BUF_Z (buf))
365 m->memind = bytind_to_memind (buf, pos);
369 set_marker_position (Lisp_Object marker, Bufpos pos)
371 struct buffer *buf = XMARKER (marker)->buffer;
374 error ("Marker does not point anywhere");
376 set_bi_marker_position (marker, bufpos_to_bytind (buf, pos));
380 copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum)
382 REGISTER Lisp_Object new;
386 if (INTP (marker) || MARKERP (marker))
389 new = noseeum_make_marker ();
391 new = Fmake_marker ();
392 Fset_marker (new, marker,
393 (MARKERP (marker) ? Fmarker_buffer (marker) : Qnil));
394 XMARKER (new)->insertion_type = !NILP (type);
398 marker = wrong_type_argument (Qinteger_or_marker_p, marker);
401 RETURN_NOT_REACHED (Qnil) /* not reached */
404 DEFUN ("copy-marker", Fcopy_marker, 1, 2, 0, /*
405 Return a new marker pointing at the same place as MARKER.
406 If argument is a number, makes a new marker pointing
407 at that position in the current buffer.
408 The optional argument TYPE specifies the insertion type of the new marker;
409 see `marker-insertion-type'.
413 return copy_marker_1 (marker, type, 0);
417 noseeum_copy_marker (Lisp_Object marker, Lisp_Object type)
419 return copy_marker_1 (marker, type, 1);
422 DEFUN ("marker-insertion-type", Fmarker_insertion_type, 1, 1, 0, /*
423 Return insertion type of MARKER: t if it stays after inserted text.
424 nil means the marker stays before text inserted there.
428 CHECK_MARKER (marker);
429 return XMARKER (marker)->insertion_type ? Qt : Qnil;
432 DEFUN ("set-marker-insertion-type", Fset_marker_insertion_type, 2, 2, 0, /*
433 Set the insertion-type of MARKER to TYPE.
434 If TYPE is t, it means the marker advances when you insert text at it.
435 If TYPE is nil, it means the marker stays behind when you insert text at it.
439 CHECK_MARKER (marker);
441 XMARKER (marker)->insertion_type = ! NILP (type);
445 /* #### What is the possible use of this? It looks quite useless to
446 me, because there is no way to find *which* markers are positioned
447 at POSITION. Additional bogosity bonus: (buffer-has-markers-at
448 (point)) will always return t because of the `point-marker'. The
449 same goes for the position of mark. Bletch!
451 Someone should discuss this with Stallman, but I don't have the
452 stomach. In fact, this function sucks so badly that I'm disabling
453 it by default (although I've debugged it). If you want to use it,
454 use extents instead. --hniksic */
456 xxDEFUN ("buffer-has-markers-at", Fbuffer_has_markers_at, 1, 1, 0, /*
457 Return t if there are markers pointing at POSITION in the current buffer.
461 struct Lisp_Marker *marker;
464 /* A small optimization trick: convert POS to memind now, rather
465 than converting every marker's memory index to bufpos. */
466 pos = bytind_to_memind (current_buffer,
467 get_buffer_pos_byte (current_buffer, position,
470 for (marker = BUF_MARKERS (current_buffer);
472 marker = marker_next (marker))
474 /* We use marker->memind, so we don't have to go through the
475 unwieldy operation of creating a Lisp_Object for
476 marker_position() every time around. */
477 if (marker->memind == pos)
485 #ifdef MEMORY_USAGE_STATS
488 compute_buffer_marker_usage (struct buffer *b, struct overhead_stats *ovstats)
490 struct Lisp_Marker *m;
494 for (m = BUF_MARKERS (b); m; m = m->next)
495 total += sizeof (struct Lisp_Marker);
496 ovstats->was_requested += total;
497 overhead = fixed_type_block_overhead (total);
498 /* #### claiming this is all malloc overhead is not really right,
499 but it has to go somewhere. */
500 ovstats->malloc_overhead += overhead;
501 return total + overhead;
504 #endif /* MEMORY_USAGE_STATS */
508 syms_of_marker (void)
510 DEFSUBR (Fmarker_position);
511 DEFSUBR (Fmarker_buffer);
512 DEFSUBR (Fset_marker);
513 DEFSUBR (Fcopy_marker);
514 DEFSUBR (Fmarker_insertion_type);
515 DEFSUBR (Fset_marker_insertion_type);
516 #if 0 /* FSFmacs crock */
517 DEFSUBR (Fbuffer_has_markers_at);
522 init_buffer_markers (struct buffer *b)
527 b->mark = Fmake_marker ();
529 b->point_marker = Fmake_marker ();
530 Fset_marker (b->point_marker,
531 /* For indirect buffers, point is already set. */
532 b->base_buffer ? make_int (BUF_PT (b)) : make_int (1),
537 uninit_buffer_markers (struct buffer *b)
539 /* Unchain all markers of this buffer
540 and leave them pointing nowhere. */
541 REGISTER struct Lisp_Marker *m, *next;
542 for (m = BUF_MARKERS (b); m; m = next)
545 next = marker_next (m);