aboutsummaryrefslogtreecommitdiffstats
path: root/src/undo.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/undo.c')
-rw-r--r--src/undo.c215
1 files changed, 2 insertions, 213 deletions
diff --git a/src/undo.c b/src/undo.c
index e878ef4dcf9..63edc8e9b8d 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -1,5 +1,6 @@
1/* undo handling for GNU Emacs. 1/* undo handling for GNU Emacs.
2 Copyright (C) 1990, 1993-1994, 2000-2012 Free Software Foundation, Inc. 2 Copyright (C) 1990, 1993-1994, 2000-2013 Free Software Foundation,
3 Inc.
3 4
4This file is part of GNU Emacs. 5This file is part of GNU Emacs.
5 6
@@ -451,217 +452,6 @@ user_error (const char *msg)
451} 452}
452 453
453 454
454DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
455 doc: /* Undo N records from the front of the list LIST.
456Return what remains of the list. */)
457 (Lisp_Object n, Lisp_Object list)
458{
459 struct gcpro gcpro1, gcpro2;
460 Lisp_Object next;
461 ptrdiff_t count = SPECPDL_INDEX ();
462 register EMACS_INT arg;
463 Lisp_Object oldlist;
464 int did_apply = 0;
465
466#if 0 /* This is a good feature, but would make undo-start
467 unable to do what is expected. */
468 Lisp_Object tem;
469
470 /* If the head of the list is a boundary, it is the boundary
471 preceding this command. Get rid of it and don't count it. */
472 tem = Fcar (list);
473 if (NILP (tem))
474 list = Fcdr (list);
475#endif
476
477 CHECK_NUMBER (n);
478 arg = XINT (n);
479 next = Qnil;
480 GCPRO2 (next, list);
481 /* I don't think we need to gcpro oldlist, as we use it only
482 to check for EQ. ++kfs */
483
484 /* In a writable buffer, enable undoing read-only text that is so
485 because of text properties. */
486 if (NILP (BVAR (current_buffer, read_only)))
487 specbind (Qinhibit_read_only, Qt);
488
489 /* Don't let `intangible' properties interfere with undo. */
490 specbind (Qinhibit_point_motion_hooks, Qt);
491
492 oldlist = BVAR (current_buffer, undo_list);
493
494 while (arg > 0)
495 {
496 while (CONSP (list))
497 {
498 next = XCAR (list);
499 list = XCDR (list);
500 /* Exit inner loop at undo boundary. */
501 if (NILP (next))
502 break;
503 /* Handle an integer by setting point to that value. */
504 if (INTEGERP (next))
505 SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
506 else if (CONSP (next))
507 {
508 Lisp_Object car, cdr;
509
510 car = XCAR (next);
511 cdr = XCDR (next);
512 if (EQ (car, Qt))
513 {
514 /* Element (t . TIME) records previous modtime.
515 Preserve any flag of NONEXISTENT_MODTIME_NSECS or
516 UNKNOWN_MODTIME_NSECS. */
517 struct buffer *base_buffer = current_buffer;
518 EMACS_TIME mod_time;
519
520 if (CONSP (cdr)
521 && CONSP (XCDR (cdr))
522 && CONSP (XCDR (XCDR (cdr)))
523 && CONSP (XCDR (XCDR (XCDR (cdr))))
524 && INTEGERP (XCAR (XCDR (XCDR (XCDR (cdr)))))
525 && XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) < 0)
526 mod_time =
527 (make_emacs_time
528 (0, XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) / 1000));
529 else
530 mod_time = lisp_time_argument (cdr);
531
532 if (current_buffer->base_buffer)
533 base_buffer = current_buffer->base_buffer;
534
535 /* If this records an obsolete save
536 (not matching the actual disk file)
537 then don't mark unmodified. */
538 if (EMACS_TIME_NE (mod_time, base_buffer->modtime))
539 continue;
540#ifdef CLASH_DETECTION
541 Funlock_buffer ();
542#endif /* CLASH_DETECTION */
543 Fset_buffer_modified_p (Qnil);
544 }
545 else if (EQ (car, Qnil))
546 {
547 /* Element (nil PROP VAL BEG . END) is property change. */
548 Lisp_Object beg, end, prop, val;
549
550 prop = Fcar (cdr);
551 cdr = Fcdr (cdr);
552 val = Fcar (cdr);
553 cdr = Fcdr (cdr);
554 beg = Fcar (cdr);
555 end = Fcdr (cdr);
556
557 if (XINT (beg) < BEGV || XINT (end) > ZV)
558 user_error ("Changes to be undone are outside visible portion of buffer");
559 Fput_text_property (beg, end, prop, val, Qnil);
560 }
561 else if (INTEGERP (car) && INTEGERP (cdr))
562 {
563 /* Element (BEG . END) means range was inserted. */
564
565 if (XINT (car) < BEGV
566 || XINT (cdr) > ZV)
567 user_error ("Changes to be undone are outside visible portion of buffer");
568 /* Set point first thing, so that undoing this undo
569 does not send point back to where it is now. */
570 Fgoto_char (car);
571 Fdelete_region (car, cdr);
572 }
573 else if (EQ (car, Qapply))
574 {
575 /* Element (apply FUN . ARGS) means call FUN to undo. */
576 struct buffer *save_buffer = current_buffer;
577
578 car = Fcar (cdr);
579 cdr = Fcdr (cdr);
580 if (INTEGERP (car))
581 {
582 /* Long format: (apply DELTA START END FUN . ARGS). */
583 Lisp_Object delta = car;
584 Lisp_Object start = Fcar (cdr);
585 Lisp_Object end = Fcar (Fcdr (cdr));
586 Lisp_Object start_mark = Fcopy_marker (start, Qnil);
587 Lisp_Object end_mark = Fcopy_marker (end, Qt);
588
589 cdr = Fcdr (Fcdr (cdr));
590 apply1 (Fcar (cdr), Fcdr (cdr));
591
592 /* Check that the function did what the entry said it
593 would do. */
594 if (!EQ (start, Fmarker_position (start_mark))
595 || (XINT (delta) + XINT (end)
596 != marker_position (end_mark)))
597 error ("Changes to be undone by function different than announced");
598 Fset_marker (start_mark, Qnil, Qnil);
599 Fset_marker (end_mark, Qnil, Qnil);
600 }
601 else
602 apply1 (car, cdr);
603
604 if (save_buffer != current_buffer)
605 error ("Undo function switched buffer");
606 did_apply = 1;
607 }
608 else if (STRINGP (car) && INTEGERP (cdr))
609 {
610 /* Element (STRING . POS) means STRING was deleted. */
611 Lisp_Object membuf;
612 EMACS_INT pos = XINT (cdr);
613
614 membuf = car;
615 if (pos < 0)
616 {
617 if (-pos < BEGV || -pos > ZV)
618 user_error ("Changes to be undone are outside visible portion of buffer");
619 SET_PT (-pos);
620 Finsert (1, &membuf);
621 }
622 else
623 {
624 if (pos < BEGV || pos > ZV)
625 user_error ("Changes to be undone are outside visible portion of buffer");
626 SET_PT (pos);
627
628 /* Now that we record marker adjustments
629 (caused by deletion) for undo,
630 we should always insert after markers,
631 so that undoing the marker adjustments
632 put the markers back in the right place. */
633 Finsert (1, &membuf);
634 SET_PT (pos);
635 }
636 }
637 else if (MARKERP (car) && INTEGERP (cdr))
638 {
639 /* (MARKER . INTEGER) means a marker MARKER
640 was adjusted by INTEGER. */
641 if (XMARKER (car)->buffer)
642 Fset_marker (car,
643 make_number (marker_position (car) - XINT (cdr)),
644 Fmarker_buffer (car));
645 }
646 }
647 }
648 arg--;
649 }
650
651
652 /* Make sure an apply entry produces at least one undo entry,
653 so the test in `undo' for continuing an undo series
654 will work right. */
655 if (did_apply
656 && EQ (oldlist, BVAR (current_buffer, undo_list)))
657 bset_undo_list
658 (current_buffer,
659 Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list)));
660
661 UNGCPRO;
662 return unbind_to (count, list);
663}
664
665void 455void
666syms_of_undo (void) 456syms_of_undo (void)
667{ 457{
@@ -674,7 +464,6 @@ syms_of_undo (void)
674 last_undo_buffer = NULL; 464 last_undo_buffer = NULL;
675 last_boundary_buffer = NULL; 465 last_boundary_buffer = NULL;
676 466
677 defsubr (&Sprimitive_undo);
678 defsubr (&Sundo_boundary); 467 defsubr (&Sundo_boundary);
679 468
680 DEFVAR_INT ("undo-limit", undo_limit, 469 DEFVAR_INT ("undo-limit", undo_limit,
generated by cgit v1.2.1 (git 2.18.0) at 2026-04-12 16:53:30 +0000