diff options
Diffstat (limited to 'lisp/emacs-lisp/package.el')
| -rw-r--r-- | lisp/emacs-lisp/package.el | 233 |
1 files changed, 161 insertions, 72 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index ccd52aa7b33..9ed23862e92 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -73,9 +73,9 @@ ;; M-x list-packages ;; Enters a mode similar to buffer-menu which lets you manage ;; packages. You can choose packages for install (mark with "i", -;; then "x" to execute) or deletion (not implemented yet), and you -;; can see what packages are available. This will automatically -;; fetch the latest list of packages from ELPA. +;; then "x" to execute) or deletion, and you can see what packages +;; are available. This will automatically fetch the latest list of +;; packages from ELPA. ;; ;; M-x package-install-from-buffer ;; Install a package consisting of a single .el file that appears @@ -89,7 +89,7 @@ ;; Install a package from the indicated file. The package can be ;; either a tar file or a .el file. A tar file must contain an ;; appropriately-named "-pkg.el" file; a .el file must be properly -;; formatted as with package-install-from-buffer. +;; formatted as with `package-install-from-buffer'. ;;; Thanks: ;;; (sorted by sort-lines): @@ -225,7 +225,7 @@ security." :type '(alist :key-type (string :tag "Archive name") :value-type (string :tag "URL or directory name")) :risky t - :version "26.1") ; gnutls test + :version "28.1") (defcustom package-menu-hide-low-priority 'archive "If non-nil, hide low priority packages from the packages menu. @@ -397,6 +397,12 @@ a sane initial value." :version "25.1" :type '(repeat symbol)) +(defcustom package-native-compile nil + "Non-nil means to native compile packages on installation." + :type '(boolean) + :risky t + :version "28.1") + (defcustom package-menu-async t "If non-nil, package-menu will use async operations when possible. Currently, only the refreshing of archive contents supports @@ -830,8 +836,6 @@ correspond to previously loaded files (those returned by ;; Don't return nil. t))) -(declare-function find-library-name "find-func" (library)) - (defun package--files-load-history () (delq nil (mapcar (lambda (x) @@ -841,20 +845,22 @@ correspond to previously loaded files (those returned by load-history))) (defun package--list-of-conflicts (dir history) - (delq - nil - (mapcar - (lambda (x) (let* ((file (file-relative-name x dir)) - ;; Previously loaded file, if any. - (previous - (ignore-errors - (file-name-sans-extension - (file-truename (find-library-name file))))) - (pos (when previous (member previous history)))) - ;; Return (RELATIVE-FILENAME . HISTORY-POSITION) - (when pos - (cons (file-name-sans-extension file) (length pos))))) - (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))) + (require 'find-func) + (declare-function find-library-name "find-func" (library)) + (delq + nil + (mapcar + (lambda (x) (let* ((file (file-relative-name x dir)) + ;; Previously loaded file, if any. + (previous + (ignore-error file-error ;"Can't find library" + (file-name-sans-extension + (file-truename (find-library-name file))))) + (pos (when previous (member previous history)))) + ;; Return (RELATIVE-FILENAME . HISTORY-POSITION) + (when pos + (cons (file-name-sans-extension file) (length pos))))) + (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))) (defun package--list-loaded-files (dir) "Recursively list all files in DIR which correspond to loaded features. @@ -986,6 +992,8 @@ untar into a directory named DIR; otherwise, signal an error." ;; E.g. for multi-package installs, we should first install all packages ;; and then compile them. (package--compile new-desc) + (when package-native-compile + (package--native-compile-async new-desc)) ;; After compilation, load again any files loaded by ;; `activate-1', so that we use the byte-compiled definitions. (package--load-files-for-activation new-desc :reload))) @@ -1070,6 +1078,15 @@ This assumes that `pkg-desc' has already been activated with (load-path load-path)) (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))) +(defun package--native-compile-async (pkg-desc) + "Native compile installed package PKG-DESC asynchronously. +This assumes that `pkg-desc' has already been activated with +`package-activate-1'." + (when (and (featurep 'native-compile) + (native-comp-available-p)) + (let ((warning-minimum-level :error)) + (native-compile-async (package-desc-dir pkg-desc) t)))) + ;;;; Inferring package from current buffer (defun package-read-from-string (str) "Read a Lisp expression from STR. @@ -1104,7 +1121,7 @@ is wrapped around any parts requiring it." (declare-function lm-header-multiline "lisp-mnt" (header)) (declare-function lm-homepage "lisp-mnt" (&optional file)) (declare-function lm-keywords-list "lisp-mnt" (&optional file)) -(declare-function lm-maintainer "lisp-mnt" (&optional file)) +(declare-function lm-maintainers "lisp-mnt" (&optional file)) (declare-function lm-authors "lisp-mnt" (&optional file)) (defun package-buffer-info () @@ -1150,7 +1167,10 @@ boundaries." :kind 'single :url homepage :keywords keywords - :maintainer (lm-maintainer) + :maintainer + ;; For backward compatibility, use a single string if there's only + ;; one maintainer (the most common case). + (let ((maints (lm-maintainers))) (if (cdr maints) maints (car maints))) :authors (lm-authors))))) (defun package--read-pkg-desc (kind) @@ -1289,7 +1309,10 @@ is non-nil, don't propagate connection errors (does not apply to errors signaled by ERROR-FORM or by BODY). \(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)" - (declare (indent defun) (debug t)) + (declare (indent defun) + ;; FIXME: This should be something like + ;; `form def-body &rest form', but that doesn't work. + (debug (form &rest sexp))) (while (keywordp (car body)) (setq body (cdr (cdr body)))) `(package--with-response-buffer-1 ,url (lambda () ,@body) @@ -1347,11 +1370,9 @@ errors signaled by ERROR-FORM or by BODY). (kill-buffer buffer) (goto-char (point-min)))))) (package--unless-error body - (let ((url (expand-file-name file url))) - (unless (file-name-absolute-p url) - (error "Location %s is not a url nor an absolute file name" - url)) - (insert-file-contents-literally url))))) + (unless (file-name-absolute-p url) + (error "Location %s is not a url nor an absolute file name" url)) + (insert-file-contents-literally (expand-file-name file url))))) (define-error 'bad-signature "Failed to verify signature") @@ -2176,8 +2197,24 @@ Downloads and installs required packages as needed." ((derived-mode-p 'tar-mode) (package-tar-file-info)) (t - (save-excursion - (package-buffer-info))))) + ;; Package headers should be parsed from decoded text + ;; (see Bug#48137) where possible. + (if (and (eq buffer-file-coding-system 'no-conversion) + buffer-file-name) + (let* ((package-buffer (current-buffer)) + (decoding-system + (car (find-operation-coding-system + 'insert-file-contents + (cons buffer-file-name + package-buffer))))) + (with-temp-buffer + (insert-buffer-substring package-buffer) + (decode-coding-region (point-min) (point-max) + decoding-system) + (package-buffer-info))) + + (save-excursion + (package-buffer-info)))))) (name (package-desc-name pkg-desc))) ;; Download and install the dependencies. (let* ((requires (package-desc-reqs pkg-desc)) @@ -2203,14 +2240,18 @@ directory." (setq default-directory file) (dired-mode)) (insert-file-contents-literally file) + (set-visited-file-name file) (when (string-match "\\.tar\\'" file) (tar-mode))) (package-install-from-buffer))) ;;;###autoload -(defun package-install-selected-packages () +(defun package-install-selected-packages (&optional noconfirm) "Ensure packages in `package-selected-packages' are installed. -If some packages are not installed propose to install them." +If some packages are not installed, propose to install them. +If optional argument NOCONFIRM is non-nil, don't ask for +confirmation to install packages." (interactive) + (package--archives-initialize) ;; We don't need to populate `package-selected-packages' before ;; using here, because the outcome is the same either way (nothing ;; gets installed). @@ -2221,10 +2262,11 @@ If some packages are not installed propose to install them." (difference (- (length not-installed) (length available)))) (cond (available - (when (y-or-n-p - (format "Packages to install: %d (%s), proceed? " - (length available) - (mapconcat #'symbol-name available " "))) + (when (or noconfirm + (y-or-n-p + (format "Packages to install: %d (%s), proceed? " + (length available) + (mapconcat #'symbol-name available " ")))) (mapc (lambda (p) (package-install p 'dont-select)) available))) ((> difference 0) (message "Packages that are not available: %d (the rest is already installed), maybe you need to `M-x package-refresh-contents'" @@ -2240,6 +2282,17 @@ If some packages are not installed propose to install them." (equal (cadr (assq (package-desc-name pkg) package-alist)) pkg)) +(declare-function comp-el-to-eln-filename "comp.c") +(defun package--delete-directory (dir) + "Delete DIR recursively. +Clean-up the corresponding .eln files if Emacs is native +compiled." + (when (featurep 'native-compile) + (cl-loop + for file in (directory-files-recursively dir "\\.el\\'") + do (comp-clean-up-stale-eln (comp-el-to-eln-filename file)))) + (delete-directory dir t)) + (defun package-delete (pkg-desc &optional force nosave) "Delete package PKG-DESC. @@ -2292,7 +2345,7 @@ If NOSAVE is non-nil, the package is not removed from (package-desc-name pkg-used-elsewhere-by))) (t (add-hook 'post-command-hook #'package-menu--post-refresh) - (delete-directory dir t) + (package--delete-directory dir) ;; Remove NAME-VERSION.signed and NAME-readme.txt files. ;; ;; NAME-readme.txt files are no longer created, but they @@ -2693,9 +2746,9 @@ PROPERTIES are passed to `insert-text-button', for which this function is a convenience wrapper used by `describe-package-1'." (let ((button-text (if (display-graphic-p) text (concat "[" text "]"))) (button-face (if (display-graphic-p) - '(:box (:line-width 2 :color "dark grey") - :background "light grey" - :foreground "black") + (progn + (require 'cus-edit) ; for the custom-button face + 'custom-button) 'link))) (apply #'insert-text-button button-text 'face button-face 'follow-link t properties))) @@ -2732,6 +2785,7 @@ either a full name or nil, and EMAIL is a valid email address." (define-key map "U" 'package-menu-mark-upgrades) (define-key map "r" 'revert-buffer) (define-key map "~" 'package-menu-mark-obsolete-for-deletion) + (define-key map "w" 'package-browse-url) (define-key map "x" 'package-menu-execute) (define-key map "h" 'package-menu-quick-help) (define-key map "H" #'package-menu-hide-package) @@ -2754,6 +2808,8 @@ either a full name or nil, and EMAIL is a valid email address." "Menu for `package-menu-mode'." '("Package" ["Describe Package" package-menu-describe-package :help "Display information about this package"] + ["Open Package Homepage" package-browse-url + :help "Open the homepage of this package"] ["Help" package-menu-quick-help :help "Show short key binding help for package-menu-mode"] "--" ["Refresh Package List" revert-buffer @@ -2803,6 +2859,7 @@ either a full name or nil, and EMAIL is a valid email address." Letters do not insert themselves; instead, they are commands. \\<package-menu-mode-map> \\{package-menu-mode-map}" + :interactive nil (setq mode-line-process '((package--downloads-in-progress ":Loading") (package-menu--transaction-status package-menu--transaction-status))) @@ -2925,7 +2982,7 @@ Installed obsolete packages are always displayed.") Also hide packages whose name matches a regexp in user option `package-hidden-regexps' (a list). To add regexps to this list, use `package-menu-hide-package'." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (setq package-menu--hide-packages (not package-menu--hide-packages)) @@ -3262,7 +3319,7 @@ To unhide a package, type Type \\[package-menu-toggle-hiding] to toggle package hiding." (declare (interactive-only "change `package-hidden-regexps' instead.")) - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (let* ((name (when (derived-mode-p 'package-menu-mode) (concat "\\`" (regexp-quote (symbol-name (package-desc-name @@ -3286,7 +3343,7 @@ Type \\[package-menu-toggle-hiding] to toggle package hiding." (defun package-menu-describe-package (&optional button) "Describe the current package. If optional arg BUTTON is non-nil, describe its associated package." - (interactive) + (interactive nil package-menu-mode) (let ((pkg-desc (if button (button-get button 'package-desc) (tabulated-list-get-id)))) (if pkg-desc @@ -3296,7 +3353,7 @@ If optional arg BUTTON is non-nil, describe its associated package." ;; fixme numeric argument (defun package-menu-mark-delete (&optional _num) "Mark a package for deletion and move to the next line." - (interactive "p") + (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (if (member (package-menu-get-status) '("installed" "dependency" "obsolete" "unsigned")) @@ -3305,7 +3362,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-mark-install (&optional _num) "Mark a package for installation and move to the next line." - (interactive "p") + (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency")) (tabulated-list-put-tag "I" t) @@ -3313,20 +3370,20 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-mark-unmark (&optional _num) "Clear any marks on a package and move to the next line." - (interactive "p") + (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (tabulated-list-put-tag " " t)) (defun package-menu-backup-unmark () "Back up one line and clear any marks on that package." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (forward-line -1) (tabulated-list-put-tag " ")) (defun package-menu-mark-obsolete-for-deletion () "Mark all obsolete packages for deletion." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (save-excursion (goto-char (point-min)) @@ -3336,7 +3393,8 @@ If optional arg BUTTON is non-nil, describe its associated package." (forward-line 1))))) (defvar package--quick-help-keys - '(("install," "delete," "unmark," ("execute" . 1)) + '((("mark for installation," . 9) + ("mark for deletion," . 9) "unmark," ("execute marked actions" . 1)) ("next," "previous") ("Hide-package," "(-toggle-hidden") ("g-refresh-contents," "/-filter," "help"))) @@ -3357,7 +3415,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-quick-help () "Show short key binding help for `package-menu-mode'. The full list of keys can be viewed with \\[describe-mode]." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (message (mapconcat #'package--prettify-quick-help-key package--quick-help-keys "\n"))) @@ -3453,7 +3511,7 @@ call will upgrade the package. If there's an async refresh operation in progress, the flags will be placed as part of `package-menu--post-refresh' instead of immediately." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (if (not package--downloads-in-progress) (package-menu--mark-upgrades-1) @@ -3547,7 +3605,7 @@ packages list, respectively." Packages marked for installation are downloaded and installed; packages marked for deletion are removed. Optional argument NOQUERY non-nil means do not ask the user to confirm." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (let (install-list delete-list cmd pkg-desc) (save-excursion @@ -3792,7 +3850,8 @@ strings. If ARCHIVE is nil or the empty string, show all packages." (interactive (list (completing-read-multiple "Filter by archive (comma separated): " - (mapcar #'car package-archives)))) + (mapcar #'car package-archives))) + package-menu-mode) (package--ensure-package-menu-mode) (let ((re (if (listp archive) (regexp-opt archive) @@ -3813,7 +3872,8 @@ DESCRIPTION. When called interactively, prompt for DESCRIPTION. If DESCRIPTION is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by description (regexp)"))) + (interactive (list (read-regexp "Filter by description (regexp)")) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not description) (string-empty-p description)) (package-menu--generate t t) @@ -3834,10 +3894,11 @@ strings. If KEYWORD is nil or the empty string, show all packages." (interactive (list (completing-read-multiple "Keywords (comma separated): " - (package-all-keywords)))) + (package-all-keywords))) + package-menu-mode) + (package--ensure-package-menu-mode) (when (stringp keyword) (setq keyword (list keyword))) - (package--ensure-package-menu-mode) (if (not keyword) (package-menu--generate t t) (package-menu--filter-by (lambda (pkg-desc) @@ -3856,7 +3917,8 @@ When called interactively, prompt for NAME-OR-DESCRIPTION. If NAME-OR-DESCRIPTION is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by name or description (regexp)"))) + (interactive (list (read-regexp "Filter by name or description (regexp)")) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not name-or-description) (string-empty-p name-or-description)) (package-menu--generate t t) @@ -3875,7 +3937,8 @@ Display only packages with name that matches regexp NAME. When called interactively, prompt for NAME. If NAME is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by name (regexp)"))) + (interactive (list (read-regexp "Filter by name (regexp)")) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not name) (string-empty-p name)) (package-menu--generate t t) @@ -3905,13 +3968,19 @@ packages." "incompat" "installed" "new" - "unsigned")))) + "unsigned"))) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not status) (string-empty-p status)) (package-menu--generate t t) - (package-menu--filter-by (lambda (pkg-desc) - (string-match-p status (package-desc-status pkg-desc))) - (format "status:%s" status)))) + (let ((status-list + (if (listp status) + status + (split-string status ",")))) + (package-menu--filter-by + (lambda (pkg-desc) + (member (package-desc-status pkg-desc) status-list)) + (format "status:%s" (string-join status-list ",")))))) (defun package-menu-filter-by-version (version predicate) "Filter the \"*Packages*\" buffer by VERSION and PREDICATE. @@ -3940,7 +4009,9 @@ If VERSION is nil or the empty string, show all packages." ('< "< less than") ('> "> greater than")) "): ")) - choice)))) + choice))) + package-menu-mode) + (package--ensure-package-menu-mode) (unless (equal predicate 'quit) (if (or (not version) (string-empty-p version)) (package-menu--generate t t) @@ -3958,7 +4029,7 @@ If VERSION is nil or the empty string, show all packages." (defun package-menu-filter-marked () "Filter \"*Packages*\" buffer by non-empty upgrade mark. Unlike other filters, this leaves the marks intact." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (widen) (let (found-entries mark pkg-id entry marks) @@ -3986,7 +4057,7 @@ Unlike other filters, this leaves the marks intact." (defun package-menu-filter-upgradable () "Filter \"*Packages*\" buffer to show only upgradable packages." - (interactive) + (interactive nil package-menu-mode) (let ((pkgs (mapcar #'car (package-menu--find-upgrades)))) (package-menu--filter-by (lambda (pkg) @@ -3995,7 +4066,7 @@ Unlike other filters, this leaves the marks intact." (defun package-menu-clear-filter () "Clear any filter currently applied to the \"*Packages*\" buffer." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (package-menu--generate t t)) @@ -4016,10 +4087,7 @@ The return value is a string (or nil in case we can't find it)." ;; the version at compile time and hardcodes it into the .elc file! (declare (pure t)) ;; Hack alert! - (let ((file - (or (if (boundp 'byte-compile-current-file) byte-compile-current-file) - load-file-name - buffer-file-name))) + (let ((file (or (macroexp-file-name) buffer-file-name))) (cond ((null file) nil) ;; Packages are normally installed into directories named "<pkg>-<vers>", @@ -4088,6 +4156,10 @@ activations need to be changed, such as when `package-load-list' is modified." (package-activated-list ()) ;; Make sure we can load this file without load-source-file-function. (coding-system-for-write 'emacs-internal) + ;; Ensure that `pp' and `prin1-to-string' calls further down + ;; aren't truncated. + (print-length nil) + (print-level nil) (Info-directory-list '(""))) (dolist (elt package-alist) (condition-case err @@ -4106,7 +4178,8 @@ activations need to be changed, such as when `package-load-list' is modified." (let ((load-suffixes '(".el" ".elc"))) (locate-library (package--autoloads-file-name pkg)))) (pfile (prin1-to-string file))) - (insert "(let ((load-file-name " pfile "))\n") + (insert "(let ((load-true-file-name " pfile ")\ +(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) @@ -4155,6 +4228,22 @@ beginning of the line." (package-version-join (package-desc-version package-desc)) (package-desc-summary package-desc)))) +(defun package-browse-url (desc &optional secondary) + "Open the home page of the package under point in a browser. +`browse-url' is used to determine the browser to be used. +If SECONDARY (interactively, the prefix), use the secondary browser." + (interactive (list (tabulated-list-get-id) + current-prefix-arg) + package-menu-mode) + (unless desc + (user-error "No package here")) + (let ((url (cdr (assoc :url (package-desc-extras desc))))) + (unless url + (user-error "No home page for %s" (package-desc-name desc))) + (if secondary + (funcall browse-url-secondary-browser-function url) + (browse-url url)))) + ;;;; Introspection (defun package-get-descriptor (pkg-name) |