Refactor autodef generator

This commit is contained in:
Henrik Lissner 2019-07-22 22:10:48 +02:00
parent a301330603
commit afebdb35da
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395

View file

@ -149,11 +149,7 @@ even if it doesn't need reloading!"
(alt-sexp (match-string 1)) (alt-sexp (match-string 1))
(type (car sexp)) (type (car sexp))
(name (doom-unquote (cadr sexp))) (name (doom-unquote (cadr sexp)))
(origin (cond ((doom-module-from-path path)) (origin (doom-module-from-path path)))
((file-in-directory-p path doom-private-dir)
`(:private . ,(intern (file-name-base path))))
((file-in-directory-p path doom-emacs-dir)
`(:core . ,(intern (file-name-base path)))))))
(cond (cond
((and (not member-p) ((and (not member-p)
alt-sexp) alt-sexp)
@ -161,35 +157,37 @@ even if it doesn't need reloading!"
((memq type '(defun defmacro cl-defun cl-defmacro)) ((memq type '(defun defmacro cl-defun cl-defmacro))
(cl-destructuring-bind (_ _name arglist &rest body) sexp (cl-destructuring-bind (_ _name arglist &rest body) sexp
(let ((docstring (if (stringp (car body)) (appendq!
(pop body) forms
"No documentation."))) (list (if member-p
(appendq! (make-autoload sexp path)
forms (let ((docstring
(list (if member-p (format "THIS FUNCTION DOES NOTHING BECAUSE %s IS DISABLED\n\n%s"
(make-autoload sexp (abbreviate-file-name (file-name-sans-extension path))) origin
(setq docstring (format "THIS FUNCTION DOES NOTHING BECAUSE %s IS DISABLED\n\n%s" (if (stringp (car body))
origin docstring)) (pop body)
"No documentation."))))
(condition-case-unless-debug e (condition-case-unless-debug e
(if alt-sexp (if alt-sexp
(read alt-sexp) (read alt-sexp)
(append (list (pcase type (append
(`defun 'defmacro) (list (pcase type
(`cl-defun `cl-defmacro) (`defun 'defmacro)
(_ type)) (`cl-defun `cl-defmacro)
name arglist docstring) (_ type))
(cl-loop for arg in arglist name arglist docstring)
if (and (symbolp arg) (cl-loop for arg in arglist
(not (keywordp arg)) if (and (symbolp arg)
(not (memq arg cl--lambda-list-keywords))) (not (keywordp arg))
collect arg into syms (not (memq arg cl--lambda-list-keywords)))
else if (listp arg) collect arg into syms
collect (car arg) into syms else if (listp arg)
finally return (if syms `((ignore ,@syms)))))) collect (car arg) into syms
finally return (if syms `((ignore ,@syms))))))
('error ('error
(print! "- Ignoring autodef %s (%s)" name e) (print! "- Ignoring autodef %s (%s)" name e)
nil))) nil))))
`(put ',name 'doom-module ',origin)))))) `(put ',name 'doom-module ',origin)))))
((eq type 'defalias) ((eq type 'defalias)
(cl-destructuring-bind (_type name target &optional docstring) sexp (cl-destructuring-bind (_type name target &optional docstring) sexp
@ -200,10 +198,8 @@ even if it doesn't need reloading!"
docstring docstring
(format "THIS FUNCTION DOES NOTHING BECAUSE %s IS DISABLED\n\n%s" (format "THIS FUNCTION DOES NOTHING BECAUSE %s IS DISABLED\n\n%s"
origin docstring))) origin docstring)))
(appendq! (appendq! forms `((put ',name 'doom-module ',origin)
forms (defalias ',name #',target ,docstring))))))
`((put ',name 'doom-module ',origin)
(defalias ',name #',target ,docstring))))))
(member-p (push sexp forms))))) (member-p (push sexp forms)))))
forms)) forms))