HCoop / bpt / emacs.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Revert last bug-reference-url-format change.
[bpt/emacs.git] / lisp / progmodes / ada-mode.el
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 07d38db..95f9f6b 100644 (file)
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1,7 +1,7 @@
 ;;; ada-mode.el --- major-mode for editing Ada sources
 
 ;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
 ;;; ada-mode.el --- major-mode for editing Ada sources
 
 ;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;               2005, 2006, 2007  Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
 
 ;; Author: Rolf Ebert      <ebert@inf.enst.fr>
 ;;      Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
 
 ;; Author: Rolf Ebert      <ebert@inf.enst.fr>
 ;;      Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
@@ -11,10 +11,10 @@
 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, 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
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -22,9 +22,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 ;; This mode is a major mode for editing Ada code.  This is a major
 
 ;;; Commentary:
 ;; This mode is a major mode for editing Ada code.  This is a major
@@ -130,15 +128,14 @@
 (require 'which-func nil t)
 (require 'compile nil t)
 
 (require 'which-func nil t)
 (require 'compile nil t)
 
-(defvar compile-auto-highlight)
 (defvar ispell-check-comments)
 (defvar skeleton-further-elements)
 
 (defun ada-mode-version ()
   "Return Ada mode version."
   (interactive)
 (defvar ispell-check-comments)
 (defvar skeleton-further-elements)
 
 (defun ada-mode-version ()
   "Return Ada mode version."
   (interactive)
-  (let ((version-string "3.7"))
-    (if (interactive-p)
+  (let ((version-string "4.00"))
+    (if (called-interactively-p 'interactive)
        (message version-string)
       version-string)))
 
        (message version-string)
       version-string)))
 
@@ -235,6 +232,10 @@ It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
 (defcustom ada-clean-buffer-before-saving t
   "*Non-nil means remove trailing spaces and untabify the buffer before saving."
   :type 'boolean :group 'ada)
 (defcustom ada-clean-buffer-before-saving t
   "*Non-nil means remove trailing spaces and untabify the buffer before saving."
   :type 'boolean :group 'ada)
+(make-obsolete-variable 'ada-clean-buffer-before-saving
+                       "use the `write-file-functions' hook."
+                       "23.2")
+
 
 (defcustom ada-indent 3
   "*Size of Ada indentation.
 
 (defcustom ada-indent 3
   "*Size of Ada indentation.
@@ -256,7 +257,7 @@ Note that indentation is calculated only if `ada-indent-comment-as-code' is t.
 
 For instance:
     A := 1;   --  A multi-line comment
 
 For instance:
     A := 1;   --  A multi-line comment
-             --  aligned if ada-indent-align-comments is t"
+             --  aligned if `ada-indent-align-comments' is t"
   :type 'boolean :group 'ada)
 
 (defcustom ada-indent-comment-as-code t
   :type 'boolean :group 'ada)
 
 (defcustom ada-indent-comment-as-code t
@@ -450,6 +451,13 @@ The extensions should include a `.' if needed.")
 (defvar ada-mode-map (make-sparse-keymap)
   "Local keymap used for Ada mode.")
 
 (defvar ada-mode-map (make-sparse-keymap)
   "Local keymap used for Ada mode.")
 
+(defvar ada-mode-extra-map (make-sparse-keymap)
+  "Keymap used for non-standard keybindings.")
+
+;; default is C-c C-q because it's free in ada-mode-map
+(defvar ada-mode-extra-prefix "\C-c\C-q"
+  "Prefix key to access `ada-mode-extra-map' functions.")
+
 (defvar ada-mode-abbrev-table nil
   "Local abbrev table for Ada mode.")
 
 (defvar ada-mode-abbrev-table nil
   "Local abbrev table for Ada mode.")
 
@@ -582,8 +590,25 @@ This variable defines several rules to use to align different lines.")
 ;; FIXME: make this customizable
 
 (defconst ada-ident-re
 ;; FIXME: make this customizable
 
 (defconst ada-ident-re
-  "\\(\\sw\\|[_.]\\)+"
-  "Regexp matching Ada (qualified) identifiers.")
+  "[[:alpha:]]\\(?:[_[:alnum:]]\\)*"
+  ;; [:alnum:] matches any multibyte word constituent, as well as
+  ;; Latin-1 letters and numbers. This allows __ and trailing _;
+  ;; someone (emacs bug#1919) proposed [^\W_] to fix that, but \W does
+  ;; _not_ mean "not word constituent" inside a character alternative.
+  "Regexp matching an Ada identifier.")
+
+(defconst ada-goto-label-re
+  (concat "<<" ada-ident-re ">>")
+  "Regexp matching a goto label.")
+
+(defconst ada-block-label-re
+  (concat ada-ident-re "[ \t\n]*:[^=]")
+  "Regexp matching a block label.
+Note that this also matches a variable declaration.")
+
+(defconst ada-label-re
+  (concat "\\(?:" ada-block-label-re "\\)\\|\\(?:" ada-goto-label-re "\\)")
+  "Regexp matching a goto or block label.")
 
 ;;  "with" needs to be included in the regexp, to match generic subprogram parameters
 ;;  Similarly, we put '[not] overriding' on the same line with 'procedure' etc.
 
 ;;  "with" needs to be included in the regexp, to match generic subprogram parameters
 ;;  Similarly, we put '[not] overriding' on the same line with 'procedure' etc.
@@ -631,6 +656,7 @@ The package name is in (match-string 4).")
     (concat "\\("
            ";"                                        "\\|"
            "=>[ \t]*$"                                "\\|"
     (concat "\\("
            ";"                                        "\\|"
            "=>[ \t]*$"                                "\\|"
+           "=>[ \t]*--.*$"                            "\\|"
            "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)"  "\\|"
            "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
                                "loop" "private" "record" "select"
            "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)"  "\\|"
            "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
                                "loop" "private" "record" "select"
@@ -651,28 +677,16 @@ A new statement starts after these.")
            "\\>"))
   "Regexp used in `ada-goto-matching-start'.")
 
            "\\>"))
   "Regexp used in `ada-goto-matching-start'.")
 
-(defvar ada-matching-decl-start-re
-  (eval-when-compile
-    (concat "\\<"
-           (regexp-opt
-            '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
-           "\\>"))
-  "Regexp used in `ada-goto-matching-decl-start'.")
-
 (defvar ada-loop-start-re
   "\\<\\(for\\|while\\|loop\\)\\>"
   "Regexp for the start of a loop.")
 
 (defvar ada-subprog-start-re
   (eval-when-compile
 (defvar ada-loop-start-re
   "\\<\\(for\\|while\\|loop\\)\\>"
   "Regexp for the start of a loop.")
 
 (defvar ada-subprog-start-re
   (eval-when-compile
-    (concat "\\<" (regexp-opt '("accept" "entry" "function" "package" "procedure"
+    (concat "\\<" (regexp-opt '("accept" "entry" "function" "overriding" "package" "procedure"
                                "protected" "task") t) "\\>"))
   "Regexp for the start of a subprogram.")
 
                                "protected" "task") t) "\\>"))
   "Regexp for the start of a subprogram.")
 
-(defvar ada-named-block-re
-  "[ \t]*\\(\\sw\\|_\\)+[ \t]*:[^=]"
-  "Regexp of the name of a block or loop.")
-
 (defvar ada-contextual-menu-on-identifier nil
   "Set to true when the right mouse button was clicked on an identifier.")
 
 (defvar ada-contextual-menu-on-identifier nil
   "Set to true when the right mouse button was clicked on an identifier.")
 
@@ -712,7 +726,7 @@ displaying the menu if point was on an identifier."
 (defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")
 
 (defconst ada-imenu-subprogram-menu-re
 (defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")
 
 (defconst ada-imenu-subprogram-menu-re
-  (concat "^[ \t]*\\(procedure\\|function\\)[ \t\n]+"
+  (concat "^[ \t]*\\(overriding[ \t]*\\)?\\(procedure\\|function\\)[ \t\n]+"
          "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)"
          ada-imenu-comment-re
          "\\)[ \t\n]*"
          "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)"
          ada-imenu-comment-re
          "\\)[ \t\n]*"
@@ -720,7 +734,7 @@ displaying the menu if point was on an identifier."
 
 (defvar ada-imenu-generic-expression
   (list
 
 (defvar ada-imenu-generic-expression
   (list
-   (list nil ada-imenu-subprogram-menu-re 2)
+   (list nil ada-imenu-subprogram-menu-re 3)
    (list "*Specs*"
         (concat
          "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
    (list "*Specs*"
         (concat
          "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
@@ -785,13 +799,14 @@ the 4 file locations can be clicked on and jumped to."
 
       ;; set source marker
       (save-excursion
 
       ;; set source marker
       (save-excursion
-        (compilation-find-file (point-marker) (match-string 1) "./")
-        (set-buffer file)
+       (compilation-find-file (point-marker) (match-string 1) "./")
+       (set-buffer file)
 
 
-        (if (stringp line)
-            (goto-line (string-to-number line)))
+       (when (stringp line)
+         (goto-char (point-min))
+         (forward-line (1- (string-to-number line))))
 
 
-        (setq source (point-marker)))
+       (setq source (point-marker)))
 
       (compilation-goto-locus error-pos source nil)
 
 
       (compilation-goto-locus error-pos source nil)
 
@@ -1002,6 +1017,9 @@ If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'."
                          (line-beginning-position) (point))))
   (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
 
                          (line-beginning-position) (point))))
   (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
 
+(defsubst ada-in-numeric-literal-p ()
+  "Return t if point is after a prefix of a numeric literal."
+  (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)"))
 
 ;;------------------------------------------------------------------
 ;; Contextual menus
 
 ;;------------------------------------------------------------------
 ;; Contextual menus
@@ -1100,48 +1118,7 @@ the file name."
 
 ;;;###autoload
 (defun ada-mode ()
 
 ;;;###autoload
 (defun ada-mode ()
-  "Ada mode is the major mode for editing Ada code.
-
-Bindings are as follows: (Note: 'LFD' is control-j.)
-\\{ada-mode-map}
-
- 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]'
-
- Adjust case of identifiers and keywords in region    '\\[ada-adjust-case-region]'
- Adjust case of identifiers and keywords in buffer    '\\[ada-adjust-case-buffer]'
-
- Fill comment paragraph, justify and append postfix   '\\[fill-paragraph]'
-
- 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 and 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]'."
+  "Ada mode is the major mode for editing Ada code."
 
   (interactive)
   (kill-all-local-variables)
 
   (interactive)
   (kill-all-local-variables)
@@ -1191,14 +1168,10 @@ If you use ada-xref.el:
   (set (make-local-variable 'fill-paragraph-function)
        'ada-fill-comment-paragraph)
 
   (set (make-local-variable 'fill-paragraph-function)
        'ada-fill-comment-paragraph)
 
-  (set (make-local-variable 'imenu-generic-expression)
-       ada-imenu-generic-expression)
-
   ;;  Support for compile.el
   ;;  We just substitute our own functions to go to the error.
   (add-hook 'compilation-mode-hook
            (lambda()
   ;;  Support for compile.el
   ;;  We just substitute our own functions to go to the error.
   (add-hook 'compilation-mode-hook
            (lambda()
-             (set (make-local-variable 'compile-auto-highlight) 40)
              ;; FIXME: This has global impact!  -stef
              (define-key compilation-minor-mode-map [mouse-2]
                'ada-compile-mouse-goto-error)
              ;; FIXME: This has global impact!  -stef
              (define-key compilation-minor-mode-map [mouse-2]
                'ada-compile-mouse-goto-error)
@@ -1208,23 +1181,13 @@ If you use ada-xref.el:
                'ada-compile-goto-error)))
 
   ;;  font-lock support :
                'ada-compile-goto-error)))
 
   ;;  font-lock support :
-  ;;  We need to set some properties for XEmacs, and define some variables
-  ;;  for Emacs
 
 
-  ;; FIXME: The Emacs code should work just fine under XEmacs AFAIK.  --Stef
-  (if (featurep 'xemacs)
-      ;;  XEmacs
-      (put 'ada-mode 'font-lock-defaults
-          '(ada-font-lock-keywords
-            nil t ((?\_ . "w") (?# . ".")) beginning-of-line))
-    ;;  Emacs
-    (set (make-local-variable 'font-lock-defaults)
-        '(ada-font-lock-keywords
-          nil t
-          ((?\_ . "w") (?# . "."))
-          beginning-of-line
-          (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
-    )
+  (set (make-local-variable 'font-lock-defaults)
+       '(ada-font-lock-keywords
+        nil t
+        ((?\_ . "w") (?# . "."))
+        beginning-of-line
+        (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
 
   ;; Set up support for find-file.el.
   (set (make-local-variable 'ff-other-file-alist)
 
   ;; Set up support for find-file.el.
   (set (make-local-variable 'ff-other-file-alist)
@@ -1237,34 +1200,34 @@ If you use ada-xref.el:
 
   (make-local-variable 'ff-special-constructs)
   (mapc (lambda (pair) (add-to-list 'ff-special-constructs pair))
 
   (make-local-variable 'ff-special-constructs)
   (mapc (lambda (pair) (add-to-list 'ff-special-constructs pair))
-        (list
-         ;; Top level child package declaration; go to the parent package.
-         (cons (eval-when-compile
-                 (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
-                         "\\(body[ \t]+\\)?"
-                         "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
-               (lambda ()
-                 (ff-get-file
-                  ada-search-directories-internal
-                  (ada-make-filename-from-adaname (match-string 3))
-                  ada-spec-suffixes)))
-
-         ;; A "separate" clause.
-         (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
-               (lambda ()
-                 (ff-get-file
-                  ada-search-directories-internal
-                  (ada-make-filename-from-adaname (match-string 1))
-                  ada-spec-suffixes)))
-
-         ;; A "with" clause.
-         (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
-               (lambda ()
-                 (ff-get-file
-                  ada-search-directories-internal
-                  (ada-make-filename-from-adaname (match-string 1))
-                  ada-spec-suffixes)))
-         ))
+       (list
+        ;; Top level child package declaration; go to the parent package.
+        (cons (eval-when-compile
+                (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
+                        "\\(body[ \t]+\\)?"
+                        "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
+              (lambda ()
+                (ff-get-file
+                 ada-search-directories-internal
+                 (ada-make-filename-from-adaname (match-string 3))
+                 ada-spec-suffixes)))
+
+        ;; A "separate" clause.
+        (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
+              (lambda ()
+                (ff-get-file
+                 ada-search-directories-internal
+                 (ada-make-filename-from-adaname (match-string 1))
+                 ada-spec-suffixes)))
+
+        ;; A "with" clause.
+        (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
+              (lambda ()
+                (ff-get-file
+                 ada-search-directories-internal
+                 (ada-make-filename-from-adaname (match-string 1))
+                 ada-spec-suffixes)))
+        ))
 
   ;;  Support for outline-minor-mode
   (set (make-local-variable 'outline-regexp)
 
   ;;  Support for outline-minor-mode
   (set (make-local-variable 'outline-regexp)
@@ -1272,6 +1235,8 @@ If you use ada-xref.el:
   (set (make-local-variable 'outline-level) 'ada-outline-level)
 
   ;;  Support for imenu : We want a sorted index
   (set (make-local-variable 'outline-level) 'ada-outline-level)
 
   ;;  Support for imenu : We want a sorted index
+  (setq imenu-generic-expression ada-imenu-generic-expression)
+
   (setq imenu-sort-function 'imenu--sort-by-name)
 
   ;;  Support for ispell : Check only comments
   (setq imenu-sort-function 'imenu--sort-by-name)
 
   ;;  Support for ispell : Check only comments
@@ -1284,40 +1249,40 @@ If you use ada-xref.el:
 
   ;; Exclude comments alone on line from alignment.
   (add-to-list 'align-exclude-rules-list
 
   ;; Exclude comments alone on line from alignment.
   (add-to-list 'align-exclude-rules-list
-               '(ada-solo-comment
-                 (regexp  . "^\\(\\s-*\\)--")
-                 (modes   . '(ada-mode))))
+              '(ada-solo-comment
+                (regexp  . "^\\(\\s-*\\)--")
+                (modes   . '(ada-mode))))
   (add-to-list 'align-exclude-rules-list
   (add-to-list 'align-exclude-rules-list
-               '(ada-solo-use
-                 (regexp  . "^\\(\\s-*\\)\\<use\\>")
-                 (modes   . '(ada-mode))))
+              '(ada-solo-use
+                (regexp  . "^\\(\\s-*\\)\\<use\\>")
+                (modes   . '(ada-mode))))
 
   (setq ada-align-modes nil)
 
   (add-to-list 'ada-align-modes
 
   (setq ada-align-modes nil)
 
   (add-to-list 'ada-align-modes
-               '(ada-declaration-assign
-                 (regexp  . "[^:]\\(\\s-*\\):[^:]")
-                 (valid   . (lambda() (not (ada-in-comment-p))))
-                 (repeat . t)
-                 (modes   . '(ada-mode))))
+              '(ada-declaration-assign
+                (regexp  . "[^:]\\(\\s-*\\):[^:]")
+                (valid   . (lambda() (not (ada-in-comment-p))))
+                (repeat . t)
+                (modes   . '(ada-mode))))
   (add-to-list 'ada-align-modes
   (add-to-list 'ada-align-modes
-               '(ada-associate
-                 (regexp  . "[^=]\\(\\s-*\\)=>")
-                 (valid   . (lambda() (not (ada-in-comment-p))))
-                 (modes   . '(ada-mode))))
+              '(ada-associate
+                (regexp  . "[^=]\\(\\s-*\\)=>")
+                (valid   . (lambda() (not (ada-in-comment-p))))
+                (modes   . '(ada-mode))))
   (add-to-list 'ada-align-modes
   (add-to-list 'ada-align-modes
-               '(ada-comment
-                 (regexp  . "\\(\\s-*\\)--")
-                 (modes   . '(ada-mode))))
+              '(ada-comment
+                (regexp  . "\\(\\s-*\\)--")
+                (modes   . '(ada-mode))))
   (add-to-list 'ada-align-modes
   (add-to-list 'ada-align-modes
-               '(ada-use
-                 (regexp  . "\\(\\s-*\\)\\<use\\s-")
-                 (valid   . (lambda() (not (ada-in-comment-p))))
-                 (modes   . '(ada-mode))))
+              '(ada-use
+                (regexp  . "\\(\\s-*\\)\\<use\\s-")
+                (valid   . (lambda() (not (ada-in-comment-p))))
+                (modes   . '(ada-mode))))
   (add-to-list 'ada-align-modes
   (add-to-list 'ada-align-modes
-               '(ada-at
-                 (regexp . "\\(\\s-+\\)at\\>")
-                 (modes . '(ada-mode))))
+              '(ada-at
+                (regexp . "\\(\\s-+\\)at\\>")
+                (modes . '(ada-mode))))
 
   (setq align-mode-rules-list ada-align-modes)
 
 
   (setq align-mode-rules-list ada-align-modes)
 
@@ -1336,6 +1301,9 @@ If you use ada-xref.el:
   ;;  Support for indent-new-comment-line (Especially for XEmacs)
   (set (make-local-variable 'comment-multi-line) nil)
 
   ;;  Support for indent-new-comment-line (Especially for XEmacs)
   (set (make-local-variable 'comment-multi-line) nil)
 
+  ;;  Support for add-log
+  (set (make-local-variable 'add-log-current-defun-function) 'ada-which-function)
+
   (setq major-mode 'ada-mode
        mode-name "Ada")
 
   (setq major-mode 'ada-mode
        mode-name "Ada")
 
@@ -1345,14 +1313,6 @@ If you use ada-xref.el:
 
   (set-syntax-table ada-mode-syntax-table)
 
 
   (set-syntax-table ada-mode-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 'delete-trailing-whitespace)
-       ;; convert all tabs to the correct number of spaces.
-       (add-hook 'local-write-file-hooks
-                 (lambda () (untabify (point-min) (point-max))))))
-
   (set (make-local-variable 'skeleton-further-elements)
        '((< '(backward-delete-char-untabify
              (min ada-indent (current-column))))))
   (set (make-local-variable 'skeleton-further-elements)
        '((< '(backward-delete-char-untabify
              (min ada-indent (current-column))))))
@@ -1396,13 +1356,11 @@ If you use ada-xref.el:
        (progn (goto-char (symbol-value 'beg)) (forward-word -1) (point))
        (goto-char aa-end)))))
 
        (progn (goto-char (symbol-value 'beg)) (forward-word -1) (point))
        (goto-char aa-end)))))
 
-;;  transient-mark-mode and mark-active are not defined in XEmacs
 (defun ada-region-selected ()
 (defun ada-region-selected ()
-  "Return t if a region has been selected by the user and is still active."
-  (if (featurep 'xemacs)
-      (region-active-p)
-    (and transient-mark-mode mark-active)))
-
+  "Should we operate on an active region?"
+  (if (fboundp 'use-region-p)
+      (use-region-p)
+    (region-active-p)))
 \f
 ;;-----------------------------------------------------------------
 ;;                      auto-casing
 \f
 ;;-----------------------------------------------------------------
 ;;                      auto-casing
@@ -1436,7 +1394,7 @@ Casing exception lists are `ada-case-exception' and `ada-case-exception-substrin
 (defun ada-create-case-exception (&optional word)
   "Define WORD as an exception for the casing system.
 If WORD is not given, then the current word in the buffer is used instead.
 (defun ada-create-case-exception (&optional word)
   "Define WORD as an exception for the casing system.
 If WORD is not given, then the current word in the buffer is used instead.
-The new words is added to the first file in `ada-case-exception-file'.
+The new word is added to the first file in `ada-case-exception-file'.
 The standard casing rules will no longer apply to this word."
   (interactive)
   (let ((previous-syntax-table (syntax-table))
 The standard casing rules will no longer apply to this word."
   (interactive)
   (let ((previous-syntax-table (syntax-table))
@@ -1651,6 +1609,8 @@ If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier."
                 (eq (char-syntax (char-before)) ?w)
                 ;;  if in a string or a comment
                 (not (ada-in-string-or-comment-p))
                 (eq (char-syntax (char-before)) ?w)
                 ;;  if in a string or a comment
                 (not (ada-in-string-or-comment-p))
+                ;;  if in a numeric literal
+                (not (ada-in-numeric-literal-p))
                 )
            (if (save-excursion
                  (forward-word -1)
                 )
            (if (save-excursion
                  (forward-word -1)
@@ -1673,7 +1633,7 @@ ARG is the prefix the user entered with \\[universal-argument]."
   (interactive "P")
 
   (if ada-auto-case
   (interactive "P")
 
   (if ada-auto-case
-      (let ((lastk last-command-char)
+      (let ((lastk last-command-event)
            (previous-syntax-table (syntax-table)))
 
        (unwind-protect
            (previous-syntax-table (syntax-table)))
 
        (unwind-protect
@@ -1707,9 +1667,9 @@ ARG is the prefix the user entered with \\[universal-argument]."
 
     ;; Else, no auto-casing
     (cond
 
     ;; Else, no auto-casing
     (cond
-     ((eq last-command-char ?\n)
+     ((eq last-command-event ?\n)
       (funcall ada-lfd-binding))
       (funcall ada-lfd-binding))
-     ((eq last-command-char ?\r)
+     ((eq last-command-event ?\r)
       (funcall ada-ret-binding))
      (t
       (self-insert-command (prefix-numeric-value arg))))
       (funcall ada-ret-binding))
      (t
       (self-insert-command (prefix-numeric-value arg))))
@@ -1756,7 +1716,7 @@ adapt to unusal auto-casing schemes.  Since it does nothing, you can for
 instance use it for `ada-case-identifier' if you don't want any special
 auto-casing for identifiers, whereas keywords have to be lower-cased.
 See also `ada-auto-case' to disable auto casing altogether."
 instance use it for `ada-case-identifier' if you don't want any special
 auto-casing for identifiers, whereas keywords have to be lower-cased.
 See also `ada-auto-case' to disable auto casing altogether."
-  )
+  nil)
 
 (defun ada-capitalize-word (&optional arg)
   "Upcase first letter and letters following '_', lower case other letters.
 
 (defun ada-capitalize-word (&optional arg)
   "Upcase first letter and letters following '_', lower case other letters.
@@ -2158,10 +2118,18 @@ Return the equivalent internal parameter list."
 
 (defun ada-indent-newline-indent-conditional ()
   "Insert a newline and indent it.
 
 (defun ada-indent-newline-indent-conditional ()
   "Insert a newline and indent it.
-The original line is indented first if `ada-indent-after-return' is non-nil."
+The original line is re-indented if `ada-indent-after-return' is non-nil."
   (interactive "*")
   (interactive "*")
-  (if ada-indent-after-return (ada-indent-current))
+  ;; If at end of buffer (entering brand new code), some indentation
+  ;; fails.  For example, a block label requires whitespace following
+  ;; the : to be recognized.  So we do the newline first, then
+  ;; go back and indent the original line.
   (newline)
   (newline)
+  (if ada-indent-after-return
+      (progn
+        (forward-char -1)
+        (ada-indent-current)
+        (forward-char 1)))
   (ada-indent-current))
 
 (defun ada-justified-indent-current ()
   (ada-indent-current))
 
 (defun ada-justified-indent-current ()
@@ -2193,7 +2161,7 @@ The original line is indented first if `ada-indent-after-return' is non-nil."
 
 (defun ada-batch-reformat ()
   "Re-indent and re-case all the files found on the command line.
 
 (defun ada-batch-reformat ()
   "Re-indent and re-case all the files found on the command line.
-This function should be used from the Unix/Windows command line, with a
+This function should be used from the command line, with a
 command like:
   emacs -batch -l ada-mode -f ada-batch-reformat file1 file2 ..."
 
 command like:
   emacs -batch -l ada-mode -f ada-batch-reformat file1 file2 ..."
 
@@ -2215,8 +2183,8 @@ Return the new position of point or nil if not found."
 
 (defun ada-indent-current ()
   "Indent current line as Ada code.
 
 (defun ada-indent-current ()
   "Indent current line as Ada code.
-Return the calculation that was done, including the reference point and the
-offset."
+Return the calculation that was done, including the reference point
+and the offset."
   (interactive)
   (let ((previous-syntax-table (syntax-table))
        (orgpoint (point-marker))
   (interactive)
   (let ((previous-syntax-table (syntax-table))
        (orgpoint (point-marker))
@@ -2385,8 +2353,8 @@ offset."
                      (progn
                        (goto-char (car match-cons))
                        (save-excursion
                      (progn
                        (goto-char (car match-cons))
                        (save-excursion
-                         (beginning-of-line)
-                         (if (looking-at ada-named-block-re)
+                         (back-to-indentation)
+                         (if (looking-at ada-block-label-re)
                              (setq label (- ada-label-indent))))))))
 
            ;; found 'record' =>
                              (setq label (- ada-label-indent))))))))
 
            ;; found 'record' =>
@@ -2505,7 +2473,7 @@ offset."
      ((and (= (downcase (char-after)) ?b)
           (looking-at "begin\\>"))
       (save-excursion
      ((and (= (downcase (char-after)) ?b)
           (looking-at "begin\\>"))
       (save-excursion
-       (if (ada-goto-matching-decl-start t)
+       (if (ada-goto-decl-start t)
            (list (progn (back-to-indentation) (point)) 0)
          (ada-indent-on-previous-lines nil orgpoint orgpoint))))
 
            (list (progn (back-to-indentation) (point)) 0)
          (ada-indent-on-previous-lines nil orgpoint orgpoint))))
 
@@ -2527,7 +2495,7 @@ offset."
            (list (progn (back-to-indentation) (point)) 'ada-indent))
        (save-excursion
          (ada-goto-stmt-start)
            (list (progn (back-to-indentation) (point)) 'ada-indent))
        (save-excursion
          (ada-goto-stmt-start)
-         (if (looking-at "\\<package\\|procedure\\|function\\>")
+         (if (looking-at "\\<overriding\\|package\\|procedure\\|function\\>")
              (list (progn (back-to-indentation) (point)) 0)
            (list (progn (back-to-indentation) (point)) 'ada-indent)))))
 
              (list (progn (back-to-indentation) (point)) 0)
            (list (progn (back-to-indentation) (point)) 'ada-indent)))))
 
@@ -2676,27 +2644,31 @@ offset."
           (looking-at "\\<\\(package\\|function\\|procedure\\)\\>"))
       (save-excursion
        ;;  Go up until we find either a generic section, or the end of the
           (looking-at "\\<\\(package\\|function\\|procedure\\)\\>"))
       (save-excursion
        ;;  Go up until we find either a generic section, or the end of the
-       ;;  previous subprogram/package
+       ;;  previous subprogram/package, or 'overriding' for this function/procedure
        (let (found)
          (while (and (not found)
                      (ada-search-ignore-string-comment
        (let (found)
          (while (and (not found)
                      (ada-search-ignore-string-comment
-            "\\<\\(generic\\|end\\|begin\\|package\\|procedure\\|function\\)\\>" t))
+            "\\<\\(generic\\|end\\|begin\\|overriding\\|package\\|procedure\\|function\\)\\>" t))
 
            ;;  avoid "with procedure"... in generic parts
            (save-excursion
              (forward-word -1)
              (setq found (not (looking-at "with"))))))
 
 
            ;;  avoid "with procedure"... in generic parts
            (save-excursion
              (forward-word -1)
              (setq found (not (looking-at "with"))))))
 
-       (if (looking-at "generic")
-           (list (progn (back-to-indentation) (point)) 0)
-         (ada-indent-on-previous-lines nil orgpoint orgpoint))))
+       (cond
+        ((looking-at "\\<generic\\|overriding\\>")
+         (list (progn (back-to-indentation) (point)) 0))
+
+        (t
+         (ada-indent-on-previous-lines nil orgpoint orgpoint)))))
 
      ;;---------------------------------
      ;; label
      ;;---------------------------------
 
 
      ;;---------------------------------
      ;; label
      ;;---------------------------------
 
-     ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
+     ((looking-at ada-label-re)
       (if (ada-in-decl-p)
       (if (ada-in-decl-p)
+          ;; ada-block-label-re matches variable declarations
          (ada-indent-on-previous-lines nil orgpoint orgpoint)
        (append (ada-indent-on-previous-lines nil orgpoint orgpoint)
                '(ada-label-indent))))
          (ada-indent-on-previous-lines nil orgpoint orgpoint)
        (append (ada-indent-on-previous-lines nil orgpoint orgpoint)
                '(ada-label-indent))))
@@ -2721,9 +2693,10 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
     (if (ada-in-paramlist-p)
        (ada-get-indent-paramlist)
 
     (if (ada-in-paramlist-p)
        (ada-get-indent-paramlist)
 
-      ;; move to beginning of current statement
+      ;; Move to beginning of current statement. If already at a
+      ;; statement start, move to beginning of enclosing statement.
       (unless nomove
       (unless nomove
-       (ada-goto-stmt-start))
+       (ada-goto-stmt-start t))
 
       ;; no beginning found => don't change indentation
       (if (and (eq oldpoint (point))
 
       ;; no beginning found => don't change indentation
       (if (and (eq oldpoint (point))
@@ -2749,6 +2722,12 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
         ((looking-at ada-block-start-re)
          (ada-get-indent-block-start orgpoint))
         ;;
         ((looking-at ada-block-start-re)
          (ada-get-indent-block-start orgpoint))
         ;;
+        ((looking-at ada-block-label-re) ; also variable declaration
+         (ada-get-indent-block-label orgpoint))
+        ;;
+        ((looking-at ada-goto-label-re)
+         (ada-get-indent-goto-label orgpoint))
+        ;;
         ((looking-at "\\(sub\\)?type\\>")
          (ada-get-indent-type orgpoint))
         ;;
         ((looking-at "\\(sub\\)?type\\>")
          (ada-get-indent-type orgpoint))
         ;;
@@ -2764,17 +2743,8 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
         ((looking-at "when\\>")
          (ada-get-indent-when orgpoint))
         ;;
         ((looking-at "when\\>")
          (ada-get-indent-when orgpoint))
         ;;
-        ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
-         (ada-get-indent-label orgpoint))
-        ;;
         ((looking-at "separate\\>")
          (ada-get-indent-nochange))
         ((looking-at "separate\\>")
          (ada-get-indent-nochange))
-
-        ;; A label
-        ((looking-at "<<")
-         (list (+ (save-excursion (back-to-indentation) (point))
-                  (- ada-label-indent))))
-
         ;;
         ((looking-at "with\\>\\|use\\>")
          ;;  Are we still in that statement, or are we in fact looking at
         ;;
         ((looking-at "with\\>\\|use\\>")
          ;;  Are we still in that statement, or are we in fact looking at
@@ -2826,7 +2796,7 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
      (t
       (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
       (ada-goto-next-non-ws)
      (t
       (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
       (ada-goto-next-non-ws)
-      (list (point) 0)))))
+      (list (point) 'ada-broken-indent)))))
 
 (defun ada-get-indent-end (orgpoint)
   "Calculate the indentation when point is just before an end statement.
 
 (defun ada-get-indent-end (orgpoint)
   "Calculate the indentation when point is just before an end statement.
@@ -2844,12 +2814,15 @@ ORGPOINT is the limit position used in the calculation."
          (forward-word 1)
          (ada-goto-next-non-ws)
          (cond
          (forward-word 1)
          (ada-goto-next-non-ws)
          (cond
-          ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>")
+          ;;
+          ;; loop/select/if/case/return
+          ;;
+          ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|return\\)\\>")
            (save-excursion (ada-check-matching-start (match-string 0)))
            (list (save-excursion (back-to-indentation) (point)) 0))
 
           ;;
            (save-excursion (ada-check-matching-start (match-string 0)))
            (list (save-excursion (back-to-indentation) (point)) 0))
 
           ;;
-          ;; loop/select/if/case/record/select
+          ;; record
           ;;
           ((looking-at "\\<record\\>")
            (save-excursion
           ;;
           ((looking-at "\\<record\\>")
            (save-excursion
@@ -2879,7 +2852,7 @@ ORGPOINT is the limit position used in the calculation."
              (if (looking-at "\\<begin\\>")
                  (progn
                    (setq indent (list (point) 0))
              (if (looking-at "\\<begin\\>")
                  (progn
                    (setq indent (list (point) 0))
-                   (if (ada-goto-matching-decl-start t)
+                   (if (ada-goto-decl-start t)
                        (list (progn (back-to-indentation) (point)) 0)
                      indent))
                (list (progn (back-to-indentation) (point)) 0)
                        (list (progn (back-to-indentation) (point)) 0)
                      indent))
                (list (progn (back-to-indentation) (point)) 0)
@@ -3004,6 +2977,10 @@ ORGPOINT is the limit position used in the calculation."
                (car (ada-search-ignore-string-comment "\\<type\\>" t)))
              'ada-indent)))
 
                (car (ada-search-ignore-string-comment "\\<type\\>" t)))
              'ada-indent)))
 
+     ;; Special case for label:
+     ((looking-at ada-block-label-re)
+      (list (- (save-excursion (back-to-indentation) (point)) ada-label-indent) 'ada-indent))
+
      ;; nothing follows the block-start
      (t
       (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
      ;; nothing follows the block-start
      (t
       (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
@@ -3099,10 +3076,10 @@ ORGPOINT is the limit position used in the calculation."
        (list (save-excursion (back-to-indentation) (point))
              'ada-broken-decl-indent))
 
        (list (save-excursion (back-to-indentation) (point))
              'ada-broken-decl-indent))
 
-       ;;  This one is called in every over case when indenting a line at the
+       ;;  This one is called in every other case when indenting a line at the
        ;;  top level
        (t
        ;;  top level
        (t
-       (if (looking-at ada-named-block-re)
+       (if (looking-at (concat "[ \t]*" ada-block-label-re))
            (setq label (- ada-label-indent))
 
          (let (p)
            (setq label (- ada-label-indent))
 
          (let (p)
@@ -3131,7 +3108,7 @@ ORGPOINT is the limit position used in the calculation."
          (list (+ (save-excursion (back-to-indentation) (point)) label)
                'ada-broken-indent)))))))
 
          (list (+ (save-excursion (back-to-indentation) (point)) label)
                'ada-broken-indent)))))))
 
-(defun ada-get-indent-label (orgpoint)
+(defun ada-get-indent-block-label (orgpoint)
   "Calculate the indentation when before a label or variable declaration.
 ORGPOINT is the limit position used in the calculation."
   (let ((match-cons nil)
   "Calculate the indentation when before a label or variable declaration.
 ORGPOINT is the limit position used in the calculation."
   (let ((match-cons nil)
@@ -3163,6 +3140,16 @@ ORGPOINT is the limit position used in the calculation."
      (t
       (list cur-indent '(- ada-label-indent))))))
 
      (t
       (list cur-indent '(- ada-label-indent))))))
 
+(defun ada-get-indent-goto-label (orgpoint)
+  "Calculate the indentation when at a goto label."
+  (search-forward ">>")
+  (ada-goto-next-non-ws)
+  (if (>= (point) orgpoint)
+      ;; labeled statement is the one we need to indent
+      (list (- (point) ada-label-indent))
+    ;; else indentation is indent for labeled statement
+    (ada-indent-on-previous-lines t orgpoint)))
+
 (defun ada-get-indent-loop (orgpoint)
   "Calculate the indentation when just before a loop or a for ... use.
 ORGPOINT is the limit position used in the calculation."
 (defun ada-get-indent-loop (orgpoint)
   "Calculate the indentation when just before a loop or a for ... use.
 ORGPOINT is the limit position used in the calculation."
@@ -3171,8 +3158,8 @@ ORGPOINT is the limit position used in the calculation."
 
        ;; If looking at a named block, skip the label
        (label (save-excursion
 
        ;; If looking at a named block, skip the label
        (label (save-excursion
-                (beginning-of-line)
-                (if (looking-at ada-named-block-re)
+                (back-to-indentation)
+                (if (looking-at ada-block-label-re)
                     (- ada-label-indent)
                   0))))
 
                     (- ada-label-indent)
                   0))))
 
@@ -3192,7 +3179,7 @@ ORGPOINT is the limit position used in the calculation."
       (setq pos (ada-get-indent-block-start orgpoint))
       (if (equal label 0)
          pos
       (setq pos (ada-get-indent-block-start orgpoint))
       (if (equal label 0)
          pos
-       (list (+ (car pos) label) (cdr pos))))
+       (list (+ (car pos) label) (cadr pos))))
 
      ;;
      ;; 'for'- loop (or also a for ... use statement)
 
      ;;
      ;; 'for'- loop (or also a for ... use statement)
@@ -3330,7 +3317,7 @@ ORGPOINT is the limit position used in the calculation."
 ;; -- searching and matching
 ;; -----------------------------------------------------------
 
 ;; -- searching and matching
 ;; -----------------------------------------------------------
 
-(defun ada-goto-stmt-start ()
+(defun ada-goto-stmt-start (&optional ignore-goto-label)
   "Move point to the beginning of the statement that point is in or after.
 Return the new position of point.
 As a special case, if we are looking at a closing parenthesis, skip to the
   "Move point to the beginning of the statement that point is in or after.
 Return the new position of point.
 As a special case, if we are looking at a closing parenthesis, skip to the
@@ -3348,7 +3335,7 @@ open parenthesis."
          (progn
            (unless (save-excursion
                      (goto-char (cdr match-dat))
          (progn
            (unless (save-excursion
                      (goto-char (cdr match-dat))
-                     (ada-goto-next-non-ws orgpoint))
+                     (ada-goto-next-non-ws orgpoint ignore-goto-label))
              ;;
              ;; nothing follows => it's the end-statement directly in
              ;;                    front of point => search again
              ;;
              ;; nothing follows => it's the end-statement directly in
              ;;                    front of point => search again
@@ -3370,7 +3357,7 @@ open parenthesis."
        (goto-char (point-min))
        ;;
        ;; skip to the very first statement, if there is one
        (goto-char (point-min))
        ;;
        ;; skip to the very first statement, if there is one
-         ;;
+       ;;
        (unless (ada-goto-next-non-ws orgpoint)
          (goto-char orgpoint))))
     (point)))
        (unless (ada-goto-next-non-ws orgpoint)
          (goto-char orgpoint))))
     (point)))
@@ -3431,19 +3418,25 @@ is the end of the match."
        match-dat
       nil)))
 
        match-dat
       nil)))
 
-
-(defun ada-goto-next-non-ws (&optional limit)
-  "Skip white spaces, newlines and comments to next non-ws character.
+(defun ada-goto-next-non-ws (&optional limit skip-goto-label)
+  "Skip to next non-whitespace character.
+Skips spaces, newlines and comments, and possibly goto labels.
+Return `point' if moved, nil if not.
 Stop the search at LIMIT.
 Do not call this function from within a string."
   (unless limit
     (setq limit (point-max)))
   (while (and (<= (point) limit)
 Stop the search at LIMIT.
 Do not call this function from within a string."
   (unless limit
     (setq limit (point-max)))
   (while (and (<= (point) limit)
-             (progn (forward-comment 10000)
-                    (if (and (not (eobp))
-                             (save-excursion (forward-char 1)
-                                             (ada-in-string-p)))
-                        (progn (forward-sexp 1) t)))))
+             (or (progn (forward-comment 10000)
+                         (if (and (not (eobp))
+                                  (save-excursion (forward-char 1)
+                                                  (ada-in-string-p)))
+                             (progn (forward-sexp 1) t)))
+                  (and skip-goto-label
+                       (looking-at ada-goto-label-re)
+                       (progn
+                         (goto-char (match-end 0))
+                         t)))))
   (if (< (point) limit)
       (point)
     nil)
   (if (< (point) limit)
       (point)
     nil)
@@ -3470,9 +3463,7 @@ Return the new position of point or nil if not found."
     (unless backward
       (skip-syntax-forward "w"))
     (if (setq match-cons
     (unless backward
       (skip-syntax-forward "w"))
     (if (setq match-cons
-            (if backward
-                (ada-search-ignore-string-comment "\\w" t nil t)
-              (ada-search-ignore-string-comment "\\w" nil nil t)))
+              (ada-search-ignore-string-comment "\\w" backward nil t))
        ;;
        ;; move to the beginning of the word found
        ;;
        ;;
        ;; move to the beginning of the word found
        ;;
@@ -3502,16 +3493,18 @@ Moves point to the matching block start."
 Assumes point to be already positioned by `ada-goto-matching-start'.
 Moves point to the beginning of the declaration."
 
 Assumes point to be already positioned by `ada-goto-matching-start'.
 Moves point to the beginning of the declaration."
 
-  ;; named block without a `declare'
+  ;; named block without a `declare'; ada-goto-matching-start leaves
+  ;; point at start of 'begin' for a block.
   (if (save-excursion
        (ada-goto-previous-word)
        (looking-at (concat "\\<" defun-name "\\> *:")))
   (if (save-excursion
        (ada-goto-previous-word)
        (looking-at (concat "\\<" defun-name "\\> *:")))
-      t                                 ; do nothing
+      t                                 ; name matches
+    ;; else
     ;;
     ;; 'accept' or 'package' ?
     ;;
     (unless (looking-at ada-subprog-start-re)
     ;;
     ;; 'accept' or 'package' ?
     ;;
     (unless (looking-at ada-subprog-start-re)
-      (ada-goto-matching-decl-start))
+      (ada-goto-decl-start))
     ;;
     ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
     ;;
     ;;
     ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
     ;;
@@ -3520,7 +3513,9 @@ Moves point to the beginning of the declaration."
       ;; a named 'declare'-block ? => jump to the label
       ;;
       (if (looking-at "\\<declare\\>")
       ;; a named 'declare'-block ? => jump to the label
       ;;
       (if (looking-at "\\<declare\\>")
-         (backward-word 1)
+         (progn
+           (forward-comment -1)
+           (backward-word 1))
        ;;
        ;; no, => 'procedure'/'function'/'task'/'protected'
        ;;
        ;;
        ;; no, => 'procedure'/'function'/'task'/'protected'
        ;;
@@ -3542,14 +3537,20 @@ Moves point to the beginning of the declaration."
               (buffer-substring (point)
                                 (progn (forward-sexp 1) (point))))))))
 
               (buffer-substring (point)
                                 (progn (forward-sexp 1) (point))))))))
 
-(defun ada-goto-matching-decl-start (&optional noerror recursive)
-  "Move point to the matching declaration start of the current 'begin'.
-If NOERROR is non-nil, it only returns nil if no match was found."
+(defun ada-goto-decl-start (&optional noerror)
+  "Move point to the declaration start of the current construct.
+If NOERROR is non-nil, return nil if no match was found;
+otherwise throw error."
   (let ((nest-count 1)
   (let ((nest-count 1)
+        (regexp (eval-when-compile
+                  (concat "\\<"
+                          (regexp-opt
+                           '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
+                          "\\>")))
 
        ;;  first should be set to t if we should stop at the first
        ;;  "begin" we encounter.
 
        ;;  first should be set to t if we should stop at the first
        ;;  "begin" we encounter.
-       (first (not recursive))
+       (first t)
        (count-generic nil)
        (stop-at-when nil)
        )
        (count-generic nil)
        (stop-at-when nil)
        )
@@ -3573,7 +3574,7 @@ If NOERROR is non-nil, it only returns nil if no match was found."
     ;; search backward for interesting keywords
     (while (and
            (not (zerop nest-count))
     ;; search backward for interesting keywords
     (while (and
            (not (zerop nest-count))
-           (ada-search-ignore-string-comment ada-matching-decl-start-re t))
+           (ada-search-ignore-string-comment regexp t))
       ;;
       ;; calculate nest-depth
       ;;
       ;;
       ;; calculate nest-depth
       ;;
@@ -3606,7 +3607,6 @@ If NOERROR is non-nil, it only returns nil if no match was found."
 
                  (if (looking-at "end")
                      (ada-goto-matching-start 1 noerror t)
 
                  (if (looking-at "end")
                      (ada-goto-matching-start 1 noerror t)
-                   ;; (ada-goto-matching-decl-start noerror t)
 
                    (setq loop-again nil)
                    (unless (looking-at "begin")
 
                    (setq loop-again nil)
                    (unless (looking-at "begin")
@@ -3634,34 +3634,50 @@ If NOERROR is non-nil, it only returns nil if no match was found."
        (setq first t))
        ;;
        ((looking-at "is")
        (setq first t))
        ;;
        ((looking-at "is")
-       ;; check if it is only a type definition, but not a protected
-       ;; type definition, which should be handled like a procedure.
-       (if (or (looking-at "is[ \t]+<>")
-               (save-excursion
-                 (forward-comment -10000)
-                 (forward-char -1)
-
-                 ;; Detect if we have a closing parenthesis (Could be
-                 ;; either the end of subprogram parameters or (<>)
-                 ;; in a type definition
-                 (if (= (char-after) ?\))
-                     (progn
-                       (forward-char 1)
-                       (backward-sexp 1)
-                       (forward-comment -10000)
-                       ))
-                 (skip-chars-backward "a-zA-Z0-9_.'")
-                 (ada-goto-previous-word)
-                 (and
-                  (looking-at "\\<\\(sub\\)?type\\|case\\>")
+        ;; look for things to ignore
+        (if
+            (or
+             ;; generic formal parameter
+             (looking-at "is[ t]+<>")
+
+             ;; A type definition, or a case statement.  Note that the
+             ;; goto-matching-start above on 'end record' leaves us at
+             ;; 'record', not at 'type'.
+             ;;
+             ;; We get to a case statement here by calling
+             ;; 'ada-move-to-end' from inside a case statement; then
+             ;; we are not ignoring 'when'.
+             (save-excursion
+               ;; Skip type discriminants or case argument function call param list
+               (forward-comment -10000)
+               (forward-char -1)
+               (if (= (char-after) ?\))
+                   (progn
+                     (forward-char 1)
+                     (backward-sexp 1)
+                     (forward-comment -10000)
+                     ))
+               ;; skip type or case argument name
+               (skip-chars-backward "a-zA-Z0-9_.'")
+               (ada-goto-previous-word)
+               (and
+                ;; if it's a protected type, it's the decl start we
+                ;; are looking for; since we didn't see the 'end'
+                ;; above, we are inside it.
+                (looking-at "\\<\\(sub\\)?type\\|case\\>")
                   (save-match-data
                     (ada-goto-previous-word)
                     (not (looking-at "\\<protected\\>"))))
                   (save-match-data
                     (ada-goto-previous-word)
                     (not (looking-at "\\<protected\\>"))))
-                 ))                    ; end of `or'
-           (goto-char (match-beginning 0))
-         (progn
-           (setq nest-count (1- nest-count))
-           (setq first nil))))
+               )                    ; end of type definition p
+
+             ;; null procedure declaration
+             (save-excursion (ada-goto-next-word) (looking-at "\\<null\\>"))
+             );; end or
+            ;; skip this construct
+            nil
+          ;; this is the right "is"
+          (setq nest-count (1- nest-count))
+          (setq first nil)))
 
        ;;
        ((looking-at "new")
 
        ;;
        ((looking-at "new")
@@ -3897,13 +3913,12 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
              (goto-char (match-beginning 0)))
 
             ;;
              (goto-char (match-beginning 0)))
 
             ;;
-            ;; found 'do' => skip back to 'accept'
+            ;; found 'do' => skip back to 'accept' or 'return'
             ;;
             ((looking-at "do")
              (unless (ada-search-ignore-string-comment
             ;;
             ((looking-at "do")
              (unless (ada-search-ignore-string-comment
-                      "accept" t nil nil
-                      'word-search-backward)
-               (error "Missing 'accept' in front of 'do'"))))
+                      "\\<accept\\|return\\>" t)
+               (error "Missing 'accept' or 'return' in front of 'do'"))))
            (point))
 
        (if noerror
            (point))
 
        (if noerror
@@ -4117,7 +4132,7 @@ Point is moved at the beginning of the SEARCH-RE."
 Assumes point to be at the end of a statement."
   (or (ada-in-paramlist-p)
       (save-excursion
 Assumes point to be at the end of a statement."
   (or (ada-in-paramlist-p)
       (save-excursion
-       (ada-goto-matching-decl-start t))))
+       (ada-goto-decl-start t))))
 
 
 (defun ada-looking-at-semi-or ()
 
 
 (defun ada-looking-at-semi-or ()
@@ -4153,7 +4168,7 @@ Return nil if the private is part of the package name, as in
 
 
 (defun ada-in-paramlist-p ()
 
 
 (defun ada-in-paramlist-p ()
-  "Return t if point is inside a parameter-list."
+  "Return t if point is inside the parameter-list of a declaration, but not a subprogram call or aggregate."
   (save-excursion
     (and
      (ada-search-ignore-string-comment "(\\|)" t nil t)
   (save-excursion
     (and
      (ada-search-ignore-string-comment "(\\|)" t nil t)
@@ -4184,13 +4199,13 @@ Return nil if the private is part of the package name, as in
 
      ;; right keyword two words before parenthesis ?
      ;; Type is in this list because of discriminants
 
      ;; right keyword two words before parenthesis ?
      ;; Type is in this list because of discriminants
+     ;; pragma is not, because the syntax is that of a subprogram call.
      (looking-at (eval-when-compile
                   (concat "\\<\\("
                           "procedure\\|function\\|body\\|"
                           "task\\|entry\\|accept\\|"
                           "access[ \t]+procedure\\|"
                           "access[ \t]+function\\|"
      (looking-at (eval-when-compile
                   (concat "\\<\\("
                           "procedure\\|function\\|body\\|"
                           "task\\|entry\\|accept\\|"
                           "access[ \t]+procedure\\|"
                           "access[ \t]+function\\|"
-                          "pragma\\|"
                           "type\\)\\>"))))))
 
 (defun ada-search-ignore-complex-boolean (regexp backwardp)
                           "type\\)\\>"))))))
 
 (defun ada-search-ignore-complex-boolean (regexp backwardp)
@@ -4411,7 +4426,7 @@ of the region.  Otherwise, operate only on the current line."
                  ;;
                  ada-move-to-declaration
                  (looking-at "\\<begin\\>")
                  ;;
                  ada-move-to-declaration
                  (looking-at "\\<begin\\>")
-                 (ada-goto-matching-decl-start)
+                 (ada-goto-decl-start)
                  (setq pos (point))))
 
            )                           ; end of save-excursion
                  (setq pos (point))))
 
            )                           ; end of save-excursion
@@ -4423,7 +4438,7 @@ of the region.  Otherwise, operate only on the current line."
       (set-syntax-table previous-syntax-table))))
 
 (defun ada-move-to-end ()
       (set-syntax-table previous-syntax-table))))
 
 (defun ada-move-to-end ()
-  "Move point to the matching end of the block around point.
+  "Move point to the end of the block around point.
 Moves to 'begin' if in a declarative part."
   (interactive)
   (let ((pos (point))
 Moves to 'begin' if in a declarative part."
   (interactive)
   (let ((pos (point))
@@ -4473,7 +4488,7 @@ Moves to 'begin' if in a declarative part."
              (ada-goto-matching-end 0))
             ;; package start
             ((save-excursion
              (ada-goto-matching-end 0))
             ;; package start
             ((save-excursion
-               (setq decl-start (and (ada-goto-matching-decl-start t) (point)))
+               (setq decl-start (and (ada-goto-decl-start t) (point)))
                (and decl-start (looking-at "\\<package\\>")))
              (ada-goto-matching-end 1))
 
                (and decl-start (looking-at "\\<package\\>")))
              (ada-goto-matching-end 1))
 
@@ -4540,6 +4555,9 @@ Moves to 'begin' if in a declarative part."
 (defun ada-create-keymap ()
   "Create the keymap associated with the Ada mode."
 
 (defun ada-create-keymap ()
   "Create the keymap associated with the Ada mode."
 
+  ;; All non-standard keys go into ada-mode-extra-map
+  (define-key ada-mode-map ada-mode-extra-prefix ada-mode-extra-map)
+
   ;; Indentation and Formatting
   (define-key ada-mode-map "\C-j"     'ada-indent-newline-indent-conditional)
   (define-key ada-mode-map "\C-m"     'ada-indent-newline-indent-conditional)
   ;; Indentation and Formatting
   (define-key ada-mode-map "\C-j"     'ada-indent-newline-indent-conditional)
   (define-key ada-mode-map "\C-m"     'ada-indent-newline-indent-conditional)
@@ -4588,23 +4606,25 @@ Moves to 'begin' if in a declarative part."
     'ada-point-and-xref)
   (define-key ada-mode-map [(control tab)] 'ada-complete-identifier)
 
     'ada-point-and-xref)
   (define-key ada-mode-map [(control tab)] 'ada-complete-identifier)
 
-  (define-key ada-mode-map "\C-co"     'ff-find-other-file)
+  (define-key ada-mode-extra-map "o"     'ff-find-other-file)
   (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame)
   (define-key ada-mode-map "\C-c\C-d"  'ada-goto-declaration)
   (define-key ada-mode-map "\C-c\C-s"  'ada-xref-goto-previous-reference)
   (define-key ada-mode-map "\C-c\C-c"  'ada-compile-application)
   (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame)
   (define-key ada-mode-map "\C-c\C-d"  'ada-goto-declaration)
   (define-key ada-mode-map "\C-c\C-s"  'ada-xref-goto-previous-reference)
   (define-key ada-mode-map "\C-c\C-c"  'ada-compile-application)
-  (define-key ada-mode-map "\C-cc"     'ada-change-prj)
-  (define-key ada-mode-map "\C-cd"     'ada-set-default-project-file)
-  (define-key ada-mode-map "\C-cg"     'ada-gdb-application)
+  (define-key ada-mode-extra-map "c"     'ada-change-prj)
+  (define-key ada-mode-extra-map "d"     'ada-set-default-project-file)
+  (define-key ada-mode-extra-map "g"     'ada-gdb-application)
   (define-key ada-mode-map "\C-c\C-m"  'ada-set-main-compile-application)
   (define-key ada-mode-map "\C-c\C-m"  'ada-set-main-compile-application)
-  (define-key ada-mode-map "\C-cr"     'ada-run-application)
+  (define-key ada-mode-extra-map "r"     'ada-run-application)
   (define-key ada-mode-map "\C-c\C-o"  'ada-goto-parent)
   (define-key ada-mode-map "\C-c\C-r"  'ada-find-references)
   (define-key ada-mode-map "\C-c\C-o"  'ada-goto-parent)
   (define-key ada-mode-map "\C-c\C-r"  'ada-find-references)
-  (define-key ada-mode-map "\C-cl"     'ada-find-local-references)
+  (define-key ada-mode-extra-map "l"     'ada-find-local-references)
   (define-key ada-mode-map "\C-c\C-v"  'ada-check-current)
   (define-key ada-mode-map "\C-c\C-v"  'ada-check-current)
-  (define-key ada-mode-map "\C-cf"     'ada-find-file)
+  (define-key ada-mode-extra-map "f"     'ada-find-file)
 
 
-  (define-key ada-mode-map "\C-cu"  'ada-prj-edit)
+  (define-key ada-mode-extra-map "u"  'ada-prj-edit)
+
+  (define-key ada-mode-map "\C-xnd" 'ada-narrow-to-defun); override narrow-to-defun
 
   ;;  The templates, defined in ada-stmt.el
 
 
   ;;  The templates, defined in ada-stmt.el
 
@@ -4637,7 +4657,7 @@ Moves to 'begin' if in a declarative part."
     (define-key map "w"    'ada-while-loop)
     (define-key map "\C-x" 'ada-exception)
     (define-key map "x"    'ada-exit)
     (define-key map "w"    'ada-while-loop)
     (define-key map "\C-x" 'ada-exception)
     (define-key map "x"    'ada-exit)
-    (define-key ada-mode-map "\C-ct" map))
+    (define-key ada-mode-extra-map "t" map))
   )
 
 
   )
 
 
@@ -4813,10 +4833,9 @@ Moves to 'begin' if in a declarative part."
 ;; -------------------------------------------------------
 
 (defadvice comment-region (before ada-uncomment-anywhere disable)
 ;; -------------------------------------------------------
 
 (defadvice comment-region (before ada-uncomment-anywhere disable)
-  (if (and arg
-          (listp arg)  ;;  a prefix with \C-u is of the form '(4), whereas
+  (if (and (consp arg)  ;;  a prefix with \C-u is of the form '(4), whereas
                       ;;  \C-u 2  sets arg to '2'  (fixed by S.Leake)
                       ;;  \C-u 2  sets arg to '2'  (fixed by S.Leake)
-          (string= mode-name "Ada"))
+          (derived-mode-p 'ada-mode))
       (save-excursion
        (let ((cs (concat "^[ \t]*" (regexp-quote comment-start))))
          (goto-char beg)
       (save-excursion
        (let ((cs (concat "^[ \t]*" (regexp-quote comment-start))))
          (goto-char beg)
@@ -4957,11 +4976,11 @@ The paragraph is indented on the first line."
 ;; cursor at the correct position.
 ;; Standard Ada does not force any relation between unit names and file names,
 ;; so some of these functions can only be a good approximation. However, they
 ;; cursor at the correct position.
 ;; Standard Ada does not force any relation between unit names and file names,
 ;; so some of these functions can only be a good approximation. However, they
-;; are also overriden in `ada-xref'.el when we know that the user is using
+;; are also overridden in `ada-xref'.el when we know that the user is using
 ;; GNAT.
 ;; ---------------------------------------------------
 
 ;; GNAT.
 ;; ---------------------------------------------------
 
-;; Overriden when we work with GNAT, to use gnatkrunch
+;; Overridden when we work with GNAT, to use gnatkrunch
 (defun ada-make-filename-from-adaname (adaname)
   "Determine the filename in which ADANAME is found.
 This matches the GNAT default naming convention, except for
 (defun ada-make-filename-from-adaname (adaname)
   "Determine the filename in which ADANAME is found.
 This matches the GNAT default naming convention, except for
@@ -5037,9 +5056,9 @@ Used in `ff-pre-load-hook'."
   (save-excursion
     (end-of-line);;  make sure we get the complete name
     (or (if (re-search-backward ada-procedure-start-regexp nil t)
   (save-excursion
     (end-of-line);;  make sure we get the complete name
     (or (if (re-search-backward ada-procedure-start-regexp nil t)
-            (setq ff-function-name (match-string 5)))
-        (if (re-search-backward ada-package-start-regexp nil t)
-            (setq ff-function-name (match-string 4))))
+           (setq ff-function-name (match-string 5)))
+       (if (re-search-backward ada-package-start-regexp nil t)
+           (setq ff-function-name (match-string 4))))
     ))
 
 
     ))
 
 
@@ -5099,7 +5118,7 @@ Since the search can be long, the results are cached."
 
          ;; Get the function name, but not the properties, or this changes
          ;; the face in the modeline on Emacs 21
 
          ;; Get the function name, but not the properties, or this changes
          ;; the face in the modeline on Emacs 21
-         (setq func-name (match-string-no-properties 2))
+         (setq func-name (match-string-no-properties 3))
          (if (and (not (ada-in-comment-p))
                   (not (save-excursion
                          (goto-char (match-end 0))
          (if (and (not (ada-in-comment-p))
                   (not (save-excursion
                          (goto-char (match-end 0))
@@ -5182,12 +5201,12 @@ Return nil if no body was found."
 
 (defconst ada-font-lock-syntactic-keywords
   ;; Mark single quotes as having string quote syntax in 'c' instances.
 
 (defconst ada-font-lock-syntactic-keywords
   ;; Mark single quotes as having string quote syntax in 'c' instances.
-  ;; As a special case, ''' will not be highlighted, but if we do not
-  ;; set this special case, then the rest of the buffer is highlighted as
-  ;; a string
+  ;; We used to explicitly avoid ''' as a special case for fear the buffer
+  ;; be highlighted as a string, but it seems this fear is unfounded.
+  ;;
   ;; This sets the properties of the characters, so that ada-in-string-p
   ;; correctly handles '"' too...
   ;; This sets the properties of the characters, so that ada-in-string-p
   ;; correctly handles '"' too...
-  '(("[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
+  '(("[^a-zA-Z0-9)]\\('\\)[^\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
     ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))))
 
 (defvar ada-font-lock-keywords
     ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))))
 
 (defvar ada-font-lock-keywords
@@ -5240,7 +5259,7 @@ Return nil if no body was found."
                "null" "or" "others" "overriding" "private" "protected" "raise"
                "range" "record" "rem" "renames" "requeue" "return" "reverse"
                "select" "separate" "synchronized" "tagged" "task" "terminate"
                "null" "or" "others" "overriding" "private" "protected" "raise"
                "range" "record" "rem" "renames" "requeue" "return" "reverse"
                "select" "separate" "synchronized" "tagged" "task" "terminate"
-                "then" "until" "when" "while" "with" "xor") t)
+               "then" "until" "when" "while" "with" "xor") t)
             "\\>")
      ;;
      ;; Anything following end and not already fontified is a body name.
             "\\>")
      ;;
      ;; Anything following end and not already fontified is a body name.
@@ -5377,13 +5396,15 @@ for `ada-procedure-start-regexp'."
        (insert "end " procname ";")
        (ada-indent-newline-indent)
        )
        (insert "end " procname ";")
        (ada-indent-newline-indent)
        )
-       ;; else
+
        ((looking-at "[ \t\n]*is")
        ;; do nothing
        )
        ((looking-at "[ \t\n]*is")
        ;; do nothing
        )
+
        ((looking-at "[ \t\n]*rename")
        ;; do nothing
        )
        ((looking-at "[ \t\n]*rename")
        ;; do nothing
        )
+
        (t
        (message "unknown syntax"))))
      (t
        (t
        (message "unknown syntax"))))
      (t
@@ -5507,7 +5528,6 @@ This function typically is to be hooked into `ff-file-created-hook'."
 (autoload 'ada-point-and-xref               "ada-xref" nil t)
 (autoload 'ada-reread-prj-file              "ada-xref" nil t)
 (autoload 'ada-run-application              "ada-xref" nil t)
 (autoload 'ada-point-and-xref               "ada-xref" nil t)
 (autoload 'ada-reread-prj-file              "ada-xref" nil t)
 (autoload 'ada-run-application              "ada-xref" nil t)
-(autoload 'ada-set-default-project-file     "ada-xref" nil nil)
 (autoload 'ada-set-default-project-file     "ada-xref" nil t)
 (autoload 'ada-xref-goto-previous-reference "ada-xref" nil t)
 (autoload 'ada-set-main-compile-application "ada-xref" nil t)
 (autoload 'ada-set-default-project-file     "ada-xref" nil t)
 (autoload 'ada-xref-goto-previous-reference "ada-xref" nil t)
 (autoload 'ada-set-main-compile-application "ada-xref" nil t)
Unnamed repository; edit this file 'description' to name the repository.