Mercurial > emacs
annotate src/undo.c @ 3075:878381e48b0d
* xfns.c: Clear out the old face stuff.
(x_face_table, n_faces, x_set_face, x_set_glyph, Fx_set_face_font,
Fx_set_face, Fx_get_face): Removed.
(syms_of_xfns): Remove defsubr for Fx_set_face.
Arrange for font names to get fully resolved - no wildcards.
* xfns.c (x_set_frame_parameters): Store the value in the frame
parameter alist before we call the setter function, so the setter
function can touch up the value if it chooses.
(x_set_foreground_color, x_set_background_color): Call
recompute_basic_faces, so their GC's will reflect the changes.
(x_new_font): Add extern declaration - this returns a Lisp_Object
now, the fully resolved font name.
(x_set_font): Accept the fully resolved name from x_new_font, and
put it in the frame's parameter alist. Call recompute_basic_faces.
* xterm.c (x_new_font): Return the fully resolved font name, Qnil
(if no match), or Qt (match, but unacceptable metrics).
* xterm.c (x_new_font): Don't call init_frame_faces.
* xterm.h: New section for declarations for xfaces.c.
(init_frame_faces, free_frame_faces, intern_face,
face_name_id_number, same_size_fonts, recompute_basic_faces,
compute_char_face, compute_glyph_face): Declare these here.
* xfaces.c (same_size_fonts): We can now remove this extern
declaration.
* xfns.c (face_name_id_number): Likewise.
* xterm.c (intern_face): Likewise.
* xfns.c (Fx_list_fonts): Remember that FACE may not have a font
specified. Don't specify 30000 as the maximum limit on the number
of fontns returned - 2000 is more reasonable.
Treat faces as structures specifying modifications to the frame's
parameters, rather than things which need to specify a complete
set of parameters by themselves.
* xfaces.c (init_frame_faces): Don't set up the two frame display
faces by querying the GC - just leave all their fields blank, and
call recompute_basic_faces, letting build_face do the work of
consulting the frame when necessary.
(recompute_basic_faces): New function.
(compute_base_faces): New function for obtaining the "identity"
for compute_char_face and compute_glyph_face.
(compute_char_face, compute_glyph_face): Call it, instead of copying
FRAME_DEFAULT_FACE.
* xfns.c (x_make_gc): No need to call init_frame_faces here.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Tue, 25 May 1993 14:03:41 +0000 |
parents | e94a593c3952 |
children | 54381151027d |
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 | |
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 } |