-; 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.)
+;;; ada.el --- Ada editing support package in GNUlisp. v1.0
;; 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.")
(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
by typing Control-C followed by a character mnemonic for the construct.
-C-c C-a array C-c b exception block
-C-c C-e exception C-c d declare block
-C-c C-k package spec C-c k package body
-C-c C-p procedure spec C-c p proc/func body
-C-c C-f func spec C-c f for loop
- C-c i if
- C-c I elsif
- C-c e else
-C-c C-v private C-c l loop
-C-c C-r record C-c c case
-C-c C-s subtype C-c s separate
-C-c C-t type C-c t tab spacing for indents
-C-c C-w when C-c w while
- C-c x exit
-C-c ( paired parens C-c - inline comment
- C-c h header sec
-C-c C compile C-c B bind
-C-c E find error list
-C-c L name library C-c O options for bind
-
-C-c < and C-c > move backward and forward respectively to the next line
+\\<ada-mode-map>\\[ada-array] array \\[ada-exception-block] exception block
+\\[ada-exception] exception \\[ada-declare-block] declare block
+\\[ada-package-spec] package spec \\[ada-package-body] package body
+\\[ada-procedure-spec] procedure spec \\[ada-subprogram-body] proc/func body
+\\[ada-function-spec] func spec \\[ada-for-loop] for loop
+ \\[ada-if] if
+ \\[ada-elsif] elsif
+ \\[ada-else] else
+\\[ada-private] private \\[ada-loop] loop
+\\[ada-record] record \\[ada-case] case
+\\[ada-subtype] subtype \\[ada-separate] separate
+\\[ada-type] type \\[ada-tabsize] tab spacing for indents
+\\[ada-when] when \\[ada-while] while
+ \\[ada-exit] exit
+\\[ada-paired-parens] paired parens \\[ada-inline-comment] inline comment
+ \\[ada-header] header spec
+\\[ada-compile] compile \\[ada-bind] bind
+\\[ada-find-listing] find error list
+\\[ada-library-name] name library \\[ada-options-for-bind] options for bind
+
+\\[ada-backward-to-same-indent] and \\[ada-forward-to-same-indent] move backward and forward respectively to the next line
having the same (or lesser) level of indentation.
-Variable ada-indent controls the number of spaces for indent/undent.
-
-\\{ada-mode-map}
-"
+Variable `ada-indent' controls the number of spaces for indent/undent."
(interactive)
(kill-all-local-variables)
(use-local-map ada-mode-map)
(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)
(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)
- "changes spacing used for indentation. Reads spacing from minibuffer."
- (interactive "nnew indentation spacing: ")
+ "Changes spacing used for indentation.
+The prefix argument is used as the new spacing."
+ (interactive "p")
(setq ada-indent s))
(defun ada-newline ()
(backward-delete-char-untabify ada-indent nil))
(defun ada-go-to-this-indent (step indent-level)
- "Move point repeatedly by <step> lines till the current line
-has given indent-level or less, or the start/end of the buffer is hit.
-Ignore blank lines, statement labels, block/loop names."
+ "Move point repeatedly by STEP lines until the current line has
+given INDENT-LEVEL or less, or the start or end of the buffer is reached.
+Ignore blank lines, statement labels and block or loop names."
(while (and
(zerop (forward-line step))
(or (looking-at "^[ ]*$")
(defun ada-backward-to-same-indent ()
"Move point backwards to nearest line with same indentation or less.
-If not found, point is left at top of buffer."
+If not found, point is left at the top of the buffer."
(interactive)
(ada-go-to-this-indent -1 (current-indentation))
(back-to-indentation))
(defun ada-forward-to-same-indent ()
"Move point forwards to nearest line with same indentation or less.
-If not found, point is left at start of last line in buffer."
+If not found, point is left at the start of the last line in the buffer."
(interactive)
(ada-go-to-this-indent 1 (current-indentation))
(back-to-indentation))
(defun ada-array ()
- "Insert array type definition, prompting for component type,
-leaving the user to type in the index subtypes."
+ "Insert array type definition. Uses the minibuffer to prompt
+for component type and index subtypes."
(interactive)
(insert "array ()")
(backward-char)
(end-of-line))
(defun ada-case ()
- "Build skeleton case statment, prompting for the selector expression.
-starts up the first when clause, too."
+ "Build skeleton case statement.
+Uses the minibuffer to prompt for the selector expression.
+Also builds the first when clause."
(interactive)
(insert "case ")
(insert (read-string "selector expression: ") " is")
(ada-when))
(defun ada-declare-block ()
- "Insert a block with a declare part and indent for the 1st declaration."
+ "Insert a block with a declare part.
+Indent for the first declaration."
(interactive)
(let ((ada-block-name (read-string "[block name]: ")))
(insert "declare")
(cond
- ( (not (string-equal ada-block-name ""))
- (beginning-of-line)
- (open-line 1)
- (insert ada-block-name ":")
- (next-line 1)
- (end-of-line)))
+ ( (not (string-equal ada-block-name ""))
+ (beginning-of-line)
+ (open-line 1)
+ (insert ada-block-name ":")
+ (next-line 1)
+ (end-of-line)))
(ada-newline)
(ada-newline)
(insert "begin")
(ada-newline)
(ada-newline)
(if (string-equal ada-block-name "")
- (insert "end;")
+ (insert "end;")
(insert "end " ada-block-name ";"))
- )
+ )
(end-of-line -2)
(ada-tab))
(defun ada-exception-block ()
- "Insert a block with an exception part and indent for the 1st line of code."
+ "Insert a block with an exception part.
+Indent for the first line of code."
(interactive)
(let ((block-name (read-string "[block name]: ")))
(insert "begin")
(cond
- ( (not (string-equal block-name ""))
- (beginning-of-line)
- (open-line 1)
- (insert block-name ":")
- (next-line 1)
- (end-of-line)))
+ ( (not (string-equal block-name ""))
+ (beginning-of-line)
+ (open-line 1)
+ (insert block-name ":")
+ (next-line 1)
+ (end-of-line)))
(ada-newline)
(ada-newline)
(insert "exception")
(ada-newline)
(ada-newline)
(cond
- ( (string-equal block-name "")
- (insert "end;"))
- ( t
- (insert "end " block-name ";")))
- )
+ ( (string-equal block-name "")
+ (insert "end;"))
+ ( t
+ (insert "end " block-name ";")))
+ )
(end-of-line -2)
(ada-tab))
(defun ada-exception ()
- "Undent and insert an exception part into a block. Reindent."
+ "Insert an indented exception part into a block."
(interactive)
(ada-untab)
(insert "exception")
(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]: "))
(ada-tab))
(defun ada-get-arg-list ()
- "Read from user a procedure or function argument list.
+ "Read from the user a procedure or function argument list.
Add parens unless arguments absent, and insert into buffer.
-Individual arguments are arranged vertically if entered one-at-a-time.
-Arguments ending with ';' are presumed single and stacked."
+Individual arguments are arranged vertically if entered one at a time.
+Arguments ending with `;' are presumed single and stacked."
(insert " (")
(let ((ada-arg-indent (current-column))
(ada-args (read-string "[arguments]: ")))
(ada-get-arg-list))
(defun get-ada-subprogram-name ()
- "Return (without moving point or mark) a pair whose CAR is
-the name of the function or procedure whose spec immediately precedes point,
-and whose CDR is the column nbr the procedure/function keyword was found at."
+ "Return (without moving point or mark) a pair whose CAR is the name of
+the function or procedure whose spec immediately precedes point, and whose
+CDR is the column number where the procedure/function keyword was found."
(save-excursion
(let ((ada-proc-indent 0))
(if (re-search-backward
(defun ada-subprogram-body ()
"Insert frame for subprogram body.
-Invoke right after ada-function-spec or ada-procedure-spec."
+Invoke right after `ada-function-spec' or `ada-procedure-spec'."
(interactive)
(insert " is")
(let ((ada-subprogram-name-col (get-ada-subprogram-name)))
(ada-tab))
(defun ada-separate ()
- "Finish a body stub with 'is separate'."
+ "Finish a body stub with `is separate'."
(interactive)
(insert " is")
(ada-newline)
(backward-char))
(defun ada-inline-comment ()
- "Start a comment after the end of the line, indented at least COMMENT-COLUMN.
-If starting after END-COMMENT-COLUMN, start a new line."
+ "Start a comment after the end of the line, indented at least
+`comment-column' spaces. If starting after `end-comment-column',
+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 " -- "))
(defun ada-display-comment ()
-"Inserts 3 comment lines, making a display comment."
+"Inserts three comment lines, making a display comment."
(interactive)
(insert "--\n-- \n--")
(end-of-line 0))
;; Much of this is specific to Ada-Ed
-(defvar ada-lib-dir-name "lib" "*Current ada program library directory.")
+(defvar ada-lib-dir-name "lib" "*Current Ada program library directory.")
(defvar ada-bind-opts "" "*Options to supply for binding.")
(defun ada-library-name (ada-lib-name)
- "Specify name of ada library directory for later compilations."
- (interactive "Dname of ada library directory: ")
+ "Specify name of Ada library directory for later compilations."
+ (interactive "DName of Ada library directory: ")
(setq ada-lib-dir-name ada-lib-name))
(defun ada-options-for-bind ()
- "Specify options, such as -m and -i, needed for adabind."
- (setq ada-bind-opts (read-string "-m and -i options for adabind: ")))
+ "Specify options, such as -m and -i, needed for `ada-bind'."
+ (setq ada-bind-opts (read-string "-m and -i options for `ada-bind': ")))
-(defun ada-compile (ada-prefix-arg)
+(defun ada-compile (arg)
"Save the current buffer and compile it into the current program library.
Initialize the library if a prefix arg is given."
(interactive "P")
- (let* ((ada-init (if (null ada-prefix-arg) "" "-n "))
+ (let* ((ada-init (if (null arg) "" "-n "))
(ada-source-file (buffer-name)))
(compile
(concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file))))
"Bind the current program library, using the current binding options."
(interactive)
(compile (concat "adabind " ada-bind-opts " " ada-lib-dir-name)))
+
+;;; ada.el ends here