+(defparameter *wild-asd*
+ (make-pathname :directory nil :name :wild :type "asd" :version :newest))
+
+(defun directory-has-asd-files-p (directory)
+ (and (ignore-errors
+ (directory (merge-pathnames* *wild-asd* directory)
+ #+sbcl #+sbcl :resolve-symlinks nil
+ #+ccl #+ccl :follow-links nil
+ #+clisp #+clisp :circle t))
+ t))
+
+(defun subdirectories (directory)
+ (let* ((directory (ensure-directory-pathname directory))
+ #-cormanlisp
+ (wild (merge-pathnames*
+ #-(or abcl allegro lispworks scl)
+ (make-pathname :directory '(:relative :wild) :name nil :type nil :version nil)
+ #+(or abcl allegro lispworks scl) "*.*"
+ directory))
+ (dirs
+ #-cormanlisp
+ (ignore-errors
+ (directory wild .
+ #.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil)
+ #+ccl '(:follow-links nil :directories t :files nil)
+ #+clisp '(:circle t :if-does-not-exist :ignore)
+ #+(or cmu scl) '(:follow-links nil :truenamep nil)
+ #+digitool '(:directories t)
+ #+sbcl '(:resolve-symlinks nil))))
+ #+cormanlisp (cl::directory-subdirs directory))
+ #+(or abcl allegro lispworks scl)
+ (dirs (remove-if-not #+abcl #'extensions:probe-directory
+ #+allegro #'excl:probe-directory
+ #+lispworks #'lw:file-directory-p
+ #-(or abcl allegro lispworks) #'directory-pathname-p
+ dirs)))
+ dirs))
+
+(defun collect-sub*directories (directory collectp recursep collector)
+ (when (funcall collectp directory)
+ (funcall collector directory))
+ (dolist (subdir (subdirectories directory))
+ (when (funcall recursep subdir)
+ (collect-sub*directories subdir collectp recursep collector))))
+
+(defun collect-sub*directories-with-asd
+ (directory &key
+ (exclude *default-source-registry-exclusions*)
+ collect)
+ (collect-sub*directories
+ directory
+ #'directory-has-asd-files-p
+ #'(lambda (x) (not (member (car (last (pathname-directory x))) exclude :test #'equal)))
+ collect))
+