changelog shortlog graph tags branches changeset file revisions annotate raw help

Mercurial > core / lisp/std/file.lisp

revision 342: 254cca648492
parent 291: a0dfde3cb3c4
child 351: 770f2d03efd8
     1.1--- a/lisp/std/file.lisp	Mon May 13 18:40:39 2024 -0400
     1.2+++ b/lisp/std/file.lisp	Mon May 13 21:10:33 2024 -0400
     1.3@@ -397,14 +397,18 @@
     1.4   (and (not (pathname-name path))
     1.5        (not (pathname-type path))))
     1.6 
     1.7-(defun hidden-path-p (path)
     1.8-  "Return T if PATH is a hidden file or directory or NIL else."
     1.9+(defvar *hidden-paths* (list ".hg" ".git"))
    1.10+
    1.11+(defun hidden-path-p (path &optional strict)
    1.12+  "Return T if PATH is strictly a hidden file or directory or NIL else."
    1.13   (declare (type pathname path))
    1.14   (let ((name (if (directory-path-p path)
    1.15                   (car (last (pathname-directory path)))
    1.16                   (file-namestring path))))
    1.17     (and (plusp (length name))
    1.18-         (eq (char name 0) #\.))))
    1.19+         (if strict
    1.20+             (eq (char name 0) #\.)
    1.21+             (member name *hidden-paths* :test 'equal)))))
    1.22 
    1.23 (defun directory-path (path)
    1.24   "If PATH is a directory pathname, return it as it is. If it is a file
    1.25@@ -417,7 +421,7 @@
    1.26                                         (list (file-namestring path)))
    1.27                      :name nil :type nil :defaults path)))
    1.28 
    1.29-(defun find-files (path)
    1.30+(defun find-files (path &optional (hide *hidden-paths*))
    1.31   "Return a list of all files contained in the directory at PATH or any of its
    1.32 subdirectories."
    1.33   (declare (type (or pathname string) path))
    1.34@@ -428,7 +432,7 @@
    1.35     (let ((paths nil)
    1.36           (children (list-directory (directory-path path))))
    1.37       (dolist (child children paths)
    1.38-        (unless (hidden-path-p child)
    1.39+        (unless (and hide (hidden-path-p child (eq t hide)))
    1.40           (if (directory-path-p child)
    1.41               (setf paths (append paths (find-files child)))
    1.42               (push child paths)))))))