Mercurial > emacs

changeset 45931:a4c8d672ccbe

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* 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.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Thu, 20 Jun 2002 17:40:38 +0000
parents dd1d952f59c2
children 0a6b996970fa
files lisp/progmodes/ada-mode.el
diffstat 1 files changed, 169 insertions(+), 77 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/progmodes/ada-mode.el	Thu Jun 20 17:31:56 2002 +0000
+++ b/lisp/progmodes/ada-mode.el	Thu Jun 20 17:40:38 2002 +0000
@@ -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 @@
 
 ;;  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 @@
                         >>>>>>>>>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 @@
 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 @@
          :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 @@
               '(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 @@
       ;;  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 @@
 ;;;###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 @@
       (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)
+
+	;; 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)
 	))
-
-  ;;  Support for which-function-mode is provided in ada-support (support
-  ;;  for nested subprograms)
-
+  
   ;;  Set up the contextual menu
   (if ada-popup-key
       (define-key ada-mode-map ada-popup-key 'ada-popup-menu))
@@ -1306,6 +1360,30 @@
   (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 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 @@
 
     (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 @@
 	      ;; ??? 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 @@
             (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 @@
          ;;
          ((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 @@
 
       (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 @@
                   (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 @@
     ;;  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 @@
           (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 @@
 		(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 @@
 ;;  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 @@
 	(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 @@
            (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 @@
 
     ;;  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 @@
 
     ;;  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 @@
     (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 @@
 (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 @@
 	(skip-chars-forward " \t\n(")
 	
 	(condition-case nil
-	    (up-list)
+	    (up-list 1)
 	  (error nil))
 
 	(skip-chars-forward " \t\n")