summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilip Kaludercic <philipk@posteo.net>2022-07-31 21:32:38 +0200
committerPhilip Kaludercic <philipk@posteo.net>2022-07-31 21:32:38 +0200
commitf3e7820b480b4aa7a70f3ae6b2d775eba468a472 (patch)
tree5767c984066e8e616b87a62826855016cb84819d
parent118033294136a8fb3a14347ce190b447dd2ff2fe (diff)
downloademacs-f3e7820b.tar.gz
Extract package-fetch and related functionality
Note that the "package kind" was renamed from "source" to "vc". * package-vc.el: (package-vc-commit): Copy from package.el (package-vc-version): Add new function (package-vc-generate-description-file): Add new function. (package-vc-unpack): Add new function. (package-vc-fetch): Copy from package.el (package-checkout): Add alias for package-vc-fetch * package.el (package-devel-dir): Remove option. The checkouts are stored in package-user-dir (package-desc): Handle (vc . VERS) version strings (package-desc-full-name): Return the plain name for vc packages (package-devel-commit): Move function to package-vc (package-load-descriptor): Refactor according to other changes (package-load-all-descriptors): Remove package-devel-dir (package-unpack): Remove vc package handling (package-generate-description-file): Remove special handling for vc packages (package-install-from-archive): Remove special handling for vc packages (package-fetch): Move function to package-vc (package-desc-status): Use "vc" instead of "source" (package--remove-hidden): Use "vc" instead of "source" (package-menu--print-info-simple): Refactor according to other changes
-rw-r--r--lisp/emacs-lisp/package-vc.el216
-rw-r--r--lisp/emacs-lisp/package.el270
2 files changed, 294 insertions, 192 deletions
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
new file mode 100644
index 00000000000..f95c79ccf2e
--- /dev/null
+++ b/lisp/emacs-lisp/package-vc.el
@@ -0,0 +1,216 @@
+;;; 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.
+
+;;; Code:
+
+(require 'package)
+(require 'lisp-mnt)
+(require 'vc)
+
+(defgroup package-vc nil
+ "Manage packages from VC checkouts."
+ :group 'package
+ :version "29.1")
+
+(declare-function vc-clone "vc" (backend remote &optional directory))
+
+(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?")
+ (delete-directory pkg-dir t)
+ (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)))))
+
+ (package-vc-generate-description-file
+ pkg-desc (file-name-concat pkg-dir (package--description-file pkg-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)))))
+
+(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* ((input (completing-read
+ "Fetch package source (name or URL): "
+ package-archive-contents))
+ (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=)))
+ (spec (or (alist-get :vc (package-desc-extras desc))
+ (user-error "Package has no VC header"))))
+ (unless (string-match
+ (rx bos
+ (group (+ alnum))
+ (+ blank) (group (+ (not blank)))
+ (? (+ blank) (group (+ (not blank)))
+ (? (+ blank) (group (+ (not blank)))))
+ eos)
+ spec)
+ (user-error "Invalid repository specification %S" spec))
+ (package-desc-create
+ :name (if (stringp name-or-url)
+ (intern name-or-url)
+ name-or-url)
+ :kind 'vc
+ :extras `((:upstream . ,(list (intern (match-string 1 spec))
+ (match-string 2 spec)
+ (match-string 3 spec)
+ (match-string 4 spec)))
+ (: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 858214611f6..a5821486405 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -304,17 +304,6 @@ packages in `package-directory-list'."
:group 'applications
:version "24.1")
-(defcustom package-devel-dir (expand-file-name "devel" package-user-dir)
- "Directory containing the user's Emacs Lisp package checkouts.
-The directory name should be absolute.
-Apart from this directory, Emacs also looks for system-wide
-packages in `package-directory-list'."
- :type 'directory
- :initialize #'custom-initialize-delay
- :set-after '(package-user-dir)
- :risky t
- :version "29.1")
-
;;;###autoload
(defcustom package-directory-list
;; Defaults are subdirs named "elpa" in the site-lisp dirs.
@@ -472,14 +461,18 @@ synchronously."
&rest rest-plist
&aux
(name (intern name-string))
- (version (and version-string (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
@@ -571,10 +564,10 @@ 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)
- (if (eq (package-desc-kind pkg-desc) 'source)
- "devel"
+ (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)
@@ -654,6 +647,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.
@@ -682,15 +677,7 @@ are sorted with the highest version first."
nil)))
new-pkg-desc)))
-(declare-function vc-working-revision "vc" (file &optional backend))
-(defun package-devel-commit (pkg)
- "Extract the commit of a development package PKG."
- (cl-assert (eq (package-desc-kind pkg) 'source))
- (require 'vc)
- (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"))
+(declare-function package-vc-commit "package-vc" (pkg))
(defun package-load-descriptor (pkg-dir)
"Load the package description file in directory PKG-DIR.
@@ -707,13 +694,9 @@ return it."
(read (current-buffer)))
(error "Can't find define-package in %s" pkg-file))))
(setf (package-desc-dir pkg-desc) pkg-dir)
- (when (file-exists-p (expand-file-name
- (symbol-name (package-desc-name pkg-desc))
- package-devel-dir))
- ;; XXX: This check seems dirty, there should be a better
- ;; way to deduce if a package is in the devel directory.
- (setf (package-desc-kind pkg-desc) 'source)
- (push (cons :commit (package-devel-commit pkg-desc))
+ (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))
@@ -728,9 +711,7 @@ controls which package subdirectories may be loaded.
In each valid package subdirectory, this function loads the
description file containing a call to `define-package', which
updates `package-alist'."
- (dolist (dir (cl-list* package-user-dir
- package-devel-dir
- package-directory-list))
+ (dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
(dolist (pkg-dir (directory-files dir t "^[^.]" t))
(when (file-directory-p pkg-dir)
@@ -964,51 +945,12 @@ untar into a directory named DIR; otherwise, signal an error."
(apply #'nconc
(mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
-(declare-function vc-clone "vc" (backend remote &optional directory))
-
(defun package-unpack (pkg-desc)
"Install the contents of the current buffer as a package."
(let* ((name (package-desc-name pkg-desc))
(dirname (package-desc-full-name pkg-desc))
(pkg-dir (expand-file-name dirname package-user-dir)))
(pcase (package-desc-kind pkg-desc)
- ('source
- (setq pkg-dir (expand-file-name (symbol-name name) package-devel-dir))
- (when (file-exists-p pkg-dir)
- (if (and (called-interactively-p 'interactive)
- (yes-or-no-p "Overwrite previous checkout?"))
- (delete-directory pkg-dir t)
- (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"))))
- (require 'vc)
- (make-directory (file-name-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))))))
('dir
(make-directory pkg-dir t)
(let ((file-list
@@ -1035,9 +977,8 @@ untar into a directory named DIR; otherwise, signal an error."
(package--make-autoloads-and-stuff pkg-desc pkg-dir)
;; Update package-alist.
(let ((new-desc (package-load-descriptor pkg-dir)))
- (unless (or (equal (package-desc-full-name new-desc)
- (package-desc-full-name pkg-desc))
- (eq (package-desc-kind pkg-desc) 'source))
+ (unless (equal (package-desc-full-name new-desc)
+ (package-desc-full-name pkg-desc))
(error "The retrieved package (`%s') doesn't match what the archive offered (`%s')"
(package-desc-full-name new-desc) (package-desc-full-name pkg-desc)))
;; Activation has to be done before compilation, so that if we're
@@ -1071,8 +1012,7 @@ untar into a directory named DIR; otherwise, signal an error."
(nconc
(list 'define-package
(symbol-name name)
- (and (not (eq (package-desc-kind pkg-desc) 'source))
- (package-version-join (package-desc-version pkg-desc)))
+ (package-version-join (package-desc-version pkg-desc))
(package-desc-summary pkg-desc)
(let ((requires (package-desc-reqs pkg-desc)))
(list 'quote
@@ -1087,6 +1027,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))
@@ -2099,48 +2040,46 @@ if all the in-between dependencies are also in PACKAGE-LIST."
;; 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"))
- (if (eq (package-desc-kind pkg-desc) 'source)
- (package-unpack pkg-desc)
- (let* ((location (package-archive-base pkg-desc))
- (file (concat (package-desc-full-name pkg-desc)
- (package-desc-suffix pkg-desc))))
- (package--with-response-buffer location :file file
- (if (or (not (package-check-signature))
- (member (package-desc-archive pkg-desc)
- package-unsigned-archives))
- ;; If we don't care about the signature, unpack and we're
- ;; done.
- (let ((save-silently t))
- (package-unpack pkg-desc))
- ;; If we care, check it and *then* write the file.
- (let ((content (buffer-string)))
- (package--check-signature
- location file content nil
- ;; This function will be called after signature checking.
- (lambda (&optional good-sigs)
- ;; Signature checked, unpack now.
- (with-temp-buffer ;FIXME: Just use the previous current-buffer.
- (set-buffer-multibyte nil)
- (cl-assert (not (multibyte-string-p content)))
- (insert content)
- (let ((save-silently t))
- (package-unpack pkg-desc)))
- ;; Here the package has been installed successfully, mark it as
- ;; signed if appropriate.
- (when good-sigs
- ;; Write out good signatures into NAME-VERSION.signed file.
- (write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
- nil
- (expand-file-name
- (concat (package-desc-full-name pkg-desc) ".signed")
- package-user-dir)
- nil 'silent)
- ;; Update the old pkg-desc which will be shown on the description buffer.
- (setf (package-desc-signed pkg-desc) t)
- ;; Update the new (activated) pkg-desc as well.
- (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc)
- package-alist))))
- (setf (package-desc-signed (car pkg-descs)) t)))))))))))
+ (let* ((location (package-archive-base pkg-desc))
+ (file (concat (package-desc-full-name pkg-desc)
+ (package-desc-suffix pkg-desc))))
+ (package--with-response-buffer location :file file
+ (if (or (not (package-check-signature))
+ (member (package-desc-archive pkg-desc)
+ package-unsigned-archives))
+ ;; If we don't care about the signature, unpack and we're
+ ;; done.
+ (let ((save-silently t))
+ (package-unpack pkg-desc))
+ ;; If we care, check it and *then* write the file.
+ (let ((content (buffer-string)))
+ (package--check-signature
+ location file content nil
+ ;; This function will be called after signature checking.
+ (lambda (&optional good-sigs)
+ ;; Signature checked, unpack now.
+ (with-temp-buffer ;FIXME: Just use the previous current-buffer.
+ (set-buffer-multibyte nil)
+ (cl-assert (not (multibyte-string-p content)))
+ (insert content)
+ (let ((save-silently t))
+ (package-unpack pkg-desc)))
+ ;; Here the package has been installed successfully, mark it as
+ ;; signed if appropriate.
+ (when good-sigs
+ ;; Write out good signatures into NAME-VERSION.signed file.
+ (write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
+ nil
+ (expand-file-name
+ (concat (package-desc-full-name pkg-desc) ".signed")
+ package-user-dir)
+ nil 'silent)
+ ;; Update the old pkg-desc which will be shown on the description buffer.
+ (setf (package-desc-signed pkg-desc) t)
+ ;; Update the new (activated) pkg-desc as well.
+ (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc)
+ package-alist))))
+ (setf (package-desc-signed (car pkg-descs)) t))))))))))
;;;###autoload
(defun package-installed-p (package &optional min-version)
@@ -2235,61 +2174,6 @@ to install it but still mark it as selected."
(message "`%s' is already installed" name))))
;;;###autoload
-(defun package-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* ((input (completing-read
- "Fetch package source (name or URL): "
- package-archive-contents))
- (name (file-name-base input)))
- (list input (intern (string-remove-prefix "emacs-" name))))))
- (package--archives-initialize)
- (package-install
- (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 'source
- :extras `((:upstream . ,(list nil name-or-url nil nil))
- (:rev . ,rev))))
- ((when-let* ((desc (cadr (assoc name-or-url package-archive-contents
- #'string=)))
- (spec (or (alist-get :vc (package-desc-extras desc))
- (user-error "Package has no VC header"))))
- (unless (string-match
- (rx bos
- (group (+ alnum))
- (+ blank) (group (+ (not blank)))
- (? (+ blank) (group (+ (not blank)))
- (? (+ blank) (group (+ (not blank)))))
- eos)
- spec)
- (user-error "Invalid repository specification %S" spec))
- (package-desc-create
- :name (if (stringp name-or-url)
- (intern name-or-url)
- name-or-url)
- :kind 'source
- :extras `((:upstream . ,(list (intern (match-string 1 spec))
- (match-string 2 spec)
- (match-string 3 spec)
- (match-string 4 spec)))
- (:rev . ,rev)))))
- ((user-error "Unknown package to fetch: %s" name-or-url)))))
-
-;;;###autoload
(defun package-update (name)
"Update package NAME if a newer version exists."
(interactive
@@ -3188,7 +3072,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) 'source) "source")
+ ((eq (package-desc-kind pkg-desc) 'vc) "source")
((eq dir 'builtin) "built-in")
((and lle (null held)) "disabled")
((stringp held)
@@ -3279,7 +3163,7 @@ to their archives."
(let ((ins-version (package-desc-version installed)))
(cl-remove-if (lambda (p) (or (version-list-= (package-desc-version p)
ins-version)
- (eq (package-desc-kind installed) 'source)))
+ (eq (package-desc-kind installed) 'vc)))
filtered-by-priority))))))))
(defcustom package-hidden-regexps nil
@@ -3536,8 +3420,10 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
package-desc ,pkg
action package-menu-describe-package)
,(propertize
- (if (eq (package-desc-kind pkg) 'source)
- (package-devel-commit pkg)
+ (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)
@@ -4334,22 +4220,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."
@@ -4555,7 +4441,7 @@ DESC must be a `package-desc' object."
(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.