chore(package-build): Obsolete package-build-expand-file-specs (#65)

jcs090218 · web-flow · commit b3a70d920373 · 2022-12-17T11:30:58.000+08:00
* chore(package-build): Obsolete package-build-expand-file-specs

* Allow error for files-spec

* Follow create tar

* update
diff --git a/lisp/_prepare.el b/lisp/_prepare.el
@@ -136,6 +136,11 @@ the `eask-start' execution.")
   (let ((len (if (numberp len-or-list) len-or-list (length len-or-list))))
     (if (= 1 len) form-1 form-2)))
 
+;; This is used to creating the directory recipe!
+(defun eask-current-time ()
+  "Return current time."
+  (let ((now (current-time))) (logior (lsh (car now) 16) (cadr now))))
+
 (defun eask-seq-str-max (sequence)
   "Return max length in list of strings."
   (let ((result 0))
@@ -1044,7 +1049,8 @@ Standard is, 0 (error), 1 (warning), 2 (info), 3 (log), 4 or above (debug)."
 (defun eask-expand-file-specs (specs)
   "Expand file SPECS."
   (mapcar (lambda (elm) (expand-file-name (car elm) default-directory))
-          (package-build-expand-file-specs default-directory specs nil t)))
+          (ignore-errors  ; The new files spec will trigger error, wrap it
+            (package-build-expand-files-spec nil nil default-directory specs))))
 
 (defun eask-package-files ()
   "Return package files in workspace."
diff --git a/lisp/core/package.el b/lisp/core/package.el
@@ -31,13 +31,16 @@
         (append eask-files (list eask-package-file)))
     package-build-default-files-spec))
 
-(defun eask-package-dir-recipe ()
+(defun eask-package-dir-recipe (version)
   "Form a directory recipe."
   (eask-load "extern/package-recipe")
-  (let ((name (eask-guess-package-name))
-        (patterns (eask-package-dir--patterns))
-        (path default-directory))
-    (package-directory-recipe name :name name :files patterns :dir path)))
+  (let* ((name (eask-guess-package-name))
+         (patterns (eask-package-dir--patterns))
+         (path default-directory)
+         (rcp (package-directory-recipe name :name name :files patterns :dir path)))
+    (setf (slot-value rcp 'version) version)
+    (setf (slot-value rcp 'time) (eask-current-time))
+    rcp))
 
 (defun eask-packaged-name ()
   "Find a possible packaged name."
@@ -66,12 +69,12 @@
     (eask-load "extern/package-build")  ; override
 
     (let* ((version (eask-package-version))
-           (rcp (eask-package-dir-recipe))
+           (rcp (eask-package-dir-recipe version))
            (package-build-working-dir default-directory)
            (package-build-archive-dir eask-dist-path))
       (eask-with-progress
         (format "Building artifact %s (%s)... " (eask-package-name) version)
-        (package-build--package rcp version)
+        (package-build--package rcp)
         "done ✓"))
 
     (setq packaged (eask-packaged-file)
diff --git a/lisp/extern/package-build.el b/lisp/extern/package-build.el
@@ -4,14 +4,16 @@
 
 (require 'package-build nil t)
 
-(defun package-build--create-tar (name version directory mtime)
-  "Create a tar file containing the contents of VERSION of package NAME.
+(defun package-build--create-tar (rcp directory)
+  "Create a tar file containing the package version specified by RCP.
 DIRECTORY is a temporary directory that contains the directory
-that is put in the tarball.  MTIME is used as the modification
-time of all files, making the tarball reproducible."
-  (let ((tar (expand-file-name (concat name "-" version ".tar")
-                               package-build-archive-dir))
-        (dir (concat name "-" version)))
+that is put in the tarball."
+  (let* ((name (oref rcp name))
+         (version (oref rcp version))
+         (time (oref rcp time))
+         (tar (expand-file-name (concat name "-" version ".tar")
+                                package-build-archive-dir))
+         (dir (concat name "-" version)))
     ;; XXX: https://github.com/melpa/package-build/pull/34
     ;;
     ;; We definitely need to remove these two lines, or else it won't able to
@@ -29,7 +31,7 @@ time of all files, making the tarball reproducible."
        ;; prevent a reproducable tarball as described at
        ;; https://reproducible-builds.org/docs/archives.
        "--sort=name"
-       (format "--mtime=@%d" mtime)
+       (format "--mtime=@%d" time)
        "--owner=0" "--group=0" "--numeric-owner"
        "--pax-option=exthdr.name=%d/PaxHeaders/%f,delete=atime,delete=ctime"))
     (when (and package-build-verbose noninteractive)
@@ -40,7 +42,7 @@ time of all files, making the tarball reproducible."
         (message "  %s" line)))))
 
 ;;
-;; NOTE: Following code are  brought in cuz it's very useful, but we don't want
+;; NOTE: Following code are brought in cuz it's very useful, but we don't want
 ;; to bring the whole `package-build' package unless it's needed.
 ;;
 
@@ -55,42 +57,49 @@ time of all files, making the tarball reproducible."
      "lisp/test.el" "lisp/tests.el" "lisp/*-test.el" "lisp/*-tests.el"))
   "Default value for :files attribute in recipes.")
 
-(defun package-build-expand-file-specs (dir specs &optional subdir allow-empty)
-  "In DIR, expand SPECS, optionally under SUBDIR.
-The result is a list of (SOURCE . DEST), where SOURCE is a source
-file path and DEST is the relative path to which it should be copied.
+(defun package-build-expand-files-spec (rcp &optional assert repo spec)
+  "No documentation."
+  (let ((default-directory (or repo (package-recipe--working-tree rcp)))
+        (spec (or spec (oref rcp files))))
+    (when (eq (car spec) :defaults)
+      (setq spec (append package-build-default-files-spec (cdr spec))))
+    (let ((files (package-build--expand-files-spec-1
+                  (or spec package-build-default-files-spec))))
+      (when assert
+        (when (and rcp spec
+                   (equal files (package-build--expand-files-spec-1
+                                 package-build-default-files-spec)))
+          (message "Warning: %s :files spec is equivalent to the default"
+                   (oref rcp name)))
+        (unless files
+          (error "No matching file(s) found in %s using %s"
+                 default-directory (or spec "default spec"))))
+      files)))
 
-If the resulting list is empty, an error will be reported.  Pass t
-for ALLOW-EMPTY to prevent this error."
-  (let ((default-directory dir)
-        (prefix (if subdir (format "%s/" subdir) ""))
-        (lst))
-    (dolist (entry specs)
-      (setq lst
-            (if (consp entry)
-                (if (eq :exclude (car entry))
-                    (cl-nset-difference lst
-                                        (package-build-expand-file-specs
-                                         dir (cdr entry) nil t)
-                                        :key #'car
-                                        :test #'equal)
-                  (nconc lst
-                         (package-build-expand-file-specs
-                          dir
-                          (cdr entry)
-                          (concat prefix (car entry))
-                          t)))
-              (nconc
-               lst (mapcar (lambda (f)
-                             (cons f
-                                   (concat prefix
-                                           (replace-regexp-in-string
-                                            "\\.el\\.in\\'"
-                                            ".el"
-                                            (file-name-nondirectory f)))))
-                           (file-expand-wildcards entry))))))
-    (when (and (null lst) (not allow-empty))
-      (error "No matching file(s) found in %s: %s" dir specs))
-    lst))
+(defun package-build--expand-files-spec-1 (spec &optional subdir)
+  (let ((files nil))
+    (dolist (entry spec)
+      (setq files
+            (cond
+             ((stringp entry)
+              (nconc files
+                     (mapcar (lambda (f)
+                               (cons f
+                                     (concat subdir
+                                             (replace-regexp-in-string
+                                              "\\.el\\.in\\'"  ".el"
+                                              (file-name-nondirectory f)))))
+                             (file-expand-wildcards entry))))
+             ((eq (car entry) :exclude)
+              (cl-nset-difference
+               files
+               (package-build--expand-files-spec-1 (cdr entry))
+               :key #'car :test #'equal))
+             (t
+              (nconc files
+                     (package-build--expand-files-spec-1
+                      (cdr entry)
+                      (concat subdir (car entry) "/")))))))
+    files))
 
 ;;; extern/package-build.el ends here
diff --git a/lisp/extern/package-recipe.el b/lisp/extern/package-recipe.el
@@ -14,7 +14,14 @@
 
 (cl-defmethod package-build--get-commit ((_rcp package-directory-recipe)))
 
+;; After https://github.com/melpa/package-build/commit/f032c806169b0fabbcac1eb44a4f1ae00674bfa8
 (cl-defmethod package-build--get-commit-time ((_rcp package-directory-recipe) _rev)
-  (let ((now (current-time))) (logior (lsh (car now) 16) (cadr now))))
+  (eask-current-time))
+
+;; After https://github.com/melpa/package-build/pull/67
+(cl-defmethod package-build--checkout ((rcp package-directory-recipe)))
+
+(cl-defmethod package-build--get-timestamp-version ((rcp package-directory-recipe))
+  (package-build--get-commit-time rcp nil))
 
 ;;; extern/package-recipe.el ends here
