wild(carded)-modules for asdf

Rahul Jain <[email protected]> 08 Jun 2002 03:26:34 -0400

Newsgroups	gmane.lisp.cclan.general
Message-ID	<[email protected]>

I've implemented modules which take their components from a
wild-pathname, seemingly. It was quite simple (once I passed a parent
keyword arg to make-instance for the sub-components...) to
implement. Good work, Dan. :)

Attached is the file that implements this extension as well as a test
defsystem and script to run that test.

Share and Enjoy.


-- 
-> -/                        - Rahul Jain -                        \- <-
-> -\  http://linux.rice.edu/~rahul -=-  mailto:[email protected]   /- <-
-> -X "Structure is nothing if it is all you got. Skeletons spook  X- <-
-> -/  people if [they] try to walk around on their own. I really  \- <-
-> -\  wonder why XML does not." -- Erik Naggum, comp.lang.lisp    /- <-
|--|--------|--------------|----|-------------|------|---------|-----|-|
   (c)1996-2002, All rights reserved. Disclaimer available upon request.

wild-modules.lisp (text/x-lisp, 1.6 KB)

(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))

wild-module.asd (text/x-lisp, 152 B)

;;; -*- Lisp -*-

(asdf:defsystem wild-module
  :version "0.0"
  :components ((:wild-module "systems"
                             :pathname "*.asd")))

wild-module.script (text/x-lisp, 161 B)

;;; -*- Lisp -*-

(load "../asdf")
(load "../wild-modules")

(setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:oos 'asdf:load-op 'wild-module)