Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 8 additions & 1 deletion README.md
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@ Then add the following lines to your `.emacs`.
3. Press Atomic Chrome button on the tool bar.
4. Contet of the text area is opened in a new buffer of Emacs.
5. Edit content on Emacs buffer.
6. <kbd>C-c C-c</kbd> to finish editing, or the buffer killed if the browser closes the connection.
6. Press <kbd>C-c C-c</kbd> to finish editing. If the browser closes the connection, the Emacs buffer is kept for recovery.

## Customization

Expand Down Expand Up @@ -116,6 +116,13 @@ You may also need to update Ghost Text's port setting in Chrome Extensions page.

## History

unreleased

* Reattach matching edit buffers after browser reconnects
* Keep edit buffers after browser disconnects
* Fix GhostText HTTP handshake response for stricter HTTP parsers
* Handle fragmented WebSocket messages for long text inputs

version 2.0.0 (2016-11-08)

* Add support for Ghost Text
Expand Down
204 changes: 156 additions & 48 deletions atomic-chrome.el
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
;;; atomic-chrome.el --- Edit Chrome text area with Emacs using Atomic Chrome
;;; atomic-chrome.el --- Edit Chrome text area with Emacs using Atomic Chrome -*- lexical-binding: t -*-

;; Copyright (C) 2016 alpha22jp <alpha22jp@gmail.com>
;; Copyright (C) 2024 Karim Aziiev <karim.aziiev@gmail.com>
;; Copyright (C) 2026 Christoph Groth <christoph@grothesque.org>

;; Author: alpha22jp <alpha22jp@gmail.com>
;; Package-Requires: ((emacs "24.4") (let-alist "1.0.4") (websocket "1.4"))
Expand Down Expand Up @@ -120,8 +122,8 @@ corresponding major modes."
"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).")
"Hash table of editing buffer and its associated data.
Each element has a list consisting of (websocket, frame, url, title).")

(defun atomic-chrome-get-websocket (buffer)
"Look up websocket associated with buffer BUFFER.
Expand All @@ -145,8 +147,8 @@ Looks in `atomic-chrome-buffer-table'."
(defun atomic-chrome-close-connection ()
"Close client connection associated with current buffer."
(let ((socket (atomic-chrome-get-websocket (current-buffer))))
(remhash (current-buffer) atomic-chrome-buffer-table)
(when socket
(remhash (current-buffer) atomic-chrome-buffer-table)
(websocket-close socket))))

(defun atomic-chrome-send-buffer-text ()
Expand All @@ -161,8 +163,8 @@ Looks in `atomic-chrome-buffer-table'."
(if (eq (websocket-server-conn socket) atomic-chrome-server-ghost-text)
(list (cons "text" text))
(list '("type" . "updateText")
(cons "payload" (list (cons "text" text))))))))
(set-buffer-modified-p nil)))
(cons "payload" (list (cons "text" text)))))))
(set-buffer-modified-p nil))))

(defun atomic-chrome-set-major-mode (url)
"Set major mode for editing buffer depending on URL.
Expand All @@ -174,28 +176,31 @@ otherwise fallback to `atomic-chrome-default-major-mode'"
'string-match))
atomic-chrome-default-major-mode)))

(defun atomic-chrome-show-edit-buffer (buffer title)
(defun atomic-chrome-show-edit-buffer (buffer title &optional frame)
"Show editing buffer BUFFER.
Either creates a frame with title TITLE, or raises the selected
frame, depending on `atomic-chrome-buffer-open-style'."
frame, depending on `atomic-chrome-buffer-open-style'. If FRAME
is live and `atomic-chrome-buffer-open-style' is `frame', reuse it."
(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
(cond
((memq window-system '(pgtk x))
(if (or (not x-display-name) (string-match-p "wayland" x-display-name))
(make-frame frame-params)
(make-frame-on-display (getenv "DISPLAY") frame-params)))
;; Avoid using make-frame-on-display for Mac OS
((memq window-system '(ns mac))
(make-frame frame-params))
((memq window-system '(w32))
(make-frame-on-display "w32" frame-params))
(t
(make-frame frame-params))))
(if (frame-live-p frame)
frame
(cond
((memq window-system '(pgtk x))
(if (or (not x-display-name) (string-match-p "wayland" x-display-name))
(make-frame frame-params)
(make-frame-on-display (getenv "DISPLAY") frame-params)))
;; Avoid using make-frame-on-display for Mac OS
((memq window-system '(ns mac))
(make-frame frame-params))
((memq window-system '(w32))
(make-frame-on-display "w32" frame-params))
(t
(make-frame frame-params)))))
(select-frame edit-frame))
(if (eq atomic-chrome-buffer-open-style 'split)
(pop-to-buffer buffer)
Expand All @@ -204,17 +209,60 @@ frame, depending on `atomic-chrome-buffer-open-style'."
(select-frame-set-input-focus (window-frame (selected-window)))
edit-frame))

(defun atomic-chrome-buffer-text-equal-p (buffer text)
"Return non-nil if BUFFER's contents equal TEXT."
(with-current-buffer buffer
(string= (buffer-substring-no-properties (point-min) (point-max)) text)))

(defun atomic-chrome-try-reattach-buffer (socket url title text)
"Try to reattach SOCKET to a matching detached edit buffer.
Return non-nil if a buffer was reattached.

A detached buffer matches when its URL, TITLE, and contents match URL, TITLE,
and TEXT."
(cl-loop for buffer being the hash-keys of atomic-chrome-buffer-table
using (hash-values data)
when (and (buffer-live-p buffer)
(not (nth 0 data))
(equal (nth 2 data) url)
(equal (nth 3 data) title)
(atomic-chrome-buffer-text-equal-p buffer text))
return (progn
(setcar data socket)
(setcar (cdr data)
(atomic-chrome-show-edit-buffer buffer title (nth 1 data)))
(message "Reusing detached browser edit buffer %s"
(buffer-name buffer))
t)))

(defun atomic-chrome-detached-buffers ()
"Return live Atomic Chrome edit buffers without a websocket."
(let (buffers)
(cl-loop for buffer being the hash-keys of atomic-chrome-buffer-table
using (hash-values data)
do (when (and (buffer-live-p buffer) (not (nth 0 data)))
(push buffer buffers)))
(nreverse buffers)))

(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 (if (string-empty-p title) "No title" 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))))
(unless (atomic-chrome-try-reattach-buffer socket url title text)
(let* ((detached-buffers (atomic-chrome-detached-buffers))
(detached-message
(and detached-buffers
(format "Detached browser edit buffer(s) left: %s"
(mapconcat #'buffer-name detached-buffers ", "))))
(buffer (generate-new-buffer (if (string-empty-p title) "No title" title))))
(with-current-buffer buffer
(puthash buffer
(list socket (atomic-chrome-show-edit-buffer buffer title) url title)
atomic-chrome-buffer-table)
(atomic-chrome-set-major-mode url)
(insert text))
(when detached-message
(message "%s" detached-message)))))

(defun atomic-chrome-close-edit-buffer (buffer)
"Close buffer BUFFER if it's one of Atomic Chrome edit buffers."
Expand All @@ -223,7 +271,7 @@ TITLE is used for the buffer name and TEXT is inserted to the buffer."
(with-current-buffer buffer
(save-restriction
(run-hooks 'atomic-chrome-edit-done-hook)
(when frame (delete-frame frame))
(when (frame-live-p frame) (delete-frame frame))
(if (and (eq atomic-chrome-buffer-open-style 'split)
window)
(quit-window t window)
Expand All @@ -244,28 +292,88 @@ TITLE is used for the buffer name and TEXT is inserted to the buffer."
(erase-buffer)
(insert text)))))

(defvar atomic-chrome-frame-socket-incomplete-buffers-hash (make-hash-table
:test 'eq)
"A hash table mapping websocket sockets to buffers.
Each buffer accumulates payload fragments from incomplete websocket frames
associated with a specific socket connection.

This allows for efficient handling and concatenation of large and/or fragmented
messages.")


(defun atomic-chrome-on-message (socket frame)
"Handle data received from the websocket client specified by SOCKET.
FRAME holds the 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))))))))
FRAME holds the raw data received.

When frames are marked as incomplete or a previous incomplete frame
exists for the SOCKET, payload fragments are accumulated in a dedicated buffer.

Upon receiving the final fragment, the full payload is reconstructed,
decoded, and processed as a JSON object to either create or update
associated Emacs buffers for editing."
(let ((raw-payload (websocket-frame-payload frame))
(incomplete-data-buffer
(gethash socket
atomic-chrome-frame-socket-incomplete-buffers-hash)))
(cond ((not (websocket-frame-completep frame))
(unless incomplete-data-buffer
(setq incomplete-data-buffer
(generate-new-buffer
(format " *atomic-chrome-%s*" (current-time-string)))))
(with-current-buffer incomplete-data-buffer
(goto-char (point-max))
(insert raw-payload))
(puthash socket incomplete-data-buffer
atomic-chrome-frame-socket-incomplete-buffers-hash))
(t
(let* ((combined-payload
(if (not incomplete-data-buffer)
raw-payload
(unwind-protect
(with-current-buffer
incomplete-data-buffer
(goto-char (point-max))
(insert raw-payload)
(set-buffer-modified-p nil)
(buffer-string))
(remhash socket
atomic-chrome-frame-socket-incomplete-buffers-hash)
(kill-buffer incomplete-data-buffer))))
(msg (json-read-from-string
(decode-coding-string
(encode-coding-string combined-payload
'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 ((incomplete-data-buffer
(gethash socket atomic-chrome-frame-socket-incomplete-buffers-hash)))
(remhash socket atomic-chrome-frame-socket-incomplete-buffers-hash)
(when (buffer-live-p incomplete-data-buffer)
(with-current-buffer incomplete-data-buffer
(set-buffer-modified-p nil))
(kill-buffer incomplete-data-buffer)))
(let ((buffer (atomic-chrome-get-buffer-by-socket socket)))
(when buffer (atomic-chrome-close-edit-buffer buffer))))
(when buffer
(setcar (gethash buffer atomic-chrome-buffer-table) nil)
(message "Browser connection closed; keeping buffer %s"
(buffer-name buffer)))))

(defvar atomic-chrome-edit-mode-map
(let ((map (make-sparse-keymap)))
Expand Down Expand Up @@ -338,7 +446,6 @@ 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)))
Expand All @@ -351,9 +458,10 @@ STRING is the string process received."
(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))
(let* ((body (json-encode '(:ProtocolVersion 1 :WebSocketPort 64293)))
(header (format "HTTP/1.0 200 OK\r\nContent-Type: application/json\r\nContent-Length: %d\r\nConnection: close\r\n\r\n"
(string-bytes body))))
(process-send-string proc (concat header body))
(process-send-eof proc))))

;;;###autoload
Expand Down