Source

hugo-mode / hugo-mode.el

Full commit
;; Hugo mode, by Christopher Tate <ctate@acm.org>
;; Lot of stuff borrowed shamelessly from inform-mode.el
;;
;; To do:
;;		- multi-line comment blocks don't work right yet
;;		- spell check testing, needs ispell
;;		- highlight declarators' antecedents
;;

;; Copyright:
;;
;; Hugo mode borrows from Inform mode, but has its own history
;; and copyright.
;;
;; Hugo mode is copyright (c) by Christopher Tate, 2002
;;
;; Inform mode is copyright (c) by Gareth Rees 1996
;;		Portions copyright (c) by Michael Fessler 1997-1998
;;		Portions copyright (c) by Rupert Lane 1999-2000
;;
;; Inform mode can currently be found at:
;;		http://www.merguez.demon.co.uk/inform-mode/
;;
;; hugo-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 2, or (at your option)
;; any later version.
;;
;; hugo-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.

(require 'font-lock)
(require 'regexp-opt)

; Miscellany

(defconst hugo-mode-version "1.0")

(defvar hugo-maybe-other 'c++-mode
  "*`hugo-maybe-mode' runs this if current file is not in Hugo mode.")

(eval-and-compile
  (defun hugo-make-regexp (strings &optional paren shy)
    (cond 
     ((string-match "XEmacs\\|Lucid" emacs-version)
      ;; XEmacs
      (regexp-opt strings paren shy))
     (t
      ;; GNU Emacs
      (regexp-opt strings)))))

; Font Lock Mode support

(eval-and-compile
  ; in-code keywords.  "enumerate" is here because it does not declare a named
  ; entity, and so does not need the extra handling of hugo-declarator-list.
  (defvar hugo-code-keyword-list
	'("alias" "and" "anything" "array" "break" "call" "capital" "case" "child"
	  "children" "cls" "color" "colour" "dict" "do" "elder" "eldest" "else"
	  "elseif" "enumerate" "event" "punctuation" "synonym" "compound"
	  "removal" "start" "step" "false" "for" "held" "hex" "if" "in" "input"
	  "is" "jump" "local" "locate" "move" "multi" "multiheld" "multinotheld"
	  "music" "nearby" "newline" "not" "notheld" "number" "object" "or"
	  "parent" "parse$" "pause" "picture" "playback" "print" "printchar"
	  "quit" "random" "readfile" "readval" "recordoff" "recordon" "remove"
	  "restart" "restore" "return" "run" "runevents" "save" "scriptoff"
	  "scripton" "select" "serial$" "sibling" "sound" "string" "system" "text"
	  "to" "true" "undo" "verb" "while" "window" "writefile" "writeval"
	  "xobject" "xverb" "younger" "youngest" "$additive" "$complex")
	"List of Hugo code keywords.")

  ; preprocessor directives
  (defvar hugo-preprocessor-list
	'("set" "clear" "define" "ifset" "ifclear" "if set" "if clear" "else"
	  "elseif" "endif" "message" "message error" "message warning"
	  "version" "include" "switches" "link")
	"List of Hugo preprocessor directives.")
  
  ; declarator keywords: things which declare named entities.
  (defvar hugo-declarator-list
	'("array" "attribute" "property" "class" "object" "constant"
	  "global" "replace" "routine")
	"List of Hugo declarator keywords.")

  ; built-in and Hugolib attributes & properties
  (defvar hugo-property-list
	'(
	  ;; builtin properties
	  "name" "before" "after" "noun" "adjective" "article"

	  ;; properties defined by hugolib
	  "nouns" "adjectives" "preposition" "prep" "pronoun" "pronouns"
	  "short_desc" "initial_desc" "long_desc" "found_in" "type" "size"
	  "capacity" "holding" "reach" "list_contents" "in_scope" "parse_rank"
	  "exclude_from_all" "door_to" "n_to" "ne_to" "e_to" "se_to"
	  "s_to" "sw_to" "w_to" "nw_to" "u_to" "d_to" "in_to" "out_to"
	  "cant_go" "extra_scenery" "each_turn" "key_object" "when_open"
	  "when_closed" "ignore_response" "order_response" "contains_desc"
	  "inv_desc" "desc_detail" "misc")
	"List of Hugo library property names.")

  (defvar hugo-attrib-list
	'("known" "moved" "visited" "static" "plural" "living" "female"
	  "openable" "open" "lockable" "locked" "unfriendly" "light"
	  "readable" "switchable" "switchedon" "clothing" "worn"
	  "mobile" "enterable" "container" "platform" "hidden" "quiet"
	  "transparent" "workflag" "already_listed" "special")
	"List of Hugo library attribute names.")

  ; hugolib global variables
  (defvar hugo-global-list
	'("object" "xobject" "self" "words" "player" "actor" "location"
	  "verbroutine" "endflag" "prompt" "objects" "system_status"
	  "player_person" "MAX_SCORE" "FORMAT" "DEFAULT_FONT"
	  "STATUSTYPE" "UNDO_OFF" "counter" "score" "verbosity"
	  "list_nest" "light_source" "event_flag" "speaking" "old_location"
	  "last_object" "obstacle" "list_count" "need_newline"
	  "override_indent" "best_parse_rank" "customerror_flag"
	  "number_scripts" "MAX_RANK" "it_obj" "them_obj" "him_obj"
	  "her_obj" "general" "TEXTCOLOR" "BGCOLOR" "SL_TEXTCOLOR"
	  "SL_BGCOLOR" "INPUTCOLOR" "INVENTORY_MASK" "INDENT_SIZE"
	  "AFTER_PERIOD" "MENU_TEXTCOLOR" "MENU_BGCOLOR"
	  "MENU_SELECTCOLOR" "MENU_SELECTBGCOLOR")
	"List of Hugo library globals.")
)

(defvar hugo-font-lock-keywords
  (eval-when-compile
	(list
	 ;; Preprocessor directives
	 (cons (concat "^\\s-*\\#\\("
				   (hugo-make-regexp hugo-preprocessor-list)
				   "\\)")
		   'font-lock-preprocessor-face)

	 ;; Library attributes & properties
	 (cons (concat "\\<\\("
				   (hugo-make-regexp (append hugo-attrib-list hugo-property-list))
				   "\\)\\>")
		   'font-lock-variable-name-face)

	 ;; Declarators
;	 (list (concat "^#?\\("
;				   (hugo-make-regexp hugo-declarator-list nil t)
;				   "\\)\\s-+\\(->\\s-+\\)*\\(\\(\\w\\|\\s_\\)+\\)")
;		   '(1 'font-lock-keyword-face)
;		   '(5 'font-lock-function-name-face 'keep t))
	 (list (concat "^\\s-*\\<\\("
				   (hugo-make-regexp hugo-declarator-list nil t)
				   "\\)\\>")
		   '(1 'font-lock-keyword-face))

	 ;; Hugo code keywords
	 (cons (concat "\\<\\("
				   (hugo-make-regexp hugo-code-keyword-list)
				   "\\)\\>")
		   'font-lock-keyword-face)

	 ;; Globals - note that they're set to 'keep existing highlighting,
	 ;; since things like "object" are both keywords & globals.
	 (cons (concat "\\<\\("
				   (hugo-make-regexp hugo-global-list)
				   "\\)\\>")
		   'font-lock-variable-name-face)
	 ))
  "Expressions to fontify in Hugo mode.")

(defvar hugo-mode-syntax-table nil
  "Syntax table used while in Hugo mode.")

(if hugo-mode-syntax-table
	()
  (setq hugo-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?\\ "\\"	hugo-mode-syntax-table)
  (modify-syntax-entry ?\" "\""	hugo-mode-syntax-table)
  (modify-syntax-entry ?+  "."	hugo-mode-syntax-table)
  (modify-syntax-entry ?-  "."	hugo-mode-syntax-table)
  (modify-syntax-entry ?=  "."	hugo-mode-syntax-table)
  (modify-syntax-entry ?%  "."	hugo-mode-syntax-table)
  (modify-syntax-entry ?<  "."	hugo-mode-syntax-table)
  (modify-syntax-entry ?>  "."	hugo-mode-syntax-table)

;  (modify-syntax-entry ?! "<14b" hugo-mode-syntax-table)
;  (modify-syntax-entry ?\\ ">23" hugo-mode-syntax-table)
  (modify-syntax-entry ?! "<b" hugo-mode-syntax-table)
  (modify-syntax-entry ?\n ">b" hugo-mode-syntax-table)
  (modify-syntax-entry ?\^m ">b" hugo-mode-syntax-table)
)

(defvar hugo-font-lock-defaults
  '(hugo-font-lock-keywords			; keywords to fontify
	nil									; keywords only?
	t									; case-fold?
	((?_ . "w"))							; syntax-alist: _ is a word char
	nil)									; syntax-begin function !!! todo
  "Font Lock defaults for Hugo mode.")

;; ----- indentation & other language-specific stuff -----

;; indent-line-function for Hugo.  when this is called, the point has been
;; moved to the start of a new line.  we provide the same whitespace
;; as the preceding line.

(defun hugo-indent-line ()
  (setq p (point))						; remember the current location
  (beginning-of-line 0)					; move to beginning of previous line
  (re-search-forward "^\\(\\s-*\\)" p)	; find all the leading whitespace, this line only
  (setq ws (match-string 0))			; save a copy of that whitespace string
  (goto-char p)							; back to where we were
  (re-search-forward "^\\(\\s-*\\)")	; find the whitespace at the start of the target line
  (replace-match ws)					; replace it with a copy of the prior line's whitespace
)

;; ----- Spell check -----
(defun hugo-spell-check-buffer ()
  "Spellcheck all strings in the buffer using ispell."
  (interactive)
  (let (start (spell-continue t))
    (save-excursion
      (goto-char (point-min))
      (while (and (search-forward "\"" nil t) spell-continue)

;        (if (and (eq (car (hugo-syntax-class)) 'string)
;				 ;; don't spell check include directives etc
;                 (not (save-excursion
;                        (forward-line 0)
;                        (looking-at hugo-directive-regexp))))
            (progn
              (forward-char -1)         ; move point to quotation mark
              (setq start (point))
              (forward-sexp)
              (ispell-region start (point))
			  ;; If user quit out (eg by pressing q while in ispell)
			  ;; don't continue looking for strings to check.
              (setq spell-continue
                    (and ispell-process
                         (eq (process-status ispell-process) 'run))))))))
;))))))))

;; ----- Keymap -----

(defvar hugo-mode-map nil
  "Keymap for Hugo mode.")

(if hugo-mode-map nil
  (let ((map (make-sparse-keymap "Hugo keymap")))
    (setq hugo-mode-map (make-sparse-keymap))
	; newline indents to previous line's level; TAB inserts a literal tab character
	(define-key hugo-mode-map "\C-m" 'newline-and-indent)
	(define-key hugo-mode-map "\t" 'self-insert-command)

;	(define-key hugo-mode-map "\C-c\C-s" 'hugo-spell-check-buffer)
))

; ----- Main mode entry point  -----

(defun hugo-mode ()
  "Major mode for editing Hugo source code.

* Font-lock support:

  Put \(add-hook 'hugo-mode-hook 'turn-on-font-lock\) in your .emacs."

  (interactive)
  (kill-all-local-variables)
  (use-local-map hugo-mode-map)
  (setq mode-name "Hugo")
  (set-syntax-table hugo-mode-syntax-table)
  (make-local-variable 'require-final-newline)
  (make-local-variable 'font-lock-defaults)
  (make-local-variable 'indent-line-function)
  (setq
   require-final-newline t
   font-lock-defaults hugo-font-lock-defaults
   indent-line-function 'hugo-indent-line
   major-mode 'hugo-mode)
  (run-hooks 'hugo-mode-hook))

;; hugo-maybe-mode -- fall back to c++-mode if it's not recognizably Hugo
(defun hugo-maybe-mode ()
  "Starts Hugo mode if file is in Hugo; `hugo-maybe-other' otherwise."
  (let ((case-fold-search t))
    (if (save-excursion
          (re-search-forward
           "^\\(!\\|object\\|\\global\\|routine\\|\\)"
           nil t))
        (hugo-mode)
      (funcall hugo-maybe-other))))