diff --git a/src/org/armedbear/lisp/GrayStream.java b/src/org/armedbear/lisp/GrayStream.java index b1906e8b2..ae972a984 100644 --- a/src/org/armedbear/lisp/GrayStream.java +++ b/src/org/armedbear/lisp/GrayStream.java @@ -257,6 +257,14 @@ public LispObject fileLength() { return f.execute(clos); } + public static final Symbol FILE_STRING_LENGTH + = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/FILE-STRING-LENGTH"); + @Override + public LispObject fileStringLength(LispObject arg) { + Function f = checkFunction(FILE_STRING_LENGTH.getSymbolFunction()); + return f.execute(clos, arg); + } + public static final Symbol PATHNAME = PACKAGE_GRAY_STREAMS_JAVA.addExternalSymbol("JAVA/PATHNAME"); @Override @@ -324,6 +332,7 @@ public final int getLineNumber() { Autoload.autoloadFile(GrayStream.FILE_POSITION, "gray-streams-java"); Autoload.autoloadFile(GrayStream.SET_FILE_POSITION, "gray-streams-java"); Autoload.autoloadFile(GrayStream.FILE_LENGTH, "gray-streams-java"); + Autoload.autoloadFile(GrayStream.FILE_STRING_LENGTH, "gray-streams-java"); Autoload.autoloadFile(GrayStream.PATHNAME, "gray-streams-java"); Autoload.autoloadFile(GrayStream.LINE_COLUMN, "gray-streams-java"); } diff --git a/src/org/armedbear/lisp/gray-streams-java.lisp b/src/org/armedbear/lisp/gray-streams-java.lisp index 6c9583f1d..a9cbef3a4 100644 --- a/src/org/armedbear/lisp/gray-streams-java.lisp +++ b/src/org/armedbear/lisp/gray-streams-java.lisp @@ -79,6 +79,9 @@ (defun java/file-length (object) (gray-streams:stream-file-length object)) +(defun java/file-string-length (object string) + (gray-streams:stream-file-string-length object string)) + (defun java/pathname (object) (gray-streams::gray-pathname object)) diff --git a/src/org/armedbear/lisp/gray-streams.lisp b/src/org/armedbear/lisp/gray-streams.lisp index 68c7b2ee3..5aed04b4a 100644 --- a/src/org/armedbear/lisp/gray-streams.lisp +++ b/src/org/armedbear/lisp/gray-streams.lisp @@ -152,6 +152,7 @@ "STREAM-WRITE-SEQUENCE" "STREAM-FILE-POSITION" "STREAM-FILE-LENGTH" + "STREAM-FILE-STRING-LENGTH" "STREAM-ELEMENT-TYPE" "FUNDAMENTAL-BINARY-INPUT-STREAM" "FUNDAMENTAL-BINARY-OUTPUT-STREAM")) @@ -193,6 +194,7 @@ (defvar *ansi-two-way-stream-output-stream* #'cl:two-way-stream-output-stream) (defvar *ansi-file-position* #'cl:file-position) (defvar *ansi-file-length* #'cl:file-length) +(defvar *ansi-file-string-length* #'cl:file-string-length) (defvar *ansi-pathname* #'cl:pathname) (defvar *ansi-truename* #'cl:truename) @@ -709,6 +711,18 @@ (funcall *ansi-file-length* stream) (stream-file-length stream))) +(defgeneric stream-file-string-length (stream object)) + +(defmethod stream-file-string-length + ((stream fundamental-character-output-stream) object) + (declare (ignore object)) + nil) + +(defun gray-file-string-length (stream object) + (if (ansi-streamp stream) + (funcall *ansi-file-string-length* stream object) + (stream-file-string-length stream object))) + #| (defstruct (two-way-stream-g (:include stream)) input-stream output-stream) @@ -763,6 +777,7 @@ (setf (symbol-function 'common-lisp::write-sequence) #'gray-write-sequence) (setf (symbol-function 'common-lisp::file-position) #'gray-file-position) (setf (symbol-function 'common-lisp::file-length) #'gray-file-length) +(setf (symbol-function 'common-lisp::file-string-length) #'gray-file-string-length) (setf (symbol-function 'common-lisp::listen) #'gray-listen) (setf (symbol-function 'ext:line-length) #'gray-line-length) (setf (symbol-function 'common-lisp::pathname) #'gray-pathname) @@ -798,6 +813,7 @@ (common-lisp::write-sequence gray-write-sequence) (common-lisp::file-position gray-file-position) (common-lisp::file-length gray-file-length) + (common-lisp::file-string-length gray-file-string-length) (common-lisp::listen gray-listen) (common-lisp::pathname gray-pathname) (common-lisp::truename gray-truename)))