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

refactor(lib): letf!: use define-advice & split defun/defun*

Browse source
This commit is contained in:
Henrik Lissner 2024-09-11 14:12:45 -04:00
parent 4ca5819532
commit a974210605
No known key found for this signature in database
GPG key ID: B60957CA074D39A3
1 changed files with 25 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

31
lisp/doom-lib.el
View file

@ -360,16 +360,33 @@ NAME, ARGLIST, and BODY are the same as `defun', `defun*', `defmacro', and
(setq (setq
body (pcase type body (pcase type
(`defmacro `(cl-macrolet ((,@rest)) ,body)) (`defmacro `(cl-macrolet ((,@rest)) ,body))
(`defadvice `(progn (defadvice! ,@rest) (`defadvice
(unwind-protect ,body (undefadvice! ,@rest)))) (if (keywordp (cadr rest))
((or `defun `defun*) (cl-destructuring-bind (target where fn) rest
`(when-let (fn ,fn)
(advice-add ,target ,where fn)
(unwind-protect ,body (advice-remove ,target fn))))
(let* ((fn (pop rest))
(argspec (pop rest)))
(when (< (length argspec) 3)
(setq argspec
(list (nth 0 argspec)
(nth 1 argspec)
(or (nth 2 argspec) (gensym (format "%s-a" (symbol-name fn)))))))
(let ((name (nth 2 argspec)))
`(progn
(define-advice ,fn ,argspec ,@rest)
(unwind-protect ,body
(advice-remove #',fn #',name)
,(if name `(fmakunbound ',name))))))))
(`defun
`(cl-letf ((,(car rest) (symbol-function #',(car rest)))) `(cl-letf ((,(car rest) (symbol-function #',(car rest))))
(ignore ,(car rest)) (ignore ,(car rest))
,(if (eq type 'defun*) (cl-letf (((symbol-function #',(car rest))
`(cl-labels ((,@rest)) ,body)
`(cl-letf (((symbol-function #',(car rest))
(lambda! ,(cadr rest) ,@(cddr rest)))) (lambda! ,(cadr rest) ,@(cddr rest))))
,body)))) ,body)))
(`defun*
`(cl-labels ((,@rest)) ,body))
(_ (_
(when (eq (car-safe type) 'function) (when (eq (car-safe type) 'function)
(setq type (list 'symbol-function type))) (setq type (list 'symbol-function type)))