annotate src/undo.c @ 3319:2f13ae1532db

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