forked from netguy204/imp.el
-
Notifications
You must be signed in to change notification settings - Fork 19
/
impatient-mode.el
330 lines (282 loc) · 12.1 KB
/
impatient-mode.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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
;;; impatient-mode.el --- Serve buffers live over HTTP -*- lexical-binding: t; -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Brian Taylor <el.wubo@gmail.com>
;; Version: 1.1
;; URL: https://github.com/netguy204/imp.el
;; Package-Requires: ((emacs "24.3") (simple-httpd "1.5.0") (htmlize "1.40"))
;;; Commentary:
;; impatient-mode is a minor mode that publishes the live buffer
;; through the local simple-httpd server under /imp/live/<buffer-name>/.
;; To unpublish a buffer, toggle impatient-mode off.
;; Start the simple-httpd server (`httpd-start') and visit /imp/ on
;; the local server. There will be a listing of all the buffers that
;; currently have impatient-mode enabled. This is likely to be found
;; here:
;; http://localhost:8080/imp/
;; Except for html-mode buffers, buffers will be prettied up with
;; htmlize before being sent to clients. This can be toggled at any
;; time with `imp-toggle-htmlize'.
;; Because html-mode buffers are sent raw, you can use impatient-mode
;; see your edits to an HTML document live! This is perhaps the
;; primary motivation of this mode.
;; To receive updates the browser issues a long poll on the client
;; waiting for the buffer to change -- server push. The response
;; happens in an `after-change-functions' hook. Buffers that do not
;; run these hooks will not be displayed live to clients.
;;; Code:
(require 'cl-lib)
(require 'url-util)
(require 'simple-httpd)
(require 'htmlize)
(defgroup impatient nil
"Serve buffers live over HTTP."
:group 'comm)
(defcustom impatient-mode-delay nil
"The delay in seconds between a keypress and the browser reload.
Set to nil for no delay"
:group 'impatient
:type '(choice (const nil) integer))
(defcustom imp-default-user-filters '((mhtml-mode . nil)
(html-mode . nil)
(web-mode . nil))
"Alist indicating which filter should be used for which modes."
:group 'impatient
:type 'sexp)
(defvar-local imp--idle-timer nil
"A timer that goes off after `impatient-mode-delay' seconds of inactivity")
(defvar-local imp-user-filter #'imp-htmlize-filter
"Per buffer html-producing function by user.")
(defvar-local imp-client-list ()
"List of client processes watching the current buffer.")
(defvar-local imp-last-state 0
"State sequence number.")
(defvar-local imp-related-files nil
"Files that seem to be related to this buffer")
(defvar-local imp--buffer-dirty-p nil
"If non-nil, buffer has been modified but not sent to clients.")
(defvar impatient-mode-map (make-sparse-keymap)
"Keymap for impatient-mode.")
;;;###autoload
(define-minor-mode impatient-mode
"Serves the buffer live over HTTP."
:group 'impatient
:lighter " imp"
:keymap impatient-mode-map
(if (not impatient-mode)
(progn
(imp--cleanup-timer)
(remove-hook 'after-change-functions #'imp--on-change t))
(add-hook 'kill-buffer-hook #'imp--cleanup-timer nil t)
(add-hook 'after-change-functions #'imp--on-change nil t)
(imp-remove-user-filter)))
(defvar imp-shim-root (file-name-directory load-file-name)
"Location of data files needed by impatient-mode.")
(defun imp-set-user-filter (fn)
"Set a FN as user-defined filter for this buffer.
FUNCTION should accept one argument, the buffer to be filtered,
and will be evaluated with the output buffer set as the current
buffer."
(interactive "aCustom filter: ")
(setq imp-user-filter fn)
(cl-incf imp-last-state)
(imp--notify-clients))
(defun imp-remove-user-filter ()
"Set the user-defined filter for this buffer to the default."
(interactive)
(let ((lookup (assoc major-mode imp-default-user-filters)))
(if lookup
(imp-set-user-filter (cdr lookup))
(kill-local-variable 'imp-user-filter)))
(cl-incf imp-last-state)
(imp--notify-clients))
(defun imp-htmlize-filter (buffer)
"Htmlize BUFFER before sending to clients."
(let ((html-buffer (save-match-data (htmlize-buffer buffer))))
(princ (with-current-buffer html-buffer (buffer-string)))
(kill-buffer html-buffer)))
(defun imp-toggle-htmlize ()
"Toggle htmlize of buffer."
(interactive)
(if (eq imp-user-filter 'imp-htmlize-filter)
(imp-set-user-filter nil)
(imp-set-user-filter 'imp-htmlize-filter)))
(defun imp-visit-buffer (&optional arg)
"Visit the current buffer in a browser.
If given a prefix ARG, visit the buffer listing instead."
(interactive "P")
(unless (process-status "httpd")
(httpd-start))
(unless impatient-mode
(impatient-mode))
(let* ((proc (get-process "httpd"))
(proc-info (process-contact proc t))
(raw-host (plist-get proc-info :host))
(host (if (member raw-host
'(nil local "127.0.0.1" "::1" "0.0.0.0" "::"))
"localhost"
raw-host))
(local-addr (plist-get proc-info :local))
(port (aref local-addr (1- (length local-addr))))
(url (format "http://%s:%d/imp/" host port)))
(unless arg
(setq url (format "%slive/%s/" url (url-hexify-string (buffer-name)))))
(browse-url url)))
(defun imp-buffer-enabled-p (buffer)
"Return t if BUFFER has impatient-mode enabled."
(and buffer (with-current-buffer (get-buffer buffer) impatient-mode)))
(defun imp--buffer-list ()
"List of all buffers with impatient-mode enabled."
(cl-remove-if-not 'imp-buffer-enabled-p (buffer-list)))
(defun imp--should-not-cache-p (path)
"True if the PATH should be stamped with a no-cache header."
(let ((mime-type (httpd-get-mime (file-name-extension path))))
(member mime-type '("text/css" "text/html" "text/xml"
"text/plain" "text/javascript"))))
(defun httpd/imp/static (proc path _query req)
"Serve up static files."
(let* ((file (file-name-nondirectory path))
(clean (expand-file-name file imp-shim-root)))
(if (file-exists-p clean)
(httpd-send-file proc clean req)
(httpd-error proc 404))))
(defun imp-serve-buffer-list (proc)
"Serve a list of published buffers."
(with-httpd-buffer proc "text/html; charset=utf-8"
(insert "<html><head>\n")
(insert "<title>impatient-mode buffer list</title>\n")
(insert "</head><body>\n")
(insert "<h1>Public Buffers</h1>\n<hr/>")
(insert "<ul>\n")
(dolist (buffer (imp--buffer-list))
(insert (format "<li><a href=\"live/%s/\">%s</a></li>\n"
(url-hexify-string (buffer-name buffer))
(url-insert-entities-in-string (buffer-name buffer)))))
(insert "</ul>\n<hr/>")
(insert "Enable <code>impatient-mode</code> in buffers to publish them.")
(insert "</body></html>")))
(defun imp--private (proc buffer-name)
(httpd-error proc 403
(format "Buffer %s is private or doesn't exist." buffer-name)))
(defun httpd/imp/live (proc path _query req)
"Serve up the shim that lets us watch a buffer change."
(let* ((index (expand-file-name "index.html" imp-shim-root))
(decoded (url-unhex-string path))
(parts (cdr (split-string decoded "/")))
(buffer-name (nth 2 parts))
(file (httpd-clean-path (mapconcat 'identity (nthcdr 3 parts) "/")))
(buffer (get-buffer buffer-name))
(buffer-file (buffer-file-name buffer))
(buffer-dir (and buffer-file (file-name-directory buffer-file))))
(cond
((equal (file-name-directory decoded) "/imp/live/")
(httpd-redirect proc (concat decoded "/")))
((not (imp-buffer-enabled-p buffer)) (imp--private proc buffer-name))
((and (not (string= file "./")) buffer-dir)
(let* ((full-file-name (expand-file-name file buffer-dir))
(mime-type (httpd-get-mime (file-name-extension full-file-name)))
(live-buffer (cl-remove-if-not
(lambda (buf) (equal full-file-name (buffer-file-name buf)))
(imp--buffer-list))))
(with-current-buffer buffer-name
(add-to-list 'imp-related-files full-file-name))
(if live-buffer
(with-temp-buffer
(insert-buffer-substring (cl-first live-buffer))
(if (imp--should-not-cache-p decoded)
(httpd-send-header proc mime-type 200
:Cache-Control "no-cache")
(httpd-send-header proc mime-type 200
:Cache-Control
"max-age=60, must-revalidate")))
(httpd-send-file proc full-file-name req))))
(t (imp-buffer-enabled-p buffer) (httpd-send-file proc index req)))))
(defun httpd/imp (proc path &rest _)
(cond
((equal path "/imp") (httpd-redirect proc "/imp/"))
((equal path "/imp/") (imp-serve-buffer-list proc))
(t (httpd-error proc 403 (format "%s not found" path)))))
(defun imp--send-state (proc)
(let ((id (number-to-string imp-last-state))
(user-filter imp-user-filter)
(buffer (current-buffer)))
(with-temp-buffer
(let ((standard-output (current-buffer)))
(if user-filter
(funcall user-filter buffer)
(insert-buffer-substring buffer))
(httpd-send-header proc "text/html" 200
:Cache-Control "no-cache"
:X-Imp-Count id)))))
(defun imp--send-state-ignore-errors (proc)
(condition-case _
(imp--send-state proc)
(error nil)))
(defun imp--notify-clients ()
(while imp-client-list
(imp--send-state-ignore-errors (pop imp-client-list))))
(defun imp--cleanup-timer ()
"Destroy any timer associated with this buffer."
(when imp--idle-timer
(cancel-timer (cdr imp--idle-timer))
(setf imp--idle-timer nil)))
(defun imp--start-idle-timer ()
"Start/update the idle timer as appropriate."
(cond
;; Timer doesn't exist and shouldn't (do nothing)
((and (null impatient-mode-delay) (null imp--idle-timer)))
;; Timer exists when it shouldnt
((and (null impatient-mode-delay) imp--idle-timer)
(cancel-timer (cdr imp--idle-timer))
(setf imp--idle-timer nil))
;; Timer doesn't exist when it should
((and impatient-mode-delay (null imp--idle-timer))
(let* ((buffer (current-buffer))
(timer (run-with-idle-timer
impatient-mode-delay :repeat
(lambda ()
(with-current-buffer buffer
(imp--after-timeout))))))
(setf imp--idle-timer (cons impatient-mode-delay timer))))
;; Timer delay is incorrect
((not (eql (car imp--idle-timer) impatient-mode-delay))
(timer-set-idle-time (cdr imp--idle-timer)
impatient-mode-delay
:repeat)
(setf (car imp--idle-timer) impatient-mode-delay))))
(defun imp--on-change (&rest _)
"Hook for `after-change-functions'."
(imp--start-idle-timer)
(if impatient-mode-delay
(setf imp--buffer-dirty-p :dirty)
(imp--update-buffer)))
(defun imp--after-timeout ()
"Execute after `impatient-mode-delay' seconds of idleness."
(when imp--buffer-dirty-p
(imp--update-buffer))
(imp--start-idle-timer))
(defun imp--update-buffer ()
"Update this buffer in the browser."
(setf imp--buffer-dirty-p nil)
(cl-incf imp-last-state)
;; notify our clients
(imp--notify-clients)
;; notify any clients that we're in the `imp-related-files' list for
(let ((buffer-file (buffer-file-name (current-buffer))))
(dolist (buffer (imp--buffer-list))
(with-current-buffer buffer
(when (member buffer-file imp-related-files)
(imp--notify-clients))))))
(defun httpd/imp/buffer (proc path query &rest _)
"Servlet that accepts long poll requests."
(let* ((decoded (url-unhex-string path))
(buffer-name (file-name-nondirectory decoded))
(buffer (get-buffer buffer-name))
(req-last-id (string-to-number (or (cadr (assoc "id" query)) "0"))))
(if (imp-buffer-enabled-p buffer)
(with-current-buffer buffer
(if (equal req-last-id imp-last-state)
(push proc imp-client-list) ; this client is sync'd
(imp--send-state-ignore-errors proc))) ; this client is behind
(imp--private proc buffer-name))))
(provide 'impatient-mode)
;;; impatient-mode.el ends here