Mercurial > emacs
annotate src/undo.c @ 5307:069c54e77fd1
Don't repeat at load time any bindings that are autoloaded.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 23 Dec 1993 04:52:56 +0000 |
parents | 1fc792473491 |
children | 099857a46901 |
rev | line source |
---|---|
223 | 1 /* undo handling for GNU Emacs. |
2961 | 2 Copyright (C) 1990, 1993 Free Software Foundation, Inc. |
223 | 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 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
3719
diff
changeset
|
22 #include <config.h> |
223 | 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 | |
3696
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
29 Lisp_Object Qinhibit_read_only; |
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
30 |
223 | 31 /* Record an insertion that just happened or is about to happen, |
32 for LENGTH characters at position BEG. | |
33 (It is possible to record an insertion before or after the fact | |
34 because we don't need to record the contents.) */ | |
35 | |
36 record_insert (beg, length) | |
37 Lisp_Object beg, length; | |
38 { | |
39 Lisp_Object lbeg, lend; | |
40 | |
2194
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
41 if (EQ (current_buffer->undo_list, Qt)) |
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
42 return; |
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
43 |
223 | 44 if (current_buffer != XBUFFER (last_undo_buffer)) |
45 Fundo_boundary (); | |
46 XSET (last_undo_buffer, Lisp_Buffer, current_buffer); | |
47 | |
48 if (MODIFF <= current_buffer->save_modified) | |
49 record_first_change (); | |
50 | |
51 /* If this is following another insertion and consecutive with it | |
52 in the buffer, combine the two. */ | |
53 if (XTYPE (current_buffer->undo_list) == Lisp_Cons) | |
54 { | |
55 Lisp_Object elt; | |
56 elt = XCONS (current_buffer->undo_list)->car; | |
57 if (XTYPE (elt) == Lisp_Cons | |
58 && XTYPE (XCONS (elt)->car) == Lisp_Int | |
59 && XTYPE (XCONS (elt)->cdr) == Lisp_Int | |
1524
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
60 && XINT (XCONS (elt)->cdr) == XINT (beg)) |
223 | 61 { |
1524
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
62 XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length)); |
223 | 63 return; |
64 } | |
65 } | |
66 | |
1524
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
67 lbeg = beg; |
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
68 XSET (lend, Lisp_Int, XINT (beg) + XINT (length)); |
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
69 current_buffer->undo_list = Fcons (Fcons (lbeg, lend), |
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
70 current_buffer->undo_list); |
223 | 71 } |
72 | |
73 /* Record that a deletion is about to take place, | |
74 for LENGTH characters at location BEG. */ | |
75 | |
76 record_delete (beg, length) | |
77 int beg, length; | |
78 { | |
79 Lisp_Object lbeg, lend, sbeg; | |
80 | |
2194
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
81 if (EQ (current_buffer->undo_list, Qt)) |
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
82 return; |
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
83 |
223 | 84 if (current_buffer != XBUFFER (last_undo_buffer)) |
85 Fundo_boundary (); | |
86 XSET (last_undo_buffer, Lisp_Buffer, current_buffer); | |
87 | |
88 if (MODIFF <= current_buffer->save_modified) | |
89 record_first_change (); | |
90 | |
91 if (point == beg + length) | |
92 XSET (sbeg, Lisp_Int, -beg); | |
93 else | |
94 XFASTINT (sbeg) = beg; | |
95 XFASTINT (lbeg) = beg; | |
96 XFASTINT (lend) = beg + length; | |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
97 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
98 /* If point isn't at start of deleted range, record where it is. */ |
3687
54381151027d
(record_delete): Always use XFASTINT on sbeg.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
99 if (PT != XFASTINT (sbeg)) |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
100 current_buffer->undo_list |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
101 = Fcons (make_number (PT), current_buffer->undo_list); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
102 |
223 | 103 current_buffer->undo_list |
104 = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg), | |
105 current_buffer->undo_list); | |
106 } | |
107 | |
108 /* Record that a replacement is about to take place, | |
109 for LENGTH characters at location BEG. | |
110 The replacement does not change the number of characters. */ | |
111 | |
112 record_change (beg, length) | |
113 int beg, length; | |
114 { | |
115 record_delete (beg, length); | |
116 record_insert (beg, length); | |
117 } | |
118 | |
119 /* Record that an unmodified buffer is about to be changed. | |
120 Record the file modification date so that when undoing this entry | |
121 we can tell whether it is obsolete because the file was saved again. */ | |
122 | |
123 record_first_change () | |
124 { | |
125 Lisp_Object high, low; | |
126 XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff; | |
127 XFASTINT (low) = current_buffer->modtime & 0xffff; | |
128 current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list); | |
129 } | |
130 | |
1968
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
131 /* Record a change in property PROP (whose old value was VAL) |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
132 for LENGTH characters starting at position BEG in BUFFER. */ |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
133 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
134 record_property_change (beg, length, prop, value, buffer) |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
135 int beg, length; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
136 Lisp_Object prop, value, buffer; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
137 { |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
138 Lisp_Object lbeg, lend, entry; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
139 struct buffer *obuf = current_buffer; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
140 int boundary = 0; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
141 |
2194
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
142 if (EQ (current_buffer->undo_list, Qt)) |
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
143 return; |
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
144 |
1968
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
145 if (!EQ (buffer, last_undo_buffer)) |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
146 boundary = 1; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
147 last_undo_buffer = buffer; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
148 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
149 /* Switch temporarily to the buffer that was changed. */ |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
150 current_buffer = XBUFFER (buffer); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
151 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
152 if (boundary) |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
153 Fundo_boundary (); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
154 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
155 if (MODIFF <= current_buffer->save_modified) |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
156 record_first_change (); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
157 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
158 XSET (lbeg, Lisp_Int, beg); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
159 XSET (lend, Lisp_Int, beg + length); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
160 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
161 current_buffer->undo_list = Fcons (entry, current_buffer->undo_list); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
162 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
163 current_buffer = obuf; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
164 } |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
165 |
223 | 166 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0, |
167 "Mark a boundary between units of undo.\n\ | |
168 An undo command will stop at this point,\n\ | |
169 but another undo command will undo to the previous boundary.") | |
170 () | |
171 { | |
172 Lisp_Object tem; | |
173 if (EQ (current_buffer->undo_list, Qt)) | |
174 return Qnil; | |
175 tem = Fcar (current_buffer->undo_list); | |
485 | 176 if (!NILP (tem)) |
223 | 177 current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list); |
178 return Qnil; | |
179 } | |
180 | |
181 /* At garbage collection time, make an undo list shorter at the end, | |
182 returning the truncated list. | |
183 MINSIZE and MAXSIZE are the limits on size allowed, as described below. | |
761 | 184 In practice, these are the values of undo-limit and |
185 undo-strong-limit. */ | |
223 | 186 |
187 Lisp_Object | |
188 truncate_undo_list (list, minsize, maxsize) | |
189 Lisp_Object list; | |
190 int minsize, maxsize; | |
191 { | |
192 Lisp_Object prev, next, last_boundary; | |
193 int size_so_far = 0; | |
194 | |
195 prev = Qnil; | |
196 next = list; | |
197 last_boundary = Qnil; | |
198 | |
199 /* Always preserve at least the most recent undo record. | |
241 | 200 If the first element is an undo boundary, skip past it. |
201 | |
202 Skip, skip, skip the undo, skip, skip, skip the undo, | |
970 | 203 Skip, skip, skip the undo, skip to the undo bound'ry. |
204 (Get it? "Skip to my Loo?") */ | |
223 | 205 if (XTYPE (next) == Lisp_Cons |
1524
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
206 && NILP (XCONS (next)->car)) |
223 | 207 { |
208 /* Add in the space occupied by this element and its chain link. */ | |
209 size_so_far += sizeof (struct Lisp_Cons); | |
210 | |
211 /* Advance to next element. */ | |
212 prev = next; | |
213 next = XCONS (next)->cdr; | |
214 } | |
215 while (XTYPE (next) == Lisp_Cons | |
1524
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
216 && ! NILP (XCONS (next)->car)) |
223 | 217 { |
218 Lisp_Object elt; | |
219 elt = XCONS (next)->car; | |
220 | |
221 /* Add in the space occupied by this element and its chain link. */ | |
222 size_so_far += sizeof (struct Lisp_Cons); | |
223 if (XTYPE (elt) == Lisp_Cons) | |
224 { | |
225 size_so_far += sizeof (struct Lisp_Cons); | |
226 if (XTYPE (XCONS (elt)->car) == Lisp_String) | |
227 size_so_far += (sizeof (struct Lisp_String) - 1 | |
228 + XSTRING (XCONS (elt)->car)->size); | |
229 } | |
230 | |
231 /* Advance to next element. */ | |
232 prev = next; | |
233 next = XCONS (next)->cdr; | |
234 } | |
235 if (XTYPE (next) == Lisp_Cons) | |
236 last_boundary = prev; | |
237 | |
238 while (XTYPE (next) == Lisp_Cons) | |
239 { | |
240 Lisp_Object elt; | |
241 elt = XCONS (next)->car; | |
242 | |
243 /* When we get to a boundary, decide whether to truncate | |
244 either before or after it. The lower threshold, MINSIZE, | |
245 tells us to truncate after it. If its size pushes past | |
246 the higher threshold MAXSIZE as well, we truncate before it. */ | |
485 | 247 if (NILP (elt)) |
223 | 248 { |
249 if (size_so_far > maxsize) | |
250 break; | |
251 last_boundary = prev; | |
252 if (size_so_far > minsize) | |
253 break; | |
254 } | |
255 | |
256 /* Add in the space occupied by this element and its chain link. */ | |
257 size_so_far += sizeof (struct Lisp_Cons); | |
258 if (XTYPE (elt) == Lisp_Cons) | |
259 { | |
260 size_so_far += sizeof (struct Lisp_Cons); | |
261 if (XTYPE (XCONS (elt)->car) == Lisp_String) | |
262 size_so_far += (sizeof (struct Lisp_String) - 1 | |
263 + XSTRING (XCONS (elt)->car)->size); | |
264 } | |
265 | |
266 /* Advance to next element. */ | |
267 prev = next; | |
268 next = XCONS (next)->cdr; | |
269 } | |
270 | |
271 /* If we scanned the whole list, it is short enough; don't change it. */ | |
485 | 272 if (NILP (next)) |
223 | 273 return list; |
274 | |
275 /* Truncate at the boundary where we decided to truncate. */ | |
485 | 276 if (!NILP (last_boundary)) |
223 | 277 { |
278 XCONS (last_boundary)->cdr = Qnil; | |
279 return list; | |
280 } | |
281 else | |
282 return Qnil; | |
283 } | |
284 | |
285 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0, | |
286 "Undo N records from the front of the list LIST.\n\ | |
287 Return what remains of the list.") | |
3719
695181e4bc20
(Fprimitive_undo): Rename arg to N to avoid conflict.
Richard M. Stallman <rms@gnu.org>
parents:
3696
diff
changeset
|
288 (n, list) |
695181e4bc20
(Fprimitive_undo): Rename arg to N to avoid conflict.
Richard M. Stallman <rms@gnu.org>
parents:
3696
diff
changeset
|
289 Lisp_Object n, list; |
223 | 290 { |
3696
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
291 int count = specpdl_ptr - specpdl; |
3719
695181e4bc20
(Fprimitive_undo): Rename arg to N to avoid conflict.
Richard M. Stallman <rms@gnu.org>
parents:
3696
diff
changeset
|
292 register int arg = XINT (n); |
223 | 293 #if 0 /* This is a good feature, but would make undo-start |
294 unable to do what is expected. */ | |
295 Lisp_Object tem; | |
296 | |
297 /* If the head of the list is a boundary, it is the boundary | |
298 preceding this command. Get rid of it and don't count it. */ | |
299 tem = Fcar (list); | |
485 | 300 if (NILP (tem)) |
223 | 301 list = Fcdr (list); |
302 #endif | |
303 | |
3696
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
304 /* Don't let read-only properties interfere with undo. */ |
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
305 if (NILP (current_buffer->read_only)) |
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
306 specbind (Qinhibit_read_only, Qt); |
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
307 |
223 | 308 while (arg > 0) |
309 { | |
310 while (1) | |
311 { | |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
312 Lisp_Object next; |
223 | 313 next = Fcar (list); |
314 list = Fcdr (list); | |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
315 /* Exit inner loop at undo boundary. */ |
485 | 316 if (NILP (next)) |
223 | 317 break; |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
318 /* Handle an integer by setting point to that value. */ |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
319 if (XTYPE (next) == Lisp_Int) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
320 SET_PT (clip_to_bounds (BEGV, XINT (next), ZV)); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
321 else if (XTYPE (next) == Lisp_Cons) |
223 | 322 { |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
323 Lisp_Object car, cdr; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
324 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
325 car = Fcar (next); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
326 cdr = Fcdr (next); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
327 if (EQ (car, Qt)) |
223 | 328 { |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
329 /* Element (t high . low) records previous modtime. */ |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
330 Lisp_Object high, low; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
331 int mod_time; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
332 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
333 high = Fcar (cdr); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
334 low = Fcdr (cdr); |
3687
54381151027d
(record_delete): Always use XFASTINT on sbeg.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
335 mod_time = (XFASTINT (high) << 16) + XFASTINT (low); |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
336 /* If this records an obsolete save |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
337 (not matching the actual disk file) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
338 then don't mark unmodified. */ |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
339 if (mod_time != current_buffer->modtime) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
340 break; |
1598
3e9dadf2d13c
* undo.c (Fprimitive_undo): Remove whitespace in front of #ifdef
Jim Blandy <jimb@redhat.com>
parents:
1524
diff
changeset
|
341 #ifdef CLASH_DETECTION |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
342 Funlock_buffer (); |
1598
3e9dadf2d13c
* undo.c (Fprimitive_undo): Remove whitespace in front of #ifdef
Jim Blandy <jimb@redhat.com>
parents:
1524
diff
changeset
|
343 #endif /* CLASH_DETECTION */ |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
344 Fset_buffer_modified_p (Qnil); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
345 } |
3687
54381151027d
(record_delete): Always use XFASTINT on sbeg.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
346 #ifdef USE_TEXT_PROPERTIES |
54381151027d
(record_delete): Always use XFASTINT on sbeg.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
347 else if (EQ (car, Qnil)) |
1968
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
348 { |
3687
54381151027d
(record_delete): Always use XFASTINT on sbeg.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
349 /* Element (nil prop val beg . end) is property change. */ |
1968
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
350 Lisp_Object beg, end, prop, val; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
351 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
352 prop = Fcar (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
353 cdr = Fcdr (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
354 val = Fcar (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
355 cdr = Fcdr (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
356 beg = Fcar (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
357 end = Fcdr (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
358 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
359 Fput_text_property (beg, end, prop, val, Qnil); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
360 } |
3687
54381151027d
(record_delete): Always use XFASTINT on sbeg.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
361 #endif /* USE_TEXT_PROPERTIES */ |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
362 else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
363 { |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
364 /* Element (BEG . END) means range was inserted. */ |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
365 Lisp_Object end; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
366 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
367 if (XINT (car) < BEGV |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
368 || XINT (cdr) > ZV) |
223 | 369 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>
parents:
1248
diff
changeset
|
370 /* 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>
parents:
1248
diff
changeset
|
371 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>
parents:
1248
diff
changeset
|
372 Fgoto_char (car); |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
373 Fdelete_region (car, cdr); |
223 | 374 } |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
375 else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int) |
223 | 376 { |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
377 /* Element (STRING . POS) means STRING was deleted. */ |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
378 Lisp_Object membuf; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
379 int pos = XINT (cdr); |
544 | 380 |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
381 membuf = car; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
382 if (pos < 0) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
383 { |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
384 if (-pos < BEGV || -pos > ZV) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
385 error ("Changes to be undone are outside visible portion of buffer"); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
386 SET_PT (-pos); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
387 Finsert (1, &membuf); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
388 } |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
389 else |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
390 { |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
391 if (pos < BEGV || pos > ZV) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
392 error ("Changes to be undone are outside visible portion of buffer"); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
393 SET_PT (pos); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
394 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
395 /* Insert before markers so that if the mark is |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
396 currently on the boundary of this deletion, it |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
397 ends up on the other side of the now-undeleted |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
398 text from point. Since undo doesn't even keep |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
399 track of the mark, this isn't really necessary, |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
400 but it may lead to better behavior in certain |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
401 situations. */ |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
402 Finsert_before_markers (1, &membuf); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
403 SET_PT (pos); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
404 } |
223 | 405 } |
406 } | |
407 } | |
408 arg--; | |
409 } | |
410 | |
3696
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
411 return unbind_to (count, list); |
223 | 412 } |
413 | |
414 syms_of_undo () | |
415 { | |
3696
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
416 Qinhibit_read_only = intern ("inhibit-read-only"); |
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
417 staticpro (&Qinhibit_read_only); |
aa9310f06c0f
(syms_of_undo): Set up Qinhibit_read_only.
Richard M. Stallman <rms@gnu.org>
parents:
3687
diff
changeset
|
418 |
223 | 419 defsubr (&Sprimitive_undo); |
420 defsubr (&Sundo_boundary); | |
421 } |