;;;;
;;;; $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
(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)
(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"