aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-05-18 17:40:21 -0400
committerStefan Monnier2019-05-18 17:40:21 -0400
commit2a5705761ea8204441862d59d5fd72a94f5d592a (patch)
tree62848bdbd05f8a4638833c18971c54e6e98cadcb
parent3dcacb09a921593509d0975e4f6a9434a54521ae (diff)
downloademacs-2a5705761ea8204441862d59d5fd72a94f5d592a.tar.gz
emacs-2a5705761ea8204441862d59d5fd72a94f5d592a.zip
* 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.
-rw-r--r--lisp/emacs-lisp/package.el81
1 files 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).
1197 (declare (indent defun) (debug t)) 1197 (declare (indent defun) (debug t))
1198 (while (keywordp (car body)) 1198 (while (keywordp (car body))
1199 (setq body (cdr (cdr body)))) 1199 (setq body (cdr (cdr body))))
1200 (macroexp-let2* nil ((url-1 url) 1200 `(package--with-response-buffer-1 ,url (lambda () ,@body)
1201 (noerror-1 noerror)) 1201 :file ,file
1202 (let ((url-sym (make-symbol "url")) 1202 :async ,async
1203 (b-sym (make-symbol "b-sym"))) 1203 :error-function (lambda () ,error-form)
1204 `(cl-macrolet ((unless-error (body-2 &rest before-body) 1204 :noerror ,noerror))
1205 (let ((err (make-symbol "err"))) 1205
1206 `(with-temp-buffer 1206(cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys)
1207 (when (condition-case ,err 1207 (cl-macrolet ((unless-error (body &rest before-body)
1208 (progn ,@before-body t) 1208 (let ((err (make-symbol "err")))
1209 ,(list 'error ',error-form 1209 `(with-temp-buffer
1210 (list 'unless ',noerror-1 1210 (when (condition-case ,err
1211 `(signal (car ,err) (cdr ,err))))) 1211 (progn ,@before-body t)
1212 ,@body-2))))) 1212 (error (funcall error-function)
1213 (if (string-match-p "\\`https?:" ,url-1) 1213 (unless noerror
1214 (let ((,url-sym (concat ,url-1 ,file))) 1214 (signal (car ,err) (cdr ,err)))))
1215 (if ,async 1215 (funcall ,body))))))
1216 (unless-error nil 1216 (if (string-match-p "\\`https?:" url)
1217 (url-retrieve ,url-sym 1217 (let ((url (concat url file)))
1218 (lambda (status) 1218 (if async
1219 (let ((,b-sym (current-buffer))) 1219 (unless-error #'ignore
1220 (require 'url-handlers) 1220 (url-retrieve url
1221 (unless-error ,body 1221 (lambda (status)
1222 (when-let* ((er (plist-get status :error))) 1222 (let ((b (current-buffer)))
1223 (error "Error retrieving: %s %S" ,url-sym er)) 1223 (require 'url-handlers)
1224 (with-current-buffer ,b-sym 1224 (unless-error body
1225 (goto-char (point-min)) 1225 (when-let* ((er (plist-get status :error)))
1226 (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) 1226 (error "Error retrieving: %s %S" url er))
1227 (error "Error retrieving: %s %S" ,url-sym "incomprehensible buffer"))) 1227 (with-current-buffer b
1228 (url-insert-buffer-contents ,b-sym ,url-sym) 1228 (goto-char (point-min))
1229 (kill-buffer ,b-sym) 1229 (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror)
1230 (goto-char (point-min))))) 1230 (error "Error retrieving: %s %S" url "incomprehensible buffer")))
1231 nil 1231 (url-insert-buffer-contents b url)
1232 'silent)) 1232 (kill-buffer b)
1233 (unless-error ,body (url-insert-file-contents ,url-sym)))) 1233 (goto-char (point-min)))))
1234 (unless-error ,body 1234 nil
1235 (let ((url (expand-file-name ,file ,url-1))) 1235 'silent))
1236 (unless (file-name-absolute-p url) 1236 (unless-error body (url-insert-file-contents url))))
1237 (error "Location %s is not a url nor an absolute file name" url)) 1237 (unless-error body
1238 (insert-file-contents url)))))))) 1238 (let ((url (expand-file-name file url)))
1239 (unless (file-name-absolute-p url)
1240 (error "Location %s is not a url nor an absolute file name" url))
1241 (insert-file-contents url))))))
1239 1242
1240(define-error 'bad-signature "Failed to verify signature") 1243(define-error 'bad-signature "Failed to verify signature")
1241 1244