2 ;;; ch-asdf.cl -- various lisp utilities that make my life easier
4 ;;; Author: Cyrus Harmon <ch-lisp@bobobeach.com>
5 ;;; Time-stamp: <2006-07-31 14:46:56 sly>
10 (defun pathname-in-parent (path system
)
15 (make-pathname :directory
`(:relative
:up
))
19 (asdf:system-definition-pathname system
)))))))
21 (defun list-module-files (module system
)
22 (cond ((string-equal (symbol-name (class-name (class-of module
)))
24 (list (pathname-in-parent (asdf:component-pathname module
) system
)))
30 (truename (asdf:system-definition-pathname module
))
34 (asdf:module
(list-module-files x system
))
35 (t (let ((path (asdf:component-pathname x
)))
41 (asdf:module-components module
))))))
43 (defun make-dist (&rest module-keywords
)
44 (let ((modules (mapcar
45 #'(lambda (k) (asdf:find-system k
))
47 (let ((module (car modules
))
51 (list-module-files module module
))
53 (with-open-file (gzip-file
55 (asdf:component-name module
)
57 (asdf:component-version module
)
59 :if-does-not-exist
:create
62 (let ((*default-pathname-defaults
*
65 (make-pathname :directory
'(:relative
:up
))
69 (asdf:system-definition-pathname module
)))))))
70 (with-current-directory *default-pathname-defaults
*
74 :input
(ch-util:process-output-stream
79 (print files-for-dist
))
83 :if-error-exists
:append
))
84 :output gzip-file
)))))))
86 (defun unregister-system (name)
87 (remhash name asdf
::*defined-systems
*))