diff --git a/core/autoload/debug.el b/core/autoload/debug.el index 7b3f5ddcd..c6d58e8f9 100644 --- a/core/autoload/debug.el +++ b/core/autoload/debug.el @@ -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) diff --git a/core/core-editor.el b/core/core-editor.el index 1702c4d8e..750133700 100644 --- a/core/core-editor.el +++ b/core/core-editor.el @@ -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 diff --git a/core/core-lib.el b/core/core-lib.el index 3c6b5cc87..3411ca60b 100644 --- a/core/core-lib.el +++ b/core/core-lib.el @@ -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 "")))))) diff --git a/core/core-ui.el b/core/core-ui.el index 4ca55d8ec..45c58c826 100644 --- a/core/core-ui.el +++ b/core/core-ui.el @@ -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)))) diff --git a/modules/app/rss/autoload.el b/modules/app/rss/autoload.el index 1cf548212..98f121c83 100644 --- a/modules/app/rss/autoload.el +++ b/modules/app/rss/autoload.el @@ -101,10 +101,9 @@ ;;;###autoload (defun +rss-put-sliced-image-fn (spec alt &optional flags) "TODO" - (cl-letf (((symbol-function #'insert-image) - (lambda (image &optional alt _area _slice) - (let ((height (cdr (image-size image t)))) - (insert-sliced-image image alt nil (max 1 (/ height 20.0)) 1))))) + (letf! (defun insert-image (image &optional alt _area _slice) + (let ((height (cdr (image-size image t)))) + (insert-sliced-image image alt nil (max 1 (/ height 20.0)) 1))) (shr-put-image spec alt flags))) ;;;###autoload diff --git a/modules/editor/evil/autoload/advice.el b/modules/editor/evil/autoload/advice.el index e54a1ab90..bdf2ce8f9 100644 --- a/modules/editor/evil/autoload/advice.el +++ b/modules/editor/evil/autoload/advice.el @@ -123,8 +123,7 @@ more information on modifiers." (not (eq this-command 'evil-open-below)) (evil-insert-state-p)) (funcall orig-fn count) - (cl-letf (((symbol-function 'evil-insert-newline-below) - (lambda () (+evil--insert-newline)))) + (letf! (defun evil-insert-newline-below () (+evil--insert-newline)) (let ((evil-auto-indent evil-auto-indent)) (funcall orig-fn count))))) @@ -134,8 +133,7 @@ more information on modifiers." (not (eq this-command 'evil-open-above)) (evil-insert-state-p)) (funcall orig-fn count) - (cl-letf (((symbol-function 'evil-insert-newline-above) - (lambda () (+evil--insert-newline 'above)))) + (letf! (defun evil-insert-newline-above () (+evil--insert-newline 'above)) (let ((evil-auto-indent evil-auto-indent)) (funcall orig-fn count))))) diff --git a/modules/editor/snippets/config.el b/modules/editor/snippets/config.el index 71218a728..6a9e6cc94 100644 --- a/modules/editor/snippets/config.el +++ b/modules/editor/snippets/config.el @@ -102,6 +102,6 @@ us who use yas-minor-mode and enable yasnippet more selectively. This advice swaps `yas-global-mode' with `yas-minor-mode'." :around '(aya-expand aya-open-line) - (cl-letf (((symbol-function #'yas-global-mode) #'yas-minor-mode) - (yas-global-mode yas-minor-mode)) + (letf! ((#'yas-global-mode #'yas-minor-mode) + (yas-global-mode yas-minor-mode)) (apply orig-fn args)))) diff --git a/modules/lang/org/autoload/org-capture.el b/modules/lang/org/autoload/org-capture.el index d64372139..d4be3f097 100644 --- a/modules/lang/org/autoload/org-capture.el +++ b/modules/lang/org/autoload/org-capture.el @@ -50,7 +50,7 @@ you're done. This can be called from an external shell script." (with-selected-frame frame (require 'org-capture) (condition-case ex - (cl-letf (((symbol-function #'pop-to-buffer) #'switch-to-buffer)) + (letf! ((#'pop-to-buffer #'switch-to-buffer)) (switch-to-buffer (doom-fallback-buffer)) (let ((org-capture-initial initial-input) org-capture-entry) diff --git a/modules/lang/org/config.el b/modules/lang/org/config.el index ee71fb57d..d620e939f 100644 --- a/modules/lang/org/config.el +++ b/modules/lang/org/config.el @@ -539,11 +539,9 @@ current workspace (and clean them up)." ;; upstream (if ever). (defadvice! +org--fix-inline-images-for-imagemagick-users-a (orig-fn &rest args) :around #'org-display-inline-images - (cl-letf* ((old-create-image (symbol-function #'create-image)) - ((symbol-function #'create-image) - (lambda (file-or-data &optional type data-p &rest props) - (let ((type (if (plist-get props :width) type))) - (apply old-create-image file-or-data type data-p props))))) + (letf! (defun create-image (file-or-data &optional type data-p &rest props) + (let ((type (if (plist-get props :width) type))) + (apply create-image file-or-data type data-p props))) (apply orig-fn args))) (defadvice! +org--fix-inconsistent-uuidgen-case-a (uuid) diff --git a/modules/lang/org/contrib/present.el b/modules/lang/org/contrib/present.el index a92ff6572..d05cf8985 100644 --- a/modules/lang/org/contrib/present.el +++ b/modules/lang/org/contrib/present.el @@ -41,20 +41,19 @@ (defadvice! +org-present--narrow-to-subtree-a (orig-fn &rest args) "Narrow to the target subtree when you start the presentation." :around #'org-tree-slide--display-tree-with-narrow - (cl-letf (((symbol-function #'org-narrow-to-subtree) - (lambda () - (save-excursion - (save-match-data - (org-with-limited-levels - (narrow-to-region - (progn - (when (org-before-first-heading-p) - (org-next-visible-heading 1)) - (ignore-errors (org-up-heading-all 99)) - (forward-line 1) - (point)) - (progn (org-end-of-subtree t t) - (when (and (org-at-heading-p) (not (eobp))) - (backward-char 1)) - (point))))))))) + (letf! ((defun org-narrow-to-subtree () + (save-excursion + (save-match-data + (org-with-limited-levels + (narrow-to-region + (progn + (when (org-before-first-heading-p) + (org-next-visible-heading 1)) + (ignore-errors (org-up-heading-all 99)) + (forward-line 1) + (point)) + (progn (org-end-of-subtree t t) + (when (and (org-at-heading-p) (not (eobp))) + (backward-char 1)) + (point)))))))) (apply orig-fn args)))) diff --git a/modules/tools/pdf/config.el b/modules/tools/pdf/config.el index 99956fdea..b1c74e782 100644 --- a/modules/tools/pdf/config.el +++ b/modules/tools/pdf/config.el @@ -33,12 +33,10 @@ :around '(pdf-annot-show-annotation pdf-isearch-hl-matches pdf-view-display-region) - (cl-letf* ((old-create-image (symbol-function #'create-image)) - ((symbol-function #'create-image) - (lambda (file-or-data &optional type data-p &rest props) - (apply old-create-image file-or-data type data-p - :width (car (pdf-view-image-size)) - props)))) + (letf! (defun create-image (file-or-data &optional type data-p &rest props) + (apply create-image file-or-data type data-p + :width (car (pdf-view-image-size)) + props)) (apply orig-fn args)))) ;; Handle PDF-tools related popups better diff --git a/modules/ui/popup/+hacks.el b/modules/ui/popup/+hacks.el index d6cd059c3..7cc0573c7 100644 --- a/modules/ui/popup/+hacks.el +++ b/modules/ui/popup/+hacks.el @@ -195,20 +195,18 @@ the command buffer." ;; Fix #897: "cannot open side window" error when TAB-completing file links (defadvice! +popup--helm-hide-org-links-popup-a (orig-fn &rest args) :around #'org-insert-link - (cl-letf* ((old-org-completing-read (symbol-function 'org-completing-read)) - ((symbol-function 'org-completing-read) - (lambda (&rest args) - (when-let (win (get-buffer-window "*Org Links*")) - ;; While helm is opened as a popup, it will mistaken the - ;; *Org Links* popup for the "originated window", and will - ;; target it for actions invoked by the user. However, since - ;; *Org Links* is a popup too (they're dedicated side - ;; windows), Emacs complains about being unable to split a - ;; side window. The simple fix: get rid of *Org Links*! - (delete-window win) - ;; But it must exist for org to clean up later. - (get-buffer-create "*Org Links*")) - (apply old-org-completing-read args)))) + (letf! ((defun org-completing-read (&rest args) + (when-let (win (get-buffer-window "*Org Links*")) + ;; While helm is opened as a popup, it will mistaken the *Org + ;; Links* popup for the "originated window", and will target it + ;; for actions invoked by the user. However, since *Org Links* + ;; is a popup too (they're dedicated side windows), Emacs + ;; complains about being unable to split a side window. The + ;; simple fix: get rid of *Org Links*! + (delete-window win) + ;; ...but it must exist for org to clean up later. + (get-buffer-create "*Org Links*")) + (apply org-completing-read args))) (apply #'funcall-interactively orig-fn args))) ;; Fix left-over popup window when closing persistent help for `helm-M-x' @@ -228,7 +226,6 @@ the command buffer." (when (+popup-window-p win) (select-window win)))) - ;;;###package org (after! org ;; Org has a scorched-earth window management policy I'm not fond of. i.e. it @@ -242,10 +239,8 @@ the command buffer." org-fast-tag-selection org-fast-todo-selection) (if +popup-mode - (cl-letf (((symbol-function #'delete-other-windows) - (symbol-function #'ignore)) - ((symbol-function #'delete-window) - (symbol-function #'ignore))) + (letf! ((#'delete-other-windows #'ignore) + (#'delete-window #'ignore)) (apply orig-fn args)) (apply orig-fn args))) @@ -256,16 +251,14 @@ Ugh, such an ugly hack." :around '(org-fast-tag-selection org-fast-todo-selection) (if +popup-mode - (cl-letf* ((old-fit-buffer-fn (symbol-function #'org-fit-window-to-buffer)) - ((symbol-function #'org-fit-window-to-buffer) - (lambda (&optional window max-height min-height shrink-only) - (when-let (buf (window-buffer window)) - (delete-window window) - (select-window - (setq window (display-buffer-at-bottom buf nil))) - (with-current-buffer buf - (setq mode-line-format nil))) - (funcall old-fit-buffer-fn window max-height min-height shrink-only)))) + (letf! ((defun org-fit-window-to-buffer (&optional window max-height min-height shrink-only) + (when-let (buf (window-buffer window)) + (delete-window window) + (select-window + (setq window (display-buffer-at-bottom buf nil))) + (with-current-buffer buf + (setq mode-line-format nil))) + (funcall org-fit-window-to-buffer window max-height min-height shrink-only))) (apply orig-fn args)) (apply orig-fn args))) @@ -284,8 +277,7 @@ Ugh, such an ugly hack." ;; _then_ hand off the buffer to the pop up manager. (defadvice! +popup--org-src-switch-to-buffer-a (orig-fn &rest args) :around #'org-src-switch-to-buffer - (cl-letf (((symbol-function #'pop-to-buffer-same-window) - (symbol-function #'switch-to-buffer))) + (letf! ((#'pop-to-buffer-same-window #'switch-to-buffer)) (apply orig-fn args)))) @@ -316,8 +308,7 @@ Ugh, such an ugly hack." ;;;###package profiler (defadvice! +popup--profiler-report-find-entry-in-other-window-a (orig-fn function) :around #'profiler-report-find-entry - (cl-letf (((symbol-function 'find-function) - (symbol-function 'find-function-other-window))) + (letf! ((#'find-function #'find-function-other-window)) (funcall orig-fn function))) @@ -337,10 +328,9 @@ Ugh, such an ugly hack." which-key-custom-hide-popup-function #'which-key--hide-buffer-side-window which-key-custom-show-popup-function (lambda (act-popup-dim) - (cl-letf (((symbol-function 'display-buffer-in-side-window) - (lambda (buffer alist) - (+popup-display-buffer-stacked-side-window-fn - buffer (append '((vslot . -9999)) alist))))) + (letf! ((defun display-buffer-in-side-window (buffer alist) + (+popup-display-buffer-stacked-side-window-fn + buffer (append '((vslot . -9999)) alist)))) ;; HACK Fix #2219 where the which-key popup would get cut off. (setcar act-popup-dim (1+ (car act-popup-dim))) (which-key--show-buffer-side-window act-popup-dim)))))) @@ -351,9 +341,8 @@ Ugh, such an ugly hack." (defadvice! +popup--ignore-window-parameters-a (orig-fn &rest args) "Allow *interactive* window moving commands to traverse popups." :around '(windmove-up windmove-down windmove-left windmove-right) - (cl-letf (((symbol-function #'windmove-find-other-window) - (lambda (dir &optional arg window) - (window-in-direction - (pcase dir (`up 'above) (`down 'below) (_ dir)) - window (bound-and-true-p +popup-mode) arg windmove-wrap-around t)))) + (letf! ((defun windmove-find-other-window (dir &optional arg window) + (window-in-direction + (pcase dir (`up 'above) (`down 'below) (_ dir)) + window (bound-and-true-p +popup-mode) arg windmove-wrap-around t))) (apply orig-fn args)))