diff options
Diffstat (limited to 'lisp/emacs-lisp/package.el')
| -rw-r--r-- | lisp/emacs-lisp/package.el | 262 |
1 files changed, 207 insertions, 55 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 58fc55da124..858214611f6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -301,6 +301,7 @@ packages in `package-directory-list'." :type 'directory :initialize #'custom-initialize-delay :risky t + :group 'applications :version "24.1") (defcustom package-devel-dir (expand-file-name "devel" package-user-dir) @@ -330,6 +331,7 @@ 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 + :group 'applications :risky t :version "24.1") @@ -366,10 +368,10 @@ More specifically the value can be: This also applies to the \"archive-contents\" file that lists the contents of the archive." - :type '(choice (const nil :tag "Never") - (const allow-unsigned :tag "Allow unsigned") - (const t :tag "Check always") - (const all :tag "Check all signatures")) + :type '(choice (const :value nil :tag "Never") + (const :value allow-unsigned :tag "Allow unsigned") + (const :value t :tag "Check always") + (const :value all :tag "Check all signatures")) :risky t :version "27.1") @@ -429,22 +431,22 @@ synchronously." (defcustom package-name-column-width 30 "Column width for the Package name in the package menu." - :type 'number + :type 'natnum :version "28.1") (defcustom package-version-column-width 14 "Column width for the Package version in the package menu." - :type 'number + :type 'natnum :version "28.1") (defcustom package-status-column-width 12 "Column width for the Package status in the package menu." - :type 'number + :type 'natnum :version "28.1") (defcustom package-archive-column-width 8 "Column width for the Package archive in the package menu." - :type 'number + :type 'natnum :version "28.1") @@ -579,9 +581,9 @@ This is the name of the package with its version appended." "Return file-name extension of package-desc object PKG-DESC. Depending on the `package-desc-kind' of PKG-DESC, this is one of: - 'single - \".el\" - 'tar - \".tar\" - 'dir - \"\" + \\='single - \".el\" + \\='tar - \".tar\" + \\='dir - \"\" Signal an error if the kind is none of the above." (pcase (package-desc-kind pkg-desc) @@ -640,6 +642,7 @@ 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) +;;;###autoload (defvar package-activated-list nil ;; FIXME: This should implicitly include all builtin packages. "List of the names of currently activated packages.") @@ -751,8 +754,7 @@ REQUIREMENTS is a list of dependencies on other packages. where OTHER-VERSION is a string. EXTRA-PROPERTIES is currently unused." - (declare (indent defun)) - ;; FIXME: Placeholder! Should we keep it? + (declare (obsolete nil "29.1") (indent defun)) (error "Don't call me!")) @@ -817,10 +819,14 @@ byte-compilation of the new package to fail." (with-demoted-errors "Error in package--load-files-for-activation: %s" (let* (result (dir (package-desc-dir pkg-desc)) - (load-path-sans-dir - (cl-remove-if (apply-partially #'string= dir) - (or (bound-and-true-p find-function-source-path) - load-path))) + ;; A previous implementation would skip `dir' itself. + ;; However, in normal use reloading from the same directory + ;; never happens anyway, while in certain cases external to + ;; Emacs a package in the same directory not necessary + ;; stays byte-identical, e.g. during development. Just + ;; don't special-case `dir'. + (effective-path (or (bound-and-true-p find-library-source-path) + load-path)) (files (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")) (history (mapcar #'file-truename (cl-remove-if-not #'stringp @@ -828,8 +834,19 @@ byte-compilation of the new package to fail." (dolist (file files) (when-let ((library (package--library-stem (file-relative-name file dir))) - (canonical (locate-library library nil load-path-sans-dir)) - (found (member (file-truename canonical) history)) + (canonical (locate-library library nil effective-path)) + (truename (file-truename canonical)) + ;; Normally, all files in a package are compiled by + ;; now, but don't assume that. E.g. different + ;; versions can add or remove `no-byte-compile'. + (altname (if (string-suffix-p ".el" truename) + (replace-regexp-in-string + "\\.el\\'" ".elc" truename t) + (replace-regexp-in-string + "\\.elc\\'" ".el" truename t))) + (found (or (member truename history) + (and (not (string= altname truename)) + (member altname history)))) (recent-index (length found))) (unless (equal (file-name-base library) (format "%s-autoloads" (package-desc-name pkg-desc))) @@ -1075,6 +1092,7 @@ untar into a directory named DIR; otherwise, signal an error." (defun package-autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists and if not create it." + (declare (obsolete nil "29.1")) (unless (file-exists-p file) (require 'autoload) (let ((coding-system-for-write 'utf-8-emacs-unix)) @@ -1093,8 +1111,11 @@ untar into a directory named DIR; otherwise, signal an error." (autoload-timestamps nil) (backup-inhibited t) (version-control 'never)) - (package-autoload-ensure-default-file output-file) - (make-directory-autoloads pkg-dir output-file) + (loaddefs-generate + pkg-dir output-file + nil + "(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path))))") (let ((buf (find-buffer-visiting output-file))) (when buf (kill-buffer buf))) auto-name)) @@ -1379,7 +1400,7 @@ errors signaled by ERROR-FORM or by BODY). (cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys) (if (string-match-p "\\`https?:" url) - (let ((url (concat url file))) + (let ((url (url-expand-file-name file url))) (if async (package--unless-error #'ignore (url-retrieve @@ -1701,7 +1722,9 @@ The variable `package-load-list' controls which packages to load." (qs (if (file-readable-p elc) elc (if (file-readable-p package-quickstart-file) package-quickstart-file)))) - (if qs + ;; The quickstart file presumes that it has a blank slate, + ;; so don't use it if we already activated some packages. + (if (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). @@ -1712,6 +1735,7 @@ The variable `package-load-list' controls which packages to load." (require 'package) (package--activate-all))))) +;;;###autoload (defun package--activate-all () (dolist (elt (package--alist)) (condition-case err @@ -1926,8 +1950,12 @@ SEEN is used internally to detect infinite recursion." (error "Need package `%s-%s', but only %s is available" next-pkg (package-version-join next-version) found-something)) - (t (error "Package `%s-%s' is unavailable" - next-pkg (package-version-join next-version))))) + (t + (if (eq next-pkg 'emacs) + (error "This package requires Emacs version %s" + (package-version-join next-version)) + (error "Package `%s-%s' is unavailable" + next-pkg (package-version-join next-version)))))) (setq packages (package-compute-transaction (cons found packages) (package-desc-reqs found) @@ -2261,6 +2289,61 @@ be requested using REV." (:rev . ,rev))))) ((user-error "Unknown package to fetch: %s" name-or-url))))) +;;;###autoload +(defun package-update (name) + "Update package NAME if a newer version exists." + (interactive + (list (completing-read + "Update package: " (package--updateable-packages) nil t))) + (let ((package (if (symbolp name) + name + (intern name)))) + (package-delete (cadr (assq package package-alist)) 'force) + (package-install package 'dont-select))) + +(defun package--updateable-packages () + ;; Initialize the package system to get the list of package + ;; symbols for completion. + (package--archives-initialize) + (mapcar + #'car + (seq-filter + (lambda (elt) + (let ((available + (assq (car elt) package-archive-contents))) + (and available + (version-list-< + (package-desc-priority-version (cadr elt)) + (package-desc-priority-version (cadr available)))))) + package-alist))) + +;;;###autoload +(defun package-update-all (&optional query) + "Refresh package list and upgrade all packages. +If QUERY, ask the user before updating packages. When called +interactively, QUERY is always true." + (interactive (list (not noninteractive))) + (package-refresh-contents) + (let ((updateable (package--updateable-packages))) + (if (not updateable) + (message "No packages to update") + (when (and query + (not (yes-or-no-p + (if (length= updateable 1) + "One package to update. Do it? " + (format "%s packages to update. Do it?" + (length updateable)))))) + (user-error "Updating aborted")) + (mapc #'package-update updateable)))) + +(defun package--dependencies (pkg) + "Return a list of all dependencies PKG has. +This is done recursively." + ;; Can we have circular dependencies? Assume "nope". + (when-let* ((desc (cadr (assq pkg package-archive-contents))) + (deps (mapcar #'car (package-desc-reqs desc)))) + (delete-dups (apply #'nconc deps (mapcar #'package--dependencies deps))))) + (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. If the result looks like a dotted numeric version, return it. @@ -2487,6 +2570,35 @@ object." (package-install pkg 'dont-select)) ;;;###autoload +(defun package-recompile (pkg) + "Byte-compile package PKG again. +PKG should be either a symbol, the package name, or a `package-desc' +object." + (interactive (list (intern (completing-read + "Recompile package: " + (mapcar #'symbol-name + (mapcar #'car package-alist)))))) + (let ((pkg-desc (if (package-desc-p pkg) + pkg + (cadr (assq pkg package-alist))))) + ;; Delete the old .elc files to ensure that we don't inadvertently + ;; load them (in case they contain byte code/macros that are now + ;; invalid). + (dolist (elc (directory-files-recursively + (package-desc-dir pkg-desc) "\\.elc\\'")) + (delete-file elc)) + (package--compile pkg-desc))) + +;;;###autoload +(defun package-recompile-all () + "Byte-compile all installed packages. +This is meant to be used only in the case the byte-compiled files +are invalid due to changed byte-code, macros or the like." + (interactive) + (pcase-dolist (`(_ ,pkg-desc) package-alist) + (package-recompile pkg-desc))) + +;;;###autoload (defun package-autoremove () "Remove packages that are no longer needed. @@ -2986,7 +3098,13 @@ either a full name or nil, and EMAIL is a valid email address." (define-derived-mode package-menu-mode tabulated-list-mode "Package Menu" "Major mode for browsing a list of packages. -Letters do not insert themselves; instead, they are commands. +The most useful commands here are: + + `x': Install the package under point if it isn't already installed, + and delete it if it's already installed, + `i': mark a package for installation, and + `d': mark a package for deletion. Use the `x' command to perform the + actions on the marked files. \\<package-menu-mode-map> \\{package-menu-mode-map}" :interactive nil @@ -3561,9 +3679,6 @@ The full list of keys can be viewed with \\[describe-mode]." (message (mapconcat #'package--prettify-quick-help-key package--quick-help-keys "\n"))) -(define-obsolete-function-alias - 'package-menu-view-commentary 'package-menu-describe-package "24.1") - (defun package-menu-get-status () "Return status text of package at point in Package Menu." (package--ensure-package-menu-mode) @@ -3602,7 +3717,7 @@ corresponding to the newer version." ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC]) (let ((pkg-desc (car entry)) (status (aref (cadr entry) 2))) - (cond ((member status '("installed" "dependency" "unsigned")) + (cond ((member status '("installed" "dependency" "unsigned" "external")) (push pkg-desc installed)) ((member status '("available" "new")) (setq available (package--append-to-alist pkg-desc available)))))) @@ -3659,17 +3774,34 @@ immediately." (setq package-menu--mark-upgrades-pending t) (message "Waiting for refresh to finish..."))) -(defun package-menu--list-to-prompt (packages) +(defun package-menu--list-to-prompt (packages &optional include-dependencies) "Return a string listing PACKAGES that's usable in a prompt. PACKAGES is a list of `package-desc' objects. Formats the returned string to be usable in a minibuffer -prompt (see `package-menu--prompt-transaction-p')." +prompt (see `package-menu--prompt-transaction-p'). + +If INCLUDE-DEPENDENCIES, also include the number of uninstalled +dependencies." ;; The case where `package' is empty is handled in ;; `package-menu--prompt-transaction-p' below. - (format "%d (%s)" + (format "%d (%s)%s" (length packages) - (mapconcat #'package-desc-full-name packages " "))) - + (mapconcat #'package-desc-full-name packages " ") + (let ((deps + (seq-remove + #'package-installed-p + (delete-dups + (apply + #'nconc + (mapcar (lambda (package) + (package--dependencies + (package-desc-name package))) + packages)))))) + (if (and include-dependencies deps) + (if (length= deps 1) + (format " plus 1 dependency") + (format " plus %d dependencies" (length deps))) + "")))) (defun package-menu--prompt-transaction-p (delete install upgrade) "Prompt the user about DELETE, INSTALL, and UPGRADE. @@ -3678,11 +3810,14 @@ Either may be nil, but not all." (y-or-n-p (concat (when delete - (format "Packages to delete: %s. " (package-menu--list-to-prompt delete))) + (format "Packages to delete: %s. " + (package-menu--list-to-prompt delete))) (when install - (format "Packages to install: %s. " (package-menu--list-to-prompt install))) + (format "Packages to install: %s. " + (package-menu--list-to-prompt install t))) (when upgrade - (format "Packages to upgrade: %s. " (package-menu--list-to-prompt upgrade))) + (format "Packages to upgrade: %s. " + (package-menu--list-to-prompt upgrade))) "Proceed? "))) @@ -3744,8 +3879,13 @@ packages list, respectively." (defun package-menu-execute (&optional noquery) "Perform marked Package Menu actions. Packages marked for installation are downloaded and installed, -packages marked for deletion are removed, -and packages marked for upgrading are downloaded and upgraded. +packages marked for deletion are removed, and packages marked for +upgrading are downloaded and upgraded. + +If no packages are marked, the action taken depends on the state +of the package under point. If it's not already installed, this +command will install the package, and if it's installed, it will +delete the package. Optional argument NOQUERY non-nil means do not ask the user to confirm." (interactive nil package-menu-mode) @@ -3763,8 +3903,20 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." ((eq cmd ?I) (push pkg-desc install-list)))) (forward-line))) + ;; Nothing marked. (unless (or delete-list install-list) - (user-error "No operations specified")) + ;; Not on a package line. + (unless (tabulated-list-get-id) + (user-error "No operations specified")) + (let* ((id (tabulated-list-get-id)) + (status (package-menu-get-status))) + (cond + ((member status '("installed")) + (push id delete-list)) + ((member status '("available" "avail-obso" "new" "dependency")) + (push id install-list)) + (t (user-error "No default action available for status: %s" + status))))) (let-alist (package-menu--partition-transaction install-list delete-list) (when (or noquery (package-menu--prompt-transaction-p .delete .install .upgrade)) @@ -3998,16 +4150,14 @@ packages." (mapcar #'car package-archives))) package-menu-mode) (package--ensure-package-menu-mode) - (let ((re (if (listp archive) - (regexp-opt archive) - archive))) - (package-menu--filter-by (lambda (pkg-desc) - (let ((pkg-archive (package-desc-archive pkg-desc))) - (and pkg-archive - (string-match-p re pkg-archive)))) - (concat "archive:" (if (listp archive) - (string-join archive ",") - archive))))) + (let ((archives (ensure-list archive))) + (package-menu--filter-by + (lambda (pkg-desc) + (let ((pkg-archive (package-desc-archive pkg-desc))) + (or (null archives) + (and pkg-archive + (member pkg-archive archives))))) + (concat "archive:" (string-join archives ","))))) (defun package-menu-filter-by-description (description) "Filter the \"*Packages*\" buffer by DESCRIPTION regexp. @@ -4284,6 +4434,7 @@ activations need to be changed, such as when `package-load-list' is modified." (locate-user-emacs-file "package-quickstart.el") "Location of the file used to speed up activation of packages at startup." :type 'file + :group 'applications :initialize #'custom-initialize-delay :version "27.1") @@ -4328,18 +4479,19 @@ activations need to be changed, such as when `package-load-list' is modified." (locate-library (package--autoloads-file-name pkg)))) (pfile (prin1-to-string file))) (insert "(let ((load-true-file-name " pfile ")\ -(load-file-name " pfile "))\n") +\(load-file-name " pfile "))\n") (insert-file-contents file) ;; Fixup the special #$ reader form and throw away comments. (while (re-search-forward "#\\$\\|^;\\(.*\n\\)" nil 'move) - (unless (nth 8 (syntax-ppss)) + (unless (ppss-string-terminator (save-match-data (syntax-ppss))) (replace-match (if (match-end 1) "" pfile) t t))) (unless (bolp) (insert "\n")) (insert ")\n"))) (pp `(defvar package-activated-list) (current-buffer)) (pp `(setq package-activated-list - (append ',(mapcar #'package-desc-name package--quickstart-pkgs) - package-activated-list)) + (delete-dups + (append ',(mapcar #'package-desc-name package--quickstart-pkgs) + package-activated-list))) (current-buffer)) (let ((info-dirs (butlast Info-directory-list))) (when info-dirs |