New LS-CRLF? fluid controls whether LS terminates lines with CRLF.

This commit is contained in:
sperber 2002-02-20 13:40:09 +00:00
parent d79f2cb360
commit 8c04b1b95e
2 changed files with 16 additions and 6 deletions

17
ls.scm
View File

@ -16,6 +16,8 @@
; flag - flag files as per their types ; flag - flag files as per their types
; columns - sorts output vertically in a multicolumn format ; columns - sorts output vertically in a multicolumn format
(define ls-crlf? (make-fluid #f))
(define (ls flags paths . maybe-port) (define (ls flags paths . maybe-port)
(let* ((port (optional maybe-port (current-output-port))) (let* ((port (optional maybe-port (current-output-port)))
(paths (if (null? paths) (paths (if (null? paths)
@ -47,7 +49,7 @@
(lambda (path) (lambda (path)
(if first (if first
(set! first #f) (set! first #f)
(newline port)) (ls-newline port))
(if prefix (if prefix
(format port "~A~A:~%" prefix path)) (format port "~A~A:~%" prefix path))
(ls-path path all? recursive? long? directory? flag? columns? port)) (ls-path path all? recursive? long? directory? flag? columns? port))
@ -96,7 +98,7 @@
files)))) files))))
(if (not (null? directories)) (if (not (null? directories))
(begin (begin
(newline port) (ls-newline port)
(real-ls directories directory (real-ls directories directory
all? recursive? long? directory? flag? columns? all? recursive? long? directory? flag? columns?
port)))))))))) port))))))))))
@ -143,7 +145,7 @@
(width (display-file file flag? port))) (width (display-file file flag? port)))
(display-spaces (- column-width width) port) (display-spaces (- column-width width) port)
(vector-set! tails column (cdr tail)))))) (vector-set! tails column (cdr tail))))))
(newline port)))) (ls-newline port))))
(define (list-tail-or-null list index) (define (list-tail-or-null list index)
(let loop ((list list) (index index)) (let loop ((list list) (index index))
@ -165,7 +167,7 @@
(define (ls-file-short file flag? port) (define (ls-file-short file flag? port)
(display-file file flag? port) (display-file file flag? port)
(newline port)) (ls-newline port))
(define (ls-file-long file flag? port) (define (ls-file-long file flag? port)
(let ((info (cdr file))) (let ((info (cdr file)))
@ -201,7 +203,7 @@
(begin (begin
(display " -> " port) (display " -> " port)
(display (read-symlink (car file)) port))) (display (read-symlink (car file)) port)))
(newline port))) (ls-newline port)))
(define *year-seconds* (* 365 24 60 60)) (define *year-seconds* (* 365 24 60 60))
@ -323,3 +325,8 @@
((null? maybe-arg) default-exp) ((null? maybe-arg) default-exp)
((null? (cdr maybe-arg)) (car maybe-arg)) ((null? (cdr maybe-arg)) (car maybe-arg))
(else (error "too many optional arguments" maybe-arg)))) (else (error "too many optional arguments" maybe-arg))))
(define (ls-newline port)
(if (fluid ls-crlf?)
(write-crlf port)
(newline port)))

View File

@ -480,12 +480,15 @@
(define-interface ls-interface (define-interface ls-interface
(export ls (export ls-crlf?
ls
arguments->ls-flags)) arguments->ls-flags))
(define-structure ls ls-interface (define-structure ls ls-interface
(open scheme handle (open scheme handle
big-scheme bitwise big-scheme bitwise
fluids
crlf-io
scsh) scsh)
(files ls)) (files ls))