ambrevar: Move walk and finder from shell to file.
parent
ce1733785d
commit
8d0ecf6a76
|
@ -102,3 +102,34 @@ This returns the directory name for directories."
|
||||||
:modification-date (local-time:unix-to-timestamp (osicat-posix:stat-mtime stat))
|
:modification-date (local-time:unix-to-timestamp (osicat-posix:stat-mtime stat))
|
||||||
:access-date (local-time:unix-to-timestamp (osicat-posix:stat-atime stat))
|
:access-date (local-time:unix-to-timestamp (osicat-posix:stat-atime stat))
|
||||||
:permissions (stat-permissions stat))))))
|
:permissions (stat-permissions stat))))))
|
||||||
|
|
||||||
|
(export-always '*finder-include-directories*)
|
||||||
|
(defvar *finder-include-directories* t
|
||||||
|
"When non-nil `walk' include directories.")
|
||||||
|
|
||||||
|
(export-always 'walk)
|
||||||
|
(defun walk (root &rest predicates)
|
||||||
|
"List FILES (including directories) that satisfy all PREDICATES.
|
||||||
|
Without PREDICATES, list all files."
|
||||||
|
(let ((result '()))
|
||||||
|
(uiop:collect-sub*directories
|
||||||
|
(uiop:ensure-directory-pathname root)
|
||||||
|
(constantly t) (constantly t)
|
||||||
|
(lambda (subdirectory)
|
||||||
|
(setf result (nconc result
|
||||||
|
(let ((subfiles (mapcar #'file (append (if *finder-include-directories* (list subdirectory) nil)
|
||||||
|
(uiop:directory-files subdirectory)))))
|
||||||
|
(if predicates
|
||||||
|
(delete-if (lambda (file)
|
||||||
|
(notany (lambda (pred) (funcall pred file))
|
||||||
|
predicates))
|
||||||
|
subfiles)
|
||||||
|
subfiles))))))
|
||||||
|
result))
|
||||||
|
|
||||||
|
(export-always 'finder)
|
||||||
|
(defun finder (root &rest predicates)
|
||||||
|
"List files in ROOT that satisfy all PREDICATES.
|
||||||
|
Without PREDICATES, list all files."
|
||||||
|
(let ((*finder-include-directories* nil))
|
||||||
|
(apply #'walk root predicates)))
|
||||||
|
|
|
@ -108,10 +108,6 @@ Useful for `walk'."
|
||||||
(lambda (file)
|
(lambda (file)
|
||||||
(ppcre:scan "application/x-sharedlib" (first (file-mime-type file)))))
|
(ppcre:scan "application/x-sharedlib" (first (file-mime-type file)))))
|
||||||
|
|
||||||
(export-always '*finder-include-directories*)
|
|
||||||
(defvar *finder-include-directories* t
|
|
||||||
"When non-nil `walk' include directories.")
|
|
||||||
|
|
||||||
(export-always 'directory-listing) ; TODO: Rename list-directory?
|
(export-always 'directory-listing) ; TODO: Rename list-directory?
|
||||||
(defun directory-listing (path &key sort?)
|
(defun directory-listing (path &key sort?)
|
||||||
"Return entries in PATH.
|
"Return entries in PATH.
|
||||||
|
@ -124,33 +120,6 @@ If SORT?, sort them alphabetically."
|
||||||
(sort result #'string< :key #'namestring)
|
(sort result #'string< :key #'namestring)
|
||||||
result)))
|
result)))
|
||||||
|
|
||||||
(export-always 'walk)
|
|
||||||
(defun walk (root &rest predicates)
|
|
||||||
"List files and directories that satisfy all PREDICATES.
|
|
||||||
Without PREDICATES, list all files."
|
|
||||||
(let ((result '()))
|
|
||||||
(uiop:collect-sub*directories
|
|
||||||
(uiop:ensure-directory-pathname root)
|
|
||||||
(constantly t) (constantly t)
|
|
||||||
(lambda (subdirectory)
|
|
||||||
(setf result (nconc result
|
|
||||||
(let ((subfiles (append (if *finder-include-directories* (list subdirectory) nil)
|
|
||||||
(uiop:directory-files subdirectory))))
|
|
||||||
(if predicates
|
|
||||||
(delete-if (lambda (file)
|
|
||||||
(notany (lambda (pred) (funcall pred file))
|
|
||||||
predicates))
|
|
||||||
subfiles)
|
|
||||||
subfiles))))))
|
|
||||||
result))
|
|
||||||
|
|
||||||
(export-always 'finder)
|
|
||||||
(defun finder (root &rest predicates)
|
|
||||||
"List files in ROOT that satisfy all PREDICATES.
|
|
||||||
Without PREDICATES, list all files."
|
|
||||||
(let ((*finder-include-directories* nil))
|
|
||||||
(apply #'walk root predicates)))
|
|
||||||
|
|
||||||
(export-always 'delete-empty-directory-upward)
|
(export-always 'delete-empty-directory-upward)
|
||||||
(defun delete-empty-directory-upward (directory)
|
(defun delete-empty-directory-upward (directory)
|
||||||
"Delete directory and its parents until non-empty.
|
"Delete directory and its parents until non-empty.
|
||||||
|
|
Loading…
Reference in New Issue