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
(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" ())
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'"
(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
(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.
" --- 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"
(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
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))
(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.
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
(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))))
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)
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))
;; 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.
: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))))))
(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
(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))
(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))
;;;###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
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.
;; 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
(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")
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")))
"Installed"
(capitalize status))
'font-lock-face 'package-status-builtin-face))
- (insert (format " 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)
(help-insert-xref-button dir 'help-package-def pkg-dir))
(if (and (package-built-in-p name)
(not (package-built-in-p name version)))
- (insert (format "’,\n shadowing a ")
+ (insert (substitute-command-keys
+ "',\n shadowing a ")
(propertize "built-in package"
'font-lock-face 'package-status-builtin-face))
- (insert (format "’")))
+ (insert (substitute-command-keys "'")))
(if signed
(insert ".")
(insert " (unsigned)."))
(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)
(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)))))
(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;
\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")
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)
(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.")
(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.
(if-let ((removable (package--removable-packages)))
(message "Package menu: Operation finished. %d packages %s"
(length removable)
- "are no longer needed, type `M-x package-autoremove' to remove them")
+ (substitute-command-keys
+ "are no longer needed, type `\\[package-autoremove]' to remove them"))
(message (replace-regexp-in-string "__" "ed" message-template)
"finished"))))))))