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

After build, remove pre-built packages for which no recipe exists (see #76)

Browse source
This commit is contained in:
Steve Purcell 2012-04-17 12:00:31 +01:00
parent 225d18964a
commit 6dc2d0fb9f
1 changed files with 35 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
package-build.el
View file

@ -405,6 +405,29 @@ If PKG-INFO is nil, an empty one is created."
desc desc
type))))) type)))))
(defun pb/archive-file-name (archive-entry)
"Return the path of the file in which the package for ARCHIVE-ENTRY is stored."
(expand-file-name (format "%s-%s.%s"
(car archive-entry)
(car (aref (cdr archive-entry) 0))
(if (eq 'single (aref (cdr archive-entry) 3))
"el"
"tar"))
package-build-archive-dir))
(defun pb/remove-archive (archive-entry)
"Remove ARCHIVE-ENTRY from archive-contents, and delete associated file.
Note that the working directory (if present) is not deleted by
this function, since the archive list may contain another version
of the same-named package which is to be kept."
(message "Removing archive: %s" archive-entry)
(let ((archive-file (pb/archive-file-name archive-entry)))
(when (file-exists-p archive-file)
(delete-file archive-file)))
(setq package-build-archive-alist
(remove archive-entry package-build-archive-alist))
(pb/dump-archive-contents))
(defun pb/read-recipes () (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 (mapcar 'pb/read-from-file
@ -494,7 +517,18 @@ If PKG-INFO is nil, an empty one is created."
"Build all packages in the `package-build-alist'." "Build all packages in the `package-build-alist'."
(interactive) (interactive)
(mapc 'package-build-archive-ignore-errors (mapc 'package-build-archive-ignore-errors
(mapcar 'symbol-name (mapcar 'car package-build-alist)))) (mapcar 'symbol-name (mapcar 'car package-build-alist)))
(package-build-cleanup))
(defun package-build-cleanup ()
"Remove previously-built packages that no longer have recipes."
(interactive)
(let* ((known-package-names (mapcar 'car package-build-alist))
(stale-archives (loop for built in package-build-archive-alist
when (not (memq (car built) known-package-names))
collect built)))
(dolist (stale stale-archives)
(pb/remove-archive stale))))
(defun package-build-initialize () (defun package-build-initialize ()
"Load the recipe and archive-contents files." "Load the recipe and archive-contents files."