[Emacs-diffs] master 01/01: New macro macroexp-let2*

[Leo Liu]

branch: master
commit 6dbaf0471927829126025f57315db02d78255790
Author: Leo Liu <address@hidden>
Date:   Mon Nov 24 22:57:53 2014 +0800

    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.
---
 lisp/ChangeLog              |   10 ++++
 lisp/emacs-lisp/cl-extra.el |   17 ++++----
 lisp/emacs-lisp/cl-lib.el   |   11 ++---
 lisp/emacs-lisp/cl-macs.el  |    5 +-
 lisp/emacs-lisp/macroexp.el |    9 ++++
 lisp/window.el              |   96 +++++++++++++++++++++---------------------
 6 files changed, 82 insertions(+), 66 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 26376af..27cde86 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2014-11-24  Leo Liu  <address@hidden>
+
+       * 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  <address@hidden>
 
        * isearch.el (isearch-update): Don't assume
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 9ccfc8b..a94dcd3 100644
--- 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 c7d21c7..cc61597 100644
--- 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 c90cc04..0a6e1c6 100644
--- 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 a1dc6fa..b40e44e 100644
--- 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 91a0e15..78257b6 100644
--- 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