1 ;;; atomic-chrome.el --- Edit Chrome text area with Emacs using Atomic Chrome
3 ;; Copyright (C) 2016 alpha22jp <alpha22jp@gmail.com>
5 ;; Author: alpha22jp <alpha22jp@gmail.com>
6 ;; Package-Requires: ((emacs "24.3") (let-alist "1.0.4") (websocket "1.4"))
7 ;; Package-Version: 20171022.107
8 ;; Keywords: chrome edit textarea
9 ;; URL: https://github.com/alpha22jp/atomic-chrome
12 ;; This program is free software; you can redistribute it and/or modify it under
13 ;; the terms of the GNU General Public License as published by the Free Software
14 ;; Foundation; either version 2 of the License, or (at your option) any later
17 ;; This program is distributed in the hope that it will be useful, but WITHOUT
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
19 ;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
22 ;; You should have received a copy of the GNU General Public License along with
23 ;; this program; if not, write to the Free Software Foundation, Inc., 51
24 ;; Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
28 ;; This is the Emacs version of Atomic Chrome which is an extension for Google
29 ;; Chrome browser that allows you to edit text areas of the browser in Emacs.
31 ;; It's similar to Edit with Emacs, but has some advantages as below with the
35 ;; The input on Emacs is reflected to the browser instantly and continuously.
36 ;; * Bidirectional communication
37 ;; You can edit both on the browser and Emacs, they are synced to the same.
41 (eval-when-compile (require 'cl))
46 (defgroup atomic-chrome nil
47 "Edit Chrome text area with Emacs using Atomic Chrome."
48 :prefix "atomic-chrome-"
51 (defcustom atomic-chrome-extension-type-list '(atomic-chrome ghost-text)
52 "List of chrome extension type available."
53 :type '(repeat (choice (const :tag "Atomic Chrome" atomic-chrome)
54 (const :tag "Ghost Text" ghost-text)))
55 :group 'atomic-chrome)
57 (defcustom atomic-chrome-buffer-open-style 'split
58 "Specify the style to open new buffer for editing."
59 :type '(choice (const :tag "Open buffer with full window" full)
60 (const :tag "Open buffer with splitted window" split)
61 (const :tag "Open buffer with new frame" frame))
62 :group 'atomic-chrome)
64 (defcustom atomic-chrome-buffer-frame-width 80
65 "Width of editing buffer frame."
67 :group 'atomic-chrome)
69 (defcustom atomic-chrome-buffer-frame-height 25
70 "Height of editing buffer frame."
72 :group 'atomic-chrome)
74 (defcustom atomic-chrome-enable-auto-update t
75 "If non-nil, edit on Emacs is reflected to Chrome instantly, \
76 otherwise you need to type \"C-xC-s\" manually."
78 :group 'atomic-chrome)
80 (defcustom atomic-chrome-enable-bidirectional-edit t
81 "If non-nil, you can edit both on Chrome text area and Emacs, \
82 otherwise edit on Chrome is ignored while editing on Emacs."
84 :group 'atomic-chrome)
86 (defcustom atomic-chrome-default-major-mode 'text-mode
87 "Default major mode for editing buffer."
89 :group 'atomic-chrome)
91 (defcustom atomic-chrome-url-major-mode-alist nil
92 "Association list of URL regexp and corresponding major mode \
93 which is used to select major mode for specified website."
94 :type '(alist :key-type (regexp :tag "regexp")
95 :value-type (function :tag "major mode"))
96 :group 'atomic-chrome)
98 (defcustom atomic-chrome-edit-mode-hook nil
99 "Customizable hook which run when the editing buffer is created."
101 :group 'atomic-chrome)
103 (defcustom atomic-chrome-edit-done-hook nil
104 "Customizable hook which run when the editing buffer is closed."
106 :group 'atomic-chrome)
108 (defvar atomic-chrome-server-atomic-chrome nil
109 "Websocket server connection handle for Atomic Chrome.")
111 (defvar atomic-chrome-server-ghost-text nil
112 "Websocket server connection handle for Ghost Text.")
114 (defvar atomic-chrome-buffer-table (make-hash-table :test 'equal)
115 "Hash table of editing buffer and its assciated data.
116 Each element has a list consisting of (websocket, frame).")
118 (defun atomic-chrome-get-websocket (buffer)
119 "Lookup websocket associated with buffer BUFFER \
120 from `atomic-chrome-buffer-table'."
121 (nth 0 (gethash buffer atomic-chrome-buffer-table)))
123 (defun atomic-chrome-get-frame (buffer)
124 "Lookup frame associated with buffer BUFFER \
125 from `atomic-chrome-buffer-table'."
126 (nth 1 (gethash buffer atomic-chrome-buffer-table)))
128 (defun atomic-chrome-get-buffer-by-socket (socket)
129 "Lookup buffer which is associated to the websocket SOCKET \
130 from `atomic-chrome-buffer-table'."
132 (cl-loop for key being the hash-keys of atomic-chrome-buffer-table
133 using (hash-values val)
134 do (when (equal (nth 0 val) socket) (setq buffer key)))
137 (defun atomic-chrome-close-connection ()
138 "Close client connection associated with current buffer."
139 (let ((socket (atomic-chrome-get-websocket (current-buffer))))
141 (remhash (current-buffer) atomic-chrome-buffer-table)
142 (websocket-close socket))))
144 (defun atomic-chrome-send-buffer-text ()
145 "Send request to update text with current buffer content."
147 (let ((socket (atomic-chrome-get-websocket (current-buffer)))
148 (text (buffer-substring-no-properties (point-min) (point-max))))
149 (when (and socket text)
153 (if (eq (websocket-server-conn socket) atomic-chrome-server-ghost-text)
154 (list (cons "text" text))
155 (list '("type" . "updateText")
156 (cons "payload" (list (cons "text" text))))))))))
158 (defun atomic-chrome-set-major-mode (url)
159 "Set major mode for editing buffer depending on URL.
160 `atomic-chrome-url-major-mode-alist' can be used to select major mode.
161 The specified major mode is used if URL matches to one of the alist,
162 otherwise fallback to `atomic-chrome-default-major-mode'"
163 (funcall (or (and url (assoc-default url
164 atomic-chrome-url-major-mode-alist
166 atomic-chrome-default-major-mode)))
168 (defun atomic-chrome-show-edit-buffer (buffer title)
169 "Show editing buffer BUFFER by creating a frame with title TITLE, \
170 or raising the selected frame depending on `atomic-chrome-buffer-open-style'."
171 (let ((edit-frame nil)
172 (frame-params (list (cons 'name (format "Atomic Chrome: %s" title))
173 (cons 'width atomic-chrome-buffer-frame-width)
174 (cons 'height atomic-chrome-buffer-frame-height))))
175 (when (eq atomic-chrome-buffer-open-style 'frame)
177 (if (memq window-system '(ns mac))
178 ;; Avoid using make-frame-on-display for Mac OS.
179 (make-frame frame-params)
180 (make-frame-on-display
181 (if (eq system-type 'windows-nt) "w32" (getenv "DISPLAY"))
183 (select-frame edit-frame))
184 (if (eq atomic-chrome-buffer-open-style 'split)
185 (pop-to-buffer buffer)
186 (switch-to-buffer buffer))
187 (raise-frame edit-frame)
188 (select-frame-set-input-focus (window-frame (selected-window)))
191 (defun atomic-chrome-create-buffer (socket url title text)
192 "Create buffer associated with websocket specified by SOCKET.
193 URL is used to determine the major mode of the buffer created,
194 TITLE is used for the buffer name and TEXT is inserted to the buffer."
195 (let ((buffer (generate-new-buffer title)))
196 (with-current-buffer buffer
198 (list socket (atomic-chrome-show-edit-buffer buffer title))
199 atomic-chrome-buffer-table)
200 (atomic-chrome-set-major-mode url)
203 (defun atomic-chrome-close-edit-buffer (buffer)
204 "Close buffer BUFFER if it's one of Atomic Chrome edit buffers."
205 (let ((frame (atomic-chrome-get-frame buffer)))
206 (with-current-buffer buffer
208 (run-hooks 'atomic-chrome-edit-done-hook)
209 (when frame (delete-frame frame))
210 (if (eq atomic-chrome-buffer-open-style 'split)
212 (kill-buffer buffer))))))
214 (defun atomic-chrome-close-current-buffer ()
215 "Close current buffer and connection from client."
217 (atomic-chrome-close-edit-buffer (current-buffer)))
219 (defun atomic-chrome-update-buffer (socket text)
220 "Update text on buffer associated with SOCKET to TEXT."
221 (let ((buffer (atomic-chrome-get-buffer-by-socket socket)))
223 (with-current-buffer buffer
227 (defun atomic-chrome-on-message (socket frame)
228 "Function to handle data received from websocket client specified by SOCKET, \
229 where FRAME show raw data received."
230 (let ((msg (json-read-from-string
231 (decode-coding-string
232 (encode-coding-string (websocket-frame-payload frame) 'utf-8)
235 (if (eq (websocket-server-conn socket) atomic-chrome-server-ghost-text)
236 (if (atomic-chrome-get-buffer-by-socket socket)
237 (atomic-chrome-update-buffer socket .text)
238 (atomic-chrome-create-buffer socket .url .title .text))
239 (cond ((string= .type "register")
240 (atomic-chrome-create-buffer socket .payload.url .payload.title .payload.text))
241 ((string= .type "updateText")
242 (when atomic-chrome-enable-bidirectional-edit
243 (atomic-chrome-update-buffer socket .payload.text))))))))
245 (defun atomic-chrome-on-close (socket)
246 "Function to handle request from client to close websocket SOCKET."
247 (let ((buffer (atomic-chrome-get-buffer-by-socket socket)))
248 (when buffer (atomic-chrome-close-edit-buffer buffer))))
250 (defvar atomic-chrome-edit-mode-map
251 (let ((map (make-sparse-keymap)))
252 (define-key map (kbd "C-x C-s") 'atomic-chrome-send-buffer-text)
253 (define-key map (kbd "C-c C-c") 'atomic-chrome-close-current-buffer)
255 "Keymap for minor mode `atomic-chrome-edit-mode'.")
257 (define-minor-mode atomic-chrome-edit-mode
258 "Minor mode enabled on buffers opened by Emacs Chrome server."
259 :group 'atomic-chrome
260 :lighter " AtomicChrome"
262 :keymap atomic-chrome-edit-mode-map
263 (when atomic-chrome-edit-mode
264 (add-hook 'kill-buffer-hook 'atomic-chrome-close-connection nil t)
265 (when atomic-chrome-enable-auto-update
266 (add-hook 'post-command-hook 'atomic-chrome-send-buffer-text nil t))))
268 (defun atomic-chrome-turn-on-edit-mode ()
269 "Turn on `atomic-chrome-edit-mode' if the buffer is an editing buffer."
270 (when (gethash (current-buffer) atomic-chrome-buffer-table)
271 (atomic-chrome-edit-mode t)))
273 (define-global-minor-mode global-atomic-chrome-edit-mode
274 atomic-chrome-edit-mode atomic-chrome-turn-on-edit-mode)
276 (defun atomic-chrome-start-websocket-server (port)
277 "Create websocket server on port PORT."
281 :on-message #'atomic-chrome-on-message
283 :on-close #'atomic-chrome-on-close))
285 (defun atomic-chrome-start-httpd ()
286 "Start the HTTP server for Ghost Text query."
288 (make-network-process
289 :name "atomic-chrome-httpd"
293 :filter 'atomic-chrome-httpd-process-filter
294 :filter-multibyte nil
298 (defun atomic-chrome-normalize-header (header)
299 "Destructively capitalize the components of HEADER."
300 (mapconcat #'capitalize (split-string header "-") "-"))
302 (defun atomic-chrome-httpd-parse-string (string)
303 "Parse client http header STRING into alist."
304 (let* ((lines (split-string string "[\n\r]+"))
305 (req (list (split-string (car lines))))
306 (post (cadr (split-string string "\r\n\r\n"))))
307 (dolist (line (butlast (cdr lines)))
308 (push (list (atomic-chrome-normalize-header (car (split-string line ": ")))
309 (mapconcat #'identity
310 (cdr (split-string line ": ")) ": "))
312 (push (list "Content" post) req)
315 (defun atomic-chrome-httpd-process-filter (proc string)
316 "Process filter of PROC which run each time client make a request.
317 STRING is the string process received."
318 (setf string (concat (process-get proc :previous-string) string))
319 (let* ((request (atomic-chrome-httpd-parse-string string))
320 (content-length (cadr (assoc "Content-Length" request)))
321 (uri (cl-cadar request))
322 (content (cadr (assoc "Content" request))))
323 (if (and content-length
324 (< (string-bytes content) (string-to-number content-length)))
325 (process-put proc :previous-string string)
326 (atomic-chrome-httpd-send-response proc))))
328 (defun atomic-chrome-httpd-send-response (proc)
329 "Send an HTTP 200 OK response back to process PROC."
330 (when (processp proc)
331 (unless atomic-chrome-server-ghost-text
332 (setq atomic-chrome-server-ghost-text
333 (atomic-chrome-start-websocket-server 64293)))
334 (let ((header "HTTP/1.0 200 OK\nContent-Type: application/json\n")
335 (body (json-encode '(:ProtocolVersion 1 :WebSocketPort 64293))))
336 (process-send-string proc (concat header "\n" body))
337 (process-send-eof proc))))
340 (defun atomic-chrome-start-server ()
341 "Start websocket server for atomic-chrome."
343 (and (not atomic-chrome-server-atomic-chrome)
344 (memq 'atomic-chrome atomic-chrome-extension-type-list)
345 (setq atomic-chrome-server-atomic-chrome
346 (atomic-chrome-start-websocket-server 64292)))
347 (and (not (process-status "atomic-chrome-httpd"))
348 (memq 'ghost-text atomic-chrome-extension-type-list)
349 (atomic-chrome-start-httpd))
350 (global-atomic-chrome-edit-mode 1))
353 (defun atomic-chrome-stop-server nil
354 "Stop websocket server for atomic-chrome."
356 (when atomic-chrome-server-atomic-chrome
357 (websocket-server-close atomic-chrome-server-atomic-chrome)
358 (setq atomic-chrome-server-atomic-chrome nil))
359 (when atomic-chrome-server-ghost-text
360 (websocket-server-close atomic-chrome-server-ghost-text)
361 (setq atomic-chrome-server-ghost-text nil))
362 (when (process-status "atomic-chrome-httpd")
363 (delete-process "atomic-chrome-httpd"))
364 (global-atomic-chrome-edit-mode 0))
366 (provide 'atomic-chrome)
368 ;;; atomic-chrome.el ends here