From fe85f246b0cd22ec3d8915d47ec6798958cbeefd Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Mon, 4 Dec 2017 11:00:05 -0800 Subject: [PATCH] Add a new :catch keyword, and move :preface before such handling Fixes https://github.com/jwiegley/use-package/issues/534 --- etc/USE-PACKAGE-NEWS | 6 +++ up-core.el | 121 +++++++++++++++++++++++++------------------ up-tests.el | 29 +++++++++++ 3 files changed, 107 insertions(+), 49 deletions(-) diff --git a/etc/USE-PACKAGE-NEWS b/etc/USE-PACKAGE-NEWS index de9de0e977d..b5b5adc0be0 100644 --- a/etc/USE-PACKAGE-NEWS +++ b/etc/USE-PACKAGE-NEWS @@ -52,6 +52,12 @@ - New `:hook` keyword. +- New `:catch` keyword. If `t` or `nil`, it enables (the default, see + `use-package-defaults`) or disables catching errors at load time in + use-package expansions. It can also be a function taking two arguments: the + keyword being processed at the time the error was encountered, and the error + object (as generated by `condition-case`). + - New keywords `:custom (foo1 bar1) (foo2 bar2)` etc., and `:custom-face`. - New `:magic` and `:magic-fallback` keywords. diff --git a/up-core.el b/up-core.el index aa677e1ad80..deaead24e85 100644 --- a/up-core.el +++ b/up-core.el @@ -63,6 +63,7 @@ :defines :functions :preface + :catch :after :custom :custom-face @@ -148,6 +149,8 @@ See also `use-package-defaults', which uses this value." '(;; this '(t) has special meaning; see `use-package-handler/:config' (:config '(t) t) (:init nil t) + (:catch t (lambda (args) + (not use-package-expand-minimally))) (:defer use-package-always-defer (lambda (args) (and use-package-always-defer @@ -262,8 +265,6 @@ Must be set before loading use-package." (font-lock-add-keywords 'emacs-lisp-mode use-package-font-lock-keywords) -(defvar use-package--hush-function) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Utility functions @@ -954,6 +955,56 @@ deferred until the prefix key sequence is pressed." `((eval-and-compile ,@arg))) body))) +;;;; :catch + +(defvar use-package--form) +(defvar use-package--hush-function #'(lambda (keyword body) body)) + +(defsubst use-package-hush (context keyword body) + `((condition-case-unless-debug err + ,(macroexp-progn body) + (error (funcall ,context ,keyword err))))) + +(defun use-package-normalize/:catch (name keyword args) + (if (null args) + t + (use-package-only-one (symbol-name keyword) args + use-package--hush-function))) + +(defun use-package-handler/:catch (name keyword arg rest state) + (let* ((context (gensym "use-package--warning"))) + (cond + ((not arg) + (use-package-process-keywords name rest state)) + ((eq arg t) + `((let ((,context + #'(lambda (keyword err) + (let ((msg (format "%s/%s: %s" ',name keyword + (error-message-string err)))) + ,(when (eq use-package-verbose 'debug) + `(progn + (with-current-buffer + (get-buffer-create "*use-package*") + (goto-char (point-max)) + (insert "-----\n" msg ,use-package--form) + (emacs-lisp-mode)) + (setq msg + (concat msg + " (see the *use-package* buffer)")))) + (ignore (display-warning 'use-package msg :error)))))) + ,@(let ((use-package--hush-function + (apply-partially #'use-package-hush context))) + (funcall use-package--hush-function keyword + (use-package-process-keywords name rest state)))))) + ((functionp arg) + `((let ((,context ,arg)) + ,@(let ((use-package--hush-function + (apply-partially #'use-package-hush context))) + (funcall use-package--hush-function keyword + (use-package-process-keywords name rest state)))))) + (t + (use-package-error "The :catch keyword expects 't' or a function"))))) + ;;;; :bind, :bind* (defalias 'use-package-normalize/:bind 'use-package-normalize-binder) @@ -1253,7 +1304,7 @@ no keyword implies `:all'." (use-package-hook-injector (use-package-as-string name) :init arg))) (when init-body - (funcall use-package--hush-function + (funcall use-package--hush-function :init (if use-package-check-before-init `((when (locate-library ,(use-package-as-string name)) ,@init-body)) @@ -1285,7 +1336,7 @@ no keyword implies `:all'." body (use-package-with-elapsed-timer (format "Configuring package %s" name-symbol) - (funcall use-package--hush-function + (funcall use-package--hush-function :config (use-package-concat (use-package-hook-injector (symbol-name name-symbol) :config arg) @@ -1297,52 +1348,24 @@ no keyword implies `:all'." ;;; The main macro ;; -(defsubst use-package-hush (context body) - `((condition-case-unless-debug err - ,(macroexp-progn body) - (error (funcall ,context err))))) - (defun use-package-core (name args) - (let* ((context (gensym "use-package--warning")) - (args* (use-package-normalize-keywords name args)) - (use-package--hush-function #'identity)) - (if use-package-expand-minimally - (use-package-process-keywords name args* - (and (plist-get args* :demand) - (list :demand t))) - `((let - ((,context - #'(lambda (err) - (let ((msg (format "%s: %s" ',name (error-message-string err)))) - ,(when (eq use-package-verbose 'debug) - `(progn - (with-current-buffer (get-buffer-create "*use-package*") - (goto-char (point-max)) - (insert - "-----\n" msg - ,(concat - "\n\n" - (pp-to-string `(use-package ,name ,@args)) - "\n -->\n\n" - (pp-to-string `(use-package ,name ,@args*)) - "\n ==>\n\n" - (pp-to-string - (macroexp-progn - (let ((use-package-verbose 'errors) - (use-package-expand-minimally t)) - (use-package-process-keywords name args* - (and (plist-get args* :demand) - (list :demand t)))))))) - (emacs-lisp-mode)) - (setq msg (concat msg " (see the *use-package* buffer)")))) - (ignore (display-warning 'use-package msg :error)))))) - ,(let ((use-package--hush-function - (apply-partially #'use-package-hush context))) - (macroexp-progn - (funcall use-package--hush-function - (use-package-process-keywords name args* - (and (plist-get args* :demand) - (list :demand t))))))))))) + (let* ((args* (use-package-normalize-keywords name args)) + (use-package--form + (concat "\n\n" + (pp-to-string `(use-package ,name ,@args)) + "\n -->\n\n" + (pp-to-string `(use-package ,name ,@args*)) + "\n ==>\n\n" + (pp-to-string + (macroexp-progn + (let ((use-package-verbose 'errors) + (use-package-expand-minimally t)) + (use-package-process-keywords name args* + (and (plist-get args* :demand) + (list :demand t))))))))) + (use-package-process-keywords name args* + (and (plist-get args* :demand) + (list :demand t))))) ;;;###autoload (defmacro use-package (name &rest args) diff --git a/up-tests.el b/up-tests.el index 2635c7df757..c23d706c32c 100644 --- a/up-tests.el +++ b/up-tests.el @@ -866,6 +866,35 @@ (init) (require 'foo nil nil))))) +(ert-deftest use-package-test/:catch-1 () + (match-expansion + (use-package foo :catch t) + `(let + ((,_ #'(lambda (keyword err) + (let ((msg (format "%s/%s: %s" 'foo keyword + (error-message-string err)))) + nil + (ignore (display-warning 'use-package msg :error)))))) + (condition-case-unless-debug err + (require 'foo nil nil) + (error + (funcall ,_ :catch err)))))) + +(ert-deftest use-package-test/:catch-2 () + (match-expansion + (use-package foo :catch nil) + `(require 'foo nil nil))) + +(ert-deftest use-package-test/:catch-3 () + (match-expansion + (use-package foo :catch (lambda (keyword error))) + `(let + ((,_ (lambda (keyword error)))) + (condition-case-unless-debug err + (require 'foo nil nil) + (error + (funcall ,_ :catch err)))))) + (ert-deftest use-package-test/:after-1 () (match-expansion (use-package foo :after bar) -- 2.39.2