]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/package.el
* lisp/emacs-lisp/package.el (package--with-response-buffer): Missing require
[gnu-emacs] / lisp / emacs-lisp / package.el
index 3d2dbdf8712172e4fd478e788a2097eb61da42d7..2aea9d11d1f0c700ae05f0404d27477712573545 100644 (file)
@@ -234,7 +234,7 @@ of it available such that:
 
 This variable has three possible values:
     nil: no packages are hidden;
-    archive: only criteria (a) is used;
+    `archive': only criteria (a) is used;
     t: both criteria are used.
 
 This variable has no effect if `package-menu--hide-packages' is
@@ -456,13 +456,13 @@ This is, approximately, the inverse of `version-to-list'.
           (push (int-to-string num) str-list)
           (push "." str-list))
          ((< num -4)
-          (error "Invalid version list ‘%s’" vlist))
+          (error "Invalid version list `%s'" vlist))
          (t
           ;; pre, or beta, or alpha
           (cond ((equal "." (car str-list))
                  (pop str-list))
                 ((not (string-match "[0-9]+" (car str-list)))
-                 (error "Invalid version list ‘%s’" vlist)))
+                 (error "Invalid version list `%s'" vlist)))
           (push (cond ((= num -1) "pre")
                       ((= num -2) "beta")
                       ((= num -3) "alpha")
@@ -623,7 +623,7 @@ Return the max version (as a string) if the package is held at a lower version."
           ((stringp force)              ; held
            (unless (version-list-= version (version-to-list force))
              force))
-          (t (error "Invalid element in ‘package-load-list’")))))
+          (t (error "Invalid element in `package-load-list'")))))
 
 (defun package-built-in-p (package &optional min-version)
   "Return true if PACKAGE is built-in to Emacs.
@@ -639,6 +639,28 @@ specifying the minimum acceptable version."
         (require 'finder-inf nil t) ; For `package--builtins'.
         (assq package package--builtins))))))
 
+(defun package--autoloads-file-name (pkg-desc)
+  "Return the absolute name of the autoloads file, sans extension.
+PKG-DESC is a `package-desc' object."
+  (expand-file-name
+   (format "%s-autoloads" (package-desc-name pkg-desc))
+   (package-desc-dir pkg-desc)))
+
+(defun package--activate-autoloads-and-load-path (pkg-desc)
+  "Load the autoloads file and add package dir to `load-path'.
+PKG-DESC is a `package-desc' object."
+  (let* ((old-lp load-path)
+         (pkg-dir (package-desc-dir pkg-desc))
+         (pkg-dir-dir (file-name-as-directory pkg-dir)))
+    (with-demoted-errors "Error loading autoloads: %s"
+      (load (package--autoloads-file-name pkg-desc) nil t))
+    (when (and (eq old-lp load-path)
+               (not (or (member pkg-dir load-path)
+                        (member pkg-dir-dir load-path))))
+      ;; Old packages don't add themselves to the `load-path', so we have to
+      ;; do it ourselves.
+      (push pkg-dir load-path))))
+
 (defvar Info-directory-list)
 (declare-function info-initialize "info" ())
 
@@ -648,24 +670,14 @@ If RELOAD is non-nil, also `load' any files inside the package which
 correspond to previously loaded files (those returned by
 `package--list-loaded-files')."
   (let* ((name (package-desc-name pkg-desc))
-         (pkg-dir (package-desc-dir pkg-desc))
-         (pkg-dir-dir (file-name-as-directory pkg-dir)))
+         (pkg-dir (package-desc-dir pkg-desc)))
     (unless pkg-dir
-      (error "Internal error: unable to find directory for ‘%s’"
+      (error "Internal error: unable to find directory for `%s'"
              (package-desc-full-name pkg-desc)))
-    ;; Add to load path, add autoloads, and activate the package.
-    (let* ((old-lp load-path)
-           (autoloads-file (expand-file-name
-                            (format "%s-autoloads" name) pkg-dir))
-           (loaded-files-list (and reload (package--list-loaded-files pkg-dir))))
-      (with-demoted-errors "Error in package-activate-1: %s"
-        (load autoloads-file nil t))
-      (when (and (eq old-lp load-path)
-                 (not (or (member pkg-dir load-path)
-                          (member pkg-dir-dir load-path))))
-        ;; Old packages don't add themselves to the `load-path', so we have to
-        ;; do it ourselves.
-        (push pkg-dir load-path))
+    (let* ((loaded-files-list (when reload
+                                (package--list-loaded-files pkg-dir))))
+      ;; Add to load path, add autoloads, and activate the package.
+      (package--activate-autoloads-and-load-path pkg-desc)
       ;; Call `load' on all files in `pkg-dir' already present in
       ;; `load-history'.  This is done so that macros in these files are updated
       ;; to their new definitions.  If another package is being installed which
@@ -674,7 +686,8 @@ correspond to previously loaded files (those returned by
       (with-demoted-errors "Error in package-activate-1: %s"
         (mapc (lambda (feature) (load feature nil t))
               ;; Skip autoloads file since we already evaluated it above.
-              (remove (file-truename autoloads-file) loaded-files-list))))
+              (remove (file-truename (package--autoloads-file-name pkg-desc))
+                      loaded-files-list))))
     ;; Add info node.
     (when (file-exists-p (expand-file-name "dir" pkg-dir))
       ;; FIXME: not the friendliest, but simple.
@@ -754,8 +767,8 @@ Newer versions are always activated, regardless of FORCE."
                        (unless (package-activate (car req))
                          (throw 'dep-failure req))))))
         (if fail
-            (warn "Unable to activate package ‘%s’.
-Required package ‘%s-%s’ is unavailable"
+            (warn "Unable to activate package `%s'.
+Required package `%s-%s' is unavailable"
                   package (car fail) (package-version-join (cadr fail)))
           ;; If all goes well, activate the package itself.
           (package-activate-1 pkg-vec force)))))))
@@ -876,7 +889,8 @@ untar into a directory named DIR; otherwise, signal an error."
              " --- automatically extracted autoloads\n"
              ";;\n"
              ";;; Code:\n"
-             "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n"
+             ;; `load-path' should contain only directory names
+             "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n"
              "\f\n;; Local Variables:\n"
              ";; version-control: never\n"
              ";; no-byte-compile: t\n"
@@ -919,8 +933,9 @@ untar into a directory named DIR; otherwise, signal an error."
 (defun package--compile (pkg-desc)
   "Byte-compile installed package PKG-DESC."
   (let ((warning-minimum-level :error)
-        (save-silently inhibit-message))
-    (package-activate-1 pkg-desc)
+        (save-silently inhibit-message)
+        (load-path load-path))
+    (package--activate-autoloads-and-load-path pkg-desc)
     (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
 
 ;;;; Inferring package from current buffer
@@ -1109,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))
@@ -1119,47 +1135,53 @@ 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)))
+                                (require 'url-handlers)
+                                (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)
+                                                   (error "Error retrieving: %s %S" url "incomprehensible buffer"))
+                                                 (with-temp-buffer
+                                                   (url-insert-buffer-contents b url)
+                                                   (kill-buffer b)
+                                                   (goto-char (point-min))
+                                                   ,@body)))))))
+             (if ,async
+                 (wrap-errors (url-retrieve url callback nil 'silent))
+               (with-current-buffer (wrap-errors (url-retrieve-synchronously url 'silent))
+                 (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.
@@ -1205,15 +1227,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))))
 \f
 ;;; Packages on Archives
 ;; The following variables store information about packages available
@@ -1350,10 +1369,18 @@ If the archive version is too new, signal an error."
       (dolist (package contents)
         (package--add-to-archive-contents package archive)))))
 
+(defvar package--old-archive-priorities nil
+  "Store currently used `package-archive-priorities'.
+This is the value of `package-archive-priorities' last time
+`package-read-all-archive-contents' was called.  It can be used
+by arbitrary functions to decide whether it is necessary to call
+it again.")
+
 (defun package-read-all-archive-contents ()
   "Re-read `archive-contents', if it exists.
 If successful, set `package-archive-contents'."
   (setq package-archive-contents nil)
+  (setq package--old-archive-priorities package-archive-priorities)
   (dolist (archive package-archives)
     (package-read-archive-contents (car archive))))
 
@@ -1372,13 +1399,18 @@ If successful, set `package-archive-contents'."
 The variable `package-load-list' controls which packages to load.
 If optional arg NO-ACTIVATE is non-nil, don't activate packages.
 If `user-init-file' does not mention `(package-initialize)', add
-it to the file."
+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."
   (interactive)
   (setq package-alist nil)
   (if (equal user-init-file load-file-name)
       ;; If `package-initialize' is being called as part of loading
       ;; the init file, it's obvious we don't need to ensure-init.
-      (setq package--init-file-ensured t)
+      (setq package--init-file-ensured t
+            ;; And likely we don't need to run it again after init.
+            package-enable-at-startup nil)
     (package--ensure-init-file))
   (package-load-all-descriptors)
   (package-read-all-archive-contents)
@@ -1442,7 +1474,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))
@@ -1465,18 +1499,15 @@ similar to an entry in `package-alist'.  Save the cached copy to
                ;; Even if the sig fails, this download is done, so
                ;; remove it from the in-progress list.
                (package--update-downloads-in-progress archive)
-               (error "Unsigned archive ‘%s’" name))
+               (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.
@@ -1489,13 +1520,8 @@ 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)))
-      (error (message "Failed to download ‘%s’ archive."
+        (package--download-one-archive archive "archive-contents" async)
+      (error (message "Failed to download `%s' archive."
                (car archive))))))
 
 ;;;###autoload
@@ -1564,7 +1590,7 @@ SEEN is used internally to detect infinite recursion."
                          (package-desc-full-name already))
               (setq packages (delq already packages))
               (setq already nil))
-          (error "Need package ‘%s-%s’, but only %s is being installed"
+          (error "Need package `%s-%s', but only %s is being installed"
                  next-pkg (package-version-join next-version)
                  (package-version-join (package-desc-version already)))))
       (cond
@@ -1592,20 +1618,21 @@ SEEN is used internally to detect infinite recursion."
                 (unless problem
                   (setq problem
                         (if (stringp disabled)
-                            (format "Package ‘%s’ held at version %s, but version %s required"
-                                    next-pkg disabled
-                                    (package-version-join next-version))
-                          (format "Required package ‘%s’ is disabled"
-                                  next-pkg)))))
+                            (format-message
+                             "Package `%s' held at version %s, but version %s required"
+                             next-pkg disabled
+                             (package-version-join next-version))
+                          (format-message "Required package `%s' is disabled"
+                                          next-pkg)))))
                (t (setq found pkg-desc)))))
           (unless found
             (cond
              (problem (error "%s" problem))
              (found-something
-              (error "Need package ‘%s-%s’, but only %s is available"
+              (error "Need package `%s-%s', but only %s is available"
                      next-pkg (package-version-join next-version)
                      found-something))
-             (t (error "Package ‘%s-%s’ is unavailable"
+             (t (error "Package `%s-%s' is unavailable"
                        next-pkg (package-version-join next-version)))))
           (setq packages
                 (package-compute-transaction (cons found packages)
@@ -1748,7 +1775,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))
@@ -1765,7 +1792,7 @@ if all the in-between dependencies are also in PACKAGE-LIST."
              (unless (or good-sigs (eq package-check-signature 'allow-unsigned))
                ;; Even if the sig fails, this download is done, so
                ;; remove it from the in-progress list.
-               (error "Unsigned package: ‘%s’"
+               (error "Unsigned package: `%s'"
                  (package-desc-name pkg-desc)))
              ;; Signature checked, unpack now.
              (with-temp-buffer (insert content)
@@ -1832,12 +1859,12 @@ add a call to it along with some explanatory comments."
                     (save-restriction
                       (widen)
                       (goto-char (point-min))
-                      (search-forward "(package-initialize)" nil 'noerror))))
+                      (re-search-forward "(package-initialize\\_>" nil 'noerror))))
               ;; Don't visit the file if we don't have to.
               (with-temp-buffer
                 (insert-file-contents user-init-file)
                 (goto-char (point-min))
-                (search-forward "(package-initialize)" nil 'noerror)))))
+                (re-search-forward "(package-initialize\\_>" nil 'noerror)))))
       (unless contains-init
         (with-current-buffer (or buffer
                                  (let ((delay-mode-hooks t))
@@ -1867,7 +1894,7 @@ add a call to it along with some explanatory comments."
 ;;;###autoload
 (defun package-install (pkg &optional dont-select)
   "Install the package PKG.
-PKG can be a package-desc or the package name of one the available packages
+PKG can be a package-desc or a symbol naming one of the available packages
 in an archive in `package-archives'.  Interactively, prompt for its name.
 
 If called interactively or if DONT-SELECT nil, add PKG to
@@ -1898,15 +1925,15 @@ to install it but still mark it as selected."
                 pkg)))
     (unless (or dont-select (package--user-selected-p name))
       (package--save-selected-packages
-       (cons name package-selected-packages))))
-  (if-let ((transaction
-            (if (package-desc-p pkg)
-                (unless (package-installed-p pkg)
-                  (package-compute-transaction (list pkg)
-                                               (package-desc-reqs pkg)))
-              (package-compute-transaction () (list (list pkg))))))
-      (package-download-transaction transaction)
-    (message "‘%s’ is already installed" (package-desc-full-name pkg))))
+       (cons name package-selected-packages)))
+    (if-let ((transaction
+              (if (package-desc-p pkg)
+                  (unless (package-installed-p pkg)
+                    (package-compute-transaction (list pkg)
+                                                 (package-desc-reqs pkg)))
+                (package-compute-transaction () (list (list pkg))))))
+        (package-download-transaction transaction)
+      (message "`%s' is already installed" name))))
 
 (defun package-strip-rcs-id (str)
   "Strip RCS version ID from the version string STR.
@@ -1981,7 +2008,7 @@ If some packages are not installed propose to install them."
   ;; using here, because the outcome is the same either way (nothing
   ;; gets installed).
   (if (not package-selected-packages)
-      (message "‘package-selected-packages’ is empty, nothing to install")
+      (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
@@ -2046,13 +2073,13 @@ If NOSAVE is non-nil, the package is not removed from
                                   (expand-file-name package-user-dir))
                                  (expand-file-name dir)))
            ;; Don't delete "system" packages.
-           (error "Package ‘%s’ is a system package, not deleting"
+           (error "Package `%s' is a system package, not deleting"
                   (package-desc-full-name pkg-desc)))
           ((and (null force)
                 (setq pkg-used-elsewhere-by
                       (package--used-elsewhere-p pkg-desc)))
            ;; Don't delete packages used as dependency elsewhere.
-           (error "Package ‘%s’ is used by ‘%s’ as dependency, not deleting"
+           (error "Package `%s' is used by `%s' as dependency, not deleting"
                   (package-desc-full-name pkg-desc)
                   (package-desc-name pkg-used-elsewhere-by)))
           (t
@@ -2067,7 +2094,7 @@ If NOSAVE is non-nil, the package is not removed from
              (delete pkg-desc pkgs)
              (unless (cdr pkgs)
                (setq package-alist (delq pkgs package-alist))))
-           (message "Package ‘%s’ deleted." (package-desc-full-name pkg-desc))))))
+           (message "Package `%s' deleted." (package-desc-full-name pkg-desc))))))
 
 ;;;###autoload
 (defun package-reinstall (pkg)
@@ -2096,7 +2123,8 @@ will be deleted."
   ;; do absolutely nothing.
   (when (or package-selected-packages
             (yes-or-no-p
-             "‘package-selected-packages’ is empty! Really remove ALL packages? "))
+             (format-message
+              "`package-selected-packages' is empty! Really remove ALL packages? ")))
     (let ((removable (package--removable-packages)))
       (if removable
           (when (y-or-n-p
@@ -2143,7 +2171,7 @@ will be deleted."
       (with-current-buffer standard-output
         (describe-package-1 package)))))
 
-(defface package-help-section-name-face
+(defface package-help-section-name
   '((t :inherit (bold font-lock-function-name-face)))
   "Face used on section names in package description buffers."
   :version "25.1")
@@ -2154,7 +2182,7 @@ If more STRINGS are provided, insert them followed by a newline.
 Otherwise no newline is inserted."
   (declare (indent 1))
   (insert (make-string (max 0 (- 11 (string-width name))) ?\s)
-          (propertize (concat name ": ") 'font-lock-face 'package-help-section-name-face))
+          (propertize (concat name ": ") 'font-lock-face 'package-help-section-name))
   (when strings
     (apply #'insert strings)
     (insert "\n")))
@@ -2204,7 +2232,7 @@ Otherwise no newline is inserted."
                                    "Installed"
                                  (capitalize status))
                                'font-lock-face 'package-status-builtin-face))
-           (insert (substitute-command-keys " in "))
+           (insert (substitute-command-keys " in `"))
            (let ((dir (abbreviate-file-name
                        (file-name-as-directory
                         (if (file-in-directory-p pkg-dir package-user-dir)
@@ -2214,10 +2242,10 @@ Otherwise no newline is inserted."
            (if (and (package-built-in-p name)
                     (not (package-built-in-p name version)))
                (insert (substitute-command-keys
-                        ",\n             shadowing a ")
+                        "',\n             shadowing a ")
                        (propertize "built-in package"
                                    'font-lock-face 'package-status-builtin-face))
-             (insert (substitute-command-keys "")))
+             (insert (substitute-command-keys "'")))
            (if signed
                (insert ".")
              (insert " (unsigned)."))
@@ -2338,26 +2366,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)
@@ -2365,16 +2390,16 @@ Otherwise no newline is inserted."
 
 (defun package-install-button-action (button)
   (let ((pkg-desc (button-get button 'package-desc)))
-    (when (y-or-n-p (format "Install package ‘%s’? "
-                            (package-desc-full-name pkg-desc)))
+    (when (y-or-n-p (format-message "Install package `%s'? "
+                                    (package-desc-full-name pkg-desc)))
       (package-install pkg-desc nil)
       (revert-buffer nil t)
       (goto-char (point-min)))))
 
 (defun package-delete-button-action (button)
   (let ((pkg-desc (button-get button 'package-desc)))
-    (when (y-or-n-p (format "Delete package ‘%s’? "
-                      (package-desc-full-name pkg-desc)))
+    (when (y-or-n-p (format-message "Delete package `%s'? "
+                                    (package-desc-full-name pkg-desc)))
       (package-delete pkg-desc)
       (revert-buffer nil t)
       (goto-char (point-min)))))
@@ -2654,6 +2679,8 @@ KEYWORDS should be nil or a list of keywords."
             (push pkg info-list)))))
 
     ;; Available and disabled packages:
+    (unless (equal package--old-archive-priorities package-archive-priorities)
+      (package-read-all-archive-contents))
     (dolist (elt package-archive-contents)
       (let ((name (car elt)))
         ;; To be displayed it must be in PACKAGES;
@@ -2758,68 +2785,68 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
 
 \f
 ;;; Package menu faces
-(defface package-name-face
+(defface package-name
   '((t :inherit link))
   "Face used on package names in the package menu."
   :version "25.1")
 
-(defface package-description-face
+(defface package-description
   '((t :inherit default))
   "Face used on package description summaries in the package menu."
   :version "25.1")
 
-(defface package-status-built-in-face
+(defface package-status-built-in
   '((t :inherit font-lock-builtin-face))
   "Face used on the status and version of built-in packages."
   :version "25.1")
 
-(defface package-status-external-face
+(defface package-status-external
   '((t :inherit package-status-builtin-face))
   "Face used on the status and version of external packages."
   :version "25.1")
 
-(defface package-status-available-face
+(defface package-status-available
   '((t :inherit default))
   "Face used on the status and version of available packages."
   :version "25.1")
 
-(defface package-status-new-face
-  '((t :inherit (bold package-status-available-face)))
+(defface package-status-new
+  '((t :inherit (bold package-status-available)))
   "Face used on the status and version of new packages."
   :version "25.1")
 
-(defface package-status-held-face
+(defface package-status-held
   '((t :inherit font-lock-constant-face))
   "Face used on the status and version of held packages."
   :version "25.1")
 
-(defface package-status-disabled-face
+(defface package-status-disabled
   '((t :inherit font-lock-warning-face))
   "Face used on the status and version of disabled packages."
   :version "25.1")
 
-(defface package-status-installed-face
+(defface package-status-installed
   '((t :inherit font-lock-comment-face))
   "Face used on the status and version of installed packages."
   :version "25.1")
 
-(defface package-status-dependency-face
-  '((t :inherit package-status-installed-face))
+(defface package-status-dependency
+  '((t :inherit package-status-installed))
   "Face used on the status and version of dependency packages."
   :version "25.1")
 
-(defface package-status-unsigned-face
+(defface package-status-unsigned
   '((t :inherit font-lock-warning-face))
   "Face used on the status and version of unsigned packages."
   :version "25.1")
 
-(defface package-status-incompat-face
+(defface package-status-incompat
   '((t :inherit font-lock-comment-face))
   "Face used on the status and version of incompat packages."
   :version "25.1")
 
-(defface package-status-avail-obso-face
-  '((t :inherit package-status-incompat-face))
+(defface package-status-avail-obso
+  '((t :inherit package-status-incompat))
   "Face used on the status and version of avail-obso packages."
   :version "25.1")
 
@@ -2831,22 +2858,22 @@ PKG is a package-desc object.
 Return (PKG-DESC [NAME VERSION STATUS DOC])."
   (let* ((status  (package-desc-status pkg))
          (face (pcase status
-                 (`"built-in"  'package-status-built-in-face)
-                 (`"external"  'package-status-external-face)
-                 (`"available" 'package-status-available-face)
-                 (`"avail-obso" 'package-status-avail-obso-face)
-                 (`"new"       'package-status-new-face)
-                 (`"held"      'package-status-held-face)
-                 (`"disabled"  'package-status-disabled-face)
-                 (`"installed" 'package-status-installed-face)
-                 (`"dependency" 'package-status-dependency-face)
-                 (`"unsigned"  'package-status-unsigned-face)
-                 (`"incompat"  'package-status-incompat-face)
+                 (`"built-in"  'package-status-built-in)
+                 (`"external"  'package-status-external)
+                 (`"available" 'package-status-available)
+                 (`"avail-obso" 'package-status-avail-obso)
+                 (`"new"       'package-status-new)
+                 (`"held"      'package-status-held)
+                 (`"disabled"  'package-status-disabled)
+                 (`"installed" 'package-status-installed)
+                 (`"dependency" 'package-status-dependency)
+                 (`"unsigned"  'package-status-unsigned)
+                 (`"incompat"  'package-status-incompat)
                  (_            'font-lock-warning-face)))) ; obsolete.
     (list pkg
           `[(,(symbol-name (package-desc-name pkg))
-             face package-name-face
-             font-lock-face package-name-face
+             face package-name
+             font-lock-face package-name
              follow-link t
              package-desc ,pkg
              action package-menu-describe-package)
@@ -2858,7 +2885,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
                   (list (propertize (or (package-desc-archive pkg) "")
                                     'font-lock-face face)))
             ,(propertize (package-desc-summary pkg)
-                         'font-lock-face 'package-description-face)])))
+                         'font-lock-face 'package-description)])))
 
 (defvar package-menu--old-archive-contents nil
   "`package-archive-contents' before the latest refresh.")
@@ -2892,8 +2919,8 @@ If optional arg BUTTON is non-nil, describe its associated package."
            (cl-remove-if-not (lambda (e) (string-match re (symbol-name (car e))))
                              package-archive-contents)))
       (message (substitute-command-keys
-                (concat "Hiding %s packages, type ‘\\[package-menu-toggle-hiding]’"
-                        " to toggle or ‘\\[customize-variable] RET package-hidden-regexps’"
+                (concat "Hiding %s packages, type `\\[package-menu-toggle-hiding]'"
+                        " to toggle or `\\[customize-variable] RET package-hidden-regexps'"
                         " to customize it"))
         (length hidden)))))
 
@@ -3077,8 +3104,8 @@ prompt (see `package-menu--prompt-transaction-p')."
       (length packages)
       (mapconcat #'package-desc-full-name packages ", ")))
    ;; Exactly 1
-   (t (format "package ‘%s’"
-        (package-desc-full-name (car packages))))))
+   (t (format-message "package `%s'"
+                      (package-desc-full-name (car packages))))))
 
 (defun package-menu--prompt-transaction-p (delete install upgrade)
   "Prompt the user about DELETE, INSTALL, and UPGRADE.
@@ -3133,7 +3160,7 @@ objects removed."
       (condition-case-unless-debug err
           (let ((inhibit-message package-menu-async))
             (package-delete elt nil 'nosave))
-        (error (message "Error trying to delete ‘%s’: %S"
+        (error (message "Error trying to delete `%s': %S"
                  (package-desc-full-name elt)
                  err))))))
 
@@ -3264,7 +3291,7 @@ Store this list in `package-menu--new-package-list'."
 (defun package-menu--find-and-notify-upgrades ()
   "Notify the user of upgradable packages."
   (when-let ((upgrades (package-menu--find-upgrades)))
-    (message "%d package%s can be upgraded; type ‘%s’ to mark %s for upgrading."
+    (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
       (length upgrades)
       (if (= (length upgrades) 1) "" "s")
       (substitute-command-keys "\\[package-menu-mark-upgrades]")