Permit minimal expansion of macro bodies, and other fixes

This commit is contained in:
John Wiegley 2015-03-16 10:39:37 -05:00
parent 21a091f17a
commit 302c008b45

View file

@ -89,35 +89,73 @@ happens.
Note that if either `pre-init' hooks returns a nil value, that Note that if either `pre-init' hooks returns a nil value, that
block's user-supplied configuration is not evaluated, so be block's user-supplied configuration is not evaluated, so be
certain to return `t' if you only wish to add behavior to what certain to return `t' if you only wish to add behavior to what
the user specified.") the user specified."
:type 'boolean
:group 'use-package)
(defcustom use-package-expand-minimally nil
"If non-nil, make the expanded code as minimal as possible.
This disables:
- Printing to the *Messages* buffer of slowly-evaluating forms
- Capture of load errors (normally redisplayed as warnings)
- Conditional loading of packages (load failures become errors)
The only real advantage is that, if you know your configuration
works, then your byte-compiled init file is as minimal as
possible."
:type 'boolean
:group 'use-package)
(defmacro use-package-expand (name label form)
(declare (indent 1))
(when form
(if use-package-expand-minimally
form
(let ((err (make-symbol "err")))
`(condition-case-unless-debug ,err
,form
(error
(ignore
(display-warning 'use-package (error-message-string ,err)
:error))))))))
(put 'use-package-expand 'lisp-indent-function 'defun)
(defun use-package-hook-injector (name-string keyword args) (defun use-package-hook-injector (name-string keyword args)
"Wrap pre/post hook injections around a given keyword form." "Wrap pre/post hook injections around a given keyword form."
(if (not use-package-inject-hooks) (if (not use-package-inject-hooks)
(use-package-expand name-string (format "%s" keyword) (macroexpand-all
(plist-get args keyword)) `(use-package-expand name-string ,(format "%s" keyword)
,(plist-get args keyword)))
(let ((keyword-name (substring (format "%s" keyword) 1)) (let ((keyword-name (substring (format "%s" keyword) 1))
(block (plist-get args keyword))) (block (plist-get args keyword)))
(when block (when block
`(when ,(use-package-expand name-string (format "pre-%s hook" keyword) (macroexpand-all
`(run-hook-with-args-until-failure `(when (use-package-expand name-string ,(format "pre-%s hook" keyword)
(run-hook-with-args-until-failure
',(intern (concat "use-package--" name-string ',(intern (concat "use-package--" name-string
"--pre-" keyword-name "-hook")))) "--pre-" keyword-name "-hook"))))
,(use-package-expand name-string (format "%s" keyword) (use-package-expand name-string ,(format "%s" keyword)
(plist-get args keyword)) ,(plist-get args keyword))
,(use-package-expand name-string (format "post-%s hook" keyword) (use-package-expand name-string ,(format "post-%s hook" keyword)
`(run-hooks (run-hooks
',(intern (concat "use-package--" name-string ',(intern (concat "use-package--" name-string
"--post-" keyword-name "-hook"))))))))) "--post-" keyword-name "-hook"))))))))))
(defun use-package-progn (body)
(if (= (length body) 1)
(car body)
`(progn ,@body)))
(defmacro use-package-with-elapsed-timer (text &rest body) (defmacro use-package-with-elapsed-timer (text &rest body)
(declare (indent 1)) (declare (indent 1))
(if use-package-expand-minimally
(use-package-progn body)
(let ((nowvar (make-symbol "now"))) (let ((nowvar (make-symbol "now")))
(if (bound-and-true-p use-package-verbose) (if (bound-and-true-p use-package-verbose)
`(let ((,nowvar (current-time))) `(let ((,nowvar (current-time)))
(message "%s..." ,text) (message "%s..." ,text)
(prog1 (prog1
(progn ,@body) ,(use-package-progn body)
(let ((elapsed (let ((elapsed
(float-time (time-subtract (current-time) ,nowvar)))) (float-time (time-subtract (current-time) ,nowvar))))
(if (> elapsed (if (> elapsed
@ -125,7 +163,9 @@ the user specified.")
"0.01")) "0.01"))
(message "%s...done (%.3fs)" ,text elapsed) (message "%s...done (%.3fs)" ,text elapsed)
(message "%s...done" ,text))))) (message "%s...done" ,text)))))
`(progn ,@body)))) (use-package-progn body)))))
(put 'use-package-with-elapsed-timer 'lisp-indent-function 'defun)
(defsubst use-package-error (msg) (defsubst use-package-error (msg)
"Report MSG as an error, so the user knows it came from this package." "Report MSG as an error, so the user knows it came from this package."
@ -177,6 +217,8 @@ the user specified.")
(use-package-error (use-package-error
(concat label " wants exactly one argument"))))) (concat label " wants exactly one argument")))))
(put 'use-package-only-one 'lisp-indent-function 'defun)
(defun use-package-as-one (label args f) (defun use-package-as-one (label args f)
"Call F on the first element of ARGS if it has one element, or all of ARGS." "Call F on the first element of ARGS if it has one element, or all of ARGS."
(declare (indent 1)) (declare (indent 1))
@ -187,6 +229,8 @@ the user specified.")
(use-package-error (use-package-error
(concat label " wants a list")))) (concat label " wants a list"))))
(put 'use-package-as-one 'lisp-indent-function 'defun)
(defsubst use-package-is-sympair (x &optional allow-vector) (defsubst use-package-is-sympair (x &optional allow-vector)
"Return t if X has the type (STRING . SYMBOL)." "Return t if X has the type (STRING . SYMBOL)."
(and (consp x) (and (consp x)
@ -325,17 +369,6 @@ the user specified.")
"Delete all empty lists from ELEMS (nil or (list nil)), and append them." "Delete all empty lists from ELEMS (nil or (list nil)), and append them."
(apply #'nconc (delete nil (delete (list nil) elems)))) (apply #'nconc (delete nil (delete (list nil) elems))))
(defsubst use-package-expand (name label form)
(declare (indent 1))
(when form
(let ((err (make-symbol "err"))
(fmt (format "Failure in %s of %s: %%S" label name)))
`(condition-case-unless-debug ,err
,form
(error
(ignore
(display-warning 'use-package (format ,fmt ,err) :error)))))))
(defun use--package (name name-symbol name-string args) (defun use--package (name name-symbol name-string args)
"See docstring for `use-package'." "See docstring for `use-package'."
(let* (let*
@ -414,8 +447,7 @@ the user specified.")
;; (unless (and (fboundp command) ;; (unless (and (fboundp command)
;; (not (autoloadp command))) ;; (not (autoloadp command)))
;; `(autoload #',command ,name-string nil t)) ;; `(autoload #',command ,name-string nil t))
`(autoload #',command ,name-string nil t) `(autoload #',command ,name-string nil t))
)
commands))) commands)))
(when (bound-and-true-p byte-compile-current-file) (when (bound-and-true-p byte-compile-current-file)
@ -437,21 +469,24 @@ the user specified.")
bindings bindings
(if config-body (if config-body
`((eval-after-load ',name `((eval-after-load ',name
'(use-package-with-elapsed-timer ',(macroexpand
`(use-package-with-elapsed-timer
,(format "Configuring package %s" name-string) ,(format "Configuring package %s" name-string)
,@config-body))))) ,@config-body))))))
`((use-package-with-elapsed-timer `(,(macroexpand
`(use-package-with-elapsed-timer
,(format "Loading package %s" name-string) ,(format "Loading package %s" name-string)
(if (not (require ',name-symbol nil t)) ,(if use-package-expand-minimally
(display-warning (use-package-progn
'use-package (use-package-cat-maybes
(format "Could not load package %s" ,name-string) :error) (list `(require ',name-symbol nil t))
bindings
config-body))
`(if (not (require ',name-symbol nil t))
(error "Could not load package %s" ,name-string)
,@(use-package-cat-maybes ,@(use-package-cat-maybes
bindings bindings
config-body) config-body))))))))))
t))))
(list t))))
(defmacro use-package (name &rest args) (defmacro use-package (name &rest args)
"Declare an Emacs package by specifying a group of configuration options. "Declare an Emacs package by specifying a group of configuration options.
@ -496,38 +531,35 @@ this file. Usage:
:pin Pin the package to an archive." :pin Pin the package to an archive."
(declare (indent 1)) (declare (indent 1))
(unless (member :disabled args) (unless (member :disabled args)
(use-package-expand "use-package" "expansion"
(let* ((name-string (if (stringp name) name (symbol-name name))) (let* ((name-string (if (stringp name) name (symbol-name name)))
(name-symbol (if (stringp name) (intern name) name)) (name-symbol (if (stringp name) (intern name) name))
(args* (args* (use-package-normalize-plist name-symbol args))
(condition-case-unless-debug err (archive-name (plist-get args* :pin))
(use-package-normalize-plist name-symbol args) (ensure (plist-get args* :ensure))
(error (package-name (or (and (eq ensure t) name) ensure)))
(display-warning 'use-package
(error-message-string err) :error)))))
;; Pin any packages that have been marked with `:pin'. ;; Pin any packages that have been marked with `:pin'.
(let ((archive-name (plist-get args* :pin)))
(when archive-name (when archive-name
(use-package-pin-package name archive-name))) (use-package-pin-package name-symbol archive-name))
;; Ensure that the package has been installed, if marked with ;; Ensure that the package has been installed, if marked with
;; `:ensure'. ;; `:ensure'.
(let* ((ensure (plist-get args* :ensure))
(package-name (or (and (eq ensure t) name) ensure)))
(when package-name (when package-name
(require 'package) (require 'package)
(use-package-ensure-elpa package-name))) (use-package-ensure-elpa package-name))
;; At this point, we can expand the macro using the helper function. ;; At this point, we can expand the macro using the helper function.
;; `use--package'. ;; `use--package'.
(let* (let*
((body (use--package name name-symbol name-string args*)) ((body (use-package-cat-maybes
(use--package name name-symbol name-string args*)
(when archive-name
`((add-to-list 'package-pinned-packages
'(,name-symbol . ,archive-name))))))
(pred (plist-get args* :if)) (pred (plist-get args* :if))
(expansion (if pred (expansion (if pred
`(when ,pred ,@body) `(when ,pred ,@body)
(if (= (length body) 1) (use-package-progn body)))
(car body)
`(progn ,@body))))
(requires (plist-get args* :requires)) (requires (plist-get args* :requires))
(pre-compile-load (pre-compile-load
@ -557,9 +589,9 @@ this file. Usage:
;; If a dynamic test has been requested -- that certain other ;; If a dynamic test has been requested -- that certain other
;; packages must be loaded first, before attempting to load and ;; packages must be loaded first, before attempting to load and
;; configure this package -- wrap that logic around the expansion. ;; configure this package -- wrap that logic around the expansion.
(if (= (length body*) 1) (use-package-progn body*))))))
(car body*)
`(progn ,@body*)))))) (put 'use-package 'lisp-indent-function 'defun)
(defun use-package-autoload-keymap (keymap-symbol package override) (defun use-package-autoload-keymap (keymap-symbol package override)
"Loads PACKAGE and then binds the key sequence used to invoke "Loads PACKAGE and then binds the key sequence used to invoke
@ -633,12 +665,6 @@ manually updated package."
(when (not (package-installed-p package)) (when (not (package-installed-p package))
(package-install package))) (package-install package)))
(put 'use-package 'lisp-indent-function 'defun)
(put 'use-package-expand 'lisp-indent-function 'defun)
(put 'use-package-only-one 'lisp-indent-function 'defun)
(put 'use-package-as-one 'lisp-indent-function 'defun)
(put 'use-package-with-elapsed-timer 'lisp-indent-function 'defun)
(provide 'use-package) (provide 'use-package)
;; Local Variables: ;; Local Variables: