1 /* undo handling for XEmacs.
2 Copyright (C) 1990, 1992, 1993, 1994 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.28. */
23 /* This file has been Mule-ized. */
30 /* Maintained in event-stream.c */
31 extern Bufpos last_point_position;
32 extern Lisp_Object last_point_position_buffer;
34 /* Extent code needs to know about undo because the behavior of insert()
35 with regard to extents varies depending on whether we are inside
39 /* Last buffer for which undo information was recorded. */
40 static Lisp_Object last_undo_buffer;
42 Lisp_Object Qinhibit_read_only;
44 /* The first time a command records something for undo.
45 it also allocates the undo-boundary object
46 which will be added to the list at the end of the command.
47 This ensures we can't run out of space while trying to make
49 Lisp_Object pending_boundary;
52 undo_boundary (struct buffer *b)
54 Lisp_Object tem = Fcar (b->undo_list);
57 /* One way or another, cons nil onto the front of the undo list. */
58 if (CONSP (pending_boundary))
60 /* If we have preallocated the cons cell to use here,
62 XCDR (pending_boundary) = b->undo_list;
63 b->undo_list = pending_boundary;
64 pending_boundary = Qnil;
67 b->undo_list = Fcons (Qnil, b->undo_list);
73 undo_prelude (struct buffer *b, int hack_pending_boundary)
75 if (EQ (b->undo_list, Qt))
78 if (NILP (last_undo_buffer) || b != XBUFFER (last_undo_buffer))
81 XSETBUFFER (last_undo_buffer, b);
84 /* Allocate a cons cell to be the undo boundary after this command. */
85 if (hack_pending_boundary && NILP (pending_boundary))
86 pending_boundary = Fcons (Qnil, Qnil);
88 if (BUF_MODIFF (b) <= BUF_SAVE_MODIFF (b))
90 /* Record that an unmodified buffer is about to be changed.
91 Record the file modification date so that when undoing this
92 entry we can tell whether it is obsolete because the file was
96 Fcons (make_int ((b->modtime >> 16) & 0xffff),
97 make_int (b->modtime & 0xffff))),
106 restore_inside_undo (Lisp_Object val)
108 inside_undo = XINT (val);
113 /* Record an insertion that just happened or is about to happen,
114 for LENGTH characters at position BEG.
115 (It is possible to record an insertion before or after the fact
116 because we don't need to record the contents.) */
119 record_insert (struct buffer *b, Bufpos beg, Charcount length)
121 if (!undo_prelude (b, 1))
124 /* If this is following another insertion and consecutive with it
125 in the buffer, combine the two. */
126 if (CONSP (b->undo_list))
129 elt = XCAR (b->undo_list);
133 && XINT (XCDR (elt)) == beg)
135 XCDR (elt) = make_int (beg + length);
140 b->undo_list = Fcons (Fcons (make_int (beg),
141 make_int (beg + length)),
145 /* Record that a deletion is about to take place,
146 for LENGTH characters at location BEG. */
149 record_delete (struct buffer *b, Bufpos beg, Charcount length)
151 /* This function can GC */
155 if (!undo_prelude (b, 1))
158 at_boundary = (CONSP (b->undo_list)
159 && NILP (XCAR (b->undo_list)));
161 if (BUF_PT (b) == beg + length)
162 sbeg = make_int (-beg);
164 sbeg = make_int (beg);
166 /* If we are just after an undo boundary, and
167 point wasn't at start of deleted range, record where it was. */
169 && BUFFERP (last_point_position_buffer)
170 && b == XBUFFER (last_point_position_buffer)
171 && last_point_position != XINT (sbeg))
172 b->undo_list = Fcons (make_int (last_point_position), b->undo_list);
174 b->undo_list = Fcons (Fcons (make_string_from_buffer (b, beg,
180 /* Record that a replacement is about to take place,
181 for LENGTH characters at location BEG.
182 The replacement does not change the number of characters. */
185 record_change (struct buffer *b, Bufpos beg, Charcount length)
187 record_delete (b, beg, length);
188 record_insert (b, beg, length);
191 /* Record that an EXTENT is about to be attached or detached in its buffer.
192 This works much like a deletion or insertion, except that there's no string.
193 The tricky part is that the buffer we operate on comes from EXTENT.
194 Most extent changes happen as a side effect of string insertion and
195 deletion; this call is solely for Fdetach_extent() and Finsert_extent().
198 record_extent (Lisp_Object extent, int attached)
200 Lisp_Object obj = Fextent_object (extent);
205 struct buffer *b = XBUFFER (obj);
206 if (!undo_prelude (b, 1))
211 token = list3 (extent, Fextent_start_position (extent),
212 Fextent_end_position (extent));
213 b->undo_list = Fcons (token, b->undo_list);
220 /* Record a change in property PROP (whose old value was VAL)
221 for LENGTH characters starting at position BEG in BUFFER. */
223 record_property_change (Bufpos beg, Charcount length,
224 Lisp_Object prop, Lisp_Object value,
227 Lisp_Object lbeg, lend, entry;
228 struct buffer *b = XBUFFER (buffer);
230 if (!undo_prelude (b, 1))
233 lbeg = make_int (beg);
234 lend = make_int (beg + length);
235 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
236 b->undo_list = Fcons (entry, b->undo_list);
241 DEFUN ("undo-boundary", Fundo_boundary, 0, 0, 0, /*
242 Mark a boundary between units of undo.
243 An undo command will stop at this point,
244 but another undo command will undo to the previous boundary.
248 if (EQ (current_buffer->undo_list, Qt))
250 undo_boundary (current_buffer);
254 /* At garbage collection time, make an undo list shorter at the end,
255 returning the truncated list.
256 MINSIZE and MAXSIZE are the limits on size allowed, as described below.
257 In practice, these are the values of undo-threshold and
258 undo-high-threshold. */
261 truncate_undo_list (Lisp_Object list, int minsize, int maxsize)
263 Lisp_Object prev, next, last_boundary;
266 if (!(minsize > 0 || maxsize > 0))
271 last_boundary = Qnil;
276 /* Always preserve at least the most recent undo record.
277 If the first element is an undo boundary, skip past it. */
279 && NILP (XCAR (next)))
281 /* Add in the space occupied by this element and its chain link. */
282 size_so_far += sizeof (struct Lisp_Cons);
284 /* Advance to next element. */
289 && !NILP (XCAR (next)))
294 /* Add in the space occupied by this element and its chain link. */
295 size_so_far += sizeof (struct Lisp_Cons);
298 size_so_far += sizeof (struct Lisp_Cons);
299 if (STRINGP (XCAR (elt)))
300 size_so_far += (sizeof (struct Lisp_String) - 1
301 + XSTRING_LENGTH (XCAR (elt)));
304 /* Advance to next element. */
309 last_boundary = prev;
316 /* When we get to a boundary, decide whether to truncate
317 either before or after it. The lower threshold, MINSIZE,
318 tells us to truncate after it. If its size pushes past
319 the higher threshold MAXSIZE as well, we truncate before it. */
322 if (size_so_far > maxsize && maxsize > 0)
324 last_boundary = prev;
325 if (size_so_far > minsize && minsize > 0)
329 /* Add in the space occupied by this element and its chain link. */
330 size_so_far += sizeof (struct Lisp_Cons);
333 size_so_far += sizeof (struct Lisp_Cons);
334 if (STRINGP (XCAR (elt)))
335 size_so_far += (sizeof (struct Lisp_String) - 1
336 + XSTRING_LENGTH (XCAR (elt)));
339 /* Advance to next element. */
344 /* If we scanned the whole list, it is short enough; don't change it. */
348 /* Truncate at the boundary where we decided to truncate. */
349 if (!NILP (last_boundary))
351 XCDR (last_boundary) = Qnil;
358 DEFUN ("primitive-undo", Fprimitive_undo, 2, 2, 0, /*
359 Undo COUNT records from the front of the list LIST.
360 Return what remains of the list.
364 struct gcpro gcpro1, gcpro2;
365 Lisp_Object next = Qnil;
366 /* This function can GC */
368 int speccount = specpdl_depth ();
370 record_unwind_protect (restore_inside_undo, make_int (inside_undo));
373 #if 0 /* This is a good feature, but would make undo-start
374 unable to do what is expected. */
377 /* If the head of the list is a boundary, it is the boundary
378 preceding this command. Get rid of it and don't count it. */
389 /* Don't let read-only properties interfere with undo. */
390 if (NILP (current_buffer->read_only))
391 specbind (Qinhibit_read_only, Qt);
399 else if (!CONSP (list))
403 /* Exit inner loop at undo boundary. */
406 /* Handle an integer by setting point to that value. */
407 else if (INTP (next))
408 BUF_SET_PT (current_buffer,
409 bufpos_clip_to_bounds (BUF_BEGV (current_buffer),
411 BUF_ZV (current_buffer)));
412 else if (CONSP (next))
414 Lisp_Object car = XCAR (next);
415 Lisp_Object cdr = XCDR (next);
419 /* Element (t high . low) records previous modtime. */
420 Lisp_Object high, low;
422 if (!CONSP (cdr)) goto rotten;
425 if (!INTP (high) || !INTP (low)) goto rotten;
426 mod_time = (XINT (high) << 16) + XINT (low);
427 /* If this records an obsolete save
428 (not matching the actual disk file)
429 then don't mark unmodified. */
430 if (mod_time != current_buffer->modtime)
432 #ifdef CLASH_DETECTION
434 #endif /* CLASH_DETECTION */
435 /* may GC under ENERGIZE: */
436 Fset_buffer_modified_p (Qnil, Qnil);
438 else if (EXTENTP (car))
440 /* Element (extent start end) means that EXTENT was
441 detached, and we need to reattach it. */
442 Lisp_Object extent_obj, start, end;
446 end = Fcar (Fcdr (cdr));
448 if (!INTP (start) || !INTP (end))
450 Fset_extent_endpoints (extent_obj, start, end,
454 else if (EQ (car, Qnil))
456 /* Element (nil prop val beg . end) is property change. */
457 Lisp_Object beg, end, prop, val;
466 Fput_text_property (beg, end, prop, val, Qnil);
469 else if (INTP (car) && INTP (cdr))
471 /* Element (BEG . END) means range was inserted. */
473 if (XINT (car) < BUF_BEGV (current_buffer)
474 || XINT (cdr) > BUF_ZV (current_buffer))
475 error ("Changes to be undone are outside visible portion of buffer");
476 /* Set point first thing, so that undoing this undo
477 does not send point back to where it is now. */
478 Fgoto_char (car, Qnil);
479 Fdelete_region (car, cdr, Qnil);
481 else if (STRINGP (car) && INTP (cdr))
483 /* Element (STRING . POS) means STRING was deleted. */
484 Lisp_Object membuf = car;
485 int pos = XINT (cdr);
489 if (-pos < BUF_BEGV (current_buffer) || -pos > BUF_ZV (current_buffer))
490 error ("Changes to be undone are outside visible portion of buffer");
491 BUF_SET_PT (current_buffer, -pos);
492 Finsert (1, &membuf);
496 if (pos < BUF_BEGV (current_buffer) || pos > BUF_ZV (current_buffer))
497 error ("Changes to be undone are outside visible portion of buffer");
498 BUF_SET_PT (current_buffer, pos);
500 /* Insert before markers so that if the mark is
501 currently on the boundary of this deletion, it
502 ends up on the other side of the now-undeleted
503 text from point. Since undo doesn't even keep
504 track of the mark, this isn't really necessary,
505 but it may lead to better behavior in certain
508 I'm doubtful that this is safe; you could mess
509 up the process-output mark in shell buffers, so
510 until I hear a compelling reason for this change,
511 I'm leaving it out. -jwz
513 /* Finsert_before_markers (1, &membuf); */
514 Finsert (1, &membuf);
515 BUF_SET_PT (current_buffer, pos);
523 else if (EXTENTP (next))
524 Fdetach_extent (next);
528 signal_simple_continuable_error
529 ("Something rotten in the state of undo", next);
536 return unbind_to (speccount, list);
542 DEFSUBR (Fprimitive_undo);
543 DEFSUBR (Fundo_boundary);
544 defsymbol (&Qinhibit_read_only, "inhibit-read-only");
551 pending_boundary = Qnil;
552 staticpro (&pending_boundary);
553 last_undo_buffer = Qnil;
554 staticpro (&last_undo_buffer);