support :wild-inferiors in DIRECTORY and use PATHNAME-MATCH-P to filt…

…er pathnames

cl-files.el

@@ -8,11 +8,55 @@
 (defun file-error (pathname)
   (ERROR 'FILE-ERROR (kw PATHNAME) pathname))
 
-(defun DIRECTORY (pathspec)
-  ;; TODO: A more correct implementation would walk through the result of
-  ;; (directory-files pathspec) and filter out all that matches pathspec.
-  ;; PATHNAME-MATCH-P.
-  (mapcar #'PATHNAME (file-expand-wildcards (NAMESTRING pathspec))))
+(defun wild-directories (name dir pathname files)
+  (if (null dir)
+      (nconc (DIRECTORY (MERGE-PATHNAMES name pathname)) files)
+      (let ((component (first dir)))
+	(setq dir (rest dir))
+	(cond
+	  ((eq component (kw WILD))
+	   (dolist (file (directory-files name) files)
+	     (unless (or (string= file ".") (string= file ".."))
+	       (setq file (concat name file "/"))
+	       (when (file-directory-p file)
+		 (setq files (wild-directories file dir pathname files))))))
+	  ((eq component (kw WILD-INFERIORS))
+	   (setq files (wild-directories name dir pathname files))
+	   (dolist (file (directory-files name) files)
+	     (unless (or (string= file ".") (string= file ".."))
+	       (setq file (concat name file "/"))
+	       (when (file-directory-p file)
+		 (setq files (wild-directories
+			      file (cons (kw WILD-INFERIORS) dir)
+			      pathname files))))))
+	  ((eq component (kw UP))
+	   (wild-directories (concat name "../") dir pathname files))
+	  ((eq component (kw BACK))
+	   (ERROR ":BACK isn't supported"))
+	  (t
+	   (let ((file (concat name component "/")))
+	     (if (file-directory-p file)
+		 (wild-directories file dir pathname files)
+		 files)))))))
+
+(defun DIRECTORY (pathname-designator)
+  (let ((pathname (PATHNAME pathname-designator)))
+    (if (WILD-PATHNAME-P pathname (kw DIRECTORY))
+	(let* ((dir (PATHNAME-DIRECTORY pathname))
+	       (x (pop dir))
+	       (name (cond
+		       ((eq x (kw ABSOLUTE)) "/")
+		       ((or (null x) (eq x (kw RELATIVE))) "./")
+		       (t (error "error")))))
+	  (wild-directories name dir pathname nil))
+	(let ((result nil)
+	      (dir (MAKE-PATHNAME (kw DIRECTORY)
+				  (PATHNAME-DIRECTORY pathname))))
+	  (dolist (file (directory-files (DIRECTORY-NAMESTRING pathname)))
+	    (setq file (MERGE-PATHNAMES file dir))
+	    (when (PATHNAME-MATCH-P file pathname)
+	      (push file result)))
+	  result))))
 
 (defun PROBE-FILE (pathspec)
   ;; TODO...
@@ -21,7 +65,7 @@
       nil))
 
 (defun ENSURE-DIRECTORIES-EXIST (pathspec &optional verbose)
-  (let ((dir (file-name-directory pathspec)))
+  (let ((dir (file-name-directory (NAMESTRING pathspec))))
     (cl:values pathspec
 	       (if (file-exists-p dir)
 		   (progn (make-directory dir t) T)