procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Handle missing dependencies for source packages

Browse source 
* lisp/emacs-lisp/package-vc.el (package-vc-install-dependencies): Add
new function.
(package-vc--unpack-1): Call 'package-vc-install-dependencies' instead
of 'package-compute-transaction' and 'package-download-transaction'.

It is unreasonable to abort the installation, since we cannot expect
all dependencies to be available in the regular archives.  Instead we
note which packages couldn't be found, and warn the user that these
will be missing.
This commit is contained in:
Philip Kaludercic 2022-12-25 09:35:36 +01:00
parent 7bc7b6b4dd
commit b38e56d8a9
1 changed files with 137 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

217
lisp/emacs-lisp/package-vc.el
View file

@ -406,99 +406,156 @@ otherwise it's assumed to be an Info file."
(when clean-up (when clean-up
(delete-file file)))) (delete-file file))))
(defun package-vc-install-dependencies (requirements)
"Install missing dependencies, and return missing ones.
The return value will be nil if everything was found, or a list
of (NAME VERSION) pairs of all packages that couldn't be found.
REQUIREMENTS should be a list of additional requirements; each
element in this list should have the form (PACKAGE VERSION-LIST),
where PACKAGE is a package name and VERSION-LIST is the required
version of that package."
(let ((to-install '()) (missing '()))
(cl-labels ((search (pkg)
"Attempt to find all dependencies for PKG."
(cond
((assq (car pkg) to-install)) ;inhibit cycles
((package-installed-p (car pkg)))
((let* ((pac package-archive-contents)
(desc (cadr (assoc (car pkg) pac))))
(if desc
(let ((reqs (package-desc-reqs pkg)))
(push pkg to-install)
(mapc #'search reqs))
(push pkg missing))))))
(version-order (a b)
"Predicate to sort packages in order."
(version-list-< (cadr b) (cadr a)))
(duplicate-p (a b)
"Are A and B the same package?"
(eq (car a) (car b)))
(depends-on-p (target package)
"Does PACKAGE depend on TARGET?"
(or (eq target package)
(let* ((pac package-archive-contents)
(desc (cadr (assoc package pac))))
(seq-some
(apply-partially #'depends-on-p target)
(package-desc-reqs desc)))))
(dependent-order (a b)
(or (not (depends-on-p (car b) (car a)))
(depends-on-p (car a) (car b)))))
(mapc #'search requirements)
(cl-callf sort to-install #'version-order)
(cl-callf seq-uniq to-install #'duplicate-p)
(cl-callf sort to-install #'dependent-order))
(mapc #'package-install-from-archive to-install)
missing))
(defun package-vc--unpack-1 (pkg-desc pkg-dir) (defun package-vc--unpack-1 (pkg-desc pkg-dir)
"Prepare PKG-DESC that is already checked-out in PKG-DIR. "Prepare PKG-DESC that is already checked-out in PKG-DIR.
This includes downloading missing dependencies, generating This includes downloading missing dependencies, generating
autoloads, generating a package description file (used to autoloads, generating a package description file (used to
identify a package as a VC package later on), building identify a package as a VC package later on), building
documentation and marking the package as installed." documentation and marking the package as installed."
;; Remove any previous instance of PKG-DESC from `package-alist' (let (missing)
(let ((pkgs (assq (package-desc-name pkg-desc) package-alist))) ;; Remove any previous instance of PKG-DESC from `package-alist'
(when pkgs (let ((pkgs (assq (package-desc-name pkg-desc) package-alist)))
(setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs))))) (when pkgs
(setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs)))))
;; In case the package was installed directly from source, the ;; In case the package was installed directly from source, the
;; dependency list wasn't know beforehand, and they might have ;; dependency list wasn't know beforehand, and they might have
;; to be installed explicitly. ;; to be installed explicitly.
(let ((deps '())) (let ((deps '()))
(dolist (file (directory-files pkg-dir t "\\.el\\'" t)) (dolist (file (directory-files pkg-dir t "\\.el\\'" t))
(with-temp-buffer (with-temp-buffer
(insert-file-contents file) (insert-file-contents file)
(when-let* ((require-lines (lm-header-multiline "package-requires"))) (when-let* ((require-lines (lm-header-multiline "package-requires")))
(thread-last (thread-last
(mapconcat #'identity require-lines " ") (mapconcat #'identity require-lines " ")
package-read-from-string package-read-from-string
package--prepare-dependencies package--prepare-dependencies
(nconc deps) (nconc deps)
(setq deps))))) (setq deps)))))
(dolist (dep deps) (dolist (dep deps)
(cl-callf version-to-list (cadr dep))) (cl-callf version-to-list (cadr dep)))
(package-download-transaction (setf missing (package-vc-install-dependencies (delete-dups deps)))
(package-compute-transaction nil (delete-dups deps)))) (setf missing (delq (assq (package-desc-name pkg-desc)
missing)
missing)))
(let ((default-directory (file-name-as-directory pkg-dir)) (let ((default-directory (file-name-as-directory pkg-dir))
(pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir)))
;; Generate autoloads ;; Generate autoloads
(let* ((name (package-desc-name pkg-desc)) (let* ((name (package-desc-name pkg-desc))
(auto-name (format "%s-autoloads.el" name)) (auto-name (format "%s-autoloads.el" name))
(extras (package-desc-extras pkg-desc)) (extras (package-desc-extras pkg-desc))
(lisp-dir (alist-get :lisp-dir extras))) (lisp-dir (alist-get :lisp-dir extras)))
(package-generate-autoloads (package-generate-autoloads
name (file-name-concat pkg-dir lisp-dir)) name (file-name-concat pkg-dir lisp-dir))
(when lisp-dir (when lisp-dir
(write-region (write-region
(with-temp-buffer (with-temp-buffer
(insert ";; Autoload indirection for package-vc\n\n") (insert ";; Autoload indirection for package-vc\n\n")
(prin1 `(load (expand-file-name (prin1 `(load (expand-file-name
,(file-name-concat lisp-dir auto-name) ,(file-name-concat lisp-dir auto-name)
(or (and load-file-name (or (and load-file-name
(file-name-directory load-file-name)) (file-name-directory load-file-name))
(car load-path)))) (car load-path))))
(current-buffer)) (current-buffer))
(buffer-string)) (buffer-string))
nil (expand-file-name auto-name pkg-dir)))) nil (expand-file-name auto-name pkg-dir))))
;; Generate package file ;; Generate package file
(package-vc--generate-description-file pkg-desc pkg-file) (package-vc--generate-description-file pkg-desc pkg-file)
;; Detect a manual ;; Detect a manual
(when-let ((pkg-spec (package-vc--desc->spec pkg-desc)) (when-let ((pkg-spec (package-vc--desc->spec pkg-desc))
((executable-find "install-info"))) ((executable-find "install-info")))
(dolist (doc-file (ensure-list (plist-get pkg-spec :doc))) (dolist (doc-file (ensure-list (plist-get pkg-spec :doc)))
(package-vc--build-documentation pkg-desc doc-file)))) (package-vc--build-documentation pkg-desc doc-file))))
;; Update package-alist. ;; Update package-alist.
(let ((new-desc (package-load-descriptor pkg-dir))) (let ((new-desc (package-load-descriptor pkg-dir)))
;; Activation has to be done before compilation, so that if we're ;; Activation has to be done before compilation, so that if we're
;; upgrading and macros have changed we load the new definitions ;; upgrading and macros have changed we load the new definitions
;; before compiling. ;; before compiling.
(when (package-activate-1 new-desc :reload :deps) (when (package-activate-1 new-desc :reload :deps)
;; FIXME: Compilation should be done as a separate, optional, step. ;; FIXME: Compilation should be done as a separate, optional, step.
;; E.g. for multi-package installs, we should first install all packages ;; E.g. for multi-package installs, we should first install all packages
;; and then compile them. ;; and then compile them.
(package--compile new-desc) (package--compile new-desc)
(when package-native-compile (when package-native-compile
(package--native-compile-async new-desc)) (package--native-compile-async new-desc))
;; After compilation, load again any files loaded by ;; After compilation, load again any files loaded by
;; `activate-1', so that we use the byte-compiled definitions. ;; `activate-1', so that we use the byte-compiled definitions.
(package--reload-previously-loaded new-desc))) (package--reload-previously-loaded new-desc)))
;; Mark package as selected ;; Mark package as selected
(package--save-selected-packages (package--save-selected-packages
(cons (package-desc-name pkg-desc) (cons (package-desc-name pkg-desc)
package-selected-packages)) package-selected-packages))
(package--quickstart-maybe-refresh) (package--quickstart-maybe-refresh)
;; Confirm that the installation was successful ;; Confirm that the installation was successful
(let ((main-file (package-vc--main-file pkg-desc))) (let ((main-file (package-vc--main-file pkg-desc)))
(message "VC package `%s' installed (Version %s, Revision %S)." (message "VC package `%s' installed (Version %s, Revision %S).%s"
(package-desc-name pkg-desc) (package-desc-name pkg-desc)
(lm-with-file main-file (lm-with-file main-file
(package-strip-rcs-id (package-strip-rcs-id
(or (lm-header "package-version") (or (lm-header "package-version")
(lm-header "version")))) (lm-header "version"))))
(vc-working-revision main-file))) (vc-working-revision main-file)
t) (if missing
(format
" Failed to install the following dependencies: %s"
(mapconcat
(lambda (p)
(format "%s (%s)" (car p) (cadr p)))
missing ", "))
"")))
t))
(defun package-vc--guess-backend (url) (defun package-vc--guess-backend (url)
"Guess the VC backend for URL. "Guess the VC backend for URL.