emacs/lisp/emacs-lisp/package-activate.el
Philip Kaludercic 02af0e93a0
; Reset :initialize for 'package-autosuggest-mode'
* lisp/emacs-lisp/package-activate.el (package-autosuggest-mode):
We don't need a special initializer for the minor mode, if we
are not enabling the option OOTB.
2026-02-12 18:20:15 +01:00

683 lines
28 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; package-activate.el --- Core of the Emacs Package Manager -*- lexical-binding:t -*-
;; Copyright (C) 2007-2026 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Daniel Hackney <dan@haxney.org>
;; Created: 10 Mar 2007
;; Version: 1.1.0
;; Keywords: tools
;; Package-Requires: ((tabulated-list "1.0"))
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file contains the core definitions of package.el used to
;; activate packages at startup, as well as other functions that are
;; useful without having to load the entirety of package.el.
;; Note that the contents of this file are preloaded!
;;; Code:
(eval-when-compile (require 'cl-lib))
(defcustom package-load-list '(all)
"List of packages for `package-activate-all' to make available.
Each element in this list should be a list (NAME VERSION), or the
symbol `all'. The symbol `all' says to make available the latest
installed versions of all packages not specified by other
elements.
For an element (NAME VERSION), NAME is a package name (a symbol).
VERSION should be t, a string, or nil.
If VERSION is t, the most recent version is made available.
If VERSION is a string, only that version is ever made available.
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 made available (it is \"disabled\")."
: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"
:group 'package)
(defvar package--default-summary "No description available.")
(define-inline package-vc-p (pkg-desc)
"Return non-nil if PKG-DESC is a VC package."
(inline-letevals (pkg-desc)
(inline-quote (eq (package-desc-kind ,pkg-desc) 'vc))))
(cl-defstruct (package-desc
;; Rename the default constructor from `make-package-desc'.
(:constructor package-desc-create)
;; Has the same interface as the old `define-package',
;; which is still used in the "foo-pkg.el" files. Extra
;; options can be supported by adding additional keys.
(:constructor
package-desc-from-define
(name-string version-string &optional summary requirements
&rest rest-plist
&aux
(name (intern name-string))
(version (if (eq (car-safe version-string) 'vc)
(version-to-list (cdr version-string))
(version-to-list version-string)))
(reqs (mapcar (lambda (elt)
(list (car elt)
(version-to-list (cadr elt))))
(if (eq 'quote (car requirements))
(nth 1 requirements)
requirements)))
(kind (plist-get rest-plist :kind))
(archive (plist-get rest-plist :archive))
(extras (let (alist)
(while rest-plist
(unless (memq (car rest-plist) '(:kind :archive))
(let ((value (cadr rest-plist)))
(when value
(push (cons (car rest-plist)
(if (eq (car-safe value) 'quote)
(cadr value)
value))
alist))))
(setq rest-plist (cddr rest-plist)))
alist)))))
"Structure containing information about an individual package.
Slots:
`name' Name of the package, as a symbol.
`version' Version of the package, as a version list.
`summary' Short description of the package, typically taken from
the first line of the file.
`reqs' Requirements of the package. A list of (PACKAGE
VERSION-LIST) naming the dependent package and the minimum
required version.
`kind' The distribution format of the package. Currently, it is
either `single', `tar', or (temporarily only) `dir'. In
addition, there is distribution format `vc', which is handled
by package-vc.el.
`archive' The name of the archive (as a string) whence this
package came.
`dir' The directory where the package is installed (if installed),
`builtin' if it is built-in, or nil otherwise.
`extras' Optional alist of additional keyword-value pairs.
`signed' Flag to indicate that the package is signed by provider."
name
version
(summary package--default-summary)
reqs
kind
archive
dir
extras
signed)
;; Pseudo fields.
(defun package-version-join (vlist)
"Return the version string corresponding to the list VLIST.
This is, approximately, the inverse of `version-to-list'.
\(Actually, it returns only one of the possible inverses, since
`version-to-list' is a many-to-one operation.)"
(if (null vlist)
""
(let ((str-list (list "." (int-to-string (car vlist)))))
(dolist (num (cdr vlist))
(cond
((>= num 0)
(push (int-to-string num) str-list)
(push "." str-list))
((< num -4)
(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)))
(push (cond ((= num -1) "pre")
((= num -2) "beta")
((= num -3) "alpha")
((= num -4) "snapshot"))
str-list))))
(if (equal "." (car str-list))
(pop str-list))
(apply #'concat (nreverse str-list)))))
(defun package-desc-full-name (pkg-desc)
"Return full name of package-desc object PKG-DESC.
This is the name of the package with its version appended."
(if (package-vc-p pkg-desc)
(symbol-name (package-desc-name pkg-desc))
(format "%s-%s"
(package-desc-name pkg-desc)
(package-version-join (package-desc-version pkg-desc)))))
;;; Installed packages
;; The following variables store information about packages present in
;; the system. The most important of these is `package-alist'. The
;; command `package-activate-all' is also closely related to this
;; section.
(defvar package--builtins nil
"Alist of built-in packages.
The actual value is initialized by loading the library
`finder-inf'; this is not done until it is needed, e.g. by the
function `package-built-in-p'.
Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package
name (a symbol) and DESC is a `package--bi-desc' structure.")
(put 'package--builtins 'risky-local-variable t)
(defvar package-alist nil
"Alist of all packages available for activation.
Each element has the form (PKG . DESCS), where PKG is a package
name (a symbol) and DESCS is a non-empty list of `package-desc'
structures, sorted by decreasing versions.
This variable is set automatically by `package-load-descriptor',
called via `package-activate-all'. To change which packages are
loaded and/or activated, customize `package-load-list'.")
(put 'package-alist 'risky-local-variable t)
;;;; Public interfaces for accessing built-in package info
;;;###autoload
(defvar package-activated-list nil
;; FIXME: This should implicitly include all builtin packages.
"List of the names of currently activated packages.")
(put 'package-activated-list 'risky-local-variable t)
;;;; Populating `package-alist'.
;; The following functions are called on each installed package by
;; `package-load-all-descriptors', which ultimately populates the
;; `package-alist' variable.
(defun package-process-define-package (exp)
"Process define-package expression EXP and push it to `package-alist'.
EXP should be a form read from a foo-pkg.el file.
Convert EXP into a `package-desc' object using the
`package-desc-from-define' constructor before pushing it to
`package-alist'.
If there already exists a package by the same name in
`package-alist', insert this object there such that the packages
are sorted with the highest version first."
(when (eq (car-safe exp) 'define-package)
(let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
(name (package-desc-name new-pkg-desc))
(version (package-desc-version new-pkg-desc))
(old-pkgs (assq name package-alist)))
(if (null old-pkgs)
;; If there's no old package, just add this to `package-alist'.
(push (list name new-pkg-desc) package-alist)
;; If there is, insert the new package at the right place in the list.
(while
(if (and (cdr old-pkgs)
(version-list-< version
(package-desc-version (cadr old-pkgs))))
(setq old-pkgs (cdr old-pkgs))
(push new-pkg-desc (cdr old-pkgs))
nil)))
new-pkg-desc)))
(defun package-load-descriptor (pkg-dir)
"Load the package description file in directory PKG-DIR.
Create a new `package-desc' object, add it to `package-alist' and
return it."
(let ((pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir))
(signed-file (concat pkg-dir ".signed")))
(when (file-exists-p pkg-file)
(with-temp-buffer
(insert-file-contents pkg-file)
(goto-char (point-min))
(let ((pkg-desc (or (package-process-define-package
(read (current-buffer)))
(error "Can't find define-package in %s" pkg-file))))
(setf (package-desc-dir pkg-desc) pkg-dir)
(if (file-exists-p signed-file)
(setf (package-desc-signed pkg-desc) t))
pkg-desc)))))
(defun package-load-all-descriptors ()
"Load descriptors for installed Emacs Lisp packages.
This looks for package subdirectories in `package-user-dir' and
`package-directory-list'. The variable `package-load-list'
controls which package subdirectories may be loaded.
In each valid package subdirectory, this function loads the
description file containing a call to `define-package', which
updates `package-alist'."
(dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
(dolist (pkg-dir (directory-files dir t "\\`[^.]"))
(when (file-directory-p pkg-dir)
(package-load-descriptor pkg-dir))))))
(defun package--alist ()
"Return `package-alist', after computing it if needed."
(or package-alist
(progn (package-load-all-descriptors)
package-alist)))
;;; Package activation
;; Section for functions used by `package-activate', which see.
(defun package-disabled-p (pkg-name version)
"Return whether PKG-NAME at VERSION can be activated.
The decision is made according to `package-load-list'.
Return nil if the package can be activated.
Return t if the package is completely disabled.
Return the max version (as a string) if the package is held at a lower version."
(let ((force (assq pkg-name package-load-list)))
(cond ((null force) (not (memq 'all package-load-list)))
((null (setq force (cadr force))) t) ; disabled
((eq force t) nil)
((stringp force) ; held
(unless (version-list-= version (version-to-list force))
force))
(t (error "Invalid element in `package-load-list'")))))
(defun package-built-in-p (package &optional min-version)
"Return non-nil if PACKAGE is built-in to Emacs.
Optional arg MIN-VERSION, if non-nil, should be a version list
specifying the minimum acceptable version."
(if (package-desc-p package) ;; was built-in and then was converted
(eq 'builtin (package-desc-dir package))
(let ((bi (assq package package--builtin-versions)))
(cond
(bi (version-list-<= min-version (cdr bi)))
((remove 0 min-version) nil)
(t
(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)))
(declare-function info-initialize "info" ())
(defvar package--quickstart-pkgs t
"If set to a list, we're computing the set of pkgs to activate.")
(defun package--add-info-node (pkg-dir)
"Add info node located in PKG-DIR."
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
(require 'info)
(defvar Info-directory-list)
(info-initialize)
(add-to-list 'Info-directory-list pkg-dir)))
(defun package-activate-1 (pkg-desc &optional reload deps)
"Activate package given by PKG-DESC, even if it was already active.
If DEPS is non-nil, also activate its dependencies (unless they
are already activated).
If RELOAD is non-nil, also `load' any files inside the package which
correspond to previously loaded files."
(let* ((name (package-desc-name pkg-desc))
(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)))
(catch 'exit
;; Activate its dependencies recursively.
;; FIXME: This doesn't check whether the activated version is the
;; required version.
(when deps
(dolist (req (package-desc-reqs pkg-desc))
(unless (package-activate (car req))
(message "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable"
name (car req) (package-version-join (cadr req)))
(throw 'exit nil))))
(if (listp package--quickstart-pkgs)
;; We're only collecting the set of packages to activate!
(push pkg-desc package--quickstart-pkgs)
(when (or reload (assq name package--builtin-versions))
(require 'package)
(declare-function package--reload-previously-loaded
"package" (pkg-desc &optional warn))
(package--reload-previously-loaded
pkg-desc (unless reload
"Package %S is activated too late.
The following files have already been loaded: %S")))
(with-demoted-errors "Error loading autoloads: %s"
(load (package--autoloads-file-name pkg-desc) nil t)))
(package--add-info-node pkg-dir)
(push name package-activated-list)
;; Don't return nil.
t)))
;;;; `package-activate'
(defun package--get-activatable-pkg (pkg-name)
;; Is "activatable" a word?
(let ((pkg-descs (cdr (assq pkg-name package-alist))))
;; Check if PACKAGE is available in `package-alist'.
(while
(when pkg-descs
(let ((available-version (package-desc-version (car pkg-descs))))
(or (package-disabled-p pkg-name available-version)
;; Prefer a builtin package.
(package-built-in-p pkg-name available-version))))
(setq pkg-descs (cdr pkg-descs)))
(car pkg-descs)))
;; This function activates a newer version of a package if an older
;; one was already activated. It also loads a features of this
;; package which were already loaded.
(defun package-activate (package &optional force)
"Activate the package named PACKAGE.
If FORCE is true, (re-)activate it if it's already activated.
Newer versions are always activated, regardless of FORCE."
(let ((pkg-desc (package--get-activatable-pkg package)))
(cond
;; If no such package is found, maybe it's built-in.
((null pkg-desc)
(package-built-in-p package))
;; If the package is already activated, just return t.
((and (memq package package-activated-list) (not force))
t)
;; Otherwise, proceed with activation.
(t (package-activate-1 pkg-desc nil 'deps)))))
;;; Installation -- Local operations
;; This section contains a variety of features regarding installing a
;; package to/from disk. This includes autoload generation,
;; unpacking, compiling, as well as defining a package from the
;; current buffer.
;;;; Unpacking
;;;###autoload
(defvar package--activated nil
"Non-nil if `package-activate-all' has been run.")
;;;###autoload
(progn ;; Make the function usable without loading `package.el'.
(defun package-activate-all ()
"Activate all installed packages.
The variable `package-load-list' controls which packages to load."
(setq package--activated t)
(let* ((elc (concat package-quickstart-file "c"))
(qs (if (file-readable-p elc) elc
(if (file-readable-p package-quickstart-file)
package-quickstart-file))))
;; The quickstart file presumes that it has a blank slate,
;; so don't use it if we already activated some packages.
(or (and qs (not (bound-and-true-p package-activated-list))
;; Skip `load-source-file-function' which would slow us down by
;; a factor 2 when loading the .el file (this assumes we were
;; careful to save this file so it doesn't need any decoding).
(with-demoted-errors "Error during quickstart: %S"
(let ((load-source-file-function nil))
(unless (boundp 'package-activated-list)
(setq package-activated-list nil))
(load qs nil 'nomessage)
t)))
(progn
(require 'package)
;; Silence the "unknown function" warning when this is compiled
;; inside `loaddefs.el'.
;; FIXME: We use `with-no-warnings' because the effect of
;; `declare-function' is currently not scoped, so if we use
;; it here, we end up with a redefinition warning instead :-)
(with-no-warnings
(package--activate-all)))))))
(defun package--activate-all ()
(dolist (elt (package--alist))
(condition-case err
(package-activate (car elt))
;; Don't let failure of activation of a package arbitrarily stop
;; activation of further packages.
(error (message "%s" (error-message-string err))))))
;;;; Inferring package from current buffer
(declare-function lm-package-version "lisp-mnt" (&optional file))
;;;###autoload
(defun package-installed-p (package &optional min-version)
"Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed.
If PACKAGE is a symbol, it is the package name and MIN-VERSION
should be a version list.
If PACKAGE is a `package-desc' object, MIN-VERSION is ignored."
(cond
((package-desc-p package)
(let ((dir (package-desc-dir package)))
(and (stringp dir)
(file-exists-p dir))))
((and (not (bound-and-true-p package--initialized))
(null min-version)
package-activated-list)
;; We used the quickstart: make it possible to use package-installed-p
;; even before package is fully initialized.
(or
(memq package package-activated-list)
;; Also check built-in packages.
(package-built-in-p package min-version)))
(t
(or
(let ((pkg-descs (cdr (assq package (package--alist)))))
(and pkg-descs
(version-list-<= min-version
(package-desc-version (car pkg-descs)))))
;; Also check built-in packages.
(package-built-in-p package min-version)))))
;;;###autoload
(defun package-get-version ()
"Return the version number of the package in which this is used.
Assumes it is used from an Elisp file placed inside the top-level directory
of an installed ELPA package.
The return value is a string (or nil in case we can't find it).
It works in more cases if the call is in the file which contains
the `Version:' header."
;; In a sense, this is a lie, but it does just what we want: precomputes
;; the version at compile time and hardcodes it into the .elc file!
(declare (pure t))
;; Hack alert!
(let ((file (or (macroexp-file-name) buffer-file-name)))
(cond
((null file) nil)
;; Packages are normally installed into directories named "<pkg>-<vers>",
;; so get the version number from there.
((string-match "/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'" file)
(match-string 1 file))
;; For packages run straight from the an elpa.git clone, there's no
;; "-<vers>" in the directory name, so we have to fetch the version
;; the hard way.
(t
(let* ((pkgdir (file-name-directory file))
(pkgname (file-name-nondirectory (directory-file-name pkgdir)))
(mainfile (expand-file-name (concat pkgname ".el") pkgdir)))
(unless (file-readable-p mainfile) (setq mainfile file))
(when (file-readable-p mainfile)
(require 'lisp-mnt)
(lm-package-version mainfile)))))))
;;;; Package suggestions system
;; Note that only the definitions necessary to recognise package
;; suggestions are defined here. The user interface to select and act
;; on package suggestions is to be found in package.el.
(defcustom package-autosuggest-style 'mode-line
"How to draw attention to `package-autosuggest-mode' suggestions.
You can set this value to `mode-line' (default) to indicate the
availability of a package suggestion in the minor mode, `always' to
prompt the user in the minibuffer every time a suggestion is available
in a `fundamental-mode' buffer, or `message' to just display a message
hinting at the existence of a suggestion. If you only wish to be
reminded of package suggestions once every session, consider customizing
the `package-autosuggest-once' user option."
:type '(choice (const :tag "Indicate in mode line" mode-line)
(const :tag "Always prompt" always)
(const :tag "Indicate with message" message))
:group 'package)
(defcustom package-autosuggest-once nil
"Non-nil means not to repeat package suggestions."
:type 'boolean
:group 'package)
(defvar package--autosuggest-database 'unset
"A list of package suggestions.
Each entry in the list is of a form suitable to for
`package--suggestion-applies-p', which see. The special value `unset'
is used to indicate that `package--autosuggest-find-candidates' should
load the database into memory.")
(defvar package--autosuggest-suggested '()
"List of packages that have already been suggested.
Suggestions found in this list will not count as suggestions (e.g. if
`package-autosuggest-style' is set to `mode-line', a suggestion found in
here will inhibit `package-autosuggest-mode' from displaying a hint in
the mode line).")
(defun package--suggestion-applies-p (sug)
"Check if a suggestion SUG is applicable to the current buffer.
Each suggestion has the form (PACKAGE TYPE DATA), where PACKAGE is a
symbol denoting the package and major-mode the suggestion applies to,
TYPE is one of `auto-mode-alist', `magic-mode-alist' or
`interpreter-mode-alist' indicating the type of check to be made and
DATA is the value to check against TYPE in the intuitive way (e.g. for
`auto-mode-alist' DATA is a regular expression matching a file name that
PACKAGE should be suggested for). If the package name and the major
mode name differ, then an optional forth element MAJOR-MODE can indicate
what command to invoke to enable the package."
(pcase sug
((or (guard (not (eq major-mode 'fundamental-mode)))
(guard (and package-autosuggest-once
(not (memq (car sug) package--autosuggest-suggested))))
`(,(pred package-installed-p) . ,_))
nil)
(`(,_ auto-mode-alist ,ext . ,_)
(and (buffer-file-name) (string-match-p ext (buffer-file-name)) t))
(`(,_ magic-mode-alist ,mag . ,_)
(without-restriction
(save-excursion
(goto-char (point-min))
(looking-at-p mag))))
(`(,_ interpreter-mode-alist ,intr . ,_)
(without-restriction
(save-excursion
(goto-char (point-min))
(and (looking-at auto-mode-interpreter-regexp)
(string-match-p
(concat "\\`" (file-name-nondirectory (match-string 2)) "\\'")
intr)))))))
(defun package--autosuggest-find-candidates ()
"Return a list of suggestions that might be interesting the current buffer.
The elements of the returned list will have the form described in
`package--suggestion-applies-p'."
(and (eq major-mode 'fundamental-mode)
(let ((suggetions '()))
(when (eq package--autosuggest-database 'unset)
(setq package--autosuggest-database
(with-temp-buffer
(insert-file-contents
(expand-file-name "package-autosuggest.eld"
data-directory))
(read (current-buffer)))))
(dolist (sug package--autosuggest-database)
(when (package--suggestion-applies-p sug)
(push sug suggetions)))
suggetions)))
(defvar package--autosugest-line-format
'(:eval (package--autosugest-line-format)))
(put 'package--autosugest-line-format 'risky-local-variable t)
(defun package--autosugest-line-format ()
"Generate a mode-line string to indicate a suggested package."
`(,@(and-let* (((not (null package-autosuggest-mode)))
((eq package-autosuggest-style 'mode-line))
(avail (package--autosuggest-find-candidates)))
(propertize
"[Upgrade?]"
'face 'mode-line-emphasis
'mouse-face 'mode-line-highlight
'help-echo "Click to install suggested package."
'keymap (let ((map (make-sparse-keymap)))
(define-key map [mode-line down-mouse-1] #'package-autosuggest)
map)))))
(declare-function package-autosuggest "package" (&optional candidates))
(defun package--autosuggest-after-change-mode ()
"Display package suggestions for the current buffer.
This function should be added to `after-change-major-mode-hook'."
(when-let* ((avail (package--autosuggest-find-candidates))
(pkgs (mapconcat #'symbol-name
(delete-dups (mapcar #'car avail))
", ")))
(pcase-exhaustive package-autosuggest-style
('mode-line
(setq mode-name (append (ensure-list mode-name)
'((package-autosuggest-mode
package--autosugest-line-format))))
(force-mode-line-update t))
('always
(package-autosuggest avail))
('message
(message
(substitute-command-keys
(format "Found suggested packages: %s. Install using \\[package-autosuggest]"
pkgs)))
(dolist (rec avail)
(add-to-list 'package--autosuggest-suggested (car rec)))))))
;;;###autoload
(define-minor-mode package-autosuggest-mode
"Enable the automatic suggestion and installation of packages."
:global t :group 'package
;; :initialize #'custom-initialize-delay
(funcall (if package-autosuggest-mode #'add-hook #'remove-hook)
'after-change-major-mode-hook
#'package--autosuggest-after-change-mode))
(provide 'package-activate)
;;; package-activate.el ends here