mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

New macro macroexp-let2*

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

10
lisp/ChangeLog
View file

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

17
lisp/emacs-lisp/cl-extra.el
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,

11
lisp/emacs-lisp/cl-lib.el
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.

5
lisp/emacs-lisp/cl-macs.el
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

9
lisp/emacs-lisp/macroexp.el
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))

84
lisp/window.el
View file

@ -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)))
(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)))))))
(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)))
(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)))))))
(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)))
(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)))
(let ((inhibit-read-only t)
(inhibit-modification-hooks t))
(setq ,value (progn ,@body)))
(set-window-point ,window (point-min))
(set-window-point ,window (point-min))
(when (functionp (cdr (assq 'window-height (cdr ,vaction))))
(ignore-errors
(funcall (cdr (assq 'window-height (cdr ,vaction))) ,window)))
(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)))))))
(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