1 ;;; edit-server.el --- server that responds to edit requests from Chrome
3 ;; Copyright (C) 2009-2011 Alex Bennee
4 ;; Copyright (C) 2010-2011 Riccardo Murri
6 ;; Author: Alex Bennee <alex@bennee.com>
7 ;; Maintainer: Alex Bennee <alex@bennee.com>
9 ;; Homepage: https://github.com/stsquad/emacs_chrome
11 ;; This file is not part of GNU Emacs.
13 ;; This file is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 3, or (at your option)
18 ;; This file is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
28 ;; This provides an edit server to respond to requests from the Chrome
29 ;; Emacs Chrome plugin. This is my first attempt at doing something
30 ;; with sockets in Emacs. I based it on the following examples:
32 ;; http://www.emacswiki.org/emacs/EmacsEchoServer
33 ;; http://nullprogram.com/blog/2009/05/17/
35 ;; To use it ensure the file is in your load-path and add something
36 ;; like the following examples to your .emacs:
38 ;; To open pages for editing in new buffers in your existing Emacs
41 ;; (when (require 'edit-server nil t)
42 ;; (setq edit-server-new-frame nil)
43 ;; (edit-server-start))
45 ;; To open pages for editing in new frames using a running emacs
46 ;; started in --daemon mode:
48 ;; (when (and (require 'edit-server nil t) (daemonp))
49 ;; (edit-server-start))
51 ;; Buffers are edited in `text-mode' by default; to use a different
52 ;; major mode, change `edit-server-default-major-mode' or customize
53 ;; `edit-server-url-major-mode-alist' to specify major modes based
56 ;; (setq edit-server-url-major-mode-alist
57 ;; '(("github\\.com" . markdown-mode)))
59 ;; Alternatively, set the mode in `edit-server-start-hook'. For
62 ;; (add-hook 'edit-server-start-hook
64 ;; (when (string-match "github.com" (buffer-name))
71 ;; (setq debug-on-error t)
72 ;; (setq edebug-all-defs t)
74 (unless (featurep 'make-network-process)
75 (error "Incompatible version of [X]Emacs - lacks make-network-process"))
79 (defcustom edit-server-port 9292
80 "Local port the edit server listens to."
84 (defcustom edit-server-host nil
85 "If not nil, accept connections from HOST address rather than just
86 localhost. This may present a security issue."
90 (defcustom edit-server-verbose nil
91 "If not nil, log connections and progress also to the echo area."
95 (defcustom edit-server-done-hook nil
96 "Hook run when done editing a buffer for the Emacs HTTP edit-server.
97 Current buffer holds the text that is about to be sent back to the client."
101 (defcustom edit-server-start-hook nil
102 "Hook run when starting a editing buffer. Current buffer is
103 the fully prepared editing buffer. Use this hook to enable
104 buffer-specific modes or add key bindings."
110 (defcustom edit-server-new-frame t
111 "If not nil, edit each buffer in a new frame (and raise it)."
115 (defcustom edit-server-new-frame-alist
116 '((name . "Emacs TEXTAREA")
120 (menu-bar-lines . t))
121 "Frame parameters for new frames. See `default-frame-alist' for examples.
122 If nil, the new frame will use the existing `default-frame-alist' values."
124 :type '(repeat (cons :format "%v"
125 (symbol :tag "Parameter")
126 (sexp :tag "Value"))))
128 (defcustom edit-server-default-major-mode
130 "The default major mode to use in editing buffers, if no other
131 mode is selected by `edit-server-url-major-mode-alist'."
135 (defcustom edit-server-url-major-mode-alist
137 "A-list of patterns and corresponding functions; when the first
138 pattern is encountered which matches `edit-server-url', the
139 corresponding function will be called in order to set the desired
140 major mode. If no pattern matches,
141 `edit-server-default-major-mode' will be used."
143 :type '(alist :key-type (string :tag "Regexp")
144 :value-type (function :tag "Major mode function")))
146 (defcustom edit-server-new-frame-mode-line t
147 "Show the emacs frame's mode-line if set to t; hide if nil."
153 (defconst edit-server-process-buffer-name " *edit-server*"
154 "Template name of the edit-server process buffers.")
156 (defconst edit-server-log-buffer-name "*edit-server-log*"
157 "Template name of the edit-server process buffers.")
159 (defconst edit-server-edit-buffer-name "TEXTAREA"
160 "Template name of the edit-server text editing buffers.")
162 (defvar edit-server-clients ()
163 "List of all client processes associated with the server process.")
165 ;; Buffer local variables
167 ;; These are all required to associate the edit buffer with the
168 ;; correct connection to the client and allow for the buffer to be sent
169 ;; back when ready. They are `permanent-local` to avoid being reset if
170 ;; the buffer changes major modes.
172 (defvar edit-server-proc nil
173 "Network process associated with the current edit.")
174 (make-variable-buffer-local 'edit-server-proc)
175 (put 'edit-server-proc 'permanent-local t)
177 (defvar edit-server-frame nil
178 "The frame created for a new edit-server process.")
179 (make-variable-buffer-local 'edit-server-frame)
180 (put 'edit-server-frame 'permanent-local t)
182 (defvar edit-server-phase nil
183 "Symbol indicating the state of the HTTP request parsing.")
184 (make-variable-buffer-local 'edit-server-phase)
185 (put 'edit-server-phase 'permanent-local t)
187 (defvar edit-server-received nil
188 "Number of bytes received so far in the client buffer.
189 Depending on the character encoding, may be different from the buffer length.")
190 (make-variable-buffer-local 'edit-server-received)
191 (put 'edit-server-received 'permanent-local t)
193 (defvar edit-server-request nil
194 "The HTTP request (GET, HEAD, POST) received.")
195 (make-variable-buffer-local 'edit-server-request)
196 (put 'edit-server-request 'permanent-local t)
198 (defvar edit-server-content-length nil
199 "The value gotten from the HTTP `Content-Length' header.")
200 (make-variable-buffer-local 'edit-server-content-length)
201 (put 'edit-server-content-length 'permanent-local t)
203 (defvar edit-server-url nil
204 "The value gotten from the HTTP `x-url' header.")
205 (make-variable-buffer-local 'edit-server-url)
206 (put 'edit-server-url 'permanent-local t)
210 ;; We want to re-map some of the keys to trigger edit-server-done
211 ;; instead of the usual emacs like behaviour. However using
212 ;; local-set-key will affect all buffers of the same mode, hence we
213 ;; define a special (derived) mode for handling editing of text areas.
216 (defvar edit-server-edit-mode-map
217 (let ((map (make-sparse-keymap)))
218 (define-key map (kbd "C-x C-s") 'edit-server-save)
219 (define-key map (kbd "C-x #") 'edit-server-done)
220 (define-key map (kbd "C-c C-c") 'edit-server-done)
221 (define-key map (kbd "C-x C-c") 'edit-server-abort)
223 "Keymap for minor mode `edit-server-edit-mode'.
225 Redefine a few common Emacs keystrokes to functions that can
226 deal with the response to the edit-server request.
228 Any of the following keys will close the buffer and send the text
229 to the HTTP client: C-x #, C-c C-c.
231 Pressing C-x C-s will save the current state to the kill-ring.
233 If any of the above isused with a prefix argument, the
234 unmodified text is sent back instead.")
236 (define-minor-mode edit-server-edit-mode
237 "Minor mode enabled on buffers opened by `edit-server-accept'.
239 Its sole purpose is currently to enable
240 `edit-server-edit-mode-map', which overrides common keystrokes to
241 send a response back to the client."
245 :keymap edit-server-edit-mode-map)
247 (defun turn-on-edit-server-edit-mode-if-server ()
248 "Turn on `edit-server-edit-mode' if in an edit-server buffer."
249 (when edit-server-proc
250 (edit-server-edit-mode t)))
252 (define-globalized-minor-mode global-edit-server-edit-mode
253 edit-server-edit-mode turn-on-edit-server-edit-mode-if-server)
254 (global-edit-server-edit-mode t)
257 ;; Edit Server socket code
259 (defun edit-server-start (&optional verbose)
260 "Start the edit server.
262 If argument VERBOSE is non-nil, logs all server activity to buffer
263 `*edit-server-log*'. When called interactivity, a prefix argument
264 will cause it to be verbose."
266 (if (or (process-status "edit-server")
267 (null (condition-case err
268 (make-network-process
270 :buffer edit-server-process-buffer-name
272 :host (or edit-server-host 'local)
273 :service edit-server-port
274 :log 'edit-server-accept
278 (message "An edit-server process is already running")
279 (setq edit-server-clients '())
280 (if verbose (get-buffer-create edit-server-log-buffer-name))
281 (edit-server-log nil "Created a new edit-server process")))
283 (defun edit-server-stop nil
284 "Stop the edit server"
286 (while edit-server-clients
287 (edit-server-kill-client (car edit-server-clients))
288 (setq edit-server-clients (cdr edit-server-clients)))
289 (if (process-status "edit-server")
290 (delete-process "edit-server")
291 (message "No edit server running"))
292 (when (get-buffer edit-server-process-buffer-name)
293 (kill-buffer edit-server-process-buffer-name)))
295 (defun edit-server-log (proc fmt &rest args)
296 "If a `*edit-server-log*' buffer exists, write STRING to it.
297 This is done for logging purposes. If `edit-server-verbose' is
298 non-nil, then STRING is also echoed to the message line."
299 (let ((string (apply 'format fmt args)))
300 (if edit-server-verbose
302 (if (get-buffer edit-server-log-buffer-name)
303 (with-current-buffer edit-server-log-buffer-name
304 (goto-char (point-max))
305 (insert (current-time-string)
309 (buffer-name (process-buffer proc))
311 "") ; nil is not acceptable to 'insert
313 (or (bolp) (newline))))))
315 (defun edit-server-accept (server client msg)
316 "Accept a new client connection."
317 (let ((buffer (generate-new-buffer edit-server-process-buffer-name)))
318 (when (fboundp 'set-buffer-multibyte)
319 (set-buffer-multibyte t)) ; djb
320 (buffer-disable-undo buffer)
321 (set-process-buffer client buffer)
322 (set-process-filter client 'edit-server-filter)
323 ;; kill-buffer kills the associated process
324 (set-process-query-on-exit-flag client nil)
325 (with-current-buffer buffer
326 (setq edit-server-phase 'wait
327 edit-server-received 0
328 edit-server-request nil))
329 (setq edit-server-content-length nil
330 edit-server-url nil))
331 (add-to-list 'edit-server-clients client)
332 (edit-server-log client msg))
334 (defun edit-server-filter (proc string)
335 "Process data received from the client."
336 ;; there is no guarantee that data belonging to the same client
337 ;; request will arrive all in one go; therefore, we must accumulate
338 ;; data in the buffer and process it in different phases, which
339 ;; requires us to keep track of the processing state.
340 (with-current-buffer (process-buffer proc)
342 (setq edit-server-received
343 (+ edit-server-received (string-bytes string)))
344 (when (eq edit-server-phase 'wait)
345 ;; look for a complete HTTP request string
347 (goto-char (point-min))
348 (when (re-search-forward
349 "^\\([A-Z]+\\)\\s-+\\(\\S-+\\)\\s-+\\(HTTP/[0-9\.]+\\)\r?\n"
352 proc "Got HTTP `%s' request, processing in buffer `%s'..."
353 (match-string 1) (current-buffer))
354 (setq edit-server-request (match-string 1))
355 (setq edit-server-content-length nil)
356 (setq edit-server-phase 'head))))
358 (when (eq edit-server-phase 'head)
359 ;; look for "Content-length" header
361 (goto-char (point-min))
362 (when (re-search-forward "^Content-Length:\\s-+\\([0-9]+\\)" nil t)
363 (setq edit-server-content-length
364 (string-to-number (match-string 1)))))
365 ;; look for "x-url" header
367 (goto-char (point-min))
368 (when (re-search-forward "^x-url: .*//\\(.*\\)/" nil t)
369 (setq edit-server-url (match-string 1))))
370 ;; look for head/body separator
372 (goto-char (point-min))
373 (when (re-search-forward "\\(\r?\n\\)\\{2\\}" nil t)
374 ;; HTTP headers are pure ASCII (1 char = 1 byte), so we can subtract
375 ;; the buffer position from the count of received bytes
376 (setq edit-server-received
377 (- edit-server-received (- (match-end 0) (point-min))))
378 ;; discard headers - keep only HTTP content in buffer
379 (delete-region (point-min) (match-end 0))
380 (setq edit-server-phase 'body))))
382 (when (eq edit-server-phase 'body)
383 (if (and edit-server-content-length
384 (> edit-server-content-length edit-server-received))
385 (edit-server-log proc
386 "Received %d bytes of %d ..."
387 edit-server-received edit-server-content-length)
388 ;; all content transferred - process request now
390 ((string= edit-server-request "POST")
391 ;; create editing buffer, and move content to it
392 (edit-server-create-edit-buffer proc))
394 ;; send 200 OK response to any other request
395 (edit-server-send-response proc "edit-server is running.\n" t)))
396 ;; wait for another connection to arrive
397 (setq edit-server-received 0)
398 (setq edit-server-phase 'wait)))))
400 (defun edit-server-create-frame(buffer)
401 "Create a frame for the edit server"
402 (if edit-server-new-frame
404 (if (memq window-system '(ns mac))
405 ;; Aquamacs, Emacs NS, Emacs (experimental) Mac port
406 (make-frame edit-server-new-frame-alist)
407 (make-frame-on-display (getenv "DISPLAY")
408 edit-server-new-frame-alist))))
409 (unless edit-server-new-frame-mode-line
410 (setq mode-line-format nil))
411 (select-frame new-frame)
412 (when (and (eq window-system 'x)
413 (fboundp 'x-send-client-message))
414 (x-send-client-message nil 0 nil
415 "_NET_ACTIVE_WINDOW" 32
417 (raise-frame new-frame)
418 (set-window-buffer (frame-selected-window new-frame) buffer)
420 (pop-to-buffer buffer)
424 (defun edit-server-choose-major-mode ()
425 "Use `edit-server-url-major-mode-alist' to choose a major mode
426 initialization function based on `edit-server-url', or fall back
427 to `edit-server-default-major-mode'"
428 (let ((pairs edit-server-url-major-mode-alist)
429 (mode edit-server-default-major-mode))
431 (let ((entry (car pairs)))
432 (if (string-match (car entry) edit-server-url)
433 (setq mode (cdr entry)
435 (setq pairs (cdr pairs)))))
438 (defun edit-server-create-edit-buffer(proc)
439 "Create an edit buffer, place content in it and save the network
440 process for the final call back"
441 (let ((buffer (generate-new-buffer
443 edit-server-edit-buffer-name))))
444 (with-current-buffer buffer
445 (when (fboundp 'set-buffer-multibyte)
446 (set-buffer-multibyte t))) ; djb
447 (copy-to-buffer buffer (point-min) (point-max))
448 (with-current-buffer buffer
449 (setq edit-server-url (with-current-buffer (process-buffer proc) edit-server-url))
450 (edit-server-choose-major-mode)
451 ;; Allow `edit-server-start-hook' to override the major mode.
452 ;; (re)setting the minor mode seems to clear the buffer-local
453 ;; variables that we depend upon for the response, so call the
455 (run-hooks 'edit-server-start-hook)
457 (add-hook 'kill-buffer-hook 'edit-server-abort* nil t)
459 (setq edit-server-proc proc
460 edit-server-frame (edit-server-create-frame buffer))
461 (edit-server-edit-mode))))
463 (defun edit-server-send-response (proc &optional body close)
464 "Send an HTTP 200 OK response back to process PROC.
465 Optional second argument BODY specifies the response content:
466 - If nil, the HTTP response will have null content.
467 - If a string, the string is sent as response content.
468 - Any other value will cause the contents of the current
470 If optional third argument CLOSE is non-nil, then process PROC
471 and its buffer are killed with `edit-server-kill-client'."
474 (let ((response-header (concat
476 (format "Server: Emacs/%s\n" emacs-version)
479 "%a, %d %b %Y %H:%M:%S GMT\n"
481 (process-send-string proc response-header)
482 (process-send-string proc "\n")
485 (process-send-string proc (encode-coding-string body 'utf-8)))
488 (encode-coding-region (point-min) (point-max) 'utf-8)
489 (process-send-region proc (point-min) (point-max))))
490 (process-send-eof proc)
492 (edit-server-kill-client proc))
493 (edit-server-log proc "Editing done, sent HTTP OK response."))
494 (message "edit-server-send-response: invalid proc (bug?)")))
496 (defun edit-server-kill-client (proc)
497 "Kill client process PROC and remove it from the list."
498 (let ((procbuf (process-buffer proc)))
499 (delete-process proc)
500 (when (buffer-live-p procbuf)
501 (kill-buffer procbuf))
502 (setq edit-server-clients (delq proc edit-server-clients))))
504 (defun edit-server-done (&optional abort nokill)
505 "Finish editing: send HTTP response back, close client and editing buffers.
507 The current contents of the buffer are sent back to the HTTP
508 client, unless argument ABORT is non-nil, in which case then the
509 original text is sent back.
510 If optional second argument NOKILL is non-nil, then the editing
511 buffer is not killed.
513 When called interactively, use prefix arg to abort editing."
515 ;; Do nothing if the connection is closed by the browser (tab killed, etc.)
516 (unless (eq (process-status edit-server-proc) 'closed)
517 (let ((buffer (current-buffer))
518 (proc edit-server-proc)
519 (procbuf (process-buffer edit-server-proc)))
520 ;; edit-server-* vars are buffer-local,
521 ;; so they must be used before issuing kill-buffer
523 ;; send back original content
524 (with-current-buffer procbuf
525 (run-hooks 'edit-server-done-hook)
526 (edit-server-send-response proc t))
527 ;; send back edited content
530 (buffer-disable-undo)
531 ;; ensure any format encoding is done (like longlines)
532 (dolist (format buffer-file-format)
533 (format-encode-region (point-min) (point-max) format))
535 (run-hooks 'edit-server-done-hook)
536 (edit-server-send-response edit-server-proc t)
537 ;; restore formats (only useful if we keep the buffer)
538 (dolist (format buffer-file-format)
539 (format-decode-region (point-min) (point-max) format))
540 (buffer-enable-undo)))
541 (when edit-server-frame
542 (delete-frame edit-server-frame))
543 ;; delete-frame may change the current buffer
545 (kill-buffer buffer))
546 (edit-server-kill-client proc))))
549 ;; There are a couple of options for handling the save
550 ;; action. The intent is to preserve data but not finish
551 ;; editing. There are a couple of approaches that could
553 ;; a) Use the iterative edit-server option (send a buffer
554 ;; back to the client which then returns new request
555 ;; to continue the session).
556 ;; b) Back-up the edit session to a file
557 ;; c) Save the current buffer to the kill-ring
559 ;; I've attempted to do a) a couple of times but I keep running
560 ;; into problems which I think are emacs bugs. So for now I'll
561 ;; just push the current buffer to the kill-ring.
563 (defun edit-server-save ()
564 "Save the current state of the edit buffer."
568 (buffer-disable-undo)
569 (copy-region-as-kill (point-min) (point-max))
570 (buffer-enable-undo)))
572 (defun edit-server-abort ()
573 "Discard editing and send the original text back to the browser."
575 (edit-server-done t))
577 (defun edit-server-abort* ()
578 "Discard editing and send the original text back to the browser,
579 but don't kill the editing buffer."
581 (edit-server-done t t))
583 (provide 'edit-server)
585 ;;; edit-server.el ends here