Changeset 38262 in project


Ignore:
Timestamp:
03/15/20 01:35:21 (3 weeks ago)
Author:
Kon Lovett
Message:

add optional directory stack argument, reflow

Location:
release/5/directory-utils/trunk
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed
  • release/5/directory-utils/trunk/directory-utils.egg

    r38259 r38262  
    33
    44((synopsis "directory-utils")
    5  (version "2.1.0")
     5 (version "2.2.0")
    66 (category io)
    77 (author "[[kon lovett]]")
  • release/5/directory-utils/trunk/directory-utils.scm

    r38259 r38262  
    44;; Issues
    55;;
    6 ;; - See scattered 'FIXME' entries.
     6;; - Need a routine that provides filename and stat info to the fold func.
     7;; stat info: Posix + platform specific:
     8;; Windows Hidden attribute ...
     9;; macOS birthtime ...
    710
    811(module directory-utils
     
    1518  dot-filename-prefix?
    1619  dot-pathname? dot-filename?
     20  remove-dotfiles
    1721  ;
    1822  directory-fold
     
    3034  find-program-pathnames
    3135  which-command-pathnames
    32   which-command-pathname
    33   remove-dotfiles)
     36  which-command-pathname)
    3437
    3538(import scheme)
     
    160163;;
    161164
    162 ;FIXME need a routine that provides filename and stat info to the fold func.
    163 ;The stat info should include platform specific info as well: the Windows Hidden
    164 ;attribute, the MacOS X birthtime, etc.
    165 
    166165(: directory-fold (procedure * pathname #!rest -> *))
    167166;
    168167(define (directory-fold func ident dir . opts)
    169   (check-procedure 'directory-fold func)
    170   (let* (
    171     (dotfiles? (get-keyword #:dotfiles? opts (lambda () #f)))
    172     (dir (directory (check-directory 'directory-fold dir) dotfiles?)) )
    173     (fold func ident dir) ) )
     168  (let (
     169    (show-dotfiles? (get-keyword #:dotfiles? opts (lambda () #f))) )
     170    (fold
     171      (check-procedure 'directory-fold func)
     172      ident
     173      (directory (check-directory 'directory-fold dir) show-dotfiles?)) ) )
    174174
    175175;; Directory Stack
     
    188188    (string=? +dot-directory+ (make-pathname dir #f))) )
    189189
    190 (: push-directory ((or boolean pathname) -> void))
    191 ;
    192 (define (push-directory dir)
    193   (stack-push! (directory-utility-stack) (current-directory))
     190(: push-directory ((or boolean pathname) #!optional stack -> void))
     191;
     192(define (push-directory dir #!optional (dirstack (directory-utility-stack)))
     193  (stack-push! dirstack (current-directory))
    194194  ;don't cd unless necessary
    195195  (when (and dir (not (ignored-directory? dir)))
    196196    (change-directory dir) ) )
    197197
    198 (: pop-directory (-> void))
    199 ;
    200 (define (pop-directory)
    201   (unless (stack-empty? (directory-utility-stack))
    202     (change-directory (stack-pop! (directory-utility-stack))) ) )
    203 
    204 (: pop-toplevel-directory (-> void))
    205 ;
    206 (define (pop-toplevel-directory)
    207   (until (stack-empty? (directory-utility-stack))
    208     (pop-directory) ) )
     198(: pop-directory (#!optional stack -> void))
     199;
     200(define (pop-directory #!optional (dirstack (directory-utility-stack)))
     201  (unless (stack-empty? dirstack)
     202    (change-directory (stack-pop! dirstack)) ) )
     203
     204(: pop-toplevel-directory (#!optional stack -> void))
     205;
     206(define (pop-toplevel-directory #!optional (dirstack (directory-utility-stack)))
     207  (until (stack-empty? dirstack)
     208    (pop-directory dirstack) ) )
    209209
    210210;; Ensure the directory for the specified path exists.
     
    225225  (cond-expand
    226226    (windows
    227       (if (pathname-extension bn)
    228         bn
     227      (if (pathname-extension bn) bn
    229228        (make-pathname #f bn "exe")) )
    230229    (else
     
    236235  (cond-expand
    237236    (windows
    238       (if (pathname-extension bn)
    239         bn
     237      (if (pathname-extension bn) bn
    240238        (make-pathname #f bn "bat")) )
    241239    (else
    242       (if (pathname-extension bn)
    243         bn
     240      (if (pathname-extension bn) bn
    244241        (make-pathname #f bn "sh")) ) ) )
    245242
     
    249246;
    250247(define (file-exists-in-directory? fil . opts)
    251   (let* (
    252     (dir (optional opts #f))
    253     (path (make-pathname dir fil)) )
    254     (and (file-exists? path) path) ) )
     248  (let (
     249    (dir (optional opts #f)) )
     250    (let (
     251      (path (make-pathname dir fil)) )
     252      (and (file-exists? path) path) ) ) )
    255253
    256254;; List of all found pathnames.
     
    266264;
    267265(define (*find-file-pathnames fil dirs)
    268   (let loop ((dirs dirs) (paths '()))
    269     (if (null? dirs)
    270       (not-null? paths)
     266  (let loop (
     267    (dirs dirs)
     268    (paths '()) )
     269    (if (null? dirs) (not-null? paths)
    271270      (loop
    272271        (cdr dirs)
     
    287286  (cond-expand
    288287    (windows
    289       (if (pathname-extension cmd)
    290         (*find-file-pathnames cmd dirs)
     288      (if (pathname-extension cmd) (*find-file-pathnames cmd dirs)
    291289        (let (
    292290          (founds
     
    317315    (varnam (optional opts "PATH")) )
    318316    (and-let* (
    319       (ps (which-command-pathnames cmd varnam)) )
     317      (ps (which-command-pathnames cmd varnam))
     318      ((not (zero? (length ps)))) )
    320319      (first ps) ) ) )
    321320
  • release/5/directory-utils/trunk/tests/directory-utils-test.scm

    r35988 r38262  
    44(import test)
    55
     6(include "test-gloss.incl")
     7
    68(test-begin "Directory Utils")
    79
     10(import directory-utils)
     11
    812;;;
    9 
    10 (import (chicken fixnum) directory-utils)
    1113
    1214(test-assert (pathname? "abc/cbs.foo"))
     
    3537(test-assert (not (which-command-pathnames "93274030#$%)#)$()")))
    3638
     39;run.scm test-gloss.incl.scm directory-utils-test.scm
    3740(cond-expand
    38   (compiling  (define-constant TESTS-DIRECTORY-COUNT 3))
    39   (else       (define-constant TESTS-DIRECTORY-COUNT 2)) )
     41  (compiling  (define-constant TESTS-DIRECTORY-COUNT 4))
     42  (else       (define-constant TESTS-DIRECTORY-COUNT 3)) )
    4043
    4144(test "directory-fold tests"
    4245  TESTS-DIRECTORY-COUNT
    43   (directory-fold (lambda (fn ct) (fx+ ct 1)) 0 "." #:dotfiles? #f))
     46  (directory-fold (lambda (fn ct) (add1 ct)) 0 "." #:dotfiles? #f))
    4447
    4548(test-assert (push-directory ".."))
     
    4851(define-constant EGG-DIRECTORY-COUNT 3)
    4952
    50 (let ((dotno (directory-fold (lambda (fn ct) (fx+ ct 1)) 0 "." #:dotfiles? #f)))
    51   (test-assert "directory-fold tests/.." (<= EGG-DIRECTORY-COUNT dotno)) )
     53(let ((fns (directory-fold cons '() "." #:dotfiles? #t)))
     54  (glossf "Files: ~A" fns)
     55  (test-assert "directory-fold tests/.." (<= EGG-DIRECTORY-COUNT (length fns))) )
    5256
    53 (test-assert (pop-toplevel-directory)) ;(pop-directory)
     57;NOTE at this point the same
     58(test-assert (pop-directory))
     59;(test-assert (pop-toplevel-directory))
    5460
    5561;;;
  • release/5/directory-utils/trunk/tests/run.scm

    r35988 r38262  
    44;chicken-install invokes as "<csi> -s run.scm <eggnam> <eggdir>"
    55
    6 (import
    7   (only (chicken pathname) make-pathname)
    8   (only (chicken process) system)
    9   (only (chicken process-context) argv)
    10   (only (chicken format) format))
     6(import (only (chicken pathname) make-pathname))
     7(import (only (chicken process) system))
     8(import (only (chicken process-context) argv))
     9(import (only (chicken format) format))
    1110
    1211(define *args* (argv))
Note: See TracChangeset for help on using the changeset viewer.