Commits

Marc Simpson committed bfbf2d4

Initial commit

Comments (0)

Files changed (1)

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