awesome-emacs/doomemacs
1
0
Fork 0
mirror of https://github.com/doomemacs/doomemacs synced 2025-08-03 12:27:26 -05:00
Code Issues Packages Projects Releases Wiki Activity

Fix letf! sometimes losing letf binds

Browse Source 
When expanding:

  (quiet! ...)

You'd expect (simplified for explanation):

  (letf! ((standard-output ...)
         ((symbol-function #'message) ...)
         ((symbol-function #'load-file) ...)
         ((symbol-function #'write-region) ...))
    ...)

But instead get:

  (letf! ((standard-output ...))
    ;; where'd the other binds go?
    ...)

This was due to data-loss caused by nreverse's destructive mutation of
the given bindings.

Also: silences byte-compiler complaining about unused bindings.
This commit is contained in:
Henrik Lissner
2020-05-14 22:32:03 -04:00
parent e7f04a3d87
commit 68709fe93a
1 changed files with 7 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
core/core-lib.el
View File

@ -210,20 +210,21 @@ the same name, for use with `funcall' or `apply'. ARGLIST and BODY are as in
(setq body (macroexp-progn body)) (setq body (macroexp-progn body))
(when (memq (car bindings) '(defun defmacro)) (when (memq (car bindings) '(defun defmacro))
(setq bindings (list bindings))) (setq bindings (list bindings)))
(dolist (binding (nreverse bindings) body) (dolist (binding (reverse bindings) (macroexpand body))
(let ((type (car binding)) (let ((type (car binding))
(rest (cdr binding))) (rest (cdr binding)))
(setq (setq
body (pcase type body (pcase type
(`defmacro `(cl-macrolet ((,(car rest) ,(cadr rest) ,@(cddr rest))) ,body)) (`defmacro `(cl-macrolet ((,(car rest) ,(cadr rest) ,@(cddr rest))) ,body))
(`defun `(cl-letf* ((,(car rest) (symbol-function #',(car rest))) (`defun `(cl-letf* ((,(car rest) (symbol-function #',(car rest)))
((symbol-function #',(car rest)) ((symbol-function #',(car rest))
(lambda ,(cadr rest) ,@(cddr rest)))) (lambda ,(cadr rest) ,@(cddr rest))))
,body)) (ignore ,(car rest))
,body))
(_ (_
(when (eq (car-safe type) 'function) (when (eq (car-safe type) 'function)
(setq type `(symbol-function ,type))) (setq type (list 'symbol-function type)))
`(cl-letf ((,type ,@rest)) ,body))))))) (list 'cl-letf (list (cons type rest)) body)))))))
(defmacro quiet! (&rest forms) (defmacro quiet! (&rest forms)
"Run FORMS without generating any output. "Run FORMS without generating any output.