]> git.eshelyaron.com Git - emacs.git/commitdiff
Only emit the debugging context text once
authorJohn Wiegley <johnw@newartisans.com>
Mon, 4 Dec 2017 06:54:34 +0000 (22:54 -0800)
committerJohn Wiegley <johnw@newartisans.com>
Mon, 4 Dec 2017 06:54:34 +0000 (22:54 -0800)
up-core.el

index 2dcf729abfa9b23639dede4c22d4af669902be32..e66d9510b1eef37abef68537cb9c6283caed3f88 100644 (file)
@@ -1324,44 +1324,54 @@ no keyword implies `:all'."
 ;;; The main macro
 ;;
 
-(defun use-package-hush (name args args* expanded body)
+(defsubst use-package-hush (context body)
   `((condition-case-unless-debug err
         ,(macroexp-progn body)
-      (error
-       (let ((msg (format "%s: %s" ',name (error-message-string err))))
-         ,(when (eq use-package-verbose 'debug)
-            `(progn
-               (setq msg (concat msg " (see the *use-package* buffer)"))
-               (with-current-buffer (get-buffer-create "*use-package*")
-                 (goto-char (point-max))
-                 (insert "-----\n" msg
+      (error (,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
+        (funcall use-package--hush-function
+                 (use-package-process-keywords name args*
+                   (and (plist-get args* :demand)
+                        (list :demand t))))
+      `((cl-flet
+            ((,context
+              (err)
+              (let ((msg (format "%s: %s" ',name
+                                 (error-message-string err))))
+                ,(when (eq use-package-verbose 'debug)
+                   `(progn
+                      (setq msg (concat msg " (see the *use-package* buffer)"))
+                      (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 expanded))))
-                 (emacs-lisp-mode))))
-         (ignore (display-warning 'use-package msg :error)))))))
-
-(defun use-package-core (name args)
-  (let* ((args* (use-package-normalize-keywords name args))
-         (use-package--hush-function
-          (if use-package-expand-minimally
-              #'identity
-            (let ((use-package--hush-function #'identity))
-              (apply-partially
-               #'use-package-hush name args args*
-               (let ((use-package-verbose 'errors)
-                     (use-package-expand-minimally t))
-                 (use-package-process-keywords name args*
-                   (and (plist-get args* :demand)
-                        (list :demand t)))))))))
-    (funcall use-package--hush-function
-             (use-package-process-keywords name args*
-               (and (plist-get args* :demand)
-                    (list :demand t))))))
+                           (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))))
+                (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)))))))))))
 
 ;;;###autoload
 (defmacro use-package (name &rest args)