summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/bytecomp.el16
-rw-r--r--lisp/emacs-lisp/package-vc.el284
-rw-r--r--lisp/emacs-lisp/package.el194
3 files changed, 449 insertions, 45 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 9d5f6682b5a..5b9f92a4cc2 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1876,6 +1876,9 @@ Files in subdirectories of DIRECTORY are processed also."
(interactive "DByte force recompile (directory): ")
(byte-recompile-directory directory nil t))
+(defvar byte-compile-ignore-files nil
+ "List of regexps for files to ignore during byte compilation.")
+
;;;###autoload
(defun byte-recompile-directory (directory &optional arg force follow-symlinks)
"Recompile every `.el' file in DIRECTORY that needs recompilation.
@@ -1932,14 +1935,23 @@ also be compiled."
;; This file is a subdirectory. Handle them differently.
(or (null arg) (eq 0 arg)
(y-or-n-p (concat "Check " source "? ")))
- (setq directories (nconc directories (list source))))
+ (setq directories (nconc directories (list source)))
+ ;; Directory is requested to be ignored
+ (string-match-p
+ (regexp-opt byte-compile-ignore-files)
+ source)
+ (setq directories (nconc directories (list source))))
;; It is an ordinary file. Decide whether to compile it.
(if (and (string-match emacs-lisp-file-regexp source)
;; The next 2 tests avoid compiling lock files
(file-readable-p source)
(not (string-match "\\`\\.#" file))
(not (auto-save-file-name-p source))
- (not (member source (dir-locals--all-files directory))))
+ (not (member source (dir-locals--all-files directory)))
+ ;; File is requested to be ignored
+ (string-match-p
+ (regexp-opt byte-compile-ignore-files)
+ source))
(progn (cl-incf
(pcase (byte-recompile-file source force arg)
('no-byte-compile skip-count)
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
new file mode 100644
index 00000000000..27f1c7c3b70
--- /dev/null
+++ b/lisp/emacs-lisp/package-vc.el
@@ -0,0 +1,284 @@
+;;; package-vc.el --- Manage packages from VC checkouts -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Keywords: tools
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; While packages managed by package.el use tarballs for distributing
+;; the source code, this extension allows for packages to be fetched
+;; and updated directly from a version control system.
+
+;;; TODO:
+
+;; - Allow for automatic updating TODO
+;; * Detect merge conflicts TODO
+;; * Check if there are upstream changes TODO
+;; - Allow finding revisions that bump the version tag TODO
+;; * Allow for `package-vc-fetch' to use the version
+;; of the package if already installed.
+;; - Allow for ELPA specifications to be respected without TODO
+;; endangering the user with arbitrary code execution
+;; - Allow sending patches to package maintainers TODO
+;; * Add `vc-send-patch' to vc.el TODO
+
+;;; Code:
+
+(eval-when-compile (require 'rx))
+(require 'package)
+(require 'lisp-mnt)
+(require 'vc)
+(require 'seq)
+
+(defgroup package-vc nil
+ "Manage packages from VC checkouts."
+ :group 'package
+ :version "29.1")
+
+(defcustom package-vc-probable-repository-regexp
+ (rx bos "http" (? "s") "://"
+ (or (: (? "www.") "github.com"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "codeberg.org"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: (? "www.") "gitlab" (+ "." (+ alnum))
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_"))))
+ (or (? "/") ".git") eos)
+ "Regular expression matching URLs that are repositories."
+ :version "29.1"
+ :type 'regex)
+
+(defun package-vc-commit (pkg)
+ "Extract the commit of a development package PKG."
+ (cl-assert (eq (package-desc-kind pkg) 'vc))
+ ;; FIXME: vc should be extended to allow querying the commit of a
+ ;; directory (as is possible when dealing with git repositores).
+ ;; This should be a fallback option.
+ (cl-loop with dir = (package-desc-dir pkg)
+ for file in (directory-files dir t "\\.el\\'" t)
+ when (vc-working-revision file) return it
+ finally return "unknown"))
+
+(defun package-vc-version (pkg)
+ "Extract the commit of a development package PKG."
+ (cl-assert (eq (package-desc-kind pkg) 'vc))
+ (cl-loop with dir = (package-desc-dir pkg) ;FIXME: dir is nil
+ for file in (sort (directory-files dir t "\\.el\\'")
+ (lambda (s1 s2)
+ (< (length s1) (length s2))))
+ when (with-temp-buffer
+ (insert-file-contents file)
+ (package-strip-rcs-id
+ (or (lm-header "package-version")
+ (lm-header "version"))))
+ return it
+ finally return "0"))
+
+(defun package-vc-generate-description-file (pkg-desc pkg-file)
+ "Generate a package description file for PKG-DESC.
+The output is written out into PKG-FILE."
+ (let* ((name (package-desc-name pkg-desc)))
+ (let ((print-level nil)
+ (print-quoted t)
+ (print-length nil))
+ (write-region
+ (concat
+ ";;; Generated package description from "
+ (replace-regexp-in-string
+ "-pkg\\.el\\'" ".el"
+ (file-name-nondirectory pkg-file))
+ " -*- no-byte-compile: t -*-\n"
+ (prin1-to-string
+ (nconc
+ (list 'define-package
+ (symbol-name name)
+ (cons 'vc (package-vc-version pkg-desc))
+ (package-desc-summary pkg-desc)
+ (let ((requires (package-desc-reqs pkg-desc)))
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires))))
+ (package--alist-to-plist-args
+ (package-desc-extras pkg-desc))))
+ "\n")
+ nil pkg-file nil 'silent))))
+
+(defun package-vc-unpack (pkg-desc)
+ "Install the package described by PKG-DESC."
+ (let* ((name (package-desc-name pkg-desc))
+ (dirname (package-desc-full-name pkg-desc))
+ (pkg-dir (expand-file-name dirname package-user-dir)))
+ (setf (package-desc-dir pkg-desc) pkg-dir)
+ (when (file-exists-p pkg-dir)
+ (if (yes-or-no-p "Overwrite previous checkout?")
+ (package--delete-directory pkg-dir)
+ (error "There already exists a checkout for %s" name)))
+ (pcase-let* ((attr (package-desc-extras pkg-desc))
+ (`(,backend ,repo ,dir ,branch)
+ (or (alist-get :upstream attr)
+ (error "Source package has no repository"))))
+ (make-directory (file-name-directory pkg-dir) t)
+ (unless (setf (car (alist-get :upstream attr))
+ (vc-clone backend repo pkg-dir))
+ (error "Failed to clone %s from %s" name repo))
+ (when-let ((rev (or (alist-get :rev attr) branch)))
+ (vc-retrieve-tag pkg-dir rev))
+ (when dir (setq pkg-dir (file-name-concat pkg-dir dir)))
+
+ ;; In case the package was installed directly from source, the
+ ;; dependency list wasn't know beforehand, and they might have
+ ;; to be installed explicitly.
+ (let (deps)
+ (dolist (file (directory-files pkg-dir t "\\.el\\'" t))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when-let* ((require-lines (lm-header-multiline "package-requires")))
+ (thread-last
+ (mapconcat #'identity require-lines " ")
+ package-read-from-string
+ package--prepare-dependencies
+ (nconc deps)
+ (setq deps)))))
+ (dolist (dep deps)
+ (cl-callf version-to-list (cadr dep)))
+ (package-download-transaction
+ (package-compute-transaction nil (delete-dups deps)))))
+
+ (let ((default-directory pkg-dir)
+ (name (package-desc-name pkg-desc))
+ (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir)))
+ ;; Generate autoloads
+ (package-generate-autoloads name pkg-dir)
+ (vc-ignore (concat "/" (file-relative-name
+ (expand-file-name (format "%s-autoloads.el" name))
+ default-directory)))
+
+ ;; Generate package file
+ (package-vc-generate-description-file pkg-desc pkg-file)
+ (vc-ignore (concat "/" (file-relative-name pkg-file default-directory))))
+
+ ;; Update package-alist.
+ (let ((new-desc (package-load-descriptor pkg-dir)))
+ ;; Activation has to be done before compilation, so that if we're
+ ;; upgrading and macros have changed we load the new definitions
+ ;; before compiling.
+ (when (package-activate-1 new-desc :reload :deps)
+ ;; FIXME: Compilation should be done as a separate, optional, step.
+ ;; 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--reload-previously-loaded new-desc)))
+
+ ;; Detect a manual
+ (when (executable-find "install-info")
+ ;; Only proceed if we can find an unambiguous TeXinfo file
+ (let ((texi-files (directory-files pkg-dir t "\\.texi\\'"))
+ (dir-file (expand-file-name "dir" pkg-dir)))
+ (when (length= texi-files 1)
+ (call-process "install-info" nil nil nil
+ (concat "--dir=" dir-file)
+ (car texi-files)))))))
+
+(defun package-vc-sourced-packages-list ()
+ "Generate a list of packages with VC data."
+ (seq-filter
+ (lambda (pkg)
+ (let ((extras (package-desc-extras (cadr pkg))))
+ (or (alist-get :vc extras)
+ ;; If we have no explicit VC data, we can try a kind of
+ ;; heuristic and use the URL header, that might already be
+ ;; pointing towards a repository, and use that as a backup
+ (and-let* ((url (alist-get :url extras))
+ ((string-match-p package-vc-probable-repository-regexp
+ url)))
+ ;; XXX: Currently `package-vc-probable-repository-regexp'
+ ;; only contains Git repositories, so we can infer the
+ ;; repository type. This might work for now, but is not a
+ ;; particularly resilient approach.
+ (setf (alist-get :vc (package-desc-extras (cadr pkg)))
+ (list 'Git url))
+ t))))
+ package-archive-contents))
+
+(defun package-vc-update (pkg-desc)
+ "Attempt to update the packager PKG-DESC."
+ (let ((default-directory (package-desc-dir pkg-desc)))
+ (with-demoted-errors "Error during package update: %S"
+ (vc-pull))))
+
+(defun package-vc-fetch (name-or-url &optional name rev)
+ "Fetch the source of NAME-OR-URL.
+If NAME-OR-URL is a URL, then the package will be downloaded from
+the repository indicated by the URL. The function will try to
+guess the name of the package using `file-name-base'. This can
+be overridden by manually passing the optional NAME. Otherwise
+NAME-OR-URL is taken to be a package name, and the package
+metadata will be consulted for the URL. An explicit revision can
+be requested using REV."
+ (interactive
+ (progn
+ ;; Initialize the package system to get the list of package
+ ;; symbols for completion.
+ (package--archives-initialize)
+ (let* ((packages (package-vc-sourced-packages-list))
+ (input (completing-read
+ "Fetch package source (name or URL): " packages))
+ (name (file-name-base input)))
+ (list input (intern (string-remove-prefix "emacs-" name))))))
+ (package--archives-initialize)
+ (package-vc-unpack
+ (cond
+ ((and (stringp name-or-url)
+ (url-type (url-generic-parse-url name-or-url)))
+ (package-desc-create
+ :name (or name (intern (file-name-base name-or-url)))
+ :kind 'vc
+ :extras `((:upstream . ,(list nil name-or-url nil nil))
+ (:rev . ,rev))))
+ ((when-let* ((desc (cadr (assoc name-or-url package-archive-contents
+ #'string=)))
+ (upstream (or (alist-get :vc (package-desc-extras desc))
+ (user-error "Package has no VC data"))))
+ (package-desc-create
+ :name (if (stringp name-or-url)
+ (intern name-or-url)
+ name-or-url)
+ :kind 'vc
+ :extras `((:upstream . ,upstream)
+ (:rev . ,rev)))))
+ ((user-error "Unknown package to fetch: %s" name-or-url)))))
+
+;;;###autoload
+(defalias 'package-checkout #'package-vc-fetch)
+
+(provide 'package-vc)
+;;; package-vc.el ends here
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)