From 2a5705761ea8204441862d59d5fd72a94f5d592a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 18 May 2019 17:40:21 -0400 Subject: [PATCH] * 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. --- lisp/emacs-lisp/package.el | 81 ++++++++++++++++++++------------------ 1 file changed, 42 insertions(+), 39 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7b779b5ae5b..656c4e15f6f 100644 --- 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") -- 2.39.2