Merge remote-tracking branch 'savannah/master' into HEAD

This commit is contained in:
Andrea Corallo 2021-01-08 21:40:45 +01:00
commit 400f620f24
140 changed files with 1773 additions and 1108 deletions

View file

@ -222,16 +222,27 @@ expression, in which case we want to handle forms differently."
;; Convert defcustom to less space-consuming data.
((eq car 'defcustom)
(let ((varname (car-safe (cdr-safe form)))
(init (car-safe (cdr-safe (cdr-safe form))))
(doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
)
(let* ((varname (car-safe (cdr-safe form)))
(props (nthcdr 4 form))
(initializer (plist-get props :initialize))
(init (car-safe (cdr-safe (cdr-safe form))))
(doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
)
`(progn
(defvar ,varname ,init ,doc)
,(if (not (member initializer '(nil 'custom-initialize-default
#'custom-initialize-default
'custom-initialize-reset
#'custom-initialize-reset)))
form
`(defvar ,varname ,init ,doc))
;; When we include the complete `form', this `custom-autoload'
;; is not indispensable, but it still helps in case the `defcustom'
;; doesn't specify its group explicitly, and probably in a few other
;; corner cases.
(custom-autoload ',varname ,file
,(condition-case nil
(null (cadr (memq :set form)))
(null (plist-get props :set))
(error nil))))))
((eq car 'defgroup)

View file

@ -382,7 +382,7 @@ convention was modified."
(puthash (indirect-function function) signature
advertised-signature-table))
(defun make-obsolete (obsolete-name current-name &optional when)
(defun make-obsolete (obsolete-name current-name when)
"Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
OBSOLETE-NAME should be a function name or macro name (a symbol).
@ -391,17 +391,14 @@ If CURRENT-NAME is a string, that is the `use instead' message
\(it should end with a period, and not start with a capital).
WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
(declare (advertised-calling-convention
;; New code should always provide the `when' argument.
(obsolete-name current-name when) "23.1"))
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
(purecopy (list current-name nil when)))
obsolete-name)
(defmacro define-obsolete-function-alias (obsolete-name current-name
&optional when docstring)
(defmacro define-obsolete-function-alias ( obsolete-name current-name when
&optional docstring)
"Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete.
\(define-obsolete-function-alias \\='old-fun \\='new-fun \"22.1\" \"old-fun's doc.\")
@ -415,15 +412,13 @@ WHEN should be a string indicating when the function was first
made obsolete, for example a date or a release number.
See the docstrings of `defalias' and `make-obsolete' for more details."
(declare (doc-string 4)
(advertised-calling-convention
;; New code should always provide the `when' argument.
(obsolete-name current-name when &optional docstring) "23.1"))
(declare (doc-string 4))
`(progn
(defalias ,obsolete-name ,current-name ,docstring)
(make-obsolete ,obsolete-name ,current-name ,when)))
(defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
(defun make-obsolete-variable ( obsolete-name current-name when
&optional access-type)
"Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message.
@ -431,16 +426,13 @@ WHEN should be a string indicating when the variable
was first made obsolete, for example a date or a release number.
ACCESS-TYPE if non-nil should specify the kind of access that will trigger
obsolescence warnings; it can be either `get' or `set'."
(declare (advertised-calling-convention
;; New code should always provide the `when' argument.
(obsolete-name current-name when &optional access-type) "23.1"))
(put obsolete-name 'byte-obsolete-variable
(purecopy (list current-name access-type when)))
obsolete-name)
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)
(defmacro define-obsolete-variable-alias ( obsolete-name current-name when
&optional docstring)
"Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
WHEN should be a string indicating when the variable was first
@ -469,10 +461,7 @@ For the benefit of Customize, if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
`saved-value', `saved-variable-comment'."
(declare (doc-string 4)
(advertised-calling-convention
;; New code should always provide the `when' argument.
(obsolete-name current-name when &optional docstring) "23.1"))
(declare (doc-string 4))
`(progn
(defvaralias ,obsolete-name ,current-name ,docstring)
;; See Bug#4706.

View file

@ -3529,10 +3529,11 @@ for symbols generated by the byte compiler itself."
(and od
(not (memq var byte-compile-not-obsolete-vars))
(not (memq var byte-compile-global-not-obsolete-vars))
(or (pcase (nth 1 od)
('set (not (eq access-type 'reference)))
('get (eq access-type 'reference))
(_ t)))))
(not (memq var byte-compile-lexical-variables))
(pcase (nth 1 od)
('set (not (eq access-type 'reference)))
('get (eq access-type 'reference))
(_ t))))
(byte-compile-warn-obsolete var))))
(defsubst byte-compile-dynamic-variable-op (base-op var)

View file

@ -215,7 +215,8 @@ It creates an autoload function for CNAME's constructor."
;; turn this into a usable self-pointing symbol
(when eieio-backward-compatibility
(set cname cname)
(make-obsolete-variable cname (format "use \\='%s instead" cname)
(make-obsolete-variable cname (format "\
use \\='%s or turn off `eieio-backward-compatibility' instead" cname)
"25.1"))
(setf (cl--find-class cname) newc)

View file

@ -173,12 +173,12 @@ with \"-q\").
Even if the value is nil, you can type \\[package-initialize] to
make installed packages available at any time, or you can
call (package-initialize) in your init-file."
call (package-activate-all) in your init-file."
:type 'boolean
:version "24.1")
(defcustom package-load-list '(all)
"List of packages for `package-initialize' to make available.
"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
@ -292,15 +292,18 @@ the package will be unavailable."
:risky t
:version "24.4")
;;;###autoload
(defcustom package-user-dir (locate-user-emacs-file "elpa")
"Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
Apart from this directory, Emacs also looks for system-wide
packages in `package-directory-list'."
:type 'directory
:initialize #'custom-initialize-delay
:risky t
:version "24.1")
;;;###autoload
(defcustom package-directory-list
;; Defaults are subdirs named "elpa" in the site-lisp dirs.
(let (result)
@ -315,6 +318,7 @@ Each directory name should be absolute.
These directories contain packages intended for system-wide; in
contrast, `package-user-dir' contains packages for personal use."
:type '(repeat directory)
:initialize #'custom-initialize-delay
:risky t
:version "24.1")
@ -593,9 +597,8 @@ package."
;;; Installed packages
;; The following variables store information about packages present in
;; the system. The most important of these is `package-alist'. The
;; command `package-initialize' is also closely related to this
;; section, but it is left for a later section because it also affects
;; other stuff.
;; command `package-activate-all' is also closely related to this
;; section.
(defvar package--builtins nil
"Alist of built-in packages.
@ -614,7 +617,7 @@ 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-initialize'. To change which packages are
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)
@ -875,6 +878,20 @@ DIR, sorted by most recently loaded last."
(lambda (x y) (< (cdr x) (cdr y))))))))
;;;; `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.
@ -882,24 +899,16 @@ DIR, sorted by most recently loaded last."
"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-descs (cdr (assq package 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 package available-version)
;; Prefer a builtin package.
(package-built-in-p package available-version))))
(setq pkg-descs (cdr pkg-descs)))
(let ((pkg-desc (package--get-activatable-pkg package)))
(cond
;; If no such package is found, maybe it's built-in.
((null pkg-descs)
((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 (car pkg-descs) nil 'deps)))))
(t (package-activate-1 pkg-desc nil 'deps)))))
;;; Installation -- Local operations
@ -1633,9 +1642,8 @@ that code in the early init-file."
;; `package--initialized' is t.
(package--build-compatibility-table))
(defvar package-quickstart-file)
;;;###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."
@ -1649,13 +1657,19 @@ The variable `package-load-list' controls which packages to load."
;; 2 when loading the .el file (this assumes we were careful to
;; save this file so it doesn't need any decoding).
(let ((load-source-file-function nil))
(unless (boundp 'package-activated-list)
(setq package-activated-list nil))
(load qs nil 'nomessage))
(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))))))))
(require 'package)
(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))))))
;;;; Populating `package-archive-contents' from archives
;; This subsection populates the variables listed above from the
@ -2083,6 +2097,13 @@ PACKAGES are satisfied, i.e. that PACKAGES is computed
using `package-compute-transaction'."
(mapc #'package-install-from-archive packages))
(defun package--archives-initialize ()
"Make sure the list of installed and remote packages are initialized."
(unless package--initialized
(package-initialize t))
(unless package-archive-contents
(package-refresh-contents)))
;;;###autoload
(defun package-install (pkg &optional dont-select)
"Install the package PKG.
@ -2103,10 +2124,7 @@ to install it but still mark it as selected."
(progn
;; Initialize the package system to get the list of package
;; symbols for completion.
(unless package--initialized
(package-initialize t))
(unless package-archive-contents
(package-refresh-contents))
(package--archives-initialize)
(list (intern (completing-read
"Install package: "
(delq nil
@ -2116,6 +2134,7 @@ to install it but still mark it as selected."
package-archive-contents))
nil t))
nil)))
(package--archives-initialize)
(add-hook 'post-command-hook #'package-menu--post-refresh)
(let ((name (if (package-desc-p pkg)
(package-desc-name pkg)
@ -3742,7 +3761,7 @@ short description."
(package-menu--generate nil t)))
;; The package menu buffer has keybindings. If the user types
;; `M-x list-packages', that suggests it should become current.
(switch-to-buffer buf)))
(pop-to-buffer-same-window buf)))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
@ -4070,10 +4089,12 @@ activations need to be changed, such as when `package-load-list' is modified."
:type 'boolean
:version "27.1")
;;;###autoload
(defcustom package-quickstart-file
(locate-user-emacs-file "package-quickstart.el")
"Location of the file used to speed up activation of packages at startup."
:type 'file
:initialize #'custom-initialize-delay
:version "27.1")
(defun package--quickstart-maybe-refresh ()
@ -4140,6 +4161,8 @@ activations need to be changed, such as when `package-load-list' is modified."
;; no-update-autoloads: t
;; End:
"))
;; FIXME: Do it asynchronously in an Emacs subprocess, and
;; don't show the byte-compiler warnings.
(byte-compile-file package-quickstart-file)))
(defun package--imenu-prev-index-position-function ()
@ -4160,6 +4183,15 @@ beginning of the line."
(package-version-join (package-desc-version package-desc))
(package-desc-summary package-desc))))
;;;; Introspection
(defun package-get-descriptor (pkg-name)
"Return the `package-desc' of PKG-NAME."
(unless package--initialized (package-initialize 'no-activate))
(or (package--get-activatable-pkg pkg-name)
(cadr (assq pkg-name package-alist))
(cadr (assq pkg-name package-archive-contents))))
(provide 'package)
;;; package.el ends here