From: Richard M. Stallman Date: Sat, 14 Mar 1998 08:19:27 +0000 (+0000) Subject: Implement selective undo (by Paul Flinders). X-Git-Tag: emacs-20.3~1899 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=65627aad683a648e510b5dd204f6b18086b99054;p=emacs.git 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. --- diff --git a/lisp/simple.el b/lisp/simple.el index 62a6ea2e877..be60e3c8f73 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -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)))))