edit-server.el 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651
  1. ;;; edit-server.el --- server that responds to edit requests from Chrome
  2. ;; Copyright (C) 2009-2013 Alex Bennée
  3. ;; Copyright (C) 2010-2011 Riccardo Murri
  4. ;; Author: Alex Bennée <alex@bennee.com>
  5. ;; Maintainer: Alex Bennée <alex@bennee.com>
  6. ;; Version: 1.10
  7. ;; Homepage: https://github.com/stsquad/emacs_chrome
  8. ;; This file is not part of GNU Emacs.
  9. ;; This file is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 3, or (at your option)
  12. ;; any later version.
  13. ;; This file is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;; GNU General Public License for more details.
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  19. ;;; Commentary:
  20. ;; This provides an edit server to respond to requests from the Chrome
  21. ;; Emacs Chrome plugin. This is my first attempt at doing something
  22. ;; with sockets in Emacs. I based it on the following examples:
  23. ;;
  24. ;; http://www.emacswiki.org/emacs/EmacsEchoServer
  25. ;; http://nullprogram.com/blog/2009/05/17/
  26. ;;
  27. ;; To use it ensure the file is in your load-path and add something
  28. ;; like the following examples to your .emacs:
  29. ;;
  30. ;; To open pages for editing in new buffers in your existing Emacs
  31. ;; instance:
  32. ;;
  33. ;; (when (require 'edit-server nil t)
  34. ;; (setq edit-server-new-frame nil)
  35. ;; (edit-server-start))
  36. ;;
  37. ;; To open pages for editing in new frames using a running emacs
  38. ;; started in --daemon mode:
  39. ;;
  40. ;; (when (and (require 'edit-server nil t) (daemonp))
  41. ;; (edit-server-start))
  42. ;;
  43. ;; Buffers are edited in `text-mode' by default; to use a different
  44. ;; major mode, change `edit-server-default-major-mode' or customize
  45. ;; `edit-server-url-major-mode-alist' to specify major modes based
  46. ;; on the remote URL:
  47. ;;
  48. ;; (setq edit-server-url-major-mode-alist
  49. ;; '(("github\\.com" . markdown-mode)))
  50. ;;
  51. ;; Alternatively, set the mode in `edit-server-start-hook'. For
  52. ;; example:
  53. ;;
  54. ;; (add-hook 'edit-server-start-hook
  55. ;; (lambda ()
  56. ;; (when (string-match "github.com" (buffer-name))
  57. ;; (markdown-mode))))
  58. ;;; Code:
  59. ;; uncomment to debug
  60. ;; (setq debug-on-error t)
  61. ;; (setq edebug-all-defs t)
  62. (unless (featurep 'make-network-process)
  63. (error "Incompatible version of [X]Emacs - lacks make-network-process"))
  64. ;;; Customization
  65. (defcustom edit-server-port 9292
  66. "Local port the edit server listens to."
  67. :group 'edit-server
  68. :type 'integer)
  69. (defcustom edit-server-host nil
  70. "If not nil, accept connections from HOST address rather than just
  71. localhost. This may present a security issue."
  72. :group 'edit-server
  73. :type 'boolean)
  74. (defcustom edit-server-verbose nil
  75. "If not nil, log connections and progress also to the echo area."
  76. :group 'edit-server
  77. :type 'boolean)
  78. (defcustom edit-server-done-hook nil
  79. "Hook run when done editing a buffer for the Emacs HTTP edit-server.
  80. Current buffer holds the text that is about to be sent back to the client."
  81. :group 'edit-server
  82. :type 'hook)
  83. (defcustom edit-server-start-hook nil
  84. "Hook run when starting a editing buffer. Current buffer is
  85. the fully prepared editing buffer. Use this hook to enable
  86. buffer-specific modes or add key bindings."
  87. :group 'edit-server
  88. :type 'hook)
  89. ;; frame options
  90. (defcustom edit-server-new-frame t
  91. "If not nil, edit each buffer in a new frame (and raise it)."
  92. :group 'edit-server
  93. :type 'boolean)
  94. (defcustom edit-server-new-frame-alist
  95. '((name . "Emacs TEXTAREA")
  96. (width . 80)
  97. (height . 25)
  98. (minibuffer . t)
  99. (menu-bar-lines . t))
  100. "Frame parameters for new frames. See `default-frame-alist' for examples.
  101. If nil, the new frame will use the existing `default-frame-alist' values."
  102. :group 'edit-server
  103. :type '(repeat (cons :format "%v"
  104. (symbol :tag "Parameter")
  105. (sexp :tag "Value"))))
  106. (defcustom edit-server-default-major-mode
  107. 'text-mode
  108. "The default major mode to use in editing buffers, if no other
  109. mode is selected by `edit-server-url-major-mode-alist'."
  110. :group 'edit-server
  111. :type 'function)
  112. (defcustom edit-server-url-major-mode-alist
  113. nil
  114. "A-list of patterns and corresponding functions; when the first
  115. pattern is encountered which matches `edit-server-url', the
  116. corresponding function will be called in order to set the desired
  117. major mode. If no pattern matches,
  118. `edit-server-default-major-mode' will be used."
  119. :group 'edit-server
  120. :type '(alist :key-type (string :tag "Regexp")
  121. :value-type (function :tag "Major mode function")))
  122. (defcustom edit-server-new-frame-mode-line t
  123. "Show the emacs frame's mode-line if set to t; hide if nil."
  124. :group 'edit-server
  125. :type 'boolean)
  126. ;;; Variables
  127. (defconst edit-server-process-buffer-name " *edit-server*"
  128. "Template name of the edit-server process buffers.")
  129. (defconst edit-server-log-buffer-name "*edit-server-log*"
  130. "Template name of the edit-server process buffers.")
  131. (defconst edit-server-edit-buffer-name "TEXTAREA"
  132. "Template name of the edit-server text editing buffers.")
  133. (defvar edit-server-clients ()
  134. "List of all client processes associated with the server process.")
  135. ;; Buffer local variables
  136. ;;
  137. ;; These are all required to associate the edit buffer with the
  138. ;; correct connection to the client and allow for the buffer to be sent
  139. ;; back when ready. They are `permanent-local` to avoid being reset if
  140. ;; the buffer changes major modes.
  141. (defvar edit-server-proc nil
  142. "Network process associated with the current edit.")
  143. (make-variable-buffer-local 'edit-server-proc)
  144. (put 'edit-server-proc 'permanent-local t)
  145. (defvar edit-server-frame nil
  146. "The frame created for a new edit-server process.")
  147. (make-variable-buffer-local 'edit-server-frame)
  148. (put 'edit-server-frame 'permanent-local t)
  149. (defvar edit-server-phase nil
  150. "Symbol indicating the state of the HTTP request parsing.")
  151. (make-variable-buffer-local 'edit-server-phase)
  152. (put 'edit-server-phase 'permanent-local t)
  153. (defvar edit-server-received nil
  154. "Number of bytes received so far in the client buffer.
  155. Depending on the character encoding, may be different from the buffer length.")
  156. (make-variable-buffer-local 'edit-server-received)
  157. (put 'edit-server-received 'permanent-local t)
  158. (defvar edit-server-request nil
  159. "The HTTP request (GET, HEAD, POST) received.")
  160. (make-variable-buffer-local 'edit-server-request)
  161. (put 'edit-server-request 'permanent-local t)
  162. (defvar edit-server-request-url nil
  163. "The HTTP request URL received.")
  164. (make-variable-buffer-local 'edit-server-request-url)
  165. (put 'edit-server-request-url 'permanent-local t)
  166. (defvar edit-server-content-length nil
  167. "The value gotten from the HTTP `Content-Length' header.")
  168. (make-variable-buffer-local 'edit-server-content-length)
  169. (put 'edit-server-content-length 'permanent-local t)
  170. (defvar edit-server-url nil
  171. "The value gotten from the HTTP `x-url' header.")
  172. (make-variable-buffer-local 'edit-server-url)
  173. (put 'edit-server-url 'permanent-local t)
  174. (defvar edit-server-file nil
  175. "The value gotten from the HTTP `x-file' header.")
  176. (make-variable-buffer-local 'edit-server-file)
  177. (put 'edit-server-file 'permanent-local t)
  178. ;;; Mode magic
  179. ;;
  180. ;; We want to re-map some of the keys to trigger edit-server-done
  181. ;; instead of the usual emacs like behaviour. However using
  182. ;; local-set-key will affect all buffers of the same mode, hence we
  183. ;; define a special (derived) mode for handling editing of text areas.
  184. (defvar edit-server-edit-mode-map
  185. (let ((map (make-sparse-keymap)))
  186. (define-key map (kbd "C-x C-s") 'edit-server-save)
  187. (define-key map (kbd "C-x #") 'edit-server-done)
  188. (define-key map (kbd "C-c C-c") 'edit-server-done)
  189. (define-key map (kbd "C-x C-c") 'edit-server-abort)
  190. map)
  191. "Keymap for minor mode `edit-server-edit-mode'.
  192. Redefine a few common Emacs keystrokes to functions that can
  193. deal with the response to the edit-server request.
  194. Any of the following keys will close the buffer and send the text
  195. to the HTTP client: C-x #, C-c C-c.
  196. Pressing C-x C-s will save the current state to the kill-ring.
  197. If any of the above isused with a prefix argument, the
  198. unmodified text is sent back instead.")
  199. (define-minor-mode edit-server-edit-mode
  200. "Minor mode enabled on buffers opened by `edit-server-accept'.
  201. Its sole purpose is currently to enable
  202. `edit-server-edit-mode-map', which overrides common keystrokes to
  203. send a response back to the client."
  204. :group 'edit-server
  205. :lighter " EditSrv"
  206. :init-value nil
  207. :keymap edit-server-edit-mode-map)
  208. (defun turn-on-edit-server-edit-mode-if-server ()
  209. "Turn on `edit-server-edit-mode' if in an edit-server buffer."
  210. (when edit-server-proc
  211. (edit-server-edit-mode t)))
  212. (define-globalized-minor-mode global-edit-server-edit-mode
  213. edit-server-edit-mode turn-on-edit-server-edit-mode-if-server)
  214. (global-edit-server-edit-mode t)
  215. ;; Edit Server socket code
  216. ;; Avoid an unnecessary prompt about active processes when exiting
  217. ;; emacs with no active edit-server clients
  218. ;; https://github.com/stsquad/emacs_chrome/issues/67
  219. ;;
  220. ;; According to http://emacswiki.org/emacs/AdviceVsHooks advice is a
  221. ;; sledgehammer which should be avoided if possible. However, the
  222. ;; only hooks run by save-buffers-kill-emacs are defined by
  223. ;; kill-emacs-query-functions and run *after* the check for active
  224. ;; processes which results in precisely the interactive prompt we want
  225. ;; to avoid when edit-server has no active clients. So it seems that
  226. ;; advice is the only solution until save-buffers-kill-emacs offers an
  227. ;; earlier hook.
  228. (defadvice save-buffers-kill-emacs
  229. (before edit-server-stop-before-kill-emacs)
  230. "Call `edit-server-stop' if there are no active clients, to
  231. avoid the user being prompted to kill the edit-server process."
  232. (or edit-server-clients (edit-server-stop)))
  233. ;;;###autoload
  234. (defun edit-server-start (&optional verbose)
  235. "Start the edit server.
  236. If argument VERBOSE is non-nil, logs all server activity to buffer
  237. `*edit-server-log*'. When called interactivity, a prefix argument
  238. will cause it to be verbose."
  239. (interactive "P")
  240. (if (or (process-status "edit-server")
  241. (null (condition-case err
  242. (let ((proc (make-network-process
  243. :name "edit-server"
  244. :buffer edit-server-process-buffer-name
  245. :family 'ipv4
  246. :host (or edit-server-host 'local)
  247. :service edit-server-port
  248. :log 'edit-server-accept
  249. :server t
  250. :noquery t)))
  251. (set-process-coding-system proc 'utf-8 'utf-8)
  252. proc)
  253. (file-error nil))))
  254. (message "An edit-server process is already running")
  255. (ad-activate 'save-buffers-kill-emacs)
  256. (setq edit-server-clients '())
  257. (if verbose (get-buffer-create edit-server-log-buffer-name))
  258. (edit-server-log nil "Created a new edit-server process")))
  259. (defun edit-server-stop nil
  260. "Stop the edit server"
  261. (interactive)
  262. (while edit-server-clients
  263. (edit-server-kill-client (car edit-server-clients))
  264. (setq edit-server-clients (cdr edit-server-clients)))
  265. (if (process-status "edit-server")
  266. (delete-process "edit-server")
  267. (message "No edit server running"))
  268. (when (get-buffer edit-server-process-buffer-name)
  269. (kill-buffer edit-server-process-buffer-name))
  270. (ad-disable-advice 'save-buffers-kill-emacs
  271. 'before 'edit-server-stop-before-kill-emacs)
  272. ;; Disabling advice doesn't take effect until you (re-)activate
  273. ;; all advice for the function.
  274. (ad-activate 'save-buffers-kill-emacs))
  275. (defun edit-server-log (proc fmt &rest args)
  276. "If a `*edit-server-log*' buffer exists, write STRING to it.
  277. This is done for logging purposes. If `edit-server-verbose' is
  278. non-nil, then STRING is also echoed to the message line."
  279. (let ((string (apply 'format fmt args)))
  280. (if edit-server-verbose
  281. (message string))
  282. (if (get-buffer edit-server-log-buffer-name)
  283. (with-current-buffer edit-server-log-buffer-name
  284. (goto-char (point-max))
  285. (insert (current-time-string)
  286. " "
  287. (if (processp proc)
  288. (concat
  289. (buffer-name (process-buffer proc))
  290. ": ")
  291. "") ; nil is not acceptable to 'insert
  292. string)
  293. (or (bolp) (newline))))))
  294. (defun edit-server-accept (server client msg)
  295. "Accept a new client connection."
  296. (let ((buffer (generate-new-buffer edit-server-process-buffer-name)))
  297. (when (fboundp 'set-buffer-multibyte)
  298. (set-buffer-multibyte t)) ; djb
  299. (buffer-disable-undo buffer)
  300. (set-process-buffer client buffer)
  301. (set-process-filter client 'edit-server-filter)
  302. ;; kill-buffer kills the associated process
  303. (set-process-query-on-exit-flag client nil)
  304. (with-current-buffer buffer
  305. (setq edit-server-phase 'wait
  306. edit-server-received 0
  307. edit-server-request nil
  308. edit-server-request-url nil))
  309. (setq edit-server-content-length nil
  310. edit-server-url nil
  311. edit-server-file nil))
  312. (add-to-list 'edit-server-clients client)
  313. (edit-server-log client msg))
  314. (defun edit-server-filter (proc string)
  315. "Process data received from the client."
  316. ;; there is no guarantee that data belonging to the same client
  317. ;; request will arrive all in one go; therefore, we must accumulate
  318. ;; data in the buffer and process it in different phases, which
  319. ;; requires us to keep track of the processing state.
  320. (with-current-buffer (process-buffer proc)
  321. (insert string)
  322. (setq edit-server-received
  323. (+ edit-server-received (string-bytes string)))
  324. (when (eq edit-server-phase 'wait)
  325. ;; look for a complete HTTP request string
  326. (save-excursion
  327. (goto-char (point-min))
  328. (when (re-search-forward
  329. "^\\([A-Z]+\\)\\s-+\\(\\S-+\\)\\s-+\\(HTTP/[0-9\.]+\\)\r?\n"
  330. nil t)
  331. (setq edit-server-request (match-string 1)
  332. edit-server-request-url (match-string 2)
  333. edit-server-content-length nil
  334. edit-server-phase 'head)
  335. (edit-server-log
  336. proc "Got HTTP `%s' request of url `%s', processing in buffer `%s'..."
  337. edit-server-request edit-server-request-url (current-buffer)))))
  338. (when (eq edit-server-phase 'head)
  339. ;; look for "Content-length" header
  340. (save-excursion
  341. (goto-char (point-min))
  342. (when (re-search-forward "^Content-Length:\\s-+\\([0-9]+\\)" nil t)
  343. (setq edit-server-content-length
  344. (string-to-number (match-string 1)))))
  345. ;; look for "x-url" header
  346. (save-excursion
  347. (goto-char (point-min))
  348. (when (re-search-forward "^x-url: .*/\\{2,3\\}\\([^?\r\n ]+\\)" nil t)
  349. (setq edit-server-url (match-string 1))))
  350. ;; look for "x-file" header
  351. (save-excursion
  352. (goto-char (point-min))
  353. (when (re-search-forward "^x-file: \\([^?\r\n ]+\\)" nil t)
  354. (edit-server-log proc "Found x-file: %s" (match-string 1))
  355. (setq edit-server-file (match-string 1))))
  356. ;; look for head/body separator
  357. (save-excursion
  358. (goto-char (point-min))
  359. (when (re-search-forward "\\(\r?\n\\)\\{2\\}" nil t)
  360. ;; HTTP headers are pure ASCII (1 char = 1 byte), so we can subtract
  361. ;; the buffer position from the count of received bytes
  362. (setq edit-server-received
  363. (- edit-server-received (- (match-end 0) (point-min))))
  364. ;; discard headers - keep only HTTP content in buffer
  365. (delete-region (point-min) (match-end 0))
  366. (edit-server-log proc
  367. "Processed headers, length: %s, url: %s, file: %s"
  368. edit-server-content-length edit-server-url edit-server-file)
  369. (setq edit-server-phase 'body))))
  370. (when (eq edit-server-phase 'body)
  371. (if (and edit-server-content-length
  372. (> edit-server-content-length edit-server-received))
  373. (edit-server-log proc
  374. "Received %d bytes of %d ..."
  375. edit-server-received edit-server-content-length)
  376. ;; all content transferred - process request now
  377. (cond
  378. ((string= edit-server-request "POST")
  379. ;; create editing buffer, and move content to it
  380. (edit-server-find-or-create-edit-buffer proc edit-server-file))
  381. ((string-match "foreground" edit-server-request-url)
  382. (edit-server-foreground-request)
  383. (edit-server-send-response proc "edit-server received foreground request.\n")
  384. (edit-server-kill-client proc))
  385. (t
  386. ;; send 200 OK response to any other request
  387. (edit-server-send-response proc "edit-server is running.\n")
  388. (edit-server-kill-client proc)))
  389. ;; wait for another connection to arrive
  390. (setq edit-server-received 0)
  391. (setq edit-server-phase 'wait)))))
  392. (defun edit-server-foreground-request ()
  393. "Bring Emacs into the foreground after a request from Chrome"
  394. (when edit-server-new-frame
  395. (make-frame-on-display (getenv "DISPLAY")
  396. edit-server-new-frame-alist)))
  397. (defun edit-server-show-edit-buffer (buffer)
  398. "Show edit buffer by creating a frame or raising the selected
  399. frame."
  400. (if edit-server-new-frame
  401. (let ((new-frame
  402. (if (memq window-system '(ns mac))
  403. ;; Aquamacs, Emacs NS, Emacs (experimental) Mac port
  404. (make-frame edit-server-new-frame-alist)
  405. (make-frame-on-display (getenv "DISPLAY")
  406. edit-server-new-frame-alist))))
  407. (unless edit-server-new-frame-mode-line
  408. (setq mode-line-format nil))
  409. (select-frame new-frame)
  410. (when (and (eq window-system 'x)
  411. (fboundp 'x-send-client-message))
  412. (x-send-client-message nil 0 nil
  413. "_NET_ACTIVE_WINDOW" 32
  414. '(1 0 0)))
  415. (raise-frame new-frame)
  416. (set-window-buffer (frame-selected-window new-frame) buffer)
  417. new-frame)
  418. (select-frame-set-input-focus (window-frame (selected-window)))
  419. (pop-to-buffer buffer)
  420. (raise-frame)
  421. nil))
  422. (defun edit-server-choose-major-mode ()
  423. "Use `edit-server-url-major-mode-alist' to choose a major mode
  424. initialization function based on `edit-server-url', or fall back
  425. to `edit-server-default-major-mode'"
  426. (let ((pairs edit-server-url-major-mode-alist)
  427. (mode edit-server-default-major-mode))
  428. (while pairs
  429. (let ((entry (car pairs)))
  430. (if (string-match (car entry) edit-server-url)
  431. (setq mode (cdr entry)
  432. pairs nil)
  433. (setq pairs (cdr pairs)))))
  434. (funcall mode)))
  435. (defun edit-server-find-or-create-edit-buffer(proc &optional existing)
  436. "Find and existing or create an new edit buffer, place content in it
  437. and save the network process for the final call back"
  438. (let* ((existing-buffer (get-buffer (or (and (stringp existing) existing) "")))
  439. (buffer (or existing-buffer (generate-new-buffer
  440. (or edit-server-url
  441. edit-server-edit-buffer-name)))))
  442. (edit-server-log proc
  443. "using buffer %s for edit (existing-buffer is %s)"
  444. buffer existing-buffer)
  445. ;; set multi-byte for proper UTF-8 handling (djb)
  446. (when (fboundp 'set-buffer-multibyte)
  447. (with-current-buffer buffer
  448. (set-buffer-multibyte t)))
  449. ;; I seem to be working around a bug here :-/
  450. ;;
  451. ;; For some reason the copy-to-buffer doesn't blat the existing contents.
  452. ;; This screws up formatting as the contents where decoded before being
  453. ;; sent back to the browser. As a kludge I save the returned contents
  454. ;; in the kill-ring.
  455. (when existing-buffer
  456. (kill-ring-save (point-min) (point-max)))
  457. (edit-server-log proc "copying new data into buffer")
  458. (copy-to-buffer buffer (point-min) (point-max))
  459. (with-current-buffer buffer
  460. (setq edit-server-url (with-current-buffer (process-buffer proc) edit-server-url))
  461. (edit-server-choose-major-mode)
  462. ;; Allow `edit-server-start-hook' to override the major mode.
  463. ;; (re)setting the minor mode seems to clear the buffer-local
  464. ;; variables that we depend upon for the response, so call the
  465. ;; hooks early on
  466. (run-hooks 'edit-server-start-hook)
  467. (set-buffer-modified-p 'nil)
  468. (add-hook 'kill-buffer-hook 'edit-server-abort* nil t)
  469. (buffer-enable-undo)
  470. (setq edit-server-proc proc
  471. edit-server-frame (edit-server-show-edit-buffer buffer))
  472. (edit-server-edit-mode))))
  473. (defun edit-server-send-response (proc &optional body progress)
  474. "Send an HTTP 200 OK response back to process PROC.
  475. Optional second argument BODY specifies the response content:
  476. - If nil, the HTTP response will have null content.
  477. - If a string, the string is sent as response content.
  478. - Any other value will cause the contents of the current
  479. buffer to be sent.
  480. If optional third argument progress is non-nil, then the response
  481. will include x-file and x-open headers to allow continuation of editing."
  482. (interactive)
  483. (edit-server-log proc "sending edit-server response")
  484. (if (processp proc)
  485. (let ((response-header (concat
  486. "HTTP/1.0 200 OK\n"
  487. (format "Server: Emacs/%s\n" emacs-version)
  488. "Date: "
  489. (format-time-string
  490. "%a, %d %b %Y %H:%M:%S GMT\n"
  491. (current-time))
  492. (when progress
  493. (format "x-file: %s\nx-open: true\n" (buffer-name))))))
  494. (process-send-string proc response-header)
  495. (process-send-string proc "\n")
  496. (cond
  497. ((stringp body)
  498. (process-send-string proc (encode-coding-string body 'utf-8)))
  499. ((not body) nil)
  500. (t
  501. (encode-coding-region (point-min) (point-max) 'utf-8)
  502. (process-send-region proc (point-min) (point-max))))
  503. (process-send-eof proc)
  504. (edit-server-log proc "Editing done, sent HTTP OK response."))
  505. (message "edit-server-send-response: invalid proc (bug?)")))
  506. (defun edit-server-kill-client (proc)
  507. "Kill client process PROC and remove it from the list."
  508. (let ((procbuf (process-buffer proc)))
  509. (delete-process proc)
  510. (when (buffer-live-p procbuf)
  511. (kill-buffer procbuf))
  512. (setq edit-server-clients (delq proc edit-server-clients))))
  513. (defun edit-server-done (&optional abort nokill)
  514. "Finish editing: send HTTP response back, close client and editing buffers.
  515. The current contents of the buffer are sent back to the HTTP
  516. client, unless argument ABORT is non-nil, in which case then the
  517. original text is sent back.
  518. If optional second argument NOKILL is non-nil, then the editing
  519. buffer is not killed and the buffer name is passed to calling process.
  520. When called interactively, use prefix arg to abort editing."
  521. (interactive "P")
  522. ;; Do nothing if the connection is closed by the browser (tab killed, etc.)
  523. (unless (eq (process-status edit-server-proc) 'closed)
  524. (let ((buffer (current-buffer))
  525. (proc edit-server-proc)
  526. (procbuf (process-buffer edit-server-proc)))
  527. ;; edit-server-* vars are buffer-local,
  528. ;; so they must be used before issuing kill-buffer
  529. (if abort
  530. ;; send back original content
  531. (with-current-buffer procbuf
  532. (run-hooks 'edit-server-done-hook)
  533. (edit-server-send-response proc t))
  534. ;; send back edited content
  535. (save-restriction
  536. (widen)
  537. (buffer-disable-undo)
  538. ;; ensure any format encoding is done (like longlines)
  539. (dolist (format buffer-file-format)
  540. (format-encode-region (point-min) (point-max) format))
  541. ;; send back
  542. (run-hooks 'edit-server-done-hook)
  543. (edit-server-send-response proc t nokill)
  544. (edit-server-log proc "sent response to browser")))
  545. (when edit-server-frame
  546. (delete-frame edit-server-frame))
  547. ;; delete-frame may change the current buffer
  548. (unless nokill
  549. (kill-buffer buffer))
  550. (edit-server-kill-client proc))))
  551. ;; edit-server-save uses the iterative edit-server option (send a
  552. ;; buffer back to the client which then returns new request to
  553. ;; continue the session). The edit-server then switches back to the
  554. ;; buffer referenced by the x-file header.
  555. ;;
  556. (defun edit-server-save ()
  557. "Save the current state of the edit buffer but don't close it."
  558. (interactive)
  559. (edit-server-done nil t))
  560. (defun edit-server-abort ()
  561. "Discard editing and send the original text back to the browser."
  562. (interactive)
  563. (edit-server-done t))
  564. (defun edit-server-abort* ()
  565. "Discard editing and send the original text back to the browser,
  566. but don't kill the editing buffer."
  567. (interactive)
  568. (edit-server-done t t))
  569. (provide 'edit-server)
  570. ;;; edit-server.el ends here