; 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.)(setq auto-mode-alist (cons (cons "\\.ada$" 'ada-mode) auto-mode-alist))(defvar ada-mode-syntax-table nil  "Syntax table in use in Ada-mode buffers.")(let ((table (make-syntax-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 ?/ "." 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 ?> "." 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 ?: "." table)  (modify-syntax-entry ?\; "." table)  (modify-syntax-entry ?\' "." table)  (modify-syntax-entry ?\" "\"" table)  (setq ada-mode-syntax-table table))(defvar ada-mode-map nil  "Keymap used in Ada mode.")(let ((map (make-sparse-keymap)))  (define-key map "\C-m" 'ada-newline)  (define-key map "\C-?" 'backward-delete-char-untabify)  (define-key map "\C-i" 'ada-tab)  (define-key map "\C-c\C-i" 'ada-untab)  (define-key map "\C-c<" 'ada-backward-to-same-indent)  (define-key map "\C-c>" 'ada-forward-to-same-indent)  (define-key map "\C-ch" 'ada-header)  (define-key map "\C-c(" 'ada-paired-parens)  (define-key map "\C-c-" 'ada-inline-comment)  (define-key map "\C-c\C-a" 'ada-array)  (define-key map "\C-cb" 'ada-exception-block)  (define-key map "\C-cd" 'ada-declare-block)  (define-key map "\C-c\C-e" 'ada-exception)  (define-key map "\C-cc" 'ada-case)  (define-key map "\C-c\C-k" 'ada-package-spec)  (define-key map "\C-ck" 'ada-package-body)  (define-key map "\C-c\C-p" 'ada-procedure-spec)  (define-key map "\C-cp" 'ada-subprogram-body)  (define-key map "\C-c\C-f" 'ada-function-spec)  (define-key map "\C-cf" 'ada-for-loop)  (define-key map "\C-cl" 'ada-loop)  (define-key map "\C-ci" 'ada-if)  (define-key map "\C-cI" 'ada-elsif)  (define-key map "\C-ce" 'ada-else)  (define-key map "\C-c\C-v" 'ada-private)  (define-key map "\C-c\C-r" 'ada-record)  (define-key map "\C-c\C-s" 'ada-subtype)  (define-key map "\C-cs" 'ada-separate)  (define-key map "\C-c\C-t" 'ada-type)  (define-key map "\C-ct" 'ada-tabsize);;    (define-key map "\C-c\C-u" 'ada-use);;    (define-key map "\C-c\C-w" 'ada-with)  (define-key map "\C-cw" 'ada-while-loop)  (define-key map "\C-c\C-w" 'ada-when)  (define-key map "\C-cx" 'ada-exit)  (define-key map "\C-cC" 'ada-compile)  (define-key map "\C-cB" 'ada-bind)  (define-key map "\C-cE" 'ada-find-listing)  (define-key map "\C-cL" 'ada-library-name)  (define-key map "\C-cO" 'ada-options-for-bind)  (setq ada-mode-map map))(defvar ada-indent 4 "*Value is the number of columns to indent in Ada-Mode.")  (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 bufferby typing Control-C followed by a character mnemonic for the construct.C-c C-a  array         	C-c b    exception blockC-c C-e  exception      C-c d    declare blockC-c C-k  package spec   C-c k    package bodyC-c C-p  procedure spec C-c p    proc/func bodyC-c C-f  func spec      C-c f    for loop                        C-c i    if                        C-c I    elsif                        C-c e    elseC-c C-v  private        C-c l    loopC-c C-r  record         C-c c    caseC-c C-s  subtype        C-c s    separateC-c C-t  type           C-c t    tab spacing for indentsC-c C-w  when           C-c w    while                        C-c x    exitC-c (    paired parens  C-c -    inline comment                        C-c h    header secC-c C    compile        C-c B    bindC-c E    find error listC-c L    name library   C-c O    options for bindC-c < and C-c > move backward and forward respectively to the next linehaving the same (or lesser) level of indentation.Variable ada-indent controls the number of spaces for indent/undent.\\{ada-mode-map}"  (interactive)  (kill-all-local-variables)  (use-local-map ada-mode-map)  (setq major-mode 'ada-mode)  (setq mode-name "Ada")  (make-local-variable 'comment-column)  (setq comment-column 41)  (make-local-variable 'end-comment-column)  (setq end-comment-column 72)  (set-syntax-table ada-mode-syntax-table)  (make-local-variable 'paragraph-start)  (setq paragraph-start (concat "^$\\|" page-delimiter))  (make-local-variable 'paragraph-separate)  (setq paragraph-separate paragraph-start)  (make-local-variable 'paragraph-ignore-fill-prefix)  (setq paragraph-ignore-fill-prefix t);  (make-local-variable 'indent-line-function);  (setq indent-line-function 'c-indent-line)  (make-local-variable 'require-final-newline)  (setq require-final-newline t)  (make-local-variable 'comment-start)  (setq comment-start "--")  (make-local-variable 'comment-end)  (setq comment-end "\n")  (make-local-variable 'comment-column)  (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 'parse-sexp-ignore-comments)  (setq parse-sexp-ignore-comments t)  (run-hooks 'ada-mode-hook))(defun ada-tabsize (s)  "changes spacing used for indentation. Reads spacing from minibuffer."  (interactive "nnew indentation spacing: ")  (setq ada-indent s))(defun ada-newline ()  "Start new line and indent to current tab stop."  (interactive)  (let ((ada-cc (current-indentation)))    (newline)    (indent-to ada-cc)))(defun ada-tab ()  "Indent to next tab stop."  (interactive)  (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent)))(defun ada-untab ()  "Delete backwards to previous tab stop."  (interactive)  (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 linehas given indent-level or less, or the start/end of the buffer is hit.Ignore blank lines, statement labels, block/loop names."  (while (and	  (zerop (forward-line step))	  (or (looking-at "^[ 	]*$")	      (looking-at "^[ 	]*--")	      (looking-at "^<<[A-Za-z0-9_]+>>")	      (looking-at "^[A-Za-z0-9_]+:")	      (> (current-indentation) indent-level)))    nil))(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."  (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."  (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."  (interactive)  (insert "array ()")  (backward-char)  (insert (read-string "index subtype[s]: "))  (end-of-line)  (insert " of ;")  (backward-char)  (insert (read-string "component-type: "))  (end-of-line))(defun ada-case ()  "Build skeleton case statment, prompting for the selector expression.starts up the first when clause, too."  (interactive)  (insert "case ")  (insert (read-string "selector expression: ") " is")  (ada-newline)  (ada-newline)  (insert "end case;")  (end-of-line 0)  (ada-tab)  (ada-tab)  (ada-when))(defun ada-declare-block ()  "Insert a block with a declare part and indent for the 1st 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)))    (ada-newline)    (ada-newline)    (insert "begin")    (ada-newline)    (ada-newline)    (if (string-equal ada-block-name "")      (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."  (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)))    (ada-newline)    (ada-newline)    (insert "exception")    (ada-newline)    (ada-newline)    (cond      ( (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."  (interactive)  (ada-untab)  (insert "exception")  (ada-newline)  (ada-tab))(defun ada-else ()  "Add an else clause inside an if-then-end-if clause."  (interactive)  (ada-untab)  (insert "else")  (ada-newline)  (ada-tab))(defun ada-exit ()  "Insert an exit statement, prompting for loop name and condition."  (interactive)  (insert "exit")  (let ((ada-loop-name (read-string "[name of loop to exit]: ")))    (if (not (string-equal ada-loop-name "")) (insert " " ada-loop-name)))  (let ((ada-exit-condition (read-string "[exit condition]: ")))    (if (not (string-equal ada-exit-condition ""))	(if (string-match "^ *[Ww][Hh][Ee][Nn] +" ada-exit-condition)	    (insert " " ada-exit-condition)	  (insert " when " ada-exit-condition))))  (insert ";"))(defun ada-when ()  "Start a case statement alternative with a when clause."