Expand file list specs in package-build-package for a more convenient API

The expansion functions therefore become private once again.

See #1274.
This commit is contained in:
Steve Purcell 2014-01-03 18:27:32 +00:00
parent 2e01dc88a5
commit c05a403945

View file

@ -660,10 +660,13 @@ of the same-named package which is to be kept."
collect pkg-info))
(defun package-build-expand-file-specs (dir specs &optional subdir)
(defun pb/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."
file path and DEST is the relative path to which it should be copied.
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))
@ -672,14 +675,15 @@ file path and DEST is the relative path to which it should be copied."
(if (consp entry)
(if (eq :exclude (car entry))
(cl-nset-difference lst
(package-build-expand-file-specs dir (cdr entry))
(pb/expand-file-specs dir (cdr entry) nil t)
:key 'car
:test 'equal)
(nconc lst
(package-build-expand-file-specs
(pb/expand-file-specs
dir
(cdr entry)
(concat prefix (car entry)))))
(concat prefix (car entry))
t)))
(nconc
lst (mapcar (lambda (f)
(let ((destname)))
@ -689,19 +693,19 @@ file path and DEST is the relative path to which it should be copied."
"\\.in\\'"
""
(file-name-nondirectory f)))))
(file-expand-wildcards entry))))))))
(file-expand-wildcards entry))))))
(when (and (null lst) (not allow-empty))
(error "No matching file(s) found in %s: %s" dir specs))
lst))
(defun pb/expand-config-file-list (dir config)
"In DIR, expand the :files for CONFIG using 'package-build-expand-file-specs."
(let* ((patterns (or (plist-get config :files) package-build-default-files-spec))
(files (package-build-expand-file-specs dir patterns)))
(or files
(error "No matching file(s) found in %s: %s" dir patterns))))
(defun pb/config-file-list (config)
"Get the :files spec from CONFIG, or return `package-build-default-files-spec'."
(or (plist-get config :files) package-build-default-files-spec))
(defun pb/expand-source-file-list (dir config)
"Shorthand way to expand paths in DIR for source files listed in CONFIG."
(mapcar 'car (pb/expand-config-file-list dir config)))
(mapcar 'car (pb/expand-file-specs dir (pb/config-file-list config))))
(defun pb/generate-info-files (files source-dir target-dir)
"Create .info files from any .texi files listed in FILES in SOURCE-DIR in TARGET-DIR.
@ -809,11 +813,11 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
(pb/message "\n;;; %s\n" file-name)
(let* ((version (package-build-checkout name rcp pkg-working-dir))
(files (pb/expand-config-file-list pkg-working-dir rcp))
(default-directory package-build-working-dir)
(start-time (current-time))
(archive-entry (package-build-package (symbol-name name)
version files
version
(pb/config-file-list rcp)
pkg-working-dir
package-build-archive-dir)))
(pb/dump archive-entry
@ -825,90 +829,97 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
file-name)))
;;;###autoload
(defun package-build-package (package-name version files source-dir target-dir)
"Create PACKAGE-NAME with VERSION containing FILES from SOURCE-DIR, and store in TARGET-DIR.
(defun package-build-package (package-name version file-specs source-dir target-dir)
"Create PACKAGE-NAME with VERSION using FILE-SPECS to gather files from SOURCE-DIR.
Argument FILES is an list of (SRC . DEST) relative path pairs, as
returned by `package-build-expand-file-specs'.
The resulting package will be stored as a .el or .tar file in
TARGET-DIR, depending on whether there are multiple files.
Argument FILE-SPECS is a list of specs for source files, which
should be relative to SOURCE-DIR. The specs can be wildcards,
and optionally specify different target paths. They extended
syntax is currently only documented in the MELPA README. You can
simply pass `package-build-default-files-spec' in most cases.
Returns the archive entry for the package."
(cond
((not version)
(error "Unable to check out repository for %s" package-name))
((= 1 (length files))
(let* ((pkg-source (expand-file-name (caar files) source-dir))
(pkg-target (expand-file-name
(concat package-name "-" version ".el")
target-dir))
(pkg-info (pb/merge-package-info
(pb/get-package-info pkg-source)
package-name
version)))
(unless (string-equal (downcase (concat package-name ".el"))
(downcase (file-name-nondirectory pkg-source)))
(error "Single file %s does not match package name %s"
(file-name-nondirectory pkg-source) package-name))
(when (file-exists-p pkg-target)
(delete-file pkg-target t))
(copy-file pkg-source pkg-target)
(let ((enable-local-variables nil)
(make-backup-files nil))
(with-current-buffer (find-file pkg-target)
(pb/update-or-insert-version version)
(pb/ensure-ends-here-line pkg-source)
(write-file pkg-target nil)
(condition-case err
(pb/package-buffer-info-vec)
(error
(pb/message "Warning: %S" err)))
(kill-buffer)))
(let ((files (pb/expand-file-specs source-dir file-specs)))
(cond
((not version)
(error "Unable to check out repository for %s" package-name))
((= 1 (length files))
(let* ((pkg-source (expand-file-name (caar files) source-dir))
(pkg-target (expand-file-name
(concat package-name "-" version ".el")
target-dir))
(pkg-info (pb/merge-package-info
(pb/get-package-info pkg-source)
package-name
version)))
(unless (string-equal (downcase (concat package-name ".el"))
(downcase (file-name-nondirectory pkg-source)))
(error "Single file %s does not match package name %s"
(file-name-nondirectory pkg-source) package-name))
(when (file-exists-p pkg-target)
(delete-file pkg-target t))
(copy-file pkg-source pkg-target)
(let ((enable-local-variables nil)
(make-backup-files nil))
(with-current-buffer (find-file pkg-target)
(pb/update-or-insert-version version)
(pb/ensure-ends-here-line pkg-source)
(write-file pkg-target nil)
(condition-case err
(pb/package-buffer-info-vec)
(error
(pb/message "Warning: %S" err)))
(kill-buffer)))
(pb/write-pkg-readme (and (> (length pkg-info) 4) (aref pkg-info 4))
package-name)
(pb/archive-entry pkg-info 'single)))
((< 1 (length files))
(let* ((tmp-dir (file-name-as-directory (make-temp-file package-name t)))
(pkg-dir-name (concat package-name "-" version))
(pkg-tmp-dir (expand-file-name pkg-dir-name tmp-dir))
(pkg-file (concat package-name "-pkg.el"))
(pkg-file-source (or (pb/find-source-file pkg-file files)
pkg-file))
(file-source (concat package-name ".el"))
(pkg-source (or (pb/find-source-file file-source files)
file-source))
(pkg-info (pb/merge-package-info
(let ((default-directory source-dir))
(or (pb/get-pkg-file-info pkg-file-source)
;; some packages (like magit) provide name-pkg.el.in
(pb/get-pkg-file-info
(expand-file-name (concat pkg-file ".in")
(file-name-directory pkg-source)))
(pb/get-package-info pkg-source)))
package-name
version)))
(pb/write-pkg-readme (and (> (length pkg-info) 4) (aref pkg-info 4))
package-name)
(pb/archive-entry pkg-info 'single)))
((< 1 (length files))
(let* ((tmp-dir (file-name-as-directory (make-temp-file package-name t)))
(pkg-dir-name (concat package-name "-" version))
(pkg-tmp-dir (expand-file-name pkg-dir-name tmp-dir))
(pkg-file (concat package-name "-pkg.el"))
(pkg-file-source (or (pb/find-source-file pkg-file files)
pkg-file))
(file-source (concat package-name ".el"))
(pkg-source (or (pb/find-source-file file-source files)
file-source))
(pkg-info (pb/merge-package-info
(let ((default-directory source-dir))
(or (pb/get-pkg-file-info pkg-file-source)
;; some packages (like magit) provide name-pkg.el.in
(pb/get-pkg-file-info
(expand-file-name (concat pkg-file ".in")
(file-name-directory pkg-source)))
(pb/get-package-info pkg-source)))
package-name
version)))
(pb/copy-package-files files source-dir pkg-tmp-dir)
(pb/write-pkg-file (expand-file-name pkg-file
(file-name-as-directory pkg-tmp-dir))
pkg-info)
(pb/copy-package-files files source-dir pkg-tmp-dir)
(pb/write-pkg-file (expand-file-name pkg-file
(file-name-as-directory pkg-tmp-dir))
pkg-info)
(pb/generate-info-files files source-dir pkg-tmp-dir)
(pb/generate-dir-file files pkg-tmp-dir)
(pb/generate-info-files files source-dir pkg-tmp-dir)
(pb/generate-dir-file files pkg-tmp-dir)
(let ((default-directory tmp-dir))
(pb/create-tar (expand-file-name (concat package-name "-" version ".tar")
target-dir)
pkg-dir-name))
(let ((default-directory tmp-dir))
(pb/create-tar (expand-file-name (concat package-name "-" version ".tar")
target-dir)
pkg-dir-name))
(let ((default-directory source-dir))
(pb/write-pkg-readme (pb/find-package-commentary pkg-source)
package-name))
(let ((default-directory source-dir))
(pb/write-pkg-readme (pb/find-package-commentary pkg-source)
package-name))
(delete-directory pkg-tmp-dir t nil)
(pb/archive-entry pkg-info 'tar)))
(delete-directory pkg-tmp-dir t nil)
(pb/archive-entry pkg-info 'tar)))
(t (error "Unable to find files matching recipe patterns"))))
(t (error "Unable to find files matching recipe patterns")))))