cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

filesystem.lisp (2638B)

      1 ;;; Copyright (C) 2013, 2014 Tomas Hlavaty <tom@logand.com>
      2 ;;;
      3 ;;; Permission is hereby granted, free of charge, to any person
      4 ;;; obtaining a copy of this software and associated documentation
      5 ;;; files (the "Software"), to deal in the Software without
      6 ;;; restriction, including without limitation the rights to use, copy,
      7 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
      8 ;;; of the Software, and to permit persons to whom the Software is
      9 ;;; furnished to do so, subject to the following conditions:
     10 ;;;
     11 ;;; The above copyright notice and this permission notice shall be
     12 ;;; included in all copies or substantial portions of the Software.
     13 ;;;
     14 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
     15 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
     16 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
     17 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
     18 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
     19 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
     20 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
     21 ;;; DEALINGS IN THE SOFTWARE.
     22 
     23 (defpackage :rw.filesystem
     24   (:use :cl)
     25   (:export :directory-reader
     26            :file-reader))
     27 
     28 (in-package :rw.filesystem)
     29 
     30 (defun %directoryp (pathname)
     31   (equal (directory-namestring pathname) (namestring pathname)))
     32 
     33 (defun directory-reader (pathname &optional recurse)
     34   (when (%directoryp pathname)
     35     (flet ((expand (x) (directory (merge-pathnames "*" #+nil "*.*" x))))
     36       (let ((stack (list (expand pathname))))
     37         (lambda ()
     38           (when stack
     39             (let ((x (pop (car stack))))
     40               (unless (car stack)
     41                 (pop stack))
     42               (prog1 x
     43                 (when (and x recurse (%directoryp x))
     44                   (let ((y (expand x)))
     45                     (when y
     46                       (push y stack))))))))))))
     47 
     48 ;;(rw:till (rw:peek-reader (directory-reader "~/Mail/")))
     49 ;;(rw:till (rw:peek-reader (directory-reader "~/News/")))
     50 ;;(rw:till (rw:peek-reader (directory-reader "~/News/" t)))
     51 ;;(rw:till (rw:peek-reader (directory-reader "/tmp/")))
     52 ;;(rw:till (rw:peek-reader (directory-reader "/tmp/" t)))
     53 
     54 #+nil
     55 (defun directory-reader (reader)
     56   (lambda ()
     57     (do ((x (rw:next reader) (rw:next reader)))
     58         ((or (not x) (%directoryp x)) x))))
     59 
     60 #+nil
     61 (defun file-reader (reader)
     62   (lambda ()
     63     (do ((x (rw:next reader) (rw:next reader)))
     64         ((or (not x) (not (%directoryp x))) x))))
     65 
     66 ;;(till (rw:peek-reader (directory-reader (dir-reader "/tmp/" t))))
     67 ;;(till (rw:peek-reader (file-reader (dir-reader "/tmp/" t))))