stream.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) LICENSE
       ---
       stream.lisp (10793B)
       ---
            1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*-
            2 ;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.61 2008/05/19 22:32:56 edi Exp $
            3 
            4 ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
            5 
            6 ;;; Redistribution and use in source and binary forms, with or without
            7 ;;; modification, are permitted provided that the following conditions
            8 ;;; are met:
            9 
           10 ;;;   * Redistributions of source code must retain the above copyright
           11 ;;;     notice, this list of conditions and the following disclaimer.
           12 
           13 ;;;   * Redistributions in binary form must reproduce the above
           14 ;;;     copyright notice, this list of conditions and the following
           15 ;;;     disclaimer in the documentation and/or other materials
           16 ;;;     provided with the distribution.
           17 
           18 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
           19 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
           20 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
           21 ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
           22 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
           23 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
           24 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
           25 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
           26 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
           27 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
           28 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
           29 
           30 (in-package :flexi-streams)
           31 
           32 (defclass flexi-stream (trivial-gray-stream-mixin)
           33   ((stream :initarg :stream
           34            :reader flexi-stream-stream
           35            :documentation "The actual stream that's used for
           36 input and/or output.  It must be capable of reading/writing
           37 octets with READ-SEQUENCE and/or WRITE-SEQUENCE.")
           38    (external-format :initform (make-external-format :iso-8859-1)
           39                     :initarg :flexi-stream-external-format
           40                     :accessor flexi-stream-external-format
           41                     :documentation "The encoding currently used
           42 by this stream.  Can be changed on the fly.")
           43    (element-type :initform 'char*
           44                  :initarg :element-type
           45                  :accessor flexi-stream-element-type
           46                  :documentation "The element type of this stream."))
           47   (:documentation "A FLEXI-STREAM object is a stream that's
           48 `layered' atop an existing binary/bivalent stream in order to
           49 allow for multi-octet external formats.  FLEXI-STREAM itself is a
           50 mixin and should not be instantiated."))
           51 
           52 (defmethod initialize-instance :after ((flexi-stream flexi-stream) &rest initargs)
           53   "Makes sure the EXTERNAL-FORMAT and ELEMENT-TYPE slots contain
           54 reasonable values."
           55   (declare #.*standard-optimize-settings*)
           56   (declare (ignore initargs))
           57   (with-accessors ((external-format flexi-stream-external-format)
           58                    (element-type flexi-stream-element-type))
           59       flexi-stream
           60     (unless (or (subtypep element-type 'character)
           61                 (subtypep element-type 'octet))
           62       (error 'flexi-stream-element-type-error
           63              :element-type element-type
           64              :stream flexi-stream))
           65     (setq external-format (maybe-convert-external-format external-format))))
           66 
           67 (defmethod (setf flexi-stream-external-format) :around (new-value (flexi-stream flexi-stream))
           68   "Converts the new value to an EXTERNAL-FORMAT object if
           69 necessary."
           70   (declare #.*standard-optimize-settings*)
           71   (call-next-method (maybe-convert-external-format new-value) flexi-stream))
           72 
           73 (defmethod (setf flexi-stream-element-type) :before (new-value (flexi-stream flexi-stream))
           74   "Checks whether the new value makes sense before it is set."
           75   (declare #.*standard-optimize-settings*)
           76   (unless (or (subtypep new-value 'character)
           77               (type-equal new-value 'octet))
           78     (error 'flexi-stream-element-type-error
           79            :element-type new-value
           80            :stream flexi-stream)))
           81 
           82 (defmethod stream-element-type ((stream flexi-stream))
           83   "Returns the element type that was provided by the creator of
           84 the stream."
           85   (declare #.*standard-optimize-settings*)
           86   (with-accessors ((element-type flexi-stream-element-type))
           87       stream
           88     element-type))
           89 
           90 (defmethod close ((stream flexi-stream) &key abort)
           91   "Closes the flexi stream by closing the underlying `real'
           92 stream."
           93   (declare #.*standard-optimize-settings*)
           94   (with-accessors ((stream flexi-stream-stream))
           95       stream
           96     (cond ((open-stream-p stream)
           97            (close stream :abort abort))
           98           (t nil))))
           99 
          100 (defmethod open-stream-p ((stream flexi-stream))
          101   "A flexi stream is open if its underlying stream is open."
          102   (declare #.*standard-optimize-settings*)
          103   (with-accessors ((stream flexi-stream-stream))
          104       stream
          105     (open-stream-p stream)))
          106 
          107 (defmethod stream-file-position ((stream flexi-stream))
          108   "Dispatch to method for underlying stream."
          109   (declare #.*standard-optimize-settings*)
          110   (with-accessors ((stream flexi-stream-stream))
          111       stream
          112     (file-position stream)))
          113 
          114 (defmethod (setf stream-file-position) (position-spec (stream flexi-stream))
          115   "Dispatch to method for underlying stream."
          116   (declare #.*standard-optimize-settings*)
          117   (with-accessors ((underlying-stream flexi-stream-stream))
          118       stream
          119     (if (file-position underlying-stream position-spec)
          120         (setf (flexi-stream-position stream) (file-position underlying-stream))
          121           nil)))
          122 
          123 (defclass flexi-output-stream (flexi-stream fundamental-binary-output-stream
          124                                             fundamental-character-output-stream)
          125   ((column :initform 0
          126            :accessor flexi-stream-column
          127            :documentation "The current output column.  A
          128 non-negative integer or NIL."))
          129   (:documentation "A FLEXI-OUTPUT-STREAM is a FLEXI-STREAM that
          130 can actually be instatiated and used for output.  Don't use
          131 MAKE-INSTANCE to create a new FLEXI-OUTPUT-STREAM but use
          132 MAKE-FLEXI-STREAM instead."))
          133 
          134 #+:cmu
          135 (defmethod input-stream-p ((stream flexi-output-stream))
          136   "Explicitly states whether this is an input stream."
          137   (declare #.*standard-optimize-settings*)
          138   nil)
          139 
          140 (defclass flexi-input-stream (flexi-stream fundamental-binary-input-stream
          141                                            fundamental-character-input-stream)
          142   ((last-char-code :initform nil
          143                    :accessor flexi-stream-last-char-code
          144                    :documentation "This slot either holds NIL or the
          145 last character \(code) read successfully.  This is mainly used for
          146 UNREAD-CHAR sanity checks.")
          147    (last-octet :initform nil
          148                :accessor flexi-stream-last-octet
          149                :documentation "This slot either holds NIL or the last
          150 octet read successfully from the stream using a `binary' operation
          151 such as READ-BYTE.  This is mainly used for UNREAD-BYTE sanity
          152 checks.")
          153    (octet-stack :initform nil
          154                 :accessor flexi-stream-octet-stack
          155                 :documentation "A small buffer which holds octets
          156 that were already read from the underlying stream but not yet
          157 used to produce characters.  This is mainly used if we have to
          158 look ahead for a CR/LF line ending.")
          159    (position :initform 0
          160              :initarg :position
          161              :type integer
          162              :accessor flexi-stream-position
          163              :documentation "The position within the stream where each
          164 octet read counts as one.")
          165    (bound :initform nil
          166           :initarg :bound
          167           :type (or null integer)
          168           :accessor flexi-stream-bound
          169           :documentation "When this is not NIL, it must be an integer
          170 and the stream will behave as if no more data is available as soon as
          171 POSITION is greater or equal than this value."))
          172   (:documentation "A FLEXI-INPUT-STREAM is a FLEXI-STREAM that
          173 can actually be instatiated and used for input.  Don't use
          174 MAKE-INSTANCE to create a new FLEXI-INPUT-STREAM but use
          175 MAKE-FLEXI-STREAM instead."))
          176 
          177 #+:cmu
          178 (defmethod output-stream-p ((stream flexi-input-stream))
          179   "Explicitly states whether this is an output stream."
          180   (declare #.*standard-optimize-settings*)
          181   nil)
          182 
          183 (defclass flexi-io-stream (flexi-input-stream flexi-output-stream)
          184   ()
          185   (:documentation "A FLEXI-IO-STREAM is a FLEXI-STREAM that can
          186 actually be instatiated and used for input and output.  Don't use
          187 MAKE-INSTANCE to create a new FLEXI-IO-STREAM but use
          188 MAKE-FLEXI-STREAM instead."))
          189 
          190 #+:cmu
          191 (defmethod input-stream-p ((stream flexi-io-stream))
          192   "Explicitly states whether this is an input stream."
          193   (declare #.*standard-optimize-settings*)
          194   t)
          195 
          196 #+:cmu
          197 (defmethod output-stream-p ((stream flexi-io-stream))
          198   "Explicitly states whether this is an output stream."
          199   (declare #.*standard-optimize-settings*)
          200   t)
          201 
          202 (defun make-flexi-stream (stream &rest args
          203                                  &key (external-format (make-external-format :iso-8859-1))
          204                                       element-type column position bound)
          205   "Creates and returns a new flexi stream.  STREAM must be an open
          206 binary or `bivalent' stream, i.e. it must be capable of
          207 reading/writing octets with READ-SEQUENCE and/or WRITE-SEQUENCE.  The
          208 resulting flexi stream is an input stream if and only if STREAM is an
          209 input stream.  Likewise, it's an output stream if and only if STREAM
          210 is an output stream.  The default for ELEMENT-TYPE is LW:SIMPLE-CHAR
          211 on LispWorks and CHARACTER on other Lisps.  EXTERNAL-FORMAT must be an
          212 EXTERNAL-FORMAT object or a symbol or a list denoting such an object.
          213 COLUMN is the initial column of the stream which is either a
          214 non-negative integer or NIL.  The COLUMN argument must only be used
          215 for output streams.  POSITION \(only used for input streams) should be
          216 an integer and it denotes the position the stream is in - it will be
          217 increased by one for each octet read.  BOUND \(only used for input
          218 streams) should be NIL or an integer.  If BOUND is not NIL and
          219 POSITION has gone beyond BOUND, then the stream will behave as if no
          220 more input is available."
          221   (declare #.*standard-optimize-settings*)
          222   ;; these arguments are ignored - they are only there to provide a
          223   ;; meaningful parameter list for IDEs
          224   (declare (ignore element-type column position bound))
          225   (unless (and (streamp stream)
          226                (open-stream-p stream))
          227     (error "~S should have been an open stream." stream))
          228   (apply #'make-instance
          229          ;; actual type depends on STREAM
          230          (cond ((and (input-stream-p stream)
          231                      (output-stream-p stream))
          232                 'flexi-io-stream)
          233                ((input-stream-p stream)
          234                 'flexi-input-stream)
          235                ((output-stream-p stream)
          236                 'flexi-output-stream)
          237                (t
          238                 (error "~S is neither an input nor an output stream." stream)))
          239          :stream stream
          240          :flexi-stream-external-format external-format
          241          (sans args :external-format)))