github/melpa
1
0
Fork 0
mirror of https://github.com/correl/melpa.git synced 2024-11-22 19:18:39 +00:00
Code Issues Projects Releases Packages Wiki Activity

Copy files for multi-file packages as individuals, rather than duplicating the repository.

Browse source
This commit is contained in:
Donald Curtis 2012-04-29 19:26:28 -05:00
parent a1c97870c2
commit abbe137e38
1 changed files with 46 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
package-build.el
View file

@ -481,12 +481,47 @@ of the same-named package which is to be kept."
(pb/dump-archive-contents))
(defun pb/read-recipes ()
"Return a list of data structures for all recipes in `package-build-recipes-dir'."
"Return a list of data structures for all recipes in
`package-build-recipes-dir'."
(mapcar 'pb/read-from-file
(directory-files package-build-recipes-dir t "^[^.]")))
;;; Public interface
(defun pb/copy-file (src dst)
"Copy SRC to DST and create parent directories for DST if they
don't exist."
(let ((dstdir (file-name-directory dst)))
(unless (file-exists-p dstdir)
(make-directory dstdir t)))
(cond
((file-regular-p src)
(copy-file src dst))
((file-directory-p src)
(copy-directory src dst))))
(defun pb/equal (lst)
"Test if all elements in the list are equal."
(let ((first-element (car lst)))
(every (lambda (ele) (equal first-element ele)) lst)))
(defun pb/common-prefix (lsts)
"Determine the longest starting prefix for LSTS"
(when (pb/equal (mapcar 'car lsts))
(cons (car (car lsts)) (pb/common-prefix (mapcar 'cdr lsts)))))
(defun pb/common-path-prefix (files)
"Determine the common path prefix for FILES"
(mapconcat 'identity
(pb/common-prefix
(mapcar (lambda (path) (split-string path "/"))
files)) "/"))
(defun pb/remove-prefix (pfx str)
"Strip PFX from STR"
(if (string-match (concat "^" pfx) str)
(setq str (replace-match "" nil nil str))
str))
;;; Public interface
(defun package-build-archive (name)
"Build a package archive for package FILE-NAME."
(interactive (list (intern (completing-read "Package: "
@ -531,12 +566,19 @@ of the same-named package which is to be kept."
(pb/get-package-info (concat file-name ".el"))))
file-name
version
cfg)))
cfg))
(pkg-pathpfx
(file-name-as-directory (pb/common-path-prefix files))))
(when (file-exists-p pkg-dir)
(delete-directory pkg-dir t nil))
(copy-directory file-name pkg-dir)
(mapc (lambda (fn)
(pb/copy-file (expand-file-name fn pkg-cwd)
(expand-file-name
(pb/remove-prefix pkg-pathpfx fn)
pkg-dir)))
files)
(pb/write-pkg-file (expand-file-name
pkg-file