edit-server.el 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634
  1. ;;; edit-server.el --- server that responds to edit requests from Chrome
  2. ;; Copyright (C) 2009-2011 Alex Bennee
  3. ;; Copyright (C) 2010-2011 Riccardo Murri
  4. ;; Author: Alex Bennee <alex@bennee.com>
  5. ;; Maintainer: Alex Bennee <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-content-length nil
  163. "The value gotten from the HTTP `Content-Length' header.")
  164. (make-variable-buffer-local 'edit-server-content-length)
  165. (put 'edit-server-content-length 'permanent-local t)
  166. (defvar edit-server-url nil
  167. "The value gotten from the HTTP `x-url' header.")
  168. (make-variable-buffer-local 'edit-server-url)
  169. (put 'edit-server-url 'permanent-local t)
  170. (defvar edit-server-file nil
  171. "The value gotten from the HTTP `x-file' header.")
  172. (make-variable-buffer-local 'edit-server-file)
  173. (put 'edit-server-file 'permanent-local t)
  174. ;;; Mode magic
  175. ;;
  176. ;; We want to re-map some of the keys to trigger edit-server-done
  177. ;; instead of the usual emacs like behaviour. However using
  178. ;; local-set-key will affect all buffers of the same mode, hence we
  179. ;; define a special (derived) mode for handling editing of text areas.
  180. (defvar edit-server-edit-mode-map
  181. (let ((map (make-sparse-keymap)))
  182. (define-key map (kbd "C-x C-s") 'edit-server-save)
  183. (define-key map (kbd "C-x #") 'edit-server-done)
  184. (define-key map (kbd "C-c C-c") 'edit-server-done)
  185. (define-key map (kbd "C-x C-c") 'edit-server-abort)
  186. map)
  187. "Keymap for minor mode `edit-server-edit-mode'.
  188. Redefine a few common Emacs keystrokes to functions that can
  189. deal with the response to the edit-server request.
  190. Any of the following keys will close the buffer and send the text
  191. to the HTTP client: C-x #, C-c C-c.
  192. Pressing C-x C-s will save the current state to the kill-ring.
  193. If any of the above isused with a prefix argument, the
  194. unmodified text is sent back instead.")
  195. (define-minor-mode edit-server-edit-mode
  196. "Minor mode enabled on buffers opened by `edit-server-accept'.
  197. Its sole purpose is currently to enable
  198. `edit-server-edit-mode-map', which overrides common keystrokes to
  199. send a response back to the client."
  200. :group 'edit-server
  201. :lighter " EditSrv"
  202. :init-value nil
  203. :keymap edit-server-edit-mode-map)
  204. (defun turn-on-edit-server-edit-mode-if-server ()
  205. "Turn on `edit-server-edit-mode' if in an edit-server buffer."
  206. (when edit-server-proc
  207. (edit-server-edit-mode t)))
  208. (define-globalized-minor-mode global-edit-server-edit-mode
  209. edit-server-edit-mode turn-on-edit-server-edit-mode-if-server)
  210. (global-edit-server-edit-mode t)
  211. ;; Edit Server socket code
  212. ;; Avoid an unnecessary prompt about active processes when exiting
  213. ;; emacs with no active edit-server clients
  214. ;; https://github.com/stsquad/emacs_chrome/issues/67
  215. ;;
  216. ;; According to http://emacswiki.org/emacs/AdviceVsHooks advice is a
  217. ;; sledgehammer which should be avoided if possible. However, the
  218. ;; only hooks run by save-buffers-kill-emacs are defined by
  219. ;; kill-emacs-query-functions and run *after* the check for active
  220. ;; processes which results in precisely the interactive prompt we want
  221. ;; to avoid when edit-server has no active clients. So it seems that
  222. ;; advice is the only solution until save-buffers-kill-emacs offers an
  223. ;; earlier hook.
  224. (defadvice save-buffers-kill-emacs
  225. (before edit-server-stop-before-kill-emacs)
  226. "Call `edit-server-stop' if there are no active clients, to
  227. avoid the user being prompted to kill the edit-server process."
  228. (or edit-server-clients (edit-server-stop)))
  229. (defun edit-server-start (&optional verbose)
  230. "Start the edit server.
  231. If argument VERBOSE is non-nil, logs all server activity to buffer
  232. `*edit-server-log*'. When called interactivity, a prefix argument
  233. will cause it to be verbose."
  234. (interactive "P")
  235. (if (or (process-status "edit-server")
  236. (null (condition-case err
  237. (let ((proc (make-network-process
  238. :name "edit-server"
  239. :buffer edit-server-process-buffer-name
  240. :family 'ipv4
  241. :host (or edit-server-host 'local)
  242. :service edit-server-port
  243. :log 'edit-server-accept
  244. :server t
  245. :noquery t)))
  246. (set-process-coding-system proc 'utf-8 'utf-8)
  247. proc)
  248. (file-error nil))))
  249. (message "An edit-server process is already running")
  250. (ad-activate 'save-buffers-kill-emacs)
  251. (setq edit-server-clients '())
  252. (if verbose (get-buffer-create edit-server-log-buffer-name))
  253. (edit-server-log nil "Created a new edit-server process")))
  254. (defun edit-server-stop nil
  255. "Stop the edit server"
  256. (interactive)
  257. (while edit-server-clients
  258. (edit-server-kill-client (car edit-server-clients))
  259. (setq edit-server-clients (cdr edit-server-clients)))
  260. (if (process-status "edit-server")
  261. (delete-process "edit-server")
  262. (message "No edit server running"))
  263. (when (get-buffer edit-server-process-buffer-name)
  264. (kill-buffer edit-server-process-buffer-name))
  265. (ad-disable-advice 'save-buffers-kill-emacs
  266. 'before 'edit-server-stop-before-kill-emacs)
  267. ;; Disabling advice doesn't take effect until you (re-)activate
  268. ;; all advice for the function.
  269. (ad-activate 'save-buffers-kill-emacs))
  270. (defun edit-server-log (proc fmt &rest args)
  271. "If a `*edit-server-log*' buffer exists, write STRING to it.
  272. This is done for logging purposes. If `edit-server-verbose' is
  273. non-nil, then STRING is also echoed to the message line."
  274. (let ((string (apply 'format fmt args)))
  275. (if edit-server-verbose
  276. (message string))
  277. (if (get-buffer edit-server-log-buffer-name)
  278. (with-current-buffer edit-server-log-buffer-name
  279. (goto-char (point-max))
  280. (insert (current-time-string)
  281. " "
  282. (if (processp proc)
  283. (concat
  284. (buffer-name (process-buffer proc))
  285. ": ")
  286. "") ; nil is not acceptable to 'insert
  287. string)
  288. (or (bolp) (newline))))))
  289. (defun edit-server-accept (server client msg)
  290. "Accept a new client connection."
  291. (let ((buffer (generate-new-buffer edit-server-process-buffer-name)))
  292. (when (fboundp 'set-buffer-multibyte)
  293. (set-buffer-multibyte t)) ; djb
  294. (buffer-disable-undo buffer)
  295. (set-process-buffer client buffer)
  296. (set-process-filter client 'edit-server-filter)
  297. ;; kill-buffer kills the associated process
  298. (set-process-query-on-exit-flag client nil)
  299. (with-current-buffer buffer
  300. (setq edit-server-phase 'wait
  301. edit-server-received 0
  302. edit-server-request nil))
  303. (setq edit-server-content-length nil
  304. edit-server-url nil
  305. edit-server-file nil))
  306. (add-to-list 'edit-server-clients client)
  307. (edit-server-log client msg))
  308. (defun edit-server-filter (proc string)
  309. "Process data received from the client."
  310. ;; there is no guarantee that data belonging to the same client
  311. ;; request will arrive all in one go; therefore, we must accumulate
  312. ;; data in the buffer and process it in different phases, which
  313. ;; requires us to keep track of the processing state.
  314. (with-current-buffer (process-buffer proc)
  315. (insert string)
  316. (setq edit-server-received
  317. (+ edit-server-received (string-bytes string)))
  318. (when (eq edit-server-phase 'wait)
  319. ;; look for a complete HTTP request string
  320. (save-excursion
  321. (goto-char (point-min))
  322. (when (re-search-forward
  323. "^\\([A-Z]+\\)\\s-+\\(\\S-+\\)\\s-+\\(HTTP/[0-9\.]+\\)\r?\n"
  324. nil t)
  325. (edit-server-log
  326. proc "Got HTTP `%s' request, processing in buffer `%s'..."
  327. (match-string 1) (current-buffer))
  328. (setq edit-server-request (match-string 1))
  329. (setq edit-server-content-length nil)
  330. (setq edit-server-phase 'head))))
  331. (when (eq edit-server-phase 'head)
  332. ;; look for "Content-length" header
  333. (save-excursion
  334. (goto-char (point-min))
  335. (when (re-search-forward "^Content-Length:\\s-+\\([0-9]+\\)" nil t)
  336. (setq edit-server-content-length
  337. (string-to-number (match-string 1)))))
  338. ;; look for "x-url" header
  339. (save-excursion
  340. (goto-char (point-min))
  341. (when (re-search-forward "^x-url: .*/\\{2,3\\}\\([^?\r\n ]+\\)" nil t)
  342. (setq edit-server-url (match-string 1))))
  343. ;; look for "x-file" header
  344. (save-excursion
  345. (goto-char (point-min))
  346. (when (re-search-forward "^x-file: \\([^?\r\n ]+\\)" nil t)
  347. (edit-server-log proc "Found x-file: %s" (match-string 1))
  348. (setq edit-server-file (match-string 1))))
  349. ;; look for head/body separator
  350. (save-excursion
  351. (goto-char (point-min))
  352. (when (re-search-forward "\\(\r?\n\\)\\{2\\}" nil t)
  353. ;; HTTP headers are pure ASCII (1 char = 1 byte), so we can subtract
  354. ;; the buffer position from the count of received bytes
  355. (setq edit-server-received
  356. (- edit-server-received (- (match-end 0) (point-min))))
  357. ;; discard headers - keep only HTTP content in buffer
  358. (delete-region (point-min) (match-end 0))
  359. (edit-server-log proc
  360. "Processed headers, length: %s, url: %s, file: %s"
  361. edit-server-content-length edit-server-url edit-server-file)
  362. (setq edit-server-phase 'body))))
  363. (when (eq edit-server-phase 'body)
  364. (if (and edit-server-content-length
  365. (> edit-server-content-length edit-server-received))
  366. (edit-server-log proc
  367. "Received %d bytes of %d ..."
  368. edit-server-received edit-server-content-length)
  369. ;; all content transferred - process request now
  370. (cond
  371. ((string= edit-server-request "POST")
  372. ;; create editing buffer, and move content to it
  373. (edit-server-find-or-create-edit-buffer proc edit-server-file))
  374. (t
  375. ;; send 200 OK response to any other request
  376. (edit-server-send-response proc "edit-server is running.\n")
  377. (edit-server-kill-client proc)))
  378. ;; wait for another connection to arrive
  379. (setq edit-server-received 0)
  380. (setq edit-server-phase 'wait)))))
  381. (defun edit-server-show-edit-buffer (buffer)
  382. "Show edit buffer by creating a frame or raising the selected
  383. frame."
  384. (if edit-server-new-frame
  385. (let ((new-frame
  386. (if (memq window-system '(ns mac))
  387. ;; Aquamacs, Emacs NS, Emacs (experimental) Mac port
  388. (make-frame edit-server-new-frame-alist)
  389. (make-frame-on-display (getenv "DISPLAY")
  390. edit-server-new-frame-alist))))
  391. (unless edit-server-new-frame-mode-line
  392. (setq mode-line-format nil))
  393. (select-frame new-frame)
  394. (when (and (eq window-system 'x)
  395. (fboundp 'x-send-client-message))
  396. (x-send-client-message nil 0 nil
  397. "_NET_ACTIVE_WINDOW" 32
  398. '(1 0 0)))
  399. (raise-frame new-frame)
  400. (set-window-buffer (frame-selected-window new-frame) buffer)
  401. new-frame)
  402. (select-frame-set-input-focus (window-frame (selected-window)))
  403. (pop-to-buffer buffer)
  404. (raise-frame)
  405. nil))
  406. (defun edit-server-choose-major-mode ()
  407. "Use `edit-server-url-major-mode-alist' to choose a major mode
  408. initialization function based on `edit-server-url', or fall back
  409. to `edit-server-default-major-mode'"
  410. (let ((pairs edit-server-url-major-mode-alist)
  411. (mode edit-server-default-major-mode))
  412. (while pairs
  413. (let ((entry (car pairs)))
  414. (if (string-match (car entry) edit-server-url)
  415. (setq mode (cdr entry)
  416. pairs nil)
  417. (setq pairs (cdr pairs)))))
  418. (funcall mode)))
  419. (defun edit-server-find-or-create-edit-buffer(proc &optional existing)
  420. "Find and existing or create an new edit buffer, place content in it
  421. and save the network process for the final call back"
  422. (let* ((existing-buffer (get-buffer (or (and (stringp existing) existing) "")))
  423. (buffer (or existing-buffer (generate-new-buffer
  424. (or edit-server-url
  425. edit-server-edit-buffer-name)))))
  426. (edit-server-log proc (format
  427. "using buffer %s for edit (existing-buffer
  428. is %s)"
  429. buffer existing-buffer))
  430. ;; set multi-byte for proper UTF-8 handling (djb)
  431. (when (fboundp 'set-buffer-multibyte)
  432. (with-current-buffer buffer
  433. (set-buffer-multibyte t)))
  434. ;; I seem to be working around a bug here :-/
  435. ;;
  436. ;; For some reason the copy-to-buffer doesn't blat the existing contents.
  437. ;; This screws up formatting as the contents where decoded before being
  438. ;; sent back to the browser. As a kludge I save the returned contents
  439. ;; in the kill-ring.
  440. (when existing-buffer
  441. (kill-ring-save (point-min) (point-max)))
  442. (edit-server-log proc "copying new data into buffer")
  443. (copy-to-buffer buffer (point-min) (point-max))
  444. (with-current-buffer buffer
  445. (setq edit-server-url (with-current-buffer (process-buffer proc) edit-server-url))
  446. (edit-server-choose-major-mode)
  447. ;; Allow `edit-server-start-hook' to override the major mode.
  448. ;; (re)setting the minor mode seems to clear the buffer-local
  449. ;; variables that we depend upon for the response, so call the
  450. ;; hooks early on
  451. (run-hooks 'edit-server-start-hook)
  452. (set-buffer-modified-p 'nil)
  453. (add-hook 'kill-buffer-hook 'edit-server-abort* nil t)
  454. (buffer-enable-undo)
  455. (setq edit-server-proc proc
  456. edit-server-frame (edit-server-show-edit-buffer buffer))
  457. (edit-server-edit-mode))))
  458. (defun edit-server-send-response (proc &optional body progress)
  459. "Send an HTTP 200 OK response back to process PROC.
  460. Optional second argument BODY specifies the response content:
  461. - If nil, the HTTP response will have null content.
  462. - If a string, the string is sent as response content.
  463. - Any other value will cause the contents of the current
  464. buffer to be sent.
  465. If optional third argument progress is non-nil, then the response
  466. will include x-file and x-open headers to allow continuation of editing."
  467. (interactive)
  468. (edit-server-log proc "sending edit-server response")
  469. (if (processp proc)
  470. (let ((response-header (concat
  471. "HTTP/1.0 200 OK\n"
  472. (format "Server: Emacs/%s\n" emacs-version)
  473. "Date: "
  474. (format-time-string
  475. "%a, %d %b %Y %H:%M:%S GMT\n"
  476. (current-time))
  477. (when progress
  478. (format "x-file: %s\nx-open: true\n" (buffer-name))))))
  479. (process-send-string proc response-header)
  480. (process-send-string proc "\n")
  481. (cond
  482. ((stringp body)
  483. (process-send-string proc (encode-coding-string body 'utf-8)))
  484. ((not body) nil)
  485. (t
  486. (encode-coding-region (point-min) (point-max) 'utf-8)
  487. (process-send-region proc (point-min) (point-max))))
  488. (process-send-eof proc)
  489. (edit-server-log proc "Editing done, sent HTTP OK response."))
  490. (message "edit-server-send-response: invalid proc (bug?)")))
  491. (defun edit-server-kill-client (proc)
  492. "Kill client process PROC and remove it from the list."
  493. (let ((procbuf (process-buffer proc)))
  494. (delete-process proc)
  495. (when (buffer-live-p procbuf)
  496. (kill-buffer procbuf))
  497. (setq edit-server-clients (delq proc edit-server-clients))))
  498. (defun edit-server-done (&optional abort nokill)
  499. "Finish editing: send HTTP response back, close client and editing buffers.
  500. The current contents of the buffer are sent back to the HTTP
  501. client, unless argument ABORT is non-nil, in which case then the
  502. original text is sent back.
  503. If optional second argument NOKILL is non-nil, then the editing
  504. buffer is not killed and the buffer name is passed to calling process.
  505. When called interactively, use prefix arg to abort editing."
  506. (interactive "P")
  507. ;; Do nothing if the connection is closed by the browser (tab killed, etc.)
  508. (unless (eq (process-status edit-server-proc) 'closed)
  509. (let ((buffer (current-buffer))
  510. (proc edit-server-proc)
  511. (procbuf (process-buffer edit-server-proc)))
  512. ;; edit-server-* vars are buffer-local,
  513. ;; so they must be used before issuing kill-buffer
  514. (if abort
  515. ;; send back original content
  516. (with-current-buffer procbuf
  517. (run-hooks 'edit-server-done-hook)
  518. (edit-server-send-response proc t))
  519. ;; send back edited content
  520. (save-restriction
  521. (widen)
  522. (buffer-disable-undo)
  523. ;; ensure any format encoding is done (like longlines)
  524. (dolist (format buffer-file-format)
  525. (format-encode-region (point-min) (point-max) format))
  526. ;; send back
  527. (run-hooks 'edit-server-done-hook)
  528. (edit-server-send-response proc t nokill)
  529. (edit-server-log proc "sent response to browser")))
  530. (when edit-server-frame
  531. (delete-frame edit-server-frame))
  532. ;; delete-frame may change the current buffer
  533. (unless nokill
  534. (kill-buffer buffer))
  535. (edit-server-kill-client proc))))
  536. ;; edit-server-save uses the iterative edit-server option (send a
  537. ;; buffer back to the client which then returns new request to
  538. ;; continue the session). The edit-server then switches back to the
  539. ;; buffer referenced by the x-file header.
  540. ;;
  541. (defun edit-server-save ()
  542. "Save the current state of the edit buffer but don't close it."
  543. (interactive)
  544. (edit-server-done nil t))
  545. (defun edit-server-abort ()
  546. "Discard editing and send the original text back to the browser."
  547. (interactive)
  548. (edit-server-done t))
  549. (defun edit-server-abort* ()
  550. "Discard editing and send the original text back to the browser,
  551. but don't kill the editing buffer."
  552. (interactive)
  553. (edit-server-done t t))
  554. (provide 'edit-server)
  555. ;;; edit-server.el ends here