i7.el

;;; i7.el --- Inform 7 major mode

;; Copyright (C) 2013, 2014  Brady J. Garvin

;; Author: Brady Garvin <bgarvin@acm.org>
;; Version: 0.1
;; Keywords: languages

;; Inform 7 Mode 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.

;; Inform 7 Mode 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 Inform 7 Mode; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.

;;; Commentary:


;;; Code:

;; Support for Emacs < 24.0.
(eval-and-compile
  (unless (fboundp 'setq-local)
    (defmacro setq-local (variable value)
      `(set (make-local-variable ',variable) ,value))))


;;; Customization:

(defgroup i7 nil
  "Inform 7 major mode."
  :group 'languages
  :link '(custom-group-link :tag "Font Lock Faces" font-lock-faces))

(defcustom i7-mode-hook nil
  "Mode hook for Inform 7 major mode."
  :group 'i7
  :tag "Inform 7 Major Mode Hook"
  :type 'hook)

(defcustom i7-highlighter "i7-highlighter" ; TODO
  "Location of the Inform 7 highlighter executable."
  :group 'i7
  :tag "Inform 7 Highlighter"
  :type 'file)

;; Based on http://bzr.savannah.gnu.org/lh/emacs/emacs-24/annotate/head:/lisp/faces.el#L2167.
(defface i7-dabbrev-face
  '((((class color grayscale) (min-colors 88) (background light))
     :foreground "grey50")
    (((class color grayscale) (min-colors 88) (background dark))
     :foreground "grey70")
    (((class color) (min-colors 8) (background light))
     :foreground "green")
    (((class color) (min-colors 8) (background dark))
     :foreground "yellow"))
  "The face for suggested Inform 7 completions."
  :group 'i7
  :tag "Inform 7 Completion Face")

;; Based on http://bzr.savannah.gnu.org/lh/emacs/emacs-24/annotate/head:/lisp/faces.el#L2125.
(defface i7-emphasis-face
  '((t :weight bold))
  "The face for the Inform 7 syntactic element under the cursor."
  :group 'i7
  :tag "Inform 7 Emphasis Face")


;;; Highlighter process management:

(defun i7-kill-highlighter (&optional print-message)
  "If the Inform 7 highlighter is running, kill it.  Display a message if PRINT-MESSAGE is non-nil."
  (interactive "p")
  (if (and
       (boundp 'i7-highlighter-process)
       (eq (process-status i7-highlighter-process) 'run))
      (progn
	(i7-send-command i7-client-end-session)
	(delete-process i7-highlighter-process)))
  (if print-message
      (if (boundp 'i7-highlighter-process)
	  (message (format "Inform 7 highlighter killed.  Current state: %s." (process-status i7-highlighter-process)))
	(message "No Inform 7 highlighter to kill."))))

(defun i7-restart-highlighter (&optional print-message)
  "Start or restart the Inform 7 highlighter.  Display a message if PRINT-MESSAGE is non-nil."
  (interactive "p")
  (i7-kill-highlighter)
  (clrhash i7-buffer-numbering)
  (clrhash i7-reverse-buffer-numbering)
  (setq i7-next-buffer-number 0)
  (clrhash i7-view-numbering)
  (clrhash i7-reverse-view-numbering)
  (setq i7-next-view-number 0)
  (clrhash i7-view-buffers)
  (clrhash i7-view-cursors)
  (setq
   i7-highlighter-process
   (let ((process-connection-type nil)) ; We don't need a PTY.
     (start-process "Inform 7 Highlighter" nil i7-highlighter)))
  (set-process-query-on-exit-flag i7-highlighter-process nil)
  (set-process-coding-system i7-highlighter-process 'binary)
  (set-process-filter i7-highlighter-process 'i7-highlighter-process-filter)
  (dolist (highlight-code i7-highlights-known)
    (i7-send-command i7-client-support-highlight-code highlight-code))
  (i7-send-command i7-client-begin-session)
  (dolist (buffer (buffer-list))
    (with-current-buffer buffer
      (if (eq major-mode 'i7-mode)
	  (progn
	    (i7-ensure-buffer-is-i7-buffer buffer)
	    (i7-buffer-contents-change 1 (1+ (buffer-size buffer)) 0)))))
  (if print-message
      (message (format "Inform 7 highlighter restared.  Current state: %s." (process-status i7-highlighter-process)))))

(defun i7-ensure-highlighter-started ()
  "If the highlighter has not been run, start it."
  (unless (boundp 'i7-highlighter-process)
    (i7-restart-highlighter)))


;;; Constant definitions autogenerated from protocol.hpp:

(defconst i7-protocol-version-number ?\x00000000
  "The version of the highlighter protocol supported by the Inform 7 major mode.")

;; Messages sent by the client (the editor)

;; Sent to request the server to terminate.
(defconst i7-client-end-session ?\x00000000)
;; Sent to signal the end of support messages and the beginning of highlighting.
(defconst i7-client-begin-session ?\x00000001)

;; Sent before CLIENT-BEGIN-SESSION to indicate client support for a highlight
;; code.  The server will only send highlights that both it and the client
;; support.
;; See below for the possibled highlight codes.
(defconst i7-client-support-highlight-code ?\x00000101) ;; [highlight code]

;; Sent when a buffer is no longer relevant to the highlighting process.
(defconst i7-client-discard-buffer ?\x00010000) ;; [buffer number]
;; Sent when a buffer is determined relevant to the highlighting process.
;; Usually sent for any buffers being edited as well as included extensions.
(defconst i7-client-introduce-buffer ?\x00010001) ;; [buffer number]

;; Sent when the author's intended use of a buffer, as story source text or as
;; an extension, is no longer clear.  Buffers default to undecided, so this
;; message is rarely used.
(defconst i7-client-mark-buffer-undecided ?\x00010100) ;; [buffer number]
;; Sent to indicate that a buffer is to hold story source text, not the contents
;; of an extension.
(defconst i7-client-mark-buffer-as-story ?\x00010101) ;; [buffer number]
;; Sent to indicate that a buffer is to hold the contents of an extension, not
;; story source text.  The includable file name is the extension name that this
;; extension can be included as or an empty string if there is no way to
;; included it.  This message should be resent whenever the includable file name
;; changes.
(defconst i7-client-mark-buffer-as-extension ?\x00010103) ;; [buffer number] [INCLUDABLE FILE NAME WITHOUT FILE EXTENSION]

;; Sent to signal an edit that has removed codepoints from a buffer.
(defconst i7-client-remove-codepoints ?\x00010200) ;; [buffer number] [inclusive lower bound] [exclusive upper bound]
;; Sent to signal an edit that has added codepoints to a buffer.
(defconst i7-client-add-codepoints ?\x00010201) ;; [buffer number] [beginning codepoint index] [INSERTION]

;; Sent when a view no longer exists.
(defconst i7-client-discard-view ?\x00020000) ;; [view number]
;; Sent when a view of the given buffer is created.  It begins empty.
(defconst i7-client-introduce-view ?\x00020001) ;; [view number] [buffer number]
;; Sent when a view becomes (effectively) empty but is not destroyed.
;; Useful, for instance, to prevent updates in occluded windows.
(defconst i7-client-clear-view ?\x00020002) ;; [view number]
;; Sent when the range of codepoints visible in a view changes.
(defconst i7-client-move-view ?\x00020003) ;; [view number] [inclusive lower bound] [exclusive upper bound]

;; Sent when a view no longer has a cursor position on which to base emphasis,
;; usually when it loses focus.
(defconst i7-client-clear-cursor ?\x00020100) ;; [view number]
;; Sent when the view has focus and a cursor position on which to base emphasis,
;; usually when it gains focus.  The endpoints should be the same codepoint
;; index to indicate the location of the cursor when no text is selected,
;; different indicies to give the endpoints of the selection if there is one.
;; (Note that multiple views may have a cursor set in them at the same time, and
;; emphasis is likewise per-view.)
(defconst i7-client-set-cursor ?\x00020101) ;; [view number] [inclusive lower bound] [exclusive upper bound]

;; Messages sent by the server (the highlighter)

;; Sent to instruct the client to remove all highlighting in the given range.
(defconst i7-server-remove-highlights ?\x00010000) ;; [buffer number] [inclusive lower bound] [exclusive upper bound]
;; Sent to instruct the client to highlight the given range per the given code.
;; See below for the possibled highlight codes.
(defconst i7-server-add-highlight ?\x00010001) ;; [buffer number] [inclusive lower bound] [exclusive upper bound] [highlight code]
;; Sent to instruct the client to remove all warnings in the given range.
(defconst i7-server-remove-warnings ?\x00010002) ;; [buffer number] [inclusive lower bound] [exclusive upper bound]
;; Sent to instruct the client to add warning formatting to the given range.
;; Warning formatting is usually effected by underlining the text orange in
;; addition to any formatting prescribed by its highlights.
(defconst i7-server-add-warning ?\x00010003) ;; [buffer number] [inclusive lower bound] [exclusive upper bound]
;; Sent to instruct the client to remove all errors in the given range.
(defconst i7-server-remove-errors ?\x00010004) ;; [buffer number] [inclusive lower bound] [exclusive upper bound]
;; Sent to instruct the client to add error formatting to the given range.
;; Error formatting is usually effected by underlining the text red in addition
;; to any formatting prescribed by its highlights.  If an error and warning
;; overlap and conflict in formatting, the error should trump the warning.
(defconst i7-server-add-error ?\x00010005) ;; [buffer number] [inclusive lower bound] [exclusive upper bound]
;; Sent to instruct the client to remove all hovertexts in the given range.
(defconst i7-server-remove-hovertexts ?\x00010100) ;; [buffer number] [inclusive lower bound] [exclusive upper bound]
;; Sent to instruct the client to add hovertext to the given range.  Hovertext
;; is displayed in a popup or "tooltip" when the mouse hovers over the relevant
;; range; there should also be a keyboard command to make it visible.
(defconst i7-server-add-hovertext ?\x00010101) ;; [buffer number] [inclusive lower bound] [exclusive upper bound] [HOVERTEXT]

;; Sent to instruct the client to remove all emphasis in the given range.
(defconst i7-server-remove-emphasis ?\x00020000) ;; [view number] [inclusive lower bound] [exclusive upper bound]
;; Sent to instruct the client to emphasize the given range.  Emphasis is
;; usually effected by bolding the text in addition to any formatting prescribed
;; by its highlights.
(defconst i7-server-add-emphasis ?\x00020001) ;; [view number] [inclusive lower bound] [exclusive upper bound]
;; Sent when suggestions sent earlier no longer apply.
(defconst i7-server-clear-suggestions ?\x00020100) ;; [view number]
;; Sent to suggest text to insert after the cursor.  Will be sent multiple times
;; if there are multiple suggestions.
(defconst i7-server-make-suggestion ?\x00020101) ;; [view number] [SUGGESTION]

;; Highlight codes (partly based on the Inform Technical Manual)

(defconst i7-highlight-ordinary-i7 ?\x00000000)
(defconst i7-highlight-i7-delimiter ?\x00000001) ;; (+ and +)

(defconst i7-highlight-ordinary-i6 ?\x00010000)
(defconst i7-highlight-i6-delimiter ?\x00010001) ;; (- and -)
(defconst i7-highlight-i6-directive ?\x00010002)
(defconst i7-highlight-i6-keyword ?\x00010004)
(defconst i7-highlight-i6-function ?\x00010100)
(defconst i7-highlight-i6-function-delimiter ?\x00010101) ;; [ and ]
(defconst i7-highlight-i6-property-like ?\x00010102)
(defconst i7-highlight-i6-property-like-delimiter ?\x00010103)

(defconst i7-highlight-vm-assembly ?\x00020000)
(defconst i7-highlight-vm-assembly-delimiter ?\x00020001) ;; @

(defconst i7-highlight-comment ?\x00030000)
(defconst i7-highlight-comment-delimiter ?\x00030001) ;; !, [, and ]
(defconst i7-highlight-documentation ?\x00030100)
(defconst i7-highlight-documentation-delimiter ?\x00030101) ;; ---- DOCUMENTATION ----
(defconst i7-highlight-paste-marker ?\x00030103) ;; *:

(defconst i7-highlight-character-literal ?\x00040000)
(defconst i7-highlight-character-literal-delimiter ?\x00040001) ;; '
(defconst i7-highlight-string-literal ?\x00040100)
(defconst i7-highlight-string-literal-delimiter ?\x00040101) ;; "
(defconst i7-highlight-character-escape ?\x00040200)
(defconst i7-highlight-character-escape-delimiter ?\x00040201) ;; @ and @@
(defconst i7-highlight-substitution ?\x00040300)
(defconst i7-highlight-substitution-delimiter ?\x00040301) ;; [ and ]
(defconst i7-highlight-segmented-substitution ?\x00040302)
(defconst i7-highlight-segmented-substitution-delimiter ?\x00040303) ;; [ and ]

(defconst i7-highlights-known
  (list
   i7-highlight-ordinary-i7
   i7-highlight-i7-delimiter
   i7-highlight-ordinary-i6
   i7-highlight-i6-delimiter
   i7-highlight-i6-directive
   i7-highlight-i6-keyword
   i7-highlight-i6-function
   i7-highlight-i6-function-delimiter
   i7-highlight-i6-property-like
   i7-highlight-i6-property-like-delimiter
   i7-highlight-vm-assembly
   i7-highlight-vm-assembly-delimiter
   i7-highlight-comment
   i7-highlight-comment-delimiter
   i7-highlight-documentation
   i7-highlight-documentation-delimiter
   i7-highlight-paste-marker
   i7-highlight-character-literal
   i7-highlight-character-literal-delimiter
   i7-highlight-string-literal
   i7-highlight-string-literal-delimiter
   i7-highlight-character-escape
   i7-highlight-character-escape-delimiter
   i7-highlight-substitution
   i7-highlight-substitution-delimiter
   i7-highlight-segmented-substitution
   i7-highlight-segmented-substitution-delimiter))


;;; Functions for decoding server-to-client messages:

(defun i7-highlight-face (highlight-code)
  "Return the face corresponding to the Inform 7 highlight code HIGHLIGHT-CODE."
  (cond
   ((= highlight-code i7-highlight-ordinary-i7) nil)
   ((= highlight-code i7-highlight-i7-delimiter) font-lock-keyword-face)
   ((= highlight-code i7-highlight-ordinary-i6) nil)
   ((= highlight-code i7-highlight-i6-delimiter) font-lock-keyword-face)
   ((= highlight-code i7-highlight-i6-directive) font-lock-preprocessor-face)
   ((= highlight-code i7-highlight-i6-keyword) font-lock-keyword-face)
   ((= highlight-code i7-highlight-i6-function) font-lock-function-name-face)
   ((= highlight-code i7-highlight-i6-function-delimiter) font-lock-function-name-face)
   ((= highlight-code i7-highlight-i6-property-like) font-lock-variable-name-face)
   ((= highlight-code i7-highlight-i6-property-like-delimiter) font-lock-variable-name-face)
   ((= highlight-code i7-highlight-vm-assembly) font-lock-builtin-face)
   ((= highlight-code i7-highlight-vm-assembly-delimiter) font-lock-builtin-face)
   ((= highlight-code i7-highlight-comment) font-lock-comment-face)
   ((= highlight-code i7-highlight-comment-delimiter) font-lock-comment-delimiter-face)
   ((= highlight-code i7-highlight-documentation) font-lock-doc-face)
   ((= highlight-code i7-highlight-documentation-delimiter) font-lock-doc-face)
   ((= highlight-code i7-highlight-paste-marker) font-lock-keyword-face)
   ((= highlight-code i7-highlight-character-literal) font-lock-constant-face)
   ((= highlight-code i7-highlight-character-literal-delimiter) font-lock-constant-face)
   ((= highlight-code i7-highlight-string-literal) font-lock-string-face)
   ((= highlight-code i7-highlight-string-literal-delimiter) font-lock-string-face)
   ((= highlight-code i7-highlight-character-escape) font-lock-constant-face)
   ((= highlight-code i7-highlight-character-escape-delimiter) font-lock-constant-face)
   ((= highlight-code i7-highlight-substitution) font-lock-function-name-face)
   ((= highlight-code i7-highlight-substitution-delimiter) font-lock-function-name-face)
   ((= highlight-code i7-highlight-segmented-substitution) font-lock-function-name-face)
   ((= highlight-code i7-highlight-segmented-substitution-delimiter) font-lock-function-name-face)))


;;; Functions for encoding client-to-server messages:

(defun i7-flatten-map (function list)
  "Apply FUNCTION to each element of LIST and append the results."
  (apply 'append (mapcar function list)))

(defun i7-encode-codepoint (codepoint)
  "Return the UTF-32 of CODEPOINT as a list of bytes."
  (list ?\x0 (lsh (logand ?\x1F0000 codepoint) -16) (lsh (logand ?\xFF00 codepoint) -8) (logand ?\xFF codepoint)))

(defun i7-encode-string (string)
  "Return the UTF-32 of the codepoints of STRING as a list of bytes."
  (i7-flatten-map 'i7-encode-codepoint (append string '(?\x0))))

(defun i7-encode (value)
  "Return the UTF-32 of VALUE as a list of bytes unless it is already a list."
  (cond
   ((integer-or-marker-p value)
    (i7-encode-codepoint value))
   ((stringp value)
    (i7-encode-string value))
   ((listp value)
    value)))


;;; Variables and functions for receiving server-to-client messages:

(defvar i7-highlighter-handlers (make-hash-table)
  "Mapping from messages sent by the Inform 7 highlighter to the Lisp functions that handle them.")
(puthash i7-server-remove-highlights 'i7-remove-highlights i7-highlighter-handlers)
(puthash i7-server-add-highlight 'i7-add-highlight i7-highlighter-handlers)
(puthash i7-server-remove-warnings 'i7-remove-warnings i7-highlighter-handlers)
(puthash i7-server-add-warning 'i7-add-warning i7-highlighter-handlers)
(puthash i7-server-remove-errors 'i7-remove-errors i7-highlighter-handlers)
(puthash i7-server-add-error 'i7-add-error i7-highlighter-handlers)
(puthash i7-server-remove-hovertexts 'i7-remove-hovertexts i7-highlighter-handlers)
(puthash i7-server-add-hovertext 'i7-add-hovertext i7-highlighter-handlers)
(puthash i7-server-remove-emphasis 'i7-remove-emphasis i7-highlighter-handlers)
(puthash i7-server-add-emphasis 'i7-add-emphasis i7-highlighter-handlers)
(puthash i7-server-clear-suggestions 'i7-clear-suggestions i7-highlighter-handlers)
(puthash i7-server-make-suggestion 'i7-make-suggestion i7-highlighter-handlers)

(defvar i7-highlighter-reply-buffer nil
  "The list of unprocessed bytes recieved from the Inform 7 highlighter.")

(defun i7-highlighter-process-filter (process output)
  "Accumulate (from PROCESS) OUTPUT in `i7-highlighter-reply-buffer'."
  (setq i7-highlighter-reply-buffer (append i7-highlighter-reply-buffer output nil))
  (i7-highlighter-handler))

(defun i7-highlighter-reply-end-of-string (beginning-index)
  "Return the index of the first terminating UTF-32 null at or after BEGINNING-INDEX, or nil if none is found."
  (let ((current-index 0)
	(sublist i7-highlighter-reply-buffer)
	(found nil))
    (while (and
	    sublist
	    (not
	     (and
	      (>= current-index beginning-index)
	      (setq found
		    (zerop (elt sublist 0))
		    (zerop (elt sublist 1))
		    (zerop (elt sublist 2))
		    (zerop (elt sublist 3))))))
      (setq current-index (+ current-index 4))
      (setq sublist (cdr (cdr (cdr (cdr sublist)0)))))
    (if found current-index)))

(defun i7-peek-reply-quadruple ()
  "Peek at four bytes at the start of of `i7-highlighter-reply-buffer' as one integer."
  (let ((first-byte (elt i7-highlighter-reply-buffer 0))
	(second-byte (elt i7-highlighter-reply-buffer 1))
	(third-byte (elt i7-highlighter-reply-buffer 2))
	(fourth-byte (elt i7-highlighter-reply-buffer 3)))
    (+ (lsh first-byte 24) (lsh second-byte 16) (lsh third-byte 8) fourth-byte)))

(defun i7-pop-reply-quadruple ()
  "Pop four bytes off of `i7-highlighter-reply-buffer' as one integer."
  (let ((first-byte (pop i7-highlighter-reply-buffer))
	(second-byte (pop i7-highlighter-reply-buffer))
	(third-byte (pop i7-highlighter-reply-buffer))
	(fourth-byte (pop i7-highlighter-reply-buffer)))
    (+ (lsh first-byte 24) (lsh second-byte 16) (lsh third-byte 8) fourth-byte)))

(defun i7-highlighter-handler ()
  "Repeatedly inspect the message at the start of `i7-highlighter-reply-buffer' and invoke the matching hander."
  (if (>= (length i7-highlighter-reply-buffer) 4)
      (catch 'i7-reply-from-server-incomplete
	(let ((handler (gethash (i7-peek-reply-quadruple) i7-highlighter-handlers)))
	  (if handler
	      (apply handler nil)
	    (i7-highlighter-error-handler)))
	(run-at-time nil nil 'i7-highlighter-handler))))

(defun i7-highlighter-error-handler ()
  "Complain about a message with no handler and kill the Inform 7 highlighter."
  (message
   (format
    "Inform 7 highlighter gave unrecognized reply: %s / \"%s\".\nKilling process."
    i7-highlighter-reply-buffer
    (concat "" i7-highlighter-reply-buffer)))
  (setq i7-highlighter-reply-buffer nil)
  (i7-kill-highlighter))


;;; Functions for sending client-to-server messages:

(defun i7-send-command (&rest arguments)
  "If the highlighter is running, send ARGUMENTS to it as UTF-32."
  (if (and
       (boundp 'i7-highlighter-process)
       (eq (process-status i7-highlighter-process) 'run))
      (let ((i7-highlighter-message (apply 'unibyte-string (i7-flatten-map 'i7-encode arguments))))
	(process-send-string i7-highlighter-process i7-highlighter-message))))


;;; Maintenance of buffers and views (client-to-server):

(defvar i7-buffer-numbering (make-hash-table :weakness 'key)
  "Mapping from Emacs buffers to buffer numbers for the Inform 7 highlighter.")
(defvar i7-reverse-buffer-numbering (make-hash-table :weakness 'value)
  "Mapping from buffer numbers for the Inform 7 highlighter to Emacs buffers.")
(defvar i7-next-buffer-number 0
  "The smallest buffer number that has not been sent to the Inform 7 highlighter.")

(defun i7-ensure-buffer-is-i7-buffer (buffer)
  "If BUFFER does not have a corresponding buffer number, give it one and notify the Inform 7 highlighter."
  (unless (gethash buffer i7-buffer-numbering)
    (progn
      (puthash buffer i7-next-buffer-number i7-buffer-numbering)
      (puthash i7-next-buffer-number buffer i7-reverse-buffer-numbering)
      (i7-send-command i7-client-introduce-buffer i7-next-buffer-number)
      (setq i7-next-buffer-number (1+ i7-next-buffer-number)))))

(defun i7-ensure-buffer-is-not-i7-buffer (buffer)
  "If BUFFER has a corresponding buffer number, destroy the correspondence and notify the Inform 7 highlighter."
  (let ((buffer-number (gethash buffer i7-buffer-numbering)))
    (if buffer-number
	(progn
	  (remhash buffer i7-buffer-numbering)
	  (remhash buffer-number i7-reverse-buffer-numbering)
	  (i7-send-command i7-client-discard-buffer buffer-number)))))

(defun i7-mark-buffer-type (buffer)
  "If BUFFER is visiting a file, tell the Inform 7 highlighter the file extension of the file's truename."
  (i7-ensure-buffer-is-i7-buffer buffer)
  (let ((truename (buffer-file-truename buffer)))
    (if (stringp truename)
	(let ((buffer-number (gethash buffer i7-buffer-numbering))
	      (file-extension (file-name-extension truename t))
	      (file-corename (file-name-sans-extension (file-name-nondirectory truename))))
	  (cond
	   ((equal file-extension ".ni")
	    (i7-send-command i7-client-mark-buffer-as-story buffer-number))
	   ((or (equal file-extension "") (equal file-extension ".i7x"))
	    ;; TODO: check whether extension is includable
	    (i7-send-command i7-client-mark-buffer-as-extension buffer-number file-corename))
	   (t
	    (i7-send-command i7-client-mark-buffer-undecided buffer-number)))))))

(defvar i7-view-numbering (make-hash-table :weakness 'key)
  "Mapping from Emacs windows to view numbers for the Inform 7 highlighter.")
(defvar i7-reverse-view-numbering (make-hash-table :weakness 'value)
  "Mapping from view numbers for the Inform 7 highlighter to Emacs windows.")
(defvar i7-next-view-number 0
  "The smallest view number that has not been sent to the Inform 7 highlighter.")

(defun i7-ensure-view-is-i7-view (window)
  "If WINDOW does not have a corresponding view number, give it one and notify the Inform 7 highlighter."
  (unless (gethash window i7-view-numbering)
    (progn
      (puthash window i7-next-view-number i7-view-numbering)
      (puthash i7-next-view-number window i7-reverse-view-numbering)
      (i7-send-command i7-client-introduce-view i7-next-view-number (gethash (window-buffer window) i7-buffer-numbering))
      (setq i7-next-view-number (1+ i7-next-view-number)))))

(defun i7-ensure-view-is-not-i7-view (window)
  "If WINDOW has a corresponding view number, destroy the correspondence and notify the Inform 7 highlighter."
  (let ((view-number (gethash window i7-view-numbering)))
    (if view-number
	(progn
	  (remhash window i7-view-numbering)
	  (remhash view-number i7-reverse-view-numbering)
	  (i7-send-command i7-client-discard-view view-number)))))

(defvar i7-view-buffers (make-hash-table :weakness 'key-and-value)
  "Mapping from Emacs windows to buffers as last reported to the Inform 7 highlighter.")

(defun i7-ensure-view-views-buffer (window buffer)
  "If the last report to the Inform 7 highlighter did not map WINDOW to BUFFER, send an update to the highlighter."
  (let ((old-buffer (gethash window i7-view-buffers)))
    (unless (eq old-buffer buffer)
      (let ((view-number (gethash window i7-view-numbering)))
	(puthash window buffer i7-view-buffers)
	(i7-send-command i7-client-discard-view view-number)
	(i7-ensure-buffer-is-i7-buffer buffer)
	(i7-send-command i7-client-introduce-view view-number (gethash buffer i7-buffer-numbering))))))


;;; Maintenance of views' extents (client-to-server):

(defun i7-view-bounds-change (window beginning end)
  "Notify the Inform 7 highlighter that WINDOW now displays characters BEGINNING through END."
  (i7-ensure-view-is-i7-view window)
  (i7-send-command i7-client-move-view (gethash window i7-view-numbering) beginning end))

(defun i7-window-scroll-change (window beginning)
  "If necessary, notify the Inform 7 highlighter that WINDOW has scrolled to begin at BEGINNING."
  (if (eq (with-current-buffer (window-buffer window) major-mode) 'i7-mode)
      (i7-view-bounds-change window beginning (window-end window t))
    (i7-ensure-view-is-not-i7-view window)))

(defun i7-window-size-change (window)
  "If necessary, notify the Inform 7 highlighter that WINDOW has changed size."
  (if (eq (with-current-buffer (window-buffer window) major-mode) 'i7-mode)
      (i7-view-bounds-change window (window-start window) (window-end window))
    (i7-ensure-view-is-not-i7-view window)))
  
(defun i7-frame-size-change (frame)
  "If necessary, notify the Inform 7 highlighter that the windows in FRAME have changed size."
  (walk-windows 'i7-window-size-change nil frame))


;;; Maintenance of buffer's contents (client-to-server):

(defun i7-buffer-contents-change (beginning end old-length)
  "Notify the Inform 7 highlighter of the edit made from BEGINNING to END, replacing OLD-LENGTH characters in the current buffer."
  (i7-ensure-buffer-is-i7-buffer (current-buffer))
  (let ((buffer-number (gethash (current-buffer) i7-buffer-numbering)))
    (if (> old-length 0)
	(i7-send-command i7-client-remove-codepoints buffer-number (1- beginning) (+ -1 beginning old-length)))
    (if (< beginning end)
	(i7-send-command i7-client-add-codepoints buffer-number (1- beginning) (buffer-substring-no-properties beginning end))))
  (accept-process-output))


;;; Maintenance of cursor positions (client-to-server)

(defvar i7-view-cursors (make-hash-table :weakness 'key)
  "Mapping from Emacs windows to cursor positions as last reported to the Inform 7 highlighter.")

(defun i7-window-cursor-change (window)
  "Notify the Inform 7 highlighter if WINDOW's point has moved."
  (if (eq (with-current-buffer (window-buffer window) major-mode) 'i7-mode)
      (progn
	(i7-ensure-view-is-i7-view window)
	(let ((old-point (gethash window i7-view-cursors))
	      (new-point (window-point window)))
	  (unless (equal old-point new-point)
	    (i7-send-command i7-client-set-cursor (gethash window i7-view-numbering) new-point new-point)))))) ; TODO: send the region if transient-mark-mode is active?

(defun i7-cursors-change ()
  "Notify the Inform 7 highlighter of any cursors that have moved."
  (walk-windows 'i7-window-cursor-change nil t))


;;; Maintenance of overlays (server-to-client):

(defun i7-remove-highlights ()
  "Remove highlights as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 16)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((buffer-number (i7-pop-reply-quadruple))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple))))
    (with-current-buffer (gethash buffer-number i7-reverse-buffer-numbering)
      (remove-overlays beginning end 'name 'i7-font-lock)
      (overlay-recenter end))))

(defun i7-add-highlight ()
  "Add a highlight as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 20)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((buffer-number (i7-pop-reply-quadruple))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple)))
	(highlight (i7-highlight-face (i7-pop-reply-quadruple))))
    (with-current-buffer (gethash buffer-number i7-reverse-buffer-numbering)
      (let ((new-overlay (make-overlay beginning end)))
	(overlay-put new-overlay 'name 'i7-font-lock)
	(overlay-put new-overlay 'font-lock-face highlight)))))

(defun i7-remove-warnings ()
  "Remove warnings as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 16)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((buffer-number (i7-pop-reply-quadruple))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple))))
    (with-current-buffer (gethash buffer-number i7-reverse-buffer-numbering)
      (remove-overlays beginning end 'name 'i7-warning)
      (overlay-recenter end))))

(defun i7-add-warning ()
  "Add a warning as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 16)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((buffer-number (i7-pop-reply-quadruple))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple))))
    (with-current-buffer (gethash buffer-number i7-reverse-buffer-numbering)
      (let ((new-overlay (make-overlay beginning end)))
	(overlay-put new-overlay 'name 'i7-warning)
	(overlay-put new-overlay 'font-lock-face font-lock-warning-face)
	(overlay-put new-overlay 'priority 1)))))

(defun i7-remove-errors ()
  "Remove errors as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 16)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((buffer-number (i7-pop-reply-quadruple))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple))))
    (with-current-buffer (gethash buffer-number i7-reverse-buffer-numbering)
      (remove-overlays beginning end 'name 'i7-error)
      (overlay-recenter end))))

(defun i7-add-error ()
  "Add an error as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 16)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((buffer-number (i7-pop-reply-quadruple))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple))))
    (with-current-buffer (gethash buffer-number i7-reverse-buffer-numbering)
      (let ((new-overlay (make-overlay beginning end)))
	(overlay-put new-overlay 'name 'i7-error)
	(overlay-put new-overlay 'font-lock-face font-lock-warning-face)
	(overlay-put new-overlay 'priority 2)))))

(defun i7-remove-hovertexts ()
  "Remove hovertexts as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 16)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((buffer-number (i7-pop-reply-quadruple))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple))))
    (with-current-buffer (gethash buffer-number i7-reverse-buffer-numbering)
      (remove-overlays beginning end 'name 'i7-hovertext)
      (overlay-recenter end))))

(defun i7-add-hovertext ()
  "Add an hovertext as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 20)
      (throw 'i7-reply-from-server-incomplete nil))
  (unless (i7-highlighter-reply-end-of-string 16)
    (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((buffer-number (i7-pop-reply-quadruple))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple)))
	(hovertext (i7-pop-reply-string)))
    (with-current-buffer (gethash buffer-number i7-reverse-buffer-numbering)
      (let ((new-overlay (make-overlay beginning end)))
	(overlay-put new-overlay 'name 'i7-hovertext)
	(overlay-put new-overlay 'help-echo hovertext)
	(overlay-put new-overlay 'priority 4)))))

(defun i7-remove-emphasis ()
  "Remove emphasis as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 16)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((window (gethash (i7-pop-reply-quadruple) i7-reverse-view-numbering))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple))))
    (with-current-buffer (window-buffer window)
      (remove-overlays beginning end 'i7-emphasis-window window)
      (overlay-recenter end))))

(defun i7-add-emphasis ()
  "Add an emphasis as requested by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 16)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((window (gethash (i7-pop-reply-quadruple) i7-reverse-view-numbering))
	(beginning (1+ (i7-pop-reply-quadruple)))
	(end (1+ (i7-pop-reply-quadruple))))
    (with-current-buffer (window-buffer window)
      (let ((new-overlay (make-overlay beginning end)))
	(overlay-put new-overlay 'name 'i7-emphasis)
	(overlay-put new-overlay 'window window)
	(overlay-put new-overlay 'i7-emphasis-window window)
	(overlay-put new-overlay 'font-lock-face i7-emphasis-face)
	(overlay-put new-overlay 'priority 3)))))


;;; Maintenance of suggestions (server-to-client):

(defun i7-clear-suggestions ()
  "Clear suggestions sent earlier by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 8)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((window (gethash (i7-pop-reply-quadruple) i7-reverse-view-numbering)))
    (progn))) ; TODO

(defun i7-make-suggestion ()
  "Make a suggestion sent by the Inform 7 highlighter."
  (if (< (length i7-highlighter-reply-buffer) 8)
      (throw 'i7-reply-from-server-incomplete nil))
  (unless (i7-highlighter-reply-end-of-string 4)
      (throw 'i7-reply-from-server-incomplete nil))
  (i7-pop-reply-quadruple) ; discard the command
  (let ((window (gethash (i7-pop-reply-quadruple) i7-reverse-view-numbering))
	(suggestion (i7-pop-reply-string)))
    (progn))) ; TODO


;;; Indentation:

;; TODO:

;; The following is based on python.el, and not fully aware of I7 syntax.  It
;; will eventually be replaced with queries to the highlighter.  (Though maybe
;; this implementation will be kept as a backup in case the highlighter process
;; is killed.)

(defvar i7-maximum-indentation nil
  "Internal use.")

(defun i7-update-maximum-indentation ()
  "Calculate and return the Inform 7 indentation for the line at point."
  (save-excursion
    (previous-line)
    (setq
     i7-maximum-indentation
     (+ 
      (current-indentation)
      (if (member ?: (append (thing-at-point 'line) nil)) tab-width 0)))))

(defun i7-block-end-p ()
  "Non-nil if this is a line closing a block, or a blank line
indented to where it would close a block."
  (< (current-indentation)
     (save-excursion
       (previous-line)
       (current-indentation))))

(defun i7-indent-line-1 (&optional leave)
  "Subroutine of `i7-indent-line'.
Does non-repeated indentation.  LEAVE non-nil means leave
indentation if it is valid, i.e. at most the value returned
by `i7-update-maximum-indentation'."
  (let ((current (current-indentation))
	(target (i7-update-maximum-indentation))
	(position-from-end (- (point-max) (point))))
    (if (or (= current target)
	    (and
	     leave
	     (<= current target)
	     (= (mod current tab-width) 0)))
	(if (< (current-column) current)
	    (back-to-indentation))
      (beginning-of-line)
      (delete-horizontal-space)
      (indent-to target)
      (if (> (- (point-max) position-from-end) (point))
	  (goto-char (- (point-max) position-from-end))))))

(defun i7-indent-line ()
  "Indent current line as Inform 7 code.
When invoked via `indent-for-tab-command', cycle through possible
indentations for current line.  The cycle is broken by a command
different from `indent-for-tab-command', i.e. successive TABs do
the cycling."
  (interactive)
  (if (and (eq this-command 'indent-for-tab-command)
	   (eq last-command this-command))
      (if (< i7-maximum-indentation tab-width)
	  (message "Sole indentation")
	(let ((current (+ (current-indentation) tab-width)))
	  (if (> current i7-maximum-indentation)
	      (setq current 0))
	  (beginning-of-line)
	  (delete-horizontal-space)
	  (indent-to current)))
    (i7-indent-line-1)))

(defun i7-indent-region (start end)
  "`indent-region-function' for Inform 7.
Leaves validly-indented lines alone, i.e. doesn't indent to
another valid position."
  (save-excursion
    (goto-char end)
    (setq end (point-marker))
    (goto-char start)
    (or (bolp) (forward-line 1))
    (while (< (point) end)
      (or (and (bolp) (eolp))
	  (i7-indent-line-1 t))
      (forward-line 1))
    (move-marker end nil)))


;;; The mode essentials:

;; The file extensions.
(add-to-list 'auto-mode-alist '("\\.ni\\'\\|\\.i7x\\'" . i7-mode))

;; The syntax table (not used for highlighting, but used for M-b, M-f, etc.).
(defvar i7-mode-syntax-table
  (make-syntax-table)
  "Syntax table for Inform 7 major mode.")

;; The keymap.
(defvar i7-mode-map
  (let ((keymap (make-sparse-keymap)))
    ;; Entries like
    ;; (define-key keymap [?\C-c ?\C-j] 'newline-and-indent)
    ;; go here.
    keymap)
  "Keymap for Inform 7 major mode.")

;;;###autoload
;; The mode entry point.
(defun i7-mode ()
  "Major mode for editing Inform 7 source code."
  (interactive)
  (kill-all-local-variables)
  (set-syntax-table i7-mode-syntax-table)
  (use-local-map i7-mode-map)
  (i7-ensure-highlighter-started)
  (i7-ensure-buffer-is-i7-buffer (current-buffer))
  (i7-buffer-contents-change 1 (1+ (buffer-size)) 0)
  (setq-local indent-line-function 'i7-indent-line)
  (add-hook 'window-scroll-functions 'i7-window-scroll-change)
  (add-hook 'window-size-change-functions 'i7-frame-size-change)
  (add-hook 'after-change-functions 'i7-buffer-contents-change nil t)
  (add-hook 'post-command-hook 'i7-cursors-change)
  (setq major-mode 'i7-mode)
  (setq mode-name "I7")
  (run-mode-hooks 'i7-mode-hook))

(provide 'i7-mode)

;;; i7.el ends here