From 8466d8cfa486fb30d1755c4261b781135083787b Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:29 -0800 Subject: Import Upstream version 3a1 --- lineio.scm | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) (limited to 'lineio.scm') diff --git a/lineio.scm b/lineio.scm index 38a7b87..cfffd33 100644 --- a/lineio.scm +++ b/lineio.scm @@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; @@ -17,6 +17,7 @@ ;promotional, or sales literature without prior written consent in ;each case. +(require-if 'compiling 'filename) ;;@args ;;@args port @@ -63,20 +64,25 @@ ;;Writes @1 followed by a newline to the given @var{port} and returns ;;an unspecified value. The @var{Port} argument may be omitted, in ;;which case it defaults to the value returned by -;;@code{current-input-port}.@refill +;;@code{current-input-port}. (define (write-line str . port) (apply display str port) (apply newline port)) -;;@args path -;;@args path port -;;Displays the contents of the file named by @1 to @var{port}. The -;;@var{port} argument may be ommited, in which case it defaults to the -;;value returned by @code{current-output-port}. -(define (display-file path . port) - (set! port (if (null? port) (current-output-port) (car port))) - (call-with-input-file path - (lambda (inport) - (do ((line (read-line inport) (read-line inport))) - ((eof-object? line)) - (write-line line port))))) +;;@args command tmp +;;@args command +;;@1 must be a string. The string @2, if supplied, is a path to use as +;;a temporary file. @0 calls @code{system} with @1 as argument, +;;redirecting stdout to file @2. @0 returns a string containing the +;;first line of output from @2. +(define (system->line command . tmp) + (require 'filename) + (cond ((null? tmp) + (call-with-tmpnam + (lambda (tmp) (system->line command tmp)))) + (else + (set! tmp (car tmp)) + (and (zero? (system (string-append command " > " tmp))) + (file-exists? tmp) + (let ((line (call-with-input-file tmp read-line))) + (if (eof-object? line) "" line)))))) -- cgit v1.2.3