Mercurial > emacs
comparison src/undo.c @ 223:dbc50aaa4f08
Initial revision
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Wed, 03 Apr 1991 02:08:50 +0000 |
parents | |
children | f108a48f6e86 |
comparison
equal
deleted
inserted
replaced
222:d1d8765cc35e | 223:dbc50aaa4f08 |
---|---|
1 /* undo handling for GNU Emacs. | |
2 Copyright (C) 1990 Free Software Foundation, Inc. | |
3 | |
4 This file is part of GNU Emacs. | |
5 | |
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. | |
12 | |
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. */ | |
20 | |
21 | |
22 #include "config.h" | |
23 #include "lisp.h" | |
24 #include "buffer.h" | |
25 | |
26 /* Last buffer for which undo information was recorded. */ | |
27 Lisp_Object last_undo_buffer; | |
28 | |
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.) */ | |
33 | |
34 record_insert (beg, length) | |
35 Lisp_Object beg, length; | |
36 { | |
37 Lisp_Object lbeg, lend; | |
38 | |
39 if (current_buffer != XBUFFER (last_undo_buffer)) | |
40 Fundo_boundary (); | |
41 XSET (last_undo_buffer, Lisp_Buffer, current_buffer); | |
42 | |
43 if (EQ (current_buffer->undo_list, Qt)) | |
44 return; | |
45 if (MODIFF <= current_buffer->save_modified) | |
46 record_first_change (); | |
47 | |
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) | |
51 { | |
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) | |
58 { | |
59 XSETINT (XCONS (elt)->cdr, beg + length); | |
60 return; | |
61 } | |
62 } | |
63 | |
64 XFASTINT (lbeg) = beg; | |
65 XFASTINT (lend) = beg + length; | |
66 current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list); | |
67 } | |
68 | |
69 /* Record that a deletion is about to take place, | |
70 for LENGTH characters at location BEG. */ | |
71 | |
72 record_delete (beg, length) | |
73 int beg, length; | |
74 { | |
75 Lisp_Object lbeg, lend, sbeg; | |
76 | |
77 if (current_buffer != XBUFFER (last_undo_buffer)) | |
78 Fundo_boundary (); | |
79 XSET (last_undo_buffer, Lisp_Buffer, current_buffer); | |
80 | |
81 if (EQ (current_buffer->undo_list, Qt)) | |
82 return; | |
83 if (MODIFF <= current_buffer->save_modified) | |
84 record_first_change (); | |
85 | |
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); | |
95 } | |
96 | |
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. */ | |
100 | |
101 record_change (beg, length) | |
102 int beg, length; | |
103 { | |
104 record_delete (beg, length); | |
105 record_insert (beg, length); | |
106 } | |
107 | |
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. */ | |
111 | |
112 record_first_change () | |
113 { | |
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); | |
118 } | |
119 | |
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.") | |
124 () | |
125 { | |
126 Lisp_Object tem; | |
127 if (EQ (current_buffer->undo_list, Qt)) | |
128 return Qnil; | |
129 tem = Fcar (current_buffer->undo_list); | |
130 if (!NULL (tem)) | |
131 current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list); | |
132 return Qnil; | |
133 } | |
134 | |
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. */ | |
140 | |
141 Lisp_Object | |
142 truncate_undo_list (list, minsize, maxsize) | |
143 Lisp_Object list; | |
144 int minsize, maxsize; | |
145 { | |
146 Lisp_Object prev, next, last_boundary; | |
147 int size_so_far = 0; | |
148 | |
149 prev = Qnil; | |
150 next = list; | |
151 last_boundary = Qnil; | |
152 | |
153 /* Always preserve at least the most recent undo record. | |
154 If the first element is an undo boundary, skip past it. */ | |
155 if (XTYPE (next) == Lisp_Cons | |
156 && XCONS (next)->car == Qnil) | |
157 { | |
158 /* Add in the space occupied by this element and its chain link. */ | |
159 size_so_far += sizeof (struct Lisp_Cons); | |
160 | |
161 /* Advance to next element. */ | |
162 prev = next; | |
163 next = XCONS (next)->cdr; | |
164 } | |
165 while (XTYPE (next) == Lisp_Cons | |
166 && XCONS (next)->car != Qnil) | |
167 { | |
168 Lisp_Object elt; | |
169 elt = XCONS (next)->car; | |
170 | |
171 /* Add in the space occupied by this element and its chain link. */ | |
172 size_so_far += sizeof (struct Lisp_Cons); | |
173 if (XTYPE (elt) == Lisp_Cons) | |
174 { | |
175 size_so_far += sizeof (struct Lisp_Cons); | |
176 if (XTYPE (XCONS (elt)->car) == Lisp_String) | |
177 size_so_far += (sizeof (struct Lisp_String) - 1 | |
178 + XSTRING (XCONS (elt)->car)->size); | |
179 } | |
180 | |
181 /* Advance to next element. */ | |
182 prev = next; | |
183 next = XCONS (next)->cdr; | |
184 } | |
185 if (XTYPE (next) == Lisp_Cons) | |
186 last_boundary = prev; | |
187 | |
188 while (XTYPE (next) == Lisp_Cons) | |
189 { | |
190 Lisp_Object elt; | |
191 elt = XCONS (next)->car; | |
192 | |
193 /* When we get to a boundary, decide whether to truncate | |
194 either before or after it. The lower threshold, MINSIZE, | |
195 tells us to truncate after it. If its size pushes past | |
196 the higher threshold MAXSIZE as well, we truncate before it. */ | |
197 if (NULL (elt)) | |
198 { | |
199 if (size_so_far > maxsize) | |
200 break; | |
201 last_boundary = prev; | |
202 if (size_so_far > minsize) | |
203 break; | |
204 } | |
205 | |
206 /* Add in the space occupied by this element and its chain link. */ | |
207 size_so_far += sizeof (struct Lisp_Cons); | |
208 if (XTYPE (elt) == Lisp_Cons) | |
209 { | |
210 size_so_far += sizeof (struct Lisp_Cons); | |
211 if (XTYPE (XCONS (elt)->car) == Lisp_String) | |
212 size_so_far += (sizeof (struct Lisp_String) - 1 | |
213 + XSTRING (XCONS (elt)->car)->size); | |
214 } | |
215 | |
216 /* Advance to next element. */ | |
217 prev = next; | |
218 next = XCONS (next)->cdr; | |
219 } | |
220 | |
221 /* If we scanned the whole list, it is short enough; don't change it. */ | |
222 if (NULL (next)) | |
223 return list; | |
224 | |
225 /* Truncate at the boundary where we decided to truncate. */ | |
226 if (!NULL (last_boundary)) | |
227 { | |
228 XCONS (last_boundary)->cdr = Qnil; | |
229 return list; | |
230 } | |
231 else | |
232 return Qnil; | |
233 } | |
234 | |
235 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0, | |
236 "Undo N records from the front of the list LIST.\n\ | |
237 Return what remains of the list.") | |
238 (count, list) | |
239 Lisp_Object count, list; | |
240 { | |
241 register int arg = XINT (count); | |
242 #if 0 /* This is a good feature, but would make undo-start | |
243 unable to do what is expected. */ | |
244 Lisp_Object tem; | |
245 | |
246 /* If the head of the list is a boundary, it is the boundary | |
247 preceding this command. Get rid of it and don't count it. */ | |
248 tem = Fcar (list); | |
249 if (NULL (tem)) | |
250 list = Fcdr (list); | |
251 #endif | |
252 | |
253 while (arg > 0) | |
254 { | |
255 while (1) | |
256 { | |
257 Lisp_Object next, car, cdr; | |
258 next = Fcar (list); | |
259 list = Fcdr (list); | |
260 if (NULL (next)) | |
261 break; | |
262 car = Fcar (next); | |
263 cdr = Fcdr (next); | |
264 if (EQ (car, Qt)) | |
265 { | |
266 Lisp_Object high, low; | |
267 int mod_time; | |
268 high = Fcar (cdr); | |
269 low = Fcdr (cdr); | |
270 mod_time = (high << 16) + low; | |
271 /* If this records an obsolete save | |
272 (not matching the actual disk file) | |
273 then don't mark unmodified. */ | |
274 if (mod_time != current_buffer->modtime) | |
275 break; | |
276 #ifdef CLASH_DETECTION | |
277 Funlock_buffer (); | |
278 #endif /* CLASH_DETECTION */ | |
279 Fset_buffer_modified_p (Qnil); | |
280 } | |
281 else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int) | |
282 { | |
283 Lisp_Object end; | |
284 if (XINT (car) < BEGV | |
285 || XINT (cdr) > ZV) | |
286 error ("Changes to be undone are outside visible portion of buffer"); | |
287 Fdelete_region (car, cdr); | |
288 Fgoto_char (car); | |
289 } | |
290 else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int) | |
291 { | |
292 Lisp_Object membuf; | |
293 int pos = XINT (cdr); | |
294 membuf = car; | |
295 if (pos < 0) | |
296 { | |
297 if (-pos < BEGV || -pos > ZV) | |
298 error ("Changes to be undone are outside visible portion of buffer"); | |
299 SET_PT (-pos); | |
300 Finsert (1, &membuf); | |
301 } | |
302 else | |
303 { | |
304 if (pos < BEGV || pos > ZV) | |
305 error ("Changes to be undone are outside visible portion of buffer"); | |
306 SET_PT (pos); | |
307 Finsert (1, &membuf); | |
308 SET_PT (pos); | |
309 } | |
310 } | |
311 } | |
312 arg--; | |
313 } | |
314 | |
315 return list; | |
316 } | |
317 | |
318 syms_of_undo () | |
319 { | |
320 defsubr (&Sprimitive_undo); | |
321 defsubr (&Sundo_boundary); | |
322 } |