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.1 2003/04/28 23:51:59 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))))
59 (defun indent-spaces (n &optional (stream *standard-output*))
60 "Indent n*2 spaces to output stream"
62 (let ((fmt (format nil "~~~DT" (+ n n))))
63 (format stream fmt))))
65 (defun print-list (l &optional (output *standard-output*))
66 "Print a list to a stream"
69 (mapcar (lambda (x) (princ x output) (princ #\newline output)) l)
73 (defun print-rows (rows &optional (ostrm *standard-output*))
74 "Print a list of list rows to a stream"
76 (mapcar (lambda (a) (princ a ostrm) (princ #\space ostrm)) r)
80 ;; Buffered stream substitute
83 vec (start -1) (used -1) (new -1) (end -1))
87 (mod n (length (buf-vec buf)))))
89 (defun (setf bref) (val buf n)
90 (setf (svref (buf-vec buf)
91 (mod n (length (buf-vec buf))))
95 (make-buf :vec (make-array len)))
97 (defun buf-insert (x b)
98 (setf (bref b (incf (buf-end b))) x))
102 (bref b (incf (buf-start b)))
103 (setf (buf-used b) (buf-start b)
104 (buf-new b) (buf-end b))))
107 (when (< (buf-used b) (buf-new b))
108 (bref b (incf (buf-used b)))))
111 (setf (buf-used b) (buf-start b)
112 (buf-new b) (buf-end b)))
115 (setf (buf-start b) -1 (buf-used b) -1
116 (buf-new b) -1 (buf-end b) -1))
118 (defun buf-flush (b str)
119 (do ((i (1+ (buf-used b)) (1+ i)))
121 (princ (bref b i) str)))
124 (defun stream-subst (old new in out)
125 (declare (string old new))
130 (declare (fixnum pos len))
131 (do ((c (read-char in nil :eof)
132 (or (setf from-buf (buf-next buf))
133 (read-char in nil :eof))))
135 (declare (character c))
136 (cond ((char= c (char old pos))
138 (cond ((= pos len) ; 3
143 (buf-insert c buf))))
152 (princ (buf-pop buf) out)
155 (buf-flush buf out)))