--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/modes/ada-mode.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,3772 @@
+;;; ada-mode.el - An Emacs major-mode for editing Ada source.
+;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
+
+;;; Authors: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
+;;;          Rolf Ebert      <ebert@inf.enst.fr>
+
+;;; 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 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; This mode is a complete rewrite of a major mode for editing Ada 83
+;;; and Ada 95 source code under Emacs-19.  It contains completely new
+;;; indenting code and support for code browsing (see ada-xref).
+
+;;; Synched up with: FSF 19.29.
+
+;;; USAGE
+;;; =====
+;;; Emacs should enter ada-mode when you load an ada source (*.ad[abs]).
+;;;
+;;; When you have entered ada-mode, you may get more info by pressing
+;;; C-h m. You may also get online help describing various functions by:
+;;; C-h d <Name of function you want described>
+
+
+;;; HISTORY
+;;; =======
+;;; The first Ada mode for GNU Emacs was written by V. Broman in
+;;; 1985. He based his work on the already existing Modula-2 mode.
+;;; This was distributed as ada.el in versions of Emacs prior to 19.29.
+;;;
+;;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of
+;;; several files with support for dired commands and other nice
+;;; things. It is currently available from the PAL
+;;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z.
+;;;
+;;; The probably very first Ada mode (called electric-ada.el) was
+;;; written by Steven D. Litvintchouk and Steven M. Rosen for the
+;;; Gosling Emacs. L. Slater based his development on ada.el and
+;;; electric-ada.el.
+;;;
+;;; The current Ada mode is a complete rewrite by M. Heritsch and
+;;; R. Ebert.  Some ideas from the ada-mode mailing list have been
+;;; added.  Some of the functionality of L. Slater's mode has not
+;;; (yet) been recoded in this new mode.  Perhaps you prefer sticking
+;;; to his version.
+
+
+;;; KNOWN BUGS
+;;; ==========
+;;;
+;;; In the presence of comments and/or incorrect syntax
+;;; ada-format-paramlist produces weird results.
+;;;
+;;; Indenting of some tasking constructs is still buggy.
+;;; -------------------
+;;;   For tagged types the problem comes from the keyword abstract:
+
+;;;   type T2 is abstract tagged record
+;;;   X : Integer;
+;;;   Y : Float;
+;;;   end record;
+;;; -------------------	
+;;; In Emacs FSF 19.28, ada-mode will correctly indent comments at the
+;;; very beginning of the buffer (_before_ any code) when I go M-; but
+;;; when I press TAB I'd expect the comments to be placed at the beginning
+;;; of the line, just as the first line of _code_ would be indented.
+
+;;; This does not happen but the comment stays put :-( I end up going 
+;;; M-; C-a M-\
+;;; -------------------
+;;; package Test is
+;;;    -- If I hit return on the "type" line it will indent the next line
+;;;    -- in another 3 space instead of heading out to the "(". If I hit
+;;;    -- tab or return it reindents the line correctly but does not initially.
+;;;    type Wait_Return is (Read_Success, Read_Timeout, Wait_Timeout,
+;;;       Nothing_To_Wait_For_In_Wait_List);
+;;;
+;;;    -- The following line will be wrongly reindented after typing it in after
+;;;    -- the initial indent for the line was correct after type return after
+;;;    -- this line. Subsequent lines will show the same problem.
+;;; Unused:    constant Queue_ID := 0;
+;;; -------------------
+;;; -- If I do the following I get 
+;;; -- "no matching procedure/function/task/declare/package"
+;;; -- when I do return (I reverse the mappings of ^j and ^m) after "private".
+;;; package Package1 is
+;;;    package Package1_1 is
+;;;       type The_Type is private;
+;;;       private
+;;; -------------------
+;;; -- But what about this:
+;;; package G is
+;;;    type T1 is new Integer;
+;;;    type T2 is new Integer;  --< incorrect, correct if subtype
+;;;    package H is
+;;;       type T3 is new Integer;
+;;;    type                     --< Indentation is incorrect
+;;; -------------------
+
+
+
+;;; CREDITS
+;;; =======
+;;;
+;;; Many thanks to
+;;;    Philippe Warroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular,
+;;;    woodruff@stc.llnl.gov (John Woodruff)
+;;;    jj@ddci.dk (Jesper Joergensen)
+;;;    gse@ocsystems.com (Scott Evans)
+;;;    comar@LANG8.CS.NYU.EDU (Cyrille Comar)
+;;;    and others for their valuable hints.
+
+;;;--------------------
+;;;    USER OPTIONS
+;;;--------------------
+
+;; ---- configure indentation
+
+(defvar ada-indent 3
+  "*Defines the size of Ada indentation.")
+
+(defvar ada-broken-indent 2
+  "*# of columns to indent the continuation of a broken line.")
+
+(defvar ada-label-indent -4
+  "*# of columns to indent a label.")
+
+(defvar ada-stmt-end-indent 0
+  "*# of columns to indent a statement end keyword in a separate line.
+Examples are 'is', 'loop', 'record', ...")
+
+(defvar ada-when-indent 3
+  "*Defines the indentation for 'when' relative to 'exception' or 'case'.")
+
+(defvar ada-indent-record-rel-type 3
+  "*Defines the indentation for 'record' relative to 'type' or 'use'.")
+
+(defvar ada-indent-comment-as-code t
+  "*If non-nil, comment-lines get indented as ada-code.")
+
+(defvar ada-indent-is-separate t
+  "*If non-nil, 'is separate' or 'is abstract' on a separate line are
+indented.")
+
+(defvar ada-indent-to-open-paren t
+  "*If non-nil, following lines get indented according to the innermost
+open parenthesis.")
+
+(defvar ada-search-paren-char-count-limit 3000
+  "*Search that many characters for an open parenthesis.")
+
+
+;; ---- other user options
+
+(defvar ada-tab-policy 'indent-auto
+  "*Control behaviour of the TAB key.
+Must be one of 'indent-rigidly, 'indent-auto, 'gei, 'indent-af or 'always-tab.
+
+'indent-rigidly : always adds ada-indent blanks at the beginning of the line.
+'indent-auto    : use indentation functions in this file.
+'gei            : use David Kågedal's Generic Indentation Engine.
+'indent-af      : use Gary E. Barnes' ada-format.el
+'always-tab     : do indent-relative.")
+
+(defvar ada-move-to-declaration nil
+  "*If non-nil, ada-move-to-start moves point to the subprog-declaration,
+not to 'begin'.")
+
+(defvar ada-spec-suffix ".ads"
+  "*Suffix of Ada specification files.")
+
+(defvar ada-body-suffix ".adb"
+  "*Suffix of Ada body files.")
+
+(defvar ada-language-version 'ada95
+  "*Do we program in 'ada83 or 'ada95?")
+
+(defvar ada-case-keyword 'downcase-word
+  "*downcase-word, upcase-word, ada-loose-case-word or capitalize-word
+to adjust ada keywords case.")
+
+(defvar ada-case-identifier 'ada-loose-case-word
+  "*downcase-word, upcase-word, ada-loose-case-word or capitalize-word
+to adjust ada identifier case.")
+
+(defvar ada-case-attribute 'capitalize-word
+  "*downcase-word, upcase-word, ada-loose-case-word or capitalize-word
+to adjust ada identifier case.")
+
+(defvar ada-auto-case t
+  "*Non-nil automatically changes casing of preceeding word while typing.
+Casing is done according to ada-case-keyword and ada-case-identifier.")
+
+(defvar ada-clean-buffer-before-saving  nil
+  "*If non-nil, remove-trailing-spaces and untabify buffer before saving.")
+
+(defvar ada-mode-hook nil
+  "*List of functions to call when Ada Mode is invoked.
+This is a good place to add Ada environment specific bindings.")
+
+(defvar ada-external-pretty-print-program "aimap"
+  "*External pretty printer to call from within Ada Mode.")
+
+(defvar ada-tmp-directory "/tmp/"
+  "*Directory to store the temporary file for the Ada pretty printer.")
+
+(defvar ada-fill-comment-prefix "-- "
+  "*This is inserted in the first columns when filling a comment paragraph.")
+
+(defvar ada-fill-comment-postfix " --"
+  "*This is inserted at the end of each line when filling a comment paragraph
+with ada-fill-comment-paragraph postfix.")
+
+(defvar ada-krunch-args "0"
+  "*Argument of gnatk8, a string containing the max number of characters.
+Set to 0, if you dont use crunched filenames.")
+
+;;; ---- end of user configurable variables
+
+
+(defvar ada-mode-abbrev-table nil
+  "Abbrev table used in Ada mode.")
+(define-abbrev-table 'ada-mode-abbrev-table ())
+
+(defvar ada-mode-map ()
+  "Local keymap used for ada-mode.")
+
+(defvar ada-mode-syntax-table nil
+  "Syntax table to be used for editing Ada source code.")
+
+(defvar ada-mode-symbol-syntax-table nil
+  "Syntax table for Ada, where `_' is a word constituent.")
+
+(defconst ada-83-keywords
+  "\\<\\(abort\\|abs\\|accept\\|access\\|all\\|and\\|array\\|\
+at\\|begin\\|body\\|case\\|constant\\|declare\\|delay\\|delta\\|\
+digits\\|do\\|else\\|elsif\\|end\\|entry\\|exception\\|exit\\|for\\|\
+function\\|generic\\|goto\\|if\\|in\\|is\\|limited\\|loop\\|mod\\|\
+new\\|not\\|null\\|of\\|or\\|others\\|out\\|package\\|pragma\\|\
+private\\|procedure\\|raise\\|range\\|record\\|rem\\|renames\\|\
+return\\|reverse\\|select\\|separate\\|subtype\\|task\\|terminate\\|\
+then\\|type\\|use\\|when\\|while\\|with\\|xor\\)\\>"
+  "regular expression for looking at Ada83 keywords.")
+
+(defconst ada-95-keywords
+  "\\<\\(abort\\|abs\\|abstract\\|accept\\|access\\|aliased\\|\
+all\\|and\\|array\\|at\\|begin\\|body\\|case\\|constant\\|declare\\|\
+delay\\|delta\\|digits\\|do\\|else\\|elsif\\|end\\|entry\\|\
+exception\\|exit\\|for\\|function\\|generic\\|goto\\|if\\|in\\|\
+is\\|limited\\|loop\\|mod\\|new\\|not\\|null\\|of\\|or\\|others\\|\
+out\\|package\\|pragma\\|private\\|procedure\\|protected\\|raise\\|\
+range\\|record\\|rem\\|renames\\|requeue\\|return\\|reverse\\|\
+select\\|separate\\|subtype\\|tagged\\|task\\|terminate\\|then\\|\
+type\\|until\\|use\\|when\\|while\\|with\\|xor\\)\\>"
+  "regular expression for looking at Ada95 keywords.")
+
+(defvar ada-keywords ada-95-keywords
+  "regular expression for looking at Ada keywords.")
+
+(defvar ada-ret-binding nil
+  "Variable to save key binding of RET when casing is activated.")
+
+(defvar ada-lfd-binding nil
+  "Variable to save key binding of LFD when casing is activated.")
+
+;;; ---- Regexps to find procedures/functions/packages
+
+(defconst ada-ident-re 
+  "[a-zA-Z0-9_\\.]+"
+  "Regexp matching Ada identifiers.")
+
+(defvar ada-procedure-start-regexp
+  "^[ \t]*\\(procedure\\|function\\|task\\)[ \t\n]+\\([a-zA-Z0-9_\\.]+\\)"
+  "Regexp used to find Ada procedures/functions.")
+
+(defvar ada-package-start-regexp
+  "^[ \t]*\\(package\\)"
+  "Regexp used to find Ada packages")
+
+
+;;; ---- regexps for indentation functions
+
+(defvar ada-block-start-re
+  "\\<\\(begin\\|select\\|declare\\|private\\|or\\|generic\\|\
+exception\\|loop\\|else\\|\
+\\(\\(limited\\|abstract\\|tagged\\)[ \t]+\\)*record\\)\\>"
+  "Regexp for keywords starting ada-blocks.")
+
+(defvar ada-end-stmt-re
+  "\\(;\\|=>\\|^[ \t]*separate[ \t]+([a-zA-Z0-9_\\.]+)\\|\
+\\<\\(begin\\|else\\|record\\|loop\\|select\\|do\\|\
+^[ \t]*package[ \ta-zA-Z0-9_\\.]+is\\|\
+^[ \t]*exception\\|declare\\|generic\\|private\\)\\>\\)"
+  "Regexp of possible ends for a non-broken statement.
+'end' means that there has to start a new statement after these.")
+
+(defvar ada-loop-start-re
+  "\\<\\(for\\|while\\|loop\\)\\>"
+  "Regexp for the start of a loop.")
+
+(defvar ada-subprog-start-re
+  "\\<\\(procedure\\|protected\\|package[ \t]+body\\|function\\|\
+task\\|accept\\|entry\\)\\>"
+  "Regexp for the start of a subprogram.")
+
+
+;;;-------------
+;;;  functions
+;;;-------------
+
+(defun ada-xemacs ()
+  (or (string-match "Lucid"  emacs-version)
+      (string-match "XEmacs" emacs-version)))
+
+(defun ada-create-syntax-table ()
+  "Create the syntax table for ada-mode."
+  ;; There are two different syntax-tables.  The standard one declares
+  ;; `_' a symbol constituent, in the second one, it is a word
+  ;; constituent.  For some search and replacing routines we
+  ;; temporarily switch between the two.
+  (setq ada-mode-syntax-table (make-syntax-table))
+  (set-syntax-table  ada-mode-syntax-table)
+
+  ;; define string brackets (% is alternative string bracket)
+  (modify-syntax-entry ?%  "\"" ada-mode-syntax-table)
+  (modify-syntax-entry ?\" "\"" ada-mode-syntax-table)
+
+  (modify-syntax-entry ?\#  "$" ada-mode-syntax-table)
+
+  (modify-syntax-entry ?:  "." ada-mode-syntax-table)
+  (modify-syntax-entry ?\; "." ada-mode-syntax-table)
+  (modify-syntax-entry ?&  "." ada-mode-syntax-table)
+  (modify-syntax-entry ?\|  "." ada-mode-syntax-table)
+  (modify-syntax-entry ?+  "." ada-mode-syntax-table)
+  (modify-syntax-entry ?*  "." ada-mode-syntax-table)
+  (modify-syntax-entry ?/  "." ada-mode-syntax-table)
+  (modify-syntax-entry ?=  "." ada-mode-syntax-table)
+  (modify-syntax-entry ?<  "." ada-mode-syntax-table)
+  (modify-syntax-entry ?>  "." ada-mode-syntax-table)
+  (modify-syntax-entry ?$ "." ada-mode-syntax-table)
+  (modify-syntax-entry ?\[ "." ada-mode-syntax-table)
+  (modify-syntax-entry ?\] "." ada-mode-syntax-table)
+  (modify-syntax-entry ?\{ "." ada-mode-syntax-table)
+  (modify-syntax-entry ?\} "." ada-mode-syntax-table)
+  (modify-syntax-entry ?. "." ada-mode-syntax-table)
+  (modify-syntax-entry ?\\ "." ada-mode-syntax-table)
+  (modify-syntax-entry ?\' "." ada-mode-syntax-table)
+
+  ;; a single hyphen is punctuation, but a double hyphen starts a comment
+  (modify-syntax-entry ?-  ". 12" ada-mode-syntax-table)
+
+  ;; and \f and \n end a comment
+  (modify-syntax-entry ?\f  ">   " ada-mode-syntax-table)
+  (modify-syntax-entry ?\n  ">   " ada-mode-syntax-table)
+
+  ;; define what belongs in ada symbols
+  (modify-syntax-entry ?_ "_" ada-mode-syntax-table)
+
+  ;; define parentheses to match
+  (modify-syntax-entry ?\( "()" ada-mode-syntax-table)
+  (modify-syntax-entry ?\) ")(" ada-mode-syntax-table)
+
+  (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table))
+  (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
+  )
+
+
+;;;###autoload
+(defun ada-mode ()
+  "Ada Mode is the major mode for editing Ada code.
+
+Bindings are as follows: (Note: 'LFD' is control-j.)
+
+ Indent line                                          '\\[ada-tab]'
+ Indent line, insert newline and indent the new line. '\\[newline-and-indent]'
+
+ Re-format the parameter-list point is in             '\\[ada-format-paramlist]'
+ Indent all lines in region                           '\\[ada-indent-region]'
+ Call external pretty printer program                 '\\[ada-call-pretty-printer]'
+
+ Adjust case of identifiers and keywords in region    '\\[ada-adjust-case-region]'
+ Adjust case of identifiers and keywords in buffer    '\\[ada-adjust-case-buffer]'
+
+ Call EXTERNAL pretty printer (if you have one)       '\\[ada-call-pretty-printer]'
+
+ Fill comment paragraph                               '\\[ada-fill-comment-paragraph]'
+ Fill comment paragraph and justify each line         '\\[ada-fill-comment-paragraph-justify]'
+ Fill comment paragraph, justify and append postfix   '\\[ada-fill-comment-paragraph-postfix]'
+
+ Next func/proc/task '\\[ada-next-procedure]'    Previous func/proc/task '\\[ada-previous-procedure]'
+ Next package        '\\[ada-next-package]'  Previous package        '\\[ada-previous-package]'
+
+ Goto matching start of current 'end ...;'            '\\[ada-move-to-start]'
+ Goto end of current block                            '\\[ada-move-to-end]'
+
+Comments are handled using standard GNU Emacs conventions, including:
+ Start a comment                                      '\\[indent-for-comment]'
+ Comment region                                       '\\[comment-region]'
+ Uncomment region                                     '\\[ada-uncomment-region]'
+ Continue comment on next line                        '\\[indent-new-comment-line]'
+
+If you use imenu.el:
+ Display index-menu of functions & procedures         '\\[imenu]'
+
+If you use find-file.el:
+ Switch to other file (Body <-> Spec)                 '\\[ff-find-other-file]'
+                                                   or '\\[ff-mouse-find-other-file]
+ Switch to other file in other window                 '\\[ada-ff-other-window]'
+                                                   or '\\[ff-mouse-find-other-file-other-window]
+ If you use this function in a spec and no body is available, it gets created
+ with body stubs.
+
+If you use ada-xref.el:
+ Goto declaration:          '\\[ada-point-and-xref]' on the identifier
+                         or '\\[ada-goto-declaration]' with point on the identifier
+ Complete identifier:       '\\[ada-complete-identifier]'
+ Execute Gnatf:             '\\[ada-gnatf-current]'"
+
+  (interactive)
+  (kill-all-local-variables)
+
+  (make-local-variable 'require-final-newline)
+  (setq require-final-newline t)
+
+  (make-local-variable 'comment-start)
+  (setq comment-start "-- ")
+
+  ;; comment end must be set because it may hold a wrong value if
+  ;; this buffer had been in another mode before. RE
+  (make-local-variable 'comment-end)
+  (setq comment-end "")
+
+  (make-local-variable 'comment-start-skip) ;; used by autofill
+  (setq comment-start-skip "--+[ \t]*")
+
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'ada-indent-current-function)
+
+  (make-local-variable 'fill-column)
+  (setq fill-column 75)
+
+  (make-local-variable 'comment-column)
+  (setq comment-column 40)
+
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments t)
+
+  (make-local-variable 'case-fold-search)
+  (setq case-fold-search t)
+
+  (make-local-variable 'fill-paragraph-function)
+  (setq fill-paragraph-function 'ada-fill-comment-paragraph)
+
+  (setq major-mode 'ada-mode)
+  (setq mode-name "Ada")
+
+  (setq blink-matching-paren t)
+
+  (use-local-map ada-mode-map)
+
+  (if ada-mode-syntax-table
+      (set-syntax-table ada-mode-syntax-table)
+    (ada-create-syntax-table))
+
+  (if ada-clean-buffer-before-saving
+      (progn
+	;; remove all spaces at the end of lines in the whole buffer.
+	(add-hook 'local-write-file-hooks 'ada-remove-trailing-spaces)
+	;; convert all tabs to the correct number of spaces.
+	(add-hook 'local-write-file-hooks 'ada-untabify-buffer)))
+
+
+  ;; add menu 'Ada' to the menu bar
+  (ada-add-ada-menu)
+
+  (run-hooks 'ada-mode-hook)
+
+  ;; the following has to be done after running the ada-mode-hook
+  ;; because users might want to set the values of these variable
+  ;; inside the hook (MH)
+
+  (cond ((eq ada-language-version 'ada83)
+         (setq ada-keywords ada-83-keywords))
+        ((eq ada-language-version 'ada95)
+         (setq ada-keywords ada-95-keywords)))
+
+  (if ada-auto-case
+      (ada-activate-keys-for-case)))
+
+
+;;;--------------------------
+;;;  Fill Comment Paragraph
+;;;--------------------------
+
+(defun ada-fill-comment-paragraph-justify ()
+  "Fills current comment paragraph and justifies each line as well."
+  (interactive)
+  (ada-fill-comment-paragraph t))
+
+
+(defun ada-fill-comment-paragraph-postfix ()
+  "Fills current comment paragraph and justifies each line as well.
+Prompts for a postfix to be appended to each line."
+  (interactive)
+  (ada-fill-comment-paragraph t t))
+
+
+(defun ada-fill-comment-paragraph (&optional justify postfix)
+  "Fills the current comment paragraph.
+If JUSTIFY is non-nil, each line is justified as well.
+If POSTFIX and JUSTIFY are  non-nil, ada-fill-comment-postfix is appended
+to each filled and justified line.
+If ada-indent-comment-as code is non-nil, the paragraph is idented."
+  (interactive "P")
+  (let ((opos (point-marker))
+        (begin nil)
+        (end nil)
+        (end-2 nil)
+        (indent nil)
+        (ada-fill-comment-old-postfix "")
+        (fill-prefix nil))
+
+    ;; check if inside comment
+    (if (not (ada-in-comment-p))
+        (error "not inside comment"))
+
+    ;; prompt for postfix if wanted
+    (if (and justify
+             postfix)
+        (setq ada-fill-comment-postfix
+              (read-from-minibuffer "enter new postfix string: "
+                                    ada-fill-comment-postfix)))
+
+    ;; prompt for old postfix to remove if necessary
+    (if (and justify
+             postfix)
+        (setq ada-fill-comment-old-postfix
+              (read-from-minibuffer "enter already existing postfix string: "
+                                    ada-fill-comment-postfix)))
+
+    ;;
+    ;; find limits of paragraph
+    ;;
+    (message "filling comment paragraph ...")
+    (save-excursion
+      (back-to-indentation)
+      ;; find end of paragraph
+      (while (and (looking-at "--.*$")
+                  (not (looking-at "--[ \t]*$")))
+        (forward-line 1)
+        (back-to-indentation))
+      (beginning-of-line)
+      (setq end (point-marker))
+      (goto-char opos)
+      ;; find begin of paragraph
+      (back-to-indentation)
+      (while (and (looking-at "--.*$")
+                  (not (looking-at "--[ \t]*$")))
+        (forward-line -1)
+        (back-to-indentation))
+      (forward-line 1)
+      ;; get indentation to calculate width for filling
+      (ada-indent-current)
+      (back-to-indentation)
+      (setq indent (current-column))
+      (setq begin (point-marker)))
+
+    ;; delete old postfix if necessary
+    (if (and justify
+             postfix)
+        (save-excursion
+          (goto-char begin)
+          (while (re-search-forward (concat ada-fill-comment-old-postfix
+                                            "\n")
+                                    end t)
+            (replace-match "\n"))))
+
+    ;; delete leading whitespace and uncomment
+    (save-excursion
+      (goto-char begin)
+      (beginning-of-line)
+      (while (re-search-forward "^[ \t]*--[ \t]*" end t)
+        (replace-match "")))
+
+    ;; calculate fill width
+    (setq fill-column (- fill-column indent
+                         (length ada-fill-comment-prefix)
+                         (if postfix
+                             (length ada-fill-comment-postfix)
+                           0)))
+    ;; fill paragraph
+    (fill-region begin (1- end) justify)
+    (setq fill-column (+ fill-column indent
+                         (length ada-fill-comment-prefix)
+                         (if postfix
+                             (length ada-fill-comment-postfix)
+                           0)))
+   ;; find end of second last line
+    (save-excursion
+      (goto-char end)
+      (forward-line -2)
+      (end-of-line)
+      (setq end-2 (point-marker)))
+
+    ;; re-comment and re-indent region
+    (save-excursion
+      (goto-char begin)
+      (indent-to indent)
+      (insert ada-fill-comment-prefix)
+      (while (re-search-forward "\n" (1- end-2) t)
+        (replace-match (concat "\n" ada-fill-comment-prefix))
+        (beginning-of-line)
+        (indent-to indent)))
+
+    ;; append postfix if wanted
+    (if (and justify
+             postfix
+             ada-fill-comment-postfix)
+        (progn
+          ;; append postfix up to there
+          (save-excursion
+            (goto-char begin)
+            (while (re-search-forward "\n" (1- end-2) t)
+              (replace-match (concat ada-fill-comment-postfix "\n")))
+
+            ;; fill last line and append postfix
+            (end-of-line)
+            (insert-char ?
+                         (- fill-column
+                            (current-column)
+                            (length ada-fill-comment-postfix)))
+            (insert ada-fill-comment-postfix))))
+
+    ;; delete the extra line that gets inserted somehow(??)
+    (save-excursion
+      (goto-char (1- end))
+      (end-of-line)
+      (delete-char 1))
+
+     (message "filling comment paragraph ... done")
+    (goto-char opos))
+  t)
+
+
+;;;--------------------------------;;;
+;;;  Call External Pretty Printer  ;;;
+;;;--------------------------------;;;
+
+(defun ada-call-pretty-printer ()
+  "Calls the external Pretty Printer.
+The name is specified in ada-external-pretty-print-program.  Saves the
+current buffer in a directory specified by ada-tmp-directory,
+starts the Pretty Printer as external process on that file and then
+reloads the beautyfied program in the buffer and cleans up
+ada-tmp-directory."
+  (interactive)
+  (let ((filename-with-path buffer-file-name)
+        (curbuf (current-buffer))
+        (orgpos (point))
+        (mesgbuf nil) ;; for byte-compiling
+        (file-path (file-name-directory buffer-file-name))
+        (filename-without-path (file-name-nondirectory buffer-file-name))
+        (tmp-file-with-directory
+         (concat ada-tmp-directory
+                 (file-name-nondirectory buffer-file-name))))
+    ;;
+    ;; save buffer in temporary file
+    ;;
+    (message "saving current buffer to temporary file ...")
+    (write-file tmp-file-with-directory)
+    (auto-save-mode nil)
+    (message "saving current buffer to temporary file ... done")
+    ;;
+    ;; call external pretty printer program
+    ;;
+
+    (message "running external pretty printer ...")
+    ;; create a temporary buffer for messages of pretty printer
+    (setq mesgbuf (get-buffer-create "Pretty Printer Messages"))
+    ;; execute pretty printer on temporary file
+    (call-process ada-external-pretty-print-program
+                  nil mesgbuf t
+                  tmp-file-with-directory)
+    ;; display messages if there are some
+    (if (buffer-modified-p mesgbuf)
+        ;; show the message buffer
+        (display-buffer mesgbuf t)
+      ;; kill the message buffer
+      (kill-buffer mesgbuf))
+    (message "running external pretty printer ... done")
+    ;;
+    ;; kill current buffer and load pretty printer output
+    ;; or restore old buffer
+    ;;
+    (if (y-or-n-p
+         "Really replace current buffer with pretty printer output ? ")
+        (progn
+          (set-buffer-modified-p nil)
+          (kill-buffer curbuf)
+          (find-file tmp-file-with-directory))
+      (message "old buffer contents restored"))
+    ;;
+    ;; delete temporary file and restore information of current buffer
+    ;;
+    (delete-file tmp-file-with-directory)
+    (set-visited-file-name filename-with-path)
+    (auto-save-mode t)
+    (goto-char orgpos)))
+
+
+;;;---------------
+;;;  auto-casing
+;;;---------------
+
+;; from Philippe Waroquiers <philippe@cfmu.eurocontrol.be>
+;; modifiedby RE and MH
+
+(defun ada-after-keyword-p ()
+  ;; returns t if cursor is after a keyword.
+  (save-excursion
+    (forward-word -1)
+    (and (save-excursion
+           (or
+            (= (point) (point-min))
+            (backward-char 1))
+           (not (looking-at "_")))     ; (MH)
+         (looking-at (concat ada-keywords "[^_]")))))
+
+(defun ada-after-char-p ()
+  ;; returns t if after ada character "'". This is interpreted as being
+  ;; in a character constant.
+  (save-excursion
+    (if (> (point) 2)
+        (progn
+          (forward-char -2)
+          (looking-at "'"))
+      nil)))
+
+
+(defun ada-adjust-case (&optional force-identifier)
+  "Adjust the case of the word before the just-typed character,
+according to ada-case-keyword and ada-case-identifier
+If FORCE-IDENTIFIER is non-nil then also adjust keyword as
+identifier." ; (MH)
+  (forward-char -1)
+  (if (and (> (point) 1) (not (or (ada-in-string-p)
+                                  (ada-in-comment-p)
+                                  (ada-after-char-p))))
+      (if (eq (char-syntax (char-after (1- (point)))) ?w)
+	  (if (save-excursion
+		(forward-word -1)
+		(or (= (point) (point-min))
+		    (backward-char 1))
+		(looking-at "'"))
+	      (funcall ada-case-attribute -1)
+	    (if (and
+		 (not force-identifier) ; (MH)
+		 (ada-after-keyword-p))
+		(funcall ada-case-keyword -1)
+	      (funcall ada-case-identifier -1)))))
+  (forward-char 1))
+
+
+(defun ada-adjust-case-interactive (arg)
+  (interactive "P")
+  (let ((lastk last-command-char))
+    (cond ((or (eq lastk ?\n)
+               (eq lastk ?\r))
+           ;; horrible kludge
+           (insert " ")
+           (ada-adjust-case)
+           ;; horrible dekludge
+           (delete-backward-char 1)
+           ;; some special keys and their bindings
+           (cond
+            ((eq lastk ?\n)
+             (funcall ada-lfd-binding))
+            ((eq lastk ?\r)
+             (funcall ada-ret-binding))))
+          ((eq lastk ?\C-i) (ada-tab))
+          ((self-insert-command (prefix-numeric-value arg))))
+    ;; if there is a keyword in front of the underscore
+    ;; then it should be part of an identifier (MH)
+    (if (eq lastk ?_)
+        (ada-adjust-case t)
+      (ada-adjust-case))))
+
+
+(defun ada-activate-keys-for-case ()
+  ;; save original keybindings to allow swapping ret/lfd
+  ;; when casing is activated
+  ;; the 'or ...' is there to be sure that the value will not
+  ;; be changed again when ada-mode is called more than once (MH)
+  (or ada-ret-binding
+      (setq ada-ret-binding (key-binding "\C-M")))
+  (or ada-lfd-binding
+      (setq ada-lfd-binding (key-binding "\C-j")))
+  ;; call case modifying function after certain keys.
+  (mapcar (function (lambda(key) (define-key
+                                   ada-mode-map
+                                   (char-to-string key)
+                                   'ada-adjust-case-interactive)))
+          '( ?` ?~ ?! ?@ ?# ?$ ?% ?^ ?& ?* ?( ?)  ?- ?= ?+ ?[ ?{ ?] ?}
+                ?_ ?\\ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?? ?/ ?\n 32 ?\r )))
+;; deleted ?\t from above list
+
+;;
+;; added by MH
+;;
+(defun ada-loose-case-word (&optional arg)
+  "Capitalizes the first and the letters following _
+ARG is ignored, it's there to fit the standard casing functions' style."
+  (let ((pos (point))
+        (first t))
+    (skip-chars-backward "a-zA-Z0-9_")
+    (while (or first
+               (search-forward "_" pos t))
+      (and first
+           (setq first nil))
+      (insert-char (upcase (following-char)) 1)
+      (delete-char 1))
+    (goto-char pos)))
+
+
+;;
+;; added by MH
+;;
+(defun ada-adjust-case-region (from to)
+  "Adjusts the case of all identifiers and keywords in the region.
+ATTENTION: This function might take very long for big regions !"
+  (interactive "*r")
+  (let ((begin nil)
+        (end nil)
+        (keywordp nil)
+        (reldiff nil))
+    (unwind-protect
+	(save-excursion
+	  (set-syntax-table ada-mode-symbol-syntax-table)
+	  (goto-char to)
+	  ;;
+	  ;; loop: look for all identifiers and keywords
+	  ;;
+	  (while (re-search-backward
+		  "[^a-zA-Z0-9_]\\([a-zA-Z0-9_]+\\)[^a-zA-Z0-9_]"
+		  from
+		  t)
+	    ;;
+	    ;; print status message
+	    ;;
+	    (setq reldiff (- (point) from))
+	    (message (format "adjusting case ... %5d characters left"
+			     (- (point) from)))
+	    (forward-char 1)
+	    (or
+	     ;; do nothing if it is a string or comment
+	     (ada-in-string-or-comment-p)
+	     (progn
+	       ;;
+	       ;; get the identifier or keyword
+	       ;;
+	       (setq begin (point))
+	       (setq keywordp (looking-at (concat ada-keywords "[^_]")))
+	       (skip-chars-forward "a-zA-Z0-9_")
+	       ;;
+	       ;; casing according to user-option
+	       ;;
+	       (if keywordp
+		   (funcall ada-case-keyword -1)
+		 (funcall ada-case-identifier -1))
+	       (goto-char begin))))
+	  (message "adjusting case ... done"))
+      (set-syntax-table ada-mode-syntax-table))))
+
+
+;;
+;; added by MH
+;;
+(defun ada-adjust-case-buffer ()
+  "Adjusts the case of all identifiers and keywords in the whole buffer.
+ATTENTION: This function might take very long for big buffers !"
+  (interactive "*")
+  (ada-adjust-case-region (point-min) (point-max)))
+
+
+;;;------------------------;;;
+;;; Format Parameter Lists ;;;
+;;;------------------------;;;
+
+(defun ada-format-paramlist ()
+  "Re-formats a parameter-list.
+ATTENTION:  1) Comments inside the list are killed !
+            2) If the syntax is not correct (especially, if there are
+               semicolons missing), it can get totally confused !
+In such a case, use 'undo', correct the syntax and try again."
+
+  (interactive)
+  (let ((begin nil)
+        (end nil)
+        (delend nil)
+        (paramlist nil))
+    (unwind-protect
+	(progn 
+	  (set-syntax-table ada-mode-symbol-syntax-table)
+
+	  ;; check if really inside parameter list
+	  (or (ada-in-paramlist-p)
+	      (error "not in parameter list"))
+	  ;;
+	  ;; find start of current parameter-list
+	  ;;
+	  (ada-search-ignore-string-comment
+	   (concat "\\<\\("
+		   "procedure\\|function\\|body\\|package\\|task\\|entry\\|accept"
+		   "\\)\\>") t nil)
+	  (ada-search-ignore-string-comment "(" nil nil t)
+	  (backward-char 1)
+	  (setq begin (point))
+
+	  ;;
+	  ;; find end of parameter-list
+	  ;;
+	  (forward-sexp 1)
+	  (setq delend (point))
+	  (delete-char -1)
+
+	  ;;
+	  ;; find end of last parameter-declaration
+	  ;;
+	  (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
+	  (forward-char 1)
+	  (setq end (point))
+
+	  ;;
+	  ;; build a list of all elements of the parameter-list
+	  ;;
+	  (setq paramlist (ada-scan-paramlist (1+ begin) end))
+
+	  ;;
+	  ;; delete the original parameter-list
+	  ;;
+	  (delete-region begin (1- delend))
+
+	  ;;
+	  ;; insert the new parameter-list
+	  ;;
+	  (goto-char begin)
+	  (ada-insert-paramlist paramlist))
+
+      ;;
+      ;; restore syntax-table
+      ;;
+      (set-syntax-table ada-mode-syntax-table)
+      )))
+
+
+(defun ada-scan-paramlist (begin end)
+  ;; Scans a parameter-list  between BEGIN and END and returns a list
+  ;; of its contents.
+  ;; The list has the following format:
+  ;;
+  ;;   Name of Param  in? out? accept?  Name of Type   Default-Exp or nil
+  ;;
+  ;; ( ('Name_Param_1' t   nil    t      Type_Param_1   ':= expression')
+  ;;   ('Name_Param_2' nil nil    t      Type_Param_2    nil) )
+
+  (let ((paramlist (list))
+        (param (list))
+        (notend t)
+        (apos nil)
+        (epos nil)
+        (semipos nil)
+        (match-cons nil))
+
+    (goto-char begin)
+    ;;
+    ;; loop until end of last parameter
+    ;;
+    (while notend
+
+      ;;
+      ;; find first character of parameter-declaration
+      ;;
+      (ada-goto-next-non-ws)
+      (setq apos (point))
+
+      ;;
+      ;; find last character of parameter-declaration
+      ;;
+      (if (setq match-cons
+                (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
+          (progn
+            (setq epos (car match-cons))
+            (setq semipos (cdr match-cons)))
+        (setq epos end))
+
+      ;;
+      ;; read name(s) of parameter(s)
+      ;;
+      (goto-char apos)
+      (looking-at "\\([a-zA-Z0-9_, \t\n]*[a-zA-Z0-9_]\\)[ \t\n]*:[^=]")
+
+      (setq param (list (buffer-substring (match-beginning 1)
+                                          (match-end 1))))
+      (ada-search-ignore-string-comment ":" nil epos t)
+
+      ;;
+      ;; look for 'in'
+      ;;
+      (setq apos (point))
+      (setq param
+            (append param
+                    (list
+                     (consp
+                      (ada-search-ignore-string-comment "\\<in\\>"
+                                                        nil
+                                                        epos
+                                                        t)))))
+
+      ;;
+      ;; look for 'out'
+      ;;
+      (goto-char apos)
+      (setq param
+            (append param
+                    (list
+                     (consp
+                      (ada-search-ignore-string-comment "\\<out\\>"
+                                                        nil
+                                                        epos
+                                                        t)))))
+
+      ;;
+      ;; look for 'accept'
+      ;;
+      (goto-char apos)
+      (setq param
+            (append param
+                    (list
+                     (consp
+                      (ada-search-ignore-string-comment "\\<accept\\>"
+                                                        nil
+                                                        epos
+                                                        t)))))
+
+      ;;
+      ;; skip 'in'/'out'/'accept'
+      ;;
+      (goto-char apos)
+      (ada-goto-next-non-ws)
+      (while (looking-at "\\<\\(in\\|out\\|accept\\)\\>")
+        (forward-word 1)
+        (ada-goto-next-non-ws))
+
+      ;;
+      ;; read type of parameter
+      ;;
+      (looking-at "\\<[a-zA-Z0-9_\\.]+\\>")
+      (setq param
+            (append param
+                    (list
+                     (buffer-substring (match-beginning 0)
+                                       (match-end 0)))))
+
+      ;;
+      ;; read default-expression, if there is one
+      ;;
+      (goto-char (setq apos (match-end 0)))
+      (setq param
+            (append param
+                    (list
+                     (if (setq match-cons
+                               (ada-search-ignore-string-comment ":="
+                                                                 nil
+                                                                 epos
+                                                                 t))
+                         (buffer-substring (car match-cons)
+                                           epos)
+                       nil))))
+      ;;
+      ;; add this parameter-declaration to the list
+      ;;
+      (setq paramlist (append paramlist (list param)))
+
+      ;;
+      ;; check if it was the last parameter
+      ;;
+      (if (eq epos end)
+          (setq notend nil)
+        (goto-char semipos))
+
+      ) ; end of loop
+
+    (reverse paramlist)))
+
+
+(defun ada-insert-paramlist (paramlist)
+  ;; Inserts a formatted PARAMLIST in the buffer.
+  ;; See doc of ada-scan-paramlist for the format.
+  (let ((i (length paramlist))
+        (parlen 0)
+        (typlen 0)
+        (temp 0)
+        (inp nil)
+        (outp nil)
+        (acceptp nil)
+        (column nil)
+        (orgpoint 0)
+        (firstcol nil))
+
+    ;;
+    ;; loop until last parameter
+    ;;
+    (while (not (zerop i))
+      (setq i (1- i))
+
+      ;;
+      ;; get max length of parameter-name
+      ;;
+      (setq parlen
+            (if (<= parlen (setq temp
+                              (length (nth 0 (nth i paramlist)))))
+                temp
+              parlen))
+
+      ;;
+      ;; get max length of type-name
+      ;;
+      (setq typlen
+            (if (<= typlen (setq temp
+                              (length (nth 4 (nth i paramlist)))))
+                temp
+              typlen))
+
+      ;;
+      ;; is there any 'in' ?
+      ;;
+      (setq inp
+            (or inp
+                (nth 1 (nth i paramlist))))
+
+      ;;
+      ;; is there any 'out' ?
+      ;;
+      (setq outp
+            (or outp
+                (nth 2 (nth i paramlist))))
+
+      ;;
+      ;; is there any 'accept' ?
+      ;;
+      (setq acceptp
+            (or acceptp
+                (nth 3 (nth i paramlist))))) ; end of loop
+
+    ;;
+    ;; does paramlist already start on a separate line ?
+    ;;
+    (if (save-excursion
+          (re-search-backward "^.\\|[^ \t]" nil t)
+          (looking-at "^."))
+        ;; yes => re-indent it
+        (ada-indent-current)
+      ;;
+      ;; no => insert newline and indent it
+      ;;
+      (progn
+        (ada-indent-current)
+        (newline)
+        (delete-horizontal-space)
+        (setq orgpoint (point))
+        (setq column (save-excursion
+                       (funcall (ada-indent-function) orgpoint)))
+        (indent-to column)
+        ))
+
+    (insert "(")
+
+    (setq firstcol (current-column))
+    (setq i (length paramlist))
+
+    ;;
+    ;; loop until last parameter
+    ;;
+    (while (not (zerop i))
+      (setq i (1- i))
+      (setq column firstcol)
+
+      ;;
+      ;; insert parameter-name, space and colon
+      ;;
+      (insert (nth 0 (nth i paramlist)))
+      (indent-to (+ column parlen 1))
+      (insert ": ")
+      (setq column (current-column))
+
+      ;;
+      ;; insert 'in' or space
+      ;;
+      (if (nth 1 (nth i paramlist))
+          (insert "in ")
+        (if (and
+             (or inp
+                 acceptp)
+             (not (nth 3 (nth i paramlist))))
+            (insert "   ")))
+
+      ;;
+      ;; insert 'out' or space
+      ;;
+      (if (nth 2 (nth i paramlist))
+          (insert "out ")
+        (if (and
+             (or outp
+                 acceptp)
+             (not (nth 3 (nth i paramlist))))
+            (insert "    ")))
+
+      ;;
+      ;; insert 'accept'
+      ;;
+      (if (nth 3 (nth i paramlist))
+          (insert "accept "))
+
+      (setq column (current-column))
+
+      ;;
+      ;; insert type-name and, if necessary, space and default-expression
+      ;;
+      (insert (nth 4 (nth i paramlist)))
+      (if (nth 5 (nth i paramlist))
+          (progn
+            (indent-to (+ column typlen 1))
+            (insert (nth 5 (nth i paramlist)))))
+
+      ;;
+      ;; check if it was the last parameter
+      ;;
+      (if (not (zerop i))
+          ;; no => insert ';' and newline and indent
+          (progn
+            (insert ";")
+            (newline)
+            (indent-to firstcol))
+        ;; yes
+        (insert ")"))
+
+      ) ; end of loop
+
+    ;;
+    ;; if anything follows, except semicolon:
+    ;; put it in a new line and indent it
+    ;;
+    (if (not (looking-at "[ \t]*[;\n]"))
+        (ada-indent-newline-indent))
+
+    ))
+
+
+;;;----------------------------;;;
+;;; Move To Matching Start/End ;;;
+;;;----------------------------;;;
+
+(defun ada-move-to-start ()
+  "Moves point to the matching start of the current end ... around point."
+  (interactive)
+  (let ((pos (point)))
+    (unwind-protect
+	(progn
+	  (set-syntax-table ada-mode-symbol-syntax-table)
+
+	  (message "searching for block start ...")
+	  (save-excursion
+	    ;;
+	    ;; do nothing if in string or comment or not on 'end ...;'
+	    ;;            or if an error occurs during processing
+	    ;;
+	    (or
+	     (ada-in-string-or-comment-p)
+	     (and (progn
+		    (or (looking-at "[ \t]*\\<end\\>")
+			(backward-word 1))
+		    (or (looking-at "[ \t]*\\<end\\>")
+			(backward-word 1))
+		    (or (looking-at "[ \t]*\\<end\\>")
+			(error "not on end ...;")))
+		  (ada-goto-matching-start 1)
+		  (setq pos (point))
+
+		  ;;
+		  ;; on 'begin' => go on, according to user option
+		  ;;
+		  ada-move-to-declaration
+		  (looking-at "\\<begin\\>")
+		  (ada-goto-matching-decl-start)
+		  (setq pos (point))))
+
+	    ) ; end of save-excursion
+
+	  ;; now really move to the found position
+	  (goto-char pos)
+	  (message "searching for block start ... done"))
+
+      ;;
+      ;; restore syntax-table
+      ;;
+      (set-syntax-table ada-mode-syntax-table))))
+
+
+(defun ada-move-to-end ()
+  "Moves point to the matching end of the current block around point.
+Moves to 'begin' if in a declarative part."
+  (interactive)
+  (let ((pos (point))
+        (decstart nil)
+        (packdecl nil))
+    (unwind-protect
+	(progn
+	  (set-syntax-table ada-mode-symbol-syntax-table)
+
+	  (message "searching for block end ...")
+	  (save-excursion
+
+	    (forward-char 1)
+	    (cond
+	     ;; directly on 'begin'
+	     ((save-excursion
+		(ada-goto-previous-word)
+		(looking-at "\\<begin\\>"))
+	      (ada-goto-matching-end 1))
+	     ;; on first line of defun declaration
+	     ((save-excursion
+		(and (ada-goto-stmt-start)
+		     (looking-at "\\<function\\>\\|\\<procedure\\>" )))
+	      (ada-search-ignore-string-comment "\\<begin\\>"))
+	     ;; on first line of task declaration
+	     ((save-excursion
+		(and (ada-goto-stmt-start)
+		     (looking-at "\\<task\\>" )
+		     (forward-word 1)
+		     (ada-search-ignore-string-comment "[^ \n\t]")
+		     (not (backward-char 1))
+		     (looking-at "\\<body\\>")))
+	      (ada-search-ignore-string-comment "\\<begin\\>"))
+	     ;; accept block start
+	     ((save-excursion
+		(and (ada-goto-stmt-start)
+		     (looking-at "\\<accept\\>" )))
+	      (ada-goto-matching-end 0))
+	     ;; package start
+	     ((save-excursion
+		(and (ada-goto-matching-decl-start t)
+		     (looking-at "\\<package\\>")))
+	      (ada-goto-matching-end 1))
+	     ;; inside a 'begin' ... 'end' block
+	     ((save-excursion
+		(ada-goto-matching-decl-start t))
+	      (ada-search-ignore-string-comment "\\<begin\\>"))
+	     ;; (hopefully ;-) everything else
+	     (t
+	      (ada-goto-matching-end 1)))
+	    (setq pos (point))
+
+	    ) ; end of save-excursion
+
+	  ;; now really move to the found position
+	  (goto-char pos)
+	  (message "searching for block end ... done"))
+      
+      ;;
+      ;; restore syntax-table
+      ;;
+      (set-syntax-table ada-mode-syntax-table))))
+
+
+;;;-----------------------------;;;
+;;;  Functions For Indentation  ;;;
+;;;-----------------------------;;;
+
+;; ---- main functions for indentation
+
+(defun ada-indent-region (beg end)
+  "Indents the region using ada-indent-current on each line."
+  (interactive "*r")
+  (goto-char beg)
+  (let ((block-done 0)
+	(lines-remaining (count-lines beg end))
+	(msg (format "indenting %4d lines %%4d lines remaining ..."
+		     (count-lines beg end)))
+        (endmark (copy-marker end)))
+    ;; catch errors while indenting
+    (condition-case err
+        (while (< (point) endmark)
+          (if (> block-done 9)
+              (progn (message (format msg lines-remaining))
+                     (setq block-done 0)))
+	  (if (looking-at "^$") nil
+	    (ada-indent-current))
+          (forward-line 1)
+	  (setq block-done (1+ block-done))
+	  (setq lines-remaining (1- lines-remaining)))
+      ;; show line number where the error occured
+      (error
+       (error (format "line %d: %s"
+                      (1+ (count-lines (point-min) (point)))
+                      err) nil)))
+    (message "indenting ... done")))
+
+
+(defun ada-indent-newline-indent ()
+  "Indents the current line, inserts a newline and then indents the new line."
+  (interactive "*")
+  (let ((column)
+        (orgpoint))
+
+    (ada-indent-current)
+    (newline)
+    (delete-horizontal-space)
+    (setq orgpoint (point))
+
+    (unwind-protect
+	(progn
+	  (set-syntax-table ada-mode-symbol-syntax-table)
+
+	  (setq column (save-excursion
+			 (funcall (ada-indent-function) orgpoint))))
+
+      ;;
+      ;; restore syntax-table
+      ;;
+      (set-syntax-table ada-mode-syntax-table))
+
+    (indent-to column)
+
+    ;; The following is needed to ensure that indentation will still be
+    ;; correct if something follows behind point when typing LFD
+    ;; For example: Imagine point to be there (*) when LFD is typed:
+    ;;              while cond loop
+    ;;                 null; *end loop;
+    ;; Result without the following statement would be:
+    ;;              while cond loop
+    ;;                 null;
+    ;;                *end loop;
+    ;; You would then have to type TAB to correct it.
+    ;; If that doesn't bother you, you can comment out the following
+    ;; statement to speed up indentation a LITTLE bit.
+
+    (if (not (looking-at "[ \t]*$"))
+        (ada-indent-current))
+    ))
+
+
+(defun ada-indent-current ()
+  "Indents current line as Ada code.
+This works by two steps:
+ 1) It moves point to the end of the previous code-line.
+    Then it calls the function to calculate the indentation for the
+    following line as if a newline would be inserted there.
+    The calculated column # is saved and the old position of point
+    is restored.
+ 2) Then another function is called to calculate the indentation for
+    the current line, based on the previously calculated column #."
+
+  (interactive)
+
+  (unwind-protect
+      (progn
+	(set-syntax-table ada-mode-symbol-syntax-table)
+
+	(let ((line-end)
+	      (orgpoint (point-marker))
+	      (cur-indent)
+	      (prev-indent)
+	      (prevline t))
+
+	  ;;
+	  ;; first step
+	  ;;
+	  (save-excursion
+	    (if (ada-goto-prev-nonblank-line t)
+		;;
+		;; we are not in the first accessible line in the buffer
+		;;
+		(progn
+		  ;;(end-of-line)
+		  ;;(forward-char 1)
+		  ;; we are already at the BOL
+		  (forward-line 1)
+		  (setq line-end (point))
+		  (setq prev-indent
+			(save-excursion
+			  (funcall (ada-indent-function) line-end))))
+	      (setq prevline nil)))
+
+	  (if prevline
+	      ;;
+	      ;; we are not in the first accessible line in the buffer
+	      ;;
+	      (progn
+		;;
+		;; second step
+		;;
+		(back-to-indentation)
+		(setq cur-indent (ada-get-current-indent prev-indent))
+		(delete-horizontal-space)
+		(indent-to cur-indent)
+
+		;;
+		;; restore position of point
+		;;
+		(goto-char orgpoint)
+		(if (< (current-column) (current-indentation))
+              (back-to-indentation))))))
+
+    ;;
+    ;; restore syntax-table
+    ;;
+    (set-syntax-table ada-mode-syntax-table)))
+
+
+(defun ada-get-current-indent (prev-indent)
+  ;; Returns the column # to indent the current line to.
+  ;; PREV-INDENT is the indentation resulting from the previous lines.
+  (let ((column nil)
+        (pos nil)
+        (match-cons nil))
+
+    (cond
+     ;;
+     ;; in open parenthesis, but not in parameter-list
+     ;;
+     ((and
+       ada-indent-to-open-paren
+       (not (ada-in-paramlist-p))
+       (setq column (ada-in-open-paren-p)))
+      ;; check if we have something like this  (Table_Component_Type =>
+      ;;                                          Source_File_Record,)
+      (save-excursion
+        (if (and (ada-search-ignore-string-comment "[^ \t]" t nil)
+                 (looking-at "\n")
+                 (ada-search-ignore-string-comment "[^ \t\n]" t nil)
+                 (looking-at ">"))
+            (setq column (+ ada-broken-indent column))))
+      column)
+
+     ;;
+     ;; end
+     ;;
+     ((looking-at "\\<end\\>")
+      (save-excursion
+        (ada-goto-matching-start 1)
+
+        ;;
+        ;; found 'loop' => skip back to 'while' or 'for'
+        ;;                 if 'loop' is not on a separate line
+        ;;
+        (if (and
+             (looking-at "\\<loop\\>")
+             (save-excursion
+               (back-to-indentation)
+               (not (looking-at "\\<loop\\>"))))
+            (if (save-excursion
+                  (and
+                   (setq match-cons
+                         (ada-search-ignore-string-comment
+                          ada-loop-start-re t nil))
+                   (not (looking-at "\\<loop\\>"))))
+                (goto-char (car match-cons))))
+
+        (current-indentation)))
+     ;;
+     ;; exception
+     ;;
+     ((looking-at "\\<exception\\>")
+      (save-excursion
+        (ada-goto-matching-start 1)
+        (current-indentation)))
+     ;;
+     ;; when
+     ;;
+     ((looking-at "\\<when\\>")
+      (save-excursion
+        (ada-goto-matching-start 1)
+        (+ (current-indentation) ada-when-indent)))
+     ;;
+     ;; else
+     ;;
+     ((looking-at "\\<else\\>")
+      (if (save-excursion
+            (ada-goto-previous-word)
+            (looking-at "\\<or\\>"))
+          prev-indent
+        (save-excursion
+          (ada-goto-matching-start 1 nil t)
+          (current-indentation))))
+     ;;
+     ;; elsif
+     ;;
+     ((looking-at "\\<elsif\\>")
+      (save-excursion
+        (ada-goto-matching-start 1 nil t)
+        (current-indentation)))
+     ;;
+     ;; then
+     ;;
+     ((looking-at "\\<then\\>")
+      (if (save-excursion
+            (ada-goto-previous-word)
+            (looking-at "\\<and\\>"))
+          prev-indent
+        (save-excursion
+          (ada-search-ignore-string-comment "\\<elsif\\>\\|\\<if\\>" t nil)
+          (+ (current-indentation) ada-stmt-end-indent))))
+     ;;
+     ;; loop
+     ;;
+     ((looking-at "\\<loop\\>")
+      (setq pos (point))
+      (save-excursion
+        (goto-char (match-end 0))
+        (ada-goto-stmt-start)
+        (if (looking-at "\\<loop\\>\\|\\<if\\>")
+            prev-indent
+          (progn
+            (if (not (looking-at ada-loop-start-re))
+                (ada-search-ignore-string-comment ada-loop-start-re
+                                                  nil pos))
+            (if (looking-at "\\<loop\\>")
+                prev-indent
+              (+ (current-indentation) ada-stmt-end-indent))))))
+     ;;
+     ;; begin
+     ;;
+     ((looking-at "\\<begin\\>")
+      (save-excursion
+        (if (ada-goto-matching-decl-start t)
+            (current-indentation)
+          (progn
+            (message "no matching declaration start")
+            prev-indent))))
+     ;;
+     ;; is
+     ;;
+     ((looking-at "\\<is\\>")
+      (if (and
+           ada-indent-is-separate
+           (save-excursion
+             (goto-char (match-end 0))
+             (ada-goto-next-non-ws (save-excursion
+                                     (end-of-line)
+                                     (point)))
+             (looking-at "\\<abstract\\>\\|\\<separate\\>")))
+          (save-excursion
+            (ada-goto-stmt-start)
+            (+ (current-indentation) ada-indent))
+        (save-excursion
+          (ada-goto-stmt-start)
+          (+ (current-indentation) ada-stmt-end-indent))))
+     ;;
+     ;; record
+     ;;
+     ((looking-at "\\<record\\>")
+      (save-excursion
+        (ada-search-ignore-string-comment
+         "\\<\\(type\\|use\\)\\>" t nil)
+        (if (looking-at "\\<use\\>")
+            (ada-search-ignore-string-comment "\\<for\\>" t nil))
+        (+ (current-indentation) ada-indent-record-rel-type)))
+     ;;
+     ;; or as statement-start
+     ;;
+     ((ada-looking-at-semi-or)
+      (save-excursion
+        (ada-goto-matching-start 1)
+        (current-indentation)))
+     ;;
+     ;; private as statement-start
+     ;;
+     ((ada-looking-at-semi-private)
+      (save-excursion
+        (ada-goto-matching-decl-start)
+        (current-indentation)))
+     ;;
+     ;; new/abstract/separate
+     ;;
+     ((looking-at "\\<\\(new\\|abstract\\|separate\\)\\>")
+      (- prev-indent ada-indent (- ada-broken-indent)))
+     ;;
+     ;; return
+     ;;
+     ((looking-at "\\<return\\>")
+      (save-excursion
+        (forward-sexp -1)
+        (if (and (looking-at "(")
+                 (save-excursion
+                   (backward-sexp 2)
+                   (looking-at "\\<function\\>")))
+            (1+ (current-column))
+          prev-indent)))
+     ;;
+     ;; do
+     ;;
+     ((looking-at "\\<do\\>")
+      (save-excursion
+        (ada-goto-stmt-start)
+        (+ (current-indentation) ada-stmt-end-indent)))
+     ;;
+     ;; package/function/procedure
+     ;;
+     ((and (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")
+           (save-excursion
+             (forward-char 1)
+             (ada-goto-stmt-start)
+             (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")))
+      (save-excursion
+        ;; look for 'generic'
+        (if (and (ada-goto-matching-decl-start t)
+                 (looking-at "generic"))
+            (current-column)
+          prev-indent)))
+     ;;
+     ;; label
+     ;;
+     ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*:[^=]")
+      (if (ada-in-decl-p)
+          prev-indent
+        (+ prev-indent ada-label-indent)))
+     ;;
+     ;; identifier and other noindent-statements
+     ;;
+     ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*")
+      prev-indent)
+     ;;
+     ;; beginning of a parameter list
+     ;;
+     ((looking-at "(")
+      prev-indent)
+     ;;
+     ;; end of a parameter list
+     ;;
+     ((looking-at ")")
+      (save-excursion
+        (forward-char 1)
+        (backward-sexp 1)
+        (current-column)))
+     ;;
+     ;; comment
+     ;;
+     ((looking-at "--")
+      (if ada-indent-comment-as-code
+          prev-indent
+        (current-indentation)))
+     ;;
+     ;; unknown syntax - maybe this should signal an error ?
+     ;;
+     (t
+      prev-indent))))
+
+
+(defun ada-indent-function (&optional nomove)
+  ;; Returns the function to calculate the indentation for the current
+  ;; line according to the previous statement, ignoring the contents
+  ;; of the current line after point.  Moves point to the beginning of
+  ;; the current statement, if NOMOVE is nil.
+
+  (let ((orgpoint (point))
+        (func nil)
+        (stmt-start nil))
+    ;;
+    ;; inside a parameter-list
+    ;;
+    (if (ada-in-paramlist-p)
+        (setq func 'ada-get-indent-paramlist)
+      (progn
+        ;;
+        ;; move to beginning of current statement
+        ;;
+        (if (not nomove)
+            (setq stmt-start (ada-goto-stmt-start)))
+        ;;
+        ;; no beginning found => don't change indentation
+        ;;
+        (if (and
+             (eq orgpoint (point))
+             (not nomove))
+              (setq func 'ada-get-indent-nochange)
+
+          (cond
+           ;;
+           ((and
+             ada-indent-to-open-paren
+             (ada-in-open-paren-p))
+            (setq func 'ada-get-indent-open-paren))
+           ;;
+           ((looking-at "\\<end\\>")
+            (setq func 'ada-get-indent-end))
+           ;;
+           ((looking-at ada-loop-start-re)
+            (setq func 'ada-get-indent-loop))
+           ;;
+           ((looking-at ada-subprog-start-re)
+            (setq func 'ada-get-indent-subprog))
+           ;;
+           ((looking-at "\\<package\\>")
+            (setq func 'ada-get-indent-subprog)) ; maybe it needs a
+                                                 ; special function
+                                                 ; sometimes ?
+           ;;
+           ((looking-at ada-block-start-re)
+            (setq func 'ada-get-indent-block-start))
+           ;;
+           ((looking-at "\\<type\\>")
+            (setq func 'ada-get-indent-type))
+           ;;
+           ((looking-at "\\<\\(els\\)?if\\>")
+            (setq func 'ada-get-indent-if))
+           ;;
+           ((looking-at "\\<case\\>")
+            (setq func 'ada-get-indent-case))
+           ;;
+           ((looking-at "\\<when\\>")
+            (setq func 'ada-get-indent-when))
+           ;;
+           ((looking-at "--")
+            (setq func 'ada-get-indent-comment))
+           ;;
+           ((looking-at "[a-zA-Z0-9_]+[ \t\n]*:[^=]")
+            (setq func 'ada-get-indent-label))
+           ;;
+	   ((looking-at "\\<separate\\>")
+	    (setq func 'ada-get-indent-nochange))
+           (t
+            (setq func 'ada-get-indent-noindent))))))
+
+    func))
+
+
+;; ---- functions to return indentation for special cases
+
+(defun ada-get-indent-open-paren (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be behind an open paranthesis not yet closed.
+  (ada-in-open-paren-p))
+
+
+(defun ada-get-indent-nochange (orgpoint)
+  ;; Returns the indentation (column #) of the current line.
+  (save-excursion
+    (forward-line -1)
+    (current-indentation)))
+
+
+(defun ada-get-indent-paramlist (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be inside a parameter-list.
+  (save-excursion
+    (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
+    (cond
+     ;;
+     ;; in front of the first parameter
+     ;;
+     ((looking-at "(")
+      (goto-char (match-end 0))
+      (current-column))
+     ;;
+     ;; in front of another parameter
+     ;;
+     ((looking-at ";")
+      (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
+      (ada-goto-next-non-ws)
+      (current-column))
+     ;;
+     ;; inside a parameter declaration
+     ;;
+     (t
+      (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
+      (ada-goto-next-non-ws)
+      (+ (current-column) ada-broken-indent)))))
+
+
+(defun ada-get-indent-end (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be at the beginning of an end-statement.
+  ;; Therefore it has to find the corresponding start. This can be a little
+  ;; slow, if it has to search through big files with many nested blocks.
+  ;; Signals an error if the corresponding block-start doesn't match.
+  (let ((defun-name nil)
+        (indent nil))
+    ;;
+    ;; is the line already terminated by ';' ?
+    ;;
+    (if (save-excursion
+          (ada-search-ignore-string-comment ";" nil orgpoint))
+        ;;
+        ;; yes, look what's following 'end'
+        ;;
+        (progn
+          (forward-word 1)
+          (ada-goto-next-non-ws)
+          (cond
+           ;;
+           ;; loop/select/if/case/record/select
+           ;;
+           ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|record\\)\\>")
+            (save-excursion
+              (ada-check-matching-start
+               (buffer-substring (match-beginning 0)
+                                 (match-end 0)))
+              (if (looking-at "\\<\\(loop\\|record\\)\\>")
+                  (progn
+                    (forward-word 1)
+                    (ada-goto-stmt-start)))
+              ;; a label ? => skip it
+              (if (looking-at "[a-zA-Z0-9_]+[ \n\t]+:")
+                  (progn
+                    (goto-char (match-end 0))
+                    (ada-goto-next-non-ws)))
+              ;; really looking-at the right thing ?
+              (or (looking-at (concat "\\<\\("
+                                      "loop\\|select\\|if\\|case\\|"
+                                      "record\\|while\\|type\\)\\>"))
+                  (progn
+                    (ada-search-ignore-string-comment
+                     (concat "\\<\\("
+                             "loop\\|select\\|if\\|case\\|"
+                             "record\\|while\\|type\\)\\>")))
+                  (backward-word 1))
+              (current-indentation)))
+           ;;
+           ;; a named block end
+           ;;
+           ((looking-at ada-ident-re)
+            (setq defun-name (buffer-substring (match-beginning 0)
+                                               (match-end 0)))
+            (save-excursion
+              (ada-goto-matching-start 0)
+              (ada-check-defun-name defun-name)
+              (current-indentation)))
+           ;;
+           ;; a block-end without name
+           ;;
+           ((looking-at ";")
+            (save-excursion
+              (ada-goto-matching-start 0)
+              (if (looking-at "\\<begin\\>")
+                  (progn
+                    (setq indent (current-column))
+                    (if (ada-goto-matching-decl-start t)
+                        (current-indentation)
+                      indent)))))
+           ;;
+           ;; anything else - should maybe signal an error ?
+           ;;
+           (t
+            (+ (current-indentation) ada-broken-indent))))
+
+      (+ (current-indentation) ada-broken-indent))))
+
+
+(defun ada-get-indent-case (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be at the beginning of an case-statement.
+  (let ((cur-indent (current-indentation))
+        (match-cons nil)
+        (opos (point)))
+    (cond
+     ;;
+     ;; case..is..when..=>
+     ;;
+     ((save-excursion
+       (setq match-cons (ada-search-ignore-string-comment
+                         "[ \t\n]+=>" nil orgpoint)))
+      (save-excursion
+        (goto-char (car match-cons))
+        (if (not (ada-search-ignore-string-comment "\\<when\\>" t opos))
+            (error "missing 'when' between 'case' and '=>'"))
+        (+ (current-indentation) ada-indent)))
+     ;;
+     ;; case..is..when
+     ;;
+     ((save-excursion
+       (setq match-cons (ada-search-ignore-string-comment
+                         "\\<when\\>" nil orgpoint)))
+      (goto-char (cdr match-cons))
+      (+ (current-indentation) ada-broken-indent))
+     ;;
+     ;; case..is
+     ;;
+     ((save-excursion
+       (setq match-cons (ada-search-ignore-string-comment
+                         "\\<is\\>" nil orgpoint)))
+      (+ (current-indentation) ada-when-indent))
+     ;;
+     ;; incomplete case
+     ;;
+     (t
+      (+ (current-indentation) ada-broken-indent)))))
+
+
+(defun ada-get-indent-when (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be at the beginning of an when-statement.
+  (let ((cur-indent (current-indentation)))
+    (if (ada-search-ignore-string-comment
+         "[ \t\n]+=>" nil orgpoint)
+        (+ cur-indent  ada-indent)
+      (+ cur-indent ada-broken-indent))))
+
+
+(defun ada-get-indent-if (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be at the beginning of an if-statement.
+  (let ((cur-indent (current-indentation))
+        (match-cons nil))
+    ;;
+    ;; if..then ?
+    ;;
+    (if (ada-search-but-not
+         "\\<then\\>" "\\<and\\>[ \t\n]+\\<then\\>" nil orgpoint)
+
+        (progn
+          ;;
+          ;; 'then' first in separate line ?
+          ;; => indent according to 'then'
+          ;;
+          (if (save-excursion
+                (back-to-indentation)
+                (looking-at "\\<then\\>"))
+              (setq cur-indent (current-indentation)))
+          (forward-word 1)
+          ;;
+          ;; something follows 'then' ?
+          ;;
+          (if (setq match-cons
+                    (ada-search-ignore-string-comment
+                     "[^ \t\n]" nil orgpoint))
+              (progn
+                (goto-char (car match-cons))
+                (+ ada-indent
+                   (- cur-indent (current-indentation))
+                   (funcall (ada-indent-function t) orgpoint)))
+
+            (+ cur-indent ada-indent)))
+
+      (+ cur-indent ada-broken-indent))))
+
+
+(defun ada-get-indent-block-start (orgpoint)
+  ;; Returns the indentation (column #) for the new line after
+  ;; ORGPOINT.  Assumes point to be at the beginning of a block start
+  ;; keyword.
+  (let ((cur-indent (current-indentation))
+        (pos nil))
+    (cond
+     ((save-excursion
+        (forward-word 1)
+        (setq pos (car (ada-search-ignore-string-comment
+                        "[^ \t\n]" nil orgpoint))))
+      (goto-char pos)
+      (save-excursion
+        (funcall (ada-indent-function t) orgpoint)))
+     ;;
+     ;; nothing follows the block-start
+     ;;
+     (t
+      (+ (current-indentation) ada-indent)))))
+
+
+(defun ada-get-indent-subprog (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be at the beginning of a subprog-/package-declaration.
+  (let ((match-cons nil)
+        (cur-indent (current-indentation))
+        (foundis nil)
+        (addind 0)
+        (fstart (point)))
+    ;;
+    ;; is there an 'is' in front of point ?
+    ;;
+    (if (save-excursion
+          (setq match-cons
+                (ada-search-ignore-string-comment
+                 "\\<is\\>\\|\\<do\\>" nil orgpoint)))
+        ;;
+        ;; yes, then skip to its end
+        ;;
+        (progn
+          (setq foundis t)
+          (goto-char (cdr match-cons)))
+      ;;
+      ;; no, then goto next non-ws, if there is one in front of point
+      ;;
+      (progn
+        (if (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)
+            (ada-goto-next-non-ws)
+          (goto-char orgpoint))))
+
+    (cond
+     ;;
+     ;; nothing follows 'is'
+     ;;
+     ((and
+       foundis
+       (save-excursion
+         (not (ada-search-ignore-string-comment
+               "[^ \t\n]" nil orgpoint t))))
+      (+ cur-indent ada-indent))
+     ;;
+     ;; is abstract/separate/new ...
+     ;;
+     ((and
+       foundis
+       (save-excursion
+         (setq match-cons
+               (ada-search-ignore-string-comment
+                "\\<\\(separate\\|new\\|abstract\\)\\>"
+                nil orgpoint))))
+      (goto-char (car match-cons))
+      (ada-search-ignore-string-comment (concat ada-subprog-start-re
+                                                "\\|\\<package\\>") t)
+      (ada-get-indent-noindent orgpoint))
+     ;;
+     ;; something follows 'is'
+     ;;
+     ((and
+       foundis
+       (save-excursion
+         (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
+       (ada-goto-next-non-ws)
+      (funcall (ada-indent-function t) orgpoint)))
+     ;;
+     ;; no 'is' but ';'
+     ;;
+     ((save-excursion
+        (ada-search-ignore-string-comment ";" nil orgpoint))
+      cur-indent)
+     ;;
+     ;; no 'is' or ';'
+     ;;
+     (t
+      (+ cur-indent ada-broken-indent)))))
+
+
+(defun ada-get-indent-noindent (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be at the beginning of a 'noindent statement'.
+  (if (save-excursion
+        (ada-search-ignore-string-comment ";" nil orgpoint))
+      (current-indentation)
+    (+ (current-indentation) ada-broken-indent)))
+
+
+(defun ada-get-indent-label (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be at the beginning of a label or variable declaration.
+  ;; Checks the context to decide if it's a label or a variable declaration.
+  ;; This check might be a bit slow.
+  (let ((match-cons nil)
+        (cur-indent (current-indentation)))
+    (goto-char (cdr (ada-search-ignore-string-comment ":")))
+    (cond
+     ;;
+     ;; loop label
+     ;;
+     ((save-excursion
+        (setq match-cons (ada-search-ignore-string-comment
+                          ada-loop-start-re nil orgpoint)))
+      (goto-char (car match-cons))
+      (ada-get-indent-loop orgpoint))
+     ;;
+     ;; declare label
+     ;;
+     ((save-excursion
+        (setq match-cons (ada-search-ignore-string-comment
+                          "\\<declare\\>" nil orgpoint)))
+      (save-excursion
+        (goto-char (car match-cons))
+        (+ (current-indentation) ada-indent)))
+     ;;
+     ;; complete statement following colon
+     ;;
+     ((save-excursion
+        (ada-search-ignore-string-comment ";" nil orgpoint))
+      (if (ada-in-decl-p)
+          cur-indent                      ; variable-declaration
+        (- cur-indent ada-label-indent))) ; label
+     ;;
+     ;; broken statement
+     ;;
+     ((save-excursion
+        (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
+      (if (ada-in-decl-p)
+          (+ cur-indent ada-broken-indent)
+        (+ cur-indent ada-broken-indent (- ada-label-indent))))
+     ;;
+     ;; nothing follows colon
+     ;;
+     (t
+      (if (ada-in-decl-p)
+          (+ cur-indent ada-broken-indent)   ; variable-declaration
+        (- cur-indent ada-label-indent)))))) ; label
+
+
+(defun ada-get-indent-loop (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be at the beginning of a loop statement
+  ;; or (unfortunately) also a for ... use statement.
+  (let ((match-cons nil)
+        (pos (point)))
+    (cond
+
+     ;;
+     ;; statement complete
+     ;;
+     ((save-excursion
+        (ada-search-ignore-string-comment ";" nil orgpoint))
+      (current-indentation))
+     ;;
+     ;; simple loop
+     ;;
+     ((looking-at "loop\\>")
+      (ada-get-indent-block-start orgpoint))
+
+     ;;
+     ;; 'for'- loop (or also a for ... use statement)
+     ;;
+     ((looking-at "for\\>")
+      (cond
+       ;;
+       ;; for ... use
+       ;;
+       ((save-excursion
+          (and
+           (goto-char (match-end 0))
+           (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
+           (not (backward-char 1))
+           (not (zerop (skip-chars-forward "_a-zA-Z0-9'")))
+           (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
+           (not (backward-char 1))
+           (looking-at "\\<use\\>")
+           ;;
+           ;; check if there is a 'record' before point
+           ;;
+           (progn
+             (setq match-cons (ada-search-ignore-string-comment
+                               "\\<record\\>" nil orgpoint))
+             t)))
+        (if match-cons
+            (goto-char (car match-cons)))
+        (+ (current-indentation) ada-indent))
+       ;;
+       ;; for..loop
+       ;;
+       ((save-excursion
+          (setq match-cons (ada-search-ignore-string-comment
+                            "\\<loop\\>" nil orgpoint)))
+        (goto-char (car match-cons))
+        ;;
+        ;; indent according to 'loop', if it's first in the line;
+        ;; otherwise to 'for'
+        ;;
+        (if (not (save-excursion
+                   (back-to-indentation)
+                   (looking-at "\\<loop\\>")))
+            (goto-char pos))
+        (+ (current-indentation) ada-indent))
+       ;;
+       ;; for-statement is broken
+       ;;
+       (t
+        (+ (current-indentation) ada-broken-indent))))
+
+     ;;
+     ;; 'while'-loop
+     ;;
+     ((looking-at "while\\>")
+      ;;
+      ;; while..loop ?
+      ;;
+      (if (save-excursion
+            (setq match-cons (ada-search-ignore-string-comment
+                              "\\<loop\\>" nil orgpoint)))
+
+          (progn
+            (goto-char (car match-cons))
+            ;;
+            ;; indent according to 'loop', if it's first in the line;
+            ;; otherwise to 'while'.
+            ;;
+            (if (not (save-excursion
+                       (back-to-indentation)
+                       (looking-at "\\<loop\\>")))
+                (goto-char pos))
+            (+ (current-indentation) ada-indent))
+
+        (+ (current-indentation) ada-broken-indent))))))
+
+
+(defun ada-get-indent-type (orgpoint)
+  ;; Returns the indentation (column #) for the new line after ORGPOINT.
+  ;; Assumes point to be at the beginning of a type statement.
+  (let ((match-dat nil))
+    (cond
+     ;;
+     ;; complete record declaration
+     ;;
+     ((save-excursion
+        (and
+         (setq match-dat (ada-search-ignore-string-comment "\\<end\\>"
+                                                           nil
+                                                           orgpoint))
+         (ada-goto-next-non-ws)
+         (looking-at "\\<record\\>")
+         (forward-word 1)
+         (ada-goto-next-non-ws)
+         (looking-at ";")))
+      (goto-char (car match-dat))
+      (current-indentation))
+     ;;
+     ;; record type
+     ;;
+     ((save-excursion
+        (setq match-dat (ada-search-ignore-string-comment "\\<record\\>"
+                                                          nil
+                                                          orgpoint)))
+      (goto-char (car match-dat))
+      (+ (current-indentation) ada-indent))
+     ;;
+     ;; complete type declaration
+     ;;
+     ((save-excursion
+        (ada-search-ignore-string-comment ";" nil orgpoint))
+      (current-indentation))
+     ;;
+     ;; "type ... is", but not "type ... is ...", which is broken
+     ;;
+     ((save-excursion
+	(and
+	 (ada-search-ignore-string-comment "\\<is\\>" nil orgpoint)
+	 (not (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))))
+      (+ (current-indentation) ada-indent))
+     ;;
+     ;; broken statement
+     ;;
+     (t
+      (+ (current-indentation) ada-broken-indent)))))
+
+
+;;; ---- support-functions for indentation
+
+;;; ---- searching and matching
+
+(defun ada-goto-stmt-start (&optional limit)
+  ;; Moves point to the beginning of the statement that point is in or
+  ;; after.  Returns the new position of point.  Beginnings are found
+  ;; by searching for 'ada-end-stmt-re' and then moving to the
+  ;; following non-ws that is not a comment.  LIMIT is actually not
+  ;; used by the indentation functions.
+  (let ((match-dat nil)
+        (orgpoint (point)))
+
+    (setq match-dat (ada-search-prev-end-stmt limit))
+    (if match-dat
+        ;;
+        ;; found a previous end-statement => check if anything follows
+        ;;
+        (progn
+          (if (not
+               (save-excursion
+                 (goto-char (cdr match-dat))
+                 (ada-search-ignore-string-comment
+                  "[^ \t\n]" nil orgpoint)))
+              ;;
+              ;; nothing follows => it's the end-statement directly in
+              ;;                    front of point => search again
+              ;;
+              (setq match-dat (ada-search-prev-end-stmt limit)))
+          ;;
+          ;; if found the correct end-stetement => goto next non-ws
+          ;;
+          (if match-dat
+              (goto-char (cdr match-dat)))
+          (ada-goto-next-non-ws))
+
+      ;;
+      ;; no previous end-statement => we are at the beginning of the
+      ;;                              accessible part of the buffer
+      ;;
+      (progn
+        (goto-char (point-min))
+        ;;
+        ;; skip to the very first statement, if there is one
+        ;;
+        (if (setq match-dat
+                  (ada-search-ignore-string-comment
+                   "[^ \t\n]" nil orgpoint))
+            (goto-char (car match-dat))
+          (goto-char orgpoint))))
+
+
+    (point)))
+
+
+(defun ada-search-prev-end-stmt (&optional limit)
+  ;; Moves point to previous end-statement.  Returns a cons cell whose
+  ;; car is the beginning and whose cdr the end of the match.
+  ;; End-statements are defined by 'ada-end-stmt-re'.  Checks for
+  ;; certain keywords if they follow 'end', which means they are no
+  ;; end-statement there.
+  (let ((match-dat nil)
+        (pos nil)
+        (found nil))
+    ;;
+    ;; search until found or beginning-of-buffer
+    ;;
+    (while
+        (and
+         (not found)
+         (setq match-dat (ada-search-ignore-string-comment ada-end-stmt-re
+                                                           t
+                                                           limit)))
+
+      (goto-char (car match-dat))
+
+      (if (not (ada-in-open-paren-p))
+          ;;
+          ;; check if there is an 'end' in front of the match
+          ;;
+          (if (not (and
+                    (looking-at "\\<\\(record\\|loop\\|select\\)\\>")
+                    (save-excursion
+                      (ada-goto-previous-word)
+                      (looking-at "\\<end\\>"))))
+              (setq found t)
+
+            (backward-word 1)))) ; end of loop
+
+    (if found
+        match-dat
+      nil)))
+
+
+(defun ada-goto-next-non-ws (&optional limit)
+  ;; Skips whitespaces, newlines and comments to next non-ws
+  ;; character.  Signals an error if there is no more such character
+  ;; and limit is nil.
+  (let ((match-cons nil))
+    (setq match-cons (ada-search-ignore-string-comment
+                      "[^ \t\n]" nil limit t))
+    (if match-cons
+        (goto-char (car match-cons))
+      (if (not limit)
+          (error "no more non-ws")
+        nil))))
+
+
+(defun ada-goto-stmt-end (&optional limit)
+  ;; Moves point to the end of the statement that point is in or
+  ;; before.  Returns the new position of point or nil if not found.
+  (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
+      (point)
+    nil))
+
+
+(defun ada-goto-previous-word ()
+  ;; Moves point to the beginning of the previous word of ada-code.
+  ;; Returns the new position of point or nil if not found.
+  (let ((match-cons nil)
+        (orgpoint (point)))
+    (if (setq match-cons
+              (ada-search-ignore-string-comment "[^ \t\n]" t nil t))
+        ;;
+        ;; move to the beginning of the word found
+        ;;
+        (progn
+          (goto-char (cdr match-cons))
+          (skip-chars-backward "_a-zA-Z0-9")
+          (point))
+      ;;
+      ;; if not found, restore old position of point
+      ;;
+      (progn
+        (goto-char orgpoint)
+        'nil))))
+
+
+(defun ada-check-matching-start (keyword)
+  ;; Signals an error if matching block start is not KEYWORD.
+  ;; Moves point to the matching block start.
+  (ada-goto-matching-start 0)
+  (if (not (looking-at (concat "\\<" keyword "\\>")))
+      (error (concat
+              "matching start is not '"
+              keyword "'"))))
+
+
+(defun ada-check-defun-name (defun-name)
+  ;; Checks if the name of the matching defun really is DEFUN-NAME.
+  ;; Assumes point to be already positioned by 'ada-goto-matching-start'.
+  ;; Moves point to the beginning of the declaration.
+
+  ;;
+  ;; 'accept' or 'package' ?
+  ;;
+  (if (not (looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>"))
+      (ada-goto-matching-decl-start))
+  ;;
+  ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
+  ;;
+  (save-excursion
+    ;;
+    ;; a named 'declare'-block ?
+    ;;
+    (if (looking-at "\\<declare\\>")
+        (ada-goto-stmt-start)
+      ;;
+      ;; no, => 'procedure'/'function'/'task'/'protected'
+      ;;
+      (progn
+        (forward-word 2)
+        (backward-word 1)
+        ;;
+        ;; skip 'body' 'protected' 'type'
+        ;;
+        (if (looking-at "\\<\\(body\\|type\\)\\>")
+            (forward-word 1))
+        (forward-sexp 1)
+        (backward-sexp 1)))
+    ;;
+    ;; should be looking-at the correct name
+    ;;
+    (if (not (looking-at (concat "\\<" defun-name "\\>")))
+        (error
+         (concat
+          "matching defun has different name: "
+          (buffer-substring
+           (point)
+           (progn
+             (forward-sexp 1)
+             (point))))))))
+
+
+(defun ada-goto-matching-decl-start (&optional noerror nogeneric)
+  ;; Moves point to the matching declaration start of the current 'begin'.
+  ;; If NOERROR is non-nil, it only returns nil if no match was found.
+  (let ((nest-count 1)
+        (pos nil)
+        (first t)
+        (flag nil))
+    ;;
+    ;; search backward for interesting keywords
+    ;;
+    (while (and
+            (not (zerop nest-count))
+            (ada-search-ignore-string-comment
+             (concat "\\<\\("
+                     "is\\|separate\\|end\\|declare\\|new\\|begin\\|generic"
+                     "\\)\\>") t))
+      ;;
+      ;; calculate nest-depth
+      ;;
+      (cond
+       ;;
+       ((looking-at "end")
+        (ada-goto-matching-start 1 noerror)
+        (if (looking-at "begin")
+            (setq nest-count (1+ nest-count))))
+       ;;
+       ((looking-at "declare\\|generic")
+        (setq nest-count (1- nest-count))
+        (setq first nil))
+       ;;
+       ((looking-at "is")
+        ;; check if it is only a type definition
+        (if (save-excursion
+              (ada-goto-previous-word)
+              (skip-chars-backward "a-zA-Z0-9_.'")
+              (if (save-excursion
+                    (backward-char 1)
+                    (looking-at ")"))
+                  (progn
+                    (forward-char 1)
+                    (backward-sexp 1)
+                    (skip-chars-backward "a-zA-Z0-9_.'")
+                    ))
+              (ada-goto-previous-word)
+              (looking-at "\\<type\\>")) ; end of save-excursion
+            (goto-char (match-beginning 0))
+          (progn
+            (setq nest-count (1- nest-count))
+            (setq first nil))))
+
+       ;;
+       ((looking-at "new")
+        (if (save-excursion
+              (ada-goto-previous-word)
+              (looking-at "is"))
+            (goto-char (match-beginning 0))))
+       ;;
+       ((and first
+             (looking-at "begin"))
+        (setq nest-count 0)
+        (setq flag t))
+       ;;
+       (t
+        (setq nest-count (1+ nest-count))
+        (setq first nil)))
+
+      )  ;; end of loop
+
+    ;; check if declaration-start is really found
+    (if (not
+         (and
+          (zerop nest-count)
+          (not flag)
+          (progn
+            (if (looking-at "is")
+                  (ada-search-ignore-string-comment
+                   ada-subprog-start-re t)
+              (looking-at "declare\\|generic")))))
+        (if noerror nil
+          (error "no matching procedure/function/task/declare/package"))
+      t)))
+
+
+(defun ada-goto-matching-start (&optional nest-level noerror gotothen)
+  ;; Moves point to the beginning of a block-start.  Which block
+  ;; depends on the value of NEST-LEVEL, which defaults to zero.  If
+  ;; NOERROR is non-nil, it only returns nil if no matching start was
+  ;; found.  If GOTOTHEN is non-nil, point moves to the 'then'
+  ;; following 'if'.
+  (let ((nest-count (if nest-level nest-level 0))
+        (found nil)
+        (pos nil))
+
+    ;;
+    ;; search backward for interesting keywords
+    ;;
+    (while (and
+            (not found)
+            (ada-search-ignore-string-comment
+             (concat "\\<\\("
+                     "end\\|loop\\|select\\|begin\\|case\\|do\\|"
+                     "if\\|task\\|package\\|record\\|protected\\)\\>")
+             t))
+
+      ;;
+      ;; calculate nest-depth
+      ;;
+      (cond
+       ;; found block end => increase nest depth
+       ((looking-at "end")
+        (setq nest-count (1+ nest-count)))
+       ;; found loop/select/record/case/if => check if it starts or
+       ;; ends a block
+       ((looking-at "loop\\|select\\|record\\|case\\|if")
+        (setq pos (point))
+        (save-excursion
+          ;;
+          ;; check if keyword follows 'end'
+          ;;
+          (ada-goto-previous-word)
+          (if (looking-at "\\<end\\>")
+              ;; it ends a block => increase nest depth
+              (progn
+                (setq nest-count (1+ nest-count))
+                (setq pos (point)))
+            ;; it starts a block => decrease nest depth
+            (setq nest-count (1- nest-count))))
+        (goto-char pos))
+       ;; found package start => check if it really is a block
+       ((looking-at "package")
+        (save-excursion
+          (ada-search-ignore-string-comment "\\<is\\>")
+          (ada-goto-next-non-ws)
+          ;; ignore it if it is only a declaration with 'new'
+          (if (not (looking-at "\\<new\\>"))
+              (setq nest-count (1- nest-count)))))
+       ;; found task start => check if it has a body
+       ((looking-at "task")
+        (save-excursion
+          (forward-word 1)
+          (ada-goto-next-non-ws)
+          ;; ignore it if it has no body
+          (if (not (looking-at "\\<body\\>"))
+              (setq nest-count (1- nest-count)))))
+       ;; all the other block starts
+       (t
+        (setq nest-count (1- nest-count)))) ; end of 'cond'
+
+      ;; match is found, if nest-depth is zero
+      ;;
+      (setq found (zerop nest-count))) ; end of loop
+
+    (if found
+        ;;
+        ;; match found => is there anything else to do ?
+        ;;
+        (progn
+          (cond
+           ;;
+           ;; found 'if' => skip to 'then', if it's on a separate line
+           ;;                               and GOTOTHEN is non-nil
+           ;;
+           ((and
+             gotothen
+             (looking-at "if")
+             (save-excursion
+               (ada-search-ignore-string-comment "\\<then\\>" nil nil)
+               (back-to-indentation)
+               (looking-at "\\<then\\>")))
+            (goto-char (match-beginning 0)))
+           ;;
+           ;; found 'do' => skip back to 'accept'
+           ;;
+           ((looking-at "do")
+            (if (not (ada-search-ignore-string-comment "\\<accept\\>" t nil))
+                (error "missing 'accept' in front of 'do'"))))
+          (point))
+
+      (if noerror
+          nil
+        (error "no matching start")))))
+
+
+(defun ada-goto-matching-end (&optional nest-level noerror)
+  ;; Moves point to the end of a block.  Which block depends on the
+  ;; value of NEST-LEVEL, which defaults to zero.  If NOERROR is
+  ;; non-nil, it only returns nil if found no matching start.
+  (let ((nest-count (if nest-level nest-level 0))
+        (found nil))
+
+    ;;
+    ;; search forward for interesting keywords
+    ;;
+    (while (and
+            (not found)
+            (ada-search-ignore-string-comment
+             (concat "\\<\\(end\\|loop\\|select\\|begin\\|case\\|"
+                     "if\\|task\\|package\\|record\\|do\\)\\>")))
+
+      ;;
+      ;; calculate nest-depth
+      ;;
+      (backward-word 1)
+      (cond
+       ;; found block end => decrease nest depth
+       ((looking-at "\\<end\\>")
+        (setq nest-count (1- nest-count))
+        ;; skip the following keyword
+        (if (progn
+              (skip-chars-forward "end")
+              (ada-goto-next-non-ws)
+              (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
+            (forward-word 1)))
+       ;; found package start => check if it really starts a block
+       ((looking-at "\\<package\\>")
+        (ada-search-ignore-string-comment "\\<is\\>")
+        (ada-goto-next-non-ws)
+        ;; ignore and skip it if it is only a 'new' package
+        (if (not (looking-at "\\<new\\>"))
+            (setq nest-count (1+ nest-count))
+          (skip-chars-forward "new")))
+       ;; all the other block starts
+       (t
+        (setq nest-count (1+ nest-count))
+        (forward-word 1))) ; end of 'cond'
+
+      ;; match is found, if nest-depth is zero
+      ;;
+      (setq found (zerop nest-count))) ; end of loop
+
+    (if (not found)
+        (if noerror
+            nil
+          (error "no matching end"))
+      t)))
+
+
+(defun ada-forward-sexp-ignore-comment ()
+  ;; Skips one sexp forward, ignoring comments.
+  (while (looking-at "[ \t\n]*--")
+    (skip-chars-forward "[ \t\n]")
+    (end-of-line))
+  (forward-sexp 1))
+
+
+(defun ada-search-ignore-string-comment
+  (search-re &optional backward limit paramlists)
+  ;; Regexp-Search for SEARCH-RE, ignoring comments, strings and
+  ;; parameter lists, if PARAMLISTS is nil. Returns a cons cell of
+  ;; begin and end of match data or nil, if not found.
+  (let ((found nil)
+        (begin nil)
+        (end nil)
+        (pos nil)
+        (search-func
+         (if backward 're-search-backward
+           're-search-forward)))
+
+    ;;
+    ;; search until found or end-of-buffer
+    ;;
+    (while (and (not found)
+                (funcall search-func search-re limit 1))
+      (setq begin (match-beginning 0))
+      (setq end (match-end 0))
+
+      (cond
+       ;;
+       ;; found in comment => skip it
+       ;;
+       ((ada-in-comment-p)
+        (if backward
+            (progn
+              (re-search-backward "--" nil 1)
+              (goto-char (match-beginning 0)))
+          (progn
+            (forward-line 1)
+            (beginning-of-line))))
+       ;;
+       ;; found in string => skip it
+       ;;
+       ((ada-in-string-p)
+        (if backward
+            (progn
+              (re-search-backward "\"" nil 1) ; "\"\\|#" don't treat #
+              (goto-char (match-beginning 0))))
+        (re-search-forward "\"" nil 1))
+       ;;
+       ;; found character constant => ignore it
+       ;;
+       ((save-excursion
+          (setq pos (- (point) (if backward 1 2)))
+          (and (char-after pos)
+               (= (char-after pos) ?')
+               (= (char-after (+ pos 2)) ?')))
+        ())
+       ;;
+       ;; found a parameter-list but should ignore it => skip it
+       ;;
+       ((and (not paramlists)
+             (ada-in-paramlist-p))
+        (if backward
+            (ada-search-ignore-string-comment "(" t nil t)))
+       ;;
+       ;; directly in front of a comment => skip it, if searching forward
+       ;;
+       ((save-excursion
+          (goto-char begin)
+          (looking-at "--"))
+        (if (not backward)
+            (progn
+              (forward-line 1)
+              (beginning-of-line))))
+       ;;
+       ;; found what we were looking for
+       ;;
+       (t
+        (setq found t)))) ; end of loop
+
+    (if found
+        (cons begin end)
+      nil)))
+
+
+(defun ada-search-but-not (search-re not-search-re &optional backward limit)
+  ;; Searches SEARCH-RE, ignoring parts of NOT-SEARCH-RE, strings,
+  ;; comments and parameter-lists.
+  (let ((begin nil)
+        (end nil)
+        (begin-not nil)
+        (begin-end nil)
+        (end-not nil)
+        (ret-cons nil)
+        (found nil))
+
+    ;;
+    ;; search until found or end-of-buffer
+    ;;
+    (while (and
+            (not found)
+            (save-excursion
+              (setq ret-cons
+                    (ada-search-ignore-string-comment search-re
+                                                      backward limit))
+              (if (consp ret-cons)
+                  (progn
+                    (setq begin (car ret-cons))
+                    (setq end (cdr ret-cons))
+                    t)
+                nil)))
+
+      (if (or
+           ;;
+           ;; if no NO-SEARCH-RE was found
+           ;;
+           (not
+            (save-excursion
+              (setq ret-cons
+                    (ada-search-ignore-string-comment not-search-re
+                                                      backward nil))
+              (if (consp ret-cons)
+                  (progn
+                    (setq begin-not (car ret-cons))
+                    (setq end-not (cdr ret-cons))
+                    t)
+                nil)))
+           ;;
+           ;;  or this NO-SEARCH-RE is not a part of the SEARCH-RE
+           ;;  found before.
+           ;;
+           (or
+            (<= end-not begin)
+            (>= begin-not end)))
+
+          (setq found t)
+
+        ;;
+        ;; not found the correct match => skip this match
+        ;;
+        (goto-char (if backward
+                       begin
+                     end)))) ; end of loop
+
+    (if found
+        (progn
+          (goto-char begin)
+          (cons begin end))
+      nil)))
+
+
+(defun ada-goto-prev-nonblank-line ( &optional ignore-comment)
+  ;; Moves point to the beginning of previous non-blank line,
+  ;; ignoring comments if IGNORE-COMMENT is non-nil.
+  ;; It returns t if a matching line was found.
+  (let ((notfound t)
+        (newpoint nil))
+
+    (save-excursion
+      ;;
+      ;; backward one line, if there is one
+      ;;
+      (if (zerop (forward-line -1))
+          ;;
+          ;; there is some kind of previous line
+          ;;
+          (progn
+            (beginning-of-line)
+            (setq newpoint (point))
+
+            ;;
+            ;; search until found or beginning-of-buffer
+            ;;
+            (while (and (setq notfound
+                              (or (looking-at "[ \t]*$")
+                                  (and (looking-at "[ \t]*--")
+                                       ignore-comment)))
+                        (not (ada-in-limit-line-p)))
+              (forward-line -1)
+              ;;(beginning-of-line)
+              (setq newpoint (point))) ; end of loop
+
+            )) ; end of if
+
+      ) ; end of save-excursion
+
+    (if notfound nil
+      (progn
+        (goto-char newpoint)
+        t))))
+
+
+(defun ada-goto-next-nonblank-line ( &optional ignore-comment)
+  ;; Moves point to next non-blank line,
+  ;; ignoring comments if IGNORE-COMMENT is non-nil.
+  ;; It returns t if a matching line was found.
+  (let ((notfound t)
+        (newpoint nil))
+
+    (save-excursion
+    ;;
+    ;; forward one line
+    ;;
+      (if (zerop (forward-line 1))
+          ;;
+          ;; there is some kind of previous line
+          ;;
+          (progn
+            (beginning-of-line)
+            (setq newpoint (point))
+
+            ;;
+            ;; search until found or end-of-buffer
+            ;;
+            (while (and (setq notfound
+                              (or (looking-at "[ \t]*$")
+                                  (and (looking-at "[ \t]*--")
+                                       ignore-comment)))
+                        (not (ada-in-limit-line-p)))
+              (forward-line 1)
+              (beginning-of-line)
+              (setq newpoint (point))) ; end of loop
+
+            )) ; end of if
+
+      ) ; end of save-excursion
+
+    (if notfound nil
+      (progn
+        (goto-char newpoint)
+        t))))
+
+
+;; ---- boolean functions for indentation
+
+(defun ada-in-decl-p ()
+  ;; Returns t if point is inside a declarative part.
+  ;; Assumes point to be at the end of a statement.
+  (or
+   (ada-in-paramlist-p)
+   (save-excursion
+     (ada-goto-matching-decl-start t))))
+
+
+(defun ada-looking-at-semi-or ()
+  ;; Returns t if looking-at an 'or' following a semicolon.
+  (save-excursion
+    (and (looking-at "\\<or\\>")
+         (progn
+           (forward-word 1)
+           (ada-goto-stmt-start)
+           (looking-at "\\<or\\>")))))
+
+
+(defun ada-looking-at-semi-private ()
+  ;; Returns t if looking-at an 'private' following a semicolon.
+  (save-excursion
+    (and (looking-at "\\<private\\>")
+         (progn
+           (forward-word 1)
+           (ada-goto-stmt-start)
+           (looking-at "\\<private\\>")))))
+
+
+;;; make a faster??? ada-in-limit-line-p not using count-lines
+(defun ada-in-limit-line-p ()
+  ;; return t if point is in first or last accessible line.
+  (or (save-excursion (beginning-of-line) (= (point-min) (point)))
+      (save-excursion (end-of-line) (= (point-max) (point)))))
+
+
+(defun ada-in-comment-p ()
+  ;; Returns t if inside a comment.
+  (save-excursion (and (re-search-backward "\\(--\\|\n\\)" nil 1)
+                       (looking-at "-"))))
+
+
+(defun ada-in-string-p ()
+  ;; Returns t if point is inside a string
+  ;; (Taken from pascal-mode.el, modified by MH).
+  (save-excursion
+    (and
+     (nth 3 (parse-partial-sexp
+             (save-excursion
+               (beginning-of-line)
+               (point)) (point)))
+     ;; check if 'string quote' is only a character constant
+     (progn
+       (re-search-backward "\"" nil t) ; # not a string delimiter anymore
+       (not (= (char-after (1- (point))) ?'))))))
+
+
+(defun ada-in-string-or-comment-p ()
+  ;; Returns t if point is inside a string or a comment.
+  (or (ada-in-comment-p)
+      (ada-in-string-p)))
+
+
+(defun ada-in-paramlist-p ()
+  ;; Returns t if point is inside a parameter-list
+  ;; following 'function'/'procedure'/'package'.
+  (save-excursion
+    (and
+     (re-search-backward "(\\|)" nil t)
+     ;; inside parentheses ?
+     (looking-at "(")
+     (backward-word 2)
+     ;; right keyword before paranthesis ?
+     (looking-at (concat "\\<\\("
+                         "procedure\\|function\\|body\\|package\\|"
+                         "task\\|entry\\|accept\\)\\>"))
+     (re-search-forward ")\\|:" nil t)
+     ;; at least one ':' inside the parentheses ?
+     (not (backward-char 1))
+     (looking-at ":"))))
+
+
+;; not really a boolean function ...
+(defun ada-in-open-paren-p ()
+  ;; If point is somewhere behind an open parenthesis not yet closed,
+  ;; it returns the column # of the first non-ws behind this open
+  ;; parenthesis, otherwise nil."
+
+  (let ((start (if (< (point) ada-search-paren-char-count-limit)
+                   1
+                 (- (point) ada-search-paren-char-count-limit)))
+        parse-result
+        (col nil))
+    (setq parse-result (parse-partial-sexp start (point)))
+    (if (nth 1 parse-result)
+        (save-excursion
+          (goto-char (1+ (nth 1 parse-result)))
+          (if (save-excursion
+                (re-search-forward "[^ \t]" nil 1)
+                (backward-char 1)
+                (and
+                 (not (looking-at "\n"))
+                 (setq col (current-column))))
+              col
+            (current-column)))
+      nil)))
+
+
+
+;;;----------------------;;;
+;;; Behaviour Of TAB Key ;;;
+;;;----------------------;;;
+
+(defun ada-tab ()
+  "Do indenting or tabbing according to `ada-tab-policy'."
+  (interactive)
+  (cond ((eq ada-tab-policy 'indent-and-tab) (error "not implemented"))
+        ;; ada-indent-and-tab
+        ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
+        ((eq ada-tab-policy 'indent-auto) (ada-indent-current))
+        ((eq ada-tab-policy 'gei) (ada-tab-gei))
+        ((eq ada-tab-policy 'indent-af) (af-indent-line)) ; GEB
+        ((eq ada-tab-policy 'always-tab) (error "not implemented"))
+        ))
+
+
+(defun ada-untab (arg)
+  "Delete leading indenting according to `ada-tab-policy'."
+  (interactive "P")
+  (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard))
+        ((eq ada-tab-policy 'indent-af) (backward-delete-char-untabify ; GEB
+                                         (prefix-numeric-value arg) ; GEB
+                                         arg)) ; GEB
+        ((eq ada-tab-policy 'indent-auto) (error "not implemented"))
+        ((eq ada-tab-policy 'always-tab) (error "not implemented"))
+        ))
+
+
+(defun ada-indent-current-function ()
+  "Ada Mode version of the indent-line-function."
+  (interactive "*")
+  (let ((starting-point (point-marker)))
+    (ada-beginning-of-line)
+    (ada-tab)
+    (if (< (point) starting-point)
+        (goto-char starting-point))
+    (set-marker starting-point nil)
+    ))
+
+
+(defun ada-tab-hard ()
+  "Indent current line to next tab stop."
+  (interactive)
+  (save-excursion
+    (beginning-of-line)
+    (insert-char ?  ada-indent))
+  (if (save-excursion (= (point) (progn (beginning-of-line) (point))))
+      (forward-char ada-indent)))
+
+
+(defun ada-untab-hard ()
+  "indent current line to previous tab stop."
+  (interactive)
+  (let  ((bol (save-excursion (progn (beginning-of-line) (point))))
+        (eol (save-excursion (progn (end-of-line) (point)))))
+    (indent-rigidly bol eol  (- 0 ada-indent))))
+
+
+
+;;;---------------;;;
+;;; Miscellaneous ;;;
+;;;---------------;;;
+
+(defun ada-remove-trailing-spaces  ()
+;; remove all trailing spaces at the end of lines.
+ "remove trailing spaces in the whole buffer."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward "[ \t]+$" nil t)
+      (replace-match "" nil nil))))
+
+
+(defun ada-untabify-buffer ()
+;; change all tabs to spaces
+  (save-excursion
+    (untabify (point-min) (point-max))))
+
+
+(defun ada-uncomment-region (beg end)
+  "delete comment-start at the beginning of a line in the region."
+  (interactive "r")
+  (comment-region beg end -1))
+
+
+;; define a function to support find-file.el if loaded
+(defun ada-ff-other-window ()
+  "Find other file in other window using ff-find-other-file."
+  (interactive)
+  (and (fboundp 'ff-find-other-file)
+       (ff-find-other-file t)))
+
+
+;;;-------------------------------;;;
+;;; Moving To Procedures/Packages ;;;
+;;;-------------------------------;;;
+
+(defun ada-next-procedure ()
+  "Moves point to next procedure."
+  (interactive)
+  (end-of-line)
+  (if (re-search-forward ada-procedure-start-regexp nil t)
+      (goto-char (match-beginning 1))
+    (error "No more functions/procedures/tasks")))
+
+(defun ada-previous-procedure ()
+  "Moves point to previous procedure."
+  (interactive)
+  (beginning-of-line)
+  (if (re-search-backward ada-procedure-start-regexp nil t)
+      (goto-char (match-beginning 1))
+    (error "No more functions/procedures/tasks")))
+
+(defun ada-next-package ()
+  "Moves point to next package."
+  (interactive)
+  (end-of-line)
+  (if (re-search-forward ada-package-start-regexp nil t)
+      (goto-char (match-beginning 1))
+    (error "No more packages")))
+
+(defun ada-previous-package ()
+  "Moves point to previous package."
+  (interactive)
+  (beginning-of-line)
+  (if (re-search-backward ada-package-start-regexp nil t)
+      (goto-char (match-beginning 1))
+    (error "No more packages")))
+
+
+;;;-----------------------
+;;; define keymap for Ada
+;;;-----------------------
+
+(if (not ada-mode-map)
+    (progn
+      (setq ada-mode-map (make-sparse-keymap))
+
+      ;; Indentation and Formatting
+      (define-key ada-mode-map "\C-j"     'ada-indent-newline-indent)
+      (define-key ada-mode-map "\t"       'ada-tab)
+      (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region)
+      (if (ada-xemacs)
+	  (define-key ada-mode-map '(shift tab)    'ada-untab)
+	(define-key ada-mode-map [S-tab]    'ada-untab))
+      (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist)
+      (define-key ada-mode-map "\C-c\C-p" 'ada-call-pretty-printer)
+;;; We don't want to make meta-characters case-specific.
+;;;   (define-key ada-mode-map "\M-Q"     'ada-fill-comment-paragraph-justify)
+      (define-key ada-mode-map "\M-\C-q"  'ada-fill-comment-paragraph-postfix)
+
+      ;; Movement
+;;; It isn't good to redefine these.  What should be done instead?  -- rms.
+;;;   (define-key ada-mode-map "\M-e"     'ada-next-package)
+;;;   (define-key ada-mode-map "\M-a"     'ada-previous-package)
+      (define-key ada-mode-map "\M-\C-e"  'ada-next-procedure)
+      (define-key ada-mode-map "\M-\C-a"  'ada-previous-procedure)
+      (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start)
+      (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end)
+
+      ;; Compilation
+      (define-key ada-mode-map "\C-c\C-c" 'compile)
+
+      ;; Casing
+      (define-key ada-mode-map "\C-c\C-r" 'ada-adjust-case-region)
+      (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer)
+
+      (define-key ada-mode-map "\177"     'backward-delete-char-untabify)
+
+      ;; Use predefined function of emacs19 for comments (RE)
+      (define-key ada-mode-map "\C-c;"    'comment-region)
+      (define-key ada-mode-map "\C-c:"    'ada-uncomment-region)
+
+      ;; Change basic functionality
+
+      ;; substitute-key-definition is not defined equally in GNU Emacs
+      ;; and XEmacs, you cannot put in an optional 4th parameter in
+      ;; XEmacs.  I don't think it's necessary, so I leave it out for
+      ;; GNU Emacs as well.  If you encounter any problems with the
+      ;; following three functions, please tell me. RE
+      (mapcar (function (lambda (pair)
+			  (substitute-key-definition (car pair) (cdr pair)
+						     ada-mode-map)))
+	      '((beginning-of-line      . ada-beginning-of-line)
+		(end-of-line            . ada-end-of-line)
+		(forward-to-indentation . ada-forward-to-indentation)
+		))
+      ;; else GNU Emacs
+      ;;(mapcar (lambda (pair)
+      ;;             (substitute-key-definition (car pair) (cdr pair)
+      ;;				   ada-mode-map global-map))
+
+      ))
+
+
+;;;-------------------
+;;; define menu 'Ada'
+;;;-------------------
+
+(require 'easymenu)
+
+(defun ada-add-ada-menu ()
+  "Adds the menu 'Ada' to the menu-bar in Ada Mode."
+  (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode."
+                    '("Ada"
+                      ["Next Package" ada-next-package t]
+                      ["Previous Package" ada-previous-package t]
+                      ["Next Procedure" ada-next-procedure t]
+                      ["Previous Procedure" ada-previous-procedure t]
+                      ["Goto Start" ada-move-to-start t]
+                      ["Goto End" ada-move-to-end t]
+                      ["------------------" nil nil]
+                      ["Indent Current Line (TAB)"
+                       ada-indent-current-function t]
+                      ["Indent Lines in Region" ada-indent-region t]
+                      ["Format Parameter List" ada-format-paramlist t]
+                      ["Pretty Print Buffer" ada-call-pretty-printer t]
+                      ["------------" nil nil]
+                      ["Fill Comment Paragraph"
+                       ada-fill-comment-paragraph t]
+                      ["Justify Comment Paragraph"
+                       ada-fill-comment-paragraph-justify t]
+                      ["Postfix Comment Paragraph"
+                       ada-fill-comment-paragraph-postfix t]
+                      ["------------" nil nil]
+                      ["Adjust Case Region" ada-adjust-case-region t]
+                      ["Adjust Case Buffer" ada-adjust-case-buffer t]
+                      ["----------" nil nil]
+                      ["Comment   Region" comment-region t]
+                      ["Uncomment Region" ada-uncomment-region t]
+                      ["----------------" nil nil]
+                      ["Compile" compile (fboundp 'compile)]
+                      ["Next Error" next-error (fboundp 'next-error)]
+                      ["---------------" nil nil]
+                      ["Index" imenu (fboundp 'imenu)]
+                      ["--------------" nil nil]
+                      ["Other File Other Window" ada-ff-other-window
+                       (fboundp 'ff-find-other-file)]
+                      ["Other File" ff-find-other-file
+                       (fboundp 'ff-find-other-file)]))
+  (if (ada-xemacs) (progn
+                     (easy-menu-add ada-mode-menu)
+                     (setq mode-popup-menu (cons "Ada Mode" ada-mode-menu)))))
+
+
+
+;;;-------------------------------
+;;; Define Some Support Functions
+;;;-------------------------------
+
+(defun ada-beginning-of-line (&optional arg)
+  (interactive "P")
+  (cond
+   ((eq ada-tab-policy 'indent-af) (af-beginning-of-line arg))
+   (t (beginning-of-line arg))
+   ))
+
+(defun ada-end-of-line (&optional arg)
+  (interactive "P")
+  (cond
+   ((eq ada-tab-policy 'indent-af) (af-end-of-line arg))
+   (t (end-of-line arg))
+   ))
+
+(defun ada-current-column ()
+  (cond
+   ((eq ada-tab-policy 'indent-af) (af-current-column))
+   (t (current-column))
+   ))
+
+(defun ada-forward-to-indentation (&optional arg)
+  (interactive "P")
+  (cond
+   ((eq ada-tab-policy 'indent-af) (af-forward-to-indentation arg))
+   (t (forward-to-indentation arg))
+   ))
+
+;;;---------------------------------------------------
+;;; support for find-file
+;;;---------------------------------------------------
+
+
+;;;###autoload
+(defun ada-make-filename-from-adaname (adaname)
+  "determine the filename of a package/procedure from its own Ada name."
+  ;; this is done simply by calling gkrunch, when we work with GNAT. It
+  ;; must be a more complex function in other compiler environments.
+  (interactive "s")
+
+  ;; things that should really be done by the external process
+  ;; since gnat-2.0, gnatk8 can do these things. If you still use a
+  ;; previous version, just uncomment the following lines.
+  (let (krunch-buf)
+    (setq krunch-buf (generate-new-buffer "*gkrunch*"))
+    (save-excursion
+      (set-buffer krunch-buf)
+;      (insert (downcase adaname))
+;      (goto-char (point-min))
+;      (while (search-forward "." nil t)
+;        (replace-match "-" nil t))
+;      (setq adaname (buffer-substring (point-min)
+;                                      (progn
+;                                        (goto-char (point-min))
+;                                        (end-of-line)
+;                                        (point))))
+;      ;; clean the buffer
+;      (delete-region (point-min) (point-max))
+      ;; send adaname to external process "gnatk8"
+      (call-process "gnatk8" nil krunch-buf nil
+                    adaname ada-krunch-args)
+      ;; fetch output of that process
+      (setq adaname (buffer-substring
+                     (point-min)
+                     (progn
+                       (goto-char (point-min))
+                       (end-of-line)
+                       (point))))
+      (kill-buffer krunch-buf)))
+  (setq adaname adaname) ;; can I avoid this statement?
+  )
+
+
+;;; functions for placing the cursor on the corresponding subprogram
+(defun ada-which-function-are-we-in ()
+  "Determine whether we are on a function definition/declaration and remember
+the name of that function."
+
+  (setq ff-function-name nil)
+
+  (save-excursion
+    (if (re-search-backward ada-procedure-start-regexp nil t)
+	(setq ff-function-name (buffer-substring (match-beginning 0)
+						 (match-end 0)))
+      ; we didn't find a procedure start, perhaps there is a package
+      (if (re-search-backward ada-package-start-regexp nil t)
+	  (setq ff-function-name (buffer-substring (match-beginning 0)
+						   (match-end 0)))
+	))))
+
+
+;;;---------------------------------------------------
+;;; support for imenu
+;;;---------------------------------------------------
+
+(defun imenu-create-ada-index (&optional regexp)
+  "create index alist for Ada files."
+  (let ((index-alist '())
+        prev-pos char)
+    (goto-char (point-min))
+    ;(imenu-progress-message prev-pos 0)
+    ;; Search for functions/procedures
+    (save-match-data
+     (while (re-search-forward
+             (or regexp ada-procedure-start-regexp)
+             nil t)
+       ;(imenu-progress-message prev-pos)
+       ;; do not store forward definitions
+       ;; right now we store them. We want to avoid them only in
+       ;; package bodies, not in the specs!! ???RE???
+       (save-match-data
+;        (if (not (looking-at (concat
+;                              "[ \t\n]*" ; WS
+;                              "\([^)]+\)" ; parameterlist
+;                              "\\([ \n\t]+return[ \n\t]+"; potential return
+;                              "[a-zA-Z0-9_\\.]+\\)?"
+;                              "[ \t]*" ; WS
+;                              ";"  ;; THIS is what we really look for
+;                              )))
+;            ; (push (imenu-example--name-and-position) index-alist)
+            (setq index-alist (cons (imenu-example--name-and-position)
+                        index-alist))
+;          )
+	)
+       ;(imenu-progress-message 100)
+       ))
+    (nreverse index-alist)))
+
+;;;---------------------------------------------------
+;;; support for font-lock
+;;;---------------------------------------------------
+
+;; 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
+   ;;
+   ;; accept, entry, function, package (body), protected (body|type),
+   ;; pragma, procedure, task (body) plus name.
+   (list (concat
+	  "\\<\\("
+	  "accept\\|"
+	  "entry\\|"
+	  "function\\|"
+	  "package\\|"
+	  "package[ \t]+body\\|"
+	  "procedure\\|"
+	  "protected\\|"
+	  "protected[ \t]+body\\|"
+	  "protected[ \t]+type\\|"
+;;	  "p\\(\\(ackage\\|rotected\\)\\(\\|[ \t]+\\(body\\|type\\)\\)\
+;;\\|r\\(agma\\|ocedure\\)\\)\\|"
+	  "task\\|"
+	  "task[ \t]+body\\|"
+	  "task[ \t]+type"
+;;	  "task\\(\\|[ \t]+body\\)"
+	  "\\)\\>[ \t]*"
+	  "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
+    '(1 font-lock-keyword-face) '(2 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\\|ut\\)\\|pr\\(ivate\\|otected\\)\\|"
+            "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
+            "se\\(lect\\|parate\\)\\|"
+            "t\\(agged\\|erminate\\|hen\\)\\|until\\|" ; task removed
+	    "wh\\(ile\\|en\\)\\|xor" ; "when" added
+            "\\)\\>")
+    ;;
+    ;; 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]*"
+;                 "\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*"
+;                 "\\(\\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]*"
+                  "\\<\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)\\>"
+                  "[ \t]*"
+                  "\\(\\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+\\)?[ \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 (comma separated list of) reference.
+    (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)\\>" ; "when" removed
+                  ; "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?") ; RE
+                  "[ \t]*\\([a-zA-Z0-9_\\.\\|, ]+\\)\\W")
+          '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
+    ;;
+    ;; Goto tags.
+    '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)
+    ))
+  "For consideration as a value of `ada-font-lock-keywords'.
+This does a lot more highlighting.")
+
+;(defconst ada-font-lock-keywords (purecopy
+;  (let ((ident  "\\(\\(\\sw\\|\\s_\\)+\\)") ; indent is 2nd capture
+;	(decl-1 "\\(procedure\\|function\\|package\\)[ \t]+") ; 1 ()
+;	(decl-2 "\\(task\\|package\\)[ \t]+body[ \t]+")	; 1()
+;	(kwords-1			; "normal" keywords
+;	 '("abort" "abs" "accept" "access" "array" "begin" "body" "case"
+;	   "constant" "declare" "delay" "delta" "digits" "else" "elsif"
+;	   "entry" "exception" "exit" "function"  "generic" "goto" "if"
+;	   "others" "limited" "loop" "mod" "new" "null" "out" "subtype"
+;	   "package" "pragma" "private" "procedure" "raise" "range" "record"
+;	   "rem" "renames" "return" "reverse" "select" "separate" "task"
+;	   "terminate" "then" "type" "when" "while" "with" "xor"))
+;	(kwords-2	; keywords that may appear at the end of a word AND
+;			; may also be preceeded by a non-space.
+;	 '("and" "at" "do" "end" "for" "in" "is" "not" "of" "or" "use"))
+;	)
+;    (list
+;     ;;'("\\(--.*\\)" 1 font-lock-comment-face t) ; syntax table should do this
+;     (list (concat "^[ \t]*" decl-2 ident) 3 'font-lock-function-name-face)
+;     (list (concat "^[ \t]*" decl-1 ident) 3 'font-lock-function-name-face)
+;     (cons (concat "\\(" (mapconcat 'identity kwords-1 "\\|") "\\)[ \n\t;(]")
+;	   1)
+;     (cons (concat "[ \t+=*/---]\\(" (mapconcat 'identity kwords-2 "\\|")
+;		   "\\)[ \n\t;(]")
+;	   1)
+;     (cons "^\\(end\\)[ \n\t;(]" 1)
+;     (cons "\\.\\(all\\)" 1)
+;     )))
+;  "Expressions to highlight in Ada buffers.")
+
+(defvar ada-font-lock-keywords (if font-lock-maximum-decoration
+				   ada-font-lock-keywords-2
+				 ada-font-lock-keywords-1)
+  "*Expressions to highlight in Ada mode.")
+
+(put 'ada-mode 'font-lock-defaults
+		'(ada-font-lock-keywords nil t ((?\_ . "w"))))
+
+;;;
+;;; ????
+;;;
+(defun ada-gen-comment-until-proc ()
+  ;; comment until spec of a procedure or a function.
+  (forward-line 1)
+  (set-mark-command (point))
+  (if (re-search-forward ada-procedure-start-regexp nil t)
+      (progn (goto-char (match-beginning 1))
+             (comment-region (mark) (point)))
+    (error "No more functions/procedures")))
+
+
+(defun ada-gen-treat-proc (match)
+  ;; make dummy body of a procedure/function specification.
+  ;; MATCH is a cons cell containing the start and end location of the
+  ;; last search for ada-procedure-start-regexp. 
+  (goto-char (car match))
+  (let (proc-found func-found)
+    (cond
+     ((or (setq proc-found (looking-at "^[ \t]*procedure"))
+	  (setq func-found (looking-at "^[ \t]*function")))
+      ;; treat it as a proc/func
+      (forward-word 2) 
+      (forward-word -1)
+      (setq procname (buffer-substring (point) (cdr match))) ; store  proc name
+
+    ;; goto end of procname
+    (goto-char (cdr match))
+
+    ;; skip over parameterlist
+    (forward-sexp)
+    ;; if function, skip over 'return' and result type.
+    (if func-found
+	(progn
+	  (forward-word 1)
+	  (skip-chars-forward " \t\n")
+	  (setq functype (buffer-substring (point)
+					   (progn 
+					     (skip-chars-forward
+					      "a-zA-Z0-9_\.")
+					     (point))))))
+    ;; look for next non WS
+    (cond
+     ((looking-at "[ \t]*;")
+      (delete-region (match-beginning 0) (match-end 0)) ;; delete the ';'
+      (ada-indent-newline-indent)
+      (insert " is")
+      (ada-indent-newline-indent)
+      (if func-found
+	  (progn
+	    (insert "Result : ")
+	    (insert functype)
+	    (insert ";")
+	    (ada-indent-newline-indent)))
+      (insert "begin -- ")
+      (insert procname)
+      (ada-indent-newline-indent)
+      (insert "null;")
+      (ada-indent-newline-indent)
+      (if func-found
+	  (progn
+	    (insert "return Result;")
+	    (ada-indent-newline-indent)))
+      (insert "end ")
+      (insert procname)
+      (insert ";")
+      (ada-indent-newline-indent)	
+      )
+      ;; else
+     ((looking-at "[ \t\n]*is")
+      ;; do nothing
+      )
+     ((looking-at "[ \t\n]*rename")
+      ;; do nothing
+      )
+     (t
+      (message "unknown syntax")))
+    ))))
+
+
+(defun ada-make-body ()
+  "Create an Ada package body in the current buffer.
+The potential old buffer contents is deleted first, then we copy the
+spec buffer in here and modify it to make it a body.
+
+This function typically is to be hooked into `ff-file-created-hooks'."
+  (interactive)
+  (delete-region (point-min) (point-max))
+  (insert-buffer (car (cdr (buffer-list))))
+  (ada-mode)
+
+  (let (found)
+    (if (setq found 
+	      (ada-search-ignore-string-comment ada-package-start-regexp))
+	(progn (goto-char (cdr found))
+	       (insert " body")
+	       ;; (forward-line -1)
+	       ;;(comment-region (point-min) (point))
+	       )
+      (error "No package"))
+    
+    ;; (comment-until-proc)
+    ;;   does not work correctly
+    ;;   must be done by hand
+    
+    (while (setq found
+		 (ada-search-ignore-string-comment ada-procedure-start-regexp))
+      (ada-gen-treat-proc found))))
+
+
+;;; provide ourself
+
+(provide 'ada-mode)
+
+;;; ada-mode.el ends here