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.
This commit is contained in:
Leo Liu 2014-11-24 22:57:53 +08:00
parent d71a2d495f
commit 6dbaf04719
6 changed files with 76 additions and 60 deletions

View file

@ -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,

View file

@ -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.

View file

@ -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

View file

@ -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))