* lisp/emacs-lisp/package.el: Reduce macrology in ...with-response-buffer

(package--with-response-buffer-1): New function, extracted from
package--with-response-buffer.
(package--with-response-buffer): Use it.

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 7b779b5ae5ba01a24c0eef4023b7552f6a3da9a0..656c4e15f6f564733a482cbc5155dfc3afb5082c 100644 (file)
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1197,45 +1197,48 @@ errors signaled by ERROR-FORM or by BODY).
   (declare (indent defun) (debug t))
   (while (keywordp (car body))
     (setq body (cdr (cdr body))))
-  (macroexp-let2* nil ((url-1 url)
-                       (noerror-1 noerror))
-    (let ((url-sym (make-symbol "url"))
-          (b-sym (make-symbol "b-sym")))
-      `(cl-macrolet ((unless-error (body-2 &rest before-body)
-                                   (let ((err (make-symbol "err")))
-                                     `(with-temp-buffer
-                                        (when (condition-case ,err
-                                                  (progn ,@before-body t)
-                                                ,(list 'error ',error-form
-                                                       (list 'unless ',noerror-1
-                                                             `(signal (car ,err) (cdr ,err)))))
-                                          ,@body-2)))))
-         (if (string-match-p "\\`https?:" ,url-1)
-             (let ((,url-sym (concat ,url-1 ,file)))
-               (if ,async
-                   (unless-error nil
-                                 (url-retrieve ,url-sym
-                                               (lambda (status)
-                                                 (let ((,b-sym (current-buffer)))
-                                                   (require 'url-handlers)
-                                                   (unless-error ,body
-                                                                 (when-let* ((er (plist-get status :error)))
-                                                                   (error "Error retrieving: %s %S" ,url-sym er))
-                                                                 (with-current-buffer ,b-sym
-                                                                   (goto-char (point-min))
-                                                                   (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror)
-                                                                     (error "Error retrieving: %s %S" ,url-sym "incomprehensible buffer")))
-                                                                 (url-insert-buffer-contents ,b-sym ,url-sym)
-                                                                 (kill-buffer ,b-sym)
-                                                                 (goto-char (point-min)))))
-                                               nil
-                                               'silent))
-                 (unless-error ,body (url-insert-file-contents ,url-sym))))
-           (unless-error ,body
-                         (let ((url (expand-file-name ,file ,url-1)))
-                           (unless (file-name-absolute-p url)
-                             (error "Location %s is not a url nor an absolute file name" url))
-                           (insert-file-contents url))))))))
+  `(package--with-response-buffer-1 ,url (lambda () ,@body)
+                                    :file ,file
+                                    :async ,async
+                                    :error-function (lambda () ,error-form)
+                                    :noerror ,noerror))
+
+(cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys)
+  (cl-macrolet ((unless-error (body &rest before-body)
+                              (let ((err (make-symbol "err")))
+                                `(with-temp-buffer
+                                   (when (condition-case ,err
+                                             (progn ,@before-body t)
+                                           (error (funcall error-function)
+                                                  (unless noerror
+                                                    (signal (car ,err) (cdr ,err)))))
+                                     (funcall ,body))))))
+    (if (string-match-p "\\`https?:" url)
+        (let ((url (concat url file)))
+          (if async
+              (unless-error #'ignore
+                (url-retrieve url
+                  (lambda (status)
+                    (let ((b (current-buffer)))
+                      (require 'url-handlers)
+                      (unless-error body
+                        (when-let* ((er (plist-get status :error)))
+                          (error "Error retrieving: %s %S" url er))
+                        (with-current-buffer b
+                          (goto-char (point-min))
+                          (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror)
+                            (error "Error retrieving: %s %S" url "incomprehensible buffer")))
+                        (url-insert-buffer-contents b url)
+                        (kill-buffer b)
+                        (goto-char (point-min)))))
+                  nil
+                  'silent))
+            (unless-error body (url-insert-file-contents url))))
+      (unless-error body
+        (let ((url (expand-file-name file url)))
+          (unless (file-name-absolute-p url)
+            (error "Location %s is not a url nor an absolute file name" url))
+          (insert-file-contents url))))))
 
 (define-error 'bad-signature "Failed to verify signature")