New macro macroexp-let2*

* emacs-lisp/macroexp.el (macroexp-let2*): New macro.

* window.el (with-temp-buffer-window)
(with-current-buffer-window, with-displayed-buffer-window):
* emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin):
* emacs-lisp/cl-lib.el (substring):
* emacs-lisp/cl-extra.el (cl-getf): Use it.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 26376afe239d15809bf81f9dbca5bd8aefdb7182..27cde869693812632ae9039078132c4b799c4265 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2014-11-24  Leo Liu  <sdl.web@gmail.com>
+
+       * emacs-lisp/macroexp.el (macroexp-let2*): New macro.
+
+       * window.el (with-temp-buffer-window)
+       (with-current-buffer-window, with-displayed-buffer-window):
+       * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin):
+       * emacs-lisp/cl-lib.el (substring):
+       * emacs-lisp/cl-extra.el (cl-getf): Use it.
+
 2014-11-24  Eli Zaretskii  <eliz@gnu.org>
 
        * isearch.el (isearch-update): Don't assume

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 9ccfc8bfb9310186ef0e6e28f8d2f5f98a4fca9b..a94dcd335b4317517fc584e68ef9d6d3205b95dc 100644 (file)
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -606,15 +606,14 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
   (declare (gv-expander
             (lambda (do)
               (gv-letplace (getter setter) plist
-                (macroexp-let2 nil k tag
-                  (macroexp-let2 nil d def
-                    (funcall do `(cl-getf ,getter ,k ,d)
-                             (lambda (v)
-                               (macroexp-let2 nil val v
-                                 `(progn
-                                    ,(funcall setter
-                                              `(cl--set-getf ,getter ,k ,val))
-                                    ,val))))))))))
+                (macroexp-let2* nil ((k tag) (d def))
+                  (funcall do `(cl-getf ,getter ,k ,d)
+                          (lambda (v)
+                            (macroexp-let2 nil val v
+                              `(progn
+                                 ,(funcall setter
+                                           `(cl--set-getf ,getter ,k ,val))
+                                 ,val)))))))))
   (setplist '--cl-getf-symbol-- plist)
   (or (get '--cl-getf-symbol-- tag)
       ;; Originally we called cl-get here,

diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index c7d21c76fc186fad0ceedf0b913d693b3e0aa290..cc61597d313f351941e4f42df0c723e830159efa 100644 (file)
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -723,12 +723,11 @@ If ALIST is non-nil, the new pairs are prepended to it."
 (gv-define-expander substring
   (lambda (do place from &optional to)
     (gv-letplace (getter setter) place
-      (macroexp-let2 nil start from
-        (macroexp-let2 nil end to
-          (funcall do `(substring ,getter ,start ,end)
-                   (lambda (v)
-                     (funcall setter `(cl--set-substring
-                                       ,getter ,start ,end ,v)))))))))
+      (macroexp-let2* nil ((start from) (end to))
+        (funcall do `(substring ,getter ,start ,end)
+                 (lambda (v)
+                   (funcall setter `(cl--set-substring
+                                     ,getter ,start ,end ,v))))))))
 
 ;;; Miscellaneous.
 

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index c90cc040f84abfddfa8011f6318efb4bebfa5a19..0a6e1c63cf1664e0e9cb15d5c19f7a451a6ed915 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2906,9 +2906,8 @@ The function's arguments should be treated as immutable.
 ;;;###autoload
 (defun cl--compiler-macro-adjoin (form a list &rest keys)
   (if (memq :key keys) form
-    (macroexp-let2 macroexp-copyable-p va a
-      (macroexp-let2 macroexp-copyable-p vlist list
-        `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist))))))
+    (macroexp-let2* macroexp-copyable-p ((va a) (vlist list))
+      `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist)))))
 
 (defun cl--compiler-macro-get (_form sym prop &optional def)
   (if def

diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index a1dc6fa05b2b124a9ea5048ccdc97e6b6c8d1ab3..b40e44ee90f915c712a6ada6061091e3bb1dc263 100644 (file)
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -344,6 +344,15 @@ be skipped; if nil, as is usual, `macroexp-const-p' is used."
          (macroexp-let* (list (list ,var ,expsym))
                         ,bodysym)))))
 
+(defmacro macroexp-let2* (test bindings &rest body)
+  "Bind each binding in BINDINGS as `macroexp-let2' does."
+  (declare (indent 2) (debug (sexp (&rest (sexp form)) body)))
+  (pcase-exhaustive bindings
+    (`nil (macroexp-progn body))
+    (`((,var ,exp) . ,tl)
+     `(macroexp-let2 ,test ,var ,exp
+        (macroexp-let2* ,test ,tl ,@body)))))
+
 (defun macroexp--maxsize (exp size)
   (cond ((< size 0) size)
         ((symbolp exp) (1- size))

diff --git a/lisp/window.el b/lisp/window.el
index 91a0e159a8442e2f2be936d98a555eb4130fe484..78257b6121807d470578831af1dedc8ecf7d2ff7 100644 (file)
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -185,19 +185,19 @@ argument replaces this)."
   (let ((buffer (make-symbol "buffer"))
        (window (make-symbol "window"))
        (value (make-symbol "value")))
-    (macroexp-let2 nil vbuffer-or-name buffer-or-name
-      (macroexp-let2 nil vaction action
-       (macroexp-let2 nil vquit-function quit-function
-         `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
-                 (standard-output ,buffer)
-                 ,window ,value)
-            (setq ,value (progn ,@body))
-            (with-current-buffer ,buffer
-              (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
-
-            (if (functionp ,vquit-function)
-                (funcall ,vquit-function ,window ,value)
-              ,value)))))))
+    (macroexp-let2* nil ((vbuffer-or-name buffer-or-name)
+                        (vaction action)
+                        (vquit-function quit-function))
+      `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
+             (standard-output ,buffer)
+             ,window ,value)
+        (setq ,value (progn ,@body))
+        (with-current-buffer ,buffer
+          (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
+
+        (if (functionp ,vquit-function)
+            (funcall ,vquit-function ,window ,value)
+          ,value)))))
 
 (defmacro with-current-buffer-window (buffer-or-name action quit-function &rest body)
   "Evaluate BODY with a buffer BUFFER-OR-NAME current and show that buffer.
@@ -208,19 +208,19 @@ BODY."
   (let ((buffer (make-symbol "buffer"))
        (window (make-symbol "window"))
        (value (make-symbol "value")))
-    (macroexp-let2 nil vbuffer-or-name buffer-or-name
-      (macroexp-let2 nil vaction action
-       (macroexp-let2 nil vquit-function quit-function
-         `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
-                 (standard-output ,buffer)
-                 ,window ,value)
-            (with-current-buffer ,buffer
-              (setq ,value (progn ,@body))
-              (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
-
-            (if (functionp ,vquit-function)
-                (funcall ,vquit-function ,window ,value)
-              ,value)))))))
+    (macroexp-let2* nil ((vbuffer-or-name buffer-or-name)
+                        (vaction action)
+                        (vquit-function quit-function))
+      `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
+             (standard-output ,buffer)
+             ,window ,value)
+        (with-current-buffer ,buffer
+          (setq ,value (progn ,@body))
+          (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
+
+        (if (functionp ,vquit-function)
+            (funcall ,vquit-function ,window ,value)
+          ,value)))))
 
 (defmacro with-displayed-buffer-window (buffer-or-name action quit-function &rest body)
   "Show a buffer BUFFER-OR-NAME and evaluate BODY in that buffer.
@@ -230,28 +230,28 @@ displays the buffer specified by BUFFER-OR-NAME before running BODY."
   (let ((buffer (make-symbol "buffer"))
        (window (make-symbol "window"))
        (value (make-symbol "value")))
-    (macroexp-let2 nil vbuffer-or-name buffer-or-name
-      (macroexp-let2 nil vaction action
-       (macroexp-let2 nil vquit-function quit-function
-         `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
-                 (standard-output ,buffer)
-                 ,window ,value)
-            (with-current-buffer ,buffer
-              (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
-
-            (let ((inhibit-read-only t)
-                  (inhibit-modification-hooks t))
-              (setq ,value (progn ,@body)))
-
-            (set-window-point ,window (point-min))
-
-            (when (functionp (cdr (assq 'window-height (cdr ,vaction))))
-              (ignore-errors
-                (funcall (cdr (assq 'window-height (cdr ,vaction))) ,window)))
-
-            (if (functionp ,vquit-function)
-                (funcall ,vquit-function ,window ,value)
-              ,value)))))))
+    (macroexp-let2* nil ((vbuffer-or-name buffer-or-name)
+                        (vaction action)
+                        (vquit-function quit-function))
+      `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
+             (standard-output ,buffer)
+             ,window ,value)
+        (with-current-buffer ,buffer
+          (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
+
+        (let ((inhibit-read-only t)
+              (inhibit-modification-hooks t))
+          (setq ,value (progn ,@body)))
+
+        (set-window-point ,window (point-min))
+
+        (when (functionp (cdr (assq 'window-height (cdr ,vaction))))
+          (ignore-errors
+            (funcall (cdr (assq 'window-height (cdr ,vaction))) ,window)))
+
+        (if (functionp ,vquit-function)
+            (funcall ,vquit-function ,window ,value)
+          ,value)))))
 
 ;; The following two functions are like `window-next-sibling' and
 ;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so