From 37c549c63657ba79d4b6a806359da7daaa6908d5 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Sun, 4 Sep 2016 13:43:03 -0700 Subject: [PATCH] Factor out the common part of pathname-match-p. --- src/code/pathname.lisp | 39 ++++++++++++++++++--------------------- 1 file changed, 18 insertions(+), 21 deletions(-) diff --git a/src/code/pathname.lisp b/src/code/pathname.lisp index 44ac9019c..12f627f51 100644 --- a/src/code/pathname.lisp +++ b/src/code/pathname.lisp @@ -1219,7 +1219,22 @@ a host-structure or string." (: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. +;; 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) "Pathname matches the wildname template?" (declare (type path-designator in-pathname) @@ -1228,16 +1243,7 @@ a host-structure or string." (type (or string pathname) in-wildname)) (with-pathname (pathname in-pathname) (with-pathname (wildname in-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)))))) + (%%pathname-match-p pathname wildname)))) ;;; PATHNAME-MATCH-P -- Interface ;;; @@ -1251,17 +1257,8 @@ a host-structure or string." (enumerate-search-list (pathname in-path) (with-pathname (in-wild in-wildname) (enumerate-search-list (wildname in-wild) - (macrolet ((frob (field &optional (op 'components-match )) - `(or (null (,field wildname)) - (,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)))))))) + (when (%%pathname-match-p pathname wildname) + (return-from pathname-match-p pathname))))))) ;;; SUBSTITUTE-INTO -- Internal -- GitLab