path: root/lisp/emacs-lisp/package-core.el

;;; package-core.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, including
;; package descriptors, general user options and the package activation
;; logic.

;;; Code:

(eval-when-compile (require 'cl-lib))

(defvar package--default-summary "No description available.")

(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)


;;; 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

(defun package-versioned-builtin-packages ()
  "Return a list of all the versioned built-in packages.
The return value is a list of names of built-in packages represented as
symbols."
  (mapcar #'car package--builtin-versions))

(defun package-builtin-package-version (package)
  "Return the version of a built-in PACKAGE given by its symbol.
The return value is a list of integers representing the version of
PACKAGE, in the format returned by `version-to-list', or nil if the
package is built-in but has no version or is not a built-in package."
  (alist-get package package--builtin-versions))

;;;###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)))

(defvar Info-directory-list)
(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)
    (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))
          (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)))))))

(provide 'package-core)
;;; package-core.el ends here