: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.
(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.