diff --git a/ls.scm b/ls.scm index a22de7e..9979bef 100644 --- a/ls.scm +++ b/ls.scm @@ -16,6 +16,8 @@ ; flag - flag files as per their types ; columns - sorts output vertically in a multicolumn format +(define ls-crlf? (make-fluid #f)) + (define (ls flags paths . maybe-port) (let* ((port (optional maybe-port (current-output-port))) (paths (if (null? paths) @@ -47,7 +49,7 @@ (lambda (path) (if first (set! first #f) - (newline port)) + (ls-newline port)) (if prefix (format port "~A~A:~%" prefix path)) (ls-path path all? recursive? long? directory? flag? columns? port)) @@ -96,7 +98,7 @@ files)))) (if (not (null? directories)) (begin - (newline port) + (ls-newline port) (real-ls directories directory all? recursive? long? directory? flag? columns? port)))))))))) @@ -143,7 +145,7 @@ (width (display-file file flag? port))) (display-spaces (- column-width width) port) (vector-set! tails column (cdr tail)))))) - (newline port)))) + (ls-newline port)))) (define (list-tail-or-null list index) (let loop ((list list) (index index)) @@ -165,7 +167,7 @@ (define (ls-file-short file flag? port) (display-file file flag? port) - (newline port)) + (ls-newline port)) (define (ls-file-long file flag? port) (let ((info (cdr file))) @@ -201,7 +203,7 @@ (begin (display " -> " port) (display (read-symlink (car file)) port))) - (newline port))) + (ls-newline port))) (define *year-seconds* (* 365 24 60 60)) @@ -323,3 +325,8 @@ ((null? maybe-arg) default-exp) ((null? (cdr maybe-arg)) (car maybe-arg)) (else (error "too many optional arguments" maybe-arg)))) + +(define (ls-newline port) + (if (fluid ls-crlf?) + (write-crlf port) + (newline port))) \ No newline at end of file diff --git a/modules.scm b/modules.scm index ed7dfac..54865c7 100644 --- a/modules.scm +++ b/modules.scm @@ -480,12 +480,15 @@ (define-interface ls-interface - (export ls + (export ls-crlf? + ls arguments->ls-flags)) (define-structure ls ls-interface (open scheme handle big-scheme bitwise + fluids + crlf-io scsh) (files ls))