* lisp/subr.el (dlet): New macro

* lisp/calendar/calendar.el (calendar-dlet*): Use it.

3 files changed, 34 insertions, 11 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 52ba1f6d354..87e634f2c1d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -216,6 +216,8 @@ This is no longer supported, and setting this variable has no effect.
 
 * Lisp Changes in Emacs 28.1
 
+** New macro 'dlet' to dynamically bind variables
+
 ** The variable 'force-new-style-backquotes' has been removed.
 This removes the final remaining trace of old-style backquotes.
 
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 1ae39445680..1d5b9479e2b 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -136,14 +136,13 @@
 ;; - whatever is passed to diary-remind
 
 (defmacro calendar-dlet* (binders &rest body)
-  "Like `let*' but using dynamic scoping."
+  "Like `dlet' but without warnings about non-prefixed var names."
   (declare (indent 1) (debug let))
-  `(progn
-     (with-no-warnings                  ;Silence "lacks a prefix" warnings!
-       ,@(mapcar (lambda (binder)
-                   `(defvar ,(if (consp binder) (car binder) binder)))
-                 binders))
-     (let* ,binders ,@body)))
+  (let ((vars (mapcar (lambda (binder)
+                        (if (consp binder) (car binder) binder))
+                      binders)))
+    `(with-suppressed-warnings ((lexical ,@vars))
+       (dlet ,binders ,@body))))
 
 ;; Avoid recursive load of calendar when loading cal-menu.  Yuck.
 (provide 'calendar)
diff --git a/lisp/subr.el b/lisp/subr.el
index 13515ca7da1..359f51c0d0c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1777,6 +1777,21 @@ all symbols are bound before any of the VALUEFORMs are evalled."
      ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
      ,@body))
 
+(defmacro dlet (binders &rest body)
+  "Like `let*' but using dynamic scoping."
+  (declare (indent 1) (debug let))
+  ;; (defvar FOO) only affects the current scope, but in order for
+  ;; this not to affect code after the `let*' we need to create a new scope,
+  ;; which is what the surrounding `let' is for.
+  ;; FIXME: (let () ...) currently doesn't actually create a new scope,
+  ;; which is why we use (let (_) ...).
+  `(let (_)
+     ,@(mapcar (lambda (binder)
+                 `(defvar ,(if (consp binder) (car binder) binder)))
+               binders)
+     (let* ,binders ,@body)))
+
+
 (defmacro with-wrapper-hook (hook args &rest body)
   "Run BODY, using wrapper functions from HOOK with additional ARGS.
 HOOK is an abnormal hook.  Each hook function in HOOK \"wraps\"
@@ -2972,13 +2987,14 @@ This finishes the change group by reverting all of its changes."
         ;; the body of `atomic-change-group' all changes can be undone.
         (widen)
         (let ((old-car (car-safe elt))
-              (old-cdr (cdr-safe elt)))
+              (old-cdr (cdr-safe elt))
+              (start-pul pending-undo-list))
           (unwind-protect
               (progn
                 ;; Temporarily truncate the undo log at ELT.
                 (when (consp elt)
                   (setcar elt nil) (setcdr elt nil))
-                (unless (eq last-command 'undo) (undo-start))
+                (setq pending-undo-list buffer-undo-list)
                 ;; Make sure there's no confusion.
                 (when (and (consp elt) (not (eq elt (last pending-undo-list))))
                   (error "Undoing to some unrelated state"))
@@ -2991,7 +3007,13 @@ This finishes the change group by reverting all of its changes."
             ;; Reset the modified cons cell ELT to its original content.
             (when (consp elt)
               (setcar elt old-car)
-              (setcdr elt old-cdr))))))))
+              (setcdr elt old-cdr)))
+          ;; Let's not break a sequence of undos just because we
+          ;; tried to make a change and then undid it: preserve
+          ;; the original `pending-undo-list' if it's still valid.
+          (if (eq (undo--last-change-was-undo-p buffer-undo-list)
+                  start-pul)
+              (setq pending-undo-list start-pul)))))))
 
 ;;;; Display-related functions.
 
@@ -3970,7 +3992,7 @@ the function `undo--wrap-and-run-primitive-undo'."
         (let (;; (inhibit-modification-hooks t)
               (before-change-functions
                ;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize
-               ;; (e.g. via a regexp-search or sexp-movement trigerring
+               ;; (e.g. via a regexp-search or sexp-movement triggering
                ;; on-the-fly syntax-propertize), make sure that this gets
                ;; properly refreshed after subsequent changes.
                (if (memq #'syntax-ppss-flush-cache before-change-functions)