# HG changeset patch
# User Karl Heuer <kwzh@gnu.org>
# Date 801948632 0
# Node ID a755246890228a73191b23b71d057e377ce538b9
# Parent  20f5e203dfe6467f2eea9f6e25946b0761577869
(initial comments): Copyright 1995; don't speak
about setup; correct history for a file that actually IS in
Emacs 19.29; update list of known bugs.
(all functions): inititialize all local variables explicitely to 'nil'.
(ada-font-lock-keywords): initialized according to new user option
`font-lock-maximum-decoration'.

(ada-ident-re): new regexp for Ada identifiers.
(ada-block-start-re): "record" may be preceded by one or more
occurencies of "limited", "abstract", or "tagged".
(ada-end-stmt-re): added "separate" body parts, "else", and
"package <Id> is".
(ada-subprogram-start-re): added "entry", "protected" and
"package body"
(ada-indent-function): handle "elsif" the same way as "if", added
"separate" for no indent.
(ada-get-indent-type): if "type ... is .." is followed by code on
the same line, it is a broken statement. Test it.
(ada-check-defun-name): check for "protected" records.
(ada-goto-matching-decl-start): use of ada-ident-re.
(ada-goto-matching-start): extend regexp for "protected" record.
(ada-in-limit-line): renamed from in-limit-line. Don't use
count-lines, but test if beginning-of-line/end-of-line puts us
to bob/eob.
(ada-goto-previous-nonblank-line): save a beginning-of-line
statement, as we already are there.
(ada-complete-type): removed.
(ada-tabsize): removed.
(keymap): use C-M-a and C-M-e for proc/func movement.  No
keybinding anymore for next/prev-package.
(ada-font-lock-keywords-[1|2]): add protected records. "when" removed
from 'reference'-face.
(initial comments): updated CREDITS list.
(ada-add-ada-menu): capitalized menu entries.  Added menu statement
needed for XEmacs.

changed all Ada94 to Ada95.

(ada-xemacs): new function, detect if we are
running on XEmacs. Ada keymap definition and menus use it.
(ada-create-syntax-table): corrected comments explaining use of 2nd
syntax table.  Added creation of ada-mode-symbol-syntax-table
with '_' as word constituent.
(ada-adjust-case): add test, if symbol is preceeded by a "'".
If true, change case according to ada-case-attribute.
(ada-which-function-are-we-in): new routine. Save name of the current
function in the old buffer; we can place cursor now at the same
function in the new buffer using find-file.
(ada-make-body): new function.  Generates body stubs if the body
did not exist yet and you switch to it by find-file.
(ada-gen-treat-proc): complete rewrite for ada-make-body.
(ada-mode): two doc lines about the above extension.
(keymap definition): remove 4th parameter in call to
`substitute-key-definition' to make XEmacs happy.

(ada-adjust-case-region, ada-move-to-start, ada-move-to-end,
ada-indent-newline-indent, ada-format-paramlist): switch syntax
tables, protect switching of syntax tables with unwind-protect.
(ada-in-open-paren-p): replace user option
`ada-search-paren-line-count-limit' by
`ada-search-paren-char-count-limit'.
(ada-case-attribute): new user option, but not yet the functionality.
(ada-krunch-args): initialized to 0 exploiting the new capability of
'gnatk8' as of gnat-2.0.
(ada-make-filename-from-adaname): remove downcasing and replacement
of dots. This is done in external program gnatk8 (gnat-2.0).
(ada-in-open-paren-p): complete rewrite for speed-up.
(ada-search-ignore-string-comment): ignore # as a string terminator
in all searches.
(ada-add-ada-menu): use real variables instead of t for invoking
'easymenu'
(require 'easymenu).
(imenu-create-ada-index): we accept forward definitions again.
(ada-indent-region): catch errors, simplified code.

diff -r 20f5e203dfe6 -r a75524689022 lisp/progmodes/ada-mode.el
--- a/lisp/progmodes/ada-mode.el	Tue May 30 23:32:09 1995 +0000
+++ b/lisp/progmodes/ada-mode.el	Wed May 31 19:30:32 1995 +0000
@@ -21,13 +21,13 @@
 ;; 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 94 source code under Emacs-19.  It contains completely new
+;;; and Ada 95 source code under Emacs-19.  It contains completely new
 ;;; indenting code and support for code browsing (see ada-xref).
 
 
 ;;; USAGE
 ;;; =====
-;;; Emacs should enter ada-mode when you load an ada source (*.ada).
+;;; 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:
@@ -57,66 +57,77 @@
 ;;; to his version.
 
 
-;;; KNOWN BUGS / BUGREPORTS
-;;; =======================
+;;; KNOWN BUGS
+;;; ==========
 ;;;
 ;;; In the presence of comments and/or incorrect syntax
 ;;; ada-format-paramlist produces weird results.
 ;;;
-;;; Indentation is sometimes wrong at the very beginning of the buffer.
-;;; So please try it on different locations. If it's still wrong then
-;;; report the bug.
-;;;
-;;; At the moment the browsing functions are limited to the use of the
-;;; separate packages "find-file.el" and "ada-xref.el" (ada-xref.el is
-;;; only for GNAT users).
-;;;
-;;; indenting of some tasking constructs is not yet supported.
-;;;
-;;; `reformat-region' sometimes generates some weird indentation.
+;;; 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);
 ;;;
-;;;> I have the following suggestions for the function template: 1) I
-;;;> don't want it automatically assigning it a name for the return variable. I
-;;;> never want it to be called "Result" because that is nondescriptive. If you
-;;;> must define a variable, give me the ability to specify its name.
-;;;>
-;;;> 2) You do not provide a type for variable 'Result'. Its type is the same
-;;;> as the function's return type, which the template knows, so why force me
-;;;> to type it in?
-;;;>
-
-;;;As always, different users have different tastes.
-;;;It would be nice if one could configure such layout details separately
-;;;without patching the LISP code. Maybe the metalanguage used in ada-stmt.el
-;;;could be taken even further, providing the user with some nice syntax
-;;;for describing layout. Then my own hacks would survive the next
-;;;update of the package :-)
-
-;;;By the way, there are some more quirks:
-
-;;;1) text entered in prompt mode (*) is not converted to upper case (I have
-;;;   choosen upper case for indentifiers).
-;;;   (*) I would like to suggest the term "template code" instead of
-;;;   "pseudo code".
-
-;;; There are quite a few problems in the crossreferencing part. These
-;;; are partly due to errors in gnatf.  One of the major bugs in
-;;; ada-xref is, that we do not wait for gnatf to rebuild the xref file.
-;;; We start the job, but do not wait for finishing.
-
+;;;    -- 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.
 
 ;;; LCD Archive Entry:
 ;;; ada-mode|Rolf Ebert|<ebert@inf.enst.fr>
 ;;; |Major-mode for Ada
-;;; |$Date: 1995/04/07 00:14:59 $|$Revision: 1.5 $|
+;;; |$Date: 1995/05/24 17:02:23 $|$Revision: 2.17 $|
 
 
-(defconst ada-mode-version (substring "$Revision: 1.5 $" 11 -2)
-  "$Id: ada-mode.el,v 1.5 1995/04/07 00:14:59 kwzh Exp kwzh $
-
-Report bugs to: Rolf Ebert <ebert@inf.enst.fr>")
-
-
 ;;;--------------------
 ;;;    USER OPTIONS
 ;;;--------------------
@@ -153,9 +164,8 @@
   "*If non-nil, following lines get indented according to the innermost
 open parenthesis.")
 
-(defvar ada-search-paren-line-count-limit 5
-  "*Search that many non-blank non-comment lines for an open parenthesis.
-Values higher than about 5 horribly slow down the indenting.")
+(defvar ada-search-paren-char-count-limit 3000
+  "*Search that many characters for an open parenthesis.")
 
 
 ;; ---- other user options
@@ -166,7 +176,7 @@
 
 '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.
+'gei            : use David Kågedal's Generic Indentation Engine.
 'indent-af      : use Gary E. Barnes' ada-format.el
 'always-tab     : do indent-relative.")
 
@@ -180,8 +190,8 @@
 (defvar ada-body-suffix ".adb"
   "*Suffix of Ada body files.")
 
-(defvar ada-language-version 'ada94
-  "*Do we program in 'ada83 or 'ada94?")
+(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
@@ -191,6 +201,10 @@
   "*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.")
@@ -215,9 +229,9 @@
   "*This is inserted at the end of each line when filling a comment paragraph
 with ada-fill-comment-paragraph postfix.")
 
-(defvar ada-krunch-args "250"
+(defvar ada-krunch-args "0"
   "*Argument of gnatk8, a string containing the max number of characters.
-Set to a big number, if you dont use crunched filenames.")
+Set to 0, if you dont use crunched filenames.")
 
 ;;; ---- end of user configurable variables
 
@@ -232,6 +246,9 @@
 (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\\|\
@@ -243,7 +260,7 @@
 then\\|type\\|use\\|when\\|while\\|with\\|xor\\)\\>"
   "regular expression for looking at Ada83 keywords.")
 
-(defconst ada-94-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\\|\
@@ -253,9 +270,9 @@
 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 Ad94 keywords.")
-
-(defvar ada-keywords ada-94-keywords
+  "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
@@ -266,6 +283,10 @@
 
 ;;; ---- 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.")
@@ -279,12 +300,15 @@
 
 (defvar ada-block-start-re
   "\\<\\(begin\\|select\\|declare\\|private\\|or\\|generic\\|\
-exception\\|loop\\|record\\|else\\)\\>"
+exception\\|loop\\|else\\|\
+\\(\\(limited\\|abstract\\|tagged\\)[ \t]+\\)*record\\)\\>"
   "Regexp for keywords starting ada-blocks.")
 
 (defvar ada-end-stmt-re
-  "\\(;\\|=>\\|\\<\\(begin\\|record\\|loop\\|select\\|do\\|\
-exception\\|declare\\|generic\\|private\\)\\>\\)"
+  "\\(;\\|=>\\|^[ \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.")
 
@@ -293,7 +317,8 @@
   "Regexp for the start of a loop.")
 
 (defvar ada-subprog-start-re
-  "\\<\\(procedure\\|function\\|task\\|accept\\)\\>"
+  "\\<\\(procedure\\|protected\\|package[ \t]+body\\|function\\|\
+task\\|accept\\|entry\\)\\>"
   "Regexp for the start of a subprogram.")
 
 
@@ -301,17 +326,16 @@
 ;;;  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."
-  ;; This syntax table is a merge of two syntax tables I found
-  ;; in the two ada modes in the old ada.el and the old
-  ;; electric-ada.el. (jsl)
-  ;; There still remains the problem, if the underscore '_' is a word
-  ;; constituent or not. (re)
-  ;; The Emacs doc clearly states that it is a symbol, and that is what most
-  ;; on the ada-mode list prefer. (re)
-  ;; For some functions, the syntactical meaning of '_' is temporaryly
-  ;; changed to 'w'. (mh)
+  ;; 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)
 
@@ -353,6 +377,9 @@
   ;; 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)
   )
 
 
@@ -378,8 +405,8 @@
  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]'
+ 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]'
@@ -398,6 +425,8 @@
                                                    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
@@ -473,8 +502,8 @@
 
   (cond ((eq ada-language-version 'ada83)
          (setq ada-keywords ada-83-keywords))
-        ((eq ada-language-version 'ada94)
-         (setq ada-keywords ada-94-keywords)))
+        ((eq ada-language-version 'ada95)
+         (setq ada-keywords ada-95-keywords)))
 
   (if ada-auto-case
       (ada-activate-keys-for-case)))
@@ -719,7 +748,8 @@
          (looking-at (concat ada-keywords "[^_]")))))
 
 (defun ada-after-char-p ()
-  ;; returns t if after ada character "'".
+  ;; returns t if after ada character "'". This is interpreted as being
+  ;; in a character constant.
   (save-excursion
     (if (> (point) 2)
         (progn
@@ -738,11 +768,17 @@
                                   (ada-in-comment-p)
                                   (ada-after-char-p))))
       (if (eq (char-syntax (char-after (1- (point)))) ?w)
-          (if (and
-               (not force-identifier) ; (MH)
-               (ada-after-keyword-p))
-              (funcall ada-case-keyword -1)
-            (funcall ada-case-identifier -1))))
+	  (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))
 
 
@@ -818,40 +854,43 @@
         (end nil)
         (keywordp nil)
         (reldiff nil))
-    (save-excursion
-      (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"))))
+    (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))))
 
 
 ;;
@@ -860,7 +899,7 @@
 (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)
+  (interactive "*")
   (ada-adjust-case-region (point-min) (point-max)))
 
 
@@ -880,59 +919,59 @@
         (end nil)
         (delend nil)
         (paramlist nil))
-    ;;
-    ;; ATTENTION: modify sntax-table temporary !
-    ;;
-    (modify-syntax-entry ?_ "w")
-
-    ;; 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
-    ;;
-    (modify-syntax-entry ?_ "_")))
+    (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)
@@ -1246,47 +1285,46 @@
   "Moves point to the matching start of the current end ... around point."
   (interactive)
   (let ((pos (point)))
-    ;;
-    ;; ATTENTION: modify sntax-table temporary !
-    ;;
-    (modify-syntax-entry ?_ "w")
-
-    (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
+    (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"))
+
       ;;
-      (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
-    ;;
-    (modify-syntax-entry ?_ "_")))
+      ;; restore syntax-table
+      ;;
+      (set-syntax-table ada-mode-syntax-table))))
 
 
 (defun ada-move-to-end ()
@@ -1296,64 +1334,63 @@
   (let ((pos (point))
         (decstart nil)
         (packdecl nil))
-    ;;
-    ;; ATTENTION: modify sntax-table temporary !
-    ;;
-    (modify-syntax-entry ?_ "w")
-
-    (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
-    ;;
-    (modify-syntax-entry ?_ "_")))
+    (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))))
 
 
 ;;;-----------------------------;;;
@@ -1366,19 +1403,28 @@
   "Indents the region using ada-indent-current on each line."
   (interactive "*r")
   (goto-char beg)
-  ;; catch errors while indenting
-  (condition-case err
-      (while (< (point) end)
-        (message (format "indenting ... %4d lines left"
-                         (count-lines (point) end)))
-        (ada-indent-current)
-        (forward-line 1))
-    ;; show line number where the error occured
-    (error
-     (error (format "line %d: %s"
-                    (1+ (count-lines (point-min) (point)))
-                    err) nil)))
-  (message "indenting ... done"))
+  (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 ()
@@ -1392,18 +1438,17 @@
     (delete-horizontal-space)
     (setq orgpoint (point))
 
-    ;;
-    ;; ATTENTION: modify syntax-table temporary !
-    ;;
-    (modify-syntax-entry ?_ "w")
-
-    (setq column (save-excursion
-                   (funcall (ada-indent-function) orgpoint)))
-
-    ;;
-    ;; restore syntax-table
-    ;;
-    (modify-syntax-entry ?_ "_")
+    (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)
 
@@ -1438,57 +1483,59 @@
 
   (interactive)
 
-  ;;
-  ;; ATTENTION: modify sntax-table temporary !
-  ;;
-  (modify-syntax-entry ?_ "w")
-
-  (let ((line-end)
-        (orgpoint (point-marker))
-        (cur-indent)
-        (prev-indent)
-        (prevline t))
+  (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))))))
 
     ;;
-    ;; first step
+    ;; restore syntax-table
     ;;
-    (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)
-            (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
-  ;;
-  (modify-syntax-entry ?_ "_"))
+    (set-syntax-table ada-mode-syntax-table)))
 
 
 (defun ada-get-current-indent (prev-indent)
@@ -1785,13 +1832,9 @@
            ((looking-at "\\<type\\>")
             (setq func 'ada-get-indent-type))
            ;;
-           ((looking-at "\\<if\\>")
+           ((looking-at "\\<\\(els\\)?if\\>")
             (setq func 'ada-get-indent-if))
            ;;
-           ((looking-at "\\<elsif\\>")
-            (setq func 'ada-get-indent-if)) ; maybe it needs a special
-                                            ; function sometimes ?
-           ;;
            ((looking-at "\\<case\\>")
             (setq func 'ada-get-indent-case))
            ;;
@@ -1804,6 +1847,8 @@
            ((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))))))
 
@@ -1904,7 +1949,7 @@
            ;;
            ;; a named block end
            ;;
-           ((looking-at "[a-zA-Z0-9_]+")
+           ((looking-at ada-ident-re)
             (setq defun-name (buffer-substring (match-beginning 0)
                                                (match-end 0)))
             (save-excursion
@@ -2307,10 +2352,12 @@
         (ada-search-ignore-string-comment ";" nil orgpoint))
       (current-indentation))
      ;;
-     ;; type ... is
+     ;; "type ... is", but not "type ... is ...", which is broken
      ;;
      ((save-excursion
-        (ada-search-ignore-string-comment "\\<is\\>" nil orgpoint))
+	(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
@@ -2475,7 +2522,7 @@
   ;;
   ;; 'accept' or 'package' ?
   ;;
-  (if (not (looking-at "\\<\\(accept\\|package\\|task\\)\\>"))
+  (if (not (looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>"))
       (ada-goto-matching-decl-start))
   ;;
   ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
@@ -2487,13 +2534,13 @@
     (if (looking-at "\\<declare\\>")
         (ada-goto-stmt-start)
       ;;
-      ;; no, => 'procedure'/'function'/'task'
+      ;; no, => 'procedure'/'function'/'task'/'protected'
       ;;
       (progn
         (forward-word 2)
         (backward-word 1)
         ;;
-        ;; skip 'body' or 'type'
+        ;; skip 'body' 'protected' 'type'
         ;;
         (if (looking-at "\\<\\(body\\|type\\)\\>")
             (forward-word 1))
@@ -2536,8 +2583,7 @@
        ;;
        ((looking-at "end")
         (ada-goto-matching-start 1 noerror)
-        (if (progn
-              (looking-at "begin"))
+        (if (looking-at "begin")
             (setq nest-count (1+ nest-count))))
        ;;
        ((looking-at "declare\\|generic")
@@ -2590,7 +2636,7 @@
           (progn
             (if (looking-at "is")
                   (ada-search-ignore-string-comment
-                   "\\<\\(procedure\\|function\\|task\\|package\\)\\>" t)
+                   ada-subprog-start-re t)
               (looking-at "declare\\|generic")))))
         (if noerror nil
           (error "no matching procedure/function/task/declare/package"))
@@ -2614,8 +2660,8 @@
             (not found)
             (ada-search-ignore-string-comment
              (concat "\\<\\("
-                     "end\\|loop\\|select\\|begin\\|case\\|"
-                     "if\\|task\\|package\\|record\\|do\\)\\>")
+                     "end\\|loop\\|select\\|begin\\|case\\|do\\|"
+                     "if\\|task\\|package\\|record\\|protected\\)\\>")
              t))
 
       ;;
@@ -2798,9 +2844,9 @@
        ((ada-in-string-p)
         (if backward
             (progn
-              (re-search-backward "\"\\|#" nil 1)
+              (re-search-backward "\"" nil 1) ; "\"\\|#" don't treat #
               (goto-char (match-beginning 0))))
-        (re-search-forward "\"\\|#" nil 1))
+        (re-search-forward "\"" nil 1))
        ;;
        ;; found character constant => ignore it
        ;;
@@ -2905,7 +2951,7 @@
 
 
 (defun ada-goto-prev-nonblank-line ( &optional ignore-comment)
-  ;; Moves point to previous non-blank line,
+  ;; 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)
@@ -2930,9 +2976,9 @@
                               (or (looking-at "[ \t]*$")
                                   (and (looking-at "[ \t]*--")
                                        ignore-comment)))
-                        (not (in-limit-line-p)))
+                        (not (ada-in-limit-line-p)))
               (forward-line -1)
-              (beginning-of-line)
+              ;;(beginning-of-line)
               (setq newpoint (point))) ; end of loop
 
             )) ; end of if
@@ -2971,7 +3017,7 @@
                               (or (looking-at "[ \t]*$")
                                   (and (looking-at "[ \t]*--")
                                        ignore-comment)))
-                        (not (in-limit-line-p)))
+                        (not (ada-in-limit-line-p)))
               (forward-line 1)
               (beginning-of-line)
               (setq newpoint (point))) ; end of loop
@@ -3017,11 +3063,11 @@
            (looking-at "\\<private\\>")))))
 
 
-(defun in-limit-line-p ()
-  ;; Returns t if point is in first or last accessible line.
-  (or
-   (>= 1 (count-lines (point-min) (point)))
-   (>= 1 (count-lines (point) (point-max)))))
+;;; 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 ()
@@ -3041,7 +3087,7 @@
                (point)) (point)))
      ;; check if 'string quote' is only a character constant
      (progn
-       (re-search-backward "\"\\|#" nil t)
+       (re-search-backward "\"" nil t) ; # not a string delimiter anymore
        (not (= (char-after (1- (point))) ?'))))))
 
 
@@ -3075,168 +3121,26 @@
   ;; 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 ((nest-count 1)
-        (limit nil)
-        (found nil)
-        (pos nil)
-        (col nil)
-        (counter ada-search-paren-line-count-limit))
-
-    ;;
-    ;; get search-limit
-    ;;
-    (if ada-search-paren-line-count-limit
-        (setq limit
-              (save-excursion
-                (while (not (zerop counter))
-                  (ada-goto-prev-nonblank-line)
-                  (setq counter (1- counter)))
-                (beginning-of-line)
-                (point))))
-
-    (save-excursion
-
-      ;;
-      ;; loop until found or limit
-      ;;
-      (while (and
-              (not found)
-              (ada-search-ignore-string-comment "(\\|)" t limit t))
-        (setq nest-count
-              (if (looking-at ")")
-                  (1+ nest-count)
-                (1- nest-count)))
-        (setq found (zerop nest-count))) ; end of loop
-
-      (if found
-          ;; if found => return column of first non-ws after the parenthesis
-          (progn
-            (forward-char 1)
-            (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))))
-
-
-;;;-----------------------------;;;
-;;; Simple Completion Functions ;;;
-;;;-----------------------------;;;
-
-;; These are my first steps in Emacs-Lisp ... :-) They can be replaced
-;; by functions based on the output of the Gnatf Tool that comes with
-;; the GNAT Ada compiler. See the file ada-xref.el (MH) But you might
-;; use these functions if you don't use GNAT
-
-(defun ada-use-last-with ()
-  "Inserts the package name of the last 'with' statement after use."
-  (interactive)
-  (let ((pakname nil))
-    (save-excursion
-      (forward-word -1)
-      (if (looking-at "use")
-          ;;
-          ;; find last 'with'
-          ;;
-          (progn (re-search-backward
-                  "\\(\\<with\\s-+\\)\\([a-zA-Z0-9_.]+\\)\\(\\s-*;\\)")
-                 ;;
-                 ;; get the name of the package
-                 ;;
-                 (setq pakname (concat
-                                (buffer-substring (match-beginning 2)
-                                                  (match-end 2))
-                                ";")))
-        (setq pakname "")))
-    (insert pakname)))
-
-
-(defun ada-complete-symbol (symboldef position symalist)
-  ;; Tries to complete a symbol in the buffer.
-  ;; SYMBOLDEF is the regexp to find the definition of the desired symbol.
-  ;; POSITION is the position of the subexpression in SYMBOLDEF to match
-  ;; the symbol itself.
-  ;; SYMALIST is an alist with possibly predefined completions."
-  (let ((sofar nil)
-        (completed nil)
-        (insertpos nil))
-    (save-excursion
-      ;;
-      ;; get the part of the symbol already typed
-      ;;
-      (re-search-backward "\\([^a-zA-Z0-9_\\.]\\)\\([a-zA-Z0-9_\\.]+\\)")
-      (setq sofar (buffer-substring (match-beginning 2)
-                                    (match-end 2)))
-      ;;
-      ;; delete it
-      ;;
-      (delete-region (setq insertpos (match-beginning 2))
-                     (match-end 2))
-      ;;
-      ;; find all possible completions by searching for definitions of
-      ;; this kind of symbol
-      ;;
-      (while (re-search-backward symboldef nil t)
-        ;;
-        ;; build an alist of these possible completions
-        ;;
-        (setq symalist (cons (cons (buffer-substring (match-beginning position)
-                                                     (match-end position))
-                                   nil)
-                             symalist)))
-
-      (or
-       ;;
-       ;; symbol gets completed as far as possible
-       ;;
-       (stringp (setq completed (try-completion sofar symalist)))
-       ;;
-       ;; or is already complete
-       ;;
-       (setq completed sofar)))
-    ;;
-    ;; insert the completed symbol
-    ;;
-    (goto-char insertpos)
-    (insert completed)))
-
-
-(defun ada-complete-use ()
-  "Tries to complete the package name in an 'use' statement in the buffer.
-Searches through former 'with' statements for possible completions."
-  (interactive)
-  (ada-complete-symbol
-   "\\(\\<with\\s-+\\)\\([a-zA-Z0-9_.]+\\)\\(\\s-*;\\)" 2 nil)
-  (insert ";"))
-
-
-(defun ada-complete-procedure ()
-  "Tries to complete a procedure/function name in the buffer."
-  (interactive)
-  (ada-complete-symbol ada-procedure-start-regexp 2 nil))
-
-
-(defun ada-complete-variable ()
-  "Tries to complete a variable name in the buffer."
-  (interactive)
-  (ada-complete-symbol
-   "\\([^a-zA-Z0-9_]\\)\\([a-zA-Z0-9_]+\\)[ \t\n]+\\(:\\)" 2 nil))
-
-
-(defun ada-complete-type ()
-  "Tries to complete a type name in the buffer."
-  (interactive)
-  (ada-complete-symbol "\\(type\\)[ \t\n]+\\([a-zA-Z0-9_\\.]+\\)"
-                       2
-                       '(("Integer" nil)
-                         ("Long_Integer" nil)
-                         ("Natural" nil)
-                         ("Positive" nil)
-                         ("Short_Integer" 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)))
+
 
 
 ;;;----------------------;;;
@@ -3269,7 +3173,7 @@
 
 
 (defun ada-indent-current-function ()
-  "ada-mode version of the indent-line-function."
+  "Ada Mode version of the indent-line-function."
   (interactive "*")
   (let ((starting-point (point-marker)))
     (ada-beginning-of-line)
@@ -3280,8 +3184,6 @@
     ))
 
 
-
-
 (defun ada-tab-hard ()
   "Indent current line to next tab stop."
   (interactive)
@@ -3300,11 +3202,6 @@
     (indent-rigidly bol eol  (- 0 ada-indent))))
 
 
-(defun ada-tabsize (s)
-  "changes spacing used for indentation. Reads spacing from minibuffer."
-  (interactive "nnew indentation spacing: ")
-  (setq ada-indent s))
-
 
 ;;;---------------;;;
 ;;; Miscellaneous ;;;
@@ -3389,8 +3286,9 @@
       (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)
-      ;; How do I write this for working with Lucid Emacs?
-      (define-key ada-mode-map [S-tab]    'ada-untab)
+      (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.
@@ -3399,10 +3297,10 @@
 
       ;; Movement
 ;;; It isn't good to redefine these.  What should be done instead?  -- rms.
-;;;   (define-key ada-mode-map "\M-e"     'ada-next-procedure)
-;;;   (define-key ada-mode-map "\M-a"     'ada-previous-procedure)
-      (define-key ada-mode-map "\M-\C-e"  'ada-next-package)
-      (define-key ada-mode-map "\M-\C-a"  'ada-previous-package)
+;;;   (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)
 
@@ -3420,13 +3318,24 @@
       (define-key ada-mode-map "\C-c:"    'ada-uncomment-region)
 
       ;; Change basic functionality
-      (mapcar (lambda (pair)
-                (substitute-key-definition (car pair) (cdr pair)
-                                           ada-mode-map global-map))
-              '((beginning-of-line      . ada-beginning-of-line)
-                (end-of-line            . ada-end-of-line)
-                (forward-to-indentation . ada-forward-to-indentation)
-                ))
+
+      ;; 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))
+
       ))
 
 
@@ -3434,45 +3343,51 @@
 ;;; 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]
+                      ["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)"
+                      ["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]
+                      ["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"
+                      ["Fill Comment Paragraph"
                        ada-fill-comment-paragraph t]
-                      ["justify comment paragraph"
+                      ["Justify Comment Paragraph"
                        ada-fill-comment-paragraph-justify t]
-                      ["postfix comment paragraph"
+                      ["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]
+                      ["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]
+                      ["Comment   Region" comment-region t]
+                      ["Uncomment Region" ada-uncomment-region t]
                       ["----------------" nil nil]
-                      ["compile" compile (fboundp 'compile)]
-                      ["next error" next-error (fboundp 'next-error)]
+                      ["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
+                      ["Other File Other Window" ada-ff-other-window
                        (fboundp 'ff-find-other-file)]
-                      ["other file" ff-find-other-file
-                       (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)))))
+
 
 
 ;;;-------------------------------
@@ -3510,10 +3425,8 @@
 ;;; support for find-file
 ;;;---------------------------------------------------
 
-(defvar ada-krunch-args "8"
-  "*Argument of gnatk8, a string containing the max number of characters.
-Set to a big number, if you dont use crunched filenames.")
-
+
+;;;###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
@@ -3521,21 +3434,23 @@
   (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))
+;      (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)
@@ -3550,6 +3465,25 @@
   (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
 ;;;---------------------------------------------------
@@ -3566,21 +3500,23 @@
              (or regexp ada-procedure-start-regexp)
              nil t)
        ;(imenu-progress-message prev-pos)
-       ;;(backward-up-list 1) ;; needed in Ada ????
        ;; 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)
+;        (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)))
@@ -3598,13 +3534,28 @@
 (defconst ada-font-lock-keywords-1
   (list
    ;;
-   ;; Function, package (body), pragma, procedure, task (body) plus name.
-   (list (concat "\\<\\("
-                 "function\\|"
-                 "p\\(ackage\\(\\|[ \t]+body\\)\\|r\\(agma\\|ocedure\\)\\)\\|"
-                 "task\\(\\|[ \t]+body\\)"
-                 "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
-         '(1 font-lock-keyword-face) '(6 font-lock-function-name-face nil t)))
+   ;; 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.")
 
@@ -3630,11 +3581,12 @@
             "o\\(r\\|thers\\|ut\\)\\|pr\\(ivate\\|otected\\)\\|"
             "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
             "se\\(lect\\|parate\\)\\|"
-            "t\\(a\\(gged\\|sk\\)\\|erminate\\|hen\\)\\|until\\|while\\|xor"
+            "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+\\)?"
+    '("\\<\\(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.
@@ -3661,7 +3613,7 @@
                 font-lock-type-face) nil t))
     ;;
     ;; Keywords followed by a (comma separated list of) reference.
-    (list (concat "\\<\\(goto\\|raise\\|use\\|when\\|with\\)\\>"
+    (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))
@@ -3690,87 +3642,103 @@
     (error "No more functions/procedures")))
 
 
-(defun ada-gen-treat-proc nil
+(defun ada-gen-treat-proc (match)
   ;; make dummy body of a procedure/function specification.
-  (goto-char (match-end 0))
-  (let ((wend (point))
-        (wstart (progn (re-search-backward "[   ][a-zA-Z0-9_\"]+" nil t)
-                       (+ (match-beginning 0) 1)))) ; delete leading WS
-    (copy-region-as-kill wstart wend) ; store  proc name in kill-buffer
-
-
-    ;; if the next notWS char is '(' ==> parameterlist follows
-    ;; if the next notWS char is ';' ==> no paramterlist
-    ;; if the next notWS char is 'r' ==> paramterless function, search ';'
-
-    ;; goto end of regex before last (= end of procname)
-    (goto-char (match-end 0))
+  ;; 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
-    (backward-char)
-    (re-search-forward "[       ]*.")
-    (if (char-equal (char-after (match-end 0)) ?\;)
-        (delete-char 1) ;; delete the ';'
-      ;; else
-      ;; find ');' or 'return <id> ;'
-      (re-search-forward
-       "\\()[ \t]*;\\)\\|\\(return[ \t]+[a-zA-Z0-9_]+[ \t]*;\\)" nil t)
-      (goto-char (match-end 0))
-      (delete-backward-char 1) ;; delete the ';'
+    (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)	
       )
-
-    (insert " is")
-    ;; if it is a function, we should generate a return variable and a
-    ;; return statement. Sth. like "Result : <return-type>;" and a
-    ;; "return Result;".
-    (ada-indent-newline-indent)
-    (insert "begin -- ")
-    (yank)
-    (newline)
-    (insert "null;")
-    (newline)
-    (insert "end ")
-    (yank)
-    (insert ";")
-    (ada-indent-newline-indent))
-
-
-(defun ada-gen-make-bodyfile (spec-filename)
-  "Create a new buffer containing the correspondig Ada body
-to the current specs."
-  (interactive "b")
-;;;  (let* (
-;;;      (file-name (ada-body-filename spec-filename))
-;;;      (buf (get-buffer-create file-name)))
-;;;    (switch-to-buffer buf)
-;;;    (ada-mode)
-  (ff-find-other-file t t)
-;;;  (if (= (buffer-size) 0)
-;;;      (make-header)
-;;;    ;; make nothing, autoinsert.el had put something in already
-;;;    )
-    (end-of-buffer)
-    (let ((hlen (count-lines (point-min) (point-max))))
-      (insert-buffer spec-filename)
-      ;; hlen lines have already been inserted automatically
+      ;; else
+     ((looking-at "[ \t\n]*is")
+      ;; do nothing
+      )
+     ((looking-at "[ \t\n]*rename")
+      ;; do nothing
       )
-
-    (if (re-search-forward ada-package-start-regexp nil t)
-        (progn (goto-char (match-end 1))
-               (insert " body"))
+     (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 (re-search-forward ada-procedure-start-regexp nil t)
-      (ada-gen-treat-proc))
-
-                                        ; don't overwrite an eventually
-                                        ; existing file
-;    (if (file-exists-p file-name)
-;        (error "File with this name already exists!")
-;      (write-file file-name))
-    ))
+    
+    ;; (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