Commit 65627aad authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

Implement selective undo (by Paul Flinders).

(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.
parent 5cfee3ac
......@@ -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)))
(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)
))))))
;; 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)))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment