emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Introduce letf! convenience macro

Browse source 
A more succinct cl-letf, which allows for local functions and macros.
This commit is contained in:
Henrik Lissner 2020-04-29 21:08:17 -04:00
parent c3a84f0fbf
commit d12752324a
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
12 changed files with 113 additions and 115 deletions
Download patch file Download diff file Expand all files Collapse all files

5
core/autoload/debug.el
View file

@ -46,10 +46,7 @@ ready to be pasted in a bug report on github."
(require 'core-packages)
(let ((default-directory doom-emacs-dir)
(doom-modules (doom-modules)))
(cl-letf
(((symbol-function 'sh)
(lambda (&rest args)
(cdr (apply #'doom-call-process args)))))
(letf! (defun sh (&rest args) (cdr (apply #'doom-call-process args)))
`((emacs
(version . ,emacs-version)
(features ,@system-configuration-features)

29
core/core-editor.el
View file

@ -293,10 +293,7 @@ possible."
`pp' can be expensive for longer lists, and there's no reason to prettify cache
files, so we replace calls to `pp' with the much faster `prin1'."
:around #'save-place-alist-to-file
(cl-letf (((symbol-function #'pp) #'prin1))
(funcall orig-fn)))
(save-place-mode +1))
(letf! ((#'pp #'prin1)) (funcall orig-fn))))
(use-package! server
@ -394,18 +391,14 @@ files, so we replace calls to `pp' with the much faster `prin1'."
`nim-mode'. This prevents them from leaving Emacs in a broken state."
:around #'dtrt-indent-mode
(let ((dtrt-indent-run-after-smie dtrt-indent-run-after-smie))
(cl-letf* ((old-smie-config-guess (symbol-function 'smie-config-guess))
(old-smie-config--guess (symbol-function 'symbol-config--guess))
((symbol-function 'symbol-config--guess)
(lambda (beg end)
(funcall old-smie-config--guess beg (min end 10000))))
((symbol-function 'smie-config-guess)
(lambda ()
(condition-case e (funcall old-smie-config-guess)
(error (setq dtrt-indent-run-after-smie t)
(message "[WARNING] Indent detection: %s"
(error-message-string e))
(message "")))))) ; warn silently
(letf! ((defun symbol-config--guess (beg end)
(funcall symbol-config--guess beg (min end 10000)))
(defun smie-config-guess ()
(condition-case e (funcall smie-config-guess)
(error (setq dtrt-indent-run-after-smie t)
(message "[WARNING] Indent detection: %s"
(error-message-string e))
(message ""))))) ; warn silently
(funcall orig-fn arg)))))
@ -421,8 +414,8 @@ files, so we replace calls to `pp' with the much faster `prin1'."
(defun doom-use-helpful-a (orig-fn &rest args)
"Force ORIG-FN to use helpful instead of the old describe-* commands."
(cl-letf (((symbol-function #'describe-function) #'helpful-function)
((symbol-function #'describe-variable) #'helpful-variable))
(letf! ((#'describe-function #'helpful-function)
(#'describe-variable #'helpful-variable))
(apply orig-fn args)))
(after! apropos

47
core/core-lib.el
View file

@ -191,6 +191,37 @@ aliases."
(setenv (car var) (cdr var)))
,@body))
(defmacro letf! (bindings &rest body)
"Temporarily rebind function and macros in BODY.
BINDINGS is either a) a list of, or a single, `defun' or `defmacro'-ish form, or
b) a list of (PLACE VALUE) bindings as `cl-letf*' would accept.
TYPE is either `defun' or `defmacro'. NAME is the name of the function. If an
original definition for NAME exists, it can be accessed as a lexical variable by
the same name, for use with `funcall' or `apply'. ARGLIST and BODY are as in
`defun'.
\(fn ((TYPE NAME ARGLIST &rest BODY) ...) BODY...)"
(declare (indent defun))
(setq body (macroexp-progn body))
(when (memq (car bindings) '(defun defmacro))
(setq bindings (list bindings)))
(dolist (binding (nreverse bindings) body)
(let ((type (car binding))
(rest (cdr binding)))
(setq
body (pcase type
(`defmacro `(cl-macrolet ((,(car rest) ,(cadr rest) ,@(cddr rest))) ,body))
(`defun `(cl-letf* ((,(car rest) (symbol-function #',(car rest)))
((symbol-function #',(car rest))
(lambda ,(cadr rest) ,@(cddr rest))))
,body))
(_
(when (eq (car-safe type) 'function)
(setq type `(symbol-function ,type)))
`(cl-letf ((,type ,@rest)) ,body)))))))
(defmacro quiet! (&rest forms)
"Run FORMS without generating any output.
@ -198,15 +229,13 @@ This silences calls to `message', `load-file', `write-region' and anything that
writes to `standard-output'."
`(cond (doom-debug-mode ,@forms)
((not doom-interactive-mode)
(let ((old-fn (symbol-function 'write-region)))
(cl-letf ((standard-output (lambda (&rest _)))
((symbol-function 'load-file) (lambda (file) (load file nil t)))
((symbol-function 'message) (lambda (&rest _)))
((symbol-function 'write-region)
(lambda (start end filename &optional append visit lockname mustbenew)
(unless visit (setq visit 'no-message))
(funcall old-fn start end filename append visit lockname mustbenew))))
,@forms)))
(letf! ((standard-output (lambda (&rest _)))
(defun load-file (file) (load-file nil t))
(defun message (&rest _))
(defun write-region (start end filename &optional append visit lockname mustbenew)
(unless visit (setq visit 'no-message))
(funcall write-region start end filename append visit lockname mustbenew)))
,@forms))
((let ((inhibit-message t)
(save-silently t))
(prog1 ,@forms (message ""))))))

6
core/core-ui.el
View file

@ -619,10 +619,8 @@ This offers a moderate boost in startup (or theme switch) time, so long as
:around #'load-theme
(if (or (null after-init-time)
doom--prefer-theme-elc)
(cl-letf* ((old-locate-file (symbol-function 'locate-file))
((symbol-function 'locate-file)
(lambda (filename path &optional _suffixes predicate)
(funcall old-locate-file filename path '("c" "") predicate))))
(letf! (defun locate-file (filename path &optional _suffixes predicate)
(funcall locate-file filename path '("c" "") predicate))
(apply orig-fn args))
(apply orig-fn args))))