From 76de65636cde0f0d2c86f2e2f3fb094b3b864ca9 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Mon, 6 Dec 2004 12:56:05 +0000
Subject: [PATCH] New CLOS-STREAMS feature. Stub methods for CLOS streams.

---
 src/c/main.d         |  3 +++
 src/clos/load.lsp.in |  5 +++-
 src/clos/streams.lsp | 60 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 67 insertions(+), 1 deletion(-)
 create mode 100644 src/clos/streams.lsp

diff --git a/src/c/main.d b/src/c/main.d
index 3c7084bf8..a5b822aa7 100644
--- a/src/c/main.d
+++ b/src/c/main.d
@@ -411,6 +411,9 @@ cl_boot(int argc, char **argv)
 #endif
 #ifdef ECL_CMU_FORMAT
 	ADD_FEATURE("CMU-FORMAT");
+#endif
+#ifdef ECL_CLOS_STREAMS
+	ADD_FEATURE("CLOS-STREAMS");
 #endif
 	/* This is assumed in all systems */
 	ADD_FEATURE("IEEE-FLOATING-POINT");
diff --git a/src/clos/load.lsp.in b/src/clos/load.lsp.in
index fb577f5c5..9adb3cd77 100644
--- a/src/clos/load.lsp.in
+++ b/src/clos/load.lsp.in
@@ -18,7 +18,10 @@
   "src:clos;inspect.lsp"
   #+cmu-format
   "src:lsp;pprint.lsp"
-  "src:clos;conditions.lsp"))
+  "src:clos;conditions.lsp"
+  #+clos-streams
+  "src:clos;streams.lsp"
+  ))
 
 #-cross
 (mapc #'(lambda (x) (load x :verbose nil)) +clos-module-files+)
diff --git a/src/clos/streams.lsp b/src/clos/streams.lsp
new file mode 100644
index 000000000..3d953135f
--- /dev/null
+++ b/src/clos/streams.lsp
@@ -0,0 +1,60 @@
+;;;;  Copyright (c) 2004, Juan Jose Garcia-Ripoll
+;;;;
+;;;;    This program is free software; you can redistribute it and/or
+;;;;    modify it under the terms of the GNU Library General Public
+;;;;    License as published by the Free Software Foundation; either
+;;;;    version 2 of the License, or (at your option) any later version.
+;;;;
+;;;;    See file '../Copyright' for full details.
+;;;;        The CLOS IO library.
+
+(in-package "SI")
+
+;;;
+;;; The following methods constitute the whole of the interface that a CLOS
+;;; class has to offer in order to be accepted by READ, WRITE, CLOSE, etc.
+;;; Here we provide dummy methods that fail with a TYPE-ERROR, which is the
+;;; condition type expected by the ANSI standard.
+;;;
+
+(defmethod ext::stream-input-p ((stream t))
+  (not-a-clos-stream stream 'ext::stream-input-))
+
+(defmethod ext::stream-output-p ((stream t))
+  (not-a-clos-stream stream 'ext:stream-output-p))
+
+(defmethod ext::stream-close ((stream t))
+  (not-a-clos-stream stream 'ext:stream-close))
+
+(defmethod ext::stream-read-char ((stream t))
+  (not-a-clos-stream stream 'ext:stream-read-char))
+
+(defmethod ext::stream-unread-char ((stream t) char)
+  (not-a-clos-stream stream 'ext:stream-unread-char))
+
+(defmethod ext::stream-write-char ((stream t) char)
+  (not-a-clos-stream stream 'ext:stream-write-char))
+
+(defmethod ext::stream-force-output ((stream t))
+  (not-a-clos-stream stream 'ext:stream-force-output))
+
+(defmethod ext::stream-clear-input ((stream t))
+  (not-a-clos-stream stream 'ext:stream-clear-input))
+
+(defmethod ext::stream-clear-output ((stream t))
+  (not-a-clos-stream stream 'ext:stream-clear-output))
+
+(defmethod ext::stream-listen ((stream t))
+  (not-a-clos-stream stream 'ext:stream-listen))
+
+(defmethod ext::stream-interactive-p ((stream t))
+  (not-a-clos-stream stream 'ext:stream-interactive-p))
+
+(defun not-a-clos-stream (object method-name)
+  (declare (ext::c-local))
+  (error 'simple-type-error
+	 :datum object
+	 :expected-type 'STREAM
+	 :format-control
+	 "The object ~S~%is neither a common-lisp STREAM nor a CLOS object with method ~A."
+	 :format-arguments (list object method-name)))