.
[bpt/emacs.git] / lisp / ada.el
index 4588d72..bf7633b 100644 (file)
@@ -1,16 +1,15 @@
 ;;; ada.el --- Ada editing support package in GNUlisp.  v1.0
 
-; Author: Vincent Broman <broman@bugs.nosc.mil>  May 1987.
-; (borrows heavily from Mick Jordan's Modula-2 package for GNU,
-; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
-
 ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
 
+;; Author: Vincent Broman <broman@bugs.nosc.mil>
+;; Keywords: languages
+
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs 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 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; along with GNU Emacs; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
-(setq auto-mode-alist (cons (cons "\\.ada$" 'ada-mode) auto-mode-alist))
+;;; Commentary:
+
+;; Created May 1987.
+;; (borrows heavily from Mick Jordan's Modula-2 package for GNU,
+;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
+
+;;; Code:
 
 (defvar ada-mode-syntax-table nil
   "Syntax table in use in Ada-mode buffers.")
@@ -36,7 +41,7 @@
   (modify-syntax-entry ?* "." table)
   (modify-syntax-entry ?/ "." table)
   (modify-syntax-entry ?+ "." table)
-  (modify-syntax-entry ?- "." table)
+  (modify-syntax-entry ?- ". 12" table)
   (modify-syntax-entry ?= "." table)
   (modify-syntax-entry ?\& "." table)
   (modify-syntax-entry ?\| "." table)
   (modify-syntax-entry ?\; "." table)
   (modify-syntax-entry ?\' "." table)
   (modify-syntax-entry ?\" "\"" table)
+  (modify-syntax-entry ?\n ">" table)
   (setq ada-mode-syntax-table table))
 
+;; Strings are a real pain in Ada because both ' and " can appear in a
+;; non-string quote context (the former as an operator, the latter as a
+;; character string).  We follow the least losing solution, in which only " is
+;; a string quote.  Therefore a character string of the form '"' will throw
+;; fontification off on the wrong track.
+
+(defconst ada-font-lock-keywords-1
+  (list
+   ;;
+   ;; Function, package (body), pragma, procedure, task (body) plus name.
+   (list (concat "\\<\\("
+                "function\\|"
+                "p\\(ackage\\(\\|[ \t]+body\\)\\|r\\(agma\\|ocedure\\)\\)\\|"
+                "task\\(\\|[ \t]+body\\)"
+                "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
+        '(1 font-lock-keyword-face) '(6 font-lock-function-name-face nil t)))
+  "For consideration as a value of `ada-font-lock-keywords'.
+This does fairly subdued highlighting.")
+
+(defconst ada-font-lock-keywords-2
+  (append ada-font-lock-keywords-1
+   (list
+    ;;
+    ;; Main keywords, except those treated specially below.
+    (concat "\\<\\("
+;    ("abort" "abs" "abstract" "accept" "access" "aliased" "all"
+;     "and" "array" "at" "begin" "case" "declare" "delay" "delta"
+;     "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
+;     "generic" "if" "in" "is" "limited" "loop" "mod" "not"
+;     "null" "or" "others" "private" "protected"
+;     "range" "record" "rem" "renames" "requeue" "return" "reverse"
+;     "select" "separate" "tagged" "task" "terminate" "then" "until"
+;     "while" "xor")
+           "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|"
+           "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|"
+           "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|"
+           "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|"
+           "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|"
+           "o\\(r\\|thers\\)\\|pr\\(ivate\\|otected\\)\\|"
+           "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
+           "se\\(lect\\|parate\\)\\|"
+           "t\\(a\\(gged\\|sk\\)\\|erminate\\|hen\\)\\|until\\|while\\|xor"
+           "\\)\\>")
+    ;;
+    ;; Anything following end and not already fontified is a body name.
+    '("\\<\\(end\\)\\>[ \t]*\\(\\sw+\\)?"
+      (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
+;    ;;
+;    ;; Variable name plus optional keywords followed by a type name.  Slow.
+;    (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:"
+;                "[ \t]*\\(constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*"
+;                "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
+;        '(1 font-lock-variable-name-face)
+;        '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t))
+    ;;
+    ;; Optional keywords followed by a type name.
+    (list (concat ":[ \t]*\\<\\(constant\\|in\\|in[ \t]+out\\|out\\)\\>?[ \t]*"
+                 "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
+         '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
+    ;;
+    ;; Keywords followed by a type or function name.
+    (list (concat "\\<\\("
+                 "new\\|of\\|subtype\\|type"
+                 "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?")
+         '(1 font-lock-keyword-face)
+         '(2 (if (match-beginning 4)
+                 font-lock-function-name-face
+               font-lock-type-face) nil t))
+    ;;
+    ;; Keywords followed by a reference.
+    (list (concat "\\<\\(goto\\|raise\\|use\\|when\\|with\\)\\>"
+                 "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
+         '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
+    ;;
+    ;; Goto tags.
+    '("<<\\(\\sw+\\(\\.\\sw*\\)*\\)>>" 1 font-lock-reference-face)
+    ))
+  "For consideration as a value of `ada-font-lock-keywords'.
+This does a lot more highlighting.")
+
+(defvar ada-font-lock-keywords (if font-lock-maximum-decoration
+                                  ada-font-lock-keywords-2
+                                ada-font-lock-keywords-1)
+  "Additional expressions to highlight in Ada mode.")
+
 (defvar ada-mode-map nil
   "Keymap used in Ada mode.")
 
   (setq ada-mode-map map))
 
 (defvar ada-indent 4 "*Value is the number of columns to indent in Ada-Mode.")
-  
+
+(defvar ada-comment-end-column)
+
 (defun ada-mode ()
 "This is a mode intended to support program development in Ada.
 Most control constructs and declarations of Ada can be inserted in the buffer
@@ -138,11 +231,11 @@ Variable `ada-indent' controls the number of spaces for indent/undent."
   (setq mode-name "Ada")
   (make-local-variable 'comment-column)
   (setq comment-column 41)
-  (make-local-variable 'end-comment-column)
-  (setq end-comment-column 72)
+  (make-local-variable 'ada-comment-end-column)
+  (setq ada-comment-end-column 72)
   (set-syntax-table ada-mode-syntax-table)
   (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "^$\\|" page-delimiter))
+  (setq paragraph-start (concat "$\\|" page-delimiter))
   (make-local-variable 'paragraph-separate)
   (setq paragraph-separate paragraph-start)
   (make-local-variable 'paragraph-ignore-fill-prefix)
@@ -159,10 +252,12 @@ Variable `ada-indent' controls the number of spaces for indent/undent."
   (setq comment-column 41)
   (make-local-variable 'comment-start-skip)
   (setq comment-start-skip "--+ *")
-  (make-local-variable 'comment-indent-hook)
-  (setq comment-indent-hook 'c-comment-indent)
+  (make-local-variable 'comment-indent-function)
+  (setq comment-indent-function 'c-comment-indent)
   (make-local-variable 'parse-sexp-ignore-comments)
   (setq parse-sexp-ignore-comments t)
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults '(ada-font-lock-keywords nil t ((?\_ . "w"))))
   (run-hooks 'ada-mode-hook))
 
 (defun ada-tabsize (s)
@@ -386,7 +481,7 @@ Indent for the first line of code."
   (ada-tab))
 
 (defun ada-loop ()
-  "Insert a skeleton loop statement.  exit statement added by hand."
+  "Insert a skeleton loop statement.  The exit statement is added by hand."
   (interactive)
   (insert "loop ")
   (let* ((ada-loop-name (read-string "[loop name]: "))
@@ -592,7 +687,7 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'."
 start a new line."
   (interactive)
   (end-of-line)
-  (if (> (current-column) end-comment-column) (newline))
+  (if (> (current-column) ada-comment-end-column) (newline))
   (if (< (current-column) comment-column) (indent-to comment-column))
   (insert " -- "))