emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/progmodes/ada-mode.el


From: Stefan Monnier
Subject: [Emacs-diffs] Changes to emacs/lisp/progmodes/ada-mode.el
Date: Thu, 20 Jun 2002 13:40:38 -0400

Index: emacs/lisp/progmodes/ada-mode.el
diff -c emacs/lisp/progmodes/ada-mode.el:1.50 
emacs/lisp/progmodes/ada-mode.el:1.51
*** emacs/lisp/progmodes/ada-mode.el:1.50       Sun Apr 28 17:14:17 2002
--- emacs/lisp/progmodes/ada-mode.el    Thu Jun 20 13:40:38 2002
***************
*** 1,13 ****
  ;;; ada-mode.el --- major-mode for editing Ada sources
  
! ;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001
  ;;  Free Software Foundation, Inc.
  
  ;; Author: Rolf Ebert      <address@hidden>
  ;;      Markus Heritsch <address@hidden>
  ;;      Emmanuel Briot  <address@hidden>
  ;; Maintainer: Emmanuel Briot <address@hidden>
! ;; Ada Core Technologies's version:   $Revision: 1.50 $
  ;; Keywords: languages ada
  
  ;; This file is part of GNU Emacs.
--- 1,13 ----
  ;;; ada-mode.el --- major-mode for editing Ada sources
  
! ;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001, 2002
  ;;  Free Software Foundation, Inc.
  
  ;; Author: Rolf Ebert      <address@hidden>
  ;;      Markus Heritsch <address@hidden>
  ;;      Emmanuel Briot  <address@hidden>
  ;; Maintainer: Emmanuel Briot <address@hidden>
! ;; Ada Core Technologies's version:   Revision: 1.164.2.2 (GNAT 3.15)
  ;; Keywords: languages ada
  
  ;; This file is part of GNU Emacs.
***************
*** 156,163 ****
  
  ;;  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))
  
  (defvar ada-mode-hook nil
    "*List of functions to call when Ada mode is invoked.
--- 156,163 ----
  
  ;;  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))
  
  (defvar ada-mode-hook nil
    "*List of functions to call when Ada mode is invoked.
***************
*** 192,197 ****
--- 192,206 ----
                          >>>>>>>>>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,355 ****
  An example is:
  procedure Foo is
  begin
! >>>>>>>>>>>>Label:  --  from ada-label-indent"
    :type 'integer :group 'ada)
  
  (defcustom ada-language-version 'ada95
--- 358,366 ----
  An example is:
  procedure Foo is
  begin
! >>>>>>>>>>>>Label:  --  from ada-label-indent
! 
! This is also used for <<..>> labels"
    :type 'integer :group 'ada)
  
  (defcustom ada-language-version 'ada95
***************
*** 669,674 ****
--- 680,687 ----
           :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,704 ****
--- 712,721 ----
                '(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,945 ****
--- 957,963 ----
        ;;  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,1091 ****
  ;;;###autoload
  (defun ada-mode ()
    "Ada mode is the major mode for editing Ada code.
! This version was built on $Date: 2002/04/28 21:14:17 $.
  
  Bindings are as follows: (Note: 'LFD' is control-j.)
  \\{ada-mode-map}
--- 1103,1109 ----
  ;;;###autoload
  (defun ada-mode ()
    "Ada mode is the major mode for editing Ada code.
! 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,1303 ****
        (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)
  
    ;;  Set up the contextual menu
    (if ada-popup-key
        (define-key ada-mode-map ada-popup-key 'ada-popup-menu))
--- 1308,1357 ----
        (progn
        (add-to-list 'align-dq-string-modes 'ada-mode)
        (add-to-list 'align-open-comment-modes 'ada-mode)
        (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)
+       ))
+   
    ;;  Set up the contextual menu
    (if ada-popup-key
        (define-key ada-mode-map ada-popup-key 'ada-popup-menu))
***************
*** 1306,1311 ****
--- 1360,1389 ----
    (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,1327 ****
    (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))))))
--- 1399,1405 ----
    (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))))))
***************
*** 2137,2143 ****
  
      (let ((line (save-excursion
                  (goto-char (car cur-indent))
!                 (count-lines (point-min) (point)))))
  
        (if (equal (cdr cur-indent) '(0))
          (message (concat "same indentation as line " (number-to-string line)))
--- 2215,2221 ----
  
      (let ((line (save-excursion
                  (goto-char (car cur-indent))
!                 (count-lines 1 (point)))))
  
        (if (equal (cdr cur-indent) '(0))
          (message (concat "same indentation as line " (number-to-string line)))
***************
*** 2289,2314 ****
              ;; ??? 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)
! ;             )
!           )))))
  
       ;;---------------------------
       ;;   at end of buffer
--- 2367,2391 ----
              ;; ??? Could use a different variable
              (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,2499 ****
              (list (progn (back-to-indentation) (point)) 'ada-indent))
          (save-excursion
            (ada-goto-stmt-start)
!           (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))))
  
       ;;---------------------------
       ;;  starting with r (return, renames)
--- 2570,2578 ----
              (list (progn (back-to-indentation) (point)) 'ada-indent))
          (save-excursion
            (ada-goto-stmt-start)
!         (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,2738 ****
--- 2812,2823 ----
           ;;
           ((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,3371 ****
  
        (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))))
!         ))
  
      (if found
          match-dat
--- 3431,3465 ----
  
        (goto-char (car match-dat))
        (unless (ada-in-open-paren-p)
!       (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,3709 ****
                    (error (concat
                            "No matching 'is' or 'renames' for 'package' at"
                            " line "
!                           (number-to-string (count-lines (point-min)
!                                                          (1+ current)))))))
                (unless (looking-at "renames")
                  (progn
                    (forward-word 1)
--- 3796,3802 ----
                    (error (concat
                            "No matching 'is' or 'renames' for 'package' at"
                            " line "
!                           (number-to-string (count-lines 1 (1+ current)))))))
                (unless (looking-at "renames")
                  (progn
                    (forward-word 1)
***************
*** 3814,3820 ****
      ;;  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))
        (forward-char 1))
  
      ;;
--- 3907,3913 ----
      ;;  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 (looking-at "\\<if\\|loop\\|case\\>")
        (forward-char 1))
  
      ;;
***************
*** 4306,4314 ****
            (save-excursion
  
              (cond
               ;; directly on 'begin'
             ((save-excursion
!               (ada-goto-previous-word)
                (looking-at "\\<begin\\>"))
              (ada-goto-matching-end 1))
             
--- 4399,4408 ----
            (save-excursion
  
              (cond
+              ;; Go to the beginning of the current word, and check if we are
               ;; directly on 'begin'
             ((save-excursion
!               (skip-syntax-backward "w")
                (looking-at "\\<begin\\>"))
              (ada-goto-matching-end 1))
             
***************
*** 4344,4349 ****
--- 4438,4449 ----
                (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,4536 ****
  ;;  function for justifying the comments.
  ;; -------------------------------------------------------
  
! (defadvice comment-region (before ada-uncomment-anywhere)
    (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)
--- 4630,4636 ----
  ;;  function for justifying the comments.
  ;; -------------------------------------------------------
  
! (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,4559 ****
        (ad-activate 'comment-region)
        (comment-region beg end (- (or arg 2)))
        (ad-deactivate 'comment-region))
!     (comment-region beg end (list (- (or arg 2))))))
  
  (defun ada-fill-comment-paragraph-justify ()
    "Fills current comment paragraph and justifies each line as well."
--- 4653,4660 ----
        (ad-activate 'comment-region)
        (comment-region beg end (- (or arg 2)))
        (ad-deactivate 'comment-region))
!     (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,4588 ****
             (not (looking-at "[ \t]*--")))
        (error "not inside comment"))
  
!   (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
--- 4680,4687 ----
             (not (looking-at "[ \t]*--")))
        (error "not inside comment"))
  
!   (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,4599 ****
  
      ;;  Find end of paragraph
      (back-to-indentation)
!     (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
--- 4692,4698 ----
  
      ;;  Find end of paragraph
      (back-to-indentation)
!     (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,4617 ****
  
      ;;  Find beginning of paragraph
      (back-to-indentation)
!     (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
      ;;  of the buffer
      (unless (bobp)
        (forward-line 1))
--- 4706,4716 ----
  
      ;;  Find beginning of paragraph
      (back-to-indentation)
!     (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
        (forward-line -1)
        (back-to-indentation))
  
!     ;;  We want one line above the first one, unless we are at the beginning
      ;;  of the buffer
      (unless (bobp)
        (forward-line 1))
***************
*** 4629,4641 ****
      (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))
  
--- 4728,4733 ----
***************
*** 4777,4786 ****
  (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.
  Since the search can be long, the results are cached."
  
!   (let ((line (count-lines (point-min) (point)))
          (pos (point))
          end-pos
          func-name indent
--- 4869,4878 ----
  (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.
  Since the search can be long, the results are cached."
  
!   (let ((line (count-lines 1 (point)))
          (pos (point))
          end-pos
          func-name indent
***************
*** 4798,4804 ****
        (skip-chars-forward " \t\n(")
        
        (condition-case nil
!           (up-list)
          (error nil))
  
        (skip-chars-forward " \t\n")
--- 4890,4896 ----
        (skip-chars-forward " \t\n(")
        
        (condition-case nil
!           (up-list 1)
          (error nil))
  
        (skip-chars-forward " \t\n")



reply via email to

[Prev in Thread] Current Thread [Next in Thread]