diff --git a/CHANGELOG b/CHANGELOG index 39624aca0..413c2f3d7 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -28,6 +28,17 @@ parameter given to configure script). * Pending changes since 23.9.9 + +- Add gray-streams module. This makes it possible to load Gray stream + support via ~(require '#:gray-streams)~ versus calling the internal + function ~gray::redefine-cl-functions~. +- Add support for some Gray stream extensions. Specifically, the generic + functions ~gray-streams:stream-line-length~ and + ~gray-streams:stream-file-length~ have been added. The former allows + stream specific line lengths when ~cl:*print-right-margin*~ is NIL. The + latter allows Gray streams to implement ~cl:file-length~. +- Various bug fixes for Gray streams. + * 23.9.9 changes since 21.2.1 ** Announcement Dear Community, diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index d57f3f12d..a3c1a3e6c 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1863,6 +1863,7 @@ cl_symbols[] = { {GRAY_ "STREAM-FRESH-LINE" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, {GRAY_ "STREAM-INTERACTIVE-P" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, {GRAY_ "STREAM-LINE-COLUMN" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, +{GRAY_ "STREAM-LINE-LENGTH" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, {GRAY_ "STREAM-LISTEN" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, {GRAY_ "STREAM-PEEK-CHAR" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, {GRAY_ "STREAM-READ-BYTE" ECL_FUN(NULL, NULL, -1) ECL_VAR(GRAY_ORDINARY, OBJNULL)}, diff --git a/src/clos/streams.lsp b/src/clos/streams.lsp index f2afecbbb..a34fd197d 100644 --- a/src/clos/streams.lsp +++ b/src/clos/streams.lsp @@ -95,6 +95,11 @@ stream class that is defined, a method must be defined for this function, although it is permissible for it to always return NIL.")) +;; Extension from CLASP, CMUCL, SBCL, Mezzano and SICL + +(defgeneric stream-line-length (stream) + (:documentation "Return the stream line length or NIL.")) + (defgeneric stream-listen (stream) #+sb-doc (:documentation @@ -411,6 +416,16 @@ (declare (ignore stream)) nil) +;; LINE-LENGTH + +(defmethod stream-line-length ((stream fundamental-character-output-stream)) + nil) + +(defmethod stream-line-length ((stream ansi-stream)) + nil) + +(defmethod stream-line-length ((stream t)) + (bug-or-error stream 'stream-line-length)) ;; LISTEN diff --git a/src/doc/manual/extensions/gray-streams.txi b/src/doc/manual/extensions/gray-streams.txi index 365a4f759..18d0d4080 100644 --- a/src/doc/manual/extensions/gray-streams.txi +++ b/src/doc/manual/extensions/gray-streams.txi @@ -6,3 +6,56 @@ Unlike the other Gray stream functions, @code{close} is not specialized on @code{t} for @var{stream}. This decision has been taken mainly for the compatibility reasons with some libraries. @end defun + +@defun {stream-file-position} stream &optional position +This is used to implement @code{file-position}. When @code{position} +is not provided it should return the current file position of the +stream as non-negative integer or @code{nil} if the file position +cannot be determined. When @code{position} is supplied the file +position of the stream should be set to that value. If setting the +position is successful then @code{t} should be returned, otherwise +@code{nil} should be returned. The default method always returns +@code{nil}. +@end defun + +@defun {stream-file-length} stream +This is used to implement @code{file-length}. It returns either a +non-negative integer or @code{nil} if the concept of file length is +not meaningful for the stream. The default method will signal a +@code{type-error} with an expected type of @code{file-stream}. This is +required to conform with the ``Exceptional Situations'' section of +@code{file-length} in the ANSI specification. +@end defun + +@defun {stream-interactive-p} stream +This is used to implement @code{interactive-stream-p}. It returns a +boolean indicating if the stream is interactive. The default method +always returns @code{nil}. +@end defun + +@defun {stream-line-length} stream +Allows the default line length to be specified for the stream. It +returns either a non-negative integer or @code{nil} if the concept of +line length is not meaningful for the stream. This value is only used +if @code{*print-right-margin*} is @code{nil}. The line length is used +by the pretty printer and by the format justification directive. The +default method returns @code{nil}. +@end defun + +@defun {stream-read-sequence} stream sequence &optional start end +This is used to implement @code{read-sequence}. It should follow the +semantics in the ANSI specification. It returns the position of the +first element in the sequence that was not updated. The default method +calls @code{stream-read-char} or @code{stream-read-byte} repeatedly +based on the type returned by @code{stream-element-type}. Element +access to the sequence is done via @code{elt}. +@end defun + +@defun {stream-write-sequence} stream sequence &optional start end +This is used to implement @code{write-sequence}. It should follow the +semantics in the ANSI specification. It returns sequence without +modification. The default method calls @code{stream-write-char} or +@code{stream-write-byte} repeatedly based on the type returned by +@code{stream-element-type}. Element access to the sequence is done via +@code{elt}. +@end defun diff --git a/src/lsp/format.lsp b/src/lsp/format.lsp index 78816eeea..ab9c5bd51 100644 --- a/src/lsp/format.lsp +++ b/src/lsp/format.lsp @@ -221,6 +221,8 @@ :start (format-directive-start struct) :end (format-directive-end struct)))) +(defconstant default-line-length 80) + (defconstant +format-directive-limit+ (1+ (char-code #\~))) #+formatter @@ -2518,7 +2520,9 @@ ,@(expand-directive-list (pop segments)))) ,(expand-bind-defaults ((extra 0) - (line-len '(or #-ecl (sys::line-length stream) 72))) + (line-len '(or *print-right-margin* + (gray:stream-line-length stream) + default-line-length))) (format-directive-params first-semi) `(setf extra-space ,extra line-len ,line-len)))) ,@(mapcar #'(lambda (segment) @@ -2549,7 +2553,9 @@ (check-output-layout-mode 2) (interpret-bind-defaults ((extra 0) - (len (or #-ecl (sys::line-length stream) 72))) + (len (or *print-right-margin* + (gray:stream-line-length stream) + default-line-length))) (format-directive-params first-semi) (setf newline-string (with-output-to-string (stream) diff --git a/src/lsp/pprint.lsp b/src/lsp/pprint.lsp index 8a7887a37..3d5516261 100644 --- a/src/lsp/pprint.lsp +++ b/src/lsp/pprint.lsp @@ -32,8 +32,6 @@ (defconstant initial-buffer-size 128) -(defconstant default-line-length 80) - (defclass pretty-stream (gray:fundamental-character-output-stream) ( ;; ;; Where the output is going to finally go. @@ -43,7 +41,8 @@ ;; ;; Line length we should format to. Cached here so we don't have to keep ;; extracting it from the target stream. - (line-length :initform (or *print-right-margin* default-line-length) + (line-length :initarg :line-length + :initform default-line-length :type column :accessor pretty-stream-line-length) ;; @@ -109,7 +108,9 @@ (defun make-pretty-stream (target) (make-instance 'pretty-stream :target target :buffer-start-column (or (file-column target) 0) - )) + :line-length (or *print-right-margin* + (gray:stream-line-length target) + default-line-length))) (defmethod print-object ((pretty-stream pretty-stream) stream) (print-unreadable-object (pretty-stream stream :type t :identity t)) @@ -131,6 +132,9 @@ ;;;; Stream interface routines. +(defmethod gray:stream-line-length ((stream pretty-stream)) + (pretty-stream-line-length stream)) + (defmethod gray::stream-write-char ((stream pretty-stream) char) (pretty-out stream char))