Package trivial-gray-streams

Overview
License
How to use it
Problem description
Overview
Classes
Character input
Character output
Other functions
Binary streams
Extensions
Examples

Overview

Author

Copyright (c) 2005 David Lichteblau

Version

The Library has no version information.

Homepage

http://common-lisp.net/project/trivial-gray-streams/

Mailing List

Send bug reports to http://lists.common-lisp.net/mailman/listinfo/trivial-gray-streams-devel

Download

The library is available via Quicklisp.

A snapshot tarball is available from https://gitorious.org/trivial-gray-streams/trivial-gray-streams/archive-tarball/master

Source Code

The Git repository is https://gitorious.org/trivial-gray-streams/trivial-gray-streams

Documentation

This documentation is generated with a fork of atdoc. The documentation tries to summarize available informations about the package trivial-gray-streams.

Dependencies

trivial-gray-streams does not depend on other libraries.

License

Copyright (c) 2005 David Lichteblau

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

How to use it

1. Use the package trivial-gray-streams instead of whatever implementation specific package you would have to use otherwise to get gray stream symbols.
2. For stream-read-sequence and stream-write-sequence, notice that we use two required arguments and allow additional keyword arguments. So the lambda list when defining a method on either function should look like this:

    (stream sequence start end &key)        

3. In order for (2) to work on all Lisps, make sure to subclass all your stream classes from trivial-gray-stream-mixin if you intend to define methods on those two generic functions.

Problem description

Common Lisp does not provide a standard way for users to define their own streams for use by the standard I/O functions. This impedes the development of window systems for Common Lisp because, while there are standard Common Lisp I/O functions and there are beginning to be standard window systems, there is no portable way to connect them together to make a portable Common Lisp window system.

There are also many applications where users might want to define their own filter streams for doing things like printer device control, report formatting, character code translation, or encryption/decryption.

Overview

Define a set of generic functions for performing I/O. These functions will have methods that specialize on the stream argument; they would be used by the existing I/O functions. Users could write additional methods for them in order to support their own stream classes.

Define a set of classes to be used as the superclass of a stream class in order to provide some default methods.

Classes

The following classes are to be used as super classes of user-defined stream classes. They are not intended to be directly instantiated; they just provide places to hang default methods.

Character input

A character input stream can be created by defining a class that includes fundamental-character-input-stream and defining methods for the generic functions below.

Character output

A character output stream can be created by defining a class that includes fundamental-character-output-stream and defining methods for the generic functions below.

Other functions

The other functions for Gray streams are not exported from the package trivial-gray-streams. These functions are:

close, open-stream-p, streamp, input-stream-p, output-stream-p, and stream-element-type

Binary streams

Binary streams can be created by defining a class that includes either fundamental-binary-input-stream or fundamental-binary-output-stream (or both) and defining a method for stream-element-type and for one or both of the following generic functions.

Extensions

Will only be called by LispWorks, CLISP and SBCL.

Examples

  ;;;; Here is an example of how the default methods could be
  ;;;; implemented (omitting the most trivial ones):


  (defmethod STREAM-PEEK-CHAR ((stream fundamental-character-input-stream))
    (let ((character (stream-read-char stream)))
      (unless (eq character :eof)
	(stream-unread-char stream character))
      character))


  (defmethod STREAM-LISTEN ((stream fundamental-character-input-stream))
    (let ((char (stream-read-char-no-hang stream)))
      (and (not (null char))
	   (not (eq char :eof))
	   (progn (stream-unread-char stream char) t))))


  (defmethod STREAM-READ-LINE ((stream fundamental-character-input-stream))
    (let ((line (make-array 64 :element-type 'string-char 
			    :fill-pointer 0 :adjustable t)))
      (loop (let ((character (stream-read-char stream)))
	      (if (eq character :eof)
		  (return (values line t))
		(if (eql character #\newline)
		    (return (values line nil))
		  (vector-push-extend character line)))))))


  (defmethod STREAM-START-LINE-P ((stream fundamental-character-output-stream))
    (equal (stream-line-column stream) 0))


  (defmethod STREAM-WRITE-STRING ((stream fundamental-character-output-stream)
				  string &optional (start 0) 
				  (end (length string)))
    (do ((i start (1+ i)))
	((>= i end) string)
      (stream-write-char stream (char string i))))


  (defmethod STREAM-TERPRI ((stream fundamental-character-output-stream))
    (stream-write-char stream #\newline)
    nil)


  (defmethod STREAM-FRESH-LINE ((stream fundamental-character-output-stream))
    (if (stream-start-line-p stream)
	nil
      (progn (stream-terpri stream) t)))


  (defmethod STREAM-ADVANCE-TO-COLUMN ((stream fundamental-character-output-stream) 
				       column)
    (let ((current (stream-line-column stream)))
      (unless (null current)
	(dotimes (i (- current column) t)
	  (stream-write-char stream #\space)))))


  (defmethod INPUT-STREAM-P ((stream fundamental-input-stream)) t)
  (defmethod INPUT-STREAM-P ((stream fundamental-output-stream))
    ;; allow the two classes to be mixed in either order
    (typep stream 'fundamental-input-stream))
  (defmethod OUTPUT-STREAM-P ((stream fundamental-output-stream)) t)
  (defmethod OUTPUT-STREAM-P ((stream fundamental-input-stream))
    (typep stream 'fundamental-output-stream))


  ;;;; Following is an example of how the existing I/O functions could
  ;;;; be implemented using standard Common Lisp and the generic
  ;;;; functions specified above.  The standard functions being defined
  ;;;; are in upper case.


  ;;  Internal helper functions


  (proclaim '(inline decode-read-arg decode-print-arg check-for-eof))
  (defun decode-read-arg (arg)
    (cond ((null arg) *standard-input*)
	  ((eq arg t) *terminal-io*)
	  (t arg)))


  (defun decode-print-arg (arg)
    (cond ((null arg) *standard-output*)
	  ((eq arg t) *terminal-io*)
	  (t arg)))


  (defun check-for-eof (value stream eof-errorp eof-value)
    (if (eq value :eof)
	(report-eof stream eof-errorp eof-value)
      value))


  (defun report-eof (stream eof-errorp eof-value)
    (if eof-errorp
	(error 'end-of-file :stream stream)
      eof-value))


  ;;;  Common Lisp input functions


  (defun READ-CHAR (&optional input-stream (eof-errorp t) eof-value recursive-p)
    (declare (ignore recursive-p)) ; a mistake in CLtL?
    (let ((stream (decode-read-arg input-stream)))
      (check-for-eof (stream-read-char stream) stream eof-errorp eof-value)))


  (defun PEEK-CHAR (&optional peek-type input-stream (eof-errorp t) 
			eof-value recursive-p)
    (declare (ignore recursive-p))
    (let ((stream (decode-read-arg input-stream)))
      (if (null peek-type)
	  (check-for-eof (stream-peek-char stream) stream eof-errorp eof-value)
        (loop
	  (let ((value (stream-peek-char stream)))
	    (if (eq value :eof)
		(return (report-eof stream eof-errorp eof-value))
	      (if (if (eq peek-type t)
		      (not (member value '(#\space #\tab #\newline
					   #\page #\return #\linefeed)))
		    (char= peek-type value))
		  (return value)
		(stream-read-char stream))))))))


  (defun UNREAD-CHAR (character &optional input-stream)
    (stream-unread-char (decode-read-arg input-stream) character))


  (defun LISTEN (&optional input-stream)
    (stream-listen (decode-read-arg input-stream)))


  (defun READ-LINE (&optional input-stream (eof-error-p t) 
			eof-value recursive-p)
    (declare (ignore recursive-p))
    (let ((stream (decode-read-arg input-stream)))
      (multiple-value-bind (string eofp)
	  (stream-read-line stream)
	(if eofp
	    (if (= (length string) 0)
		(report-eof stream eof-error-p eof-value)
	      (values string t))
	  (values string nil)))))


  (defun CLEAR-INPUT (&optional input-stream)
    (stream-clear-input (decode-read-arg input-stream)))


  (defun READ-CHAR-NO-HANG (&optional input-stream (eof-errorp t) 
				eof-value recursive-p)
    (declare (ignore recursive-p))
    (let ((stream (decode-read-arg input-stream)))
      (check-for-eof (stream-read-char-no-hang stream)
		     stream eof-errorp eof-value)))


  ;;;  Common Lisp output functions


  (defun WRITE-CHAR (character &optional output-stream)
     (stream-write-char (decode-print-arg output-stream) character))


  (defun FRESH-LINE (&optional output-stream)
    (stream-fresh-line (decode-print-arg output-stream)))


  (defun TERPRI (&optional output-stream)
    (stream-terpri (decode-print-arg output-stream)))


  (defun WRITE-STRING (string &optional output-stream &key (start 0) end)
    (stream-write-string (decode-print-arg output-stream) string start end))


  (defun WRITE-LINE (string &optional output-stream &key (start 0) end)
    (let ((stream (decode-print-arg output-stream)))
      (stream-write-string stream string start end)
      (stream-terpri stream)
      string))


  (defun FORCE-OUTPUT (&optional stream)
    (stream-force-output (decode-print-arg stream)))


  (defun FINISH-OUTPUT (&optional stream)
    (stream-finish-output (decode-print-arg stream)))


  (defun CLEAR-OUTPUT (&optional stream)
    (stream-clear-output (decode-print-arg stream)))


  ;;;  Binary streams


  (defun READ-BYTE (binary-input-stream &optional (eof-errorp t) eof-value)
    (check-for-eof (stream-read-byte binary-input-stream) 
		   binary-input-stream eof-errorp eof-value))


  (defun WRITE-BYTE (integer binary-output-stream)
    (stream-write-byte binary-output-stream integer))


  ;;;  String streams


  (defclass string-input-stream (fundamental-character-input-stream)
    ((string :initarg :string :type string)
     (index :initarg :start :type fixnum)
     (end :initarg :end :type fixnum)
     ))


  (defun MAKE-STRING-INPUT-STREAM (string &optional (start 0) end)
    (make-instance 'string-input-stream :string string 
		   :start start :end (or end (length string))))


  (defmethod stream-read-char ((stream string-input-stream))
    (with-slots (index end string) stream
      (if (>= index end)
	  :eof
	(prog1 (char string index)
	       (incf index)))))


  (defmethod stream-unread-char ((stream string-input-stream) character)
    (with-slots (index end string) stream
      (decf index)
      (assert (eql (char string index) character))
      nil))


  (defmethod stream-read-line ((stream string-input-stream))
    (with-slots (index end string) stream
      (let* ((endline (position #\newline string :start index :end end))
	     (line (subseq string index endline)))
	(if endline
	    (progn (setq index (1+ endline))
		   (values line nil))
	  (progn (setq index end)
		 (values line t))))))


  (defclass string-output-stream (fundamental-character-output-stream)
    ((string :initform nil :initarg :string)))


  (defun MAKE-STRING-OUTPUT-STREAM ()
    (make-instance 'string-output-stream))


  (defun GET-OUTPUT-STREAM-STRING (stream)
    (with-slots (string) stream
      (if (null string)
	  ""
	(prog1 string (setq string nil)))))


  (defmethod stream-write-char ((stream string-output-stream) character)
    (with-slots (string) stream
      (when (null string)
	(setq string (make-array 64. :element-type 'string-char 
				 :fill-pointer 0 :adjustable t)))
      (vector-push-extend character string)
      character))


  (defmethod stream-line-column ((stream string-output-stream))
    (with-slots (string) stream
      (if (null string)
	  0
	(let ((nx (position #\newline string :from-end t)))
	  (if (null nx)
	      (length string)
	    (- (length string) nx 1))
	  ))))