]> 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 fbc8be482a25930e3c1e83ca30db06c5aeb02318..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)
@@ -182,7 +183,13 @@ If VERSION is a string, only that version is ever loaded.
  Any other version, even if newer, is silently ignored.
  Hence, the package is \"held\" at that version.
 If VERSION is nil, the package is not loaded (it is \"disabled\")."
-  :type '(repeat symbol)
+  :type '(repeat (choice (const all)
+                         (list :tag "Specific package"
+                               (symbol :tag "Package name")
+                               (choice :tag "Version"
+                                (const :tag "disable" nil)
+                                (const :tag "most recent" t)
+                                (string :tag "specific version")))))
   :risky t
   :version "24.1")
 
@@ -1147,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")))
@@ -1158,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)
@@ -1207,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)))
@@ -1419,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)
@@ -1446,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
@@ -1548,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))
 
@@ -1976,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))
@@ -2014,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