]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/package.el
* lisp/emacs-lisp/package.el (package--with-response-buffer):
[gnu-emacs] / lisp / emacs-lisp / package.el
index 34772a0aa90a3bdcee280308b2b6c6b97275508d..aa18c2d30bc0a7fe679aa6c153ca120a9ba19ce3 100644 (file)
 (eval-when-compile (require 'subr-x))
 (eval-when-compile (require 'cl-lib))
 (eval-when-compile (require 'epg))      ;For setf accessors.
+(require 'seq)
 
 (require 'tabulated-list)
 (require 'macroexp)
@@ -1153,6 +1154,8 @@ errors signaled by ERROR-FORM or by BODY).
   (while (keywordp (car body))
     (setq body (cdr (cdr body))))
   (macroexp-let2* nil ((url-1 url)
+                       (url-sym (make-symbol "url"))
+                       (b-sym (make-symbol "b-sym"))
                        (noerror-1 noerror))
     `(cl-macrolet ((unless-error (body-2 &rest before-body)
                                  (let ((err (make-symbol "err")))
@@ -1164,23 +1167,26 @@ errors signaled by ERROR-FORM or by BODY).
                                                            `(signal (car ,err) (cdr ,err)))))
                                         ,@body-2)))))
        (if (string-match-p "\\`https?:" ,url-1)
-           (let* ((url (concat ,url-1 ,file))
-                  (callback (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)))))))
+           (let ((,url-sym (concat ,url-1 ,file)))
              (if ,async
-                 (unless-error nil (url-retrieve url callback nil 'silent))
-               (unless-error ,body (url-insert-file-contents url))))
+                 (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)
@@ -1213,7 +1219,7 @@ errors."
           (unless (and (eq package-check-signature 'allow-unsigned)
                        (eq (epg-signature-status sig) 'no-pubkey))
             (setq had-fatal-error t))))
-      (when (and (null good-signatures) had-fatal-error)
+      (when (or (null good-signatures) had-fatal-error)
         (package--display-verify-error context sig-file)
         (signal 'bad-signature (list sig-file)))
       good-signatures)))
@@ -1425,7 +1431,10 @@ If `user-init-file' does not mention `(package-initialize)', add
 it to the file.
 If called as part of loading `user-init-file', set
 `package-enable-at-startup' to nil, to prevent accidentally
-loading packages twice."
+loading packages twice.
+It is not necessary to adjust `load-path' or `require' the
+individual packages after calling `package-initialize' -- this is
+taken care of by `package-initialize'."
   (interactive)
   (setq package-alist nil)
   (if (equal user-init-file load-file-name)
@@ -1452,9 +1461,8 @@ loading packages twice."
 (defvar package--downloads-in-progress nil
   "List of in-progress asynchronous downloads.")
 
-(declare-function epg-check-configuration "epg-config"
-                  (config &optional minimum-version))
-(declare-function epg-configuration "epg-config" ())
+(declare-function epg-find-configuration "epg-config"
+                  (protocol &optional force))
 (declare-function epg-import-keys-from-file "epg" (context keys))
 
 ;;;###autoload
@@ -1554,11 +1562,15 @@ downloads in the background."
   (let ((default-keyring (expand-file-name "package-keyring.gpg"
                                            data-directory))
         (inhibit-message async))
+    (if (get 'package-check-signature 'saved-value)
+        (when package-check-signature
+          (epg-find-configuration 'OpenPGP))
+      (setq package-check-signature
+            (if (epg-find-configuration 'OpenPGP)
+                'allow-unsigned)))
     (when (and package-check-signature (file-exists-p default-keyring))
       (condition-case-unless-debug error
-          (progn
-            (epg-check-configuration (epg-configuration))
-            (package-import-keyring default-keyring))
+          (package-import-keyring default-keyring)
         (error (message "Cannot import default keyring: %S" (cdr error))))))
   (package--download-and-read-archives async))
 
@@ -1982,7 +1994,8 @@ Downloads and installs required packages as needed."
             ((derived-mode-p 'tar-mode)
              (package-tar-file-info))
             (t
-             (package-buffer-info))))
+             (save-excursion
+              (package-buffer-info)))))
          (name (package-desc-name pkg-desc)))
     ;; Download and install the dependencies.
     (let* ((requires (package-desc-reqs pkg-desc))
@@ -2020,17 +2033,21 @@ If some packages are not installed propose to install them."
   ;; gets installed).
   (if (not package-selected-packages)
       (message "`package-selected-packages' is empty, nothing to install")
-    (cl-loop for p in package-selected-packages
-             unless (package-installed-p p)
-             collect p into lst
-             finally
-             (if lst
-                 (when (y-or-n-p
-                        (format "%s packages will be installed:\n%s, proceed?"
-                          (length lst)
-                          (mapconcat #'symbol-name lst ", ")))
-                   (mapc #'package-install lst))
-               (message "All your packages are already installed")))))
+    (let* ((not-installed (seq-remove #'package-installed-p package-selected-packages))
+           (available (seq-filter (lambda (p) (assq p package-archive-contents)) not-installed))
+           (difference (- (length not-installed) (length available))))
+      (cond
+       (available
+        (when (y-or-n-p
+               (format "%s packages will be installed:\n%s, proceed?"
+                       (length available)
+                       (mapconcat #'symbol-name available ", ")))
+          (mapc (lambda (p) (package-install p 'dont-select)) available)))
+       ((> difference 0)
+        (message "%s packages are not available (the rest already installed), maybe you need to `M-x package-refresh-contents'"
+                 difference))
+       (t
+        (message "All your packages are already installed"))))))
 
 \f
 ;;; Package Deletion