branch: scratch/proof-general
commit 27d91f58ac41de6e995f8ced9b7d6e6f5fcbda33
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Commit: Stefan Monnier <monn...@iro.umontreal.ca>
Simplify code of `pg-protected-undo`
The last change made `undo-delta` be used at two places very close
to each other, so consolidate the two calls. Change the test
order since in the case where `(eq last-command 'undo)` we ended up
throwing away the work we'd just done and then returning the
first element without checking that its delta is non-trivial.
* generic/pg-user.el (pg--next-undo-delta): Rename from
`pg--next-undo-elt`. Make it check `last-command` at the beginning
rather than at the end. Make it return the delta rather than the elt.
Don't bother special-casing `nil` and `(nil)`.
(pg-protected-undo-1): Adjust accordingly.
---
generic/pg-user.el | 44 ++++++++++++++++++++++----------------------
1 file changed, 22 insertions(+), 22 deletions(-)
diff --git a/generic/pg-user.el b/generic/pg-user.el
index b47f770cab..e7a088d551 100644
--- a/generic/pg-user.el
+++ b/generic/pg-user.el
@@ -1569,7 +1569,7 @@ removed if it matches the last item in the ring."
;; `buffer-undo-list' in `proof-set-queue-endpoints'.
;;
;; Improved version due to Erik Martin-Dorel. Uses auxiliary
-;; functions `pg-protected-undo-1' and `pg--next-undo-elt'
+;; functions `pg-protected-undo-1' and `pg--next-undo-delta'
;;
(define-key proof-mode-map [remap undo] 'pg-protected-undo)
@@ -1621,7 +1621,7 @@ the locked region."
(defun pg-protected-undo-1 (arg)
"This function is intended to be called by `pg-protected-undo'.
-The flag ARG is passed to functions `undo' and `pg--next-undo-elt'.
+The flag ARG is passed to functions `undo' and `pg--next-undo-delta'.
It should be a non-numeric value saying whether an undo-in-region
behavior is expected."
;; Note that if ARG is non-nil, (> (region-end) (region-beginning)) must hold,
@@ -1630,11 +1630,10 @@ behavior is expected."
(if (or (not proof-locked-span)
(equal (proof-queue-or-locked-end) (point-min))) ; required test
(undo arg)
- (let* ((next (pg--next-undo-elt arg))
- (delta (pg--undo-delta next)) ; can be '(0 . 0) if next is nil
+ (let* ((delta (pg--next-undo-delta arg)) ; can be '(0 . 0).
(beg (car delta))
(end (max beg (- beg (cdr delta))))) ; Key computation
- (when (and next (> beg 0) ; the "next undo elt" exists
+ (when (and (> beg 0) ; the "next undo elt" exists
(> (proof-queue-or-locked-end) beg)
proof-strict-read-only ; edit freely doesn't retract
(not (and ; neither does edit in comments
@@ -1649,24 +1648,25 @@ behavior is expected."
"Cannot undo without retracting to the appropriate position")))
(undo arg))))
-(defun pg--next-undo-elt (arg)
+(defun pg--next-undo-delta (arg)
"Return the undo element that will be processed on next undo/redo.
-Assume the undo-in-region behavior will apply if ARG is non-nil."
- (let ((undo-list (if arg ; handle "undo in region"
- (undo-make-selective-list
- (region-beginning) (region-end)) ; can be '(nil)
- buffer-undo-list))) ; can be nil
- (if (or (null undo-list) (equal undo-list (list nil)))
- nil ; there is clearly no undo elt
- (while (and undo-list ; to ensure it will terminate
- (not (equal '(0 . 0) (pg--undo-delta (car undo-list)))))
- (setq undo-list (cdr undo-list))) ; get the last undo record
- (if (and (eq last-command 'undo)
- (or (eq pending-undo-list t)
- (gethash undo-list undo-equiv-table)))
- ;; then we are within a run of consecutive undo commands
- (if (eq pending-undo-list t) nil (car pending-undo-list))
- (car undo-list)))))
+Assume the `undo-in-region' behavior will apply if ARG is non-nil."
+ (let ((undo-list
+ (cond ((and (eq last-command 'undo)
+ (or (eq pending-undo-list t)
+ (gethash buffer-undo-list undo-equiv-table)))
+ ;; then we are within a run of consecutive undo commands
+ (if (eq pending-undo-list t) nil pending-undo-list))
+ (arg ; Handle "undo in region".
+ (undo-make-selective-list
+ (region-beginning) (region-end))) ; Can be '(nil).
+ (t buffer-undo-list))) ; Can be nil.
+ (delta '(0 . 0)))
+ (while (and undo-list ; To ensure it will terminate.
+ (not (equal delta
+ (setq delta (pg--undo-delta (car undo-list))))))
+ (setq undo-list (cdr undo-list))) ; Get the last undo record.
+ delta))
