From: Philip Kaludercic Date: Thu, 3 Nov 2022 18:26:21 +0000 (+0100) Subject: Add command 'package-vc-checkout' X-Git-Tag: emacs-29.0.90~1616^2~307^2~9 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ec01d9a2092319a90fd95e068af689bd24fc255d;p=emacs.git Add command 'package-vc-checkout' * doc/emacs/package.texi: Document feature. * etc/NEWS: Mention feature. * lisp/emacs-lisp/package-vc.el (package-vc-clone): Extract functionality out of 'package-vc-unpack'. (package-vc-unpack): Extract functionality out to 'package-vc-clone'. (package-vc-checkout): Add command. --- diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index db9705aaca6..bd6d91a785d 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -546,6 +546,7 @@ source. This often makes it easier to develop patches and report bugs. @findex package-vc-install +@findex package-vc-checkout 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, @@ -553,7 +554,9 @@ just like with a regular package. Packages installed this way behave just like any other package. You can update them using @code{package-update} or @code{package-update-all} and delete them again using @code{package-delete}. They are even displayed in the -regular package listing. +regular package listing. If you just wish to clone the source of a +package, without adding it to the package list, use +@code{package-vc-checkout}. @findex package-report-bug @findex package-vc-prepare-patch diff --git a/etc/NEWS b/etc/NEWS index cbde7afecb6..d808e7ab90b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1558,6 +1558,11 @@ repository. 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-checkout' +Used to fetch the source of a package by cloning a repository without +activating the package. + +++ *** New command 'package-vc-prepare-patch' This command allows you to send patches to package maintainers, for diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index 1dc62d83a98..dd23247974f 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -435,6 +435,34 @@ and return nil if no reasonable guess can be made." (and url (alist-get url package-vc-heuristic-alist nil nil #'string-match-p))) +(defun package-vc-clone (pkg-desc pkg-spec dir rev) + "Clone the source of a package into a directory DIR. +The package is described by a package descriptions PKG-DESC and a +package specification PKG-SPEC." + (pcase-let* ((name (package-desc-name pkg-desc)) + ((map :url :branch) pkg-spec)) + + ;; Clone the repository into `repo-dir' if necessary + (unless (file-exists-p dir) + (make-directory (file-name-directory dir) t) + (let ((backend (or (plist-get pkg-spec :vc-backend) + (package-vc-query-spec pkg-desc :vc-backend) + (package-vc-guess-backend url) + (plist-get (alist-get (package-desc-archive pkg-desc) + package-vc-archive-data-alist + nil nil #'string=) + :vc-backend) + package-vc-default-backend))) + (unless (vc-clone url backend dir + (or (and (not (eq rev :last-release)) rev) branch)) + (error "Failed to clone %s from %s" name url)))) + + ;; Check out the latest release if requested + (when (eq rev :last-release) + (if-let ((release-rev (package-vc-release-rev pkg-desc))) + (vc-retrieve-tag dir release-rev) + (message "No release revision was found, continuing..."))))) + (defun package-vc-unpack (pkg-desc pkg-spec &optional rev) "Install the package described by PKG-DESC. PKG-SPEC is a package specification is a property list describing @@ -442,52 +470,31 @@ how to fetch and build the package PKG-DESC. See `package-vc-archive-spec-alist' for details. The optional argument REV specifies a specific revision to checkout. This overrides the `:brach' attribute in PKG-SPEC." - (let* ((name (package-desc-name pkg-desc)) - (dirname (package-desc-full-name pkg-desc)) - (pkg-dir (expand-file-name dirname package-user-dir))) + (pcase-let* (((map :url :lisp-dir) pkg-spec) + (name (package-desc-name pkg-desc)) + (dirname (package-desc-full-name pkg-desc)) + (pkg-dir (expand-file-name dirname package-user-dir)) + (real-dir (if (null lisp-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 url))))) (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* (((map :url :branch :lisp-dir) pkg-spec) - (repo-dir - (if (null lisp-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 url))))) - - ;; Clone the repository into `repo-dir' if necessary - (unless (file-exists-p repo-dir) - (make-directory (file-name-directory repo-dir) t) - (let ((backend (or (plist-get pkg-spec :vc-backend) - (package-vc-query-spec pkg-desc :vc-backend) - (package-vc-guess-backend url) - (plist-get (alist-get (package-desc-archive pkg-desc) - package-vc-archive-data-alist - nil nil #'string=) - :vc-backend) - package-vc-default-backend))) - (unless (vc-clone url backend repo-dir - (or (and (not (eq rev :last-release)) rev) branch)) - (error "Failed to clone %s from %s" name url)))) - - ;; Check out the latest release if requested - (when (eq rev :last-release) - (if-let ((release-rev (package-vc-release-rev pkg-desc))) - (vc-retrieve-tag pkg-dir release-rev) - (message "No release revision was found, continuing..."))) - - (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 lisp-dir) pkg-dir))) + (package-vc-clone pkg-desc pkg-spec real-dir rev) + (unless (eq pkg-dir real-dir) + ;; Link from the right position in `repo-dir' to the package + ;; directory in the ELPA store. + (make-symbolic-link (file-name-concat real-dir lisp-dir) pkg-dir)) + (package-vc-unpack-1 pkg-desc pkg-dir))) (defun package-vc-sourced-packages-list () @@ -616,6 +623,36 @@ repository can be set by BACKEND. If missing, rev))) ((user-error "Unknown package to fetch: %s" name-or-url)))) +(defun package-vc-checkout (pkg-desc directory &optional rev) + "Clone the sources for PKG-DESC into DIRECTORY. +An explicit revision can be requested by passing a string to the +optional argument REV. If the command is invoked with a prefix +argument, the revision used for the last release in the package +archive is used. This can also be reproduced by passing the +special value `:last-release' as REV." + (interactive + (progn + ;; Initialize the package system to get the list of package + ;; symbols for completion. + (package-vc--archives-initialize) + (let* ((packages (package-vc-sourced-packages-list)) + (input (completing-read + "Fetch package source (name or URL): " packages))) + (list (cadr (assoc input package-archive-contents #'string=)) + (read-file-name "Clone into new or empty directory: " nil nil t nil + (lambda (dir) (or (not (file-exists-p dir)) + (directory-empty-p dir)))) + (and current-prefix-arg :last-release))))) + (package-vc--archives-initialize) + (let ((pkg-spec (or (package-vc-desc->spec pkg-desc) + (and-let* ((extras (package-desc-extras pkg-desc)) + (url (alist-get :url extras)) + (backend (package-vc-guess-backend url))) + (list :vc-backend backend :url url)) + (user-error "Package has no VC data")))) + (package-vc-clone pkg-desc pkg-spec directory rev) + (find-file directory))) + (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