/[cmucl]/src/code/filesys.lisp
ViewVC logotype

Diff of /src/code/filesys.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.104.4.3 by rtoy, Thu Jun 19 03:30:44 2008 UTC revision 1.104.4.4 by rtoy, Mon Jun 23 15:03:31 2008 UTC
# Line 1068  optionally keeping some of the most rece Line 1068  optionally keeping some of the most rece
1068  ;;; DIRECTORY  --  public.  ;;; DIRECTORY  --  public.
1069  ;;;  ;;;
1070  (defun directory (pathname &key (all t) (check-for-subdirs t)  (defun directory (pathname &key (all t) (check-for-subdirs t)
1071                             (truenamep t) (follow-links t))                    (truenamep t) (follow-links t))
1072    "Returns a list of pathnames, one for each file that matches the given    "Returns a list of pathnames, one for each file that matches the given
1073     pathname.  Supplying :ALL as nil causes this to ignore Unix dot files.  This     pathname.  Supplying :ALL as nil causes this to ignore Unix dot files.  This
1074     never includes Unix dot and dot-dot in the result.  If :TRUENAMEP is NIL,     never includes Unix dot and dot-dot in the result.  If :TRUENAMEP is NIL,
# Line 1077  optionally keeping some of the most rece Line 1077  optionally keeping some of the most rece
1077     defined to be the TRUENAME of the pathname (the truename of a link may well     defined to be the TRUENAME of the pathname (the truename of a link may well
1078     be in another directory).  If FOLLOW-LINKS is NIL then symbolic links are     be in another directory).  If FOLLOW-LINKS is NIL then symbolic links are
1079     not followed."     not followed."
1080    (let ((results nil))    (flet ((ordered-strings-remove-duplicates (list)
1081      (enumerate-search-list             (let ((results '())
1082          (pathname (merge-pathnames pathname                   (prev nil))
1083                                     (make-pathname :name :wild               (dolist (elem list)
1084                                                    :type :wild                 (when (or (null prev)
1085                                                    :version :wild                           (not (string= elem prev)))
1086                                                    :defaults *default-pathname-defaults*)                   (push elem results))
1087                                     :wild))                 (setf prev elem))
1088        (enumerate-matches (name pathname nil :follow-links follow-links)               (nreverse results))))
1089          (when (or all      (let ((results nil))
1090                    (let ((slash (position #\/ name :from-end t)))        (enumerate-search-list
1091                      (or (null slash)            (pathname (merge-pathnames pathname
1092                          (= (1+ slash) (length name))                                       (make-pathname :name :wild
1093                          (char/= (schar name (1+ slash)) #\.))))                                                      :type :wild
1094            (push name results))))                                                      :version :wild
1095      (let ((*ignore-wildcards* t))                                                      :defaults *default-pathname-defaults*)
1096        (mapcar #'(lambda (name)                                       :wild))
1097                    (let ((name (if (and check-for-subdirs          (enumerate-matches (name pathname nil :follow-links follow-links)
1098                                         (eq (unix:unix-file-kind name)            (when (or all
1099                                             :directory))                      (let ((slash (position #\/ name :from-end t)))
1100                                    (concatenate 'string name "/")                        (or (null slash)
1101                                    name)))                            (= (1+ slash) (length name))
1102                      (if truenamep (truename name) (pathname name))))                            (char/= (schar name (1+ slash)) #\.))))
1103                (sort (delete-duplicates results :test #'string=) #'string<)))))              (push name results))))
1104          (let ((*ignore-wildcards* t))
1105            (mapcar #'(lambda (name)
1106                        (let ((name (if (and check-for-subdirs
1107                                             (eq (unix:unix-file-kind name)
1108                                                 :directory))
1109                                        (concatenate 'string name "/")
1110                                        name)))
1111                          (if truenamep (truename name) (pathname name))))
1112                    (ordered-strings-remove-duplicates (sort results #'string<)))))))
1113    
1114    
1115    
1116  ;;;; Printing directories.  ;;;; Printing directories.

Legend:
Removed from v.1.104.4.3  
changed lines
  Added in v.1.104.4.4

  ViewVC Help
Powered by ViewVC 1.1.5