|
223
|
1 /* undo handling for GNU Emacs.
|
|
75227
|
2 Copyright (C) 1990, 1993, 1994, 2000, 2001, 2002, 2003, 2004,
|
|
79759
|
3 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
|
223
|
4
|
|
|
5 This file is part of GNU Emacs.
|
|
|
6
|
|
94963
|
7 GNU Emacs is free software: you can redistribute it and/or modify
|
|
14186
|
8 it under the terms of the GNU General Public License as published by
|
|
94963
|
9 the Free Software Foundation, either version 3 of the License, or
|
|
|
10 (at your option) any later version.
|
|
223
|
11
|
|
14186
|
12 GNU Emacs is distributed in the hope that it will be useful,
|
|
|
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
15 GNU General Public License for more details.
|
|
|
16
|
|
|
17 You should have received a copy of the GNU General Public License
|
|
94963
|
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
|
223
|
19
|
|
|
20
|
|
4696
|
21 #include <config.h>
|
|
223
|
22 #include "lisp.h"
|
|
|
23 #include "buffer.h"
|
6180
d369907be635
(record_delete): Save last_point_position in the undo record, rather than the
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
24 #include "commands.h"
|
|
67821
|
25 #include "window.h"
|
|
223
|
26
|
|
59048
|
27 /* Limits controlling how much undo information to keep. */
|
|
|
28
|
|
|
29 EMACS_INT undo_limit;
|
|
|
30 EMACS_INT undo_strong_limit;
|
|
59069
|
31
|
|
|
32 Lisp_Object Vundo_outer_limit;
|
|
59048
|
33
|
|
|
34 /* Function to call when undo_outer_limit is exceeded. */
|
|
|
35
|
|
|
36 Lisp_Object Vundo_outer_limit_function;
|
|
|
37
|
|
223
|
38 /* Last buffer for which undo information was recorded. */
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
39 /* BEWARE: This is not traced by the GC, so never dereference it! */
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
40 struct buffer *last_undo_buffer;
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
41
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
42 /* Position of point last time we inserted a boundary. */
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
43 struct buffer *last_boundary_buffer;
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
44 EMACS_INT last_boundary_position;
|
|
223
|
45
|
|
3696
|
46 Lisp_Object Qinhibit_read_only;
|
|
|
47
|
|
59832
|
48 /* Marker for function call undo list elements. */
|
|
|
49
|
|
|
50 Lisp_Object Qapply;
|
|
|
51
|
|
6254
|
52 /* The first time a command records something for undo.
|
|
|
53 it also allocates the undo-boundary object
|
|
|
54 which will be added to the list at the end of the command.
|
|
|
55 This ensures we can't run out of space while trying to make
|
|
|
56 an undo-boundary. */
|
|
|
57 Lisp_Object pending_boundary;
|
|
|
58
|
|
87860
|
59 /* Nonzero means do not record point in record_point. */
|
|
|
60
|
|
|
61 int undo_inhibit_record_point;
|
|
|
62
|
|
44391
|
63 /* Record point as it was at beginning of this command (if necessary)
|
|
87860
|
64 and prepare the undo info for recording a change.
|
|
44391
|
65 PT is the position of point that will naturally occur as a result of the
|
|
|
66 undo record that will be added just after this command terminates. */
|
|
|
67
|
|
|
68 static void
|
|
|
69 record_point (pt)
|
|
48326
|
70 int pt;
|
|
44391
|
71 {
|
|
|
72 int at_boundary;
|
|
|
73
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
74 /* Don't record position of pt when undo_inhibit_record_point holds. */
|
|
87860
|
75 if (undo_inhibit_record_point)
|
|
|
76 return;
|
|
|
77
|
|
44391
|
78 /* Allocate a cons cell to be the undo boundary after this command. */
|
|
|
79 if (NILP (pending_boundary))
|
|
|
80 pending_boundary = Fcons (Qnil, Qnil);
|
|
|
81
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
82 if (current_buffer != last_undo_buffer)
|
|
44391
|
83 Fundo_boundary ();
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
84 last_undo_buffer = current_buffer;
|
|
44391
|
85
|
|
|
86 if (CONSP (current_buffer->undo_list))
|
|
|
87 {
|
|
|
88 /* Set AT_BOUNDARY to 1 only when we have nothing other than
|
|
|
89 marker adjustment before undo boundary. */
|
|
|
90
|
|
|
91 Lisp_Object tail = current_buffer->undo_list, elt;
|
|
|
92
|
|
|
93 while (1)
|
|
|
94 {
|
|
|
95 if (NILP (tail))
|
|
|
96 elt = Qnil;
|
|
|
97 else
|
|
|
98 elt = XCAR (tail);
|
|
|
99 if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
|
|
|
100 break;
|
|
|
101 tail = XCDR (tail);
|
|
|
102 }
|
|
|
103 at_boundary = NILP (elt);
|
|
|
104 }
|
|
|
105 else
|
|
|
106 at_boundary = 1;
|
|
|
107
|
|
|
108 if (MODIFF <= SAVE_MODIFF)
|
|
|
109 record_first_change ();
|
|
|
110
|
|
49600
|
111 /* If we are just after an undo boundary, and
|
|
44391
|
112 point wasn't at start of deleted range, record where it was. */
|
|
|
113 if (at_boundary
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
114 && current_buffer == last_boundary_buffer
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
115 && last_boundary_position != pt)
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
116 current_buffer->undo_list
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
117 = Fcons (make_number (last_boundary_position), current_buffer->undo_list);
|
|
44391
|
118 }
|
|
|
119
|
|
223
|
120 /* Record an insertion that just happened or is about to happen,
|
|
|
121 for LENGTH characters at position BEG.
|
|
|
122 (It is possible to record an insertion before or after the fact
|
|
|
123 because we don't need to record the contents.) */
|
|
|
124
|
|
20372
|
125 void
|
|
223
|
126 record_insert (beg, length)
|
|
12088
|
127 int beg, length;
|
|
223
|
128 {
|
|
|
129 Lisp_Object lbeg, lend;
|
|
|
130
|
|
2194
|
131 if (EQ (current_buffer->undo_list, Qt))
|
|
|
132 return;
|
|
|
133
|
|
44391
|
134 record_point (beg);
|
|
223
|
135
|
|
|
136 /* If this is following another insertion and consecutive with it
|
|
|
137 in the buffer, combine the two. */
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
138 if (CONSP (current_buffer->undo_list))
|
|
223
|
139 {
|
|
|
140 Lisp_Object elt;
|
|
25663
|
141 elt = XCAR (current_buffer->undo_list);
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
142 if (CONSP (elt)
|
|
25663
|
143 && INTEGERP (XCAR (elt))
|
|
|
144 && INTEGERP (XCDR (elt))
|
|
|
145 && XINT (XCDR (elt)) == beg)
|
|
223
|
146 {
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
147 XSETCDR (elt, make_number (beg + length));
|
|
223
|
148 return;
|
|
|
149 }
|
|
|
150 }
|
|
|
151
|
|
12088
|
152 XSETFASTINT (lbeg, beg);
|
|
|
153 XSETINT (lend, beg + length);
|
|
1524
|
154 current_buffer->undo_list = Fcons (Fcons (lbeg, lend),
|
|
|
155 current_buffer->undo_list);
|
|
223
|
156 }
|
|
|
157
|
|
|
158 /* Record that a deletion is about to take place,
|
|
21237
|
159 of the characters in STRING, at location BEG. */
|
|
223
|
160
|
|
20373
|
161 void
|
|
21237
|
162 record_delete (beg, string)
|
|
|
163 int beg;
|
|
|
164 Lisp_Object string;
|
|
223
|
165 {
|
|
21237
|
166 Lisp_Object sbeg;
|
|
223
|
167
|
|
2194
|
168 if (EQ (current_buffer->undo_list, Qt))
|
|
|
169 return;
|
|
|
170
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
171 if (PT == beg + SCHARS (string))
|
|
21272
|
172 {
|
|
44391
|
173 XSETINT (sbeg, -beg);
|
|
|
174 record_point (PT);
|
|
21272
|
175 }
|
|
|
176 else
|
|
44391
|
177 {
|
|
|
178 XSETFASTINT (sbeg, beg);
|
|
|
179 record_point (beg);
|
|
|
180 }
|
|
1248
|
181
|
|
223
|
182 current_buffer->undo_list
|
|
21237
|
183 = Fcons (Fcons (string, sbeg), current_buffer->undo_list);
|
|
223
|
184 }
|
|
|
185
|
|
14480
|
186 /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT.
|
|
|
187 This is done only when a marker points within text being deleted,
|
|
|
188 because that's the only case where an automatic marker adjustment
|
|
|
189 won't be inverted automatically by undoing the buffer modification. */
|
|
|
190
|
|
20373
|
191 void
|
|
14480
|
192 record_marker_adjustment (marker, adjustment)
|
|
|
193 Lisp_Object marker;
|
|
|
194 int adjustment;
|
|
|
195 {
|
|
|
196 if (EQ (current_buffer->undo_list, Qt))
|
|
|
197 return;
|
|
|
198
|
|
|
199 /* Allocate a cons cell to be the undo boundary after this command. */
|
|
|
200 if (NILP (pending_boundary))
|
|
|
201 pending_boundary = Fcons (Qnil, Qnil);
|
|
|
202
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
203 if (current_buffer != last_undo_buffer)
|
|
14480
|
204 Fundo_boundary ();
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
205 last_undo_buffer = current_buffer;
|
|
14480
|
206
|
|
|
207 current_buffer->undo_list
|
|
|
208 = Fcons (Fcons (marker, make_number (adjustment)),
|
|
|
209 current_buffer->undo_list);
|
|
|
210 }
|
|
|
211
|
|
223
|
212 /* Record that a replacement is about to take place,
|
|
|
213 for LENGTH characters at location BEG.
|
|
21237
|
214 The replacement must not change the number of characters. */
|
|
223
|
215
|
|
20373
|
216 void
|
|
223
|
217 record_change (beg, length)
|
|
|
218 int beg, length;
|
|
|
219 {
|
|
21237
|
220 record_delete (beg, make_buffer_string (beg, beg + length, 1));
|
|
223
|
221 record_insert (beg, length);
|
|
|
222 }
|
|
|
223
|
|
|
224 /* Record that an unmodified buffer is about to be changed.
|
|
|
225 Record the file modification date so that when undoing this entry
|
|
|
226 we can tell whether it is obsolete because the file was saved again. */
|
|
|
227
|
|
20372
|
228 void
|
|
223
|
229 record_first_change ()
|
|
|
230 {
|
|
|
231 Lisp_Object high, low;
|
|
10300
|
232 struct buffer *base_buffer = current_buffer;
|
|
5762
|
233
|
|
|
234 if (EQ (current_buffer->undo_list, Qt))
|
|
|
235 return;
|
|
|
236
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
237 if (current_buffer != last_undo_buffer)
|
|
5762
|
238 Fundo_boundary ();
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
239 last_undo_buffer = current_buffer;
|
|
5762
|
240
|
|
10300
|
241 if (base_buffer->base_buffer)
|
|
|
242 base_buffer = base_buffer->base_buffer;
|
|
|
243
|
|
|
244 XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff);
|
|
|
245 XSETFASTINT (low, base_buffer->modtime & 0xffff);
|
|
223
|
246 current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
|
|
|
247 }
|
|
|
248
|
|
1968
|
249 /* Record a change in property PROP (whose old value was VAL)
|
|
|
250 for LENGTH characters starting at position BEG in BUFFER. */
|
|
|
251
|
|
20372
|
252 void
|
|
1968
|
253 record_property_change (beg, length, prop, value, buffer)
|
|
|
254 int beg, length;
|
|
|
255 Lisp_Object prop, value, buffer;
|
|
|
256 {
|
|
|
257 Lisp_Object lbeg, lend, entry;
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
258 struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer);
|
|
1968
|
259 int boundary = 0;
|
|
|
260
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
261 if (EQ (buf->undo_list, Qt))
|
|
2194
|
262 return;
|
|
|
263
|
|
6254
|
264 /* Allocate a cons cell to be the undo boundary after this command. */
|
|
|
265 if (NILP (pending_boundary))
|
|
|
266 pending_boundary = Fcons (Qnil, Qnil);
|
|
|
267
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
268 if (buf != last_undo_buffer)
|
|
1968
|
269 boundary = 1;
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
270 last_undo_buffer = buf;
|
|
1968
|
271
|
|
|
272 /* Switch temporarily to the buffer that was changed. */
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
273 current_buffer = buf;
|
|
1968
|
274
|
|
|
275 if (boundary)
|
|
|
276 Fundo_boundary ();
|
|
|
277
|
|
10300
|
278 if (MODIFF <= SAVE_MODIFF)
|
|
1968
|
279 record_first_change ();
|
|
|
280
|
9281
05b2bd5d5559
(record_insert, record_delete, record_first_change, record_property_change):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
281 XSETINT (lbeg, beg);
|
05b2bd5d5559
(record_insert, record_delete, record_first_change, record_property_change):
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
282 XSETINT (lend, beg + length);
|
|
1968
|
283 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
|
|
|
284 current_buffer->undo_list = Fcons (entry, current_buffer->undo_list);
|
|
|
285
|
|
|
286 current_buffer = obuf;
|
|
|
287 }
|
|
|
288
|
|
223
|
289 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
|
|
40123
|
290 doc: /* Mark a boundary between units of undo.
|
|
|
291 An undo command will stop at this point,
|
|
|
292 but another undo command will undo to the previous boundary. */)
|
|
|
293 ()
|
|
223
|
294 {
|
|
|
295 Lisp_Object tem;
|
|
|
296 if (EQ (current_buffer->undo_list, Qt))
|
|
|
297 return Qnil;
|
|
|
298 tem = Fcar (current_buffer->undo_list);
|
|
485
|
299 if (!NILP (tem))
|
|
6254
|
300 {
|
|
|
301 /* One way or another, cons nil onto the front of the undo list. */
|
|
|
302 if (!NILP (pending_boundary))
|
|
|
303 {
|
|
|
304 /* If we have preallocated the cons cell to use here,
|
|
|
305 use that one. */
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
306 XSETCDR (pending_boundary, current_buffer->undo_list);
|
|
6254
|
307 current_buffer->undo_list = pending_boundary;
|
|
|
308 pending_boundary = Qnil;
|
|
|
309 }
|
|
|
310 else
|
|
|
311 current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
|
|
|
312 }
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
313 last_boundary_position = PT;
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
314 last_boundary_buffer = current_buffer;
|
|
223
|
315 return Qnil;
|
|
|
316 }
|
|
|
317
|
|
|
318 /* At garbage collection time, make an undo list shorter at the end,
|
|
59048
|
319 returning the truncated list. How this is done depends on the
|
|
|
320 variables undo-limit, undo-strong-limit and undo-outer-limit.
|
|
|
321 In some cases this works by calling undo-outer-limit-function. */
|
|
223
|
322
|
|
59048
|
323 void
|
|
|
324 truncate_undo_list (b)
|
|
|
325 struct buffer *b;
|
|
223
|
326 {
|
|
59048
|
327 Lisp_Object list;
|
|
223
|
328 Lisp_Object prev, next, last_boundary;
|
|
|
329 int size_so_far = 0;
|
|
|
330
|
|
59048
|
331 /* Make sure that calling undo-outer-limit-function
|
|
|
332 won't cause another GC. */
|
|
|
333 int count = inhibit_garbage_collection ();
|
|
|
334
|
|
|
335 /* Make the buffer current to get its local values of variables such
|
|
|
336 as undo_limit. Also so that Vundo_outer_limit_function can
|
|
|
337 tell which buffer to operate on. */
|
|
|
338 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
|
|
|
339 set_buffer_internal (b);
|
|
|
340
|
|
|
341 list = b->undo_list;
|
|
|
342
|
|
223
|
343 prev = Qnil;
|
|
|
344 next = list;
|
|
|
345 last_boundary = Qnil;
|
|
|
346
|
|
59048
|
347 /* If the first element is an undo boundary, skip past it. */
|
|
25663
|
348 if (CONSP (next) && NILP (XCAR (next)))
|
|
223
|
349 {
|
|
|
350 /* Add in the space occupied by this element and its chain link. */
|
|
|
351 size_so_far += sizeof (struct Lisp_Cons);
|
|
|
352
|
|
|
353 /* Advance to next element. */
|
|
|
354 prev = next;
|
|
25663
|
355 next = XCDR (next);
|
|
223
|
356 }
|
|
55839
|
357
|
|
59048
|
358 /* Always preserve at least the most recent undo record
|
|
|
359 unless it is really horribly big.
|
|
|
360
|
|
|
361 Skip, skip, skip the undo, skip, skip, skip the undo,
|
|
|
362 Skip, skip, skip the undo, skip to the undo bound'ry. */
|
|
|
363
|
|
25663
|
364 while (CONSP (next) && ! NILP (XCAR (next)))
|
|
223
|
365 {
|
|
|
366 Lisp_Object elt;
|
|
25663
|
367 elt = XCAR (next);
|
|
223
|
368
|
|
|
369 /* Add in the space occupied by this element and its chain link. */
|
|
|
370 size_so_far += sizeof (struct Lisp_Cons);
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
371 if (CONSP (elt))
|
|
223
|
372 {
|
|
|
373 size_so_far += sizeof (struct Lisp_Cons);
|
|
25663
|
374 if (STRINGP (XCAR (elt)))
|
|
223
|
375 size_so_far += (sizeof (struct Lisp_String) - 1
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
376 + SCHARS (XCAR (elt)));
|
|
223
|
377 }
|
|
|
378
|
|
|
379 /* Advance to next element. */
|
|
|
380 prev = next;
|
|
25663
|
381 next = XCDR (next);
|
|
223
|
382 }
|
|
55839
|
383
|
|
59048
|
384 /* If by the first boundary we have already passed undo_outer_limit,
|
|
|
385 we're heading for memory full, so offer to clear out the list. */
|
|
59069
|
386 if (INTEGERP (Vundo_outer_limit)
|
|
|
387 && size_so_far > XINT (Vundo_outer_limit)
|
|
59048
|
388 && !NILP (Vundo_outer_limit_function))
|
|
|
389 {
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
390 Lisp_Object tem;
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
391 struct buffer *temp = last_undo_buffer;
|
|
59048
|
392
|
|
|
393 /* Normally the function this calls is undo-outer-limit-truncate. */
|
67339
7a9d49053af3
(truncate_undo_list): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
394 tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
|
7a9d49053af3
(truncate_undo_list): Avoid dangerous side effects in NILP argument.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
395 if (! NILP (tem))
|
|
59048
|
396 {
|
|
|
397 /* The function is responsible for making
|
|
|
398 any desired changes in buffer-undo-list. */
|
|
|
399 unbind_to (count, Qnil);
|
|
|
400 return;
|
|
|
401 }
|
|
|
402 /* That function probably used the minibuffer, and if so, that
|
|
|
403 changed last_undo_buffer. Change it back so that we don't
|
|
|
404 force next change to make an undo boundary here. */
|
|
|
405 last_undo_buffer = temp;
|
|
|
406 }
|
|
|
407
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
408 if (CONSP (next))
|
|
223
|
409 last_boundary = prev;
|
|
|
410
|
|
59048
|
411 /* Keep additional undo data, if it fits in the limits. */
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
412 while (CONSP (next))
|
|
223
|
413 {
|
|
|
414 Lisp_Object elt;
|
|
25663
|
415 elt = XCAR (next);
|
|
223
|
416
|
|
|
417 /* When we get to a boundary, decide whether to truncate
|
|
59048
|
418 either before or after it. The lower threshold, undo_limit,
|
|
223
|
419 tells us to truncate after it. If its size pushes past
|
|
59048
|
420 the higher threshold undo_strong_limit, we truncate before it. */
|
|
485
|
421 if (NILP (elt))
|
|
223
|
422 {
|
|
59048
|
423 if (size_so_far > undo_strong_limit)
|
|
223
|
424 break;
|
|
|
425 last_boundary = prev;
|
|
59048
|
426 if (size_so_far > undo_limit)
|
|
223
|
427 break;
|
|
|
428 }
|
|
|
429
|
|
|
430 /* Add in the space occupied by this element and its chain link. */
|
|
|
431 size_so_far += sizeof (struct Lisp_Cons);
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
432 if (CONSP (elt))
|
|
223
|
433 {
|
|
|
434 size_so_far += sizeof (struct Lisp_Cons);
|
|
25663
|
435 if (STRINGP (XCAR (elt)))
|
|
223
|
436 size_so_far += (sizeof (struct Lisp_String) - 1
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
437 + SCHARS (XCAR (elt)));
|
|
223
|
438 }
|
|
|
439
|
|
|
440 /* Advance to next element. */
|
|
|
441 prev = next;
|
|
25663
|
442 next = XCDR (next);
|
|
223
|
443 }
|
|
|
444
|
|
|
445 /* If we scanned the whole list, it is short enough; don't change it. */
|
|
485
|
446 if (NILP (next))
|
|
59048
|
447 ;
|
|
223
|
448 /* Truncate at the boundary where we decided to truncate. */
|
|
59048
|
449 else if (!NILP (last_boundary))
|
|
|
450 XSETCDR (last_boundary, Qnil);
|
|
|
451 /* There's nothing we decided to keep, so clear it out. */
|
|
223
|
452 else
|
|
59048
|
453 b->undo_list = Qnil;
|
|
|
454
|
|
|
455 unbind_to (count, Qnil);
|
|
223
|
456 }
|
|
|
457
|
|
|
458 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
|
|
40123
|
459 doc: /* Undo N records from the front of the list LIST.
|
|
|
460 Return what remains of the list. */)
|
|
|
461 (n, list)
|
|
3719
|
462 Lisp_Object n, list;
|
|
223
|
463 {
|
|
7671
|
464 struct gcpro gcpro1, gcpro2;
|
|
|
465 Lisp_Object next;
|
|
46285
|
466 int count = SPECPDL_INDEX ();
|
|
7671
|
467 register int arg;
|
|
59970
|
468 Lisp_Object oldlist;
|
|
|
469 int did_apply = 0;
|
|
49600
|
470
|
|
223
|
471 #if 0 /* This is a good feature, but would make undo-start
|
|
|
472 unable to do what is expected. */
|
|
|
473 Lisp_Object tem;
|
|
|
474
|
|
|
475 /* If the head of the list is a boundary, it is the boundary
|
|
|
476 preceding this command. Get rid of it and don't count it. */
|
|
|
477 tem = Fcar (list);
|
|
485
|
478 if (NILP (tem))
|
|
223
|
479 list = Fcdr (list);
|
|
|
480 #endif
|
|
|
481
|
|
40656
|
482 CHECK_NUMBER (n);
|
|
7671
|
483 arg = XINT (n);
|
|
|
484 next = Qnil;
|
|
|
485 GCPRO2 (next, list);
|
|
59970
|
486 /* I don't think we need to gcpro oldlist, as we use it only
|
|
|
487 to check for EQ. ++kfs */
|
|
7671
|
488
|
|
37527
|
489 /* In a writable buffer, enable undoing read-only text that is so
|
|
|
490 because of text properties. */
|
|
|
491 if (NILP (current_buffer->read_only))
|
|
3696
|
492 specbind (Qinhibit_read_only, Qt);
|
|
|
493
|
|
34794
|
494 /* Don't let `intangible' properties interfere with undo. */
|
|
|
495 specbind (Qinhibit_point_motion_hooks, Qt);
|
|
|
496
|
|
59970
|
497 oldlist = current_buffer->undo_list;
|
|
|
498
|
|
223
|
499 while (arg > 0)
|
|
|
500 {
|
|
39798
|
501 while (CONSP (list))
|
|
223
|
502 {
|
|
39798
|
503 next = XCAR (list);
|
|
|
504 list = XCDR (list);
|
|
1248
|
505 /* Exit inner loop at undo boundary. */
|
|
485
|
506 if (NILP (next))
|
|
223
|
507 break;
|
|
1248
|
508 /* Handle an integer by setting point to that value. */
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
509 if (INTEGERP (next))
|
|
1248
|
510 SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
511 else if (CONSP (next))
|
|
223
|
512 {
|
|
1248
|
513 Lisp_Object car, cdr;
|
|
|
514
|
|
39798
|
515 car = XCAR (next);
|
|
|
516 cdr = XCDR (next);
|
|
1248
|
517 if (EQ (car, Qt))
|
|
223
|
518 {
|
|
1248
|
519 /* Element (t high . low) records previous modtime. */
|
|
|
520 Lisp_Object high, low;
|
|
|
521 int mod_time;
|
|
10300
|
522 struct buffer *base_buffer = current_buffer;
|
|
1248
|
523
|
|
|
524 high = Fcar (cdr);
|
|
|
525 low = Fcdr (cdr);
|
|
3687
|
526 mod_time = (XFASTINT (high) << 16) + XFASTINT (low);
|
|
10300
|
527
|
|
|
528 if (current_buffer->base_buffer)
|
|
|
529 base_buffer = current_buffer->base_buffer;
|
|
|
530
|
|
1248
|
531 /* If this records an obsolete save
|
|
|
532 (not matching the actual disk file)
|
|
|
533 then don't mark unmodified. */
|
|
10300
|
534 if (mod_time != base_buffer->modtime)
|
|
12649
|
535 continue;
|
|
1598
|
536 #ifdef CLASH_DETECTION
|
|
1248
|
537 Funlock_buffer ();
|
|
1598
|
538 #endif /* CLASH_DETECTION */
|
|
1248
|
539 Fset_buffer_modified_p (Qnil);
|
|
|
540 }
|
|
3687
|
541 else if (EQ (car, Qnil))
|
|
1968
|
542 {
|
|
59777
|
543 /* Element (nil PROP VAL BEG . END) is property change. */
|
|
1968
|
544 Lisp_Object beg, end, prop, val;
|
|
|
545
|
|
|
546 prop = Fcar (cdr);
|
|
|
547 cdr = Fcdr (cdr);
|
|
|
548 val = Fcar (cdr);
|
|
|
549 cdr = Fcdr (cdr);
|
|
|
550 beg = Fcar (cdr);
|
|
|
551 end = Fcdr (cdr);
|
|
|
552
|
76800
3f97b6926170
(Fprimitive_undo): Give clearer error message when trying to change
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
553 if (XINT (beg) < BEGV || XINT (end) > ZV)
|
3f97b6926170
(Fprimitive_undo): Give clearer error message when trying to change
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
554 error ("Changes to be undone are outside visible portion of buffer");
|
|
1968
|
555 Fput_text_property (beg, end, prop, val, Qnil);
|
|
|
556 }
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
557 else if (INTEGERP (car) && INTEGERP (cdr))
|
|
1248
|
558 {
|
|
|
559 /* Element (BEG . END) means range was inserted. */
|
|
|
560
|
|
|
561 if (XINT (car) < BEGV
|
|
|
562 || XINT (cdr) > ZV)
|
|
223
|
563 error ("Changes to be undone are outside visible portion of buffer");
|
1320
c45c4e0cae7d
(Fprimitive_undo): When undoing an insert, move point and then delete.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
564 /* Set point first thing, so that undoing this undo
|
c45c4e0cae7d
(Fprimitive_undo): When undoing an insert, move point and then delete.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
565 does not send point back to where it is now. */
|
c45c4e0cae7d
(Fprimitive_undo): When undoing an insert, move point and then delete.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
566 Fgoto_char (car);
|
|
1248
|
567 Fdelete_region (car, cdr);
|
|
223
|
568 }
|
|
59832
|
569 else if (EQ (car, Qapply))
|
|
59777
|
570 {
|
|
59992
|
571 /* Element (apply FUN . ARGS) means call FUN to undo. */
|
|
60000
|
572 struct buffer *save_buffer = current_buffer;
|
|
|
573
|
|
59832
|
574 car = Fcar (cdr);
|
|
59992
|
575 cdr = Fcdr (cdr);
|
|
59832
|
576 if (INTEGERP (car))
|
|
|
577 {
|
|
59992
|
578 /* Long format: (apply DELTA START END FUN . ARGS). */
|
|
|
579 Lisp_Object delta = car;
|
|
|
580 Lisp_Object start = Fcar (cdr);
|
|
|
581 Lisp_Object end = Fcar (Fcdr (cdr));
|
|
|
582 Lisp_Object start_mark = Fcopy_marker (start, Qnil);
|
|
|
583 Lisp_Object end_mark = Fcopy_marker (end, Qt);
|
|
|
584
|
|
|
585 cdr = Fcdr (Fcdr (cdr));
|
|
|
586 apply1 (Fcar (cdr), Fcdr (cdr));
|
|
|
587
|
|
|
588 /* Check that the function did what the entry said it
|
|
|
589 would do. */
|
|
|
590 if (!EQ (start, Fmarker_position (start_mark))
|
|
|
591 || (XINT (delta) + XINT (end)
|
|
|
592 != marker_position (end_mark)))
|
|
|
593 error ("Changes to be undone by function different than announced");
|
|
|
594 Fset_marker (start_mark, Qnil, Qnil);
|
|
|
595 Fset_marker (end_mark, Qnil, Qnil);
|
|
59832
|
596 }
|
|
59992
|
597 else
|
|
|
598 apply1 (car, cdr);
|
|
60000
|
599
|
|
|
600 if (save_buffer != current_buffer)
|
|
|
601 error ("Undo function switched buffer");
|
|
59970
|
602 did_apply = 1;
|
|
59777
|
603 }
|
9108
c0287cefc0f8
(record_insert, truncate_undo_list, Fprimitive_undo): Use type test macros.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
604 else if (STRINGP (car) && INTEGERP (cdr))
|
|
223
|
605 {
|
|
1248
|
606 /* Element (STRING . POS) means STRING was deleted. */
|
|
|
607 Lisp_Object membuf;
|
|
|
608 int pos = XINT (cdr);
|
|
544
|
609
|
|
1248
|
610 membuf = car;
|
|
|
611 if (pos < 0)
|
|
|
612 {
|
|
|
613 if (-pos < BEGV || -pos > ZV)
|
|
|
614 error ("Changes to be undone are outside visible portion of buffer");
|
|
|
615 SET_PT (-pos);
|
|
|
616 Finsert (1, &membuf);
|
|
|
617 }
|
|
|
618 else
|
|
|
619 {
|
|
|
620 if (pos < BEGV || pos > ZV)
|
|
|
621 error ("Changes to be undone are outside visible portion of buffer");
|
|
|
622 SET_PT (pos);
|
|
|
623
|
|
17447
|
624 /* Now that we record marker adjustments
|
|
|
625 (caused by deletion) for undo,
|
|
|
626 we should always insert after markers,
|
|
|
627 so that undoing the marker adjustments
|
|
|
628 put the markers back in the right place. */
|
|
|
629 Finsert (1, &membuf);
|
|
1248
|
630 SET_PT (pos);
|
|
|
631 }
|
|
223
|
632 }
|
|
14480
|
633 else if (MARKERP (car) && INTEGERP (cdr))
|
|
|
634 {
|
|
|
635 /* (MARKER . INTEGER) means a marker MARKER
|
|
|
636 was adjusted by INTEGER. */
|
|
|
637 if (XMARKER (car)->buffer)
|
|
|
638 Fset_marker (car,
|
|
|
639 make_number (marker_position (car) - XINT (cdr)),
|
|
|
640 Fmarker_buffer (car));
|
|
|
641 }
|
|
223
|
642 }
|
|
|
643 }
|
|
|
644 arg--;
|
|
|
645 }
|
|
|
646
|
|
59970
|
647
|
|
|
648 /* Make sure an apply entry produces at least one undo entry,
|
|
|
649 so the test in `undo' for continuing an undo series
|
|
|
650 will work right. */
|
|
|
651 if (did_apply
|
|
|
652 && EQ (oldlist, current_buffer->undo_list))
|
|
|
653 current_buffer->undo_list
|
|
|
654 = Fcons (list3 (Qapply, Qcdr, Qnil), current_buffer->undo_list);
|
|
|
655
|
|
7671
|
656 UNGCPRO;
|
|
3696
|
657 return unbind_to (count, list);
|
|
223
|
658 }
|
|
59777
|
659
|
|
21514
|
660 void
|
|
223
|
661 syms_of_undo ()
|
|
|
662 {
|
|
3696
|
663 Qinhibit_read_only = intern ("inhibit-read-only");
|
|
|
664 staticpro (&Qinhibit_read_only);
|
|
|
665
|
|
59832
|
666 Qapply = intern ("apply");
|
|
|
667 staticpro (&Qapply);
|
|
|
668
|
|
6254
|
669 pending_boundary = Qnil;
|
|
|
670 staticpro (&pending_boundary);
|
|
|
671
|
93663
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
672 last_undo_buffer = NULL;
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
673 last_boundary_buffer = NULL;
|
959f4471c16e
(last_boundary_buffer, last_boundary_position): New vars.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
674
|
|
223
|
675 defsubr (&Sprimitive_undo);
|
|
|
676 defsubr (&Sundo_boundary);
|
|
59048
|
677
|
|
|
678 DEFVAR_INT ("undo-limit", &undo_limit,
|
|
|
679 doc: /* Keep no more undo information once it exceeds this size.
|
|
|
680 This limit is applied when garbage collection happens.
|
|
|
681 When a previous command increases the total undo list size past this
|
|
|
682 value, the earlier commands that came before it are forgotten.
|
|
|
683
|
|
|
684 The size is counted as the number of bytes occupied,
|
|
|
685 which includes both saved text and other data. */);
|
|
|
686 undo_limit = 20000;
|
|
|
687
|
|
|
688 DEFVAR_INT ("undo-strong-limit", &undo_strong_limit,
|
|
|
689 doc: /* Don't keep more than this much size of undo information.
|
|
|
690 This limit is applied when garbage collection happens.
|
|
|
691 When a previous command increases the total undo list size past this
|
|
|
692 value, that command and the earlier commands that came before it are forgotten.
|
|
|
693 However, the most recent buffer-modifying command's undo info
|
|
|
694 is never discarded for this reason.
|
|
|
695
|
|
|
696 The size is counted as the number of bytes occupied,
|
|
|
697 which includes both saved text and other data. */);
|
|
|
698 undo_strong_limit = 30000;
|
|
|
699
|
|
59069
|
700 DEFVAR_LISP ("undo-outer-limit", &Vundo_outer_limit,
|
|
59048
|
701 doc: /* Outer limit on size of undo information for one command.
|
|
|
702 At garbage collection time, if the current command has produced
|
|
59791
|
703 more than this much undo information, it discards the info and displays
|
|
|
704 a warning. This is a last-ditch limit to prevent memory overflow.
|
|
59048
|
705
|
|
59791
|
706 The size is counted as the number of bytes occupied, which includes
|
|
|
707 both saved text and other data. A value of nil means no limit. In
|
|
|
708 this case, accumulating one huge undo entry could make Emacs crash as
|
|
|
709 a result of memory overflow.
|
|
59048
|
710
|
|
|
711 In fact, this calls the function which is the value of
|
|
|
712 `undo-outer-limit-function' with one argument, the size.
|
|
|
713 The text above describes the behavior of the function
|
|
|
714 that variable usually specifies. */);
|
|
59793
|
715 Vundo_outer_limit = make_number (3000000);
|
|
59048
|
716
|
|
|
717 DEFVAR_LISP ("undo-outer-limit-function", &Vundo_outer_limit_function,
|
|
|
718 doc: /* Function to call when an undo list exceeds `undo-outer-limit'.
|
|
|
719 This function is called with one argument, the current undo list size
|
|
|
720 for the most recent command (since the last undo boundary).
|
|
|
721 If the function returns t, that means truncation has been fully handled.
|
|
|
722 If it returns nil, the other forms of truncation are done.
|
|
|
723
|
|
|
724 Garbage collection is inhibited around the call to this function,
|
|
|
725 so it must make sure not to do a lot of consing. */);
|
|
|
726 Vundo_outer_limit_function = Qnil;
|
|
87860
|
727
|
|
|
728 DEFVAR_BOOL ("undo-inhibit-record-point", &undo_inhibit_record_point,
|
|
|
729 doc: /* Non-nil means do not record `point' in `buffer-undo-list'. */);
|
|
|
730 undo_inhibit_record_point = 0;
|
|
223
|
731 }
|
|
52401
|
732
|
|
|
733 /* arch-tag: d546ee01-4aed-4ffb-bb8b-eefaae50d38a
|
|
|
734 (do not change this comment) */
|
