Skip to content
Snippets Groups Projects
Commit 37c549c6 authored by Raymond Toy's avatar Raymond Toy
Browse files

Factor out the common part of pathname-match-p.

parent c07cad4b
No related branches found
No related tags found
No related merge requests found
...@@ -1219,7 +1219,22 @@ a host-structure or string." ...@@ -1219,7 +1219,22 @@ a host-structure or string."
(:version (frob (%pathname-version pathname))))))) (:version (frob (%pathname-version pathname)))))))
(defun %%pathname-match-p (pathname wildname)
(macrolet ((frob (field &optional (op 'components-match ))
`(or (null (,field wildname))
(,op (,field pathname) (,field wildname)))))
(and (or (null (%pathname-host wildname))
(eq (%pathname-host wildname) (%pathname-host pathname)))
(frob %pathname-device)
(frob %pathname-directory directory-components-match)
(frob %pathname-name)
(frob %pathname-type)
(frob %pathname-version))))
;; Like PATHNAME-MATCH-P but the pathnames should not be search-lists. ;; Like PATHNAME-MATCH-P but the pathnames should not be search-lists.
;; Primarily intended for TRANSLATE-LOGICAL-PATHNAME and friends,
;; because PATHNAME-MATCH-P calls TRANSLATE-LOGICAL-PATHNAME, causing
;; infinite recursion.
(defun %pathname-match-p (in-pathname in-wildname) (defun %pathname-match-p (in-pathname in-wildname)
"Pathname matches the wildname template?" "Pathname matches the wildname template?"
(declare (type path-designator in-pathname) (declare (type path-designator in-pathname)
...@@ -1228,16 +1243,7 @@ a host-structure or string." ...@@ -1228,16 +1243,7 @@ a host-structure or string."
(type (or string pathname) in-wildname)) (type (or string pathname) in-wildname))
(with-pathname (pathname in-pathname) (with-pathname (pathname in-pathname)
(with-pathname (wildname in-wildname) (with-pathname (wildname in-wildname)
(macrolet ((frob (field &optional (op 'components-match )) (%%pathname-match-p pathname wildname))))
`(or (null (,field wildname))
(,op (,field pathname) (,field wildname)))))
(and (or (null (%pathname-host wildname))
(eq (%pathname-host wildname) (%pathname-host pathname)))
(frob %pathname-device)
(frob %pathname-directory directory-components-match)
(frob %pathname-name)
(frob %pathname-type)
(frob %pathname-version))))))
;;; PATHNAME-MATCH-P -- Interface ;;; PATHNAME-MATCH-P -- Interface
;;; ;;;
...@@ -1251,17 +1257,8 @@ a host-structure or string." ...@@ -1251,17 +1257,8 @@ a host-structure or string."
(enumerate-search-list (pathname in-path) (enumerate-search-list (pathname in-path)
(with-pathname (in-wild in-wildname) (with-pathname (in-wild in-wildname)
(enumerate-search-list (wildname in-wild) (enumerate-search-list (wildname in-wild)
(macrolet ((frob (field &optional (op 'components-match )) (when (%%pathname-match-p pathname wildname)
`(or (null (,field wildname)) (return-from pathname-match-p pathname)))))))
(,op (,field pathname) (,field wildname)))))
(when (and (or (null (%pathname-host wildname))
(eq (%pathname-host wildname) (%pathname-host pathname)))
(frob %pathname-device)
(frob %pathname-directory directory-components-match)
(frob %pathname-name)
(frob %pathname-type)
(frob %pathname-version))
(return-from pathname-match-p pathname))))))))
;;; SUBSTITUTE-INTO -- Internal ;;; SUBSTITUTE-INTO -- Internal
......
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