Merge branch 'stream-line-length' into 'develop'

Add gray:stream-line-length

See merge request embeddable-common-lisp/ecl!309

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,

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)},

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
 

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

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)

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))