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.7 2003/06/06 21:59:29 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 print-n-chars (char n stream)
60 (optimize (speed 3) (safety 0) (space 0)))
64 (write-char char stream)))
66 (defun indent-spaces (n &optional (stream *standard-output*))
67 "Indent n*2 spaces to output stream"
68 (print-n-chars #\space (+ n n) stream))
70 (defun print-list (l &optional (output *standard-output*))
71 "Print a list to a stream"
72 (format output "~{~A~%~}" l))
74 (defun print-rows (rows &optional (ostrm *standard-output*))
75 "Print a list of list rows to a stream"
76 (dolist (r rows) (format ostrm "~{~A~^ ~}~%" r)))
79 ;; Buffered stream substitute
82 vec (start -1) (used -1) (new -1) (end -1))
86 (mod n (length (buf-vec buf)))))
88 (defun (setf bref) (val buf n)
89 (setf (svref (buf-vec buf)
90 (mod n (length (buf-vec buf))))
94 (make-buf :vec (make-array len)))
96 (defun buf-insert (x b)
97 (setf (bref b (incf (buf-end b))) x))
101 (bref b (incf (buf-start b)))
102 (setf (buf-used b) (buf-start b)
103 (buf-new b) (buf-end b))))
106 (when (< (buf-used b) (buf-new b))
107 (bref b (incf (buf-used b)))))
110 (setf (buf-used b) (buf-start b)
111 (buf-new b) (buf-end b)))
114 (setf (buf-start b) -1 (buf-used b) -1
115 (buf-new b) -1 (buf-end b) -1))
117 (defun buf-flush (b str)
118 (do ((i (1+ (buf-used b)) (1+ i)))
120 (princ (bref b i) str)))
123 (defun stream-subst (old new in out)
124 (declare (string old new))
129 (declare (fixnum pos len))
130 (do ((c (read-char in nil :eof)
131 (or (setf from-buf (buf-next buf))
132 (read-char in nil :eof))))
134 (declare (character c))
135 (cond ((char= c (char old pos))
137 (cond ((= pos len) ; 3
142 (buf-insert c buf))))
151 (princ (buf-pop buf) out)
154 (buf-flush buf out)))