Enabled initialization of IP addresses from another host address.
[lisp-utils.git] / net-sbcl.lisp
... / ...
CommitLineData
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)