emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

feature/package+vc f3e7820b48 2/2: Extract package-fetch and related fun


From: Philip Kaludercic
Subject: feature/package+vc f3e7820b48 2/2: Extract package-fetch and related functionality
Date: Sun, 31 Jul 2022 15:34:36 -0400 (EDT)

branch: feature/package+vc
commit f3e7820b480b4aa7a70f3ae6b2d775eba468a472
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    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
---
 lisp/emacs-lisp/package-vc.el | 216 +++++++++++++++++++++++++++++++++
 lisp/emacs-lisp/package.el    | 270 ++++++++++++------------------------------
 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 0000000000..f95c79ccf2
--- /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 858214611f..a582148640 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)
@@ -2234,61 +2173,6 @@ to install it but still mark it as selected."
           (message  "Package `%s' installed." name))
       (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."
@@ -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.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]