[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
emacs-29 022ab1061b2 4/5: Ensure 'package-vc--main-file' always returns
From: |
Philip Kaludercic |
Subject: |
emacs-29 022ab1061b2 4/5: Ensure 'package-vc--main-file' always returns an existing file |
Date: |
Sat, 10 Dec 2022 04:00:47 -0500 (EST) |
branch: emacs-29
commit 022ab1061b2a5ffebcc1a000386c1a568ac06e2f
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>
Ensure 'package-vc--main-file' always returns an existing file
* lisp/emacs-lisp/package-vc.el (require): Explicitly require cl-lib.
(package-vc--main-file): If the expected file name is missing, try and
find the closest match.
---
lisp/emacs-lisp/package-vc.el | 38 +++++++++++++++++++++++++++++---------
1 file changed, 29 insertions(+), 9 deletions(-)
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index cf9b98308f1..b514afe288e 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -50,6 +50,7 @@
(eval-when-compile (require 'rx))
(eval-when-compile (require 'inline))
(eval-when-compile (require 'map))
+(eval-when-compile (require 'cl-lib))
(require 'package)
(require 'lisp-mnt)
(require 'vc)
@@ -299,15 +300,34 @@ asynchronously."
(defun package-vc--main-file (pkg-desc)
"Return the name of the main file for PKG-DESC."
(cl-assert (package-vc-p pkg-desc))
- (let ((pkg-spec (package-vc--desc->spec pkg-desc))
- (name (symbol-name (package-desc-name pkg-desc))))
- (or (plist-get pkg-spec :main-file)
- (expand-file-name
- (concat name ".el")
- (file-name-concat
- (or (package-desc-dir pkg-desc)
- (expand-file-name name package-user-dir))
- (plist-get pkg-spec :lisp-dir))))))
+ (let* ((pkg-spec (package-vc--desc->spec pkg-desc))
+ (name (symbol-name (package-desc-name pkg-desc)))
+ (directory (file-name-concat
+ (or (package-desc-dir pkg-desc)
+ (expand-file-name name package-user-dir))
+ (plist-get pkg-spec :lisp-dir)))
+ (file (or (plist-get pkg-spec :main-file)
+ (expand-file-name
+ (concat name ".el")
+ directory))))
+ (if (file-exists-p file) file
+ ;; The following heuristic is only necessary when fetching a
+ ;; repository with URL that would break the above assumptions.
+ ;; Concrete example: https://github.com/sachac/waveform-el does
+ ;; not have a file waveform-el.el, but a file waveform.el, so we
+ ;; try and find the closest match.
+ (let ((distance most-positive-fixnum) (best nil))
+ (dolist (alt (directory-files directory t "\\.el\\'" t))
+ (let ((sd (string-distance file alt)))
+ (when (and (not (string-match-p (rx (or (: "-autoloads.el")
+ (: "-pkg.el"))
+ eos)
+ alt))
+ (< sd distance))
+ (when (< sd distance)
+ (setq distance (string-distance file alt)
+ best alt)))))
+ best))))
(defun package-vc--generate-description-file (pkg-desc pkg-file)
"Generate a package description file for PKG-DESC and write it to PKG-FILE."