From 5f9153faaf767a039620a0a05a8ad0373cb24070 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 14 Nov 2015 15:44:44 +0000 Subject: [PATCH] * lisp/emacs-lisp/package.el: Refactor -with-work-buffer-async (package--with-work-buffer-async): Reimplement as `package--with-response-buffer'. (package--with-work-buffer): Mark obsolete. (package--with-response-buffer): New macro. This is a more self contained and less contrived version of `package--with-work-buffer-async'. It uses keyword arguments, doesn't have async on the name, doesn't fallback on `package--with-work-buffer', and has _much_ simpler error handling. (package--check-signature, package--download-one-archive) (package-install-from-archive, describe-package-1): Use it. (package--download-and-read-archives): Let `package--download-one-archive' take care of calling `package--update-downloads-in-progress'. --- lisp/emacs-lisp/package.el | 158 ++++++++++++++++++------------------- 1 file changed, 76 insertions(+), 82 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2962da5a917..fba07a6801e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1124,7 +1124,8 @@ FILE is the name of a file relative to that base location. This macro retrieves FILE from LOCATION into a temporary buffer, and evaluates BODY while that buffer is current. This work buffer is killed afterwards. Return the last value in BODY." - (declare (indent 2) (debug t)) + (declare (indent 2) (debug t) + (obsolete package--with-response-buffer "25.1")) `(with-temp-buffer (if (string-match-p "\\`https?:" ,location) (url-insert-file-contents (concat ,location ,file)) @@ -1134,47 +1135,52 @@ buffer is killed afterwards. Return the last value in BODY." (insert-file-contents (expand-file-name ,file ,location))) ,@body)) -(defmacro package--with-work-buffer-async (location file async &rest body) - "Run BODY in a buffer containing the contents of FILE at LOCATION. -If ASYNC is non-nil, and if it is possible, run BODY -asynchronously. If an error is encountered and ASYNC is a -function, call it with no arguments (instead of executing BODY). -If it returns non-nil, or if it wasn't a function, propagate the -error. - -For a description of the other arguments see -`package--with-work-buffer'." - (declare (indent 3) (debug t)) - (macroexp-let2* macroexp-copyable-p - ((async-1 async) - (file-1 file) - (location-1 location)) - `(if (or (not ,async-1) - (not (string-match-p "\\`https?:" ,location-1))) - (package--with-work-buffer ,location-1 ,file-1 ,@body) - ;; This `condition-case' is to catch connection errors. - (condition-case error-signal - (url-retrieve (concat ,location-1 ,file-1) - ;; This is to catch execution errors. - (lambda (status) - (condition-case error-signal - (progn - (when-let ((er (plist-get status :error))) - (error "Error retrieving: %s %S" (concat ,location-1 ,file-1) er)) - (goto-char (point-min)) - (unless (search-forward "\n\n" nil 'noerror) - (error "Invalid url response in buffer %s" - (current-buffer))) - (delete-region (point-min) (point)) - ,@body - (kill-buffer (current-buffer))) - (error (when (if (functionp ,async-1) (funcall ,async-1) t) - (signal (car error-signal) (cdr error-signal)))))) - nil - 'silent) - (error (when (if (functionp ,async-1) (funcall ,async-1) t) - (message "Error contacting: %s" (concat ,location-1 ,file-1)) - (signal (car error-signal) (cdr error-signal)))))))) +(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys) + "Access URL and run BODY in a buffer containing the response. +Point is after the headers when BODY runs. +FILE, if provided, is added to URL. +URL can be a local file name, which must be absolute. +ASYNC, if non-nil, runs the request asynchronously. +ERROR-FORM is run only if an error occurs. If NOERROR is +non-nil, don't propagate errors caused by the connection or by +BODY (does not apply to errors signaled by ERROR-FORM). + +\(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)" + (declare (indent defun) (debug t)) + (while (keywordp (car body)) + (setq body (cdr (cdr body)))) + (macroexp-let2* nil ((url-1 url)) + `(cl-macrolet ((wrap-errors (&rest bodyforms) + (let ((err (make-symbol "err"))) + `(condition-case ,err + ,(macroexp-progn bodyforms) + ,(list 'error ',error-form + (list 'unless ',noerror + `(signal (car ,err) (cdr ,err)))))))) + (if (string-match-p "\\`https?:" ,url-1) + (let* ((url (concat ,url-1 ,file)) + (callback (lambda (status) + (let ((b (current-buffer))) + (unwind-protect (wrap-errors + (when-let ((er (plist-get status :error))) + (error "Error retrieving: %s %S" url er)) + (unless (search-forward-regexp "^\r?\n\r?" nil 'noerror) + (rest-error 'rest-unintelligible-result)) + (delete-region (point-min) (point)) + ,@body) + (when (buffer-live-p b) + (kill-buffer b))))))) + (if ,async + (wrap-errors (url-retrieve url callback nil 'silent)) + (let ((buffer (wrap-errors (url-retrieve-synchronously url 'silent)))) + (with-current-buffer buffer + (funcall callback nil))))) + (wrap-errors (with-temp-buffer + (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)) + ,@body)))))) (defun package--check-signature-content (content string &optional sig-file) "Check signature CONTENT against STRING. @@ -1220,15 +1226,12 @@ list can be empty). If the signatures file is not found, CALLBACK is called with no arguments." (let ((sig-file (concat file ".sig")) (string (or string (buffer-string)))) - (condition-case nil - (package--with-work-buffer-async - location sig-file (when async (or callback t)) - (let ((sig (package--check-signature-content - (buffer-string) string sig-file))) - (when callback (funcall callback sig)) - sig)) - (file-error (funcall callback))))) - + (package--with-response-buffer location :file sig-file + :async async :noerror t + :error-form (when callback (funcall callback nil)) + (let ((sig (package--check-signature-content (buffer-substring (point) (point-max)) string sig-file))) + (when callback (funcall callback sig)) + sig)))) ;;; Packages on Archives ;; The following variables store information about packages available @@ -1470,7 +1473,9 @@ Once it's empty, run `package--post-download-archives-hook'." ARCHIVE should be a cons cell of the form (NAME . LOCATION), similar to an entry in `package-alist'. Save the cached copy to \"archives/NAME/FILE\" in `package-user-dir'." - (package--with-work-buffer-async (cdr archive) file async + (package--with-response-buffer (cdr archive) :file file + :async async + :error-form (package--update-downloads-in-progress archive) (let* ((location (cdr archive)) (name (car archive)) (content (buffer-string)) @@ -1494,17 +1499,14 @@ similar to an entry in `package-alist'. Save the cached copy to ;; remove it from the in-progress list. (package--update-downloads-in-progress archive) (error "Unsigned archive `%s'" name)) + ;; Either everything worked or we don't mind not signing. ;; Write out the archives file. (write-region content nil local-file nil 'silent) ;; Write out good signatures into archive-contents.signed file. (when good-sigs (write-region (mapconcat #'epg-signature-to-string good-sigs "\n") nil (concat local-file ".signed") nil 'silent)) - (package--update-downloads-in-progress archive) - ;; If we got this far, either everything worked or we don't mind - ;; not signing, so tell `package--with-work-buffer-async' to not - ;; propagate errors. - nil))))))) + (package--update-downloads-in-progress archive)))))))) (defun package--download-and-read-archives (&optional async) "Download descriptions of all `package-archives' and read them. @@ -1517,12 +1519,7 @@ perform the downloads asynchronously." :test #'equal)) (dolist (archive package-archives) (condition-case-unless-debug nil - (package--download-one-archive - archive "archive-contents" - ;; Called if the async download fails - (when async - ;; The t at the end means to propagate connection errors. - (lambda () (package--update-downloads-in-progress archive) t))) + (package--download-one-archive archive "archive-contents" async) (error (message "Failed to download `%s' archive." (car archive)))))) @@ -1777,7 +1774,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." (let* ((location (package-archive-base pkg-desc)) (file (concat (package-desc-full-name pkg-desc) (package-desc-suffix pkg-desc)))) - (package--with-work-buffer location file + (package--with-response-buffer location :file file (if (or (not package-check-signature) (member (package-desc-archive pkg-desc) package-unsigned-archives)) @@ -2368,26 +2365,23 @@ Otherwise no newline is inserted." (replace-match "")) (while (re-search-forward "^\\(;+ ?\\)" nil t) (replace-match "")))) - (let ((readme (expand-file-name (format "%s-readme.txt" name) - package-user-dir)) - readme-string) + (let* ((basename (format "%s-readme.txt" name)) + (readme (expand-file-name basename package-user-dir)) + readme-string) ;; For elpa packages, try downloading the commentary. If that ;; fails, try an existing readme file in `package-user-dir'. - (cond ((condition-case nil - (save-excursion - (package--with-work-buffer - (package-archive-base desc) - (format "%s-readme.txt" name) - (save-excursion - (goto-char (point-max)) - (unless (bolp) - (insert ?\n))) - (write-region nil nil - (expand-file-name readme package-user-dir) - nil 'silent) - (setq readme-string (buffer-string)) - t)) - (error nil)) + (cond ((and (package-desc-archive desc) + (package--with-response-buffer (package-archive-base desc) + :file basename :noerror t + (save-excursion + (goto-char (point-max)) + (unless (bolp) + (insert ?\n))) + (write-region nil nil + (expand-file-name readme package-user-dir) + nil 'silent) + (setq readme-string (buffer-string)) + t)) (insert readme-string)) ((file-readable-p readme) (insert-file-contents readme) -- 2.39.2