+(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