diff options
Diffstat (limited to 'lisp/emacs-lisp/package.el')
| -rw-r--r-- | lisp/emacs-lisp/package.el | 194 |
1 files changed, 151 insertions, 43 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index ed23ee5f221..2de5056475d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -461,14 +461,18 @@ synchronously." &rest rest-plist &aux (name (intern name-string)) - (version (version-to-list version-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)) + (kind (if (eq (car-safe version-string) 'vc) + 'vc + (plist-get rest-plist :kind))) (archive (plist-get rest-plist :archive)) (extras (let (alist) (while rest-plist @@ -560,9 +564,11 @@ This is, approximately, the inverse of `version-to-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." - (format "%s-%s" - (package-desc-name pkg-desc) - (package-version-join (package-desc-version pkg-desc)))) + (if (eq (package-desc-kind pkg-desc) 'vc) + (symbol-name (package-desc-name pkg-desc)) + (format "%s-%s" + (package-desc-name pkg-desc) + (package-version-join (package-desc-version pkg-desc))))) (defun package-desc-suffix (pkg-desc) "Return file-name extension of package-desc object PKG-DESC. @@ -593,6 +599,25 @@ package." "Return the priority of the archive of package-desc object PKG-DESC." (package-archive-priority (package-desc-archive pkg-desc))) +(defun package--parse-elpaignore (pkg-desc) + "Return the of regular expression to match files ignored by PKG-DESC." + (let* ((pkg-dir (file-name-as-directory (package-desc-dir pkg-desc))) + (ignore (expand-file-name ".elpaignore" pkg-dir)) + files) + (when (file-exists-p ignore) + (with-temp-buffer + (insert-file-contents ignore) + (goto-char (point-min)) + (while (not (eobp)) + (push (wildcard-to-regexp + (let ((line (buffer-substring + (line-beginning-position) + (line-end-position)))) + (file-name-concat pkg-dir (string-trim-left line "/")))) + files) + (forward-line))) + files))) + (cl-defstruct (package--bi-desc (:constructor package-make-builtin (version summary)) (:type vector)) @@ -641,6 +666,8 @@ loaded and/or activated, customize `package-load-list'.") ;; `package-load-all-descriptors', which ultimately populates the ;; `package-alist' variable. +(declare-function package-vc-version "package-vc" (pkg)) + (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. @@ -669,6 +696,8 @@ are sorted with the highest version first." nil))) new-pkg-desc))) +(declare-function package-vc-commit "package-vc" (pkg)) + (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 @@ -684,6 +713,10 @@ return it." (read (current-buffer))) (error "Can't find define-package in %s" pkg-file)))) (setf (package-desc-dir pkg-desc) pkg-dir) + (when (eq (package-desc-kind pkg-desc) 'vc) + (require 'package-vc) + (push (cons :commit (package-vc-commit pkg-desc)) + (package-desc-extras pkg-desc))) (if (file-exists-p signed-file) (setf (package-desc-signed pkg-desc) t)) pkg-desc))))) @@ -699,11 +732,9 @@ 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 (subdir (directory-files dir)) - (unless (equal subdir "..") - (let ((pkg-dir (expand-file-name subdir dir))) - (when (file-directory-p pkg-dir) - (package-load-descriptor pkg-dir)))))))) + (dolist (pkg-dir (directory-files dir t "^[^.]" t)) + (when (file-directory-p pkg-dir) + (package-load-descriptor pkg-dir)))))) (defun package--alist () "Return `package-alist', after computing it if needed." @@ -867,14 +898,22 @@ correspond to previously loaded files (those returned by (defun package--get-activatable-pkg (pkg-name) ;; Is "activatable" a word? - (let ((pkg-descs (cdr (assq pkg-name package-alist)))) + (let ((pkg-descs (sort (cdr (assq pkg-name package-alist)) + (lambda (p1 p2) + (let ((v1 (package-desc-version p1)) + (v2 (package-desc-version p2))) + (or + ;; Prefer source packages. + (eq (package-desc-kind p1) 'vc) + (not (eq (package-desc-kind p2) 'vc)) + ;; Prefer builtin packages. + (package-disabled-p p1 v1) + (not (package-disabled-p p2 v2)))))))) ;; 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)))) + (package-disabled-p pkg-name available-version))) (setq pkg-descs (cdr pkg-descs))) (car pkg-descs))) @@ -952,7 +991,7 @@ untar into a directory named DIR; otherwise, signal an error." ;; indistinguishable from a `tar' or a `single'. Let's make ;; things simple by ensuring we're one of them. (setf (package-desc-kind pkg-desc) - (if (> (length file-list) 1) 'tar 'single)))) + (if (length> file-list 1) 'tar 'single)))) ('tar (make-directory package-user-dir t) (let* ((default-directory (file-name-as-directory package-user-dir))) @@ -1015,6 +1054,7 @@ untar into a directory named DIR; otherwise, signal an error." "\n") nil pkg-file nil 'silent)))) + ;;;; Autoload (declare-function autoload-rubric "autoload" (file &optional type feature)) @@ -1062,11 +1102,13 @@ untar into a directory named DIR; otherwise, signal an error." ;;;; Compilation (defvar warning-minimum-level) +(defvar byte-compile-ignore-files) (defun package--compile (pkg-desc) "Byte-compile installed package PKG-DESC. This assumes that `pkg-desc' has already been activated with `package-activate-1'." - (let ((warning-minimum-level :error) + (let ((byte-compile-ignore-files (package--parse-elpaignore pkg-desc)) + (warning-minimum-level :error) (load-path load-path)) (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))) @@ -2025,7 +2067,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." (cdr (assoc (package-desc-archive desc) package-archives))) (defun package-install-from-archive (pkg-desc) - "Download and install a tar package defined by PKG-DESC." + "Download and install a package defined by PKG-DESC." ;; This won't happen, unless the archive is doing something wrong. (when (eq (package-desc-kind pkg-desc) 'dir) (error "Can't install directory package from archive")) @@ -2165,17 +2207,22 @@ to install it but still mark it as selected." (message "Package `%s' installed." name)) (message "`%s' is already installed" name)))) +(declare-function package-vc-update "package-vc" (pkg)) + ;;;###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))) + (let* ((package (if (symbolp name) + name + (intern name))) + (pkg-desc (cadr (assq package package-alist)))) + (if (eq (package-desc-kind pkg-desc) 'vc) + (package-vc-update pkg-desc) + (package-delete pkg-desc 'force) + (package-install package 'dont-select)))) (defun package--updateable-packages () ;; Initialize the package system to get the list of package @@ -2616,7 +2663,10 @@ Helper function for `describe-package'." (incompatible-reason (package--incompatible-p desc)) (signed (if desc (package-desc-signed desc))) (maintainer (cdr (assoc :maintainer extras))) - (authors (cdr (assoc :authors extras)))) + (authors (cdr (assoc :authors extras))) + (news (and-let* ((file (expand-file-name "news" pkg-dir)) + ((file-readable-p file))) + file))) (when (string= status "avail-obso") (setq status "available obsolete")) (when incompatible-reason @@ -2815,6 +2865,14 @@ Helper function for `describe-package'." t) (insert (or readme-string "This package does not provide a description."))))) + + ;; Insert news if available. + (when news + (insert "\n" (make-separator-line) "\n" + (propertize "* News" 'face 'package-help-section-name) + "\n\n") + (insert-file-contents news)) + ;; Make library descriptions into links. (goto-char start-of-description) (package--describe-add-library-links) @@ -2905,6 +2963,7 @@ either a full name or nil, and EMAIL is a valid email address." "r" #'revert-buffer "~" #'package-menu-mark-obsolete-for-deletion "w" #'package-browse-url + "m" #'package-contact-maintainer "x" #'package-menu-execute "h" #'package-menu-quick-help "H" #'package-menu-hide-package @@ -3063,6 +3122,7 @@ of these dependencies, similar to the list returned by (signed (or (not package-list-unsigned) (package-desc-signed pkg-desc)))) (cond + ((eq (package-desc-kind pkg-desc) 'vc) "source") ((eq dir 'builtin) "built-in") ((and lle (null held)) "disabled") ((stringp held) @@ -3151,8 +3211,9 @@ to their archives." (if (not installed) filtered-by-priority (let ((ins-version (package-desc-version installed))) - (cl-remove-if (lambda (p) (version-list-= (package-desc-version p) - ins-version)) + (cl-remove-if (lambda (p) (or (version-list-= (package-desc-version p) + ins-version) + (eq (package-desc-kind installed) 'vc))) filtered-by-priority)))))))) (defcustom package-hidden-regexps nil @@ -3354,6 +3415,11 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." "Face used on the status and version of installed packages." :version "25.1") +(defface package-status-from-source + '((t :inherit font-lock-negation-char-face)) + "Face used on the status and version of installed packages." + :version "29.1") + (defface package-status-dependency '((t :inherit package-status-installed)) "Face used on the status and version of dependency packages." @@ -3391,6 +3457,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." ("held" 'package-status-held) ("disabled" 'package-status-disabled) ("installed" 'package-status-installed) + ("source" 'package-status-from-source) ("dependency" 'package-status-dependency) ("unsigned" 'package-status-unsigned) ("incompat" 'package-status-incompat) @@ -3402,9 +3469,14 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." follow-link t package-desc ,pkg action package-menu-describe-package) - ,(propertize (package-version-join - (package-desc-version pkg)) - 'font-lock-face face) + ,(propertize + (if (eq (package-desc-kind pkg) 'vc) + (progn + (require 'package-vc) + (package-vc-commit pkg)) + (package-version-join + (package-desc-version pkg))) + 'font-lock-face face) ,(propertize status 'font-lock-face face) ,@(if (cdr package-archives) (list (propertize (or (package-desc-archive pkg) "") @@ -3479,7 +3551,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (if (member (package-menu-get-status) - '("installed" "dependency" "obsolete" "unsigned")) + '("installed" "source" "dependency" "obsolete" "unsigned")) (tabulated-list-put-tag "D" t) (forward-line))) @@ -3831,6 +3903,8 @@ This is used for `tabulated-list-format' in `package-menu-mode'." ((string= sB "installed") nil) ((string= sA "dependency") t) ((string= sB "dependency") nil) + ((string= sA "source") t) + ((string= sB "source") nil) ((string= sA "unsigned") t) ((string= sB "unsigned") nil) ((string= sA "held") t) @@ -4124,6 +4198,7 @@ packages." "held" "incompat" "installed" + "source" "new" "unsigned"))) package-menu-mode) @@ -4195,22 +4270,22 @@ Unlike other filters, this leaves the marks intact." (while (not (eobp)) (setq mark (char-after)) (unless (eq mark ?\s) - (setq pkg-id (tabulated-list-get-id)) + (setq pkg-id (tabulated-list-get-id)) (setq entry (package-menu--print-info-simple pkg-id)) - (push entry found-entries) - ;; remember the mark - (push (cons pkg-id mark) marks)) + (push entry found-entries) + ;; remember the mark + (push (cons pkg-id mark) marks)) (forward-line)) (if found-entries (progn (setq tabulated-list-entries found-entries) (package-menu--display t nil) - ;; redo the marks, but we must remember the marks!! - (goto-char (point-min)) - (while (not (eobp)) - (setq mark (cdr (assq (tabulated-list-get-id) marks))) - (tabulated-list-put-tag (char-to-string mark) t))) - (user-error "No packages found"))))) + ;; redo the marks, but we must remember the marks!! + (goto-char (point-min)) + (while (not (eobp)) + (setq mark (cdr (assq (tabulated-list-get-id) marks))) + (tabulated-list-put-tag (char-to-string mark) t))) + (user-error "No packages found"))))) (defun package-menu-filter-upgradable () "Filter \"*Packages*\" buffer to show only upgradable packages." @@ -4392,11 +4467,22 @@ beginning of the line." (package-version-join (package-desc-version package-desc)) (package-desc-summary package-desc)))) +(defun package--query-desc (&optional alist) + "Query the user for a package or return the package at point. +The optional argument ALIST must consist of elements with the +form (PKG-NAME PKG-DESC). If not specified, it will default to +`package-alist'." + (or (tabulated-list-get-id) + (let ((alist (or alist package-alist))) + (cadr (assoc (completing-read "Package: " alist nil t) + alist #'string=))))) + (defun package-browse-url (desc &optional secondary) "Open the website 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) +`browse-url' is used to determine the browser to be used. If +SECONDARY (interactively, the prefix), use the secondary browser. +DESC must be a `package-desc' object." + (interactive (list (package--query-desc) current-prefix-arg) package-menu-mode) (unless desc @@ -4405,9 +4491,31 @@ If SECONDARY (interactively, the prefix), use the secondary browser." (unless url (user-error "No website for %s" (package-desc-name desc))) (if secondary - (funcall browse-url-secondary-browser-function url) + (funcall browse-url-secondary-browser-function url) (browse-url url)))) +;; TODO: Allow attaching a patch to send directly to the maintainer. +;; Ideally this should be able to detect the local changes, convert +;; these into patches. +(defun package-contact-maintainer (desc) + "Prepare a message to send to the maintainers of a package. +DESC must be a `package-desc' object." + (interactive (list (package--query-desc package-archive-contents)) + package-menu-mode) + (unless desc + (user-error "No package here")) + (let* ((extras (package-desc-extras desc)) + (maint (alist-get :maintainer extras)) + (name (package-desc-name desc)) + (subject (read-string "Subject: "))) + (unless maint + (user-error "Package has no explicit maintainer")) + (compose-mail + (with-temp-buffer + (package--print-email-button maint) + (string-trim (substring-no-properties (buffer-string)))) + (format "[%s] %s" name subject)))) + ;;;; Introspection (defun package-get-descriptor (pkg-name) |