procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
(package--with-response-buffer-1): New function, extracted from
package--with-response-buffer.
(package--with-response-buffer): Use it.
This commit is contained in:
Stefan Monnier 2019-05-18 17:40:21 -04:00
parent 3dcacb09a9
commit 2a5705761e
1 changed files with 42 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

81
lisp/emacs-lisp/package.el
View file

@ -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")