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)