diff options
| -rw-r--r-- | doc/emacs/package.texi | 45 | ||||
| -rw-r--r-- | etc/NEWS | 25 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 16 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package-vc.el | 393 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 253 | ||||
| -rw-r--r-- | lisp/vc/vc-bzr.el | 3 | ||||
| -rw-r--r-- | lisp/vc/vc-git.el | 3 | ||||
| -rw-r--r-- | lisp/vc/vc-hg.el | 2 | ||||
| -rw-r--r-- | lisp/vc/vc-svn.el | 3 | ||||
| -rw-r--r-- | lisp/vc/vc.el | 26 |
10 files changed, 719 insertions, 50 deletions
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 420da090977..087e506d6c4 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -49,6 +49,7 @@ Manual}. * Package Statuses:: Which statuses a package can have. * Package Installation:: Options for package installation. * Package Files:: Where packages are installed. +* Package from Source:: Managing packages directly from source. @end menu @node Package Menu @@ -530,3 +531,47 @@ are laid out in the same way as in @code{package-user-dir}. corresponding package subdirectory. This only works for packages installed in @code{package-user-dir}; if told to act on a package in a system-wide package directory, the deletion command signals an error. + +@node Package from Source +@section Package from Source +@cindex package source vcs git @c "git" is not technically correct + @c but it is a popular term + + By default @code{package-install} will download a Tarball from a +package archive and install the files therein contained. Most of the +time this is just what you want. One exception is when you decide to +hack on the source code of a package, and would like to share these +changes with other users. In that case you usually want to fetch and +work on the upstream source, so that you can prepare a usable patch. + +@findex package-vc-install + One way to do this is to use @code{package-vc-install}, to fetch the +source code for a package directly from source. The command will also +automatically ensure that all files are byte-compiled and auto-loaded, +just like with a regular package. From this point on the package can +be regarded just like any other package, that can be updated (using +@code{package-update}), deleted (using @code{package-delete}) and +viewed in the package listing. + +@findex package-contact-maintainer +@findex package-report-bug +@findex package-vc-prepare-patch + With the source checkout, you might want to reproduce a bug against +the current development head or implement a new feature to scratch an +itch. If the package metadata indicates that a maintainer can be +contacted via Email, you can use the commands +@code{package-contact-maintainer} to send them a message, or +@code{package-report-bug} to report a bug that will include all the +user options that you have customised. Patches can be sent out using +@code{package-vc-prepare-patch}, that makes use of +@code{vc-prepare-patch} under the hold (@pxref{Preparing Patches}). + +@findex package-vc-link-directory +@findex package-vc-refresh + If you maintain your own packages you might want to use a local +checkout instead of cloning a remote repository. This can be done +using @code{package-vc-link-directory}, that creates a symbolic link +from the package directory (@pxref{Package Files}) to your checkout +and initialises the code. Note that if changes are made such as +adding autoloads, you should use @code{package-vc-refresh} to repeat +the initialisation. @@ -1562,6 +1562,31 @@ These commands can be useful if the ".elc" files are out of date If no packages are marked, 'x' will install the package under point if it isn't already, and remove it if it is installed. ++++ +*** New command 'package-vc-install' +Packages can now be installed directly from source by cloning from a +repository. + ++++ +*** New command 'package-vc-link-directory' +An existing checkout can now be loaded via package.el, by creating a +symbolic link from the usual package directory to the checkout. + ++++ +*** New command 'package-vc-prepare-patch' +This command allows you to send patches to package maintainers, for +packages checked out using 'package-vc-install'. + ++++ +*** New command 'package-contact-maintainer' +This command gives you a generic way to send messages to package +maintainers. + ++++ +*** New command 'package-report-bug' +This command helps you compose an email for sending bug reports to +package maintainers. + ** Miscellaneous +++ diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 74ba8984f29..ec45f488971 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1886,6 +1886,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. @@ -1942,14 +1945,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..dfa8094e614 --- /dev/null +++ b/lisp/emacs-lisp/package-vc.el @@ -0,0 +1,393 @@ +;;; 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-install' 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 + +;;; Code: + +(eval-when-compile (require 'rx)) +(require 'package) +(require 'lisp-mnt) +(require 'vc) +(require 'seq) +(require 'xdg) + +(defgroup package-vc nil + "Manage packages from VC checkouts." + :group 'package + :version "29.1") + +(defcustom package-vc-heusitic-alist + `((,(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 "-" "." "_"))) + (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/" + (or "r" "git") "/" + (+ (or alnum "-" "." "_")) (? "/"))) + (or (? "/") ".git") eos) + . Git) + (,(rx bos "http" (? "s") "://" + (or (: "hg.sr.ht" + "/~" (+ (or alnum "-" "." "_")) + "/" (+ (or alnum "-" "." "_"))) + (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/" + (+ (or alnum "-" "." "_")) (? "/"))) + eos) + . Hg) + (,(rx bos "http" (? "s") "://" + (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/" + (+ (or alnum "-" "." "_")) (? "/"))) + eos) + . Bzr)) + "Heuristic mapping URL regular expressions to VC backends." + :type `(alist :key-type (regexp :tag "Regular expression matching URLs") + :value-type (choice :tag "VC Backend" + ,@(mapcar (lambda (b) `(const ,b)) + vc-handled-backends))) + :version "29.1") + +(defcustom package-vc-repository-store + (expand-file-name "emacs/vc-packages" (xdg-data-home)) + "Directory used by `package-vc-unpack' to store repositories." + :type 'directory + :version "29.1") + +(defun package-vc-commit (pkg) + "Extract the commit of a development package PKG." + (cl-assert (package-vc-p pkg)) + ;; 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 (package-vc-p pkg)) + (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-1 (pkg-desc pkg-dir) + "Install PKG-DESC that is already located in PKG-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 (file-name-as-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))) + + ;; 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))) + (vc-ignore "/dir")))) + + ;; 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))) + + ;; Mark package as selected + (package--save-selected-packages + (cons (package-desc-name pkg-desc) + package-selected-packages))) + +(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 pkg-desc) + (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"))) + (repo-dir + (if (null dir) + pkg-dir + (unless (file-exists-p package-vc-repository-store) + (make-directory package-vc-repository-store t)) + (file-name-concat + package-vc-repository-store + ;; FIXME: We aren't sure this directory + ;; will be unique, but we can try other + ;; names to avoid an unnecessary error. + (file-name-base repo))))) + + ;; Clone the repository into `repo-dir'. + (make-directory (file-name-directory repo-dir) t) + (unless (setf (car (alist-get :upstream attr)) + (vc-clone backend repo repo-dir)) + (error "Failed to clone %s from %s" name repo)) + + (unless (eq pkg-dir repo-dir) + ;; Link from the right position in `repo-dir' to the package + ;; directory in the ELPA store. + (make-symbolic-link (file-name-concat repo-dir dir) pkg-dir)) + (when-let ((default-directory repo-dir) + (rev (or (alist-get :rev attr) branch))) + (vc-retrieve-tag pkg-dir rev))) + + (package-vc-unpack-1 pkg-desc pkg-dir))) + +(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)) + (backend (alist-get url package-vc-heusitic-alist + nil nil #'string-match-p))) + (setf (alist-get :vc (package-desc-extras (cadr pkg))) + (list backend 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)) + (ret (with-demoted-errors "Error during package update: %S" + (vc-pull))) + (buf (cond + ((processp ret) (process-buffer ret)) + ((bufferp ret) ret)))) + (if buf + (with-current-buffer buf + (vc-run-delayed + (package-vc-unpack-1 pkg-desc default-directory))) + (package-vc-unpack-1 pkg-desc default-directory)))) + + +;;;###autoload +(defun package-vc-install (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-install) + +(defun package-vc-link-directory (dir name) + "Install the package NAME in DIR by linking it into the ELPA directory. +If invoked interactively with a prefix argument, the user will be +prompted for the package NAME. Otherwise it will be inferred +from the base name of DIR." + (interactive (let ((dir (read-directory-name "Directory: "))) + (list dir + (if current-prefix-arg + (read-string "Package name: ") + (file-name-base (directory-file-name dir)))))) + (unless (vc-responsible-backend dir) + (user-error "Directory %S is not under version control" dir)) + (package--archives-initialize) + (let* ((name (file-name-base (directory-file-name dir))) + (pkg-dir (expand-file-name name package-user-dir))) + (make-symbolic-link dir pkg-dir) + (package-vc-unpack-1 (package-desc-create + :name (intern name) + :kind 'vc) + pkg-dir))) + +(defun package-vc-refresh (pkg-desc) + "Refresh the installation for PKG-DESC." + (interactive (package-vc-read-pkg "Refresh package: ")) + (package-vc-unpack-1 pkg-desc (package-desc-dir pkg-desc))) + +(defun package-vc-read-pkg (prompt) + "Query for a source package description with PROMPT." + (cadr (assoc (completing-read + prompt + package-alist + (lambda (pkg) (package-vc-p (cadr pkg))) + t) + package-alist + #'string=))) + +;;;###autoload +(defun package-vc-prepare-patch (pkg subject revisions) + "Send a patch to the maintainer of a package PKG. +SUBJECT and REVISIONS are used passed on to `vc-prepare-patch'. +PKG must be a package description." + (interactive + (list (package-vc-read-pkg "Package to prepare a patch for: ") + (and (not vc-prepare-patches-separately) + (read-string "Subject: " "[PATCH] " nil nil t)) + (or (log-view-get-marked) + (vc-read-multiple-revisions "Revisions: ")))) + (vc-prepare-patch (package-maintainers pkg t) + subject revisions)) + +(provide 'package-vc) +;;; package-vc.el ends here diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index d619142d64c..92f15337671 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -146,6 +146,7 @@ (require 'cl-lib) (eval-when-compile (require 'subr-x)) (eval-when-compile (require 'epg)) ;For setf accessors. +(eval-when-compile (require 'inline)) ;For `define-inline' (require 'seq) (require 'tabulated-list) @@ -456,6 +457,11 @@ synchronously." (defvar package--default-summary "No description available.") +(define-inline package-vc-p (pkg-desc) + "Return non-nil if PKG-DESC is a source package." + (inline-letevals (pkg-desc) + (inline-quote (eq (package-desc-kind ,pkg-desc) 'vc)))) + (cl-defstruct (package-desc ;; Rename the default constructor from `make-package-desc'. (:constructor package-desc-create) @@ -468,14 +474,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 @@ -567,9 +577,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 (package-vc-p pkg-desc) + (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. @@ -600,6 +612,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)) @@ -648,6 +679,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. @@ -676,6 +709,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 @@ -691,6 +726,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 (package-vc-p pkg-desc) + (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))))) @@ -706,11 +745,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." @@ -874,14 +911,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. + (package-vc-p p1) + (package-vc-p p2) + ;; 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))) @@ -959,7 +1004,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))) @@ -1022,6 +1067,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)) @@ -1069,11 +1115,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))) @@ -2036,9 +2084,9 @@ 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) + (when (package-vc-p pkg-desc) (error "Can't install directory package from archive")) (let* ((location (package-archive-base pkg-desc)) (file (concat (package-desc-full-name pkg-desc) @@ -2176,17 +2224,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 (package-vc-p pkg-desc) + (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 @@ -2358,15 +2411,28 @@ installed), maybe you need to \\[package-refresh-contents]") pkg)) (declare-function comp-el-to-eln-filename "comp.c") -(defun package--delete-directory (dir) - "Delete DIR recursively. +(defvar package-vc-repository-store) +(defun package--delete-directory (dir pkg-desc) + "Delete PKG-DESC directory 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)) + (if (and (package-vc-p pkg-desc) + (require 'package-vc) ;load `package-vc-repository-store' + (file-in-directory-p dir package-vc-repository-store)) + (progn + (delete-directory + (expand-file-name + (car (file-name-split + (file-relative-name dir package-vc-repository-store))) + package-vc-repository-store) + t) + (delete-file (directory-file-name dir))) + (delete-directory dir t))) + (defun package-delete (pkg-desc &optional force nosave) "Delete package PKG-DESC. @@ -2420,7 +2486,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) - (package--delete-directory dir) + (package--delete-directory dir pkg-desc) ;; Remove NAME-VERSION.signed and NAME-readme.txt files. ;; ;; NAME-readme.txt files are no longer created, but they @@ -2631,7 +2697,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 @@ -2830,6 +2899,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) @@ -2920,6 +2997,8 @@ 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 + "b" #'package-report-bug "x" #'package-menu-execute "h" #'package-menu-quick-help "H" #'package-menu-hide-package @@ -3078,6 +3157,7 @@ of these dependencies, similar to the list returned by (signed (or (not package-list-unsigned) (package-desc-signed pkg-desc)))) (cond + ((package-vc-p pkg-desc) "source") ((eq dir 'builtin) "built-in") ((and lle (null held)) "disabled") ((stringp held) @@ -3166,8 +3246,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) + (package-vc-p installed))) filtered-by-priority)))))))) (defcustom package-hidden-regexps nil @@ -3369,6 +3450,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." @@ -3406,6 +3492,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) @@ -3417,9 +3504,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 (package-vc-p pkg) + (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) "") @@ -3494,7 +3586,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))) @@ -3850,6 +3942,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) @@ -4143,6 +4237,7 @@ packages." "held" "incompat" "installed" + "source" "new" "unsigned"))) package-menu-mode) @@ -4214,22 +4309,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." @@ -4411,11 +4506,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 @@ -4424,9 +4530,60 @@ 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)))) +(defun package-maintainers (pkg-desc &optional no-error) + "Return an email address for the maintainers of PKG-DESC. +The email address may contain commas, if there are multiple +maintainers. If no maintainers are found, an error will be +signalled. If the optional argument NO-ERROR is non-nil no error +will be signalled in that case." + (unless pkg-desc + (error "Invalid package description")) + (let* ((extras (package-desc-extras pkg-desc)) + (maint (alist-get :maintainer extras))) + (cond + ((and (null maint) (null no-error)) + (user-error "Package has no explicit maintainer")) + ((not (null maint)) + (with-temp-buffer + (package--print-email-button maint) + (string-trim (substring-no-properties (buffer-string)))))))) + +;; 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) + (let ((maint (package-maintainers desc)) + (name (package-desc-name desc)) + (subject (read-string "Subject: "))) + (compose-mail maint (format "[%s] %s" name subject)))) + +(defun package-report-bug (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-alist)) + package-menu-mode) + (let ((maint (package-maintainers desc)) + (name (symbol-name (package-desc-name desc))) + vars) + (dolist-with-progress-reporter (group custom-current-group-alist) + "Scanning for modified user options..." + (dolist (ent (get (cdr group) 'custom-group)) + (when (and (custom-variable-p (car ent)) + (boundp (car ent)) + (not (eq (custom--standard-value (car ent)) + (default-toplevel-value (car ent)))) + (file-in-directory-p (car group) (package-desc-dir desc))) + (push (car ent) vars)))) + (dlet ((reporter-prompt-for-summary-p t)) + (reporter-submit-bug-report maint name vars)))) + ;;;; Introspection (defun package-get-descriptor (pkg-name) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 6f77f995554..307c5fa500d 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -532,6 +532,9 @@ in the branch repository (or whose status not be determined)." (add-hook 'after-save-hook #'vc-bzr-resolve-when-done nil t) (vc-message-unresolved-conflicts buffer-file-name))) +(defun vc-bzr-clone (remote directory) + (vc-bzr-command nil 0 '() "branch" remote directory)) + (defun vc-bzr-version-dirstate (dir) "Try to return as a string the bzr revision ID of directory DIR. This uses the dirstate file's parent revision entry. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 3c6afec0378..d63d755a287 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1268,6 +1268,9 @@ This prompts for a branch to merge from." (add-hook 'after-save-hook #'vc-git-resolve-when-done nil 'local)) (vc-message-unresolved-conflicts buffer-file-name))) +(defun vc-git-clone (remote directory) + (vc-git--out-ok "clone" remote directory)) + ;;; HISTORY FUNCTIONS (autoload 'vc-setup-buffer "vc-dispatcher") diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 2eebe2d5434..ee54f34201c 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1250,6 +1250,8 @@ REV is the revision to check out into WORKFILE." (add-hook 'after-save-hook #'vc-hg-resolve-when-done nil t) (vc-message-unresolved-conflicts buffer-file-name))) +(defun vc-hg-clone (remote directory) + (vc-hg-command nil 0 '() "clone" remote directory)) ;; Modeled after the similar function in vc-bzr.el (defun vc-hg-revert (file &optional contents-done) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 9c2bdf66746..1aebf30c2a3 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -817,6 +817,9 @@ Set file properties accordingly. If FILENAME is non-nil, return its status." "info" "--show-item" "repos-root-url") (buffer-substring-no-properties (point-min) (1- (point-max)))))) +(defun vc-svn-clone (remote directory) + (vc-svn-command nil 0 '() "checkout" remote directory)) + (provide 'vc-svn) ;;; vc-svn.el ends here diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 781e7785e41..49bb7a27aad 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -584,6 +584,11 @@ ;; buffer should be inserted into an inline patch. If the two last ;; properties are omitted, `point-min' and `point-max' will ;; respectively be used instead. +;; +;; - clone (remote directory) +;; +;; Attempt to clone a REMOTE repository, into a local DIRECTORY. +;; Returns the symbol of the backend used if successful. ;;; Changes from the pre-25.1 API: ;; @@ -3510,6 +3515,27 @@ to provide the `find-revision' operation instead." (interactive) (vc-call-backend (vc-backend buffer-file-name) 'check-headers)) +(defun vc-clone (backend remote &optional directory) + "Use BACKEND to clone REMOTE into DIRECTORY. +If successful, returns the symbol of the backed used to clone. +If BACKEND is nil, iterate through every known backend in +`vc-handled-backends' until one succeeds." + (unless directory + (setq directory default-directory)) + (if backend + (progn + (unless (memq backend vc-handled-backends) + (error "Unknown VC backend %s" backend)) + (vc-call-backend backend 'clone remote directory) + backend) + (catch 'ok + (dolist (backend vc-handled-backends) + (ignore-error vc-not-supported + (when-let (res (vc-call-backend + backend 'clone + remote directory)) + (throw 'ok backend))))))) + ;; These things should probably be generally available |