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