![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to undo.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / src|
Return to undo.c CVS log | Up to [Apple XNU] / GNUtools / emacs / src |
1.1 root 1: /* undo handling for GNU Emacs.
2: Copyright (C) 1990 Free Software Foundation, Inc.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is free software; you can redistribute it and/or modify
7: it under the terms of the GNU General Public License as published by
8: the Free Software Foundation; either version 1, or (at your option)
9: any later version.
10:
11: GNU Emacs is distributed in the hope that it will be useful,
12: but WITHOUT ANY WARRANTY; without even the implied warranty of
13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: GNU General Public License for more details.
15:
16: You should have received a copy of the GNU General Public License
17: along with GNU Emacs; see the file COPYING. If not, write to
18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19:
20:
21: #include "config.h"
22: #include "lisp.h"
23: #include "buffer.h"
24:
25: /* Last buffer for which undo information was recorded. */
26: Lisp_Object last_undo_buffer;
27:
28: /* Record an insertion that just happened or is about to happen,
29: for LENGTH characters at position BEG.
30: (It is possible to record an insertion before or after the fact
31: because we don't need to record the contents.) */
32:
33: record_insert (beg, length)
34: Lisp_Object beg, length;
35: {
36: Lisp_Object lbeg, lend;
37:
38: if (current_buffer != XBUFFER (last_undo_buffer))
39: Fundo_boundary ();
40: XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
41:
42: if (EQ (current_buffer->undo_list, Qt))
43: return;
44: if (MODIFF <= current_buffer->save_modified)
45: record_first_change ();
46:
47: /* If this is following another insertion and consecutive with it
48: in the buffer, combine the two. */
49: if (XTYPE (current_buffer->undo_list) == Lisp_Cons)
50: {
51: Lisp_Object elt;
52: elt = XCONS (current_buffer->undo_list)->car;
53: if (XTYPE (elt) == Lisp_Cons
54: && XTYPE (XCONS (elt)->car) == Lisp_Int
55: && XTYPE (XCONS (elt)->cdr) == Lisp_Int
56: && XINT (XCONS (elt)->cdr) == beg)
57: {
58: XSETINT (XCONS (elt)->cdr, beg + length);
59: return;
60: }
61: }
62:
63: XFASTINT (lbeg) = beg;
64: XFASTINT (lend) = beg + length;
65: current_buffer->undo_list = Fcons (Fcons (lbeg, lend), current_buffer->undo_list);
66: }
67:
68: /* Record that a deletion is about to take place,
69: for LENGTH characters at location BEG. */
70:
71: record_delete (beg, length)
72: int beg, length;
73: {
74: Lisp_Object lbeg, llength, lend, sbeg;
75:
76: if (current_buffer != XBUFFER (last_undo_buffer))
77: Fundo_boundary ();
78: XSET (last_undo_buffer, Lisp_Buffer, current_buffer);
79:
80: if (EQ (current_buffer->undo_list, Qt))
81: return;
82: if (MODIFF <= current_buffer->save_modified)
83: record_first_change ();
84:
85: if (point == beg + length)
86: XSET (sbeg, Lisp_Int, -beg);
87: else
88: XFASTINT (sbeg) = beg;
89: XFASTINT (lbeg) = beg;
90: XFASTINT (llength) = length;
91: XFASTINT (lend) = beg + length;
92: current_buffer->undo_list = Fcons (Fcons (Fbuffer_substring (lbeg, lend), sbeg),
93: current_buffer->undo_list);
94: }
95:
96: /* Record that a replacement is about to take place,
97: for LENGTH characters at location BEG.
98: The replacement does not change the number of characters. */
99:
100: record_change (beg, length)
101: int beg, length;
102: {
103: record_delete (beg, length);
104: record_insert (beg, length);
105: }
106:
107: /* Record that an unmodified buffer is about to be changed.
108: Record the file modification date so that when undoing this entry
109: we can tell whether it is obsolete because the file was saved again. */
110:
111: record_first_change ()
112: {
113: Lisp_Object high, low;
114: XFASTINT (high) = (current_buffer->modtime >> 16) & 0xffff;
115: XFASTINT (low) = current_buffer->modtime & 0xffff;
116: current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list);
117: }
118:
119: DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
120: "Mark a boundary between units of undo.\n\
121: An undo command will stop at this point,\n\
122: but another undo command will undo to the previous boundary.")
123: ()
124: {
125: Lisp_Object tem;
126: if (EQ (current_buffer->undo_list, Qt))
127: return Qnil;
128: tem = Fcar (current_buffer->undo_list);
129: if (!NULL (tem))
130: current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list);
131: return Qnil;
132: }
133:
134: /* At garbage collection time, make an undo list shorter at the end,
135: returning the truncated list.
136: MINSIZE and MAXSIZE are the limits on size allowed, as described below.
137: In practice, these are the values of undo-threshold and
138: undo-high-threshold. */
139:
140: Lisp_Object
141: truncate_undo_list (list, minsize, maxsize)
142: Lisp_Object list;
143: int minsize, maxsize;
144: {
145: Lisp_Object prev, next, save_prev;
146: int size_so_far = 0;
147:
148: prev = Qnil;
149: next = list;
150: save_prev = Qnil;
151:
152: while (XTYPE (next) == Lisp_Cons)
153: {
154: Lisp_Object elt;
155: elt = XCONS (next)->car;
156:
157: /* When we get to a boundary, decide whether to truncate
158: either before or after it. The lower threshold, MINSIZE,
159: tells us to truncate after it. If its size pushes past
160: the higher threshold MAXSIZE as well, we truncate before it. */
161: if (NULL (elt))
162: {
163: if (size_so_far > maxsize)
164: break;
165: save_prev = prev;
166: if (size_so_far > minsize)
167: break;
168: }
169:
170: /* Add in the space occupied by this element and its chain link. */
171: size_so_far += 8;
172: if (XTYPE (elt) == Lisp_Cons)
173: {
174: size_so_far += 8;
175: if (XTYPE (XCONS (elt)->car) == Lisp_String)
176: size_so_far += 6 + XSTRING (XCONS (elt)->car)->size;
177: }
178:
179: /* Advance to next element. */
180: prev = next;
181: next = XCONS (next)->cdr;
182: }
183:
184: /* If we scanned the whole list, it is short enough; don't change it. */
185: if (NULL (next))
186: return list;
187:
188: /* Truncate at the boundary where we decided to truncate. */
189: if (!NULL (save_prev))
190: {
191: XCONS (save_prev)->cdr = Qnil;
192: return list;
193: }
194: else
195: return Qnil;
196: }
197:
198: DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
199: "Undo N records from the front of the list LIST.\n\
200: Return what remains of the list.")
201: (count, list)
202: Lisp_Object count, list;
203: {
204: register int arg = XINT (count);
205: #if 0 /* This is a good feature, but would make undo-start
206: unable to do what is expected. */
207: Lisp_Object tem;
208:
209: /* If the head of the list is a boundary, it is the boundary
210: preceding this command. Get rid of it and don't count it. */
211: tem = Fcar (list);
212: if (NULL (tem))
213: list = Fcdr (list);
214: #endif
215:
216: while (arg > 0)
217: {
218: while (1)
219: {
220: Lisp_Object next, car, cdr;
221: next = Fcar (list);
222: list = Fcdr (list);
223: if (NULL (next))
224: break;
225: car = Fcar (next);
226: cdr = Fcdr (next);
227: if (EQ (car, Qt))
228: {
229: Lisp_Object high, low;
230: int mod_time;
231: high = Fcar (cdr);
232: low = Fcdr (cdr);
233: mod_time = (high << 16) + low;
234: /* If this records an obsolete save
235: (not matching the actual disk file)
236: then don't mark unmodified. */
237: if (mod_time != current_buffer->modtime)
238: break;
239: #ifdef CLASH_DETECTION
240: Funlock_buffer ();
241: #endif /* CLASH_DETECTION */
242: Fset_buffer_modified_p (Qnil);
243: }
244: else if (XTYPE (car) == Lisp_Int && XTYPE (cdr) == Lisp_Int)
245: {
246: Lisp_Object end;
247: if (XINT (car) < BEGV
248: || XINT (cdr) > ZV)
249: error ("Changes to be undone are outside visible portion of buffer");
250: Fdelete_region (car, cdr);
251: Fgoto_char (car);
252: }
253: else if (XTYPE (car) == Lisp_String && XTYPE (cdr) == Lisp_Int)
254: {
255: Lisp_Object membuf;
256: int pos = XINT (cdr);
257: membuf = car;
258: if (pos < 0)
259: {
260: if (-pos < BEGV || -pos > ZV)
261: error ("Changes to be undone are outside visible portion of buffer");
262: SET_PT (-pos);
263: Finsert (1, &membuf);
264: }
265: else
266: {
267: if (pos < BEGV || pos > ZV)
268: error ("Changes to be undone are outside visible portion of buffer");
269: SET_PT (pos);
270: /* The idea here is to leave mark after this text,
271: which will be the desirable thing if undoing C-w. */
272: Finsert_before_markers (1, &membuf);
273: SET_PT (pos);
274: }
275: }
276: }
277: arg--;
278: }
279:
280: return list;
281: }
282:
283: syms_of_undo ()
284: {
285: defsubr (&Sprimitive_undo);
286: defsubr (&Sundo_boundary);
287: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.