*** empty log message ***
[emacs.git] / src / undo.c
blob06abcbadd3e83cbb7330e7484b0a069ca3f5d1ca
1 /* undo handling for GNU Emacs.
2 Copyright (C) 1990 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is distributed in the hope that it will be useful,
7 but WITHOUT ANY WARRANTY. No author or distributor
8 accepts responsibility to anyone for the consequences of using it
9 or for whether it serves any particular purpose or works at all,
10 unless he says so in writing. Refer to the GNU Emacs General Public
11 License for full details.
13 Everyone is granted permission to copy, modify and redistribute
14 GNU Emacs, but only under the conditions described in the
15 GNU Emacs General Public License. A copy of this license is
16 supposed to have been given to you along with GNU Emacs so you
17 can know your rights and responsibilities. It should be in a
18 file named COPYING. Among other things, the copyright notice
19 and this notice must be preserved on all copies. */
22 #include "config.h"
23 #include "lisp.h"
24 #include "buffer.h"
26 /* Last buffer for which undo information was recorded. */
27 Lisp_Object last_undo_buffer;
29 /* Record an insertion that just happened or is about to happen,
30 for LENGTH characters at position BEG.
31 (It is possible to record an insertion before or after the fact
32 because we don't need to record the contents.) */
34 record_insert (beg, length)
35 Lisp_Object beg, length;
37 Lisp_Object lbeg, lend;
39 if (current_buffer != XBUFFER (last_undo_buffer))
40 Fundo_boundary ();
41 XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
43 if (EQ (current_buffer->undo_list, Qt))
44 return;
45 if (MODIFF <= current_buffer->save_modified)
46 record_first_change ();
48 /* If this is following another insertion and consecutive with it
49 in the buffer, combine the two. */
50 if (XTYPE (current_buffer->undo_list) == Lisp_Cons)
52 Lisp_Object elt;
53 elt = XCONS (current_buffer->undo_list)->car;
54 if (XTYPE (elt) == Lisp_Cons
55 && XTYPE (XCONS (elt)->car) == Lisp_Int
56 && XTYPE (XCONS (elt)->cdr) == Lisp_Int
57 && XINT (XCONS (elt)->cdr) == beg)
59 XSETINT (XCONS (elt)->cdr, beg + length);
60 return;
64 XFASTINT (lbeg) = beg;
65 XFASTINT (lend) = beg + length;
66 current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list);
69 /* Record that a deletion is about to take place,
70 for LENGTH characters at location BEG. */
72 record_delete (beg, length)
73 int beg, length;
75 Lisp_Object lbeg, lend, sbeg;
77 if (current_buffer != XBUFFER (last_undo_buffer))
78 Fundo_boundary ();
79 XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
81 if (EQ (current_buffer->undo_list, Qt))
82 return;
83 if (MODIFF <= current_buffer->save_modified)
84 record_first_change ();
86 if (point == beg + length)
87 XSET (sbeg, Lisp_Int, -beg);
88 else
89 XFASTINT (sbeg) = beg;
90 XFASTINT (lbeg) = beg;
91 XFASTINT (lend) = beg + length;
92 current_buffer->undo_list
93 = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
94 current_buffer->undo_list);
97 /* Record that a replacement is about to take place,
98 for LENGTH characters at location BEG.
99 The replacement does not change the number of characters. */
101 record_change (beg, length)
102 int beg, length;
104 record_delete (beg, length);
105 record_insert (beg, length);
108 /* Record that an unmodified buffer is about to be changed.
109 Record the file modification date so that when undoing this entry
110 we can tell whether it is obsolete because the file was saved again. */
112 record_first_change ()
114 Lisp_Object high, low;
115 XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff;
116 XFASTINT (low) = current_buffer->modtime & 0xffff;
117 current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
120 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
121 "Mark a boundary between units of undo.\n\
122 An undo command will stop at this point,\n\
123 but another undo command will undo to the previous boundary.")
126 Lisp_Object tem;
127 if (EQ (current_buffer->undo_list, Qt))
128 return Qnil;
129 tem = Fcar (current_buffer->undo_list);
130 if (!NILP (tem))
131 current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
132 return Qnil;
135 /* At garbage collection time, make an undo list shorter at the end,
136 returning the truncated list.
137 MINSIZE and MAXSIZE are the limits on size allowed, as described below.
138 In practice, these are the values of undo-threshold and
139 undo-high-threshold. */
141 Lisp_Object
142 truncate_undo_list (list, minsize, maxsize)
143 Lisp_Object list;
144 int minsize, maxsize;
146 Lisp_Object prev, next, last_boundary;
147 int size_so_far = 0;
149 prev = Qnil;
150 next = list;
151 last_boundary = Qnil;
153 /* Always preserve at least the most recent undo record.
154 If the first element is an undo boundary, skip past it.
156 Skip, skip, skip the undo, skip, skip, skip the undo,
157 Skip, skip, skip the undo, skip to the undo bound'ry. */
158 if (XTYPE (next) == Lisp_Cons
159 && XCONS (next)->car == Qnil)
161 /* Add in the space occupied by this element and its chain link. */
162 size_so_far += sizeof (struct Lisp_Cons);
164 /* Advance to next element. */
165 prev = next;
166 next = XCONS (next)->cdr;
168 while (XTYPE (next) == Lisp_Cons
169 && XCONS (next)->car != Qnil)
171 Lisp_Object elt;
172 elt = XCONS (next)->car;
174 /* Add in the space occupied by this element and its chain link. */
175 size_so_far += sizeof (struct Lisp_Cons);
176 if (XTYPE (elt) == Lisp_Cons)
178 size_so_far += sizeof (struct Lisp_Cons);
179 if (XTYPE (XCONS (elt)->car) == Lisp_String)
180 size_so_far += (sizeof (struct Lisp_String) - 1
181 + XSTRING (XCONS (elt)->car)->size);
184 /* Advance to next element. */
185 prev = next;
186 next = XCONS (next)->cdr;
188 if (XTYPE (next) == Lisp_Cons)
189 last_boundary = prev;
191 while (XTYPE (next) == Lisp_Cons)
193 Lisp_Object elt;
194 elt = XCONS (next)->car;
196 /* When we get to a boundary, decide whether to truncate
197 either before or after it. The lower threshold, MINSIZE,
198 tells us to truncate after it. If its size pushes past
199 the higher threshold MAXSIZE as well, we truncate before it. */
200 if (NILP (elt))
202 if (size_so_far > maxsize)
203 break;
204 last_boundary = prev;
205 if (size_so_far > minsize)
206 break;
209 /* Add in the space occupied by this element and its chain link. */
210 size_so_far += sizeof (struct Lisp_Cons);
211 if (XTYPE (elt) == Lisp_Cons)
213 size_so_far += sizeof (struct Lisp_Cons);
214 if (XTYPE (XCONS (elt)->car) == Lisp_String)
215 size_so_far += (sizeof (struct Lisp_String) - 1
216 + XSTRING (XCONS (elt)->car)->size);
219 /* Advance to next element. */
220 prev = next;
221 next = XCONS (next)->cdr;
224 /* If we scanned the whole list, it is short enough; don't change it. */
225 if (NILP (next))
226 return list;
228 /* Truncate at the boundary where we decided to truncate. */
229 if (!NILP (last_boundary))
231 XCONS (last_boundary)->cdr = Qnil;
232 return list;
234 else
235 return Qnil;
238 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
239 "Undo N records from the front of the list LIST.\n\
240 Return what remains of the list.")
241 (count, list)
242 Lisp_Object count, list;
244 register int arg = XINT (count);
245 #if 0 /* This is a good feature, but would make undo-start
246 unable to do what is expected. */
247 Lisp_Object tem;
249 /* If the head of the list is a boundary, it is the boundary
250 preceding this command. Get rid of it and don't count it. */
251 tem = Fcar (list);
252 if (NILP (tem))
253 list = Fcdr (list);
254 #endif
256 while (arg > 0)
258 while (1)
260 Lisp_Object next, car, cdr;
261 next = Fcar (list);
262 list = Fcdr (list);
263 if (NILP (next))
264 break;
265 car = Fcar (next);
266 cdr = Fcdr (next);
267 if (EQ (car, Qt))
269 Lisp_Object high, low;
270 int mod_time;
271 high = Fcar (cdr);
272 low = Fcdr (cdr);
273 mod_time = (high << 16) + low;
274 /* If this records an obsolete save
275 (not matching the actual disk file)
276 then don't mark unmodified. */
277 if (mod_time != current_buffer->modtime)
278 break;
279 #ifdef CLASH_DETECTION
280 Funlock_buffer ();
281 #endif /* CLASH_DETECTION */
282 Fset_buffer_modified_p (Qnil);
284 else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
286 Lisp_Object end;
287 if (XINT (car) < BEGV
288 || XINT (cdr) > ZV)
289 error ("Changes to be undone are outside visible portion of buffer");
290 Fdelete_region (car, cdr);
291 Fgoto_char (car);
293 else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
295 Lisp_Object membuf;
296 int pos = XINT (cdr);
297 membuf = car;
298 if (pos < 0)
300 if (-pos < BEGV || -pos > ZV)
301 error ("Changes to be undone are outside visible portion of buffer");
302 SET_PT (-pos);
303 Finsert (1, &membuf);
305 else
307 if (pos < BEGV || pos > ZV)
308 error ("Changes to be undone are outside visible portion of buffer");
309 SET_PT (pos);
311 /* Insert before markers so that if the mark is
312 currently on the boundary of this deletion, it
313 ends up on the other side of the now-undeleted
314 text from point. Since undo doesn't even keep
315 track of the mark, this isn't really necessary,
316 but it may lead to better behavior in certain
317 situations. */
318 Finsert_before_markers (1, &membuf);
319 SET_PT (pos);
323 arg--;
326 return list;
329 syms_of_undo ()
331 defsubr (&Sprimitive_undo);
332 defsubr (&Sundo_boundary);