From 6dbaf0471927829126025f57315db02d78255790 Mon Sep 17 00:00:00 2001 From: Leo Liu Date: Mon, 24 Nov 2014 22:57:53 +0800 Subject: [PATCH] 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 26376afe239..27cde869693 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2014-11-24 Leo Liu + + * 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 * isearch.el (isearch-update): Don't assume diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 9ccfc8bfb93..a94dcd335b4 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 c7d21c76fc1..cc61597d313 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 c90cc040f84..0a6e1c63cf1 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 a1dc6fa05b2..b40e44ee90f 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 91a0e159a84..78257b61218 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 -- 2.39.5