1 /* undo handling for SXEmacs.
2 Copyright (C) 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of SXEmacs
6 SXEmacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 SXEmacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* Synched up with: FSF 19.28. */
22 /* This file has been Mule-ized. */
29 /* Maintained in event-stream.c */
30 extern Bufpos last_point_position;
31 extern Lisp_Object last_point_position_buffer;
33 /* Extent code needs to know about undo because the behavior of insert()
34 with regard to extents varies depending on whether we are inside
38 /* Last buffer for which undo information was recorded. */
39 static Lisp_Object last_undo_buffer;
41 Lisp_Object Qinhibit_read_only;
43 /* The first time a command records something for undo.
44 it also allocates the undo-boundary object
45 which will be added to the list at the end of the command.
46 This ensures we can't run out of space while trying to make
48 static Lisp_Object pending_boundary;
50 static void undo_boundary(struct buffer *b)
52 Lisp_Object tem = Fcar(b->undo_list);
54 /* One way or another, cons nil onto the front of the undo list. */
55 if (CONSP(pending_boundary)) {
56 /* If we have preallocated the cons cell to use here,
58 XCDR(pending_boundary) = b->undo_list;
59 b->undo_list = pending_boundary;
60 pending_boundary = Qnil;
62 b->undo_list = Fcons(Qnil, b->undo_list);
66 static int undo_prelude(struct buffer *b, int hack_pending_boundary)
68 if (EQ(b->undo_list, Qt))
71 if (NILP(last_undo_buffer)
72 || (BUFFER_BASE_BUFFER(b)
73 != BUFFER_BASE_BUFFER(XBUFFER(last_undo_buffer)))) {
75 XSETBUFFER(last_undo_buffer, b);
78 /* Allocate a cons cell to be the undo boundary after this command. */
79 if (hack_pending_boundary && NILP(pending_boundary))
80 pending_boundary = Fcons(Qnil, Qnil);
82 if (BUF_MODIFF(b) <= BUF_SAVE_MODIFF(b)) {
83 /* Record that an unmodified buffer is about to be changed.
84 Record the file modification date so that when undoing this
85 entry we can tell whether it is obsolete because the file was
89 Fcons(make_int((b->modtime >> 16) & 0xffff),
90 make_int(b->modtime & 0xffff))),
96 static Lisp_Object restore_inside_undo(Lisp_Object val)
98 inside_undo = XINT(val);
102 /* Record an insertion that just happened or is about to happen,
103 for LENGTH characters at position BEG.
104 (It is possible to record an insertion before or after the fact
105 because we don't need to record the contents.) */
107 void record_insert(struct buffer *b, Bufpos beg, Charcount length)
109 if (!undo_prelude(b, 1))
112 /* If this is following another insertion and consecutive with it
113 in the buffer, combine the two. */
114 if (CONSP(b->undo_list)) {
116 elt = XCAR(b->undo_list);
120 && XINT(XCDR(elt)) == beg) {
121 XCDR(elt) = make_int(beg + length);
126 b->undo_list = Fcons(Fcons(make_int(beg),
127 make_int(beg + length)), b->undo_list);
130 /* Record that a deletion is about to take place,
131 for LENGTH characters at location BEG. */
133 void record_delete(struct buffer *b, Bufpos beg, Charcount length)
135 /* This function can GC */
139 if (!undo_prelude(b, 1))
142 at_boundary = (CONSP(b->undo_list)
143 && NILP(XCAR(b->undo_list)));
145 if (BUF_PT(b) == beg + length)
146 sbeg = make_int(-beg);
148 sbeg = make_int(beg);
150 /* If we are just after an undo boundary, and
151 point wasn't at start of deleted range, record where it was. */
152 if (at_boundary && BUFFERP(last_point_position_buffer)
153 && b == XBUFFER(last_point_position_buffer)
154 && last_point_position != XINT(sbeg))
156 Fcons(make_int(last_point_position), b->undo_list);
158 b->undo_list = Fcons(Fcons(make_string_from_buffer(b, beg,
160 sbeg), b->undo_list);
163 /* Record that a replacement is about to take place,
164 for LENGTH characters at location BEG.
165 The replacement does not change the number of characters. */
167 void record_change(struct buffer *b, Bufpos beg, Charcount length)
169 record_delete(b, beg, length);
170 record_insert(b, beg, length);
173 /* Record that an EXTENT is about to be attached or detached in its buffer.
174 This works much like a deletion or insertion, except that there's no string.
175 The tricky part is that the buffer we operate on comes from EXTENT.
176 Most extent changes happen as a side effect of string insertion and
177 deletion; this call is solely for Fdetach_extent() and Finsert_extent().
179 void record_extent(Lisp_Object extent, int attached)
181 Lisp_Object obj = Fextent_object(extent);
185 struct buffer *b = XBUFFER(obj);
186 if (!undo_prelude(b, 1))
191 token = list3(extent, Fextent_start_position(extent),
192 Fextent_end_position(extent));
193 b->undo_list = Fcons(token, b->undo_list);
199 /* Record a change in property PROP (whose old value was VAL)
200 for LENGTH characters starting at position BEG in BUFFER. */
202 record_property_change(Bufpos beg, Charcount length,
203 Lisp_Object prop, Lisp_Object value, Lisp_Object buffer)
205 Lisp_Object lbeg, lend, entry;
206 struct buffer *b = XBUFFER(buffer);
208 if (!undo_prelude(b, 1))
211 lbeg = make_int(beg);
212 lend = make_int(beg + length);
213 entry = Fcons(Qnil, Fcons(prop, Fcons(value, Fcons(lbeg, lend))));
214 b->undo_list = Fcons(entry, b->undo_list);
218 DEFUN("undo-boundary", Fundo_boundary, 0, 0, 0, /*
219 Mark a boundary between units of undo.
220 An undo command will stop at this point,
221 but another undo command will undo to the previous boundary.
225 if (EQ(current_buffer->undo_list, Qt))
227 undo_boundary(current_buffer);
231 /* At garbage collection time, make an undo list shorter at the end,
232 returning the truncated list.
233 MINSIZE and MAXSIZE are the limits on size allowed, as described below.
234 In practice, these are the values of undo-threshold and
235 undo-high-threshold. */
237 Lisp_Object truncate_undo_list(Lisp_Object list, int minsize, int maxsize)
239 Lisp_Object prev, next, last_boundary;
242 if (!(minsize > 0 || maxsize > 0))
247 last_boundary = Qnil;
252 /* Always preserve at least the most recent undo record.
253 If the first element is an undo boundary, skip past it. */
255 && NILP(XCAR(next))) {
256 /* Add in the space occupied by this element and its chain link. */
257 size_so_far += sizeof(Lisp_Cons);
259 /* Advance to next element. */
264 && !NILP(XCAR(next))) {
268 /* Add in the space occupied by this element and its chain link. */
269 size_so_far += sizeof(Lisp_Cons);
271 size_so_far += sizeof(Lisp_Cons);
272 if (STRINGP(XCAR(elt)))
273 size_so_far += (sizeof(Lisp_String) - 1
274 + XSTRING_LENGTH(XCAR(elt)));
277 /* Advance to next element. */
282 last_boundary = prev;
284 while (CONSP(next)) {
288 /* When we get to a boundary, decide whether to truncate
289 either before or after it. The lower threshold, MINSIZE,
290 tells us to truncate after it. If its size pushes past
291 the higher threshold MAXSIZE as well, we truncate before it. */
293 if (size_so_far > maxsize && maxsize > 0)
295 last_boundary = prev;
296 if (size_so_far > minsize && minsize > 0)
300 /* Add in the space occupied by this element and its chain link. */
301 size_so_far += sizeof(Lisp_Cons);
303 size_so_far += sizeof(Lisp_Cons);
304 if (STRINGP(XCAR(elt)))
305 size_so_far += (sizeof(Lisp_String) - 1
306 + XSTRING_LENGTH(XCAR(elt)));
309 /* Advance to next element. */
314 /* If we scanned the whole list, it is short enough; don't change it. */
318 /* Truncate at the boundary where we decided to truncate. */
319 if (!NILP(last_boundary)) {
320 XCDR(last_boundary) = Qnil;
326 DEFUN("primitive-undo", Fprimitive_undo, 2, 2, 0, /*
327 Undo COUNT records from the front of the list LIST.
328 Return what remains of the list.
332 struct gcpro gcpro1, gcpro2;
333 Lisp_Object next = Qnil;
334 /* This function can GC */
336 int speccount = specpdl_depth();
338 record_unwind_protect(restore_inside_undo, make_int(inside_undo));
341 #if 0 /* This is a good feature, but would make undo-start
342 unable to do what is expected. */
345 /* If the head of the list is a boundary, it is the boundary
346 preceding this command. Get rid of it and don't count it. */
357 /* Don't let read-only properties interfere with undo. */
358 if (NILP(current_buffer->read_only))
359 specbind(Qinhibit_read_only, Qt);
365 else if (!CONSP(list))
369 /* Exit inner loop at undo boundary. */
372 /* Handle an integer by setting point to that value. */
374 BUF_SET_PT(current_buffer,
375 bufpos_clip_to_bounds(BUF_BEGV
380 else if (CONSP(next)) {
381 Lisp_Object car = XCAR(next);
382 Lisp_Object cdr = XCDR(next);
385 /* Element (t high . low) records previous modtime. */
386 Lisp_Object high, low;
392 if (!INTP(high) || !INTP(low))
395 (XINT(high) << 16) + XINT(low);
396 /* If this records an obsolete save
397 (not matching the actual disk file)
398 then don't mark unmodified. */
399 if (mod_time != current_buffer->modtime)
401 #ifdef CLASH_DETECTION
403 #endif /* CLASH_DETECTION */
404 /* may GC under ENERGIZE: */
405 Fset_buffer_modified_p(Qnil, Qnil);
406 } else if (EXTENTP(car)) {
407 /* Element (extent start end) means that EXTENT was
408 detached, and we need to reattach it. */
409 Lisp_Object extent_obj, start, end;
413 end = Fcar(Fcdr(cdr));
415 if (!INTP(start) || !INTP(end))
417 Fset_extent_endpoints(extent_obj, start,
423 else if (EQ(car, Qnil)) {
424 /* Element (nil prop val beg . end) is property change. */
425 Lisp_Object beg, end, prop, val;
434 Fput_text_property(beg, end, prop, val,
438 else if (INTP(car) && INTP(cdr)) {
439 /* Element (BEG . END) means range was inserted. */
441 if (XINT(car) < BUF_BEGV(current_buffer)
443 BUF_ZV(current_buffer))
445 ("Changes to be undone are outside visible portion of buffer");
446 /* Set point first thing, so that undoing this undo
447 does not send point back to where it is now. */
448 Fgoto_char(car, Qnil);
449 Fdelete_region(car, cdr, Qnil);
450 } else if (STRINGP(car) && INTP(cdr)) {
451 /* Element (STRING . POS) means STRING was deleted. */
452 Lisp_Object membuf = car;
457 BUF_BEGV(current_buffer)
459 BUF_ZV(current_buffer))
461 ("Changes to be undone are outside visible portion of buffer");
462 BUF_SET_PT(current_buffer,
467 BUF_BEGV(current_buffer)
469 BUF_ZV(current_buffer))
471 ("Changes to be undone are outside visible portion of buffer");
472 BUF_SET_PT(current_buffer, pos);
474 /* Insert before markers so that if the mark is
475 currently on the boundary of this deletion, it
476 ends up on the other side of the now-undeleted
477 text from point. Since undo doesn't even keep
478 track of the mark, this isn't really necessary,
479 but it may lead to better behavior in certain
482 I'm doubtful that this is safe; you could mess
483 up the process-output mark in shell buffers, so
484 until I hear a compelling reason for this change,
485 I'm leaving it out. -jwz
487 /* Finsert_before_markers (1, &membuf); */
489 BUF_SET_PT(current_buffer, pos);
494 } else if (EXTENTP(next))
495 Fdetach_extent(next);
498 signal_simple_continuable_error
499 ("Something rotten in the state of undo",
507 return unbind_to(speccount, list);
510 void syms_of_undo(void)
512 DEFSUBR(Fprimitive_undo);
513 DEFSUBR(Fundo_boundary);
514 defsymbol(&Qinhibit_read_only, "inhibit-read-only");
517 void reinit_vars_of_undo(void)
522 void vars_of_undo(void)
524 reinit_vars_of_undo();
526 pending_boundary = Qnil;
527 staticpro(&pending_boundary);
528 last_undo_buffer = Qnil;
529 staticpro(&last_undo_buffer);