Even if the value is nil, you can type \\[package-initialize] to
activate the package system at any time."
:type 'boolean
- :group 'package
:version "24.1")
(defcustom package-load-list '(all)
If VERSION is nil, the package is not loaded (it is \"disabled\")."
:type '(repeat symbol)
:risky t
- :group 'package
:version "24.1")
(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
:type '(alist :key-type (string :tag "Archive name")
:value-type (string :tag "URL or directory name"))
:risky t
- :group 'package
:version "24.1")
+(defcustom package-menu-hide-low-priority 'archive
+ "If non-nil, hide low priority packages from the packages menu.
+A package is considered low priority if there's another version
+of it available such that:
+ (a) the archive of the other package is higher priority than
+ this one, as per `package-archive-priorities';
+ or
+ (b) they both have the same archive priority but the other
+ package has a higher version number.
+
+This variable has three possible values:
+ nil: no packages are hidden;
+ archive: only criteria (a) is used;
+ t: both criteria are used.
+
+This variable has no effect if `package-menu--hide-obsolete' is
+nil, so it can be toggled with \\<package-menu-mode-map> \\[package-menu-hide-obsolete]."
+ :type '(choice (const :tag "Don't hide anything" nil)
+ (const :tag "Hide per package-archive-priorities"
+ archive)
+ (const :tag "Hide per archive and version number" t))
+ :version "25.1")
+
(defcustom package-archive-priorities nil
"An alist of priorities for packages.
selected. When higher versions are available from archives with
lower priorities, the user has to select those manually.
-Archives not in this list have the priority 0."
+Archives not in this list have the priority 0.
+
+See also `package-menu-hide-low-priority'."
:type '(alist :key-type (string :tag "Archive name")
:value-type (integer :tag "Priority (default is 0)"))
:risky t
- :group 'package
:version "25.1")
(defcustom package-pinned-packages nil
;; via an entry (PACKAGE . NON-EXISTING). Which could be an issue
;; if PACKAGE has a known vulnerability that is fixed in newer versions.
:risky t
- :group 'package
:version "24.4")
(defcustom package-user-dir (locate-user-emacs-file "elpa")
packages in `package-directory-list'."
:type 'directory
:risky t
- :group 'package
:version "24.1")
(defcustom package-directory-list
contrast, `package-user-dir' contains packages for personal use."
:type '(repeat directory)
:risky t
- :group 'package
:version "24.1")
(defvar epg-gpg-program)
(const allow-unsigned :tag "Allow unsigned")
(const t :tag "Check always"))
:risky t
- :group 'package
:version "24.4")
(defcustom package-unsigned-archives nil
"List of archives where we do not check for package signatures."
:type '(repeat (string :tag "Archive name"))
:risky t
- :group 'package
:version "24.4")
(defcustom package-selected-packages nil
To check if a package is contained in this list here, use
`package--user-selected-p', as it may populate the variable with
a sane initial value."
- :group 'package
:type '(repeat symbol))
+(defcustom package-menu-async t
+ "If non-nil, package-menu will use async operations when possible.
+This includes refreshing archive contents as well as installing
+packages."
+ :type 'boolean
+ :version "25.1")
+
\f
;;; `package-desc' object definition
;; This is the struct used internally to represent packages.
(nth 1 keywords)
keywords)))
+(defun package-desc-priority (p)
+ "Return the priority of the archive of package-desc object P."
+ (package-archive-priority (package-desc-archive p)))
+
;; Package descriptor format used in finder-inf.el and package--builtins.
(cl-defstruct (package--bi-desc
(:constructor package-make-builtin (version summary))
(defvar generated-autoload-file)
(defvar version-control)
+(defvar package--silence nil)
+
(defun package-generate-autoloads (name pkg-dir)
(let* ((auto-name (format "%s-autoloads.el" name))
;;(ignore-name (concat name "-pkg.el"))
(generated-autoload-file (expand-file-name auto-name pkg-dir))
+ ;; Silence `autoload-generate-file-autoloads'.
+ (noninteractive package--silence)
(backup-inhibited t)
(version-control 'never))
(package-autoload-ensure-default-file generated-autoload-file)
deps))))
(declare-function lm-header "lisp-mnt" (header))
-(declare-function lm-homepage "lisp-mnt" ())
+(declare-function lm-homepage "lisp-mnt" (&optional file))
(defun package-buffer-info ()
"Return a `package-desc' describing the package in the current buffer.
(signal (cdar status) (cddr status)))
(goto-char (point-min))
(unless (search-forward "\n\n" nil 'noerror)
- (error "Invalid url response"))
+ (error "Invalid url response in buffer %s"
+ (current-buffer)))
(delete-region (point-min) (point))
,@body)
(kill-buffer (current-buffer)))
(let ((filename (expand-file-name file package-user-dir)))
(when (file-exists-p filename)
(with-temp-buffer
- (insert-file-contents-literally filename)
+ (let ((coding-system-for-read 'utf-8))
+ (insert-file-contents filename))
(let ((contents (read (current-buffer))))
(if (> (car contents) package-archive-version)
(error "Package archive version %d is higher than %d"
(declare-function epg-configuration "epg-config" ())
(declare-function epg-import-keys-from-file "epg" (context keys))
-(defvar package--silence nil)
-
(defun package--message (format &rest args)
"Like `message', except sometimes don't print to minibuffer.
If the variable `package--silence' is non-nil, the message is not
-displayed on the minibuffer."
- (apply #'message format args)
- (when package--silence
- (message nil)))
+displayed on the echo area."
+ (let ((inhibit-message package--silence))
+ (apply #'message format args)))
;;;###autoload
(defun package-import-keyring (&optional file)
perform the downloads asynchronously."
;; The downloaded archive contents will be read as part of
;; `package--update-downloads-in-progress'.
- (setq package--downloads-in-progress
- (append package-archives
- package--downloads-in-progress))
+ (dolist (archive package-archives)
+ (cl-pushnew archive package--downloads-in-progress
+ :test #'equal))
(dolist (archive package-archives)
(condition-case-unless-debug nil
(package--download-one-archive
Optional argument ASYNC specifies whether to perform the
downloads in the background."
(interactive)
- ;; FIXME: Do it asynchronously.
(unless (file-exists-p package-user-dir)
(make-directory package-user-dir t))
(let ((default-keyring (expand-file-name "package-keyring.gpg"
unless (memq name dep-list)
collect name)))
+(defun package--save-selected-packages (value)
+ "Set and save `package-selected-packages' to VALUE."
+ (let ((save-silently package--silence))
+ (customize-save-variable
+ 'package-selected-packages
+ (setq package-selected-packages value))))
+
(defun package--user-selected-p (pkg)
"Return non-nil if PKG is a package was installed by the user.
PKG is a package name.
This looks into `package-selected-packages', populating it first
if it is still empty."
(unless (consp package-selected-packages)
- (customize-save-variable
- 'package-selected-packages
- (setq package-selected-packages (package--find-non-dependencies))))
+ (package--save-selected-packages (package--find-non-dependencies)))
(memq pkg package-selected-packages))
(defun package--get-deps (pkg &optional only)
package-unsigned-archives))
;; If we don't care about the signature, unpack and we're
;; done.
- (progn (package-unpack pkg-desc)
+ (progn (let ((save-silently async))
+ (package-unpack pkg-desc))
(funcall callback))
;; If we care, check it and *then* write the file.
(let ((content (buffer-string)))
(package-desc-name pkg-desc)))
;; Signature checked, unpack now.
(with-temp-buffer (insert content)
- (package-unpack pkg-desc))
+ (let ((save-silently async))
+ (package-unpack pkg-desc)))
;; Here the package has been installed successfully, mark it as
;; signed if appropriate.
(when good-sigs
(contains-init
(if buffer
(with-current-buffer buffer
- (search-forward "(package-initialize)" nil 'noerror))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (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))
(save-restriction
(widen)
(goto-char (point-min))
+ (while (and (looking-at-p "[[:blank:]]*\\(;\\|$\\)")
+ (not (eobp)))
+ (forward-line 1))
(insert
+ "\n"
";; Added by Package.el. This must come before configurations of\n"
";; installed packages. Don't delete this line. If you don't want it,\n"
";; just comment it out by adding a semicolon to the start of the line.\n"
(package-desc-name pkg)
pkg)))
(unless (or dont-select (package--user-selected-p name))
- (customize-save-variable 'package-selected-packages
- (cons name package-selected-packages))))
+ (package--save-selected-packages
+ (cons name package-selected-packages))))
(if-let ((transaction
(if (package-desc-p pkg)
(unless (package-installed-p pkg)
;; Install the package itself.
(package-unpack pkg-desc)
(unless (package--user-selected-p name)
- (customize-save-variable 'package-selected-packages
- (cons name package-selected-packages)))
+ (package--save-selected-packages
+ (cons name package-selected-packages)))
pkg-desc))
;;;###autoload
(package-install-from-buffer)))
;;;###autoload
-(defun package-install-user-selected-packages ()
+(defun package-install-selected-packages ()
"Ensure packages in `package-selected-packages' are installed.
If some packages are not installed propose to install them."
(interactive)
;; Don't deselect if this is an older version of an
;; upgraded package.
(package--newest-p pkg-desc))
- (customize-save-variable
- 'package-selected-packages (remove name package-selected-packages)))
+ (package--save-selected-packages (remove name package-selected-packages)))
(cond ((not (string-prefix-p (file-name-as-directory
(expand-file-name package-user-dir))
(expand-file-name dir)))
(define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help)
(define-key map "?" 'package-menu-describe-package)
+ (define-key map "(" #'package-menu-hide-obsolete)
(define-key map [menu-bar package-menu] (cons "Package" menu-map))
(define-key menu-map [mq]
'(menu-item "Quit" quit-window
((version-list-= version hv) "held")
((version-list-< version hv) "obsolete")
(t "disabled"))))
- ((package-built-in-p name version) "obsolete")
- ((package--incompatible-p pkg-desc) "incompat")
(dir ;One of the installed packages.
(cond
((not (file-exists-p (package-desc-dir pkg-desc))) "deleted")
(if (package--user-selected-p name)
"installed" "dependency")))
(t "obsolete")))
+ ((package--incompatible-p pkg-desc) "incompat")
(t
(let* ((ins (cadr (assq name package-alist)))
(ins-v (if ins (package-desc-version ins))))
(cond
- ((or (null ins) (version-list-< ins-v version))
+ ;; Installed obsolete packages are handled in the `dir'
+ ;; clause above. Here we handle available obsolete, which
+ ;; are displayed depending on `package-menu--hide-obsolete'.
+ ((and ins (version-list-<= version ins-v)) "avail-obso")
+ (t
(if (memq name package-menu--new-package-list)
- "new" "available"))
- ((version-list-< version ins-v) "obsolete")
- ((version-list-= version ins-v)
- (if (not signed) "unsigned"
- (if (package--user-selected-p name)
- "installed" "dependency")))))))))
+ "new" "available"))))))))
+
+(defvar package-menu--hide-obsolete t
+ "Whether available obsolete packages should be hidden.
+Can be toggled with \\<package-menu-mode-map> \\[package-menu-hide-obsolete].
+Installed obsolete packages are always displayed.")
+
+(defun package-menu-hide-obsolete ()
+ "Toggle visibility of obsolete available packages."
+ (interactive)
+ (unless (derived-mode-p 'package-menu-mode)
+ (user-error "The current buffer is not a Package Menu"))
+ (setq package-menu--hide-obsolete
+ (not package-menu--hide-obsolete))
+ (message "%s available-obsolete packages" (if package-menu--hide-obsolete
+ "Hiding" "Displaying"))
+ (revert-buffer nil 'no-confirm))
+
+(defun package--remove-hidden (pkg-list)
+ "Filter PKG-LIST according to `package-archive-priorities'.
+PKG-LIST must be a list of package-desc objects, all with the
+same name, sorted by decreasing `package-desc-priority-version'.
+Return a list of packages tied for the highest priority according
+to their archives."
+ (when pkg-list
+ ;; Variable toggled with `package-menu-hide-obsolete'.
+ (if (not package-menu--hide-obsolete)
+ pkg-list
+ (let ((installed (cadr (assq (package-desc-name (car pkg-list))
+ package-alist))))
+ (when installed
+ (setq pkg-list
+ (let ((ins-version (package-desc-version installed)))
+ (cl-remove-if (lambda (p) (version-list-< (package-desc-version p)
+ ins-version))
+ pkg-list))))
+ (let ((filtered-by-priority
+ (cond
+ ((not package-menu-hide-low-priority)
+ pkg-list)
+ ((eq package-menu-hide-low-priority 'archive)
+ (let* ((max-priority most-negative-fixnum)
+ (out))
+ (while pkg-list
+ (let ((p (pop pkg-list)))
+ (if (>= (package-desc-priority p) max-priority)
+ (push p out)
+ (setq pkg-list nil))))
+ (nreverse out)))
+ (pkg-list
+ (list (car pkg-list))))))
+ (if (not installed)
+ filtered-by-priority
+ (let ((ins-version (package-desc-version installed)))
+ (cl-remove-if (lambda (p) (version-list-= (package-desc-version p)
+ ins-version))
+ filtered-by-priority))))))))
(defun package-menu--refresh (&optional packages keywords)
"Re-populate the `tabulated-list-entries'.
KEYWORDS should be nil or a list of keywords."
;; Construct list of (PKG-DESC . STATUS).
(unless packages (setq packages t))
- (let (info-list name)
+ (let (info-list)
;; Installed packages:
(dolist (elt package-alist)
- (setq name (car elt))
- (when (or (eq packages t) (memq name packages))
- (dolist (pkg (cdr elt))
- (when (package--has-keyword-p pkg keywords)
- (package--push pkg (package-desc-status pkg) info-list)))))
+ (let ((name (car elt)))
+ (when (or (eq packages t) (memq name packages))
+ (dolist (pkg (cdr elt))
+ (when (package--has-keyword-p pkg keywords)
+ (push pkg info-list))))))
;; Built-in packages:
(dolist (elt package--builtins)
- (setq name (car elt))
- (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
- (package--has-keyword-p (package--from-builtin elt) keywords)
- (or package-list-unversioned
- (package--bi-desc-version (cdr elt)))
- (or (eq packages t) (memq name packages)))
- (package--push (package--from-builtin elt) "built-in" info-list)))
+ (let ((pkg (package--from-builtin elt))
+ (name (car elt)))
+ (when (not (eq name 'emacs)) ; Hide the `emacs' package.
+ (when (and (package--has-keyword-p pkg keywords)
+ (or package-list-unversioned
+ (package--bi-desc-version (cdr elt)))
+ (or (eq packages t) (memq name packages)))
+ (push pkg info-list)))))
;; Available and disabled packages:
(dolist (elt package-archive-contents)
- (setq name (car elt))
- (when (or (eq packages t) (memq name packages))
- (dolist (pkg (cdr elt))
- ;; Hide obsolete packages.
- (when (and (not (package-installed-p (package-desc-name pkg)
- (package-desc-version pkg)))
- (package--has-keyword-p pkg keywords))
- (package--push pkg (package-desc-status pkg) info-list)))))
+ (let ((name (car elt)))
+ (when (or (eq packages t) (memq name packages))
+ ;; Hide available-obsolete or low-priority packages.
+ (dolist (pkg (package--remove-hidden (cdr elt)))
+ (when (package--has-keyword-p pkg keywords)
+ (push pkg info-list))))))
;; Print the result.
(setq tabulated-list-entries
- (mapcar #'package-menu--print-info info-list))))
+ (mapcar #'package-menu--print-info-simple info-list))))
(defun package-all-keywords ()
"Collect all package keywords"
- (let (keywords)
+ (let ((key-list))
(package--mapc (lambda (desc)
- (let* ((desc-keywords (and desc (package-desc--keywords desc))))
- (setq keywords (append keywords desc-keywords)))))
- keywords))
+ (setq key-list (append (package-desc--keywords desc)
+ key-list))))
+ key-list))
(defun package--mapc (function &optional packages)
"Call FUNCTION for all known PACKAGES.
"Test if package DESC has any of the given KEYWORDS.
When none are given, the package matches."
(if keywords
- (let* ((desc-keywords (and desc (package-desc--keywords desc)))
- found)
- (dolist (k keywords)
- (when (and (not found)
- (member k desc-keywords))
- (setq found t)))
+ (let ((desc-keywords (and desc (package-desc--keywords desc)))
+ found)
+ (while (and (not found) keywords)
+ (let ((k (pop keywords)))
+ (setq found
+ (or (string= k (concat "arc:" (package-desc-archive desc)))
+ (string= k (concat "status:" (package-desc-status desc)))
+ (member k desc-keywords)))))
found)
t))
"Return a package entry suitable for `tabulated-list-entries'.
PKG has the form (PKG-DESC . STATUS).
Return (PKG-DESC [NAME VERSION STATUS DOC])."
- (let* ((pkg-desc (car pkg))
- (status (cdr pkg))
+ (package-menu--print-info-simple (car pkg)))
+(make-obsolete 'package-menu--print-info
+ 'package-menu--print-info-simple "25.1")
+
+(defun package-menu--print-info-simple (pkg)
+ "Return a package entry suitable for `tabulated-list-entries'.
+PKG is a package-desc object.
+Return (PKG-DESC [NAME VERSION STATUS DOC])."
+ (let* ((status (package-desc-status pkg))
(face (pcase status
(`"built-in" 'font-lock-builtin-face)
(`"available" 'default)
+ (`"avail-obso" 'font-lock-comment-face)
(`"new" 'bold)
(`"held" 'font-lock-constant-face)
(`"disabled" 'font-lock-warning-face)
(`"unsigned" 'font-lock-warning-face)
(`"incompat" 'font-lock-comment-face)
(_ 'font-lock-warning-face)))) ; obsolete.
- (list pkg-desc
- `[,(list (symbol-name (package-desc-name pkg-desc))
- 'face 'link
- 'follow-link t
- 'package-desc pkg-desc
- 'action 'package-menu-describe-package)
+ (list pkg
+ `[(,(symbol-name (package-desc-name pkg))
+ face link
+ follow-link t
+ package-desc ,pkg
+ action package-menu-describe-package)
,(propertize (package-version-join
- (package-desc-version pkg-desc))
+ (package-desc-version pkg))
'font-lock-face face)
,(propertize status 'font-lock-face face)
,@(if (cdr package-archives)
- (list (propertize (or (package-desc-archive pkg-desc) "")
+ (list (propertize (or (package-desc-archive pkg) "")
'font-lock-face face)))
- ,(propertize (package-desc-summary pkg-desc)
- 'font-lock-face face)])))
+ ,(package-desc-summary pkg)])))
+
+(defvar package-menu--old-archive-contents nil
+ "`package-archive-contents' before the latest refresh.")
(defun package-menu-refresh ()
"Download the Emacs Lisp package archive.
(defun package-menu-mark-install (&optional _num)
"Mark a package for installation and move to the next line."
(interactive "p")
- (if (member (package-menu-get-status) '("available" "new" "dependency"))
+ (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency"))
(tabulated-list-put-tag "I" t)
(forward-line)))
(defvar package--quick-help-keys
'(("install," "delete," "unmark," ("execute" . 1))
("next," "previous")
- ("refresh-contents," "g-redisplay," "filter," "help")))
+ ("refresh-contents," "g-redisplay," "filter," "(-toggle-obsolete" "help")))
(defun package--prettify-quick-help-key (desc)
"Prettify DESC to be displayed as a help menu."
This allows for easy comparison of package versions from
different archives if archive priorities are meant to be taken in
consideration."
- (cons (package-archive-priority
- (package-desc-archive pkg-desc))
+ (cons (package-desc-priority pkg-desc)
(package-desc-version pkg-desc)))
(defun package-menu--find-upgrades ()
(del (cl-set-difference delete upg :key #'package-desc-name)))
(y-or-n-p
(concat
- (when upg "UPGRADE ")
- (package-menu--list-to-prompt upg)
- (when (and upg ins)
- (if del "; " "; and "))
- (when ins "INSTALL ")
- (package-menu--list-to-prompt ins)
- (when (and del (or ins upg)) "; and ")
- (when del "DELETE ")
+ (when del "Delete ")
(package-menu--list-to-prompt del)
+ (when (and del ins)
+ (if upg "; " "; and "))
+ (when ins "Install ")
+ (package-menu--list-to-prompt ins)
+ (when (and upg (or ins del)) "; and ")
+ (when upg "Upgrade ")
+ (package-menu--list-to-prompt upg)
"? "))))
(defun package-menu--perform-transaction (install-list delete-list &optional async)
(lambda () (package-menu--perform-transaction rest delete-list async))))
;; Once there are no more packages to install, proceed to
;; deletion.
- (dolist (elt (package--sort-by-dependence delete-list))
- (condition-case-unless-debug err
- (package-delete elt)
- (error (message (cadr err)))))
- (when package-selected-packages
- (when-let ((removable (package--removable-packages)))
- (package--message "These %d packages are no longer needed, type `M-x package-autoremove' to remove them (%s)"
- (length removable)
- (mapconcat #'symbol-name removable ", "))))
+ (let ((package--silence async))
+ (dolist (elt (package--sort-by-dependence delete-list))
+ (condition-case-unless-debug err
+ (package-delete elt)
+ (error (message (cadr err)))))
+ (when package-selected-packages
+ (when-let ((removable (package--removable-packages)))
+ (package--message "These %d packages are no longer needed, type `M-x package-autoremove' to remove them (%s)"
+ (length removable)
+ (mapconcat #'symbol-name removable ", ")))))
+ (message "Transaction done")
(package-menu--post-refresh)))
(defun package-menu-execute (&optional noquery)
(user-error "No operations specified"))
(when (or noquery
(package-menu--prompt-transaction-p install-list delete-list))
- (let ((package--silence package-menu-async))
- ;; This calls `package-menu--generate' after everything's done.
- (package-menu--perform-transaction
- install-list delete-list package-menu-async)))))
+ (message "Transaction started")
+ ;; This calls `package-menu--generate' after everything's done.
+ (package-menu--perform-transaction
+ install-list delete-list package-menu-async))))
(defun package-menu--version-predicate (A B)
(let ((vA (or (aref (cadr A) 1) '(0)))
(package-menu--name-predicate A B))
((string= sA "new") t)
((string= sB "new") nil)
- ((string= sA "available") t)
- ((string= sB "available") nil)
+ ((string-prefix-p "avail" sA)
+ (if (string-prefix-p "avail" sB)
+ (package-menu--name-predicate A B)
+ t))
+ ((string-prefix-p "avail" sB) nil)
((string= sA "installed") t)
((string= sB "installed") nil)
((string= sA "dependency") t)
(string< (or (package-desc-archive (car A)) "")
(or (package-desc-archive (car B)) "")))
-(defvar package-menu--old-archive-contents nil
- "`package-archive-contents' before the latest refresh.")
-
(defun package-menu--populate-new-package-list ()
"Decide which packages are new in `package-archives-contents'.
Store this list in `package-menu--new-package-list'."
(revert-buffer nil 'noconfirm))))
(package-menu--find-and-notify-upgrades))
-(defcustom package-menu-async t
- "If non-nil, package-menu will use async operations when possible.
-This includes refreshing archive contents as well as installing
-packages."
- :type 'boolean
- :group 'package)
-
;;;###autoload
(defun list-packages (&optional no-fetch)
"Display a list of packages.
(defun package-menu-filter (keyword)
"Filter the *Packages* buffer.
Show only those items that relate to the specified KEYWORD.
+KEYWORD can be a string or a list of strings. If it is a list, a
+package will be displayed if it matches any of the keywords.
+Interactively, it is a list of strings separated by commas.
+
To restore the full package list, type `q'."
- (interactive (list (completing-read "Keyword: " (package-all-keywords))))
- (package-show-package-list t (list keyword)))
+ (interactive
+ (list (completing-read-multiple
+ "Keywords (comma separated): " (package-all-keywords))))
+ (package-show-package-list t (if (stringp keyword)
+ (list keyword)
+ keyword)))
(defun package-list-packages-no-fetch ()
"Display a list of packages.