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.12 2003/07/30 17:32:26 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)
59 (declare (fixnum n) (optimize (speed 3) (safety 0) (space 0)))
62 (write-char char stream)))
64 (defun print-n-strings (str n stream)
65 (declare (fixnum n) (optimize (speed 3) (safety 0) (space 0)))
68 (write-string str stream)))
70 (defun indent-spaces (n &optional (stream *standard-output*))
71 "Indent n*2 spaces to output stream"
72 (print-n-chars #\space (+ n n) stream))
75 (defun indent-html-spaces (n &optional (stream *standard-output*))
76 "Indent n*2 html spaces to output stream"
77 (print-n-strings " " (+ n n) stream))
80 (defun print-list (l &optional (output *standard-output*))
81 "Print a list to a stream"
82 (format output "~{~A~%~}" l))
84 (defun print-rows (rows &optional (ostrm *standard-output*))
85 "Print a list of list rows to a stream"
86 (dolist (r rows) (format ostrm "~{~A~^ ~}~%" r)))
89 ;; Buffered stream substitute
92 vec (start -1) (used -1) (new -1) (end -1))
96 (mod n (length (buf-vec buf)))))
98 (defun (setf bref) (val buf n)
99 (setf (svref (buf-vec buf)
100 (mod n (length (buf-vec buf))))
104 (make-buf :vec (make-array len)))
106 (defun buf-insert (x b)
107 (setf (bref b (incf (buf-end b))) x))
111 (bref b (incf (buf-start b)))
112 (setf (buf-used b) (buf-start b)
113 (buf-new b) (buf-end b))))
116 (when (< (buf-used b) (buf-new b))
117 (bref b (incf (buf-used b)))))
120 (setf (buf-used b) (buf-start b)
121 (buf-new b) (buf-end b)))
124 (setf (buf-start b) -1 (buf-used b) -1
125 (buf-new b) -1 (buf-end b) -1))
127 (defun buf-flush (b str)
128 (do ((i (1+ (buf-used b)) (1+ i)))
130 (princ (bref b i) str)))
133 (defun stream-subst (old new in out)
134 (declare (string old new))
139 (declare (fixnum pos len))
140 (do ((c (read-char in nil :eof)
141 (or (setf from-buf (buf-next buf))
142 (read-char in nil :eof))))
144 (declare (character c))
145 (cond ((char= c (char old pos))
147 (cond ((= pos len) ; 3
152 (buf-insert c buf))))
161 (princ (buf-pop buf) out)
164 (buf-flush buf out)))
166 (declaim (inline write-fixnum))
167 (defun write-fixnum (n s)
168 #+allegro (excl::print-fixnum s 10 n)
169 #-allegro (write-string (write-to-string n) s))
172 (defun null-output-stream ()
173 (when (probe-file #p"/dev/null")
174 (open #p"/dev/null" :direction :output :if-exists :overwrite)))