New LS-CRLF? fluid controls whether LS terminates lines with CRLF.
This commit is contained in:
		
							parent
							
								
									d79f2cb360
								
							
						
					
					
						commit
						8c04b1b95e
					
				
							
								
								
									
										17
									
								
								ls.scm
								
								
								
								
							
							
						
						
									
										17
									
								
								ls.scm
								
								
								
								
							|  | @ -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))) | ||||||
|  | @ -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)) | ||||||
| 	 | 	 | ||||||
|  |  | ||||||
		Loading…
	
		Reference in New Issue
	
	 sperber
						sperber