1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Input/Output functions for KMRCL package
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
10 ;;;; $Id: io.lisp,v 1.3 2003/05/09 05:13:49 kevin Exp $
12 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; KMRCL users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
21 (defun print-file-contents (file &optional (strm *standard-output*))
22 "Opens a reads a file. Returns the contents as a single string"
23 (when (probe-file file)
24 (with-open-file (in file :direction :input)
26 (do ((line (read-line in nil eof)
27 (read-line in nil eof)))
29 (format strm "~A~%" line))))))
31 (defun read-file-to-string (file)
32 "Opens a reads a file. Returns the contents as a single string"
33 (with-output-to-string (out)
34 (with-open-file (in file :direction :input)
36 (do ((line (read-line in nil eof)
37 (read-line in nil eof)))
39 (format out "~A~%" line))))))
41 (defun read-file-to-strings (file)
42 "Opens a reads a file. Returns the contents as a list of strings"
44 (with-open-file (in file :direction :input)
46 (do ((line (read-line in nil eof)
47 (read-line in nil eof)))
52 (defun file-subst (old new file1 file2)
53 (with-open-file (in file1 :direction :input)
54 (with-open-file (out file2 :direction :output
55 :if-exists :supersede)
56 (stream-subst old new in out))))
58 (defun indent-spaces (n &optional (stream *standard-output*))
59 "Indent n*2 spaces to output stream"
60 (write-string (make-string (+ n n) :initial-element #\space) stream))
62 (defun print-list (l &optional (output *standard-output*))
63 "Print a list to a stream"
64 (format output "~{~A~%~}" l))
66 (defun print-rows (rows &optional (ostrm *standard-output*))
67 "Print a list of list rows to a stream"
68 (dolist (r rows) (format ostrm "~{~A~^ ~}~%" r)))
71 ;; Buffered stream substitute
74 vec (start -1) (used -1) (new -1) (end -1))
78 (mod n (length (buf-vec buf)))))
80 (defun (setf bref) (val buf n)
81 (setf (svref (buf-vec buf)
82 (mod n (length (buf-vec buf))))
86 (make-buf :vec (make-array len)))
88 (defun buf-insert (x b)
89 (setf (bref b (incf (buf-end b))) x))
93 (bref b (incf (buf-start b)))
94 (setf (buf-used b) (buf-start b)
95 (buf-new b) (buf-end b))))
98 (when (< (buf-used b) (buf-new b))
99 (bref b (incf (buf-used b)))))
102 (setf (buf-used b) (buf-start b)
103 (buf-new b) (buf-end b)))
106 (setf (buf-start b) -1 (buf-used b) -1
107 (buf-new b) -1 (buf-end b) -1))
109 (defun buf-flush (b str)
110 (do ((i (1+ (buf-used b)) (1+ i)))
112 (princ (bref b i) str)))
115 (defun stream-subst (old new in out)
116 (declare (string old new))
121 (declare (fixnum pos len))
122 (do ((c (read-char in nil :eof)
123 (or (setf from-buf (buf-next buf))
124 (read-char in nil :eof))))
126 (declare (character c))
127 (cond ((char= c (char old pos))
129 (cond ((= pos len) ; 3
134 (buf-insert c buf))))
143 (princ (buf-pop buf) out)
146 (buf-flush buf out)))