auto-install/atomic-chrome.el

   1 ;;; atomic-chrome.el --- Edit Chrome text area with Emacs using Atomic Chrome
   2
   3 ;; Copyright (C) 2016 alpha22jp <alpha22jp@gmail.com>
   4
   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
  10 ;; Version: 2.0.0
  11
  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
  15 ;; version.
  16
  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
  20 ;; details.
  21
  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.
  25
  26 ;;; Commentary:
  27
  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.
  30 ;;
  31 ;; It's similar to Edit with Emacs, but has some advantages as below with the
  32 ;; help of websocket.
  33 ;;
  34 ;; * Live update
  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.
  38
  39 ;;; Code:
  40
  41 (eval-when-compile (require 'cl))
  42 (require 'json)
  43 (require 'let-alist)
  44 (require 'websocket)
  45
  46 (defgroup atomic-chrome nil
  47   "Edit Chrome text area with Emacs using Atomic Chrome."
  48   :prefix "atomic-chrome-"
  49   :group 'applications)
  50
  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)
  56
  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)
  63
  64 (defcustom atomic-chrome-buffer-frame-width 80
  65   "Width of editing buffer frame."
  66   :type 'integer
  67   :group 'atomic-chrome)
  68
  69 (defcustom atomic-chrome-buffer-frame-height 25
  70   "Height of editing buffer frame."
  71   :type 'integer
  72   :group 'atomic-chrome)
  73
  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."
  77   :type 'boolean
  78   :group 'atomic-chrome)
  79
  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."
  83   :type 'boolean
  84   :group 'atomic-chrome)
  85
  86 (defcustom atomic-chrome-default-major-mode 'text-mode
  87   "Default major mode for editing buffer."
  88   :type 'function
  89   :group 'atomic-chrome)
  90
  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)
  97
  98 (defcustom atomic-chrome-edit-mode-hook nil
  99   "Customizable hook which run when the editing buffer is created."
 100   :type 'hook
 101   :group 'atomic-chrome)
 102
 103 (defcustom atomic-chrome-edit-done-hook nil
 104   "Customizable hook which run when the editing buffer is closed."
 105   :type 'hook
 106   :group 'atomic-chrome)
 107
 108 (defvar atomic-chrome-server-atomic-chrome nil
 109   "Websocket server connection handle for Atomic Chrome.")
 110
 111 (defvar atomic-chrome-server-ghost-text nil
 112   "Websocket server connection handle for Ghost Text.")
 113
 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).")
 117
 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)))
 122
 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)))
 127
 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'."
 131   (let (buffer)
 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)))
 135     buffer))
 136
 137 (defun atomic-chrome-close-connection ()
 138   "Close client connection associated with current buffer."
 139   (let ((socket (atomic-chrome-get-websocket (current-buffer))))
 140     (when socket
 141       (remhash (current-buffer) atomic-chrome-buffer-table)
 142       (websocket-close socket))))
 143
 144 (defun atomic-chrome-send-buffer-text ()
 145   "Send request to update text with current buffer content."
 146   (interactive)
 147   (let ((socket (atomic-chrome-get-websocket (current-buffer)))
 148         (text (buffer-substring-no-properties (point-min) (point-max))))
 149     (when (and socket text)
 150       (websocket-send-text
 151        socket
 152        (json-encode
 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))))))))))
 157
 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
 165                                        'string-match))
 166                atomic-chrome-default-major-mode)))
 167
 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)
 176       (setq edit-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"))
 182                frame-params)))
 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)))
 189     edit-frame))
 190
 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
 197       (puthash buffer
 198              (list socket (atomic-chrome-show-edit-buffer buffer title))
 199              atomic-chrome-buffer-table)
 200       (atomic-chrome-set-major-mode url)
 201       (insert text))))
 202
 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
 207       (save-restriction
 208         (run-hooks 'atomic-chrome-edit-done-hook)
 209         (when frame (delete-frame frame))
 210         (if (eq atomic-chrome-buffer-open-style 'split)
 211             (quit-window t)
 212           (kill-buffer buffer))))))
 213
 214 (defun atomic-chrome-close-current-buffer ()
 215   "Close current buffer and connection from client."
 216   (interactive)
 217   (atomic-chrome-close-edit-buffer (current-buffer)))
 218
 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)))
 222     (when buffer
 223       (with-current-buffer buffer
 224         (erase-buffer)
 225         (insert text)))))
 226
 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)
 233                'utf-8))))
 234     (let-alist msg
 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))))))))
 244
 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))))
 249
 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)
 254     map)
 255   "Keymap for minor mode `atomic-chrome-edit-mode'.")
 256
 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"
 261   :init-value nil
 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))))
 267
 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)))
 272
 273 (define-global-minor-mode global-atomic-chrome-edit-mode
 274   atomic-chrome-edit-mode atomic-chrome-turn-on-edit-mode)
 275
 276 (defun atomic-chrome-start-websocket-server (port)
 277   "Create websocket server on port PORT."
 278   (websocket-server
 279    port
 280    :host 'local
 281    :on-message #'atomic-chrome-on-message
 282    :on-open nil
 283    :on-close #'atomic-chrome-on-close))
 284
 285 (defun atomic-chrome-start-httpd ()
 286   "Start the HTTP server for Ghost Text query."
 287   (interactive)
 288   (make-network-process
 289    :name "atomic-chrome-httpd"
 290    :family 'ipv4
 291    :host 'local
 292    :service 4001
 293    :filter 'atomic-chrome-httpd-process-filter
 294    :filter-multibyte nil
 295    :server t
 296    :noquery t))
 297
 298 (defun atomic-chrome-normalize-header (header)
 299   "Destructively capitalize the components of HEADER."
 300   (mapconcat #'capitalize (split-string header "-") "-"))
 301
 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 ": ")) ": "))
 311             req))
 312     (push (list "Content" post) req)
 313     (reverse req)))
 314
 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))))
 327
 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))))
 338
 339 ;;;###autoload
 340 (defun atomic-chrome-start-server ()
 341   "Start websocket server for atomic-chrome."
 342   (interactive)
 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))
 351
 352 ;;;###autoload
 353 (defun atomic-chrome-stop-server nil
 354   "Stop websocket server for atomic-chrome."
 355   (interactive)
 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))
 365
 366 (provide 'atomic-chrome)
 367
 368 ;;; atomic-chrome.el ends here