Add a new :catch keyword, and move :preface before such handling

Fixes https://github.com/jwiegley/use-package/issues/534

diff --git a/etc/USE-PACKAGE-NEWS b/etc/USE-PACKAGE-NEWS
index de9de0e977d3bf8c45ccc1d609591856704edc8c..b5b5adc0be0891bc3aff435459b2a7fb097f7a28 100644 (file)
--- 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 aa677e1ad80bf7831fd935a25c030b78925c0825..deaead24e85c2425884335e93436f777de15aede 100644 (file)
--- 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 2635c7df757645f1a899c90d3503e90581aae20b..c23d706c32c715929904fab5d3c5c101af331b09 100644 (file)
--- 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)