X-Git-Url: http://g0dil.de/git?a=blobdiff_plain;f=auto-install%2Fatomic-chrome.el;fp=auto-install%2Fatomic-chrome.el;h=f1750dabca82cfe05377d3578640a228db280c38;hb=a13a166794e1e6f22407e13110fe83b9cb095ab8;hp=0000000000000000000000000000000000000000;hpb=844f5833be3c5f0d48e1b3b900c592841f0516d6;p=emacs-init.git

diff --git a/auto-install/atomic-chrome.el b/auto-install/atomic-chrome.el
new file mode 100644
index 0000000..f1750da
--- /dev/null
+++ b/auto-install/atomic-chrome.el
@@ -0,0 +1,368 @@
+;;; atomic-chrome.el --- Edit Chrome text area with Emacs using Atomic Chrome
+
+;; Copyright (C) 2016 alpha22jp <alpha22jp@gmail.com>
+
+;; Author: alpha22jp <alpha22jp@gmail.com>
+;; Package-Requires: ((emacs "24.3") (let-alist "1.0.4") (websocket "1.4"))
+;; Package-Version: 20171022.107
+;; Keywords: chrome edit textarea
+;; URL: https://github.com/alpha22jp/atomic-chrome
+;; Version: 2.0.0
+
+;; This program is free software; you can redistribute it and/or modify it under
+;; the terms of the GNU General Public License as published by the Free Software
+;; Foundation; either version 2 of the License, or (at your option) any later
+;; version.
+
+;; This program is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+;; details.
+
+;; You should have received a copy of the GNU General Public License along with
+;; this program; if not, write to the Free Software Foundation, Inc., 51
+;; Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This is the Emacs version of Atomic Chrome which is an extension for Google
+;; Chrome browser that allows you to edit text areas of the browser in Emacs.
+;;
+;; It's similar to Edit with Emacs, but has some advantages as below with the
+;; help of websocket.
+;;
+;; * Live update
+;;   The input on Emacs is reflected to the browser instantly and continuously.
+;; * Bidirectional communication
+;;   You can edit both on the browser and Emacs, they are synced to the same.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'json)
+(require 'let-alist)
+(require 'websocket)
+
+(defgroup atomic-chrome nil
+  "Edit Chrome text area with Emacs using Atomic Chrome."
+  :prefix "atomic-chrome-"
+  :group 'applications)
+
+(defcustom atomic-chrome-extension-type-list '(atomic-chrome ghost-text)
+  "List of chrome extension type available."
+  :type '(repeat (choice (const :tag "Atomic Chrome" atomic-chrome)
+                         (const :tag "Ghost Text" ghost-text)))
+  :group 'atomic-chrome)
+
+(defcustom atomic-chrome-buffer-open-style 'split
+  "Specify the style to open new buffer for editing."
+  :type '(choice (const :tag "Open buffer with full window" full)
+                 (const :tag "Open buffer with splitted window" split)
+                 (const :tag "Open buffer with new frame" frame))
+  :group 'atomic-chrome)
+
+(defcustom atomic-chrome-buffer-frame-width 80
+  "Width of editing buffer frame."
+  :type 'integer
+  :group 'atomic-chrome)
+
+(defcustom atomic-chrome-buffer-frame-height 25
+  "Height of editing buffer frame."
+  :type 'integer
+  :group 'atomic-chrome)
+
+(defcustom atomic-chrome-enable-auto-update t
+  "If non-nil, edit on Emacs is reflected to Chrome instantly, \
+otherwise you need to type \"C-xC-s\" manually."
+  :type 'boolean
+  :group 'atomic-chrome)
+
+(defcustom atomic-chrome-enable-bidirectional-edit t
+  "If non-nil, you can edit both on Chrome text area and Emacs, \
+otherwise edit on Chrome is ignored while editing on Emacs."
+  :type 'boolean
+  :group 'atomic-chrome)
+
+(defcustom atomic-chrome-default-major-mode 'text-mode
+  "Default major mode for editing buffer."
+  :type 'function
+  :group 'atomic-chrome)
+
+(defcustom atomic-chrome-url-major-mode-alist nil
+  "Association list of URL regexp and corresponding major mode \
+which is used to select major mode for specified website."
+  :type '(alist :key-type (regexp :tag "regexp")
+                :value-type (function :tag "major mode"))
+  :group 'atomic-chrome)
+
+(defcustom atomic-chrome-edit-mode-hook nil
+  "Customizable hook which run when the editing buffer is created."
+  :type 'hook
+  :group 'atomic-chrome)
+
+(defcustom atomic-chrome-edit-done-hook nil
+  "Customizable hook which run when the editing buffer is closed."
+  :type 'hook
+  :group 'atomic-chrome)
+
+(defvar atomic-chrome-server-atomic-chrome nil
+  "Websocket server connection handle for Atomic Chrome.")
+
+(defvar atomic-chrome-server-ghost-text nil
+  "Websocket server connection handle for Ghost Text.")
+
+(defvar atomic-chrome-buffer-table (make-hash-table :test 'equal)
+  "Hash table of editing buffer and its assciated data.
+Each element has a list consisting of (websocket, frame).")
+
+(defun atomic-chrome-get-websocket (buffer)
+  "Lookup websocket associated with buffer BUFFER \
+from `atomic-chrome-buffer-table'."
+  (nth 0 (gethash buffer atomic-chrome-buffer-table)))
+
+(defun atomic-chrome-get-frame (buffer)
+  "Lookup frame associated with buffer BUFFER \
+from `atomic-chrome-buffer-table'."
+  (nth 1 (gethash buffer atomic-chrome-buffer-table)))
+
+(defun atomic-chrome-get-buffer-by-socket (socket)
+  "Lookup buffer which is associated to the websocket SOCKET \
+from `atomic-chrome-buffer-table'."
+  (let (buffer)
+    (cl-loop for key being the hash-keys of atomic-chrome-buffer-table
+             using (hash-values val)
+             do (when (equal (nth 0 val) socket) (setq buffer key)))
+    buffer))
+
+(defun atomic-chrome-close-connection ()
+  "Close client connection associated with current buffer."
+  (let ((socket (atomic-chrome-get-websocket (current-buffer))))
+    (when socket
+      (remhash (current-buffer) atomic-chrome-buffer-table)
+      (websocket-close socket))))
+
+(defun atomic-chrome-send-buffer-text ()
+  "Send request to update text with current buffer content."
+  (interactive)
+  (let ((socket (atomic-chrome-get-websocket (current-buffer)))
+        (text (buffer-substring-no-properties (point-min) (point-max))))
+    (when (and socket text)
+      (websocket-send-text
+       socket
+       (json-encode
+        (if (eq (websocket-server-conn socket) atomic-chrome-server-ghost-text)
+            (list (cons "text" text))
+          (list '("type" . "updateText")
+                (cons "payload" (list (cons "text" text))))))))))
+
+(defun atomic-chrome-set-major-mode (url)
+  "Set major mode for editing buffer depending on URL.
+`atomic-chrome-url-major-mode-alist' can be used to select major mode.
+The specified major mode is used if URL matches to one of the alist,
+otherwise fallback to `atomic-chrome-default-major-mode'"
+  (funcall (or (and url (assoc-default url
+                                       atomic-chrome-url-major-mode-alist
+                                       'string-match))
+               atomic-chrome-default-major-mode)))
+
+(defun atomic-chrome-show-edit-buffer (buffer title)
+  "Show editing buffer BUFFER by creating a frame with title TITLE, \
+or raising the selected frame depending on `atomic-chrome-buffer-open-style'."
+  (let ((edit-frame nil)
+        (frame-params (list (cons 'name (format "Atomic Chrome: %s" title))
+                            (cons 'width atomic-chrome-buffer-frame-width)
+                            (cons 'height atomic-chrome-buffer-frame-height))))
+    (when (eq atomic-chrome-buffer-open-style 'frame)
+      (setq edit-frame
+            (if (memq window-system '(ns mac))
+                ;; Avoid using make-frame-on-display for Mac OS.
+                (make-frame frame-params)
+              (make-frame-on-display
+               (if (eq system-type 'windows-nt) "w32" (getenv "DISPLAY"))
+               frame-params)))
+      (select-frame edit-frame))
+    (if (eq atomic-chrome-buffer-open-style 'split)
+        (pop-to-buffer buffer)
+      (switch-to-buffer buffer))
+    (raise-frame edit-frame)
+    (select-frame-set-input-focus (window-frame (selected-window)))
+    edit-frame))
+
+(defun atomic-chrome-create-buffer (socket url title text)
+  "Create buffer associated with websocket specified by SOCKET.
+URL is used to determine the major mode of the buffer created,
+TITLE is used for the buffer name and TEXT is inserted to the buffer."
+  (let ((buffer (generate-new-buffer title)))
+    (with-current-buffer buffer
+      (puthash buffer
+             (list socket (atomic-chrome-show-edit-buffer buffer title))
+             atomic-chrome-buffer-table)
+      (atomic-chrome-set-major-mode url)
+      (insert text))))
+
+(defun atomic-chrome-close-edit-buffer (buffer)
+  "Close buffer BUFFER if it's one of Atomic Chrome edit buffers."
+  (let ((frame (atomic-chrome-get-frame buffer)))
+    (with-current-buffer buffer
+      (save-restriction
+        (run-hooks 'atomic-chrome-edit-done-hook)
+        (when frame (delete-frame frame))
+        (if (eq atomic-chrome-buffer-open-style 'split)
+            (quit-window t)
+          (kill-buffer buffer))))))
+
+(defun atomic-chrome-close-current-buffer ()
+  "Close current buffer and connection from client."
+  (interactive)
+  (atomic-chrome-close-edit-buffer (current-buffer)))
+
+(defun atomic-chrome-update-buffer (socket text)
+  "Update text on buffer associated with SOCKET to TEXT."
+  (let ((buffer (atomic-chrome-get-buffer-by-socket socket)))
+    (when buffer
+      (with-current-buffer buffer
+        (erase-buffer)
+        (insert text)))))
+
+(defun atomic-chrome-on-message (socket frame)
+  "Function to handle data received from websocket client specified by SOCKET, \
+where FRAME show raw data received."
+  (let ((msg (json-read-from-string
+              (decode-coding-string
+               (encode-coding-string (websocket-frame-payload frame) 'utf-8)
+               'utf-8))))
+    (let-alist msg
+      (if (eq (websocket-server-conn socket) atomic-chrome-server-ghost-text)
+          (if (atomic-chrome-get-buffer-by-socket socket)
+              (atomic-chrome-update-buffer socket .text)
+            (atomic-chrome-create-buffer socket .url .title .text))
+        (cond ((string= .type "register")
+               (atomic-chrome-create-buffer socket .payload.url .payload.title .payload.text))
+              ((string= .type "updateText")
+               (when atomic-chrome-enable-bidirectional-edit
+                 (atomic-chrome-update-buffer socket .payload.text))))))))
+
+(defun atomic-chrome-on-close (socket)
+  "Function to handle request from client to close websocket SOCKET."
+  (let ((buffer (atomic-chrome-get-buffer-by-socket socket)))
+    (when buffer (atomic-chrome-close-edit-buffer buffer))))
+
+(defvar atomic-chrome-edit-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "C-x C-s") 'atomic-chrome-send-buffer-text)
+    (define-key map (kbd "C-c C-c") 'atomic-chrome-close-current-buffer)
+    map)
+  "Keymap for minor mode `atomic-chrome-edit-mode'.")
+
+(define-minor-mode atomic-chrome-edit-mode
+  "Minor mode enabled on buffers opened by Emacs Chrome server."
+  :group 'atomic-chrome
+  :lighter " AtomicChrome"
+  :init-value nil
+  :keymap atomic-chrome-edit-mode-map
+  (when atomic-chrome-edit-mode
+    (add-hook 'kill-buffer-hook 'atomic-chrome-close-connection nil t)
+    (when atomic-chrome-enable-auto-update
+      (add-hook 'post-command-hook 'atomic-chrome-send-buffer-text nil t))))
+
+(defun atomic-chrome-turn-on-edit-mode ()
+  "Turn on `atomic-chrome-edit-mode' if the buffer is an editing buffer."
+  (when (gethash (current-buffer) atomic-chrome-buffer-table)
+    (atomic-chrome-edit-mode t)))
+
+(define-global-minor-mode global-atomic-chrome-edit-mode
+  atomic-chrome-edit-mode atomic-chrome-turn-on-edit-mode)
+
+(defun atomic-chrome-start-websocket-server (port)
+  "Create websocket server on port PORT."
+  (websocket-server
+   port
+   :host 'local
+   :on-message #'atomic-chrome-on-message
+   :on-open nil
+   :on-close #'atomic-chrome-on-close))
+
+(defun atomic-chrome-start-httpd ()
+  "Start the HTTP server for Ghost Text query."
+  (interactive)
+  (make-network-process
+   :name "atomic-chrome-httpd"
+   :family 'ipv4
+   :host 'local
+   :service 4001
+   :filter 'atomic-chrome-httpd-process-filter
+   :filter-multibyte nil
+   :server t
+   :noquery t))
+
+(defun atomic-chrome-normalize-header (header)
+  "Destructively capitalize the components of HEADER."
+  (mapconcat #'capitalize (split-string header "-") "-"))
+
+(defun atomic-chrome-httpd-parse-string (string)
+  "Parse client http header STRING into alist."
+  (let* ((lines (split-string string "[\n\r]+"))
+         (req (list (split-string (car lines))))
+         (post (cadr (split-string string "\r\n\r\n"))))
+    (dolist (line (butlast (cdr lines)))
+      (push (list (atomic-chrome-normalize-header (car (split-string line ": ")))
+                  (mapconcat #'identity
+                             (cdr (split-string line ": ")) ": "))
+            req))
+    (push (list "Content" post) req)
+    (reverse req)))
+
+(defun atomic-chrome-httpd-process-filter (proc string)
+  "Process filter of PROC which run each time client make a request.
+STRING is the string process received."
+  (setf string (concat (process-get proc :previous-string) string))
+  (let* ((request (atomic-chrome-httpd-parse-string string))
+         (content-length (cadr (assoc "Content-Length" request)))
+         (uri (cl-cadar request))
+         (content (cadr (assoc "Content" request))))
+    (if (and content-length
+             (< (string-bytes content) (string-to-number content-length)))
+        (process-put proc :previous-string string)
+      (atomic-chrome-httpd-send-response proc))))
+
+(defun atomic-chrome-httpd-send-response (proc)
+  "Send an HTTP 200 OK response back to process PROC."
+  (when (processp proc)
+    (unless atomic-chrome-server-ghost-text
+      (setq atomic-chrome-server-ghost-text
+            (atomic-chrome-start-websocket-server 64293)))
+    (let ((header "HTTP/1.0 200 OK\nContent-Type: application/json\n")
+          (body (json-encode '(:ProtocolVersion 1 :WebSocketPort 64293))))
+      (process-send-string proc (concat header "\n" body))
+      (process-send-eof proc))))
+
+;;;###autoload
+(defun atomic-chrome-start-server ()
+  "Start websocket server for atomic-chrome."
+  (interactive)
+  (and (not atomic-chrome-server-atomic-chrome)
+       (memq 'atomic-chrome atomic-chrome-extension-type-list)
+       (setq atomic-chrome-server-atomic-chrome
+             (atomic-chrome-start-websocket-server 64292)))
+  (and (not (process-status "atomic-chrome-httpd"))
+       (memq 'ghost-text atomic-chrome-extension-type-list)
+       (atomic-chrome-start-httpd))
+  (global-atomic-chrome-edit-mode 1))
+
+;;;###autoload
+(defun atomic-chrome-stop-server nil
+  "Stop websocket server for atomic-chrome."
+  (interactive)
+  (when atomic-chrome-server-atomic-chrome
+    (websocket-server-close atomic-chrome-server-atomic-chrome)
+    (setq atomic-chrome-server-atomic-chrome nil))
+  (when atomic-chrome-server-ghost-text
+    (websocket-server-close atomic-chrome-server-ghost-text)
+    (setq atomic-chrome-server-ghost-text nil))
+  (when (process-status "atomic-chrome-httpd")
+    (delete-process "atomic-chrome-httpd"))
+  (global-atomic-chrome-edit-mode 0))
+
+(provide 'atomic-chrome)
+
+;;; atomic-chrome.el ends here