/[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.56 by pw, Thu Jun 3 15:55:49 1999 UTC revision 1.57 by dtc, Wed Aug 23 15:52:46 2000 UTC
# Line 499  Line 499 
499  ;;;; Wildcard matching stuff.  ;;;; Wildcard matching stuff.
500    
501  (defmacro enumerate-matches ((var pathname &optional result  (defmacro enumerate-matches ((var pathname &optional result
502                                    &key (verify-existance t))                                    &key (verify-existance t) (follow-links t))
503                               &body body)                               &body body)
504    (let ((body-name (gensym)))    (let ((body-name (gensym)))
505      `(block nil      `(block nil
506         (flet ((,body-name (,var)         (flet ((,body-name (,var)
507                  ,@body))                  ,@body))
508           (%enumerate-matches (pathname ,pathname)           (%enumerate-matches (pathname ,pathname)
509                               ,verify-existance                               ,verify-existance ,follow-links
510                               #',body-name)                               #',body-name)
511           ,result))))           ,result))))
512    
513  (defun %enumerate-matches (pathname verify-existance function)  (defun %enumerate-matches (pathname verify-existance follow-links function)
514    (when (pathname-type pathname)    (when (pathname-type pathname)
515      (unless (pathname-name pathname)      (unless (pathname-name pathname)
516        (error "Cannot supply a type without a name:~%  ~S" pathname)))        (error "Cannot supply a type without a name:~%  ~S" pathname)))
# Line 522  Line 522 
522          (ecase (car directory)          (ecase (car directory)
523            (:absolute            (:absolute
524             (%enumerate-directories "/" (cdr directory) pathname             (%enumerate-directories "/" (cdr directory) pathname
525                                     verify-existance function))                                     verify-existance follow-links
526                                       nil function))
527            (:relative            (:relative
528             (%enumerate-directories "" (cdr directory) pathname             (%enumerate-directories "" (cdr directory) pathname
529                                     verify-existance function)))                                     verify-existance follow-links
530                                       nil function)))
531          (%enumerate-files "" pathname verify-existance function))))          (%enumerate-files "" pathname verify-existance function))))
532    
533  (defun %enumerate-directories (head tail pathname verify-existance function)  ;;; %enumerate-directories  --   Internal
534    ;;;
535    ;;; The directory node and device numbers are maintained for the current path
536    ;;; during the search for the detection of paths loops upon :wild-inferiors.
537    ;;;
538    (defun %enumerate-directories (head tail pathname verify-existance
539                                   follow-links nodes function)
540    (declare (simple-string head))    (declare (simple-string head))
541    (if tail    (macrolet ((unix-xstat (name)
542        (let ((piece (car tail)))                 `(if follow-links
543          (etypecase piece                      (unix:unix-stat ,name)
544            (simple-string                      (unix:unix-lstat ,name)))
545             (%enumerate-directories (concatenate 'string head piece "/")               (with-directory-node-noted ((head) &body body)
546                                     (cdr tail) pathname verify-existance                 `(multiple-value-bind (res dev ino mode)
547                                     function))                      (unix-xstat ,head)
548            ((or pattern (member :wild :wild-inferiors))                    (when (and res (eql (logand mode unix:s-ifmt) unix:s-ifdir))
549             (let ((dir (unix:open-dir head)))                      (let ((nodes (cons (cons dev ino) nodes)))
550               (when dir                        ,@body))))
551                 (unwind-protect               (do-directory-entries ((name directory) &body body)
552                     (loop                 `(let ((dir (unix:open-dir ,directory)))
553                       (let ((name (unix:read-dir dir)))                    (when dir
554                         (cond ((null name)                      (unwind-protect
555                                (return))                           (loop
556                               ((string= name "."))                            (let ((,name (unix:read-dir dir)))
557                               ((string= name ".."))                              (cond ((null ,name)
558                               ((pattern-matches piece name)                                     (return))
559                                (let ((subdir (concatenate 'string                                    ((string= ,name "."))
560                                                           head name "/")))                                    ((string= ,name ".."))
561                                  (when (eq (unix:unix-file-kind subdir)                                    (t
562                                            :directory)                                     ,@body))))
563                                    (%enumerate-directories                        (unix:close-dir dir))))))
564                                     subdir (cdr tail) pathname verify-existance      (if tail
565                                     function)))))))          (let ((piece (car tail)))
566                   (unix:close-dir dir)))))            (etypecase piece
567            ((member :up)              (simple-string
568             (%enumerate-directories (concatenate 'string head "../")               (let ((head (concatenate 'string head piece)))
569                                     (cdr tail) pathname verify-existance                 (with-directory-node-noted (head)
570                                     function))))                   (%enumerate-directories (concatenate 'string head "/")
571        (%enumerate-files head pathname verify-existance function)))                                           (cdr tail) pathname
572                                             verify-existance follow-links
573                                             nodes function))))
574                ((member :wild-inferiors)
575                 (%enumerate-directories head (rest tail) pathname
576                                         verify-existance follow-links
577                                         nodes function)
578                 (do-directory-entries (name head)
579                   (let ((subdir (concatenate 'string head name)))
580                     (multiple-value-bind (res dev ino mode)
581                         (unix-xstat subdir)
582                       (declare (type (or fixnum null) mode))
583                       (when (and res (eql (logand mode unix:s-ifmt) unix:s-ifdir))
584                         (unless (dolist (dir nodes nil)
585                                   (when (and (eql (car dir) dev)
586                                              (eql (cdr dir) ino))
587                                     (return t)))
588                           (let ((nodes (cons (cons dev ino) nodes))
589                                 (subdir (concatenate 'string subdir "/")))
590                             (%enumerate-directories subdir tail pathname
591                                                     verify-existance follow-links
592                                                     nodes function))))))))
593                ((or pattern (member :wild))
594                 (do-directory-entries (name head)
595                   (when (or (eq piece :wild) (pattern-matches piece name))
596                     (let ((subdir (concatenate 'string head name)))
597                       (multiple-value-bind (res dev ino mode)
598                           (unix-xstat subdir)
599                         (declare (type (or fixnum null) mode))
600                         (when (and res
601                                    (eql (logand mode unix:s-ifmt) unix:s-ifdir))
602                           (let ((nodes (cons (cons dev ino) nodes))
603                                 (subdir (concatenate 'string subdir "/")))
604                             (%enumerate-directories subdir (rest tail) pathname
605                                                     verify-existance follow-links
606                                                     nodes function))))))))
607                ((member :up)
608                 (let ((head (concatenate 'string head "..")))
609                   (with-directory-node-noted (head)
610                     (%enumerate-directories (concatenate 'string head "/")
611                                             (rest tail) pathname
612                                             verify-existance follow-links
613                                             nodes function))))))
614            (%enumerate-files head pathname verify-existance function))))
615    
616  (defun %enumerate-files (directory pathname verify-existance function)  (defun %enumerate-files (directory pathname verify-existance function)
617    (declare (simple-string directory))    (declare (simple-string directory))
# Line 651  Line 702 
702    (enumerate-search-list    (enumerate-search-list
703        (pathname path)        (pathname path)
704      (collect ((names))      (collect ((names))
705        (enumerate-matches (name pathname nil :verify-existance for-input)        (enumerate-matches (name pathname nil :verify-existance for-input
706                                   :follow-links t)
707          (when (or (not executable-only)          (when (or (not executable-only)
708                    (and (eq (unix:unix-file-kind name) :file)                    (and (eq (unix:unix-file-kind name) :file)
709                         (unix:unix-access name unix:x_ok)))                         (unix:unix-access name unix:x_ok)))
# Line 831  Line 883 
883                                     (make-pathname :name :wild                                     (make-pathname :name :wild
884                                                    :type :wild                                                    :type :wild
885                                                    :version :wild)))                                                    :version :wild)))
886        (enumerate-matches (name pathname)        (enumerate-matches (name pathname nil :follow-links follow-links)
887          (when (or all          (when (or all
888                    (let ((slash (position #\/ name :from-end t)))                    (let ((slash (position #\/ name :from-end t)))
889                      (or (null slash)                      (or (null slash)

Legend:
Removed from v.1.56  
changed lines
  Added in v.1.57

  ViewVC Help
Powered by ViewVC 1.1.5