From dd2b8fe4e7d512e449a410238f9c87ce69d71566 Mon Sep 17 00:00:00 2001 From: Rahul Jain <> Date: Sat, 8 Jun 2002 15:55:00 +0000 Subject: [PATCH] wild-pathname-based modules for asdf. (:wild-module "name" :pathname "foo/*.bar" :component-class 'bar-file), e.g. --- test/wild-module.asd | 6 ++++++ test/wild-module.script | 7 +++++++ wild-modules.lisp | 35 +++++++++++++++++++++++++++++++++++ 3 files changed, 48 insertions(+) create mode 100644 test/wild-module.asd create mode 100644 test/wild-module.script create mode 100644 wild-modules.lisp diff --git a/test/wild-module.asd b/test/wild-module.asd new file mode 100644 index 00000000..8c090084 --- /dev/null +++ b/test/wild-module.asd @@ -0,0 +1,6 @@ +;;; -*- Lisp -*- + +(asdf:defsystem wild-module + :version "0.0" + :components ((:wild-module "systems" + :pathname "*.asd"))) diff --git a/test/wild-module.script b/test/wild-module.script new file mode 100644 index 00000000..d1b5d04d --- /dev/null +++ b/test/wild-module.script @@ -0,0 +1,7 @@ +;;; -*- Lisp -*- + +(load "../asdf") +(load "../wild-modules") + +(setf asdf:*central-registry* '(*default-pathname-defaults*)) +(asdf:oos 'asdf:load-op 'wild-module) diff --git a/wild-modules.lisp b/wild-modules.lisp new file mode 100644 index 00000000..0a7ea3f5 --- /dev/null +++ b/wild-modules.lisp @@ -0,0 +1,35 @@ +(in-package :asdf) + +(defclass wild-module (module) + ((component-class :accessor wild-module-component-class + :initform 'static-file :initarg :component-class) + (component-options :accessor wild-module-component-options + :initform nil :initarg :component-options))) + +(defmethod (setf module-components) (new-value (module wild-module)) + (declare (ignore new-value)) + (sysdef-error "Cannot explicitly set wild-module ~A's components. Please ~ +use a wild pathname instead." module)) + +(defmethod reinitialize-instance :after ((self wild-module) &key) + (let ((pathname (slot-value self 'relative-pathname))) + (and pathname + (not (wild-pathname-p pathname)) + (sysdef-error "Wild-module ~A specified with non-wild pathname ~A." + self pathname)) + (setf (slot-value self 'components) + (let* ((*default-pathname-defaults* (component-parent-pathname self)) + (files (directory (merge-pathnames (component-relative-pathname self)))) + (class (wild-module-component-class self)) + (options (wild-module-component-options self))) + (mapcar (lambda (file) + (apply #'make-instance class + :name (file-namestring file) + ;; XXX fails when wildcards are in + ;; the directory or higher parts. + :pathname file + :parent self + options)) + files))))) + +(export '(wild-module)) -- GitLab