[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r111447: * lisp/simple.el (primitive-
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r111447: * lisp/simple.el (primitive-undo): Move from undo.c. |
|
Date: |
Tue, 08 Jan 2013 14:13:31 -0500 |
|
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 111447
author: Aaron S. Hawley <address@hidden>
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2013-01-08 14:13:31 -0500
message:
* lisp/simple.el (primitive-undo): Move from undo.c.
* src/undo.c (Fprimitive_undo): Move to simple.el.
(syms_of_undo): Remove declaration for Sprimitive_undo.
* test/automated/undo-tests.el: New file.
added:
test/automated/undo-tests.el
modified:
lisp/ChangeLog
lisp/simple.el
src/ChangeLog
src/undo.c
test/ChangeLog
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2013-01-08 17:34:35 +0000
+++ b/lisp/ChangeLog 2013-01-08 19:13:31 +0000
@@ -1,3 +1,7 @@
+2013-01-08 Aaron S. Hawley <address@hidden>
+
+ * simple.el (primitive-undo): Move from undo.c.
+
2013-01-08 Stefan Monnier <address@hidden>
* vc/pcvs.el (cvs-cleanup-collection): Extend meaning of `rm-handled'.
=== modified file 'lisp/simple.el'
--- a/lisp/simple.el 2013-01-02 16:13:04 +0000
+++ b/lisp/simple.el 2013-01-08 19:13:31 +0000
@@ -1979,6 +1979,141 @@
(if (null pending-undo-list)
(setq pending-undo-list t))))
+(defun primitive-undo (n list)
+ "Undo N records from the front of the list LIST.
+Return what remains of the list."
+
+ ;; This is a good feature, but would make undo-start
+ ;; unable to do what is expected.
+ ;;(when (null (car (list)))
+ ;; ;; If the head of the list is a boundary, it is the boundary
+ ;; ;; preceding this command. Get rid of it and don't count it.
+ ;; (setq list (cdr list))))
+
+ (let ((arg n)
+ ;; In a writable buffer, enable undoing read-only text that is
+ ;; so because of text properties.
+ (inhibit-read-only t)
+ ;; Don't let `intangible' properties interfere with undo.
+ (inhibit-point-motion-hooks t)
+ ;; We use oldlist only to check for EQ. ++kfs
+ (oldlist buffer-undo-list)
+ (did-apply nil)
+ (next nil))
+ (while (> arg 0)
+ (while (and (consp list)
+ (progn
+ (setq next (car list))
+ (setq list (cdr list))
+ ;; Exit inner loop at undo boundary.
+ (not (null next))))
+ ;; Handle an integer by setting point to that value.
+ (cond
+ ((integerp next) (goto-char next))
+ ((consp next)
+ (let ((car (car next))
+ (cdr (cdr next)))
+ (cond
+ ;; Element (t . TIME) records previous modtime.
+ ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
+ ;; UNKNOWN_MODTIME_NSECS.
+ ((eq t car)
+ ;; If this records an obsolete save
+ ;; (not matching the actual disk file)
+ ;; then don't mark unmodified.
+ (when (or (equal cdr (visited-file-modtime))
+ (and (consp cdr)
+ (equal (list (car cdr) (cdr cdr))
+ (visited-file-modtime))))
+ (when (fboundp 'unlock-buffer)
+ (unlock-buffer))
+ (set-buffer-modified-p nil)))
+ ;; Element (nil PROP VAL BEG . END) is property change.
+ ((eq nil car)
+ (let ((beg (nth 2 cdr))
+ (end (nthcdr 3 cdr))
+ (prop (car cdr))
+ (val (cadr cdr)))
+ (when (or (> (point-min) beg)
+ (< (point-max) end))
+ (error "Changes to be undone are outside visible portion of
buffer"))
+ (put-text-property beg end prop val)))
+ ((and (integerp car) (integerp cdr))
+ ;; Element (BEG . END) means range was inserted.
+ (when (or (< car (point-min))
+ (> cdr (point-max)))
+ (error "Changes to be undone are outside visible portion of
buffer"))
+ ;; Set point first thing, so that undoing this undo
+ ;; does not send point back to where it is now.
+ (goto-char car)
+ (delete-region car cdr))
+ ((eq car 'apply)
+ ;; Element (apply FUN . ARGS) means call FUN to undo.
+ (let ((currbuff (current-buffer))
+ (car (car cdr))
+ (cdr (cdr cdr)))
+ (if (integerp car)
+ ;; Long format: (apply DELTA START END FUN . ARGS).
+ (let* ((delta car)
+ (start (car cdr))
+ (end (cadr cdr))
+ (start-mark (copy-marker start nil))
+ (end-mark (copy-marker end t))
+ (cdr (cddr cdr))
+ (fun (car cdr))
+ (args (cdr cdr)))
+ (apply fun args) ;; Use `save-current-buffer'?
+ ;; Check that the function did what the entry
+ ;; said it would do.
+ (unless (and (eq start
+ (marker-position start-mark))
+ (eq (+ delta end)
+ (marker-position end-mark)))
+ (error "Changes to be undone by function different
than announced"))
+ (set-marker start-mark nil)
+ (set-marker end-mark nil))
+ (apply car cdr))
+ (unless (eq currbuff (current-buffer))
+ (error "Undo function switched buffer"))
+ (setq did-apply t)))
+ ((and (stringp car) (integerp cdr))
+ ;; Element (STRING . POS) means STRING was deleted.
+ (let ((membuf car)
+ (pos cdr))
+ (when (or (< (abs pos) (point-min))
+ (> (abs pos) (point-max)))
+ (error "Changes to be undone are outside visible portion of
buffer"))
+ (if (< pos 0)
+ (progn
+ (goto-char (- pos))
+ (insert membuf))
+ (goto-char pos)
+ ;; Now that we record marker adjustments
+ ;; (caused by deletion) for undo,
+ ;; we should always insert after markers,
+ ;; so that undoing the marker adjustments
+ ;; put the markers back in the right place.
+ (insert membuf)
+ (goto-char pos))))
+ ((and (markerp car) (integerp cdr))
+ ;; (MARKER . INTEGER) means a marker MARKER
+ ;; was adjusted by INTEGER.
+ (when (marker-buffer car)
+ (set-marker car
+ (- (marker-position car) cdr)
+ (marker-buffer car))))
+ (t (error "Unrecognized entry in undo list %S" next)))))
+ (t (error "Unrecognized entry in undo list %S" next))))
+ (setq arg (1- arg)))
+ ;; Make sure an apply entry produces at least one undo entry,
+ ;; so the test in `undo' for continuing an undo series
+ ;; will work right.
+ (if (and did-apply
+ (eq oldlist buffer-undo-list))
+ (setq buffer-undo-list
+ (cons (list 'apply 'cdr nil) buffer-undo-list))))
+ list)
+
;; Deep copy of a list
(defun undo-copy-list (list)
"Make a copy of undo list LIST."
=== modified file 'src/ChangeLog'
--- a/src/ChangeLog 2013-01-08 16:51:11 +0000
+++ b/src/ChangeLog 2013-01-08 19:13:31 +0000
@@ -1,3 +1,8 @@
+2013-01-08 Aaron S. Hawley <address@hidden>
+
+ * undo.c (Fprimitive_undo): Move to simple.el.
+ (syms_of_undo): Remove declarations for Sprimitive_undo.
+
2013-01-08 Stefan Monnier <address@hidden>
* keyboard.c (echo_add_key): Rename from echo_add_char.
=== modified file 'src/undo.c'
--- a/src/undo.c 2013-01-01 09:11:05 +0000
+++ b/src/undo.c 2013-01-08 19:13:31 +0000
@@ -452,217 +452,6 @@
}
-DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0,
- doc: /* Undo N records from the front of the list LIST.
-Return what remains of the list. */)
- (Lisp_Object n, Lisp_Object list)
-{
- struct gcpro gcpro1, gcpro2;
- Lisp_Object next;
- ptrdiff_t count = SPECPDL_INDEX ();
- register EMACS_INT arg;
- Lisp_Object oldlist;
- int did_apply = 0;
-
-#if 0 /* This is a good feature, but would make undo-start
- unable to do what is expected. */
- Lisp_Object tem;
-
- /* If the head of the list is a boundary, it is the boundary
- preceding this command. Get rid of it and don't count it. */
- tem = Fcar (list);
- if (NILP (tem))
- list = Fcdr (list);
-#endif
-
- CHECK_NUMBER (n);
- arg = XINT (n);
- next = Qnil;
- GCPRO2 (next, list);
- /* I don't think we need to gcpro oldlist, as we use it only
- to check for EQ. ++kfs */
-
- /* In a writable buffer, enable undoing read-only text that is so
- because of text properties. */
- if (NILP (BVAR (current_buffer, read_only)))
- specbind (Qinhibit_read_only, Qt);
-
- /* Don't let `intangible' properties interfere with undo. */
- specbind (Qinhibit_point_motion_hooks, Qt);
-
- oldlist = BVAR (current_buffer, undo_list);
-
- while (arg > 0)
- {
- while (CONSP (list))
- {
- next = XCAR (list);
- list = XCDR (list);
- /* Exit inner loop at undo boundary. */
- if (NILP (next))
- break;
- /* Handle an integer by setting point to that value. */
- if (INTEGERP (next))
- SET_PT (clip_to_bounds (BEGV, XINT (next), ZV));
- else if (CONSP (next))
- {
- Lisp_Object car, cdr;
-
- car = XCAR (next);
- cdr = XCDR (next);
- if (EQ (car, Qt))
- {
- /* Element (t . TIME) records previous modtime.
- Preserve any flag of NONEXISTENT_MODTIME_NSECS or
- UNKNOWN_MODTIME_NSECS. */
- struct buffer *base_buffer = current_buffer;
- EMACS_TIME mod_time;
-
- if (CONSP (cdr)
- && CONSP (XCDR (cdr))
- && CONSP (XCDR (XCDR (cdr)))
- && CONSP (XCDR (XCDR (XCDR (cdr))))
- && INTEGERP (XCAR (XCDR (XCDR (XCDR (cdr)))))
- && XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) < 0)
- mod_time =
- (make_emacs_time
- (0, XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) / 1000));
- else
- mod_time = lisp_time_argument (cdr);
-
- if (current_buffer->base_buffer)
- base_buffer = current_buffer->base_buffer;
-
- /* If this records an obsolete save
- (not matching the actual disk file)
- then don't mark unmodified. */
- if (EMACS_TIME_NE (mod_time, base_buffer->modtime))
- continue;
-#ifdef CLASH_DETECTION
- Funlock_buffer ();
-#endif /* CLASH_DETECTION */
- Fset_buffer_modified_p (Qnil);
- }
- else if (EQ (car, Qnil))
- {
- /* Element (nil PROP VAL BEG . END) is property change. */
- Lisp_Object beg, end, prop, val;
-
- prop = Fcar (cdr);
- cdr = Fcdr (cdr);
- val = Fcar (cdr);
- cdr = Fcdr (cdr);
- beg = Fcar (cdr);
- end = Fcdr (cdr);
-
- if (XINT (beg) < BEGV || XINT (end) > ZV)
- user_error ("Changes to be undone are outside visible
portion of buffer");
- Fput_text_property (beg, end, prop, val, Qnil);
- }
- else if (INTEGERP (car) && INTEGERP (cdr))
- {
- /* Element (BEG . END) means range was inserted. */
-
- if (XINT (car) < BEGV
- || XINT (cdr) > ZV)
- user_error ("Changes to be undone are outside visible
portion of buffer");
- /* Set point first thing, so that undoing this undo
- does not send point back to where it is now. */
- Fgoto_char (car);
- Fdelete_region (car, cdr);
- }
- else if (EQ (car, Qapply))
- {
- /* Element (apply FUN . ARGS) means call FUN to undo. */
- struct buffer *save_buffer = current_buffer;
-
- car = Fcar (cdr);
- cdr = Fcdr (cdr);
- if (INTEGERP (car))
- {
- /* Long format: (apply DELTA START END FUN . ARGS). */
- Lisp_Object delta = car;
- Lisp_Object start = Fcar (cdr);
- Lisp_Object end = Fcar (Fcdr (cdr));
- Lisp_Object start_mark = Fcopy_marker (start, Qnil);
- Lisp_Object end_mark = Fcopy_marker (end, Qt);
-
- cdr = Fcdr (Fcdr (cdr));
- apply1 (Fcar (cdr), Fcdr (cdr));
-
- /* Check that the function did what the entry said it
- would do. */
- if (!EQ (start, Fmarker_position (start_mark))
- || (XINT (delta) + XINT (end)
- != marker_position (end_mark)))
- error ("Changes to be undone by function different than
announced");
- Fset_marker (start_mark, Qnil, Qnil);
- Fset_marker (end_mark, Qnil, Qnil);
- }
- else
- apply1 (car, cdr);
-
- if (save_buffer != current_buffer)
- error ("Undo function switched buffer");
- did_apply = 1;
- }
- else if (STRINGP (car) && INTEGERP (cdr))
- {
- /* Element (STRING . POS) means STRING was deleted. */
- Lisp_Object membuf;
- EMACS_INT pos = XINT (cdr);
-
- membuf = car;
- if (pos < 0)
- {
- if (-pos < BEGV || -pos > ZV)
- user_error ("Changes to be undone are outside visible
portion of buffer");
- SET_PT (-pos);
- Finsert (1, &membuf);
- }
- else
- {
- if (pos < BEGV || pos > ZV)
- user_error ("Changes to be undone are outside visible
portion of buffer");
- SET_PT (pos);
-
- /* Now that we record marker adjustments
- (caused by deletion) for undo,
- we should always insert after markers,
- so that undoing the marker adjustments
- put the markers back in the right place. */
- Finsert (1, &membuf);
- SET_PT (pos);
- }
- }
- else if (MARKERP (car) && INTEGERP (cdr))
- {
- /* (MARKER . INTEGER) means a marker MARKER
- was adjusted by INTEGER. */
- if (XMARKER (car)->buffer)
- Fset_marker (car,
- make_number (marker_position (car) - XINT
(cdr)),
- Fmarker_buffer (car));
- }
- }
- }
- arg--;
- }
-
-
- /* Make sure an apply entry produces at least one undo entry,
- so the test in `undo' for continuing an undo series
- will work right. */
- if (did_apply
- && EQ (oldlist, BVAR (current_buffer, undo_list)))
- bset_undo_list
- (current_buffer,
- Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list)));
-
- UNGCPRO;
- return unbind_to (count, list);
-}
-
void
syms_of_undo (void)
{
@@ -675,7 +464,6 @@
last_undo_buffer = NULL;
last_boundary_buffer = NULL;
- defsubr (&Sprimitive_undo);
defsubr (&Sundo_boundary);
DEFVAR_INT ("undo-limit", undo_limit,
=== modified file 'test/ChangeLog'
--- a/test/ChangeLog 2013-01-02 16:13:04 +0000
+++ b/test/ChangeLog 2013-01-08 19:13:31 +0000
@@ -1,3 +1,7 @@
+2013-01-08 Aaron S. Hawley <address@hidden>
+
+ * automated/undo-tests.el: New file.
+
2012-12-27 Dmitry Gutov <address@hidden>
* automated/ruby-mode-tests.el
=== added file 'test/automated/undo-tests.el'
--- a/test/automated/undo-tests.el 1970-01-01 00:00:00 +0000
+++ b/test/automated/undo-tests.el 2013-01-08 19:13:31 +0000
@@ -0,0 +1,231 @@
+;;; undo-tests.el --- Tests of primitive-undo
+
+;; Copyright (C) 2012 Aaron S. Hawley
+
+;; Author: Aaron S. Hawley <address@hidden>
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;; Profiling when the code was translate from C to Lisp on 2012-12-24.
+
+;;; C
+
+;; (elp-instrument-function 'primitive-undo)
+;; (load-file "undo-test.elc")
+;; (benchmark 100 '(let ((undo-test5-error nil)) (undo-test-all)))
+;; Elapsed time: 305.218000s (104.841000s in 14804 GCs)
+;; M-x elp-results
+;; Function Name Call Count Elapsed Time Average Time
+;; primitive-undo 2600 3.4889999999 0.0013419230
+
+;;; Lisp
+
+;; (load-file "primundo.elc")
+;; (elp-instrument-function 'primitive-undo)
+;; (benchmark 100 '(undo-test-all))
+;; Elapsed time: 295.974000s (104.582000s in 14704 GCs)
+;; M-x elp-results
+;; Function Name Call Count Elapsed Time Average Time
+;; primitive-undo 2700 3.6869999999 0.0013655555
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest undo-test0 ()
+ "Test basics of \\[undo]."
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (condition-case err
+ (undo)
+ (error
+ (unless (string= "No further undo information"
+ (cadr err))
+ (error err))))
+ (undo-boundary)
+ (insert "This")
+ (undo-boundary)
+ (erase-buffer)
+ (undo-boundary)
+ (insert "That")
+ (undo-boundary)
+ (forward-word -1)
+ (undo-boundary)
+ (insert "With ")
+ (undo-boundary)
+ (forward-word -1)
+ (undo-boundary)
+ (kill-word 1)
+ (undo-boundary)
+ (put-text-property (point-min) (point-max) 'face 'bold)
+ (undo-boundary)
+ (remove-text-properties (point-min) (point-max) '(face default))
+ (undo-boundary)
+ (set-buffer-multibyte (not enable-multibyte-characters))
+ (undo-boundary)
+ (undo)
+ (should
+ (equal (should-error (undo-more nil))
+ '(wrong-type-argument integerp nil)))
+ (undo-more 7)
+ (should (string-equal "" (buffer-string)))))
+
+(ert-deftest undo-test1 ()
+ "Test undo of \\[undo] command (redo)."
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (undo-boundary)
+ (insert "This")
+ (undo-boundary)
+ (erase-buffer)
+ (undo-boundary)
+ (insert "That")
+ (undo-boundary)
+ (forward-word -1)
+ (undo-boundary)
+ (insert "With ")
+ (undo-boundary)
+ (forward-word -1)
+ (undo-boundary)
+ (kill-word 1)
+ (undo-boundary)
+ (facemenu-add-face 'bold (point-min) (point-max))
+ (undo-boundary)
+ (set-buffer-multibyte (not enable-multibyte-characters))
+ (undo-boundary)
+ (should
+ (string-equal (buffer-string)
+ (progn
+ (undo)
+ (undo-more 4)
+ (undo)
+ ;(undo-more -4)
+ (buffer-string))))))
+
+(ert-deftest undo-test2 ()
+ "Test basic redoing with \\[undo] command."
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (undo-boundary)
+ (insert "One")
+ (undo-boundary)
+ (insert " Zero")
+ (undo-boundary)
+ (push-mark)
+ (delete-region (save-excursion
+ (forward-word -1)
+ (point)) (point))
+ (undo-boundary)
+ (beginning-of-line)
+ (insert "Zero")
+ (undo-boundary)
+ (undo)
+ (should
+ (string-equal (buffer-string)
+ (progn
+ (undo-more 2)
+ (undo)
+ (buffer-string))))))
+
+(ert-deftest undo-test3 ()
+ "Test modtime with \\[undo] command."
+ (let ((tmpfile (make-temp-file "undo-test3")))
+ (with-temp-file tmpfile
+ (let ((buffer-file-name tmpfile))
+ (buffer-enable-undo)
+ (set (make-local-variable 'make-backup-files) nil)
+ (undo-boundary)
+ (insert ?\s)
+ (undo-boundary)
+ (basic-save-buffer)
+ (insert ?\t)
+ (undo)
+ (should
+ (string-equal (buffer-string)
+ (progn
+ (undo)
+ (buffer-string)))))
+ (delete-file tmpfile))))
+
+(ert-deftest undo-test4 ()
+ "Test \\[undo] of \\[flush-lines]."
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (dotimes (i 1048576)
+ (if (zerop (% i 2))
+ (insert "Evenses")
+ (insert "Oddses")))
+ (undo-boundary)
+ (should
+ ;; Avoid string-equal because ERT will save the `buffer-string'
+ ;; to the explanation. Using `not' will record nil or non-nil.
+ (not
+ (null
+ (string-equal (buffer-string)
+ (progn
+ (flush-lines "oddses" (point-min) (point-max))
+ (undo-boundary)
+ (undo)
+ (undo)
+ (buffer-string))))))))
+
+(ert-deftest undo-test5 ()
+ "Test basic redoing with \\[undo] command."
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (undo-boundary)
+ (insert "AYE")
+ (undo-boundary)
+ (insert " BEE")
+ (undo-boundary)
+ (setq buffer-undo-list (cons '(0.0 bogus) buffer-undo-list))
+ (push-mark)
+ (delete-region (save-excursion
+ (forward-word -1)
+ (point)) (point))
+ (undo-boundary)
+ (beginning-of-line)
+ (insert "CEE")
+ (undo-boundary)
+ (undo)
+ (setq buffer-undo-list (cons "bogus" buffer-undo-list))
+ (should
+ (string-equal
+ (buffer-string)
+ (progn
+ (if (and (boundp 'undo-test5-error) (not undo-test5-error))
+ (progn
+ (should (null (undo-more 2)))
+ (should (undo)))
+ ;; Errors are generated by new Lisp version of
+ ;; `primitive-undo' not by built-in C version.
+ (should
+ (equal (should-error (undo-more 2))
+ '(error "Unrecognized entry in undo list (0.0 bogus)")))
+ (should
+ (equal (should-error (undo))
+ '(error "Unrecognized entry in undo list \"bogus\""))))
+ (buffer-string))))))
+
+(defun undo-test-all (&optional interactive)
+ "Run all tests for \\[undo]."
+ (interactive "p")
+ (if interactive
+ (ert-run-tests-interactively "^undo-")
+ (ert-run-tests-batch "^undo-")))
+
+(provide 'undo-tests)
+;;; undo-tests.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r111447: * lisp/simple.el (primitive-undo): Move from undo.c.,
Stefan Monnier <=