Skip to content
Snippets Groups Projects
Commit 4c2ed092 authored by Daniel Barlow's avatar Daniel Barlow
Browse files

new exported functions all-components, cvs-tag

parent 7c4fa09f
No related branches found
No related tags found
No related merge requests found
(in-package :cl-user) (in-package :cl-user)
(defpackage :cclan (:use #:cl #:asdf) (defpackage :cclan (:use #:cl #:asdf)
(:export #:make-tar-file)) (:export #:all-components #:cvs-tag #:make-tar-file))
...@@ -4,6 +4,9 @@ ...@@ -4,6 +4,9 @@
;;;; asdf itself, but extend it in various ways useful for maintainers ;;;; asdf itself, but extend it in various ways useful for maintainers
;;;; of new-style cCLan packages ;;;; 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 ;;;; This file does not contain references to asdf internals - or
;;;; shouldn't, anyway. Send bug reports ;;;; shouldn't, anyway. Send bug reports
...@@ -12,11 +15,23 @@ ...@@ -12,11 +15,23 @@
(let ((f (coerce function 'function))) (let ((f (coerce function 'function)))
(loop for i in list append (funcall f i)))) (loop for i in list append (funcall f i))))
(defgeneric list-files (component)) (defgeneric all-components (component))
(defmethod list-files ((c source-file)) (defmethod all-components ((source-file source-file))
(list (component-pathname c))) (list source-file))
(defmethod list-files ((c module))
(mapappend 'list-files (module-components c))) (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) (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" "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 @@ ...@@ -29,11 +44,11 @@
(mapcar (lambda (x) (enough-namestring x base-path)) (mapcar (lambda (x) (enough-namestring x base-path))
(cons (cons
(truename (system-definition-pathname system)) (truename (system-definition-pathname system))
(list-files system))))) (mapcar #'component-pathname (all-components system))))))
(= 0 (= 0
(run-shell-command "cd ~A && tar cf ~A_~A.tar ~{~D ~}" (run-shell-command "cd ~A && tar cf ~A_~A.tar ~{~D ~}"
(namestring base-path) (namestring base-path)
(component-name system) (component-name system)
(component-version system) (component-version system)
files)))) (remove-if-not #'pathname-name files)))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment