Commit | Line | Data |
---|---|---|
dfa6197c FT |
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 gray:fundamental-input-stream 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 :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 :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 gray:stream-write-byte ((socket stream-socket) byte) | |
41 | (gray-stream-write-char socket byte)) | |
42 | ||
43 | (defmethod gray:stream-unread-char ((socket stream-socket) char) | |
44 | (gray-stream-unread-char socket char)) | |
45 | ||
46 | (defmethod gray:stream-write-char ((socket stream-socket) char) | |
47 | (gray-stream-write-char socket char)) | |
48 | ||
49 | (defmethod gray:close ((socket stream-socket) &key abort) | |
50 | (declare (ignore abort)) | |
51 | (prog1 | |
52 | (call-next-method) | |
53 | (close-socket socket))) | |
54 | ||
55 | (defmethod gray:stream-start-line-p ((socket stream-socket)) | |
56 | (eql (gray:stream-line-column socket) 0)) | |
57 | ||
58 | (defmethod gray:stream-fresh-line ((socket stream-socket)) | |
59 | (unless (gray:stream-start-line-p socket) | |
60 | (gray:stream-terpri socket) | |
61 | t)) | |
62 | ||
63 | (defmethod gray:stream-write-string ((socket stream-socket) string &optional (start 0) (end (length string))) | |
64 | (gray:stream-write-sequence socket string start end)) | |
65 | ||
66 | (defmethod gray:stream-terpri ((socket stream-socket)) | |
67 | (gray:stream-write-char socket #\newline)) | |
68 | ||
69 | (defmethod 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 gray:stream-write-sequence ((socket stream-socket) seq &optional (start 0) (end (length seq))) | |
73 | (gray-stream-write-sequence socket seq start end)) | |
145f3cee FT |
74 | |
75 | ;;; Error cover-up | |
76 | ||
77 | (defmethod sb-bsd-sockets:socket-name ((sk sb-bsd-sockets:local-socket)) | |
78 | (simple-network-error "ECL does not support reading the name of Unix sockets.")) |