X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=io.lisp;h=6df15953c7b533c32a320a612c4b6481137a0a25;hp=68a6bc23cd9a8ab956d6f19ebc3db815d0870f61;hb=969fdba72abb830cd8fff86cc77c21b4a7da3620;hpb=e45bcc21473cb56f074ba85bcef89ebae5851ced diff --git a/io.lisp b/io.lisp index 68a6bc2..6df1595 100644 --- a/io.lisp +++ b/io.lisp @@ -9,7 +9,7 @@ ;;;; ;;;; $Id$ ;;;; -;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg ;;;; ;;;; KMRCL users are granted the rights to distribute and use this software ;;;; as governed by the terms of the Lisp Lesser GNU Public License @@ -21,33 +21,41 @@ (defun print-file-contents (file &optional (strm *standard-output*)) "Opens a reads a file. Returns the contents as a single string" (when (probe-file file) - (with-open-file (in file :direction :input) - (let ((eof (gensym))) - (do ((line (read-line in nil eof) - (read-line in nil eof))) - ((eq line eof)) - (format strm "~A~%" line)))))) - + (let ((eof (cons 'eof nil))) + (with-open-file (in file :direction :input) + (do ((line (read-line in nil eof) + (read-line in nil eof))) + ((eq line eof)) + (write-string line strm) + (write-char #\newline strm)))))) + +(defun read-stream-to-string (in) + (with-output-to-string (out) + (let ((eof (gensym))) + (do ((line (read-line in nil eof) + (read-line in nil eof))) + ((eq line eof)) + (format out "~A~%" line))))) + (defun read-file-to-string (file) "Opens a reads a file. Returns the contents as a single string" (with-output-to-string (out) (with-open-file (in file :direction :input) - (let ((eof (gensym))) - (do ((line (read-line in nil eof) - (read-line in nil eof))) - ((eq line eof)) - (format out "~A~%" line)))))) - + (read-stream-to-string in)))) + +(defun read-stream-to-strings (in) + (let ((lines '()) + (eof (gensym))) + (do ((line (read-line in nil eof) + (read-line in nil eof))) + ((eq line eof)) + (push line lines))) + (nreverse lines)) + (defun read-file-to-strings (file) "Opens a reads a file. Returns the contents as a list of strings" - (let ((lines '())) - (with-open-file (in file :direction :input) - (let ((eof (gensym))) - (do ((line (read-line in nil eof) - (read-line in nil eof))) - ((eq line eof)) - (push line lines))) - (nreverse lines)))) + (with-open-file (in file :direction :input) + (read-stream-to-strings in))) (defun file-subst (old new file1 file2) (with-open-file (in file1 :direction :input) @@ -191,40 +199,6 @@ (open-device-stream #p"/dev/null" :output)) ) -(defun un-unspecific (value) - "Convert :UNSPECIFIC to NIL." - (if (eq value :unspecific) nil value)) - -(defun canonicalize-directory-name (filename) - (flet ((un-unspecific (value) - (if (eq value :unspecific) nil value))) - (let* ((path (pathname filename)) - (name (un-unspecific (pathname-name path))) - (type (un-unspecific (pathname-type path))) - (new-dir - (cond ((and name type) (list (concatenate 'string name "." type))) - (name (list name)) - (type (list type)) - (t nil)))) - (if new-dir - (make-pathname - :directory (append (un-unspecific (pathname-directory path)) - new-dir) - :name nil :type nil :version nil :defaults path) - path)))) - -(defun probe-directory (filename) - (let ((path (canonicalize-directory-name filename))) - #+allegro (excl:probe-directory path) - #+clisp (values - (ignore-errors - (#+lisp=cl ext:probe-directory #-lisp=cl lisp:probe-directory - path))) - #+(or cmu scl) (eq :directory (unix:unix-file-kind (namestring path))) - #+lispworks (lw:file-directory-p path) - #+sbcl (eq :directory (sb-unix:unix-file-kind (namestring path))) - #-(or allegro clisp cmu lispworks sbcl scl) - (probe-file path))) (defun directory-tree (filename) "Returns a tree of pathnames for sub-directories of a directory"