Merge pull request #1169 from radian-software/rr-support-melpa-rename

[#1167] Support MELPA :rename

Makefile

@@ -11,7 +11,7 @@ for_compile := straight.el bootstrap.el install.el straight-x.el	\
 for_checkdoc := straight.el
 for_longlines := $(wildcard *.el *.md *.yml benchmark/*.el	\
 	scripts/*.bash) Makefile
-for_checkindent := $(wildcard *.el benchmark/*.el)
+for_checkindent := $(wildcard *.el benchmark/*.el tests/*.el)
 
 # excludes benchmarking, smoke and unit tests
 .PHONY: all
@@ -62,6 +62,7 @@ checkindent: ## Ensure that indentation is correct
 	        --eval "(setq inhibit-message t)" \
 	        --eval "(load (expand-file-name \"indent.el\"  ) nil t)" \
 	        --eval "(load (expand-file-name \"straight.el\") nil t)" \
+		--eval "(load (expand-file-name \"tests/straight-test.el\") nil t)" \
 	        --eval "(find-file \"$$file\")" \
 	        --eval "(indent-region (point-min) (point-max))" \
 	        --eval "(write-file \"$$tmpdir/$$tmpfile\")"; \

straight.el

@@ -3277,17 +3277,22 @@ return nil."
                 (plist nil))
             (cl-destructuring-bind (name . melpa-plist) melpa-recipe
               (straight--put plist :type 'git)
-              (straight--put plist :flavor 'melpa)
               (when-let ((files (plist-get melpa-plist :files)))
                 ;; We must include a *-pkg.el entry in the recipe
                 ;; because that file always needs to be linked over,
                 ;; if it is present, but the `:files' directive might
                 ;; not include it (and doesn't need to, because MELPA
                 ;; always re-creates a *-pkg.el file regardless). See
                 ;; https://github.com/radian-software/straight.el/issues/336.
-                (straight--put
-                 plist :files
-                 (append files (list (format "%S-pkg.el" package)))))
+                (setq files (append files (list (format "%S-pkg.el" package))))
+                (setq files
+                      (mapcar
+                       (lambda (entry)
+                         (when (eq (car-safe entry) :rename)
+                           (setq entry (cons (nth 1 entry) (nth 2 entry))))
+                         entry)
+                       files))
+                (straight--put plist :files files))
               (when-let ((branch (plist-get melpa-plist :branch)))
                 (straight--put plist :branch branch))
               (pcase (plist-get melpa-plist :fetcher)
@@ -4942,16 +4947,20 @@ the MELPA recipe repository, with some minor differences:
   prefix created by enclosing lists is not respected.
 
 * Whenever a *.el.in file is linked in a MELPA recipe, the target
-  of the link is named as *.el.
+  of the link is named as *.el. (Only in older versions of MELPA.)
 
 * When using `:exclude' in a MELPA recipe, only links defined in
   the current list are subject to removal, and not links defined
   in higher-level lists.
 
-If FLAVOR is nil or omitted, then expansion takes place as
-described above. If FLAVOR is the symbol `melpa', then *.el.in
-files will be linked as *.el files as in MELPA. If FLAVOR is any
-other value, the behavior is not specified."
+* MELPA recipes support a `:rename' keyword that is not supported
+  here (because you can use cons cells to rename files).
+
+There is a legacy argument FLAVOR which is not recommended for
+use. If FLAVOR is the symbol `melpa', then for backwards
+compatibility reasons, *.el.in files will be linked as *.el
+files, which was the behavior on older versions of MELPA. If
+FLAVOR is any other non-nil value, the behavior is not specified."
   ;; We bind `default-directory' here so we don't have to do it
   ;; repeatedly in the recursive section.
   (let* ((default-directory src-dir)

tests/mocks/.emacs.d/straight/repos/melpa/recipes/bbdb

@@ -0,0 +1,4 @@
+(bbdb
+ :fetcher git
+ :url "https://git.savannah.nongnu.org/git/bbdb.git"
+ :files (:defaults (:rename "lisp/bbdb-site.el.in" "bbdb-site.el")))

tests/mocks/.emacs.d/straight/repos/melpa/recipes/ditz-mode

@@ -0,0 +1 @@
+(ditz-mode :fetcher hg :url "https://hg.sr.ht/~zondo/ditz-mode")

tests/mocks/.emacs.d/straight/repos/melpa/recipes/git-link

@@ -0,0 +1,3 @@
+(git-link
+ :fetcher github
+ :repo "sshaw/git-link")

tests/mocks/.emacs.d/straight/repos/melpa/recipes/gitlab

@@ -0,0 +1,4 @@
+(gitlab
+ :fetcher github
+ :repo "nlamirault/emacs-gitlab"
+ :files ("gitlab*.el"))

tests/straight-test.el

@@ -18,7 +18,7 @@ for BINDINGS."
         (list template)
       (let ((unbound (mod (length bindings) (length vars))))
         (unless (zerop unbound)
-          (error "Unven binding list: %S" (last bindings unbound)))
+          (error "Uneven binding list: %S" (last bindings unbound)))
         (let ((body nil)
               (bindings
                (eval
@@ -207,10 +207,10 @@ return nil."
 
 (straight-deftest straight--build-steps ()
   (let* ((defaults
-          (mapcar (lambda (sym)
-                    (intern (string-remove-prefix "straight-disable-"
-                                                  (symbol-name sym))))
-                  straight--build-default-steps))
+           (mapcar (lambda (sym)
+                     (intern (string-remove-prefix "straight-disable-"
+                                                   (symbol-name sym))))
+                   straight--build-default-steps))
          (straight-disable-info
           (member 'info           ,disabled))
          (straight-disable-compile
@@ -308,14 +308,14 @@ return nil."
 
 (straight-deftest straight--ensure-blank-lines ()
   (cl-flet ((buffer-with-point-at (s n)
-              (with-temp-buffer
-                (insert s)
-                (goto-char (point-min))
-                (when (search-forward "|" nil t)
-                  (delete-region (match-beginning 0)
-                                 (match-end 0)))
-                (straight--ensure-blank-lines n)
-                (buffer-string))))
+                                  (with-temp-buffer
+                                    (insert s)
+                                    (goto-char (point-min))
+                                    (when (search-forward "|" nil t)
+                                      (delete-region (match-beginning 0)
+                                                     (match-end 0)))
+                                    (straight--ensure-blank-lines n)
+                                    (buffer-string))))
     (should (equal ,buffer-string (buffer-with-point-at ,string ,n))))
   (string n buffer-string)
   "|beginning-of-buffer" 1 "beginning-of-buffer"
@@ -610,6 +610,27 @@ return nil."
                       (straight--watcher-file ,in)))))
   (in) "test.el")
 
+(straight-deftest straight-recipes-melpa-retrieve ()
+  (let ((straight-base-dir straight-test-mock-user-emacs-dir))
+    (let ((default-directory (straight--repos-dir "melpa")))
+      (should (equal (straight-recipes-melpa-retrieve ,in)
+                     ,out))))
+  (in out)
+  ;; package that isn't in our mocks
+  'doesnotexist nil
+  ;; package that uses :fetcher hg
+  'ditz-mode nil
+  ;; normal package
+  'git-link '(git-link :type git :host github :repo "sshaw/git-link")
+  ;; package with custom :files directive
+  'gitlab '(gitlab :type git :files ("gitlab*.el" "gitlab-pkg.el")
+                   :host github :repo "nlamirault/emacs-gitlab")
+  ;; package that uses :rename keyword
+  'bbdb '(bbdb :type git
+               :files (:defaults
+                       ("lisp/bbdb-site.el.in" . "bbdb-site.el") "bbdb-pkg.el")
+               :repo "https://git.savannah.nongnu.org/git/bbdb.git"))
+
 (provide 'straight-test)
 
 ;; Local Variables: