diff --git a/CHANGES b/CHANGES
index a978f8d73..493b4e071 100644
--- a/CHANGES
+++ b/CHANGES
@@ -7,6 +7,23 @@ Unreleased
+* [r15743] (Tarn W. Burton) Add support for implementing
+ CL:INTERACTIVE-STREAM-P in for Gray streams. This is done via by
+ making CL:INTERACTIVE-STREAM-P a generic function when the Gray
+ streams module is required.
+
+* [r15742] (Tarn W. Burton) Add support for stream specific line
+ lengths. This is done via the GRAY-STREAMS:STREAM-LINE-LENGTH
+ generic function which is only used when CL:*PRINT-RIGHT-MARGIN* is
+ NIL. The pretty printer and format have been updated to respect
+ these line lengths.
+
+* [r15741] (Tarn W. Burton) Add some missing default methods in the
+ Gray streams module.
+
+* [r15739] (Tarn W. Burton) Add support for implementing
+ CL:FILE-LENGTH in for Gray streams. This is done via the
+ GRAY-STREAMS:STREAM-FILE-LENGTH generic function.
Version 1.9.2
diff --git a/src/org/armedbear/lisp/GrayStream.java b/src/org/armedbear/lisp/GrayStream.java
index 47c766d56..cce8d0f10 100644
--- a/src/org/armedbear/lisp/GrayStream.java
+++ b/src/org/armedbear/lisp/GrayStream.java
@@ -4,8 +4,8 @@
import static org.armedbear.lisp.Lisp.*;
/**
- The Java stub for Gray streams which wraps the reference of the CLOS
- object corresponding to the stream.
+ The Java proxy for Gray streams which wraps the reference of the
+ CLOS object corresponding to the stream.
*/
public class GrayStream
extends Stream
@@ -35,59 +35,49 @@ public GrayStream findOrCreate(LispObject o) {
return wrappedStream;
}
- //
+ //
// do what we can for Java code that wants to determine our valence(s)
//
+ public static final Symbol INPUT_STREAM_P
+ = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/INPUT-STREAM-P");
public boolean isInputStream() {
- Function SUBTYPEP
- = (Function)Symbol.SUBTYPEP.getSymbolFunction();
- Package pkg
- = getCurrentPackage().findPackage("GRAY-STREAMS");
- Symbol fundamentalInputStream
- = (Symbol) pkg.findSymbol("FUNDAMENTAL-INPUT-STREAM");
- if (SUBTYPEP.execute(clos.typeOf(), fundamentalInputStream).equals(T)) {
- return true;
- }
- return false;
+ Function f = checkFunction(INPUT_STREAM_P.getSymbolFunction());
+ return f.execute(clos).getBooleanValue();
}
+ public static final Symbol OUTPUT_STREAM_P
+ = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/OUTPUT-STREAM-P");
public boolean isOutputStream() {
- Function SUBTYPEP
- = (Function)Symbol.SUBTYPEP.getSymbolFunction();
- Package pkg
- = getCurrentPackage().findPackage("GRAY-STREAMS");
- Symbol s
- = (Symbol) pkg.findSymbol("FUNDAMENTAL-OUTPUT-STREAM");
- if (SUBTYPEP.execute(clos.typeOf(), s).equals(T)) {
- return true;
- }
- return false;
+ Function f = checkFunction(OUTPUT_STREAM_P.getSymbolFunction());
+ return f.execute(clos).getBooleanValue();
+ }
+
+ public static final Symbol INTERACTIVE_STREAM_P
+ = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/INTERACTIVE-STREAM-P");
+ public boolean isInteractive() {
+ Function f = checkFunction(INTERACTIVE_STREAM_P.getSymbolFunction());
+ return f.execute(clos).getBooleanValue();
+ }
+
+ public static final Symbol OPEN_STREAM_P
+ = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/OPEN-STREAM-P");
+ public boolean isOpen() {
+ Function f = checkFunction(OPEN_STREAM_P.getSymbolFunction());
+ return f.execute(clos).getBooleanValue();
}
public boolean isCharacterStream() {
Function SUBTYPEP
= (Function)Symbol.SUBTYPEP.getSymbolFunction();
Package pkg
- = getCurrentPackage().findPackage("GRAY-STREAMS");
+ = getCurrentPackage().findPackage("COMMON-LISP");
Symbol s
- = (Symbol) pkg.findSymbol("FUNDAMENTAL-CHARACTER-STREAM");
- if (SUBTYPEP.execute(clos.typeOf(), s).equals(T)) {
- return true;
- }
- return false;
+ = (Symbol) pkg.findSymbol("CHARACTER");
+ return SUBTYPEP.execute(getElementType(), s).getBooleanValue();
}
public boolean isBinaryStream() {
- Function SUBTYPEP
- = (Function)Symbol.SUBTYPEP.getSymbolFunction();
- Package pkg
- = getCurrentPackage().findPackage("GRAY-STREAMS");
- Symbol s
- = (Symbol) pkg.findSymbol("FUNDAMENTAL-BINARY-STREAM");
- if (SUBTYPEP.execute(clos.typeOf(), s).equals(T)) {
- return true;
- }
- return false;
+ return !isCharacterStream();
}
public boolean isCharacterInputStream() {
@@ -251,11 +241,6 @@ public int getCharPos() {
// unimplemented interfaces of parent class
//
// we stub these to return Lisp-side errors
- public boolean isInteractive() {
- simple_error("unimplemented isInteractive()");
- return false; // unreached
- }
-
public void setInteractive(boolean b) {
simple_error("unimplemented setInteractive(boolean)");
}
@@ -274,11 +259,6 @@ public void setExternalFormat(LispObject format) {
simple_error("unimplemented setExternalFormat()");
}
- public boolean isOpen() {
- simple_error("unimplemented isOpen()");
- return false; // unreached
- }
-
public void setOpen(boolean b) {
simple_error("unimplemented setOpen()");;
}
@@ -300,6 +280,10 @@ public void _clearInput() {
// TODO figure out why we can't add these to autoloads.lisp
static {
+ Autoload.autoloadFile(GrayStream.INPUT_STREAM_P, "gray-streams-java");
+ Autoload.autoloadFile(GrayStream.OUTPUT_STREAM_P, "gray-streams-java");
+ Autoload.autoloadFile(GrayStream.INTERACTIVE_STREAM_P, "gray-streams-java");
+ Autoload.autoloadFile(GrayStream.OPEN_STREAM_P, "gray-streams-java");
Autoload.autoloadFile(GrayStream.ELEMENT_TYPE, "gray-streams-java");
Autoload.autoloadFile(GrayStream.FORCE_OUTPUT, "gray-streams-java");
Autoload.autoloadFile(GrayStream.WRITE_STRING, "gray-streams-java");
diff --git a/src/org/armedbear/lisp/Lisp.java b/src/org/armedbear/lisp/Lisp.java
index 3c0dec995..839e95bad 100644
--- a/src/org/armedbear/lisp/Lisp.java
+++ b/src/org/armedbear/lisp/Lisp.java
@@ -1858,12 +1858,15 @@ public static final Stream checkStream(LispObject obj)
if (obj instanceof Stream) {
return (Stream) obj;
}
- if (obj.typep(Symbol.STREAM).equal(T)) {
- Stream result = GrayStream.findOrCreate(obj);
- return result;
+ if (obj instanceof StandardObject) {
+ Function subtypep = checkFunction(Symbol.SUBTYPEP.getSymbolFunction());
+ if (subtypep.execute(obj.typeOf(), Symbol.STREAM).equals(T)) {
+ Stream result = GrayStream.findOrCreate(obj);
+ return result;
+ }
}
return (Stream) // Not reached.
- type_error(obj, Symbol.STREAM);
+ type_error(obj, Symbol.STREAM);
}
public static final Stream checkCharacterInputStream(LispObject obj)
diff --git a/src/org/armedbear/lisp/TwoWayStream.java b/src/org/armedbear/lisp/TwoWayStream.java
index 8083c98ef..58f430ca8 100644
--- a/src/org/armedbear/lisp/TwoWayStream.java
+++ b/src/org/armedbear/lisp/TwoWayStream.java
@@ -228,16 +228,15 @@ public LispObject execute(LispObject first, LispObject second)
{
final Stream in = checkStream(first);
- final Stream out = checkStream(second);
- if (!in.isInputStream()
- && !(in instanceof GrayStream)) {
- return type_error(in, list(Symbol.SATISFIES,
- Symbol.INPUT_STREAM_P));
+ if (!in.isInputStream()) {
+ return type_error(in, list(Symbol.SATISFIES,
+ Symbol.INPUT_STREAM_P));
}
- if (!out.isOutputStream()
- && !(out instanceof GrayStream)) {
+
+ final Stream out = checkStream(second);
+ if (!out.isOutputStream()) {
return type_error(out, list(Symbol.SATISFIES,
- Symbol.OUTPUT_STREAM_P));
+ Symbol.OUTPUT_STREAM_P));
}
return new TwoWayStream(in, out);
}
diff --git a/src/org/armedbear/lisp/gray-streams-java.lisp b/src/org/armedbear/lisp/gray-streams-java.lisp
index 64bbcd2c7..e1f5f5eb9 100644
--- a/src/org/armedbear/lisp/gray-streams-java.lisp
+++ b/src/org/armedbear/lisp/gray-streams-java.lisp
@@ -6,19 +6,61 @@
;;;; these methods.
;;;; N.b. The function symbols seemingly have to be unique across all
-;;;; packages for this to work, hence the "java/…" prefixes.
-(defun java/element-type (object)
+;;;; packages for this to work, hence the "java/…" prefixes.
+
+(defun find-method-or-nil (method specialization)
+ "Either return the method object for generic METHOD with a one argument
+ SPECIALIZATION or nil if it doesn't exist"
+ (find-method method '() (list specialization) nil))
+
+(defun java/input-stream-p (object)
+ (let* ((method
+ (or
+ (find-method-or-nil #'gray-streams::gray-input-stream-p
+ (class-of object))
+ (find-method-or-nil #'gray-streams::gray-input-stream-p
+ (find-class 'gray-streams:fundamental-input-stream))))
+ (method-function
+ (mop:method-function method)))
+ (funcall method-function `(,object) nil)))
+
+(defun java/output-stream-p (object)
(let* ((method
(or
- (find-method #'gray-streams:stream-element-type
- '()
- (list
- (class-of object))
- nil)
- (find-method #'gray-streams::gray-stream-element-type
- '()
- (list
- (class-of object)))))
+ (find-method-or-nil #'gray-streams::gray-output-stream-p
+ (class-of object))
+ (find-method-or-nil #'gray-streams::gray-output-stream-p
+ (find-class 'gray-streams:fundamental-output-stream))))
+ (method-function
+ (mop:method-function method)))
+ (funcall method-function `(,object) nil)))
+
+(defun java/interactive-stream-p (object)
+ (let* ((method
+ (find-method-or-nil #'gray-streams::gray-interactive-stream-p
+ (class-of object)))
+ (method-function
+ (mop:method-function method)))
+ (funcall method-function `(,object) nil)))
+
+(defun java/open-stream-p (object)
+ (let* ((method
+ (or
+ (find-method-or-nil #'gray-streams::gray-open-stream-p
+ (class-of object))
+ (find-method-or-nil #'gray-streams::gray-open-stream-p
+ (find-class 'gray-streams:fundamental-stream))))
+ (method-function
+ (mop:method-function method)))
+ (funcall method-function `(,object) nil)))
+
+(defun java/element-type (object)
+ (let* ((method
+ (or
+ (find-method-or-nil #'gray-streams:stream-element-type
+ (class-of object))
+ (find-method-or-nil #'gray-streams::gray-stream-element-type
+ (class-of object))))
(method-function
(mop:method-function method)))
(funcall method-function `(,object) nil)))
@@ -57,20 +99,23 @@
(funcall method-function `(,object ,char) nil)))
(defun java/write-chars (object string start end) ; The defaults for start and end are 0 and nil, respectively.
- (flet ((find-method-or-nil (specialized-on-class)
- (find-method #'gray-streams:stream-write-sequence
- '()
- (list
- specialized-on-class
- (find-class t))
- nil)))
- (let* ((method
- (or
- (find-method-or-nil (class-of object))
- (find-method-or-nil (find-class 'gray-streams:fundamental-character-output-stream))))
- (method-function
- (mop:method-function method)))
- (funcall method-function `(,object ,string ,start ,end) nil))))
+ (let* ((method
+ (or
+ (find-method #'gray-streams:stream-write-sequence
+ '()
+ (list
+ (class-of object)
+ (find-class t))
+ nil)
+ (find-method #'gray-streams:stream-write-sequence
+ '()
+ (list
+ (find-class 'gray-streams:fundamental-character-output-stream)
+ (find-class t))
+ nil)))
+ (method-function
+ (mop:method-function method)))
+ (funcall method-function `(,object ,string ,start ,end) nil)))
(defun java/fresh-line (object)
(let* ((method
diff --git a/src/org/armedbear/lisp/gray-streams.lisp b/src/org/armedbear/lisp/gray-streams.lisp
index 72793eae7..28a6b94f0 100644
--- a/src/org/armedbear/lisp/gray-streams.lisp
+++ b/src/org/armedbear/lisp/gray-streams.lisp
@@ -182,6 +182,7 @@
#'(lambda (s) (and (input-stream-p s) (eql (stream-element-type s) 'character))))
(defvar *ansi-input-stream-p* #'cl::input-stream-p)
(defvar *ansi-output-stream-p* #'cl::output-stream-p)
+(defvar *ansi-interactive-stream-p* #'cl::interactive-stream-p)
(defvar *ansi-open-stream-p* #'cl::open-stream-p)
(defvar *ansi-streamp* #'cl::streamp)
(defvar *ansi-read-sequence* #'cl::read-sequence)
@@ -208,6 +209,7 @@
(defgeneric gray-input-stream-p (stream))
(defgeneric gray-input-character-stream-p (stream)) ;; # fb 1.01
(defgeneric gray-output-stream-p (stream))
+(defgeneric gray-interactive-stream-p (stream))
(defgeneric gray-stream-element-type (stream))
(defmethod gray-close ((stream fundamental-stream) &key abort)
@@ -221,6 +223,10 @@
(defmethod gray-streamp ((s fundamental-stream))
s)
+(defmethod gray-interactive-stream-p (stream)
+ (declare (ignore stream))
+ nil)
+
(defclass fundamental-input-stream (fundamental-stream) ())
(defmethod gray-input-character-stream-p (s) ;; # fb 1.01
@@ -605,6 +611,9 @@
(defmethod gray-output-stream-p (stream)
(funcall *ansi-output-stream-p* stream))
+(defmethod gray-interactive-stream-p (stream)
+ (funcall *ansi-interactive-stream-p* stream))
+
(defmethod gray-open-stream-p (stream)
(funcall *ansi-open-stream-p* stream))
@@ -687,6 +696,7 @@
(setf (symbol-function 'common-lisp::input-stream-p) #'gray-input-stream-p)
(setf (symbol-function 'common-lisp::input-character-stream-p) #'gray-input-character-stream-p) ;; # fb 1.01
(setf (symbol-function 'common-lisp::output-stream-p) #'gray-output-stream-p)
+(setf (symbol-function 'common-lisp::interactive-stream-p) #'gray-interactive-stream-p)
(setf (symbol-function 'common-lisp::open-stream-p) #'gray-open-stream-p)
(setf (symbol-function 'common-lisp::streamp) #'gray-streamp)
(setf (symbol-function 'common-lisp::read-sequence) #'gray-read-sequence)