;;; edit-server.el --- server that responds to edit requests from Chrome
;; Copyright (C) 2009-2011 Alex Bennee
;; Copyright (C) 2010-2011 Riccardo Murri
;; Author: Alex Bennee <alex@bennee.com>
;; Maintainer: Alex Bennee <alex@bennee.com>
;; Version: 1.10
;; Homepage: https://github.com/stsquad/emacs_chrome
;; This file is not part of GNU Emacs.
;; This file 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 3, or (at your option)
;; any later version.
;; This file 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, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This provides an edit server to respond to requests from the Chrome
;; Emacs Chrome plugin. This is my first attempt at doing something
;; with sockets in Emacs. I based it on the following examples:
;;
;; http://www.emacswiki.org/emacs/EmacsEchoServer
;; http://nullprogram.com/blog/2009/05/17/
;;
;; To use it ensure the file is in your load-path and add something
;; like the following examples to your .emacs:
;;
;; To open pages for editing in new buffers in your existing Emacs
;; instance:
;;
;; (when (require 'edit-server nil t)
;; (setq edit-server-new-frame nil)
;; (edit-server-start))
;;
;; To open pages for editing in new frames using a running emacs
;; started in --daemon mode:
;;
;; (when (and (require 'edit-server nil t) (daemonp))
;; (edit-server-start))
;;
;; Buffers are edited in `text-mode' by default; to use a different
;; major mode, change `edit-server-default-major-mode' or customize
;; `edit-server-url-major-mode-alist' to specify major modes based
;; on the remote URL:
;;
;; (setq edit-server-url-major-mode-alist
;; '(("github\\.com" . markdown-mode)))
;;
;; Alternatively, set the mode in `edit-server-start-hook'. For
;; example:
;;
;; (add-hook 'edit-server-start-hook
;; (lambda ()
;; (when (string-match "github.com" (buffer-name))
;; (markdown-mode))))
;;; Code:
;; uncomment to debug
;; (setq debug-on-error t)
;; (setq edebug-all-defs t)
(unless (featurep 'make-network-process)
(error "Incompatible version of [X]Emacs - lacks make-network-process"))
;;; Customization
(defcustom edit-server-port 9292
"Local port the edit server listens to."
:group 'edit-server
:type 'integer)
(defcustom edit-server-host nil
"If not nil, accept connections from HOST address rather than just
localhost. This may present a security issue."
:group 'edit-server
:type 'boolean)
(defcustom edit-server-verbose nil
"If not nil, log connections and progress also to the echo area."
:group 'edit-server
:type 'boolean)
(defcustom edit-server-done-hook nil
"Hook run when done editing a buffer for the Emacs HTTP edit-server.
Current buffer holds the text that is about to be sent back to the client."
:group 'edit-server
:type 'hook)
(defcustom edit-server-start-hook nil
"Hook run when starting a editing buffer. Current buffer is
the fully prepared editing buffer. Use this hook to enable
buffer-specific modes or add key bindings."
:group 'edit-server
:type 'hook)
;; frame options
(defcustom edit-server-new-frame t
"If not nil, edit each buffer in a new frame (and raise it)."
:group 'edit-server
:type 'boolean)
(defcustom edit-server-new-frame-alist
'((name . "Emacs TEXTAREA")
(width . 80)
(height . 25)
(minibuffer . t)
(menu-bar-lines . t))
"Frame parameters for new frames. See `default-frame-alist' for examples.
If nil, the new frame will use the existing `default-frame-alist' values."
:group 'edit-server
:type '(repeat (cons :format "%v"
(symbol :tag "Parameter")
(sexp :tag "Value"))))
(defcustom edit-server-default-major-mode
'text-mode
"The default major mode to use in editing buffers, if no other
mode is selected by `edit-server-url-major-mode-alist'."
:group 'edit-server
:type 'function)
(defcustom edit-server-url-major-mode-alist
nil
"A-list of patterns and corresponding functions; when the first
pattern is encountered which matches `edit-server-url', the
corresponding function will be called in order to set the desired
major mode. If no pattern matches,
`edit-server-default-major-mode' will be used."
:group 'edit-server
:type '(alist :key-type (string :tag "Regexp")
:value-type (function :tag "Major mode function")))
(defcustom edit-server-new-frame-mode-line t
"Show the emacs frame's mode-line if set to t; hide if nil."
:group 'edit-server
:type 'boolean)
;;; Variables
(defconst edit-server-process-buffer-name " *edit-server*"
"Template name of the edit-server process buffers.")
(defconst edit-server-log-buffer-name "*edit-server-log*"
"Template name of the edit-server process buffers.")
(defconst edit-server-edit-buffer-name "TEXTAREA"
"Template name of the edit-server text editing buffers.")
(defvar edit-server-clients ()
"List of all client processes associated with the server process.")
;; Buffer local variables
;;
;; These are all required to associate the edit buffer with the
;; correct connection to the client and allow for the buffer to be sent
;; back when ready. They are `permanent-local` to avoid being reset if
;; the buffer changes major modes.
(defvar edit-server-proc nil
"Network process associated with the current edit.")
(make-variable-buffer-local 'edit-server-proc)
(put 'edit-server-proc 'permanent-local t)
(defvar edit-server-frame nil
"The frame created for a new edit-server process.")
(make-variable-buffer-local 'edit-server-frame)
(put 'edit-server-frame 'permanent-local t)
(defvar edit-server-phase nil
"Symbol indicating the state of the HTTP request parsing.")
(make-variable-buffer-local 'edit-server-phase)
(put 'edit-server-phase 'permanent-local t)
(defvar edit-server-received nil
"Number of bytes received so far in the client buffer.
Depending on the character encoding, may be different from the buffer length.")
(make-variable-buffer-local 'edit-server-received)
(put 'edit-server-received 'permanent-local t)
(defvar edit-server-request nil
"The HTTP request (GET, HEAD, POST) received.")
(make-variable-buffer-local 'edit-server-request)
(put 'edit-server-request 'permanent-local t)
(defvar edit-server-content-length nil
"The value gotten from the HTTP `Content-Length' header.")
(make-variable-buffer-local 'edit-server-content-length)
(put 'edit-server-content-length 'permanent-local t)
(defvar edit-server-url nil
"The value gotten from the HTTP `x-url' header.")
(make-variable-buffer-local 'edit-server-url)
(put 'edit-server-url 'permanent-local t)
;;; Mode magic
;;
;; We want to re-map some of the keys to trigger edit-server-done
;; instead of the usual emacs like behaviour. However using
;; local-set-key will affect all buffers of the same mode, hence we
;; define a special (derived) mode for handling editing of text areas.
(defvar edit-server-edit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-x C-s") 'edit-server-save)
(define-key map (kbd "C-x #") 'edit-server-done)
(define-key map (kbd "C-c C-c") 'edit-server-done)
(define-key map (kbd "C-x C-c") 'edit-server-abort)
map)
"Keymap for minor mode `edit-server-edit-mode'.
Redefine a few common Emacs keystrokes to functions that can
deal with the response to the edit-server request.
Any of the following keys will close the buffer and send the text
to the HTTP client: C-x #, C-c C-c.
Pressing C-x C-s will save the current state to the kill-ring.
If any of the above isused with a prefix argument, the
unmodified text is sent back instead.")
(define-minor-mode edit-server-edit-mode
"Minor mode enabled on buffers opened by `edit-server-accept'.
Its sole purpose is currently to enable
`edit-server-edit-mode-map', which overrides common keystrokes to
send a response back to the client."
:group 'edit-server
:lighter " EditSrv"
:init-value nil
:keymap edit-server-edit-mode-map)
;; Edit Server socket code
(defun edit-server-start (&optional verbose)
"Start the edit server.
If argument VERBOSE is non-nil, logs all server activity to buffer
`*edit-server-log*'. When called interactivity, a prefix argument
will cause it to be verbose."
(interactive "P")
(if (or (process-status "edit-server")
(null (condition-case err
(make-network-process
:name "edit-server"
:buffer edit-server-process-buffer-name
:family 'ipv4
:host (or edit-server-host 'local)
:service edit-server-port
:log 'edit-server-accept
:server t
:noquery t)
(file-error nil))))
(message "An edit-server process is already running")
(setq edit-server-clients '())
(if verbose (get-buffer-create edit-server-log-buffer-name))
(edit-server-log nil "Created a new edit-server process")))
(defun edit-server-stop nil
"Stop the edit server"
(interactive)
(while edit-server-clients
(edit-server-kill-client (car edit-server-clients))
(setq edit-server-clients (cdr edit-server-clients)))
(if (process-status "edit-server")
(delete-process "edit-server")
(message "No edit server running"))
(when (get-buffer edit-server-process-buffer-name)
(kill-buffer edit-server-process-buffer-name)))
(defun edit-server-log (proc fmt &rest args)
"If a `*edit-server-log*' buffer exists, write STRING to it.
This is done for logging purposes. If `edit-server-verbose' is
non-nil, then STRING is also echoed to the message line."
(let ((string (apply 'format fmt args)))
(if edit-server-verbose
(message string))
(if (get-buffer edit-server-log-buffer-name)
(with-current-buffer edit-server-log-buffer-name
(goto-char (point-max))
(insert (current-time-string)
" "
(if (processp proc)
(concat
(buffer-name (process-buffer proc))
": ")
"") ; nil is not acceptable to 'insert
string)
(or (bolp) (newline))))))
(defun edit-server-accept (server client msg)
"Accept a new client connection."
(let ((buffer (generate-new-buffer edit-server-process-buffer-name)))
(when (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte t)) ; djb
(buffer-disable-undo buffer)
(set-process-buffer client buffer)
(set-process-filter client 'edit-server-filter)
;; kill-buffer kills the associated process
(set-process-query-on-exit-flag client nil)
(with-current-buffer buffer
(setq edit-server-phase 'wait
edit-server-received 0
edit-server-request nil))
(setq edit-server-content-length nil
edit-server-url nil))
(add-to-list 'edit-server-clients client)
(edit-server-log client msg))
(defun edit-server-filter (proc string)
"Process data received from the client."
;; there is no guarantee that data belonging to the same client
;; request will arrive all in one go; therefore, we must accumulate
;; data in the buffer and process it in different phases, which
;; requires us to keep track of the processing state.
(with-current-buffer (process-buffer proc)
(insert string)
(setq edit-server-received
(+ edit-server-received (string-bytes string)))
(when (eq edit-server-phase 'wait)
;; look for a complete HTTP request string
(save-excursion
(goto-char (point-min))
(when (re-search-forward
"^\\([A-Z]+\\)\\s-+\\(\\S-+\\)\\s-+\\(HTTP/[0-9\.]+\\)\r?\n"
nil t)
(edit-server-log
proc "Got HTTP `%s' request, processing in buffer `%s'..."
(match-string 1) (current-buffer))
(setq edit-server-request (match-string 1))
(setq edit-server-content-length nil)
(setq edit-server-phase 'head))))
(when (eq edit-server-phase 'head)
;; look for "Content-length" header
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^Content-Length:\\s-+\\([0-9]+\\)" nil t)
(setq edit-server-content-length
(string-to-number (match-string 1)))))
;; look for "x-url" header
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^x-url: .*//\\(.*\\)/" nil t)
(setq edit-server-url (match-string 1))))
;; look for head/body separator
(save-excursion
(goto-char (point-min))
(when (re-search-forward "\\(\r?\n\\)\\{2\\}" nil t)
;; HTTP headers are pure ASCII (1 char = 1 byte), so we can subtract
;; the buffer position from the count of received bytes
(setq edit-server-received
(- edit-server-received (- (match-end 0) (point-min))))
;; discard headers - keep only HTTP content in buffer
(delete-region (point-min) (match-end 0))
(setq edit-server-phase 'body))))
(when (eq edit-server-phase 'body)
(if (and edit-server-content-length
(> edit-server-content-length edit-server-received))
(edit-server-log proc
"Received %d bytes of %d ..."
edit-server-received edit-server-content-length)
;; all content transferred - process request now
(cond
((string= edit-server-request "POST")
;; create editing buffer, and move content to it
(edit-server-create-edit-buffer proc))
(t
;; send 200 OK response to any other request
(edit-server-send-response proc "edit-server is running.\n" t)))
;; wait for another connection to arrive
(setq edit-server-received 0)
(setq edit-server-phase 'wait)))))
(defun edit-server-create-frame(buffer)
"Create a frame for the edit server"
(if edit-server-new-frame
(let ((new-frame
(if (memq window-system '(ns mac))
;; Aquamacs, Emacs NS, Emacs (experimental) Mac port
(make-frame edit-server-new-frame-alist)
(make-frame-on-display (getenv "DISPLAY")
edit-server-new-frame-alist))))
(unless edit-server-new-frame-mode-line
(setq mode-line-format nil))
(select-frame new-frame)
(when (and (eq window-system 'x)
(fboundp 'x-send-client-message))
(x-send-client-message nil 0 nil
"_NET_ACTIVE_WINDOW" 32
'(1 0 0)))
(raise-frame new-frame)
(set-window-buffer (frame-selected-window new-frame) buffer)
new-frame)
(pop-to-buffer buffer)
(raise-frame)
nil))
(defun edit-server-choose-major-mode ()
"Use `edit-server-url-major-mode-alist' to choose a major mode
initialization function based on `edit-server-url', or fall back
to `edit-server-default-major-mode'"
(let ((pairs edit-server-url-major-mode-alist)
(mode edit-server-default-major-mode))
(while pairs
(let ((entry (car pairs)))
(if (string-match (car entry) edit-server-url)
(setq mode (cdr entry)
pairs nil)
(setq pairs (cdr pairs)))))
(funcall mode)))
(defun edit-server-create-edit-buffer(proc)
"Create an edit buffer, place content in it and save the network
process for the final call back"
(let ((buffer (generate-new-buffer
(or edit-server-url
edit-server-edit-buffer-name))))
(with-current-buffer buffer
(when (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte t))) ; djb
(copy-to-buffer buffer (point-min) (point-max))
(with-current-buffer buffer
(setq edit-server-url (with-current-buffer (process-buffer proc) edit-server-url))
(edit-server-choose-major-mode)
;; Allow `edit-server-start-hook' to override the major mode.
;; (re)setting the minor mode seems to clear the buffer-local
;; variables that we depend upon for the response, so call the
;; hooks early on
(run-hooks 'edit-server-start-hook)
(not-modified)
(add-hook 'kill-buffer-hook 'edit-server-abort* nil t)
(buffer-enable-undo)
(setq edit-server-proc proc
edit-server-frame (edit-server-create-frame buffer))
(edit-server-edit-mode))))
(defun edit-server-send-response (proc &optional body close)
"Send an HTTP 200 OK response back to process PROC.
Optional second argument BODY specifies the response content:
- If nil, the HTTP response will have null content.
- If a string, the string is sent as response content.
- Any other value will cause the contents of the current
buffer to be sent.
If optional third argument CLOSE is non-nil, then process PROC
and its buffer are killed with `edit-server-kill-client'."
(interactive)
(if (processp proc)
(let ((response-header (concat
"HTTP/1.0 200 OK\n"
(format "Server: Emacs/%s\n" emacs-version)
"Date: "
(format-time-string
"%a, %d %b %Y %H:%M:%S GMT\n"
(current-time)))))
(process-send-string proc response-header)
(process-send-string proc "\n")
(cond
((stringp body)
(process-send-string proc (encode-coding-string body 'utf-8)))
((not body) nil)
(t
(encode-coding-region (point-min) (point-max) 'utf-8)
(process-send-region proc (point-min) (point-max))))
(process-send-eof proc)
(when close
(edit-server-kill-client proc))
(edit-server-log proc "Editing done, sent HTTP OK response."))
(message "edit-server-send-response: invalid proc (bug?)")))
(defun edit-server-kill-client (proc)
"Kill client process PROC and remove it from the list."
(let ((procbuf (process-buffer proc)))
(delete-process proc)
(when (buffer-live-p procbuf)
(kill-buffer procbuf))
(setq edit-server-clients (delq proc edit-server-clients))))
(defun edit-server-done (&optional abort nokill)
"Finish editing: send HTTP response back, close client and editing buffers.
The current contents of the buffer are sent back to the HTTP
client, unless argument ABORT is non-nil, in which case then the
original text is sent back.
If optional second argument NOKILL is non-nil, then the editing
buffer is not killed.
When called interactively, use prefix arg to abort editing."
(interactive "P")
;; Do nothing if the connection is closed by the browser (tab killed, etc.)
(unless (eq (process-status edit-server-proc) 'closed)
(let ((buffer (current-buffer))
(proc edit-server-proc)
(procbuf (process-buffer edit-server-proc)))
;; edit-server-* vars are buffer-local,
;; so they must be used before issuing kill-buffer
(if abort
;; send back original content
(with-current-buffer procbuf
(run-hooks 'edit-server-done-hook)
(edit-server-send-response proc t))
;; send back edited content
(save-restriction
(widen)
(buffer-disable-undo)
;; ensure any format encoding is done (like longlines)
(dolist (format buffer-file-format)
(format-encode-region (point-min) (point-max) format))
;; send back
(run-hooks 'edit-server-done-hook)
(edit-server-send-response edit-server-proc t)
;; restore formats (only useful if we keep the buffer)
(dolist (format buffer-file-format)
(format-decode-region (point-min) (point-max) format))
(buffer-enable-undo)))
(when edit-server-frame
(delete-frame edit-server-frame))
;; delete-frame may change the current buffer
(unless nokill
(kill-buffer buffer))
(edit-server-kill-client proc))))
;;
;; There are a couple of options for handling the save
;; action. The intent is to preserve data but not finish
;; editing. There are a couple of approaches that could
;; be taken:
;; a) Use the iterative edit-server option (send a buffer
;; back to the client which then returns new request
;; to continue the session).
;; b) Back-up the edit session to a file
;; c) Save the current buffer to the kill-ring
;;
;; I've attempted to do a) a couple of times but I keep running
;; into problems which I think are emacs bugs. So for now I'll
;; just push the current buffer to the kill-ring.
(defun edit-server-save ()
"Save the current state of the edit buffer."
(interactive)
(save-restriction
(widen)
(buffer-disable-undo)
(copy-region-as-kill (point-min) (point-max))
(buffer-enable-undo)))
(defun edit-server-abort ()
"Discard editing and send the original text back to the browser."
(interactive)
(edit-server-done t))
(defun edit-server-abort* ()
"Discard editing and send the original text back to the browser,
but don't kill the editing buffer."
(interactive)
(edit-server-done t t))
(provide 'edit-server)
;;; edit-server.el ends here
