diff options
| author | Stefan Monnier | 2019-05-18 17:40:21 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-05-18 17:40:21 -0400 |
| commit | 2a5705761ea8204441862d59d5fd72a94f5d592a (patch) | |
| tree | 62848bdbd05f8a4638833c18971c54e6e98cadcb | |
| parent | 3dcacb09a921593509d0975e4f6a9434a54521ae (diff) | |
| download | emacs-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.el | 81 |
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 | ||