[bot] "built_in_updates" Thu Dec 22 07:42:58 UTC 2022
This commit is contained in:
SpacemacsBot
Maxi Wolff
parent
3afc9afa4c
commit
f1c7979b63
|
|
@ -12,7 +12,7 @@
|
|||
;; Homepage: https://github.com/melpa/package-build
|
||||
;; Keywords: maint tools
|
||||
|
||||
;; Package-Version: 3.2.50-git
|
||||
;; Package-Version: 4.0.0.50-git
|
||||
;; Package-Requires: ((emacs "25.1"))
|
||||
|
||||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||||
|
|
@ -95,23 +95,14 @@
|
|||
(if package-build-stable
|
||||
'package-build-get-tag-version
|
||||
'package-build-get-timestamp-version)
|
||||
"The function used to determine the revision and version of a package.
|
||||
"The function used to determine the commit and version of a package.
|
||||
|
||||
The default depends on the value of option `package-build-stable'.
|
||||
|
||||
This function is called with one argument, the recipe object, and
|
||||
must return (REVISION . VERSION), where REVISION is the \"current\"
|
||||
revision according to some definition of the authors choosing and
|
||||
VERSION is the version string corresponding to that.
|
||||
|
||||
REVISION should be determined first. If it is necessary for that
|
||||
to be checked out to determine VERSION, then this function has to
|
||||
do so by calling `package-build--checkout-1'. If not, then this
|
||||
step can be omitted. Note that a helper functions might call the
|
||||
checkout function themselves; `package-build--get-timestamp' does.
|
||||
|
||||
It might be appropriate to respect the `commit' and `branch' slots
|
||||
of the recipe."
|
||||
This function is called with one argument, the recipe object,
|
||||
and must return (COMMIT TIME VERSION), where COMMIT is the commit
|
||||
choosen by the function, TIME is its commit date, and VERSION is
|
||||
the version string choosen for COMMIT."
|
||||
:group 'package-build
|
||||
:set-after '(package-build-stable)
|
||||
:type 'function)
|
||||
|
|
@ -124,6 +115,26 @@ If nil (the default), then all packages are build."
|
|||
:group 'package-build
|
||||
:type '(choice (const :tag "build all") function))
|
||||
|
||||
(defcustom package-build-build-function nil
|
||||
"Low-level function used to build a package.
|
||||
If nil (the default) then the funcion used depends on whether the
|
||||
package consists of more than one file or not. One possible value
|
||||
is `package-build--build-multi-file-package', which would force
|
||||
building a tarball, even for packages that consist of a single
|
||||
file."
|
||||
:group 'package-build
|
||||
:type '(choice (const :tag "default, depending on number of files")
|
||||
function))
|
||||
|
||||
;; NOTE that these hooks are still experimental. Let me know if these
|
||||
;; are potentially useful for you and whether any changes are required
|
||||
;; to make them more appropriate for your usecase.
|
||||
(defvar package-build-worktree-function #'package-recipe--working-tree)
|
||||
(defvar package-build-early-worktree-function #'package-recipe--working-tree)
|
||||
(defvar package-build-fetch-function #'package-build--fetch)
|
||||
(defvar package-build-checkout-function #'package-build--checkout)
|
||||
(defvar package-build-cleanup-function #'package-build--cleanup)
|
||||
|
||||
(defcustom package-build-timeout-executable "timeout"
|
||||
"Path to a GNU coreutils \"timeout\" command if available.
|
||||
This must be a version which supports the \"-k\" option.
|
||||
|
|
@ -191,16 +202,56 @@ Otherwise do nothing. FORMAT-STRING and ARGS are as per that function."
|
|||
(apply #'message format-string args)))
|
||||
|
||||
;;; Version Handling
|
||||
;;;; Common
|
||||
|
||||
(defun package-build--select-version (rcp)
|
||||
(pcase-let* ((default-directory (package-build--working-tree rcp t))
|
||||
(`(,commit ,time ,version)
|
||||
(funcall package-build-get-version-function rcp)))
|
||||
(unless version
|
||||
(error "Cannot detect version for %s" (oref rcp name)))
|
||||
(oset rcp commit commit)
|
||||
(oset rcp time time)
|
||||
(oset rcp version version)))
|
||||
|
||||
(cl-defmethod package-build--select-commit ((rcp package-git-recipe) rev exact)
|
||||
(pcase-let*
|
||||
((`(,hash ,time)
|
||||
(split-string
|
||||
(car (apply #'process-lines
|
||||
"git" "log" "-n1" "--first-parent"
|
||||
"--pretty=format:%H %cd" "--date=unix" rev
|
||||
(and (not exact)
|
||||
(cons "--" (package-build--spec-globs rcp)))))
|
||||
" ")))
|
||||
(list hash (string-to-number time))))
|
||||
|
||||
(cl-defmethod package-build--select-commit ((rcp package-hg-recipe) rev exact)
|
||||
(pcase-let*
|
||||
((`(,hash ,time ,_timezone)
|
||||
(split-string
|
||||
(car (apply #'process-lines
|
||||
;; The "date" keyword uses UTC. The "hgdate" filter
|
||||
;; returns two integers separated by a space; the
|
||||
;; unix timestamp and the timezone offset. We use
|
||||
;; "hgdate" because that makes it easier to discard
|
||||
;; the time zone offset, which doesn't interest us.
|
||||
"hg" "log" "--limit" "1"
|
||||
"--template" "{node} {date|hgdate}\n" "--rev" rev
|
||||
(and (not exact)
|
||||
(cons "--" (package-build--spec-globs rcp)))))
|
||||
" ")))
|
||||
(list hash (string-to-number time))))
|
||||
|
||||
;;;; Release
|
||||
|
||||
(defun package-build-get-tag-version (rcp)
|
||||
(let ((regexp (or (oref rcp version-regexp) package-build-version-regexp))
|
||||
(tag nil)
|
||||
(version '(0)))
|
||||
(dolist (n (let ((default-directory (package-recipe--working-tree rcp)))
|
||||
(cl-etypecase rcp
|
||||
(package-git-recipe (process-lines "git" "tag" "--list"))
|
||||
(package-hg-recipe (process-lines "hg" "tags" "--quiet")))))
|
||||
(dolist (n (cl-etypecase rcp
|
||||
(package-git-recipe (process-lines "git" "tag" "--list"))
|
||||
(package-hg-recipe (process-lines "hg" "tags" "--quiet"))))
|
||||
(let ((v (ignore-errors
|
||||
(version-to-list (and (string-match regexp n)
|
||||
(match-string 1 n))))))
|
||||
|
|
@ -209,108 +260,90 @@ Otherwise do nothing. FORMAT-STRING and ARGS are as per that function."
|
|||
(setq tag (concat "refs/tags/" n))
|
||||
(setq tag n))
|
||||
(setq version v))))
|
||||
(unless tag
|
||||
(error "No valid stable versions found for %s" (oref rcp name)))
|
||||
(cons (package-build--get-commit rcp tag)
|
||||
(package-version-join version))))
|
||||
|
||||
(cl-defmethod package-build--get-commit ((rcp package-git-recipe) &optional rev)
|
||||
(let ((default-directory (package-recipe--working-tree rcp)))
|
||||
(car (process-lines "git" "rev-parse" (or rev "HEAD")))))
|
||||
|
||||
(cl-defmethod package-build--get-commit ((rcp package-hg-recipe) &optional rev)
|
||||
(let ((default-directory (package-recipe--working-tree rcp)))
|
||||
;; "--debug" is needed to get the full hash.
|
||||
(car (apply #'process-lines "hg" "--debug" "identify" "--id"
|
||||
(and rev (list "--rev" rev))))))
|
||||
(and tag
|
||||
(pcase-let ((`(,hash ,time) (package-build--select-commit rcp tag t)))
|
||||
(list hash time (package-version-join version))))))
|
||||
|
||||
;;;; Snapshot
|
||||
|
||||
(defun package-build-get-timestamp-version (rcp)
|
||||
(pcase-let ((`(,hash . ,time) (package-build--get-timestamp rcp)))
|
||||
(cons hash
|
||||
(pcase-let ((`(,hash ,time) (package-build--get-timestamp-version rcp)))
|
||||
(list hash time
|
||||
;; We remove zero-padding of the HH portion, as
|
||||
;; that is lost when stored in archive-contents.
|
||||
(concat (format-time-string "%Y%m%d." time t)
|
||||
(format "%d" (string-to-number
|
||||
(format-time-string "%H%M" time t)))))))
|
||||
|
||||
(cl-defmethod package-build--get-timestamp ((rcp package-git-recipe))
|
||||
(cl-defmethod package-build--get-timestamp-version ((rcp package-git-recipe))
|
||||
(pcase-let*
|
||||
((default-directory (package-recipe--working-tree rcp))
|
||||
(commit (oref rcp commit))
|
||||
((commit (oref rcp commit))
|
||||
(branch (oref rcp branch))
|
||||
(branch (and branch (concat "origin/" branch)))
|
||||
(rev (or commit branch "origin/HEAD"))
|
||||
;; `package-build-expand-files-spec' expects REV to be checked out.
|
||||
(_ (package-build--checkout-1 rcp rev))
|
||||
(`(,hash ,time)
|
||||
(split-string
|
||||
(car (apply #'process-lines
|
||||
"git" "log" "-n1" "--first-parent"
|
||||
"--pretty=format:%H %cd" "--date=unix" rev
|
||||
"--" (mapcar #'car (package-build-expand-files-spec rcp))))
|
||||
" ")))
|
||||
(cons hash (string-to-number time))))
|
||||
(`(,rev-hash ,rev-time) (package-build--select-commit rcp rev commit))
|
||||
(`(,tag-hash ,tag-time) (package-build-get-tag-version rcp)))
|
||||
;; If the latest commit that touches a relevant file is an ancestor of
|
||||
;; the latest tagged release and the tag is reachable from origin/HEAD
|
||||
;; (i.e., it isn't on a separate release branch) then use the tagged
|
||||
;; release. Snapshots should not be older than the latest release.
|
||||
(if (and tag-hash
|
||||
(zerop (call-process "git" nil nil nil
|
||||
"merge-base" "--is-ancestor"
|
||||
rev-hash tag-hash))
|
||||
(zerop (call-process "git" nil nil nil
|
||||
"merge-base" "--is-ancestor"
|
||||
tag-hash rev)))
|
||||
(list tag-hash tag-time)
|
||||
(list rev-hash rev-time))))
|
||||
|
||||
(cl-defmethod package-build--get-timestamp ((rcp package-hg-recipe))
|
||||
(pcase-let*
|
||||
((default-directory (package-recipe--working-tree rcp))
|
||||
(rev nil) ; TODO Respect commit and branch properties.
|
||||
(`(,hash ,time ,_timezone)
|
||||
(split-string
|
||||
(car (apply #'process-lines
|
||||
"hg" "log" "--limit" "1"
|
||||
"--template" "{node} {date|hgdate}\n"
|
||||
`(,@(and rev (list "--rev" rev))
|
||||
,@(mapcar #'car (package-build-expand-files-spec rcp)))))
|
||||
" ")))
|
||||
(cons hash (string-to-number time))))
|
||||
(cl-defmethod package-build--get-timestamp-version ((rcp package-hg-recipe))
|
||||
;; TODO Respect commit and branch properties.
|
||||
;; TODO Use latest release if appropriate.
|
||||
(package-build--select-commit rcp "." nil))
|
||||
|
||||
;;; Run Process
|
||||
|
||||
(defun package-build--run-process (directory destination command &rest args)
|
||||
(setq directory (file-name-as-directory (or directory default-directory)))
|
||||
(let (temp-buffer)
|
||||
(unwind-protect
|
||||
(with-current-buffer
|
||||
(cond ((eq destination t) (current-buffer))
|
||||
(destination)
|
||||
((setq temp-buffer (generate-new-buffer " *temp*"))))
|
||||
(unless destination
|
||||
(setq default-directory directory))
|
||||
(let ((default-directory directory)
|
||||
(argv (nconc (unless (eq system-type 'windows-nt)
|
||||
(list "env" "LC_ALL=C"))
|
||||
(if (and package-build-timeout-secs
|
||||
package-build-timeout-executable)
|
||||
(nconc (list package-build-timeout-executable
|
||||
"-k" "60"
|
||||
(number-to-string
|
||||
package-build-timeout-secs)
|
||||
command)
|
||||
args)
|
||||
(cons command args)))))
|
||||
(unless (file-directory-p default-directory)
|
||||
(error "Cannot run process in non-existent directory: %s"
|
||||
default-directory))
|
||||
(let ((exit-code (apply #'call-process
|
||||
(car argv) nil (current-buffer) nil
|
||||
(cdr argv))))
|
||||
(unless (zerop exit-code)
|
||||
(message "\nCommand '%s' exited with non-zero exit-code: %d\n"
|
||||
(mapconcat #'shell-quote-argument argv " ")
|
||||
exit-code)
|
||||
(message "%s" (buffer-string))
|
||||
(error "Command exited with non-zero exit-code: %d"
|
||||
exit-code)))))
|
||||
(when temp-buffer
|
||||
(kill-buffer temp-buffer)))))
|
||||
(defun package-build--run-process (command &rest args)
|
||||
"Run COMMAND with ARGS in `default-directory'.
|
||||
We use this to wrap commands is proper environment settings and
|
||||
with a timeout so that no command can block the build process."
|
||||
(unless (file-directory-p default-directory)
|
||||
(error "Cannot run process in non-existent directory: %s"
|
||||
default-directory))
|
||||
(with-temp-buffer
|
||||
(pcase-let* ((`(,command . ,args)
|
||||
(nconc (and (not (eq system-type 'windows-nt))
|
||||
(list "env" "LC_ALL=C"))
|
||||
(if (and package-build-timeout-secs
|
||||
package-build-timeout-executable)
|
||||
(nconc (list package-build-timeout-executable
|
||||
"-k" "60"
|
||||
(number-to-string
|
||||
package-build-timeout-secs)
|
||||
command)
|
||||
args)
|
||||
(cons command args))))
|
||||
(exit-code
|
||||
(apply #'call-process command nil (current-buffer) nil args)))
|
||||
(unless (zerop exit-code)
|
||||
(message "\nCommand '%s' exited with non-zero exit-code: %d\n"
|
||||
(mapconcat #'shell-quote-argument argv " ")
|
||||
exit-code)
|
||||
(message "%s" (buffer-string))
|
||||
(error "Command exited with non-zero exit-code: %d" exit-code)))))
|
||||
|
||||
;;; Checkout
|
||||
;;; Worktree
|
||||
|
||||
(cl-defmethod package-build--checkout ((rcp package-git-recipe))
|
||||
(let ((dir (package-recipe--working-tree rcp))
|
||||
(defun package-build--working-tree (rcp &optional early)
|
||||
(if early
|
||||
(funcall package-build-early-worktree-function rcp)
|
||||
(funcall package-build-worktree-function rcp)))
|
||||
|
||||
;;; Fetch
|
||||
|
||||
(cl-defmethod package-build--fetch ((rcp package-git-recipe))
|
||||
(let ((dir (package-build--working-tree rcp t))
|
||||
(url (package-recipe--upstream-url rcp))
|
||||
(protocol (package-recipe--upstream-protocol rcp)))
|
||||
(unless (member protocol package-build-allowed-git-protocols)
|
||||
|
|
@ -321,62 +354,60 @@ Otherwise do nothing. FORMAT-STRING and ARGS are as per that function."
|
|||
(string= (car (process-lines "git" "config" "remote.origin.url"))
|
||||
url)))
|
||||
(unless package-build--inhibit-fetch
|
||||
(package-build--message "Updating %s" dir)
|
||||
(package-build--run-process dir nil "git" "fetch" "-f" "--all" "--tags")
|
||||
;; We might later checkout "origin/HEAD". Sadly "git fetch"
|
||||
;; cannot be told to keep it up-to-date, so we have to make
|
||||
;; a second request.
|
||||
(package-build--run-process dir nil "git" "remote" "set-head"
|
||||
"origin" "--auto")))
|
||||
(let ((default-directory dir))
|
||||
(package-build--message "Updating %s" dir)
|
||||
(package-build--run-process "git" "fetch" "-f" "--all" "--tags")
|
||||
;; We might later checkout "origin/HEAD". Sadly "git fetch"
|
||||
;; cannot be told to keep it up-to-date, so we have to make
|
||||
;; a second request.
|
||||
(package-build--run-process "git" "remote" "set-head"
|
||||
"origin" "--auto"))))
|
||||
(t
|
||||
(when (file-exists-p dir)
|
||||
(delete-directory dir t))
|
||||
(package-build--message "Cloning %s to %s" url dir)
|
||||
(apply #'package-build--run-process nil nil "git" "clone" url dir
|
||||
;; This can dramatically reduce the size of large repos.
|
||||
;; But we can only do this when using a version function
|
||||
;; that is known not to require a checkout and history.
|
||||
;; See #52.
|
||||
(and (eq package-build-get-version-function
|
||||
#'package-build-get-tag-version)
|
||||
(list "--filter=blob:none" "--no-checkout")))))
|
||||
(pcase-let ((`(,rev . ,version)
|
||||
(funcall package-build-get-version-function rcp)))
|
||||
(package-build--checkout-1 rcp rev)
|
||||
version)))
|
||||
(let ((default-directory package-build-working-dir))
|
||||
(apply #'package-build--run-process "git" "clone" url dir
|
||||
;; This can dramatically reduce the size of large repos.
|
||||
;; But we can only do this when using a version function
|
||||
;; that is known not to require a checkout and history.
|
||||
;; See #52.
|
||||
(and (eq package-build-get-version-function
|
||||
#'package-build-get-tag-version)
|
||||
(list "--filter=blob:none" "--no-checkout"))))))))
|
||||
|
||||
(cl-defmethod package-build--checkout ((rcp package-hg-recipe))
|
||||
(let ((dir (package-recipe--working-tree rcp))
|
||||
(cl-defmethod package-build--fetch ((rcp package-hg-recipe))
|
||||
(let ((dir (package-build--working-tree rcp t))
|
||||
(url (package-recipe--upstream-url rcp)))
|
||||
(cond
|
||||
((and (file-exists-p (expand-file-name ".hg" dir))
|
||||
(let ((default-directory dir))
|
||||
(string= (car (process-lines "hg" "paths" "default")) url)))
|
||||
(unless package-build--inhibit-fetch
|
||||
(package-build--message "Updating %s" dir)
|
||||
(package-build--run-process dir nil "hg" "pull")
|
||||
(package-build--run-process dir nil "hg" "update")))
|
||||
(let ((default-directory dir))
|
||||
(package-build--message "Updating %s" dir)
|
||||
(package-build--run-process "hg" "pull")
|
||||
(package-build--run-process "hg" "update"))))
|
||||
(t
|
||||
(when (file-exists-p dir)
|
||||
(delete-directory dir t))
|
||||
(package-build--message "Cloning %s to %s" url dir)
|
||||
(package-build--run-process nil nil "hg" "clone" url dir)))
|
||||
(pcase-let ((`(,rev . ,version)
|
||||
(funcall package-build-get-version-function rcp)))
|
||||
(package-build--checkout-1 rcp rev)
|
||||
version)))
|
||||
(let ((default-directory package-build-working-dir))
|
||||
(package-build--run-process "hg" "clone" url dir))))))
|
||||
|
||||
(cl-defmethod package-build--checkout-1 ((rcp package-git-recipe) rev)
|
||||
;;; Checkout
|
||||
|
||||
(cl-defmethod package-build--checkout ((rcp package-git-recipe))
|
||||
(unless package-build--inhibit-checkout
|
||||
(package-build--message "Checking out %s" rev)
|
||||
(package-build--run-process (package-recipe--working-tree rcp)
|
||||
nil "git" "reset" "--hard" rev)))
|
||||
(let ((rev (oref rcp commit)))
|
||||
(package-build--message "Checking out %s" rev)
|
||||
(package-build--run-process "git" "reset" "--hard" rev))))
|
||||
|
||||
(cl-defmethod package-build--checkout-1 ((rcp package-hg-recipe) rev)
|
||||
(when (and (not package-build--inhibit-checkout) rev)
|
||||
(package-build--message "Checking out %s" rev)
|
||||
(package-build--run-process (package-recipe--working-tree rcp)
|
||||
nil "hg" "update" rev)))
|
||||
(cl-defmethod package-build--checkout ((rcp package-hg-recipe))
|
||||
(unless package-build--inhibit-checkout
|
||||
(let ((rev (oref rcp commit)))
|
||||
(package-build--message "Checking out %s" rev)
|
||||
(package-build--run-process "hg" "update" rev))))
|
||||
|
||||
;;; Generate Files
|
||||
|
||||
|
|
@ -405,14 +436,16 @@ Otherwise do nothing. FORMAT-STRING and ARGS are as per that function."
|
|||
(princ ";; Local Variables:\n;; no-byte-compile: t\n;; End:\n"
|
||||
(current-buffer)))))
|
||||
|
||||
(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)))
|
||||
(when (eq system-type 'windows-nt)
|
||||
(setq tar (replace-regexp-in-string "^\\([a-z]\\):" "/\\1" tar)))
|
||||
(let ((default-directory directory))
|
||||
|
|
@ -424,7 +457,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)
|
||||
|
|
@ -434,13 +467,14 @@ time of all files, making the tarball reproducible."
|
|||
#'string<))
|
||||
(message " %s" line)))))
|
||||
|
||||
(defun package-build--write-pkg-readme (name files directory)
|
||||
(when-let ((commentary
|
||||
(let* ((file (concat name ".el"))
|
||||
(file (or (car (rassoc file files)) file))
|
||||
(file (and file (expand-file-name file directory))))
|
||||
(and (file-exists-p file)
|
||||
(lm-commentary file)))))
|
||||
(defun package-build--write-pkg-readme (pkg files)
|
||||
(when-let* ((name (oref pkg name))
|
||||
(commentary
|
||||
(let* ((file (concat name ".el"))
|
||||
(file (or (car (rassoc file files)) file))
|
||||
(file (and file (expand-file-name file))))
|
||||
(and (file-exists-p file)
|
||||
(lm-commentary file)))))
|
||||
(with-temp-buffer
|
||||
(if (>= emacs-major-version 28)
|
||||
(insert commentary)
|
||||
|
|
@ -466,15 +500,15 @@ time of all files, making the tarball reproducible."
|
|||
(expand-file-name (concat name "-readme.txt")
|
||||
package-build-archive-dir))))))
|
||||
|
||||
(defun package-build--generate-info-files (files source-dir target-dir)
|
||||
(defun package-build--generate-info-files (files target-dir)
|
||||
"Create an info file for each texinfo file listed in FILES.
|
||||
Also create the info dir file. Remove each original texinfo
|
||||
file. The source and destination file paths are expanded in
|
||||
SOURCE-DIR and TARGET-DIR respectively."
|
||||
`default-directory' and TARGET-DIR respectively."
|
||||
(pcase-dolist (`(,src . ,tmp) files)
|
||||
(let ((extension (file-name-extension tmp)))
|
||||
(when (member extension '("info" "texi" "texinfo"))
|
||||
(let* ((src (expand-file-name src source-dir))
|
||||
(let* ((src (expand-file-name src))
|
||||
(tmp (expand-file-name tmp target-dir))
|
||||
(texi src)
|
||||
(info tmp))
|
||||
|
|
@ -487,12 +521,13 @@ SOURCE-DIR and TARGET-DIR respectively."
|
|||
;; and contains relative includes, then it is
|
||||
;; necessary to run makeinfo in the subdirectory.
|
||||
(with-demoted-errors "Error: %S"
|
||||
(package-build--run-process
|
||||
(file-name-directory texi) nil
|
||||
"makeinfo" "--no-split" texi "-o" info))))
|
||||
(let ((default-directory (file-name-directory texi)))
|
||||
(package-build--run-process
|
||||
"makeinfo" "--no-split" texi "-o" info)))))
|
||||
(with-demoted-errors "Error: %S"
|
||||
(package-build--run-process
|
||||
target-dir nil "install-info" "--dir=dir" info)))))))
|
||||
(let ((default-directory target-dir))
|
||||
(package-build--run-process
|
||||
"install-info" "--dir=dir" info))))))))
|
||||
|
||||
;;; Patch Libraries
|
||||
|
||||
|
|
@ -528,8 +563,27 @@ still be renamed."
|
|||
|
||||
;;; Package Structs
|
||||
|
||||
(defun package-build--desc-from-library (name version commit files &optional type)
|
||||
(let* ((file (concat name ".el"))
|
||||
(defun package-build--desc-from-library (rcp files &optional kind)
|
||||
"Return the package description for RCP.
|
||||
|
||||
This function is used for all packages that consist of a single
|
||||
file and those packages that consist of multiple files but lack
|
||||
a file named \"NAME-pkg.el\" or \"NAME-pkg.el\".
|
||||
|
||||
The returned value is a `package-desc' struct (which see).
|
||||
The values of the `name' and `version' slots are taken from RCP
|
||||
itself. The value of `kind' is taken from the KIND argument,
|
||||
which defaults to `single'; the other valid value being `tar'.
|
||||
|
||||
Other information is taken from the file named \"NAME-pkg.el\",
|
||||
which should appear in FILES. As a fallback, \"NAME-pkg.el.in\"
|
||||
is also tried. If neither file exists, then return nil. If a
|
||||
value is not specified in the used file, then fall back to the
|
||||
value specified in the file \"NAME.el\"."
|
||||
(let* ((name (oref rcp name))
|
||||
(version (oref rcp version))
|
||||
(commit (oref rcp commit))
|
||||
(file (concat name ".el"))
|
||||
(file (or (car (rassoc file files)) file)))
|
||||
(and (file-exists-p file)
|
||||
(with-temp-buffer
|
||||
|
|
@ -546,7 +600,7 @@ still be renamed."
|
|||
(when-let ((require-lines (lm-header-multiline "package-requires")))
|
||||
(package--prepare-dependencies
|
||||
(package-read-from-string (mapconcat #'identity require-lines " "))))
|
||||
:kind (or type 'single)
|
||||
:kind (or kind 'single)
|
||||
:url (lm-homepage)
|
||||
:keywords (lm-keywords-list)
|
||||
:maintainer (if (fboundp 'lm-maintainers)
|
||||
|
|
@ -556,8 +610,22 @@ still be renamed."
|
|||
:authors (lm-authors)
|
||||
:commit commit)))))
|
||||
|
||||
(defun package-build--desc-from-package (name version commit files)
|
||||
(let* ((file (concat name "-pkg.el"))
|
||||
(defun package-build--desc-from-package (rcp files)
|
||||
"Return the package description for RCP.
|
||||
|
||||
This function is used for packages that consist of multiple files.
|
||||
|
||||
The returned value is a `package-desc' struct (which see).
|
||||
The values of the `name' and `version' slots are taken from RCP
|
||||
itself. The value of `kind' is always `tar'.
|
||||
|
||||
Other information is taken from the file named \"NAME.el\",
|
||||
which should appear in FILES. As a fallback, \"NAME.el.in\"
|
||||
is also tried. If neither file exists, then return nil."
|
||||
(let* ((name (oref rcp name))
|
||||
(version (oref rcp version))
|
||||
(commit (oref rcp commit))
|
||||
(file (concat name "-pkg.el"))
|
||||
(file (or (car (rassoc file files))
|
||||
file)))
|
||||
(and (or (file-exists-p file)
|
||||
|
|
@ -570,8 +638,7 @@ still be renamed."
|
|||
(pcase-let*
|
||||
((`(,_ ,_ ,_ ,summary ,deps . ,extra) form)
|
||||
(deps (eval deps))
|
||||
(alt-desc (package-build--desc-from-library
|
||||
name version nil files))
|
||||
(alt-desc (package-build--desc-from-library rcp files))
|
||||
(alt (and alt-desc (package-desc-extras alt-desc))))
|
||||
(when (string-match "[\r\n]" summary)
|
||||
(error "Illegal multi-line package description in %s" file))
|
||||
|
|
@ -623,15 +690,6 @@ still be renamed."
|
|||
"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 (repo spec &optional subdir allow-empty)
|
||||
(when subdir
|
||||
(error "%s: Non-nil SUBDIR is no longer supported"
|
||||
'package-build-expand-file-specs))
|
||||
(package-build-expand-files-spec nil (not allow-empty) repo spec))
|
||||
(make-obsolete 'package-build-expand-file-specs
|
||||
'package-build-expand-files-spec
|
||||
"Package-Build 3.2")
|
||||
|
||||
(defun package-build-expand-files-spec (rcp &optional assert repo spec)
|
||||
"Return an alist of files of package RCP to be included in tarball.
|
||||
|
||||
|
|
@ -653,31 +711,29 @@ order and can have the following form:
|
|||
|
||||
- :defaults
|
||||
|
||||
If the very first element of the top-level SPEC is `:defaults',
|
||||
then that means to prepend the default file spec to the SPEC
|
||||
specified by the remaining elements.
|
||||
If the first element is `:defaults', then that means to prepend
|
||||
the default files spec to the SPEC specified by the remaining
|
||||
elements.
|
||||
|
||||
- GLOB
|
||||
|
||||
A string is glob-expanded to match zero or more files. Matched
|
||||
files are copied to the top-level directory.
|
||||
|
||||
- (SUBDIRECTORY . SPEC)
|
||||
- (SUBDIRECTORY GLOB...)
|
||||
|
||||
A list that begins with a string causes the files matched by
|
||||
the second and subsequent elements to be copied into the sub-
|
||||
directory specified by the first element.
|
||||
|
||||
- (:exclude . SPEC)
|
||||
- (:exclude GLOB...)
|
||||
|
||||
A list that begins with `:exclude' causes files that were
|
||||
matched by earlier elements that are also matched by the second
|
||||
and subsequent elements of this list to be removed from the
|
||||
returned alist. Files matched by later elements are not
|
||||
affected.
|
||||
|
||||
\(fn RCP &optional ASSERT)" ; Other arguments only for backward compat.
|
||||
(let ((default-directory (or repo (package-recipe--working-tree rcp)))
|
||||
affected."
|
||||
(let ((default-directory (or repo (package-build--working-tree rcp)))
|
||||
(spec (or spec (oref rcp files))))
|
||||
(when (eq (car spec) :defaults)
|
||||
(setq spec (append package-build-default-files-spec (cdr spec))))
|
||||
|
|
@ -694,40 +750,47 @@ order and can have the following form:
|
|||
default-directory (or spec "default spec"))))
|
||||
files)))
|
||||
|
||||
(defun package-build--expand-files-spec-1 (spec &optional subdir)
|
||||
(let ((files nil))
|
||||
(defun package-build--expand-files-spec-1 (spec)
|
||||
"Return a list of all files matching SPEC in `default-directory'.
|
||||
SPEC is a full files spec as stored in a recipe object."
|
||||
(let (include exclude)
|
||||
(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))
|
||||
(if (eq (car-safe entry) :exclude)
|
||||
(dolist (entry (cdr entry))
|
||||
(push entry exclude))
|
||||
(push entry include)))
|
||||
(cl-set-difference
|
||||
(package-build--expand-files-spec-2 (nreverse include))
|
||||
(package-build--expand-files-spec-2 (nreverse exclude))
|
||||
:test #'equal :key #'car)))
|
||||
|
||||
(defun package-build--copy-package-files (files source-dir target-dir)
|
||||
"Copy FILES from SOURCE-DIR to TARGET-DIR.
|
||||
(defun package-build--expand-files-spec-2 (spec &optional subdir)
|
||||
"Return a list of all files matching SPEC in SUBDIR.
|
||||
If SUBDIR is nil, use `default-directory'. SPEC is expected to
|
||||
be a partial files spec, consisting of either all include rules
|
||||
or all exclude rules (with the `:exclude' keyword removed)."
|
||||
(mapcan (lambda (entry)
|
||||
(if (stringp entry)
|
||||
(mapcar (lambda (f)
|
||||
(cons f
|
||||
(concat subdir
|
||||
(replace-regexp-in-string
|
||||
"\\.el\\.in\\'" ".el"
|
||||
(file-name-nondirectory f)))))
|
||||
(file-expand-wildcards entry))
|
||||
(package-build--expand-files-spec-2
|
||||
(cdr entry)
|
||||
(concat subdir (car entry) "/"))))
|
||||
spec))
|
||||
|
||||
(defun package-build--copy-package-files (files target-dir)
|
||||
"Copy FILES from `default-directory' to TARGET-DIR.
|
||||
FILES is a list of (SOURCE . DEST) relative filepath pairs."
|
||||
(package-build--message
|
||||
"Copying files (->) and directories (=>)\n from %s\n to %s"
|
||||
source-dir target-dir)
|
||||
default-directory target-dir)
|
||||
(pcase-dolist (`(,src . ,dst) files)
|
||||
(let ((src* (expand-file-name src source-dir))
|
||||
(let ((src* (expand-file-name src))
|
||||
(dst* (expand-file-name dst target-dir)))
|
||||
(make-directory (file-name-directory dst*) t)
|
||||
(cond ((file-regular-p src*)
|
||||
|
|
@ -739,6 +802,40 @@ FILES is a list of (SOURCE . DEST) relative filepath pairs."
|
|||
" %s %s => %s" (if (equal src dst) " " "!") src dst)
|
||||
(copy-directory src* dst*))))))
|
||||
|
||||
(defun package-build--spec-globs (rcp)
|
||||
"Return a list of vcs arguments to match the files specified in RCP."
|
||||
;; See glob(7), gitglossary(7) and "hg help patterns".
|
||||
(cl-flet ((toargs (glob &optional exclude)
|
||||
;; Given an element like ("dir" "dir/*"), we want to move
|
||||
;; all children of "dir" to the top-level. Glob handling
|
||||
;; of git-log/hg-log only cares about regular file, so if
|
||||
;; "dir/subdir/file" is modified, then "dir/*" does not
|
||||
;; match that change. Use "dir/**" instead, to make them
|
||||
;; look for changes to files in "dir" and all subdirs.
|
||||
(when (string-suffix-p "/*" glob)
|
||||
(setq glob (concat glob "*")))
|
||||
(cl-etypecase rcp
|
||||
(package-git-recipe
|
||||
(list (format ":(glob%s)%s" (if exclude ",exclude" "") glob)))
|
||||
(package-hg-recipe
|
||||
(list (if exclude "--exclude" "--include")
|
||||
(concat "glob:" glob))))))
|
||||
(mapcan (lambda (entry)
|
||||
(pcase-exhaustive entry
|
||||
((and glob (pred stringp))
|
||||
(toargs glob))
|
||||
((and `(:exclude . ,globs)
|
||||
(guard (cl-every #'stringp globs)))
|
||||
(mapcan (lambda (g) (toargs g t)) globs))
|
||||
((and `(,dir . ,globs)
|
||||
(guard (stringp dir))
|
||||
(guard (cl-every #'stringp globs)))
|
||||
(mapcan #'toargs globs))))
|
||||
(let ((spec (or (oref rcp files) package-build-default-files-spec)))
|
||||
(if (eq (car spec) :defaults)
|
||||
(append package-build-default-files-spec (cdr spec))
|
||||
spec)))))
|
||||
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -762,53 +859,48 @@ are subsequently dumped."
|
|||
(message "Package: %s" name)
|
||||
(message "Fetcher: %s" fetcher)
|
||||
(message "Source: %s\n" url)))
|
||||
(let ((default-directory package-build-working-dir)
|
||||
(version (package-build--checkout rcp)))
|
||||
(package-build--package rcp version)
|
||||
(when dump-archive-contents
|
||||
(package-build-dump-archive-contents))
|
||||
(message "Built %s in %.3fs, finished at %s" name
|
||||
(float-time (time-since start-time))
|
||||
(format-time-string "%FT%T%z" nil t)))))
|
||||
(funcall package-build-fetch-function rcp)
|
||||
(package-build--select-version rcp)
|
||||
(package-build--package rcp)
|
||||
(when dump-archive-contents
|
||||
(package-build-dump-archive-contents))
|
||||
(message "Built %s in %.3fs, finished at %s" name
|
||||
(float-time (time-since start-time))
|
||||
(format-time-string "%FT%T%z" nil t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun package-build--package (rcp version)
|
||||
"Create version VERSION of the package specified by RCP.
|
||||
(defun package-build--package (rcp)
|
||||
"Build the package version specified by RCP.
|
||||
Return the archive entry for the package and store the package
|
||||
in `package-build-archive-dir'."
|
||||
(let ((source-dir (package-recipe--working-tree rcp)))
|
||||
(let ((default-directory (package-build--working-tree rcp)))
|
||||
(unwind-protect
|
||||
(let ((name (oref rcp name))
|
||||
(files (package-build-expand-files-spec rcp t))
|
||||
(commit (package-build--get-commit rcp)))
|
||||
(cond
|
||||
((not version)
|
||||
(error "Unable to check out repository for %s" name))
|
||||
((= (length files) 1)
|
||||
(package-build--build-single-file-package
|
||||
rcp version commit files source-dir))
|
||||
((> (length files) 1)
|
||||
(package-build--build-multi-file-package
|
||||
rcp version commit files source-dir))
|
||||
(t (error "Unable to find files matching recipe patterns")))
|
||||
(when package-build-write-melpa-badge-images
|
||||
(package-build--write-melpa-badge-image
|
||||
name version package-build-archive-dir)))
|
||||
(cond ((cl-typep rcp 'package-git-recipe)
|
||||
(package-build--run-process
|
||||
source-dir nil "git" "clean" "-f" "-d" "-x"))
|
||||
((cl-typep rcp 'package-hg-recipe)
|
||||
(package-build--run-process source-dir nil "hg" "purge"))))))
|
||||
(progn
|
||||
(funcall package-build-checkout-function rcp)
|
||||
(let ((files (package-build-expand-files-spec rcp t)))
|
||||
(cond
|
||||
((= (length files) 0)
|
||||
(error "Unable to find files matching recipe patterns"))
|
||||
(package-build-build-function
|
||||
(funcall package-build-build-function))
|
||||
((= (length files) 1)
|
||||
(package-build--build-single-file-package rcp files))
|
||||
(t
|
||||
(package-build--build-multi-file-package rcp files)))
|
||||
(when package-build-write-melpa-badge-images
|
||||
(package-build--write-melpa-badge-image
|
||||
(oref rcp name) (oref rcp version) package-build-archive-dir))))
|
||||
(funcall package-build-cleanup-function rcp))))
|
||||
|
||||
(defun package-build--build-single-file-package (rcp version commit files source-dir)
|
||||
(defun package-build--build-single-file-package (rcp files)
|
||||
(let* ((name (oref rcp name))
|
||||
(version (oref rcp version))
|
||||
(commit (oref rcp commit))
|
||||
(file (caar files))
|
||||
(source (expand-file-name file source-dir))
|
||||
(source (expand-file-name file))
|
||||
(target (expand-file-name (concat name "-" version ".el")
|
||||
package-build-archive-dir))
|
||||
(desc (let ((default-directory source-dir))
|
||||
(package-build--desc-from-library
|
||||
name version commit files))))
|
||||
(desc (package-build--desc-from-library rcp files)))
|
||||
(unless (member (downcase (file-name-nondirectory file))
|
||||
(list (downcase (concat name ".el"))
|
||||
(downcase (concat name ".el.in"))))
|
||||
|
|
@ -823,44 +915,32 @@ in `package-build-archive-dir'."
|
|||
(package-build--ensure-ends-here-line source)
|
||||
(write-file target nil)
|
||||
(kill-buffer)))
|
||||
(package-build--write-pkg-readme name files source-dir)
|
||||
(package-build--write-pkg-readme rcp files)
|
||||
(package-build--write-archive-entry desc)))
|
||||
|
||||
(defun package-build--build-multi-file-package (rcp version commit files source-dir)
|
||||
(defun package-build--build-multi-file-package (rcp files)
|
||||
(let* ((name (oref rcp name))
|
||||
(version (oref rcp version))
|
||||
(tmp-dir (file-name-as-directory (make-temp-file name t))))
|
||||
(unwind-protect
|
||||
(let* ((target (expand-file-name (concat name "-" version) tmp-dir))
|
||||
(desc (let ((default-directory source-dir))
|
||||
(or (package-build--desc-from-package
|
||||
name version commit files)
|
||||
(package-build--desc-from-library
|
||||
name version commit files 'tar)
|
||||
(error "%s[-pkg].el matching package name is missing"
|
||||
name))))
|
||||
(mtime (package-build--get-commit-time rcp commit)))
|
||||
(package-build--copy-package-files files source-dir target)
|
||||
(desc (or (package-build--desc-from-package rcp files)
|
||||
(package-build--desc-from-library rcp files 'tar)
|
||||
(error "%s[-pkg].el matching package name is missing"
|
||||
name))))
|
||||
(package-build--copy-package-files files target)
|
||||
(package-build--write-pkg-file desc target)
|
||||
(package-build--generate-info-files files source-dir target)
|
||||
(package-build--create-tar name version tmp-dir mtime)
|
||||
(package-build--write-pkg-readme name files source-dir)
|
||||
(package-build--generate-info-files files target)
|
||||
(package-build--create-tar rcp tmp-dir)
|
||||
(package-build--write-pkg-readme rcp files)
|
||||
(package-build--write-archive-entry desc))
|
||||
(delete-directory tmp-dir t nil))))
|
||||
|
||||
(cl-defmethod package-build--get-commit-time ((rcp package-git-recipe) rev)
|
||||
(let ((default-directory (package-recipe--working-tree rcp)))
|
||||
(string-to-number
|
||||
(car (process-lines "git" "log" "-n1" "--first-parent"
|
||||
"--pretty=format:%cd" "--date=unix" rev)))))
|
||||
|
||||
(cl-defmethod package-build--get-commit-time ((rcp package-hg-recipe) rev)
|
||||
(let ((default-directory (package-recipe--working-tree rcp)))
|
||||
(string-to-number
|
||||
(car (split-string
|
||||
(car (process-lines "hg" "log" "--limit" "1"
|
||||
"--template" "{date|hgdate}\n"
|
||||
"--rev" rev))
|
||||
" ")))))
|
||||
(defun package-build--cleanup (rcp)
|
||||
(cond ((cl-typep rcp 'package-git-recipe)
|
||||
(package-build--run-process "git" "clean" "-f" "-d" "-x"))
|
||||
((cl-typep rcp 'package-hg-recipe)
|
||||
(package-build--run-process "hg" "purge"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun package-build-all ()
|
||||
|
|
@ -1061,8 +1141,5 @@ line per entry."
|
|||
|
||||
;;; _
|
||||
|
||||
(define-obsolete-function-alias 'package-build--archive-entries
|
||||
#'package-build-dump-archive-contents "Package-Build 3.0")
|
||||
|
||||
(provide 'package-build)
|
||||
;;; package-build.el ends here
|
||||
|
|
|
|||
|
|
@ -47,6 +47,8 @@
|
|||
(files :initarg :files :initform nil)
|
||||
(branch :initarg :branch :initform nil)
|
||||
(commit :initarg :commit :initform nil)
|
||||
(time :initform nil)
|
||||
(version :initform nil)
|
||||
(version-regexp :initarg :version-regexp :initform nil)
|
||||
(old-names :initarg :old-names :initform nil))
|
||||
:abstract t)
|
||||
|
|
@ -145,6 +147,14 @@ file is invalid, then raise an error."
|
|||
|
||||
;;; Validation
|
||||
|
||||
(defun package-recipe-validate-all ()
|
||||
"Validate all recipes."
|
||||
(interactive)
|
||||
(dolist (name (package-recipe-recipes))
|
||||
(condition-case err
|
||||
(package-recipe-lookup name)
|
||||
(error (message "Invalid recipe for %s: %S" name (cdr err))))))
|
||||
|
||||
(defun package-recipe--validate (recipe name)
|
||||
"Perform some basic checks on the raw RECIPE for the package named NAME."
|
||||
(pcase-let ((`(,ident . ,plist) recipe))
|
||||
|
|
@ -180,6 +190,24 @@ file is invalid, then raise an error."
|
|||
(let ((val (plist-get plist key)))
|
||||
(when val
|
||||
(cl-assert (stringp val) nil "%s must be a string but is %S" key val))))
|
||||
(when-let ((spec (plist-get plist :files)))
|
||||
;; `:defaults' is only allowed as the first element.
|
||||
;; If we find it in that position, skip over it.
|
||||
(when (eq (car spec) :defaults)
|
||||
(setq spec (cdr spec)))
|
||||
;; All other elements have to be strings or lists of strings.
|
||||
;; A list whose first element is `:exclude' is also valid.
|
||||
(dolist (entry spec)
|
||||
(unless (or (and (stringp entry)
|
||||
(not (equal entry "*")))
|
||||
(and (listp entry)
|
||||
(or (eq (car entry) :exclude)
|
||||
(stringp (car entry)))
|
||||
(seq-every-p (lambda (e)
|
||||
(and (stringp e)
|
||||
(not (equal e "*"))))
|
||||
(cdr entry))))
|
||||
(error "Invalid files spec entry %S" entry))))
|
||||
;; Silence byte compiler of Emacs 28. It appears that uses
|
||||
;; inside cl-assert sometimes, but not always, do not count.
|
||||
(list name ident all-keys))
|
||||
|
|
|
|||
|
|
@ -292,13 +292,15 @@ already and should not be upgraded etc)."
|
|||
(version
|
||||
(cond
|
||||
((or (not (equal ver-type 'elpa)) quelpa-stable-p) melpa-ver)
|
||||
(t
|
||||
(melpa-ver
|
||||
(let ((base-ver
|
||||
(if-let ((info (quelpa-build--pkg-info (symbol-name name) files build-dir)))
|
||||
(if-let ((info (quelpa-build--pkg-info (symbol-name name)
|
||||
files build-dir)))
|
||||
(aref info 3)
|
||||
'(0 0 0))))
|
||||
(while (< (length base-ver) 3) (setq base-ver (append base-ver '(0))))
|
||||
(concat (package-version-join base-ver) "." melpa-ver))))))
|
||||
(package-version-join
|
||||
(nconc base-ver (version-to-list melpa-ver))))))))
|
||||
(prog1
|
||||
(if version
|
||||
(quelpa-archive-file-name
|
||||
|
|
|
|||
Loading…
Reference in New Issue