annotate src/undo.c @ 5518:3cc7470ea71c

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