package-recipe-lookup: Always set url slot

melpa · Sep 22, 2024 · c292e78 · c292e78
1 parent 16dd770
commit c292e78
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 15 deletions.
diff --git a/package-build.el b/package-build.el
@@ -878,7 +878,7 @@ Use a sandbox if `package-build--use-sandbox' is non-nil."
 
 (cl-defmethod package-build--fetch ((rcp package-git-recipe))
   (let ((dir (package-recipe--working-tree rcp))
-        (url (package-recipe--upstream-url rcp))
+        (url (oref rcp url))
         (protocol (package-recipe--upstream-protocol rcp)))
     (cond
      ((eq package-build--inhibit-fetch 'strict))
@@ -908,7 +908,7 @@ Use a sandbox if `package-build--use-sandbox' is non-nil."
 
 (cl-defmethod package-build--fetch ((rcp package-hg-recipe))
   (let ((dir (package-recipe--working-tree rcp))
-        (url (package-recipe--upstream-url rcp)))
+        (url (oref rcp url)))
     (cond
      ((eq package-build--inhibit-fetch 'strict))
      ((and (file-exists-p (expand-file-name ".hg" dir))
@@ -1458,7 +1458,7 @@ are subsequently dumped."
     (make-directory package-build-archive-dir))
   (let* ((start-time (current-time))
          (rcp (package-recipe-lookup name))
-         (url (package-recipe--upstream-url rcp))
+         (url (oref rcp url))
          (repo (oref rcp repo))
          (fetcher (package-recipe--fetcher rcp))
          (version nil))
@@ -1687,7 +1687,7 @@ If optional PRETTY-PRINT is non-nil, then pretty-print
           (and-let* ((recipe (with-demoted-errors "Recipe error: %S"
                                (package-recipe-lookup name))))
             (push `(,symbol
-                    :url ,(package-recipe--upstream-url recipe)
+                    :url ,(oref recipe url)
                     ,@(and (cl-typep recipe 'package-hg-recipe)
                            (list :vc-backend 'Hg))
                     ,@(and-let* ((branch (oref recipe branch)))

diff --git a/package-recipe.el b/package-recipe.el
@@ -91,15 +91,11 @@
    (expand-file-name (oref rcp name) package-build-working-dir)))
 
 (cl-defmethod package-recipe--upstream-url ((rcp package-recipe))
-  (or (oref rcp url)
-      (format (oref rcp url-format)
-              (oref rcp repo))))
-
-(cl-defmethod package-recipe--upstream-url ((rcp package-git-remote-hg-recipe))
-  (concat "hg::" (oref rcp url)))
+  (oref rcp url))
+(make-obsolete 'package-recipe--upstream-url 'oref  "5.0.0")
 
 (cl-defmethod package-recipe--upstream-protocol ((rcp package-recipe))
-  (let ((url (package-recipe--upstream-url rcp)))
+  (let ((url (oref rcp url)))
     (cond ((string-match "\\`\\([a-z]+\\)://" url)
            (match-string 1 url))
           ((string-match "\\`[^:/ ]+:" url) "ssh")
@@ -137,17 +133,21 @@ file is invalid, then raise an error."
                          (read (current-buffer))))
                (plist (cdr recipe))
                (fetcher (plist-get plist :fetcher))
-               key val args)
+               key val args rcp)
           (package-recipe--validate recipe name)
           (while (setq key (pop plist))
             (setq val (pop plist))
             (unless (eq key :fetcher)
               (push val args)
               (push key args)))
           (when (and package-build-use-git-remote-hg (eq fetcher 'hg))
-            (setq fetcher 'git-remote-hg))
-          (apply (intern (format "package-%s-recipe" fetcher))
-                 name :name name args))
+            (setq fetcher 'git-remote-hg)
+            (setq args (plist-put args :url (concat "hg::" (oref rcp url)))))
+          (setq rcp (apply (intern (format "package-%s-recipe" fetcher))
+                           name :name name args))
+          (unless (oref rcp url)
+            (oset rcp url (format (oref rcp url-format) (oref rcp repo))))
+          rcp)
       (error "No such recipe: %s" name))))
 
 ;;; Validation