-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathwebsocket-client.el
164 lines (138 loc) · 6.02 KB
/
websocket-client.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
;;; websocket-client --- -*- lexical-binding: t -*-
;; Package-Requires: ((emacs "24.4") (websocket "20170829.457"))
;;; Commentary:
;;; Code:
(require 'websocket)
(defgroup websocket-client-mode nil
"WebSockets repl."
:group 'websocket)
(defface ws-server-header '((t :foreground "MediumBlue"))
"Face for server message headings."
:group 'websocket-client-mode)
(defface ws-client-header '((t :foreground "grey50"))
"Face for client message headings"
:group 'websocket-client-mode)
(defface ws-client-text '((t :foreground "grey70"))
"Face for client message headings"
:group 'websocket-client-mode)
(defvar-local wsc-output-marker nil)
(defvar-local wsc-prompt-marker nil)
(defvar-local wsc-websocket nil)
(defvar websocket-client-extra-headers nil
"A list of (header-name . header-value) pairs to send with the websocket handshake.")
(defvar-local wsc-custom-headers nil
"Record the custom headers used when opening a websocket.")
(defvar wsc-ping-interval 15
"If non-nil, the client will ping the server every WSC-PING-INTERVAL seconds.")
(defvar-local wsc-ping-timer nil
"The timer object for sending a periodic keepalive ping.")
(defsubst wsc-at-prompt-p ()
"Return t if point is at the prompt."
(>= (point) wsc-prompt-marker))
(defun wsc-insert-output (ws &rest text)
"In buffer for WS, insert TEXT at `wsc-output-marker'."
(if ws
(with-current-buffer (process-buffer (websocket-conn ws))
(save-excursion
(goto-char wsc-output-marker)
(apply 'insert text)))
(save-excursion
(goto-char wsc-output-marker)
(apply 'insert text))))
(defun wsc-header (incoming)
"Return a string header to place above a message.
INCOMING should be t for messages from the server and nil
otherwise."
(propertize
(format "[%s - %s]"
(format-time-string "%Y-%m-%d %H:%M:%S")
(if incoming "server" "client"))
'font-lock-face
(if incoming 'ws-server-header 'ws-client-header)))
(defun wsc-maybe-send ()
"If point is at the prompt, send the current text to the server."
(interactive)
(when (wsc-at-prompt-p)
(let ((text (buffer-substring-no-properties wsc-prompt-marker (point-max))))
(wsc-insert-output nil "\n" (wsc-header nil) "\n"
(propertize text 'font-lock-face 'ws-client-text))
(delete-region wsc-prompt-marker (point-max))
(condition-case nil
(wsc-send-input text)
(websocket-closed (wsc-on-close wsc-websocket))))))
(defun wsc-send-input (string)
"Send STRING to the server."
(websocket-send-text wsc-websocket string))
(defun wsc-send-ping (&optional buffer)
"Send a ping message to the server.
BUFFER is the process buffer of the websocket to ping."
(with-current-buffer (or buffer (current-buffer))
(condition-case nil
(websocket-send wsc-websocket (make-websocket-frame :opcode 'ping
:completep t))
(websocket-closed nil))))
(defun websocket-client-open (url)
"Open an interactive buffer to communicate with a websocket at URL."
(interactive "MWebSocket url: ")
(let ((buf (get-buffer-create (format "*ws: %s*" url))))
(pop-to-buffer buf)
(unless wsc-prompt-marker
(erase-buffer)
(websocket-client-mode)
(insert "\n\n> ")
(put-text-property (- (point) 2) (point) 'rear-nonsticky '(read-only))
(put-text-property (- (point) 2) (point) 'font-lock-face 'comint-highlight-prompt)
(put-text-property (- (point) 2) (point) 'read-only t)
(setq wsc-output-marker (make-marker))
(setq wsc-prompt-marker (make-marker))
(set-marker-insertion-type wsc-output-marker t)
(set-marker-insertion-type wsc-prompt-marker nil)
(set-marker wsc-output-marker (point-min))
(set-marker wsc-prompt-marker (point-max)))
(setq wsc-websocket (websocket-open url
:on-open (lambda (ws) (wsc-on-open ws buf))
:on-message 'wsc-on-message
:on-close 'wsc-on-close
:on-error 'wsc-on-error
:custom-header-alist websocket-client-extra-headers))
(setq wsc-custom-headers websocket-client-extra-headers)
(wsc-init-ws wsc-websocket buf)))
(defvar websocket-client-mode-map
(let ((map (make-keymap)))
(define-key map (kbd "RET") 'wsc-maybe-send)
map))
(define-derived-mode websocket-client-mode fundamental-mode "WS"
"Major mode for sending commands to a websocket server.")
(defun wsc-init-ws (ws buf)
"Bind WS to BUF."
(set-process-buffer (websocket-conn ws) buf)
(with-current-buffer buf (setq wsc-websocket ws)))
(defun wsc-on-open (ws buf)
"Called when the connection is established for WS.
BUF is the websocket-client buffer for WS."
(wsc-init-ws ws buf)
(wsc-insert-output ws (format "\n[%s - connected to %s]"
(format-time-string "%Y-%m-%d %H:%M:%S")
(websocket-url ws)))
(setq wsc-ping-timer (run-at-time wsc-ping-interval wsc-ping-interval
'wsc-send-ping (current-buffer))))
(defun wsc-on-message (ws frame)
"Called when WS receives FRAME."
(wsc-insert-output ws "\n" (wsc-header t)
"\n" (websocket-frame-payload frame)))
(defun wsc-on-close (ws)
"Called when WS is closed by peer."
(wsc-insert-output ws (format "\n[%s - %s closed connection]"
(format-time-string "%Y-%m-%d %H:%M:%S")
(websocket-url ws)))
(with-current-buffer (process-buffer (websocket-conn ws))
(when wsc-ping-timer
(cancel-timer wsc-ping-timer)
(setq wsc-ping-timer nil))))
(defun wsc-on-error (ws type err)
"Called when WS had a TYPE error ERR."
(wsc-insert-output ws (propertize "ERROR" 'font-lock-face 'error)
(format " in callback `%S': %s" type
(websocket-format-error err))))
(provide 'websocket-client)
;;; websocket-client.el ends here