* progmodes/ada-mode.el: Update copyright notice.

Synchronize with GNAT release 3.15a1.
Do not attempt to load ada-support, which is only for compatibility
with older Emacs versions, and is not needed for Emacs 21.
(ada-continuation-indent): New variable.
New contextual menu: "List local reference", faster than "List References".
(ada-mode): New alignment rules provided by S. Leake.
(ada-mode): Add support for which-function-mode.
Fix various calls to count-lines, that didn't work correctly when the
buffer was narrowed.
(ada-get-current-indent): Fix indentation of named parameter lists and
nested boolean expressions.
(ada-indent-on-previous-lines): Fix indentation of labels.
(ada-search-prev-end-stmt): Fix searching of the previous end-statement,
specially with regards to nested subprograms.
(comment-region advice): Initially disabled, for better compatibility with
other modes.
(ada-fill-comment-paragraph): Fixed (no longer worked with Emacs 21).

* progmodes/ada-xref.el: Update copyright notice.
(ada-xref-create-ali): The default is now not to create automatically the
ALI files by compiling the unit, since this isn't always reliable and
requires an up-to-date project file.
(ada-prj-default-comp-cmd): No longer use gcc directly to compile
a file, but use gnatmake instead, since this gives access to the GNAT
project files.
(ada-xref-search-with-egrep): New variable, suggested by P. Waroquiers.
(ada-load-project-hook): New variable, for support of GNAT project files.
(ada-update-project-menu): Fix the detection of the project file name.
(ada-add-keymap): Change key binding for ada-find-file, that conflicted
with another binding in ada-mode.el.
(ada-add-menu): New menu "List Local References", to list the reference
to the entity only in the current file, instead of looking in the whole
project.  Much faster.
(ada-find-references): New parameters arg and local-only.
(ada-find-any-references): New parameters local-only and append.
(ada-goto-declaration): Fix handling of predefined entities in xref.
(ada-get-all-references): Updated to the new xref format in GNAT 3.15,
still compatible with GNAT 3.14 of course.  Fix various calls to
count-lines, that didn't work correctly when the buffer was narrowed.

1 files changed, 168 insertions, 76 deletions

diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 62c70da0c92..3e4d5baa9ba 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1,13 +1,13 @@
 ;;; ada-mode.el --- major-mode for editing Ada sources
 
-;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001, 2002
 ;;  Free Software Foundation, Inc.
 
 ;; Author: Rolf Ebert      <ebert@inf.enst.fr>
 ;;      Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
 ;;      Emmanuel Briot  <briot@gnat.com>
 ;; Maintainer: Emmanuel Briot <briot@gnat.com>
-;; Ada Core Technologies's version:   $Revision: 1.49 $
+;; Ada Core Technologies's version:   Revision: 1.164.2.2 (GNAT 3.15)
 ;; Keywords: languages ada
 
 ;; This file is part of GNU Emacs.
@@ -156,8 +156,8 @@ If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
 
 ;;  This call should not be made in the release that is done for the
 ;;  official Emacs, since it does nothing useful for the latest version
-(if (not (ada-check-emacs-version 21 1))
-    (require 'ada-support))
+;;  (if (not (ada-check-emacs-version 21 1))
+;;      (require 'ada-support))
 
 (defvar ada-mode-hook nil
   "*List of functions to call when Ada mode is invoked.
@@ -192,6 +192,15 @@ An example is :
                         >>>>>>>>>Value);  -- from ada-broken-indent"
   :type 'integer :group 'ada)
 
+(defcustom ada-continuation-indent ada-broken-indent
+  "*Number of columns to indent the continuation of broken lines in
+parenthesis.
+
+An example is :
+   Func (Param1,
+         >>>>>Param2);"
+  :type 'integer :group 'ada)
+
 (defcustom ada-case-attribute 'ada-capitalize-word
   "*Function to call to adjust the case of Ada attributes.
 It may be `downcase-word', `upcase-word', `ada-loose-case-word',
@@ -349,7 +358,9 @@ with `ada-fill-comment-paragraph-postfix'."
 An example is:
 procedure Foo is
 begin
->>>>>>>>>>>>Label:  --  from ada-label-indent"
+>>>>>>>>>>>>Label:  --  from ada-label-indent
+
+This is also used for <<..>> labels"
   :type 'integer :group 'ada)
 
 (defcustom ada-language-version 'ada95
@@ -669,6 +680,8 @@ Modify this variable if you want to restore the point to another position.")
          :included (functionp 'ada-xref-goto-previous-reference)]
         ["List References" ada-find-references
          :included ada-contextual-menu-on-identifier]
+        ["List Local References" ada-find-local-references
+         :included ada-contextual-menu-on-identifier]
         ["-" nil nil]
         ["Other File" ff-find-other-file]
         ["Goto Parent Unit" ada-goto-parent]
@@ -699,6 +712,10 @@ Modify this variable if you want to restore the point to another position.")
               '(menu-item "List References"
                           ada-find-references
                           :visible ada-contextual-menu-on-identifier) t)
+            (define-key-after map [List-Local]
+              '(menu-item "List Local References"
+                          ada-find-local-references
+                          :visible ada-contextual-menu-on-identifier) t)
             (define-key-after map [-] '("-" nil) t)
             ))
       (define-key-after map [Other] '("Other file" . ff-find-other-file) t)
@@ -940,6 +957,7 @@ as numbers instead of gnatprep comments."
       ;;  Setting this only if font-lock is not set won't work
       ;;  if the user activates or deactivates font-lock-mode,
       ;;  but will make things faster most of the time
+      (make-local-hook 'after-change-functions)
       (add-hook 'after-change-functions 'ada-after-change-function nil t)
       )))
 
@@ -1085,7 +1103,7 @@ name"
 ;;;###autoload
 (defun ada-mode ()
   "Ada mode is the major mode for editing Ada code.
-This version was built on $Date: 2002/04/09 18:50:17 $.
+This version was built on Date: 2002/05/21 11:58:02 .
 
 Bindings are as follows: (Note: 'LFD' is control-j.)
 \\{ada-mode-map}
@@ -1290,14 +1308,50 @@ If you use ada-xref.el:
       (progn
         (add-to-list 'align-dq-string-modes 'ada-mode)
         (add-to-list 'align-open-comment-modes 'ada-mode)
-        (set 'align-mode-rules-list ada-align-modes)
         (set (make-variable-buffer-local 'align-region-separate)
              ada-align-region-separate)
-        ))
 
-  ;;  Support for which-function-mode is provided in ada-support (support
-  ;;  for nested subprograms)
+        ;; Exclude comments alone on line from alignment.
+        (add-to-list 'align-exclude-rules-list
+                     '(ada-solo-comment
+                       (regexp  . "^\\(\\s-*\\)--")
+                       (modes   . '(ada-mode))))
+        (add-to-list 'align-exclude-rules-list
+                     '(ada-solo-use
+                       (regexp  . "^\\(\\s-*\\)\\<use\\>")
+                       (modes   . '(ada-mode))))
+
+        (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))))
+        (add-to-list 'ada-align-modes
+                     '(ada-associate
+                       (regexp  . "[^=]\\(\\s-*\\)=>")
+                       (valid   . (lambda() (not (ada-in-comment-p))))
+                       (modes   . '(ada-mode))))
+        (add-to-list 'ada-align-modes
+                     '(ada-comment
+                       (regexp  . "\\(\\s-*\\)--")
+                       (modes   . '(ada-mode))))
+        (add-to-list 'ada-align-modes
+                     '(ada-use
+                       (regexp  . "\\(\\s-*\\)\\<use\\s-")
+                       (valid   . (lambda() (not (ada-in-comment-p))))
+                       (modes   . '(ada-mode))))
+        (add-to-list 'ada-align-modes
+                     '(ada-at
+                       (regexp . "\\(\\s-+\\)at\\>")
+                       (modes . '(ada-mode))))
 
+        
+        (setq align-mode-rules-list ada-align-modes)
+        ))
+  
   ;;  Set up the contextual menu
   (if ada-popup-key
       (define-key ada-mode-map ada-popup-key 'ada-popup-menu))
@@ -1306,6 +1360,30 @@ If you use ada-xref.el:
   (define-abbrev-table 'ada-mode-abbrev-table ())
   (setq local-abbrev-table ada-mode-abbrev-table)
 
+  ;;  Support for which-function mode
+  ;; which-function-mode does not work with nested subprograms, since it is
+  ;; based only on the regexps generated by imenu, and thus can only detect the
+  ;; beginning of subprograms, not the end.
+  ;; Fix is: redefine a new function ada-which-function, and call it when the
+  ;; major-mode is ada-mode.
+  
+  (unless ada-xemacs
+    ;;  This function do not require that we load which-func now.
+    ;;  This can be done by the user if he decides to use which-func-mode
+    
+    (defadvice which-function (around ada-which-function activate)
+      "In Ada buffers, should work with overloaded subprograms, and does not
+use imenu."
+      (if (equal major-mode 'ada-mode)
+          (set 'ad-return-value (ada-which-function))
+        ad-do-it))
+
+    ;;  So that we can activate which-func-modes for Ada mode
+    (if (and (boundp 'which-func-modes)
+             (listp which-func-modes))
+        (add-to-list 'which-func-modes 'ada-mode))
+    )
+
   ;;  Support for indent-new-comment-line (Especially for XEmacs)
   (setq comment-multi-line nil)
 
@@ -1321,7 +1399,7 @@ If you use ada-xref.el:
   (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)
+        (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))))))
@@ -2137,7 +2215,7 @@ This function is intended to be bound to the \C-m and \C-j keys."
 
     (let ((line (save-excursion
                   (goto-char (car cur-indent))
-                  (count-lines (point-min) (point)))))
+                  (count-lines 1 (point)))))
 
       (if (equal (cdr cur-indent) '(0))
           (message (concat "same indentation as line " (number-to-string line)))
@@ -2289,26 +2367,25 @@ offset."
               ;; ??? Could use a different variable
               (list column 'ada-broken-indent)
 
-            ;;  Correctly indent named parameter lists ("name => ...") for
-            ;;  all the following lines
-            (goto-char column)
-            (if (and (progn (forward-comment 1000)
-                            (looking-at "\\sw+\\s *=>"))
-                     (progn (goto-char orgpoint)
-                            (forward-comment 1000)
-                            (not (looking-at "\\sw+\\s *=>"))))
-                (list column 'ada-broken-indent)
-
-              ;;  ??? Would be nice that lines like
-              ;;   A
-              ;;     (B,
-              ;;      C
-              ;;        (E));  --  would be nice if this was correctly indented
-;             (if (= (char-before (1- orgpoint)) ?,)
-                  (list column 0)
-;               (list column 'ada-broken-indent)
-;               )
-            )))))
+            ;;  We want all continuation lines to be indented the same
+            ;;  (ada-broken-line from the opening parenthesis. However, in
+            ;;  parameter list, each new parameter should be indented at the
+            ;;  column as the opening parenthesis.
+
+            ;;  A special case to handle nested boolean expressions, as in
+            ;;    ((B
+            ;;        and then C) --  indented by ada-broken-indent
+            ;;     or else D)     --  indenting this line.
+            ;;  ??? This is really a hack, we should have a proper way to go to
+            ;;  ??? the beginning of the statement
+            
+            (if (= (char-before) ?\))
+                (backward-sexp))
+            
+            (if (memq (char-before) '(?, ?\; ?\( ?\)))
+                (list column 0)
+              (list column 'ada-continuation-indent)
+              )))))
 
      ;;---------------------------
      ;;   at end of buffer
@@ -2493,7 +2570,9 @@ offset."
             (list (progn (back-to-indentation) (point)) 'ada-indent))
         (save-excursion
           (ada-goto-stmt-start)
-          (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))))
+          (if (looking-at "\\<package\\|procedure\\|function\\>")
+              (list (progn (back-to-indentation) (point)) 0)
+            (list (progn (back-to-indentation) (point)) 'ada-indent)))))
 
      ;;---------------------------
      ;;  starting with r (return, renames)
@@ -2733,6 +2812,12 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
          ;;
          ((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
@@ -3346,26 +3431,35 @@ match."
 
       (goto-char (car match-dat))
       (unless (ada-in-open-paren-p)
-        (if (and (looking-at
-                  "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
-                 (save-excursion
-                   (ada-goto-previous-word)
-                   (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]")))
-            (forward-word -1)
-
-          (save-excursion
-            (goto-char (cdr match-dat))
-            (ada-goto-next-non-ws)
-            (looking-at "(")
-            ;;  words that can go after an 'is'
-            (unless (looking-at
-                     (eval-when-compile
-                       (concat "\\<"
-                               (regexp-opt '("separate" "access" "array"
-                                             "abstract" "new") t)
-                               "\\>\\|(")))
-              (setq found t))))
-        ))
+        (cond
+         
+         ((and (looking-at
+                "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
+               (save-excursion
+                 (ada-goto-previous-word)
+                 (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]")))
+          (forward-word -1))
+
+         ((looking-at "is")
+          (setq found
+                (and (save-excursion (ada-goto-previous-word)
+                                     (ada-goto-previous-word)
+                                     (not (looking-at "subtype")))
+                    
+                    (save-excursion (goto-char (cdr match-dat))
+                                    (ada-goto-next-non-ws)
+                                    ;;  words that can go after an 'is'
+                                    (not (looking-at
+                                     (eval-when-compile
+                                       (concat "\\<"
+                                               (regexp-opt
+                                                '("separate" "access" "array"
+                                                  "abstract" "new") t)
+                                               "\\>\\|("))))))))
+              
+         (t
+          (setq found t))
+        )))
 
     (if found
         match-dat
@@ -3702,8 +3796,7 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
                   (error (concat
                           "No matching 'is' or 'renames' for 'package' at"
                           " line "
-                          (number-to-string (count-lines (point-min)
-                                                         (1+ current)))))))
+                          (number-to-string (count-lines 1 (1+ current)))))))
               (unless (looking-at "renames")
                 (progn
                   (forward-word 1)
@@ -3814,7 +3907,7 @@ If NOERROR is non-nil, it only returns nil if found no matching start."
     ;;  in the nesting loop below, so we just make sure we don't count it.
     ;;  "declare" is a special case because we need to look after the "begin"
     ;;  keyword
-    (if (and (not first) (looking-at regex))
+    (if (looking-at "\\<if\\|loop\\|case\\>")
         (forward-char 1))
 
     ;;
@@ -4306,9 +4399,10 @@ Moves to 'begin' if in a declarative part."
           (save-excursion
 
             (cond
+             ;; Go to the beginning of the current word, and check if we are
              ;; directly on 'begin'
              ((save-excursion
-                (ada-goto-previous-word)
+                (skip-syntax-backward "w")
                 (looking-at "\\<begin\\>"))
               (ada-goto-matching-end 1))
              
@@ -4344,6 +4438,12 @@ Moves to 'begin' if in a declarative part."
                 (setq decl-start (and (ada-goto-matching-decl-start t) (point)))
                 (and decl-start (looking-at "\\<package\\>")))
               (ada-goto-matching-end 1))
+
+             ;;  On a "declare" keyword
+             ((save-excursion
+                (skip-syntax-backward "w")
+                (looking-at "\\<declare\\>"))
+              (ada-goto-matching-end 0 t))
              
              ;; inside a 'begin' ... 'end' block
              (decl-start
@@ -4530,7 +4630,7 @@ can add its own items."
 ;;  function for justifying the comments.
 ;; -------------------------------------------------------
 
-(defadvice comment-region (before ada-uncomment-anywhere)
+(defadvice comment-region (before ada-uncomment-anywhere disable)
   (if (and arg
            (listp arg)  ;;  a prefix with \C-u is of the form '(4), whereas
                        ;;  \C-u 2  sets arg to '2'  (fixed by S.Leake)
@@ -4553,7 +4653,8 @@ can add its own items."
         (ad-activate 'comment-region)
         (comment-region beg end (- (or arg 2)))
         (ad-deactivate 'comment-region))
-    (comment-region beg end (list (- (or arg 2))))))
+    (comment-region beg end (list (- (or arg 2))))
+    (ada-indent-region beg end)))
 
 (defun ada-fill-comment-paragraph-justify ()
   "Fills current comment paragraph and justifies each line as well."
@@ -4579,10 +4680,8 @@ The paragraph is indented on the first line."
            (not (looking-at "[ \t]*--")))
       (error "not inside comment"))
 
-  (let* ((indent)
-         (from)
-         (to)
-         (opos             (point-marker))
+  (let* (indent from to
+         (opos (point-marker))
 
          ;; Sets this variable to nil, otherwise it prevents
          ;; fill-region-as-paragraph to work on Emacs <= 20.2
@@ -4593,7 +4692,7 @@ The paragraph is indented on the first line."
 
     ;;  Find end of paragraph
     (back-to-indentation)
-    (while (and (not (eobp)) (looking-at "--[ \t]*[^ \t\n]"))
+    (while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
       (forward-line 1)
 
       ;;  If we were at the last line in the buffer, create a dummy empty
@@ -4607,11 +4706,11 @@ The paragraph is indented on the first line."
 
     ;;  Find beginning of paragraph
     (back-to-indentation)
-    (while (and (not (bobp)) (looking-at "--[ \t]*[^ \t\n]"))
+    (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
       (forward-line -1)
       (back-to-indentation))
 
-    ;;  We want one line to above the first one, unless we are at the beginning
+    ;;  We want one line above the first one, unless we are at the beginning
     ;;  of the buffer
     (unless (bobp)
       (forward-line 1))
@@ -4629,13 +4728,6 @@ The paragraph is indented on the first line."
     (while (re-search-forward "--\n" to t)
       (replace-match "\n"))
 
-    ;;  Remove the old prefixes (so that the number of spaces after -- is not
-    ;;  relevant), except on the first one since `fill-region-as-paragraph'
-    ;;  would not put it back on the first line.
-    (goto-char (+ from 2))
-    (while (re-search-forward "^-- *" to t)
-      (replace-match " "))
-
     (goto-char (1- to))
     (setq to (point-marker))
 
@@ -4777,10 +4869,10 @@ Redefines the function `ff-which-function-are-we-in'."
 (defun ada-which-function ()
   "Returns the name of the function whose body the point is in.
 This function works even in the case of nested subprograms, whereas the
-standard Emacs function which-function does not.
+standard Emacs function `which-function' does not.
 Since the search can be long, the results are cached."
 
-  (let ((line (count-lines (point-min) (point)))
+  (let ((line (count-lines 1 (point)))
         (pos (point))
         end-pos
         func-name indent
@@ -4798,7 +4890,7 @@ Since the search can be long, the results are cached."
         (skip-chars-forward " \t\n(")
         
         (condition-case nil
-            (up-list)
+            (up-list 1)
           (error nil))
 
         (skip-chars-forward " \t\n")