| 1 | (in-package :common-net) |
| 2 | |
| 3 | (require :sb-bsd-sockets) |
| 4 | |
| 5 | ;;; Gray stream methods |
| 6 | |
| 7 | ;; Redefine stream-socket with Gray superclasses. I know it's ugly, |
| 8 | ;; but I just don't know of a better way to do it. |
| 9 | (defclass stream-socket (socket sb-gray:fundamental-input-stream sb-gray:fundamental-output-stream) |
| 10 | ((mode :initform :byte) |
| 11 | (byte-buffer :initform (make-array '(16) :element-type '(unsigned-byte 8) :adjustable t) |
| 12 | :type (array (unsigned-byte 8))) |
| 13 | (byte-read-pos :initform 0 :type integer) |
| 14 | (byte-write-pos :initform 0 :type integer) |
| 15 | (char-buffer :initform (make-array '(16) :element-type 'character :adjustable t :fill-pointer 0) |
| 16 | :type (array character)) |
| 17 | (char-read-pos :initform 0 :type integer) |
| 18 | encoder decoder)) |
| 19 | |
| 20 | (macrolet ((simple (name) |
| 21 | `(defmethod |
| 22 | ,(intern (symbol-name name) (find-package :sb-gray)) ((socket stream-socket)) |
| 23 | (,(intern (concatenate 'string "GRAY-" (symbol-name name)) (symbol-package 'stream-socket)) socket))) |
| 24 | (simple-null (name) |
| 25 | `(defmethod |
| 26 | ,(intern (symbol-name name) (find-package :sb-gray)) ((socket stream-socket)) |
| 27 | nil))) |
| 28 | (simple stream-element-type) |
| 29 | (simple open-stream-p) |
| 30 | (simple stream-read-byte) |
| 31 | (simple stream-read-char) |
| 32 | (simple stream-read-char-no-hang) |
| 33 | (simple stream-peek-char) |
| 34 | (simple stream-listen) |
| 35 | (simple-null stream-line-column) |
| 36 | (simple-null stream-finish-output) |
| 37 | (simple-null stream-force-output) |
| 38 | (simple-null stream-clear-output)) |
| 39 | |
| 40 | (defmethod sb-gray:stream-write-byte ((socket stream-socket) byte) |
| 41 | (gray-stream-write-char socket byte)) |
| 42 | |
| 43 | (defmethod sb-gray:stream-unread-char ((socket stream-socket) char) |
| 44 | (gray-stream-unread-char socket char)) |
| 45 | |
| 46 | (defmethod sb-gray:stream-write-char ((socket stream-socket) char) |
| 47 | (gray-stream-write-char socket char)) |
| 48 | |
| 49 | (defmethod close ((socket stream-socket) &key abort) |
| 50 | (declare (ignore abort)) |
| 51 | (prog1 |
| 52 | (call-next-method) |
| 53 | (close-socket socket))) |
| 54 | |
| 55 | (defmethod sb-gray:stream-start-line-p ((socket stream-socket)) |
| 56 | (eql (sb-gray:stream-line-column socket) 0)) |
| 57 | |
| 58 | (defmethod sb-gray:stream-fresh-line ((socket stream-socket)) |
| 59 | (unless (sb-gray:stream-start-line-p socket) |
| 60 | (sb-gray:stream-terpri socket) |
| 61 | t)) |
| 62 | |
| 63 | (defmethod sb-gray:stream-write-string ((socket stream-socket) string &optional (start 0) (end (length string))) |
| 64 | (sb-gray:stream-write-sequence socket string start end)) |
| 65 | |
| 66 | (defmethod sb-gray:stream-terpri ((socket stream-socket)) |
| 67 | (sb-gray:stream-write-char socket #\newline)) |
| 68 | |
| 69 | (defmethod sb-gray:stream-read-sequence ((socket stream-socket) seq &optional (start 0) (end (length seq))) |
| 70 | (gray-stream-read-sequence socket seq start end)) |
| 71 | |
| 72 | (defmethod sb-gray:stream-write-sequence ((socket stream-socket) seq &optional (start 0) (end (length seq))) |
| 73 | (gray-stream-write-sequence socket seq start end)) |
| 74 | |
| 75 | ;;; Necessary SBCL gray-stream extensions |
| 76 | |
| 77 | (defmethod sb-gray:stream-line-length ((socket stream-socket)) |
| 78 | nil) |