-;;
-;; Emacs edit-server
-;;
+;;; 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/
+;;   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:

  (if (process-status "edit-server")
      (delete-process "edit-server")
    (message "No edit server running"))
  (if (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 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)))
    (and (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)
    (set-process-query-on-exit-flag client nil) ; kill-buffer kills the associated process
    (with-current-buffer buffer
      (set (make-local-variable 'edit-server-phase) 'wait)
      (set (make-local-variable 'edit-server-received) 0)
      (set (make-local-variable 'edit-server-request) nil))
      (set (make-local-variable 'edit-server-content-length) nil)
      (set (make-local-variable '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."

  ;; 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
      (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)
