Mercurial > emacs
annotate src/undo.c @ 2499:da67547eda51
* configure.in: When checking for X windows, search for an X11
subdirectory of ${x_includes}.
* configure.in: Check for gettimeofday function, for getdate.y.
Change `configure' to a mixture of custom code and autoconf stuff.
autoconf can't derive all the information we need, but we'd really
like to be able to take advantage of some of its tests, and its
file-editing facilities.
* configure.in: Renamed from configure.
Quote the sections of shell script we want copied literally to
the configure script.
(compile): Initialize this to make the autoconf macros' code happy.
Use AC_PROG_CC, AC_CONST, and AC_RETSIGTYPE instead of writing out
code to do their jobs.
Use autoconf to produce Makefile and src/config.h.
Remove the Makefile-style comment that autoconf places at the top
of src/config.h.
(config_h_opts): Removed - no longer necessary.
* Makefile.in (configname): Renamed to configuration.
(CONFIG_CFLAGS): Renamed to DEFS.
(CC, DEFS, C_SWITCH_SYSTEM, version, configuration): Adjusted to
get values via autoload @cookies@.
(libsrc_libs): Get this from autoconf. We used to do nothing
about this.
(${SUBDIR}): Pass DEFS to submakes instead of CONFIG_CFLAGS.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Sat, 10 Apr 1993 06:02:36 +0000 |
parents | 886a69457557 |
children | e94a593c3952 |
rev | line source |
---|---|
223 | 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 | |
2194
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
39 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
|
40 return; |
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
41 |
223 | 42 if (current_buffer != XBUFFER (last_undo_buffer)) |
43 Fundo_boundary (); | |
44 XSET (last_undo_buffer, Lisp_Buffer, current_buffer); | |
45 | |
46 if (MODIFF <= current_buffer->save_modified) | |
47 record_first_change (); | |
48 | |
49 /* If this is following another insertion and consecutive with it | |
50 in the buffer, combine the two. */ | |
51 if (XTYPE (current_buffer->undo_list) == Lisp_Cons) | |
52 { | |
53 Lisp_Object elt; | |
54 elt = XCONS (current_buffer->undo_list)->car; | |
55 if (XTYPE (elt) == Lisp_Cons | |
56 && XTYPE (XCONS (elt)->car) == Lisp_Int | |
57 && 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
|
58 && XINT (XCONS (elt)->cdr) == XINT (beg)) |
223 | 59 { |
1524
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
60 XSETINT (XCONS (elt)->cdr, XINT (beg) + XINT (length)); |
223 | 61 return; |
62 } | |
63 } | |
64 | |
1524
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
65 lbeg = beg; |
91454bf15944
* undo.c (record_insert): Use accessors on BEG and LENGTH.
Jim Blandy <jimb@redhat.com>
parents:
1320
diff
changeset
|
66 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
|
67 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
|
68 current_buffer->undo_list); |
223 | 69 } |
70 | |
71 /* Record that a deletion is about to take place, | |
72 for LENGTH characters at location BEG. */ | |
73 | |
74 record_delete (beg, length) | |
75 int beg, length; | |
76 { | |
77 Lisp_Object lbeg, lend, sbeg; | |
78 | |
2194
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
79 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
|
80 return; |
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
81 |
223 | 82 if (current_buffer != XBUFFER (last_undo_buffer)) |
83 Fundo_boundary (); | |
84 XSET (last_undo_buffer, Lisp_Buffer, current_buffer); | |
85 | |
86 if (MODIFF <= current_buffer->save_modified) | |
87 record_first_change (); | |
88 | |
89 if (point == beg + length) | |
90 XSET (sbeg, Lisp_Int, -beg); | |
91 else | |
92 XFASTINT (sbeg) = beg; | |
93 XFASTINT (lbeg) = beg; | |
94 XFASTINT (lend) = beg + length; | |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
95 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
96 /* If point isn't at start of deleted range, record where it is. */ |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
97 if (PT != sbeg) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
98 current_buffer->undo_list |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
99 = 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
|
100 |
223 | 101 current_buffer->undo_list |
102 = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg), | |
103 current_buffer->undo_list); | |
104 } | |
105 | |
106 /* Record that a replacement is about to take place, | |
107 for LENGTH characters at location BEG. | |
108 The replacement does not change the number of characters. */ | |
109 | |
110 record_change (beg, length) | |
111 int beg, length; | |
112 { | |
113 record_delete (beg, length); | |
114 record_insert (beg, length); | |
115 } | |
116 | |
117 /* Record that an unmodified buffer is about to be changed. | |
118 Record the file modification date so that when undoing this entry | |
119 we can tell whether it is obsolete because the file was saved again. */ | |
120 | |
121 record_first_change () | |
122 { | |
123 Lisp_Object high, low; | |
124 XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff; | |
125 XFASTINT (low) = current_buffer->modtime & 0xffff; | |
126 current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list); | |
127 } | |
128 | |
1968
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
129 /* 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
|
130 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
|
131 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
132 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
|
133 int beg, length; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
134 Lisp_Object prop, value, buffer; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
135 { |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
136 Lisp_Object lbeg, lend, entry; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
137 struct buffer *obuf = current_buffer; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
138 int boundary = 0; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
139 |
2194
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
140 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
|
141 return; |
886a69457557
(record_property_change, record_delete, record_insert):
Richard M. Stallman <rms@gnu.org>
parents:
1968
diff
changeset
|
142 |
1968
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
143 if (!EQ (buffer, last_undo_buffer)) |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
144 boundary = 1; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
145 last_undo_buffer = buffer; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
146 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
147 /* 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
|
148 current_buffer = XBUFFER (buffer); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
149 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
150 if (boundary) |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
151 Fundo_boundary (); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
152 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
153 if (MODIFF <= current_buffer->save_modified) |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
154 record_first_change (); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
155 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
156 XSET (lbeg, Lisp_Int, beg); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
157 XSET (lend, Lisp_Int, beg + length); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
158 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
|
159 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
|
160 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
161 current_buffer = obuf; |
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 |
223 | 164 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0, |
165 "Mark a boundary between units of undo.\n\ | |
166 An undo command will stop at this point,\n\ | |
167 but another undo command will undo to the previous boundary.") | |
168 () | |
169 { | |
170 Lisp_Object tem; | |
171 if (EQ (current_buffer->undo_list, Qt)) | |
172 return Qnil; | |
173 tem = Fcar (current_buffer->undo_list); | |
485 | 174 if (!NILP (tem)) |
223 | 175 current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list); |
176 return Qnil; | |
177 } | |
178 | |
179 /* At garbage collection time, make an undo list shorter at the end, | |
180 returning the truncated list. | |
181 MINSIZE and MAXSIZE are the limits on size allowed, as described below. | |
761 | 182 In practice, these are the values of undo-limit and |
183 undo-strong-limit. */ | |
223 | 184 |
185 Lisp_Object | |
186 truncate_undo_list (list, minsize, maxsize) | |
187 Lisp_Object list; | |
188 int minsize, maxsize; | |
189 { | |
190 Lisp_Object prev, next, last_boundary; | |
191 int size_so_far = 0; | |
192 | |
193 prev = Qnil; | |
194 next = list; | |
195 last_boundary = Qnil; | |
196 | |
197 /* Always preserve at least the most recent undo record. | |
241 | 198 If the first element is an undo boundary, skip past it. |
199 | |
200 Skip, skip, skip the undo, skip, skip, skip the undo, | |
970 | 201 Skip, skip, skip the undo, skip to the undo bound'ry. |
202 (Get it? "Skip to my Loo?") */ | |
223 | 203 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
|
204 && NILP (XCONS (next)->car)) |
223 | 205 { |
206 /* Add in the space occupied by this element and its chain link. */ | |
207 size_so_far += sizeof (struct Lisp_Cons); | |
208 | |
209 /* Advance to next element. */ | |
210 prev = next; | |
211 next = XCONS (next)->cdr; | |
212 } | |
213 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
|
214 && ! NILP (XCONS (next)->car)) |
223 | 215 { |
216 Lisp_Object elt; | |
217 elt = XCONS (next)->car; | |
218 | |
219 /* Add in the space occupied by this element and its chain link. */ | |
220 size_so_far += sizeof (struct Lisp_Cons); | |
221 if (XTYPE (elt) == Lisp_Cons) | |
222 { | |
223 size_so_far += sizeof (struct Lisp_Cons); | |
224 if (XTYPE (XCONS (elt)->car) == Lisp_String) | |
225 size_so_far += (sizeof (struct Lisp_String) - 1 | |
226 + XSTRING (XCONS (elt)->car)->size); | |
227 } | |
228 | |
229 /* Advance to next element. */ | |
230 prev = next; | |
231 next = XCONS (next)->cdr; | |
232 } | |
233 if (XTYPE (next) == Lisp_Cons) | |
234 last_boundary = prev; | |
235 | |
236 while (XTYPE (next) == Lisp_Cons) | |
237 { | |
238 Lisp_Object elt; | |
239 elt = XCONS (next)->car; | |
240 | |
241 /* When we get to a boundary, decide whether to truncate | |
242 either before or after it. The lower threshold, MINSIZE, | |
243 tells us to truncate after it. If its size pushes past | |
244 the higher threshold MAXSIZE as well, we truncate before it. */ | |
485 | 245 if (NILP (elt)) |
223 | 246 { |
247 if (size_so_far > maxsize) | |
248 break; | |
249 last_boundary = prev; | |
250 if (size_so_far > minsize) | |
251 break; | |
252 } | |
253 | |
254 /* Add in the space occupied by this element and its chain link. */ | |
255 size_so_far += sizeof (struct Lisp_Cons); | |
256 if (XTYPE (elt) == Lisp_Cons) | |
257 { | |
258 size_so_far += sizeof (struct Lisp_Cons); | |
259 if (XTYPE (XCONS (elt)->car) == Lisp_String) | |
260 size_so_far += (sizeof (struct Lisp_String) - 1 | |
261 + XSTRING (XCONS (elt)->car)->size); | |
262 } | |
263 | |
264 /* Advance to next element. */ | |
265 prev = next; | |
266 next = XCONS (next)->cdr; | |
267 } | |
268 | |
269 /* If we scanned the whole list, it is short enough; don't change it. */ | |
485 | 270 if (NILP (next)) |
223 | 271 return list; |
272 | |
273 /* Truncate at the boundary where we decided to truncate. */ | |
485 | 274 if (!NILP (last_boundary)) |
223 | 275 { |
276 XCONS (last_boundary)->cdr = Qnil; | |
277 return list; | |
278 } | |
279 else | |
280 return Qnil; | |
281 } | |
282 | |
283 DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0, | |
284 "Undo N records from the front of the list LIST.\n\ | |
285 Return what remains of the list.") | |
286 (count, list) | |
287 Lisp_Object count, list; | |
288 { | |
289 register int arg = XINT (count); | |
290 #if 0 /* This is a good feature, but would make undo-start | |
291 unable to do what is expected. */ | |
292 Lisp_Object tem; | |
293 | |
294 /* If the head of the list is a boundary, it is the boundary | |
295 preceding this command. Get rid of it and don't count it. */ | |
296 tem = Fcar (list); | |
485 | 297 if (NILP (tem)) |
223 | 298 list = Fcdr (list); |
299 #endif | |
300 | |
301 while (arg > 0) | |
302 { | |
303 while (1) | |
304 { | |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
305 Lisp_Object next; |
223 | 306 next = Fcar (list); |
307 list = Fcdr (list); | |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
308 /* Exit inner loop at undo boundary. */ |
485 | 309 if (NILP (next)) |
223 | 310 break; |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
311 /* 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
|
312 if (XTYPE (next) == Lisp_Int) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
313 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
|
314 else if (XTYPE (next) == Lisp_Cons) |
223 | 315 { |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
316 Lisp_Object car, cdr; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
317 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
318 car = Fcar (next); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
319 cdr = Fcdr (next); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
320 if (EQ (car, Qt)) |
223 | 321 { |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
322 /* 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
|
323 Lisp_Object high, low; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
324 int mod_time; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
325 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
326 high = Fcar (cdr); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
327 low = Fcdr (cdr); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
328 mod_time = (high << 16) + low; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
329 /* If this records an obsolete save |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
330 (not matching the actual disk file) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
331 then don't mark unmodified. */ |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
332 if (mod_time != current_buffer->modtime) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
333 break; |
1598
3e9dadf2d13c
* undo.c (Fprimitive_undo): Remove whitespace in front of #ifdef
Jim Blandy <jimb@redhat.com>
parents:
1524
diff
changeset
|
334 #ifdef CLASH_DETECTION |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
335 Funlock_buffer (); |
1598
3e9dadf2d13c
* undo.c (Fprimitive_undo): Remove whitespace in front of #ifdef
Jim Blandy <jimb@redhat.com>
parents:
1524
diff
changeset
|
336 #endif /* CLASH_DETECTION */ |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
337 Fset_buffer_modified_p (Qnil); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
338 } |
1968
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
339 if (EQ (car, Qnil)) |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
340 { |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
341 /* Element (t prop val beg . end) records property change. */ |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
342 Lisp_Object beg, end, prop, val; |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
343 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
344 prop = Fcar (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
345 cdr = Fcdr (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
346 val = Fcar (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
347 cdr = Fcdr (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
348 beg = Fcar (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
349 end = Fcdr (cdr); |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
350 |
de0a0ed7318e
(record_property_change): Typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
1598
diff
changeset
|
351 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
|
352 } |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
353 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
|
354 { |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
355 /* 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
|
356 Lisp_Object end; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
357 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
358 if (XINT (car) < BEGV |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
359 || XINT (cdr) > ZV) |
223 | 360 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
|
361 /* 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
|
362 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
|
363 Fgoto_char (car); |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
364 Fdelete_region (car, cdr); |
223 | 365 } |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
366 else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int) |
223 | 367 { |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
368 /* 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
|
369 Lisp_Object membuf; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
370 int pos = XINT (cdr); |
544 | 371 |
1248
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
372 membuf = car; |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
373 if (pos < 0) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
374 { |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
375 if (-pos < BEGV || -pos > ZV) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
376 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
|
377 SET_PT (-pos); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
378 Finsert (1, &membuf); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
379 } |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
380 else |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
381 { |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
382 if (pos < BEGV || pos > ZV) |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
383 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
|
384 SET_PT (pos); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
385 |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
386 /* 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
|
387 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
|
388 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
|
389 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
|
390 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
|
391 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
|
392 situations. */ |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
393 Finsert_before_markers (1, &membuf); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
394 SET_PT (pos); |
68c77558d34b
(record_delete): Record pos before the deletion.
Richard M. Stallman <rms@gnu.org>
parents:
970
diff
changeset
|
395 } |
223 | 396 } |
397 } | |
398 } | |
399 arg--; | |
400 } | |
401 | |
402 return list; | |
403 } | |
404 | |
405 syms_of_undo () | |
406 { | |
407 defsubr (&Sprimitive_undo); | |
408 defsubr (&Sundo_boundary); | |
409 } |