]> git.eshelyaron.com Git - emacs.git/commitdiff
Implement selective undo (by Paul Flinders).
authorRichard M. Stallman <rms@gnu.org>
Sat, 14 Mar 1998 08:19:27 +0000 (08:19 +0000)
committerRichard M. Stallman <rms@gnu.org>
Sat, 14 Mar 1998 08:19:27 +0000 (08:19 +0000)
(undo-copy-list, undo-copy-list-1): New functions.
(undo-make-selective-list, undo-delta): New functions.
(undo-elt-in-region, undo-elt-crosses-region): New functions.
(undo-adjusted-markers): New defvar.
(undo-start): New args BEG and END.
(undo): If arg or active region, pass args to undo-start.

lisp/simple.el

index 62a6ea2e87768c07deee57b6b7d6086a13f560de..be60e3c8f73bc2022a64df773888a69306a123a2 100644 (file)
@@ -797,8 +797,12 @@ Get previous element of history which is a completion of minibuffer contents."
 (defun undo (&optional arg)
   "Undo some previous changes.
 Repeat this command to undo more changes.
-A numeric argument serves as a repeat count."
-  (interactive "*p")
+A numeric argument serves as a repeat count.
+
+Just C-u as argument requests selective undo,
+limited to changes within the current region.
+Likewise in Transient Mark mode when the mark is active."
+  (interactive "*P")
   ;; If we don't get all the way thru, make last-command indicate that
   ;; for the following command.
   (setq this-command t)
@@ -807,9 +811,11 @@ A numeric argument serves as a repeat count."
     (or (eq (selected-window) (minibuffer-window))
        (message "Undo!"))
     (or (eq last-command 'undo)
-       (progn (undo-start)
+       (progn (if (or arg (and transient-mark-mode mark-active))
+                  (undo-start (region-beginning) (region-end))
+                (undo-start))
               (undo-more 1)))
-    (undo-more (or arg 1))
+    (undo-more (if arg (prefix-numeric-value arg) 1))
     ;; Don't specify a position in the undo record for the undo command.
     ;; Instead, undoing this should move point to where the change is.
     (let ((tail buffer-undo-list)
@@ -828,13 +834,6 @@ A numeric argument serves as a repeat count."
 (defvar pending-undo-list nil
   "Within a run of consecutive undo commands, list remaining to be undone.")
 
-(defun undo-start ()
-  "Set `pending-undo-list' to the front of the undo list.
-The next call to `undo-more' will undo the most recently made change."
-  (if (eq buffer-undo-list t)
-      (error "No undo information in this buffer"))
-  (setq pending-undo-list buffer-undo-list))
-
 (defun undo-more (count)
   "Undo back N undo-boundaries beyond what was already undone recently.
 Call `undo-start' to get ready to undo recent changes,
@@ -843,6 +842,168 @@ then call `undo-more' one or more times to undo them."
       (error "No further undo information"))
   (setq pending-undo-list (primitive-undo count pending-undo-list)))
 
+;; Deep copy of a list
+(defun undo-copy-list (list)
+  "Make a copy of undo list LIST."
+  (mapcar 'undo-copy-list-1 list))
+
+(defun undo-copy-list-1 (elt)
+  (if (consp elt)
+      (cons (car elt) (undo-copy-list-1 (cdr elt)))
+    elt))
+
+(defun undo-start (&optional beg end)
+  "Set `pending-undo-list' to the front of the undo list.
+The next call to `undo-more' will undo the most recently made change.
+If BEG and END are specified, then only undo elements
+that apply to text between BEG and END are used; other undo elements
+are ignored.  If BEG and END are nil, all undo elements are used."
+  (if (eq buffer-undo-list t)
+      (error "No undo information in this buffer"))
+  (setq pending-undo-list 
+       (if (and beg end (not (= beg end)))
+           (undo-make-selective-list (min beg end) (max beg end))
+         buffer-undo-list)))
+
+(defvar undo-adjusted-markers)
+
+(defun undo-make-selective-list (start end)
+  "Return a list of undo elements for the region START to END.
+The elements come from `buffer-undo-list', but we keep only
+the elements inside this region, and discard those outside this region.
+If we find an element that crosses an edge of this region,
+we stop and ignore all further elements."
+  (let ((undo-list-copy (undo-copy-list buffer-undo-list))
+       (undo-list (list nil))
+       undo-adjusted-markers
+       some-rejected
+       undo-elt undo-elt temp-undo-list delta)
+    (while undo-list-copy
+      (setq undo-elt (car undo-list-copy))
+      (let ((keep-this
+            (cond ((and (consp undo-elt) (eq (car undo-elt) t))
+                   ;; This is a "was unmodified" element.
+                   ;; Keep it if we have kept everything thus far.
+                   (not some-rejected))
+                  (t
+                   (undo-elt-in-region undo-elt start end)))))
+       (if keep-this
+           (progn
+             (setq end (+ end (cdr (undo-delta undo-elt))))
+             ;; Don't put two nils together in the list
+             (if (not (and (eq (car undo-list) nil)
+                           (eq undo-elt nil)))
+                 (setq undo-list (cons undo-elt undo-list))))
+         (if (undo-elt-crosses-region undo-elt start end)
+             (setq undo-list-copy nil)
+           (setq some-rejected t)
+           (setq temp-undo-list (cdr undo-list-copy))
+           (setq delta (undo-delta undo-elt))
+
+           (when (/= (cdr delta) 0)
+             (let ((position (car delta))
+                   (offset (cdr delta)))
+
+               ;; Loop down the earlier events adjusting their buffer positions
+               ;; to reflect the fact that a change to the buffer isn't being
+               ;; undone. We only need to process those element types which
+               ;; undo-elt-in-region will return as being in the region since
+               ;; only those types can ever get into the output
+
+               (while temp-undo-list
+                 (setq undo-elt (car temp-undo-list))
+                 (cond ((integerp undo-elt)
+                        (if (>= undo-elt position)
+                            (setcar temp-undo-list (- undo-elt offset))))
+                       ((atom undo-elt) nil)
+                       ((stringp (car undo-elt))
+                        ;; (TEXT . POSITION)
+                        (let ((text-pos (abs (cdr undo-elt)))
+                              (point-at-end (< (cdr undo-elt) 0 )))
+                          (if (>= text-pos position)
+                              (setcdr undo-elt (* (if point-at-end -1 1) 
+                                                  (- text-pos offset))))))
+                       ((integerp (car undo-elt))
+                        ;; (BEGIN . END)
+                        (when (>= (car undo-elt) position)
+                          (setcar undo-elt (- (car undo-elt) offset))
+                          (setcdr undo-elt (- (cdr undo-elt) offset))))
+                       ((null (car undo-elt))
+                        ;; (nil PROPERTY VALUE BEG . END)
+                        (let ((tail (nthcdr 3 undo-elt)))
+                          (when (>= (car tail) position)
+                            (setcar tail (- (car tail) offset))
+                            (setcdr tail (- (cdr tail) offset))))))
+                 (setq temp-undo-list (cdr temp-undo-list))))))))
+      (setq undo-list-copy (cdr undo-list-copy)))
+    (nreverse undo-list)))
+
+(defun undo-elt-in-region (undo-elt start end)
+  "Determine whether UNDO-ELT falls inside the region START ... END.
+If it crosses the edge, we return nil."
+  (cond ((integerp undo-elt)
+        (and (>= undo-elt start)
+             (<  undo-elt end)))
+       ((eq undo-elt nil)
+        t)
+       ((atom undo-elt)
+        nil)
+       ((stringp (car undo-elt))
+        ;; (TEXT . POSITION)
+        (and (>= (abs (cdr undo-elt)) start)
+             (< (abs (cdr undo-elt)) end)))
+       ((and (consp undo-elt) (markerp (car undo-elt)))
+        ;; This is a marker-adjustment element (MARKER . ADJUSTMENT).
+        ;; See if MARKER is inside the region.
+        (let ((alist-elt (assq (car undo-elt) undo-adjusted-markers)))
+          (unless alist-elt
+            (setq alist-elt (cons (car undo-elt)
+                                  (marker-position (car undo-elt))))
+            (setq undo-adjusted-markers
+                  (cons alist-elt undo-adjusted-markers)))
+          (and (cdr alist-elt)
+               (>= (cdr alist-elt) start)
+               (< (cdr alist-elt) end))))
+       ((null (car undo-elt))
+        ;; (nil PROPERTY VALUE BEG . END)
+        (let ((tail (nthcdr 3 undo-elt)))
+          (and (>= (car tail) start)
+               (< (cdr tail) end))))
+       ((integerp (car undo-elt))
+        ;; (BEGIN . END)
+        (and (>= (car undo-elt) start)
+             (< (cdr undo-elt) end)))))
+
+(defun undo-elt-crosses-region (undo-elt start end)
+  "Test whether UNDO-ELT crosses one edge of that region START ... END.
+This assumes we have already decided that UNDO-ELT
+is not *inside* the region START...END."
+  (cond ((atom undo-elt) nil)
+       ((null (car undo-elt))
+        ;; (nil PROPERTY VALUE BEG . END)
+        (let ((tail (nthcdr 3 undo-elt)))
+          (not (or (< (car tail) end)
+                   (> (cdr tail) start)))))
+       ((integerp (car undo-elt))
+        ;; (BEGIN . END)
+        (not (or (< (car undo-elt) end)
+                 (> (cdr undo-elt) start))))))
+
+;; Return the first affected buffer position and the delta for an undo element
+;; delta is defined as the change in subsequent buffer positions if we *did*
+;; the undo.
+(defun undo-delta (undo-elt)
+  (if (consp undo-elt)
+      (cond ((stringp (car undo-elt))
+            ;; (TEXT . POSITION)
+            (cons (abs (cdr undo-elt)) (length (car undo-elt))))
+           ((integerp (car undo-elt))
+            ;; (BEGIN . END)
+            (cons (car undo-elt) (- (car undo-elt) (cdr undo-elt))))
+           (t
+            '(0 . 0)))
+    '(0 . 0)))
+\f
 (defvar shell-command-history nil
   "History list for some commands that read shell commands.")
 
@@ -934,7 +1095,7 @@ In either case, the output is inserted after point (leaving mark after it)."
                  ))
            (shell-command-on-region (point) (point) command output-buffer)
            ))))))
-
+\f
 ;; We have a sentinel to prevent insertion of a termination message
 ;; in the buffer itself.
 (defun shell-command-sentinel (process signal)
@@ -1072,7 +1233,7 @@ If it is nil, error output is mingled with regular output."
   (if (and error-file (file-exists-p error-file))
       (save-excursion
        (set-buffer (get-buffer-create error-buffer))
-    ;; Do no formatting while reading error file, for fear of looping.
+       ;; Do no formatting while reading error file, for fear of looping.
        (format-insert-file error-file nil)
        (delete-file error-file)))))