From: Philip Kaludercic <philipk@posteo.net>
Date: Sun, 31 Jul 2022 12:27:28 +0000 (+0200)
Subject: Merge remote-tracking branch 'origin/master' into feature/package+vc
X-Git-Tag: emacs-29.0.90~1616^2~307^2~106
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=118033294136a8fb3a14347ce190b447dd2ff2fe;p=emacs.git

Merge remote-tracking branch 'origin/master' into feature/package+vc
---

118033294136a8fb3a14347ce190b447dd2ff2fe
diff --cc lisp/emacs-lisp/package.el
index 58fc55da124,df70f908daf..858214611f6
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@@ -301,19 -301,9 +301,20 @@@ packages in `package-directory-list'.
    :type 'directory
    :initialize #'custom-initialize-delay
    :risky t
+   :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.
@@@ -2206,61 -2160,61 +2234,116 @@@ to install it but still mark it as sele
            (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."
+   (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)))
+ 
+ (defun package--updateable-packages ()
+   ;; Initialize the package system to get the list of package
+   ;; symbols for completion.
+   (package--archives-initialize)
+   (mapcar
+    #'car
+    (seq-filter
+     (lambda (elt)
+       (let ((available
+              (assq (car elt) package-archive-contents)))
+         (and available
+              (version-list-<
+               (package-desc-priority-version (cadr elt))
+               (package-desc-priority-version (cadr available))))))
+     package-alist)))
+ 
+ ;;;###autoload
+ (defun package-update-all (&optional query)
+   "Refresh package list and upgrade all packages.
+ If QUERY, ask the user before updating packages.  When called
+ interactively, QUERY is always true."
+   (interactive (list (not noninteractive)))
+   (package-refresh-contents)
+   (let ((updateable (package--updateable-packages)))
+     (if (not updateable)
+         (message "No packages to update")
+       (when (and query
+                  (not (yes-or-no-p
+                        (if (length= updateable 1)
+                            "One package to update.  Do it? "
+                          (format "%s packages to update.  Do it?"
+                                  (length updateable))))))
+         (user-error "Updating aborted"))
+       (mapc #'package-update updateable))))
+ 
+ (defun package--dependencies (pkg)
+   "Return a list of all dependencies PKG has.
+ This is done recursively."
+   ;; Can we have circular dependencies?  Assume "nope".
+   (when-let* ((desc (cadr (assq pkg package-archive-contents)))
+               (deps (mapcar #'car (package-desc-reqs desc))))
+     (delete-dups (apply #'nconc deps (mapcar #'package--dependencies deps)))))
+ 
  (defun package-strip-rcs-id (str)
    "Strip RCS version ID from the version string STR.
  If the result looks like a dotted numeric version, return it.