annotate src/undo.c @ 284:558f606b08ae r21-0b40

Import from CVS: tag r21-0b40
author cvs
date Mon, 13 Aug 2007 10:34:13 +0200
parents 2c611d1463a6
children 6240c7796c7a
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 /* undo handling for XEmacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 Copyright (C) 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4 This file is part of XEmacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 Boston, MA 02111-1307, USA. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 /* Synched up with: FSF 19.28. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23 /* This file has been Mule-ized. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25 #include <config.h>
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26 #include "lisp.h"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27 #include "buffer.h"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 #include "extents.h"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 /* Maintained in event-stream.c */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 extern Bufpos last_point_position;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 extern Lisp_Object last_point_position_buffer;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34 /* Extent code needs to know about undo because the behavior of insert()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 with regard to extents varies depending on whether we are inside
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36 an undo or not. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 int inside_undo;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 /* Last buffer for which undo information was recorded. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 static Lisp_Object last_undo_buffer;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42 Lisp_Object Qinhibit_read_only;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 /* The first time a command records something for undo.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 it also allocates the undo-boundary object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 which will be added to the list at the end of the command.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 This ensures we can't run out of space while trying to make
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48 an undo-boundary. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49 Lisp_Object pending_boundary;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
50
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51 static void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52 undo_boundary (struct buffer *b)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 Lisp_Object tem = Fcar (b->undo_list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 if (!NILP (tem))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 /* One way or another, cons nil onto the front of the undo list. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 if (CONSP (pending_boundary))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 /* If we have preallocated the cons cell to use here,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 use that one. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 XCDR (pending_boundary) = b->undo_list;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63 b->undo_list = pending_boundary;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 pending_boundary = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 b->undo_list = Fcons (Qnil, b->undo_list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 static int
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 undo_prelude (struct buffer *b, int hack_pending_boundary)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 if (EQ (b->undo_list, Qt))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 return (0);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78 if (NILP (last_undo_buffer) || b != XBUFFER (last_undo_buffer))
284
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
79 {
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
80 undo_boundary (b);
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
81 XSETBUFFER (last_undo_buffer, b);
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
82 }
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 167
diff changeset
83
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 /* Allocate a cons cell to be the undo boundary after this command. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 if (hack_pending_boundary && NILP (pending_boundary))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 pending_boundary = Fcons (Qnil, Qnil);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 if (BUF_MODIFF (b) <= BUF_SAVE_MODIFF (b))
284
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
89 {
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
90 /* Record that an unmodified buffer is about to be changed.
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
91 Record the file modification date so that when undoing this
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
92 entry we can tell whether it is obsolete because the file was
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
93 saved again. */
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
94 b->undo_list
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
95 = Fcons (Fcons (Qt,
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
96 Fcons (make_int ((b->modtime >> 16) & 0xffff),
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
97 make_int (b->modtime & 0xffff))),
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
98 b->undo_list);
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
99 }
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
100 return 1;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 restore_inside_undo (Lisp_Object val)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 inside_undo = XINT (val);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 return val;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 /* Record an insertion that just happened or is about to happen,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 for LENGTH characters at position BEG.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 (It is possible to record an insertion before or after the fact
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 because we don't need to record the contents.) */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119 record_insert (struct buffer *b, Bufpos beg, Charcount length)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 if (!undo_prelude (b, 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122 return;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 /* If this is following another insertion and consecutive with it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 in the buffer, combine the two. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 if (CONSP (b->undo_list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 Lisp_Object elt;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 elt = XCAR (b->undo_list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 if (CONSP (elt)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131 && INTP (XCAR (elt))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 && INTP (XCDR (elt))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133 && XINT (XCDR (elt)) == beg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135 XCDR (elt) = make_int (beg + length);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 return;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
137 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 167
diff changeset
140 b->undo_list = Fcons (Fcons (make_int (beg),
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141 make_int (beg + length)),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
142 b->undo_list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
143 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
144
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
145 /* Record that a deletion is about to take place,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
146 for LENGTH characters at location BEG. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
147
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
148 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
149 record_delete (struct buffer *b, Bufpos beg, Charcount length)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
150 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
151 /* This function can GC */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
152 Lisp_Object sbeg;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
153 int at_boundary;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
154
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
155 if (!undo_prelude (b, 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 return;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
158 at_boundary = (CONSP (b->undo_list)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
159 && NILP (XCAR (b->undo_list)));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161 if (BUF_PT (b) == beg + length)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 sbeg = make_int (-beg);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
164 sbeg = make_int (beg);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 167
diff changeset
166 /* If we are just after an undo boundary, and
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
167 point wasn't at start of deleted range, record where it was. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 if (at_boundary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169 && BUFFERP (last_point_position_buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
170 && b == XBUFFER (last_point_position_buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
171 && last_point_position != XINT (sbeg))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
172 b->undo_list = Fcons (make_int (last_point_position), b->undo_list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
173
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
174 b->undo_list = Fcons (Fcons (make_string_from_buffer (b, beg,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
175 length),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 sbeg),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177 b->undo_list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
178 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
179
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
180 /* Record that a replacement is about to take place,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
181 for LENGTH characters at location BEG.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
182 The replacement does not change the number of characters. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
183
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
184 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
185 record_change (struct buffer *b, Bufpos beg, Charcount length)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
186 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
187 record_delete (b, beg, length);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
188 record_insert (b, beg, length);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
189 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
190
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
191 /* Record that an EXTENT is about to be attached or detached in its buffer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
192 This works much like a deletion or insertion, except that there's no string.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
193 The tricky part is that the buffer we operate on comes from EXTENT.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
194 Most extent changes happen as a side effect of string insertion and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
195 deletion; this call is solely for Fdetach_extent() and Finsert_extent().
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
196 */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
197 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
198 record_extent (Lisp_Object extent, int attached)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
199 {
167
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
200 Lisp_Object obj = Fextent_object (extent);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
201
167
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
202 if (BUFFERP (obj))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
203 {
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
204 Lisp_Object token;
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
205 struct buffer *b = XBUFFER (obj);
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
206 if (!undo_prelude (b, 1))
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
207 return;
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
208 if (attached)
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
209 token = extent;
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
210 else
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
211 token = list3 (extent, Fextent_start_position (extent),
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
212 Fextent_end_position (extent));
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
213 b->undo_list = Fcons (token, b->undo_list);
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
214 }
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
215 else
167
85ec50267440 Import from CVS: tag r20-3b10
cvs
parents: 70
diff changeset
216 return;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
217 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
218
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
219 #if 0 /* FSFmacs */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
220 /* Record a change in property PROP (whose old value was VAL)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
221 for LENGTH characters starting at position BEG in BUFFER. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
222
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
223 record_property_change (Bufpos beg, Charcount length,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
224 Lisp_Object prop, Lisp_Object value,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
225 Lisp_Object buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
226 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
227 Lisp_Object lbeg, lend, entry;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
228 struct buffer *b = XBUFFER (buffer);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
229
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
230 if (!undo_prelude (b, 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
231 return;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
232
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
233 lbeg = make_int (beg);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
234 lend = make_int (beg + length);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
235 entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend))));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
236 b->undo_list = Fcons (entry, b->undo_list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
237 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
238 #endif /* FSFmacs */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
239
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
240
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
241 DEFUN ("undo-boundary", Fundo_boundary, 0, 0, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
242 Mark a boundary between units of undo.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
243 An undo command will stop at this point,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
244 but another undo command will undo to the previous boundary.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
245 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
246 ())
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
247 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
248 if (EQ (current_buffer->undo_list, Qt))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
249 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
250 undo_boundary (current_buffer);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
251 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
252 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
253
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
254 /* At garbage collection time, make an undo list shorter at the end,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
255 returning the truncated list.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
256 MINSIZE and MAXSIZE are the limits on size allowed, as described below.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
257 In practice, these are the values of undo-threshold and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
258 undo-high-threshold. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
259
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
260 Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
261 truncate_undo_list (Lisp_Object list, int minsize, int maxsize)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
262 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
263 Lisp_Object prev, next, last_boundary;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
264 int size_so_far = 0;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
265
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
266 if (!(minsize > 0 || maxsize > 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
267 return list;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
268
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
269 prev = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
270 next = list;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
271 last_boundary = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
272
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
273 if (!CONSP (list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
274 return (list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
275
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
276 /* Always preserve at least the most recent undo record.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
277 If the first element is an undo boundary, skip past it. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
278 if (CONSP (next)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
279 && NILP (XCAR (next)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
280 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
281 /* Add in the space occupied by this element and its chain link. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
282 size_so_far += sizeof (struct Lisp_Cons);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
283
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
284 /* Advance to next element. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
285 prev = next;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
286 next = XCDR (next);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
287 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
288 while (CONSP (next)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
289 && !NILP (XCAR (next)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
290 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
291 Lisp_Object elt;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
292 elt = XCAR (next);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
293
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
294 /* Add in the space occupied by this element and its chain link. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
295 size_so_far += sizeof (struct Lisp_Cons);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
296 if (CONSP (elt))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
297 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
298 size_so_far += sizeof (struct Lisp_Cons);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
299 if (STRINGP (XCAR (elt)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
300 size_so_far += (sizeof (struct Lisp_String) - 1
16
0293115a14e9 Import from CVS: tag r19-15b91
cvs
parents: 0
diff changeset
301 + XSTRING_LENGTH (XCAR (elt)));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
302 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
303
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
304 /* Advance to next element. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
305 prev = next;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
306 next = XCDR (next);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
307 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
308 if (CONSP (next))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
309 last_boundary = prev;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
310
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
311 while (CONSP (next))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
312 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
313 Lisp_Object elt;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
314 elt = XCAR (next);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
315
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
316 /* When we get to a boundary, decide whether to truncate
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
317 either before or after it. The lower threshold, MINSIZE,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
318 tells us to truncate after it. If its size pushes past
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
319 the higher threshold MAXSIZE as well, we truncate before it. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
320 if (NILP (elt))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
321 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
322 if (size_so_far > maxsize && maxsize > 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
323 break;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
324 last_boundary = prev;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
325 if (size_so_far > minsize && minsize > 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
326 break;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
327 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
328
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
329 /* Add in the space occupied by this element and its chain link. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
330 size_so_far += sizeof (struct Lisp_Cons);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
331 if (CONSP (elt))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
332 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
333 size_so_far += sizeof (struct Lisp_Cons);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
334 if (STRINGP (XCAR (elt)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
335 size_so_far += (sizeof (struct Lisp_String) - 1
16
0293115a14e9 Import from CVS: tag r19-15b91
cvs
parents: 0
diff changeset
336 + XSTRING_LENGTH (XCAR (elt)));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
337 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
338
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
339 /* Advance to next element. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
340 prev = next;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
341 next = XCDR (next);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
342 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
343
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
344 /* If we scanned the whole list, it is short enough; don't change it. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
345 if (NILP (next))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
346 return list;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
347
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
348 /* Truncate at the boundary where we decided to truncate. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
349 if (!NILP (last_boundary))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
350 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
351 XCDR (last_boundary) = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
352 return list;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
353 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
354 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
355 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
356 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
357
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
358 DEFUN ("primitive-undo", Fprimitive_undo, 2, 2, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
359 Undo COUNT records from the front of the list LIST.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
360 Return what remains of the list.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
361 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
362 (count, list))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
363 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
364 struct gcpro gcpro1, gcpro2;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
365 Lisp_Object next = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
366 /* This function can GC */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
367 int arg;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
368 int speccount = specpdl_depth ();
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
369
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
370 record_unwind_protect (restore_inside_undo, make_int (inside_undo));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
371 inside_undo = 1;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
372
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
373 #if 0 /* This is a good feature, but would make undo-start
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
374 unable to do what is expected. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
375 Lisp_Object tem;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
376
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
377 /* If the head of the list is a boundary, it is the boundary
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
378 preceding this command. Get rid of it and don't count it. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
379 tem = Fcar (list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
380 if (NILP (tem))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
381 list = Fcdr (list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
382 #endif
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
383
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
384 CHECK_INT (count);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
385 arg = XINT (count);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
386 next = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
387 GCPRO2 (next, list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
388
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
389 /* Don't let read-only properties interfere with undo. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
390 if (NILP (current_buffer->read_only))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
391 specbind (Qinhibit_read_only, Qt);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
392
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
393 while (arg > 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
394 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
395 while (1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
396 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
397 if (NILP (list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
398 break;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
399 else if (!CONSP (list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
400 goto rotten;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
401 next = XCAR (list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
402 list = XCDR (list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
403 /* Exit inner loop at undo boundary. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
404 if (NILP (next))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
405 break;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
406 /* Handle an integer by setting point to that value. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
407 else if (INTP (next))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
408 BUF_SET_PT (current_buffer,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
409 bufpos_clip_to_bounds (BUF_BEGV (current_buffer),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
410 XINT (next),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
411 BUF_ZV (current_buffer)));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
412 else if (CONSP (next))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
413 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
414 Lisp_Object car = XCAR (next);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
415 Lisp_Object cdr = XCDR (next);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
416
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
417 if (EQ (car, Qt))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
418 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
419 /* Element (t high . low) records previous modtime. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
420 Lisp_Object high, low;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
421 int mod_time;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
422 if (!CONSP (cdr)) goto rotten;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
423 high = XCAR (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
424 low = XCDR (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
425 if (!INTP (high) || !INTP (low)) goto rotten;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
426 mod_time = (XINT (high) << 16) + XINT (low);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
427 /* If this records an obsolete save
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
428 (not matching the actual disk file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
429 then don't mark unmodified. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
430 if (mod_time != current_buffer->modtime)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
431 break;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
432 #ifdef CLASH_DETECTION
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
433 Funlock_buffer ();
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
434 #endif /* CLASH_DETECTION */
223
2c611d1463a6 Import from CVS: tag r20-4b10
cvs
parents: 217
diff changeset
435 /* may GC under ENERGIZE: */
2c611d1463a6 Import from CVS: tag r20-4b10
cvs
parents: 217
diff changeset
436 Fset_buffer_modified_p (Qnil, Qnil);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
437 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
438 else if (EXTENTP (car))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
439 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
440 /* Element (extent start end) means that EXTENT was
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
441 detached, and we need to reattach it. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
442 Lisp_Object extent_obj, start, end;
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 167
diff changeset
443
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
444 extent_obj = car;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
445 start = Fcar (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
446 end = Fcar (Fcdr (cdr));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
447
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
448 if (!INTP (start) || !INTP (end))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
449 goto rotten;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
450 Fset_extent_endpoints (extent_obj, start, end,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
451 Fcurrent_buffer ());
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
452 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
453 #if 0 /* FSFmacs */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
454 else if (EQ (car, Qnil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
455 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
456 /* Element (nil prop val beg . end) is property change. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
457 Lisp_Object beg, end, prop, val;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
458
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
459 prop = Fcar (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
460 cdr = Fcdr (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
461 val = Fcar (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
462 cdr = Fcdr (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
463 beg = Fcar (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
464 end = Fcdr (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
465
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
466 Fput_text_property (beg, end, prop, val, Qnil);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
467 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
468 #endif /* FSFmacs */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
469 else if (INTP (car) && INTP (cdr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
470 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
471 /* Element (BEG . END) means range was inserted. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
472
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
473 if (XINT (car) < BUF_BEGV (current_buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
474 || XINT (cdr) > BUF_ZV (current_buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
475 error ("Changes to be undone are outside visible portion of buffer");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
476 /* Set point first thing, so that undoing this undo
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
477 does not send point back to where it is now. */
223
2c611d1463a6 Import from CVS: tag r20-4b10
cvs
parents: 217
diff changeset
478 Fgoto_char (car, Qnil);
2c611d1463a6 Import from CVS: tag r20-4b10
cvs
parents: 217
diff changeset
479 Fdelete_region (car, cdr, Qnil);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
480 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
481 else if (STRINGP (car) && INTP (cdr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
482 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
483 /* Element (STRING . POS) means STRING was deleted. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
484 Lisp_Object membuf = car;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
485 int pos = XINT (cdr);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
486
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
487 if (pos < 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
488 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
489 if (-pos < BUF_BEGV (current_buffer) || -pos > BUF_ZV (current_buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
490 error ("Changes to be undone are outside visible portion of buffer");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
491 BUF_SET_PT (current_buffer, -pos);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
492 Finsert (1, &membuf);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
493 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
494 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
495 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
496 if (pos < BUF_BEGV (current_buffer) || pos > BUF_ZV (current_buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
497 error ("Changes to be undone are outside visible portion of buffer");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
498 BUF_SET_PT (current_buffer, pos);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
499
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
500 /* Insert before markers so that if the mark is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
501 currently on the boundary of this deletion, it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
502 ends up on the other side of the now-undeleted
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
503 text from point. Since undo doesn't even keep
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
504 track of the mark, this isn't really necessary,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
505 but it may lead to better behavior in certain
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
506 situations.
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 167
diff changeset
507
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
508 I'm doubtful that this is safe; you could mess
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
509 up the process-output mark in shell buffers, so
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
510 until I hear a compelling reason for this change,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
511 I'm leaving it out. -jwz
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
512 */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
513 /* Finsert_before_markers (1, &membuf); */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
514 Finsert (1, &membuf);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
515 BUF_SET_PT (current_buffer, pos);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
516 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
517 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
518 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
519 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
520 goto rotten;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
521 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
522 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
523 else if (EXTENTP (next))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
524 Fdetach_extent (next);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
525 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
526 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
527 rotten:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
528 signal_simple_continuable_error
284
558f606b08ae Import from CVS: tag r21-0b40
cvs
parents: 223
diff changeset
529 ("Something rotten in the state of undo", next);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
530 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
531 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
532 arg--;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
533 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
534
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
535 UNGCPRO;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
536 return unbind_to (speccount, list);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
537 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
538
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
539 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
540 syms_of_undo (void)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
541 {
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
542 DEFSUBR (Fprimitive_undo);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
543 DEFSUBR (Fundo_boundary);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
544 defsymbol (&Qinhibit_read_only, "inhibit-read-only");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
545 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
546
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
547 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
548 vars_of_undo (void)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
549 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
550 inside_undo = 0;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
551 pending_boundary = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
552 staticpro (&pending_boundary);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
553 last_undo_buffer = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
554 staticpro (&last_undo_buffer);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
555 }