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