diff --git a/cclan-package.lisp b/cclan-package.lisp index dc8fb6ad1d497ba830edf823829eceae2ceb10ef..0f117dd089407c656ba388e7db22f052fdcbf36b 100644 --- a/cclan-package.lisp +++ b/cclan-package.lisp @@ -1,5 +1,5 @@ (in-package :cl-user) (defpackage :cclan (:use #:cl #:asdf) - (:export #:make-tar-file)) + (:export #:all-components #:cvs-tag #:make-tar-file)) diff --git a/cclan.lisp b/cclan.lisp index d1fd21b47b18505a0ad001d957d1835994b130c4..cc0dad0a43e22561b12065d2453cd5adc95e0adb 100644 --- a/cclan.lisp +++ b/cclan.lisp @@ -4,6 +4,9 @@ ;;;; asdf itself, but extend it in various ways useful for maintainers ;;;; of new-style cCLan packages +;;;; The public interface consists of the functions whose symbols are +;;;; exported from the package + ;;;; This file does not contain references to asdf internals - or ;;;; shouldn't, anyway. Send bug reports @@ -12,11 +15,23 @@ (let ((f (coerce function 'function))) (loop for i in list append (funcall f i)))) -(defgeneric list-files (component)) -(defmethod list-files ((c source-file)) - (list (component-pathname c))) -(defmethod list-files ((c module)) - (mapappend 'list-files (module-components c))) +(defgeneric all-components (component)) +(defmethod all-components ((source-file source-file)) + (list source-file)) + +(defmethod all-components ((module module)) + (cons module (mapappend #'all-components (module-components module)))) + +(defmethod all-components ((module symbol)) + (all-components (find-system module))) + +(defun cvs-tag (system) + (let* ((system (find-system system)) + (directory (component-pathname system)) + (version (component-version system))) + (run-shell-command "cd ~A && cvs tag -F cclan_version_~A" + (namestring directory) + (substitute #\_ #\. version)))) (defun make-tar-file (system) "Make a tar file named SYSTEM-NAME_VERSION.tar containing all the files in SYSTEM. The file is created in the directory containing the system directory. Returns T on success" @@ -29,11 +44,11 @@ (mapcar (lambda (x) (enough-namestring x base-path)) (cons (truename (system-definition-pathname system)) - (list-files system))))) + (mapcar #'component-pathname (all-components system)))))) (= 0 (run-shell-command "cd ~A && tar cf ~A_~A.tar ~{~D ~}" (namestring base-path) (component-name system) (component-version system) - files)))) + (remove-if-not #'pathname-name files)))))