/[emacs]/emacs/lisp/progmodes/ada-mode.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/ada-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.50 by rms, Sun Apr 28 21:14:17 2002 UTC revision 1.50.2.1 by miles, Fri Apr 4 06:20:31 2003 UTC
# Line 1  Line 1 
1  ;;; ada-mode.el --- major-mode for editing Ada sources  ;;; ada-mode.el --- major-mode for editing Ada sources
2    
3  ;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001  ;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001, 2002
4  ;;  Free Software Foundation, Inc.  ;;  Free Software Foundation, Inc.
5    
6  ;; Author: Rolf Ebert      <ebert@inf.enst.fr>  ;; Author: Rolf Ebert      <ebert@inf.enst.fr>
7  ;;      Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>  ;;      Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
8  ;;      Emmanuel Briot  <briot@gnat.com>  ;;      Emmanuel Briot  <briot@gnat.com>
9  ;; Maintainer: Emmanuel Briot <briot@gnat.com>  ;; Maintainer: Emmanuel Briot <briot@gnat.com>
10  ;; Ada Core Technologies's version:   $Revision$  ;; Ada Core Technologies's version:   Revision: 1.164.2.2 (GNAT 3.15)
11  ;; Keywords: languages ada  ;; Keywords: languages ada
12    
13  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 156  If IS-XEMACS is non-nil, check for XEmac Line 156  If IS-XEMACS is non-nil, check for XEmac
156    
157  ;;  This call should not be made in the release that is done for the  ;;  This call should not be made in the release that is done for the
158  ;;  official Emacs, since it does nothing useful for the latest version  ;;  official Emacs, since it does nothing useful for the latest version
159  (if (not (ada-check-emacs-version 21 1))  ;;  (if (not (ada-check-emacs-version 21 1))
160      (require 'ada-support))  ;;      (require 'ada-support))
161    
162  (defvar ada-mode-hook nil  (defvar ada-mode-hook nil
163    "*List of functions to call when Ada mode is invoked.    "*List of functions to call when Ada mode is invoked.
# Line 192  An example is : Line 192  An example is :
192                          >>>>>>>>>Value);  -- from ada-broken-indent"                          >>>>>>>>>Value);  -- from ada-broken-indent"
193    :type 'integer :group 'ada)    :type 'integer :group 'ada)
194    
195    (defcustom ada-continuation-indent ada-broken-indent
196      "*Number of columns to indent the continuation of broken lines in
197    parenthesis.
198    
199    An example is :
200       Func (Param1,
201             >>>>>Param2);"
202      :type 'integer :group 'ada)
203    
204  (defcustom ada-case-attribute 'ada-capitalize-word  (defcustom ada-case-attribute 'ada-capitalize-word
205    "*Function to call to adjust the case of Ada attributes.    "*Function to call to adjust the case of Ada attributes.
206  It may be `downcase-word', `upcase-word', `ada-loose-case-word',  It may be `downcase-word', `upcase-word', `ada-loose-case-word',
# Line 294  type A is Line 303  type A is
303     Value_1,     Value_1,
304     Value_2);"     Value_2);"
305    :type 'boolean :group 'ada)    :type 'boolean :group 'ada)
306      
307  (defcustom ada-indent-is-separate t  (defcustom ada-indent-is-separate t
308    "*Non-nil means indent 'is separate' or 'is abstract' if on a single line."    "*Non-nil means indent 'is separate' or 'is abstract' if on a single line."
309    :type 'boolean :group 'ada)    :type 'boolean :group 'ada)
# Line 349  with `ada-fill-comment-paragraph-postfix Line 358  with `ada-fill-comment-paragraph-postfix
358  An example is:  An example is:
359  procedure Foo is  procedure Foo is
360  begin  begin
361  >>>>>>>>>>>>Label:  --  from ada-label-indent"  >>>>>>>>>>>>Label:  --  from ada-label-indent
362    
363    This is also used for <<..>> labels"
364    :type 'integer :group 'ada)    :type 'integer :group 'ada)
365    
366  (defcustom ada-language-version 'ada95  (defcustom ada-language-version 'ada95
# Line 669  Modify this variable if you want to rest Line 680  Modify this variable if you want to rest
680           :included (functionp 'ada-xref-goto-previous-reference)]           :included (functionp 'ada-xref-goto-previous-reference)]
681          ["List References" ada-find-references          ["List References" ada-find-references
682           :included ada-contextual-menu-on-identifier]           :included ada-contextual-menu-on-identifier]
683            ["List Local References" ada-find-local-references
684             :included ada-contextual-menu-on-identifier]
685          ["-" nil nil]          ["-" nil nil]
686          ["Other File" ff-find-other-file]          ["Other File" ff-find-other-file]
687          ["Goto Parent Unit" ada-goto-parent]          ["Goto Parent Unit" ada-goto-parent]
# Line 699  Modify this variable if you want to rest Line 712  Modify this variable if you want to rest
712                '(menu-item "List References"                '(menu-item "List References"
713                            ada-find-references                            ada-find-references
714                            :visible ada-contextual-menu-on-identifier) t)                            :visible ada-contextual-menu-on-identifier) t)
715                (define-key-after map [List-Local]
716                  '(menu-item "List Local References"
717                              ada-find-local-references
718                              :visible ada-contextual-menu-on-identifier) t)
719              (define-key-after map [-] '("-" nil) t)              (define-key-after map [-] '("-" nil) t)
720              ))              ))
721        (define-key-after map [Other] '("Other file" . ff-find-other-file) t)        (define-key-after map [Other] '("Other file" . ff-find-other-file) t)
# Line 940  as numbers instead of gnatprep comments. Line 957  as numbers instead of gnatprep comments.
957        ;;  Setting this only if font-lock is not set won't work        ;;  Setting this only if font-lock is not set won't work
958        ;;  if the user activates or deactivates font-lock-mode,        ;;  if the user activates or deactivates font-lock-mode,
959        ;;  but will make things faster most of the time        ;;  but will make things faster most of the time
960          (make-local-hook 'after-change-functions)
961        (add-hook 'after-change-functions 'ada-after-change-function nil t)        (add-hook 'after-change-functions 'ada-after-change-function nil t)
962        )))        )))
963    
# Line 1085  name" Line 1103  name"
1103  ;;;###autoload  ;;;###autoload
1104  (defun ada-mode ()  (defun ada-mode ()
1105    "Ada mode is the major mode for editing Ada code.    "Ada mode is the major mode for editing Ada code.
1106  This version was built on $Date$.  This version was built on Date: 2002/05/21 11:58:02 .
1107    
1108  Bindings are as follows: (Note: 'LFD' is control-j.)  Bindings are as follows: (Note: 'LFD' is control-j.)
1109  \\{ada-mode-map}  \\{ada-mode-map}
# Line 1290  If you use ada-xref.el: Line 1308  If you use ada-xref.el:
1308        (progn        (progn
1309          (add-to-list 'align-dq-string-modes 'ada-mode)          (add-to-list 'align-dq-string-modes 'ada-mode)
1310          (add-to-list 'align-open-comment-modes 'ada-mode)          (add-to-list 'align-open-comment-modes 'ada-mode)
         (set 'align-mode-rules-list ada-align-modes)  
1311          (set (make-variable-buffer-local 'align-region-separate)          (set (make-variable-buffer-local 'align-region-separate)
1312               ada-align-region-separate)               ada-align-region-separate)
         ))  
1313    
1314    ;;  Support for which-function-mode is provided in ada-support (support          ;; Exclude comments alone on line from alignment.
1315    ;;  for nested subprograms)          (add-to-list 'align-exclude-rules-list
1316                         '(ada-solo-comment
1317                           (regexp  . "^\\(\\s-*\\)--")
1318                           (modes   . '(ada-mode))))
1319            (add-to-list 'align-exclude-rules-list
1320                         '(ada-solo-use
1321                           (regexp  . "^\\(\\s-*\\)\\<use\\>")
1322                           (modes   . '(ada-mode))))
1323    
1324            (setq ada-align-modes nil)
1325    
1326            (add-to-list 'ada-align-modes
1327                         '(ada-declaration-assign
1328                           (regexp  . "[^:]\\(\\s-*\\):[^:]")
1329                           (valid   . (lambda() (not (ada-in-comment-p))))
1330                           (repeat . t)
1331                           (modes   . '(ada-mode))))
1332            (add-to-list 'ada-align-modes
1333                         '(ada-associate
1334                           (regexp  . "[^=]\\(\\s-*\\)=>")
1335                           (valid   . (lambda() (not (ada-in-comment-p))))
1336                           (modes   . '(ada-mode))))
1337            (add-to-list 'ada-align-modes
1338                         '(ada-comment
1339                           (regexp  . "\\(\\s-*\\)--")
1340                           (modes   . '(ada-mode))))
1341            (add-to-list 'ada-align-modes
1342                         '(ada-use
1343                           (regexp  . "\\(\\s-*\\)\\<use\\s-")
1344                           (valid   . (lambda() (not (ada-in-comment-p))))
1345                           (modes   . '(ada-mode))))
1346            (add-to-list 'ada-align-modes
1347                         '(ada-at
1348                           (regexp . "\\(\\s-+\\)at\\>")
1349                           (modes . '(ada-mode))))
1350    
1351    
1352            (setq align-mode-rules-list ada-align-modes)
1353            ))
1354    
1355    ;;  Set up the contextual menu    ;;  Set up the contextual menu
1356    (if ada-popup-key    (if ada-popup-key
# Line 1306  If you use ada-xref.el: Line 1360  If you use ada-xref.el:
1360    (define-abbrev-table 'ada-mode-abbrev-table ())    (define-abbrev-table 'ada-mode-abbrev-table ())
1361    (setq local-abbrev-table ada-mode-abbrev-table)    (setq local-abbrev-table ada-mode-abbrev-table)
1362    
1363      ;;  Support for which-function mode
1364      ;; which-function-mode does not work with nested subprograms, since it is
1365      ;; based only on the regexps generated by imenu, and thus can only detect the
1366      ;; beginning of subprograms, not the end.
1367      ;; Fix is: redefine a new function ada-which-function, and call it when the
1368      ;; major-mode is ada-mode.
1369    
1370      (unless ada-xemacs
1371        ;;  This function do not require that we load which-func now.
1372        ;;  This can be done by the user if he decides to use which-func-mode
1373    
1374        (defadvice which-function (around ada-which-function activate)
1375          "In Ada buffers, should work with overloaded subprograms, and does not
1376    use imenu."
1377          (if (equal major-mode 'ada-mode)
1378              (set 'ad-return-value (ada-which-function))
1379            ad-do-it))
1380    
1381        ;;  So that we can activate which-func-modes for Ada mode
1382        (if (and (boundp 'which-func-modes)
1383                 (listp which-func-modes))
1384            (add-to-list 'which-func-modes 'ada-mode))
1385        )
1386    
1387    ;;  Support for indent-new-comment-line (Especially for XEmacs)    ;;  Support for indent-new-comment-line (Especially for XEmacs)
1388    (setq comment-multi-line nil)    (setq comment-multi-line nil)
1389    
# Line 1321  If you use ada-xref.el: Line 1399  If you use ada-xref.el:
1399    (if ada-clean-buffer-before-saving    (if ada-clean-buffer-before-saving
1400        (progn        (progn
1401          ;; remove all spaces at the end of lines in the whole buffer.          ;; remove all spaces at the end of lines in the whole buffer.
1402          (add-hook 'local-write-file-hooks 'delete-trailing-whitespace)          (add-hook 'local-write-file-hooks 'delete-trailing-whitespace)
1403          ;; convert all tabs to the correct number of spaces.          ;; convert all tabs to the correct number of spaces.
1404          (add-hook 'local-write-file-hooks          (add-hook 'local-write-file-hooks
1405                    (lambda () (untabify (point-min) (point-max))))))                    (lambda () (untabify (point-min) (point-max))))))
# Line 1334  If you use ada-xref.el: Line 1412  If you use ada-xref.el:
1412    (if ada-fill-comment-prefix    (if ada-fill-comment-prefix
1413        (set 'comment-start ada-fill-comment-prefix)        (set 'comment-start ada-fill-comment-prefix)
1414      (set 'comment-start "-- "))      (set 'comment-start "-- "))
1415      
1416    ;;  Run this after the hook to give the users a chance to activate    ;;  Run this after the hook to give the users a chance to activate
1417    ;;  font-lock-mode    ;;  font-lock-mode
1418    
# Line 1383  If you use ada-xref.el: Line 1461  If you use ada-xref.el:
1461  (defun ada-save-exceptions-to-file (file-name)  (defun ada-save-exceptions-to-file (file-name)
1462    "Save the exception lists `ada-case-exception' and    "Save the exception lists `ada-case-exception' and
1463  `ada-case-exception-substring' to the file FILE-NAME."  `ada-case-exception-substring' to the file FILE-NAME."
1464      
1465    ;;  Save the list in the file    ;;  Save the list in the file
1466    (find-file (expand-file-name file-name))    (find-file (expand-file-name file-name))
1467    (erase-buffer)    (erase-buffer)
# Line 1396  If you use ada-xref.el: Line 1474  If you use ada-xref.el:
1474    (save-buffer)    (save-buffer)
1475    (kill-buffer nil)    (kill-buffer nil)
1476    )    )
1477      
1478  (defun ada-create-case-exception (&optional word)  (defun ada-create-case-exception (&optional word)
1479    "Defines WORD as an exception for the casing system.    "Defines WORD as an exception for the casing system.
1480  If WORD is not given, then the current word in the buffer is used instead.  If WORD is not given, then the current word in the buffer is used instead.
# Line 1547  word itself has a special casing." Line 1625  word itself has a special casing."
1625    
1626      (save-excursion      (save-excursion
1627         (forward-word -1)         (forward-word -1)
1628          
1629         (unwind-protect         (unwind-protect
1630            (progn            (progn
1631              (modify-syntax-entry ?_ "." (syntax-table))              (modify-syntax-entry ?_ "." (syntax-table))
1632                
1633              (while substrings              (while substrings
1634                (setq re (concat "\\b" (regexp-quote (caar substrings)) "\\b"))                (setq re (concat "\\b" (regexp-quote (caar substrings)) "\\b"))
1635                  
1636                (save-excursion                (save-excursion
1637                   (while (re-search-forward re max t)                   (while (re-search-forward re max t)
1638                     (replace-match (caar substrings))))                     (replace-match (caar substrings))))
# Line 2137  This function is intended to be bound to Line 2215  This function is intended to be bound to
2215    
2216      (let ((line (save-excursion      (let ((line (save-excursion
2217                    (goto-char (car cur-indent))                    (goto-char (car cur-indent))
2218                    (count-lines (point-min) (point)))))                    (count-lines 1 (point)))))
2219    
2220        (if (equal (cdr cur-indent) '(0))        (if (equal (cdr cur-indent) '(0))
2221            (message (concat "same indentation as line " (number-to-string line)))            (message (concat "same indentation as line " (number-to-string line)))
# Line 2281  offset." Line 2359  offset."
2359                (goto-char column)                (goto-char column)
2360                (skip-chars-backward " \t")                (skip-chars-backward " \t")
2361                (list (1- (point)) 0))                (list (1- (point)) 0))
2362            
2363            (if (and (skip-chars-backward " \t")            (if (and (skip-chars-backward " \t")
2364                     (= (char-before) ?\n)                     (= (char-before) ?\n)
2365                     (not (forward-comment -10000))                     (not (forward-comment -10000))
# Line 2289  offset." Line 2367  offset."
2367                ;; ??? Could use a different variable                ;; ??? Could use a different variable
2368                (list column 'ada-broken-indent)                (list column 'ada-broken-indent)
2369    
2370              ;;  Correctly indent named parameter lists ("name => ...") for              ;;  We want all continuation lines to be indented the same
2371              ;;  all the following lines              ;;  (ada-broken-line from the opening parenthesis. However, in
2372              (goto-char column)              ;;  parameter list, each new parameter should be indented at the
2373              (if (and (progn (forward-comment 1000)              ;;  column as the opening parenthesis.
2374                              (looking-at "\\sw+\\s *=>"))  
2375                       (progn (goto-char orgpoint)              ;;  A special case to handle nested boolean expressions, as in
2376                              (forward-comment 1000)              ;;    ((B
2377                              (not (looking-at "\\sw+\\s *=>"))))              ;;        and then C) --  indented by ada-broken-indent
2378                  (list column 'ada-broken-indent)              ;;     or else D)     --  indenting this line.
2379                ;;  ??? This is really a hack, we should have a proper way to go to
2380                ;;  ??? Would be nice that lines like              ;;  ??? the beginning of the statement
2381                ;;   A  
2382                ;;     (B,              (if (= (char-before) ?\))
2383                ;;      C                  (backward-sexp))
2384                ;;        (E));  --  would be nice if this was correctly indented  
2385  ;             (if (= (char-before (1- orgpoint)) ?,)              (if (memq (char-before) '(?, ?\; ?\( ?\)))
2386                    (list column 0)                  (list column 0)
2387  ;               (list column 'ada-broken-indent)                (list column 'ada-continuation-indent)
2388  ;               )                )))))
             )))))  
2389    
2390       ;;---------------------------       ;;---------------------------
2391       ;;   at end of buffer       ;;   at end of buffer
# Line 2354  offset." Line 2431  offset."
2431                            (beginning-of-line)                            (beginning-of-line)
2432                            (if (looking-at ada-named-block-re)                            (if (looking-at ada-named-block-re)
2433                                (setq label (- ada-label-indent))))))))                                (setq label (- ada-label-indent))))))))
2434                
2435              ;; found 'record' =>              ;; found 'record' =>
2436              ;;  if the keyword is found at the beginning of a line (or just              ;;  if the keyword is found at the beginning of a line (or just
2437              ;;  after limited, we indent on it, otherwise we indent on the              ;;  after limited, we indent on it, otherwise we indent on the
# Line 2392  offset." Line 2469  offset."
2469              (list (progn (back-to-indentation) (point)) 0))))              (list (progn (back-to-indentation) (point)) 0))))
2470    
2471         ;; elsif         ;; elsif
2472          
2473         ((looking-at "elsif\\>")         ((looking-at "elsif\\>")
2474          (save-excursion          (save-excursion
2475            (ada-goto-matching-start 1 nil t)            (ada-goto-matching-start 1 nil t)
# Line 2403  offset." Line 2480  offset."
2480       ;;---------------------------       ;;---------------------------
2481       ;;  starting with w (when)       ;;  starting with w (when)
2482       ;;---------------------------       ;;---------------------------
2483        
2484       ((and (= (downcase (char-after)) ?w)       ((and (= (downcase (char-after)) ?w)
2485             (looking-at "when\\>"))             (looking-at "when\\>"))
2486        (save-excursion        (save-excursion
# Line 2430  offset." Line 2507  offset."
2507       ;;---------------------------       ;;---------------------------
2508       ;;   starting with l (loop)       ;;   starting with l (loop)
2509       ;;---------------------------       ;;---------------------------
2510        
2511       ((and (= (downcase (char-after)) ?l)       ((and (= (downcase (char-after)) ?l)
2512             (looking-at "loop\\>"))             (looking-at "loop\\>"))
2513        (setq pos (point))        (setq pos (point))
# Line 2449  offset." Line 2526  offset."
2526       ;;----------------------------       ;;----------------------------
2527       ;;    starting with l (limited) or r (record)       ;;    starting with l (limited) or r (record)
2528       ;;----------------------------       ;;----------------------------
2529        
2530       ((or (and (= (downcase (char-after)) ?l)       ((or (and (= (downcase (char-after)) ?l)
2531                 (looking-at "limited\\>"))                 (looking-at "limited\\>"))
2532            (and (= (downcase (char-after)) ?r)            (and (= (downcase (char-after)) ?r)
# Line 2493  offset." Line 2570  offset."
2570              (list (progn (back-to-indentation) (point)) 'ada-indent))              (list (progn (back-to-indentation) (point)) 'ada-indent))
2571          (save-excursion          (save-excursion
2572            (ada-goto-stmt-start)            (ada-goto-stmt-start)
2573            (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent))))            (if (looking-at "\\<package\\|procedure\\|function\\>")
2574                  (list (progn (back-to-indentation) (point)) 0)
2575                (list (progn (back-to-indentation) (point)) 'ada-indent)))))
2576    
2577       ;;---------------------------       ;;---------------------------
2578       ;;  starting with r (return, renames)       ;;  starting with r (return, renames)
# Line 2501  offset." Line 2580  offset."
2580    
2581       ((and (= (downcase (char-after)) ?r)       ((and (= (downcase (char-after)) ?r)
2582             (looking-at "re\\(turn\\|names\\)\\>"))             (looking-at "re\\(turn\\|names\\)\\>"))
2583          
2584        (save-excursion        (save-excursion
2585          (let ((var 'ada-indent-return))          (let ((var 'ada-indent-return))
2586            ;;  If looking at a renames, skip the 'return' statement too            ;;  If looking at a renames, skip the 'return' statement too
# Line 2513  offset." Line 2592  offset."
2592                           (= (downcase (char-after (car pos))) ?r))                           (= (downcase (char-after (car pos))) ?r))
2593                      (goto-char (car pos)))                      (goto-char (car pos)))
2594                  (set 'var 'ada-indent-renames)))                  (set 'var 'ada-indent-renames)))
2595              
2596            (forward-comment -1000)            (forward-comment -1000)
2597            (if (= (char-before) ?\))            (if (= (char-before) ?\))
2598                (forward-sexp -1)                (forward-sexp -1)
2599              (forward-word -1))              (forward-word -1))
2600              
2601            ;; If there is a parameter list, and we have a function declaration            ;; If there is a parameter list, and we have a function declaration
2602            ;; or a access to subprogram declaration            ;; or a access to subprogram declaration
2603            (let ((num-back 1))            (let ((num-back 1))
# Line 2531  offset." Line 2610  offset."
2610                               (backward-word 1)                               (backward-word 1)
2611                               (set 'num-back 2)                               (set 'num-back 2)
2612                               (looking-at "\\(function\\|procedure\\)\\>")))))                               (looking-at "\\(function\\|procedure\\)\\>")))))
2613                    
2614                  ;; The indentation depends of the value of ada-indent-return                  ;; The indentation depends of the value of ada-indent-return
2615                  (if (<= (eval var) 0)                  (if (<= (eval var) 0)
2616                      (list (point) (list '- var))                      (list (point) (list '- var))
2617                    (list (progn (backward-word num-back) (point))                    (list (progn (backward-word num-back) (point))
2618                          var))                          var))
2619                  
2620                ;; Else there is no parameter list, but we have a function                ;; Else there is no parameter list, but we have a function
2621                ;; Only do something special if the user want to indent                ;; Only do something special if the user want to indent
2622                ;; relative to the "function" keyword                ;; relative to the "function" keyword
# Line 2545  offset." Line 2624  offset."
2624                         (save-excursion (forward-word -1)                         (save-excursion (forward-word -1)
2625                                         (looking-at "function\\>")))                                         (looking-at "function\\>")))
2626                    (list (progn (forward-word -1) (point)) var)                    (list (progn (forward-word -1) (point)) var)
2627                    
2628                  ;; Else...                  ;; Else...
2629                  (ada-indent-on-previous-lines nil orgpoint orgpoint)))))))                  (ada-indent-on-previous-lines nil orgpoint orgpoint)))))))
2630        
2631       ;;--------------------------------       ;;--------------------------------
2632       ;;   starting with 'o' or 'p'       ;;   starting with 'o' or 'p'
2633       ;;   'or'      as statement-start       ;;   'or'      as statement-start
# Line 2733  if INITIAL-POS is non-nil, moves point t Line 2812  if INITIAL-POS is non-nil, moves point t
2812           ;;           ;;
2813           ((looking-at "separate\\>")           ((looking-at "separate\\>")
2814            (ada-get-indent-nochange))            (ada-get-indent-nochange))
2815    
2816             ;; A label
2817             ((looking-at "<<")
2818              (list (+ (save-excursion (back-to-indentation) (point))
2819                       (- ada-label-indent))))
2820    
2821           ;;           ;;
2822           ((looking-at "with\\>\\|use\\>")           ((looking-at "with\\>\\|use\\>")
2823            ;;  Are we still in that statement, or are we in fact looking at            ;;  Are we still in that statement, or are we in fact looking at
# Line 3346  match." Line 3431  match."
3431    
3432        (goto-char (car match-dat))        (goto-char (car match-dat))
3433        (unless (ada-in-open-paren-p)        (unless (ada-in-open-paren-p)
3434          (if (and (looking-at          (cond
                   "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")  
                  (save-excursion  
                    (ada-goto-previous-word)  
                    (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]")))  
             (forward-word -1)  
3435    
3436            (save-excursion           ((and (looking-at
3437              (goto-char (cdr match-dat))                  "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
3438              (ada-goto-next-non-ws)                 (save-excursion
3439              (looking-at "(")                   (ada-goto-previous-word)
3440              ;;  words that can go after an 'is'                   (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]")))
3441              (unless (looking-at            (forward-word -1))
3442                       (eval-when-compile  
3443                         (concat "\\<"           ((looking-at "is")
3444                                 (regexp-opt '("separate" "access" "array"            (setq found
3445                                               "abstract" "new") t)                  (and (save-excursion (ada-goto-previous-word)
3446                                 "\\>\\|(")))                                       (ada-goto-previous-word)
3447                (setq found t))))                                       (not (looking-at "subtype")))
3448          ))  
3449                        (save-excursion (goto-char (cdr match-dat))
3450                                        (ada-goto-next-non-ws)
3451                                        ;;  words that can go after an 'is'
3452                                        (not (looking-at
3453                                         (eval-when-compile
3454                                           (concat "\\<"
3455                                                   (regexp-opt
3456                                                    '("separate" "access" "array"
3457                                                      "abstract" "new") t)
3458                                                   "\\>\\|("))))))))
3459    
3460             (t
3461              (setq found t))
3462            )))
3463    
3464      (if found      (if found
3465          match-dat          match-dat
# Line 3685  If GOTOTHEN is non-nil, point moves to t Line 3779  If GOTOTHEN is non-nil, point moves to t
3779                    ;; it ends a block => increase nest depth                    ;; it ends a block => increase nest depth
3780                    (setq nest-count (1+ nest-count)                    (setq nest-count (1+ nest-count)
3781                          pos        (point))                          pos        (point))
3782                    
3783                  ;; it starts a block => decrease nest depth                  ;; it starts a block => decrease nest depth
3784                  (setq nest-count (1- nest-count))))                  (setq nest-count (1- nest-count))))
3785              (goto-char pos))              (goto-char pos))
# Line 3702  If GOTOTHEN is non-nil, point moves to t Line 3796  If GOTOTHEN is non-nil, point moves to t
3796                    (error (concat                    (error (concat
3797                            "No matching 'is' or 'renames' for 'package' at"                            "No matching 'is' or 'renames' for 'package' at"
3798                            " line "                            " line "
3799                            (number-to-string (count-lines (point-min)                            (number-to-string (count-lines 1 (1+ current)))))))
                                                          (1+ current)))))))  
3800                (unless (looking-at "renames")                (unless (looking-at "renames")
3801                  (progn                  (progn
3802                    (forward-word 1)                    (forward-word 1)
# Line 3776  If GOTOTHEN is non-nil, point moves to t Line 3869  If GOTOTHEN is non-nil, point moves to t
3869                   (back-to-indentation)                   (back-to-indentation)
3870                   (looking-at "\\<then\\>")))                   (looking-at "\\<then\\>")))
3871                (goto-char (match-beginning 0)))                (goto-char (match-beginning 0)))
3872                
3873               ;;               ;;
3874               ;; found 'do' => skip back to 'accept'               ;; found 'do' => skip back to 'accept'
3875               ;;               ;;
# Line 3786  If GOTOTHEN is non-nil, point moves to t Line 3879  If GOTOTHEN is non-nil, point moves to t
3879                         'word-search-backward)                         'word-search-backward)
3880                  (error "missing 'accept' in front of 'do'"))))                  (error "missing 'accept' in front of 'do'"))))
3881              (point))              (point))
3882            
3883          (if noerror          (if noerror
3884              nil              nil
3885            (error "no matching start"))))))            (error "no matching start"))))))
# Line 3814  If NOERROR is non-nil, it only returns n Line 3907  If NOERROR is non-nil, it only returns n
3907      ;;  in the nesting loop below, so we just make sure we don't count it.      ;;  in the nesting loop below, so we just make sure we don't count it.
3908      ;;  "declare" is a special case because we need to look after the "begin"      ;;  "declare" is a special case because we need to look after the "begin"
3909      ;;  keyword      ;;  keyword
3910      (if (and (not first) (looking-at regex))      (if (looking-at "\\<if\\|loop\\|case\\>")
3911          (forward-char 1))          (forward-char 1))
3912    
3913      ;;      ;;
# Line 3843  If NOERROR is non-nil, it only returns n Line 3936  If NOERROR is non-nil, it only returns n
3936         ;; handling.         ;; handling.
3937         ;; Nothing should be done if we have only the specs or a         ;; Nothing should be done if we have only the specs or a
3938         ;; generic instantion.         ;; generic instantion.
3939          
3940         ((and (looking-at "\\<procedure\\|function\\>"))         ((and (looking-at "\\<procedure\\|function\\>"))
3941          (if first          (if first
3942              (forward-word 1)              (forward-word 1)
# Line 3851  If NOERROR is non-nil, it only returns n Line 3944  If NOERROR is non-nil, it only returns n
3944            (ada-goto-next-non-ws)            (ada-goto-next-non-ws)
3945            (unless (looking-at "\\<new\\>")            (unless (looking-at "\\<new\\>")
3946              (ada-goto-matching-end 0 t))))              (ada-goto-matching-end 0 t))))
3947          
3948         ;; found block end => decrease nest depth         ;; found block end => decrease nest depth
3949         ((looking-at "\\<end\\>")         ((looking-at "\\<end\\>")
3950          (setq nest-count (1- nest-count)          (setq nest-count (1- nest-count)
# Line 3862  If NOERROR is non-nil, it only returns n Line 3955  If NOERROR is non-nil, it only returns n
3955                (ada-goto-next-non-ws)                (ada-goto-next-non-ws)
3956                (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))                (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
3957              (forward-word 1)))              (forward-word 1)))
3958          
3959         ;; found package start => check if it really starts a block, and is not         ;; found package start => check if it really starts a block, and is not
3960         ;; in fact a generic instantiation for instance         ;; in fact a generic instantiation for instance
3961         ((looking-at "\\<package\\>")         ((looking-at "\\<package\\>")
# Line 3874  If NOERROR is non-nil, it only returns n Line 3967  If NOERROR is non-nil, it only returns n
3967              (goto-char (match-end 0))              (goto-char (match-end 0))
3968            (setq nest-count (1+ nest-count)            (setq nest-count (1+ nest-count)
3969                  found      (<= nest-count 0))))                  found      (<= nest-count 0))))
3970          
3971         ;; all the other block starts         ;; all the other block starts
3972         (t         (t
3973          (setq nest-count (1+ nest-count)          (setq nest-count (1+ nest-count)
# Line 4095  parenthesis, or nil." Line 4188  parenthesis, or nil."
4188              ;;                Value_1);              ;;                Value_1);
4189              ;;  type B is (   --  comment              ;;  type B is (   --  comment
4190              ;;             Value_2);              ;;             Value_2);
4191                
4192              (if (or (not ada-indent-handle-comment-special)              (if (or (not ada-indent-handle-comment-special)
4193                      (not (looking-at "[ \t]+--")))                      (not (looking-at "[ \t]+--")))
4194                  (skip-chars-forward " \t"))                  (skip-chars-forward " \t"))
# Line 4186  of the region.  Otherwise, operates only Line 4279  of the region.  Otherwise, operates only
4279        (replace-match "--  \\1")        (replace-match "--  \\1")
4280        (forward-line 1)        (forward-line 1)
4281        (beginning-of-line))        (beginning-of-line))
4282        
4283      (goto-char (point-min))      (goto-char (point-min))
4284      (while (re-search-forward "\\>(" nil t)      (while (re-search-forward "\\>(" nil t)
4285        (if (not (ada-in-string-or-comment-p))        (if (not (ada-in-string-or-comment-p))
# Line 4306  Moves to 'begin' if in a declarative par Line 4399  Moves to 'begin' if in a declarative par
4399            (save-excursion            (save-excursion
4400    
4401              (cond              (cond
4402                 ;; Go to the beginning of the current word, and check if we are
4403               ;; directly on 'begin'               ;; directly on 'begin'
4404               ((save-excursion               ((save-excursion
4405                  (ada-goto-previous-word)                  (skip-syntax-backward "w")
4406                  (looking-at "\\<begin\\>"))                  (looking-at "\\<begin\\>"))
4407                (ada-goto-matching-end 1))                (ada-goto-matching-end 1))
4408                
4409               ;; on first line of subprogram body               ;; on first line of subprogram body
4410               ;; Do nothing for specs or generic instantion, since these are               ;; Do nothing for specs or generic instantion, since these are
4411               ;; handled as the general case (find the enclosing block)               ;; handled as the general case (find the enclosing block)
# Line 4324  Moves to 'begin' if in a declarative par Line 4418  Moves to 'begin' if in a declarative par
4418                       ))                       ))
4419                (skip-syntax-backward "w")                (skip-syntax-backward "w")
4420                (ada-goto-matching-end 0 t))                (ada-goto-matching-end 0 t))
4421                  
4422               ;; on first line of task declaration               ;; on first line of task declaration
4423               ((save-excursion               ((save-excursion
4424                  (and (ada-goto-stmt-start)                  (and (ada-goto-stmt-start)
# Line 4344  Moves to 'begin' if in a declarative par Line 4438  Moves to 'begin' if in a declarative par
4438                  (setq decl-start (and (ada-goto-matching-decl-start t) (point)))                  (setq decl-start (and (ada-goto-matching-decl-start t) (point)))
4439                  (and decl-start (looking-at "\\<package\\>")))                  (and decl-start (looking-at "\\<package\\>")))
4440                (ada-goto-matching-end 1))                (ada-goto-matching-end 1))
4441                
4442                 ;;  On a "declare" keyword
4443                 ((save-excursion
4444                    (skip-syntax-backward "w")
4445                    (looking-at "\\<declare\\>"))
4446                  (ada-goto-matching-end 0 t))
4447    
4448               ;; inside a 'begin' ... 'end' block               ;; inside a 'begin' ... 'end' block
4449               (decl-start               (decl-start
4450                (goto-char decl-start)                (goto-char decl-start)
4451                (ada-goto-matching-end 0 t))                (ada-goto-matching-end 0 t))
4452                
4453               ;; (hopefully ;-) everything else               ;; (hopefully ;-) everything else
4454               (t               (t
4455                (ada-goto-matching-end 1)))                (ada-goto-matching-end 1)))
# Line 4530  can add its own items." Line 4630  can add its own items."
4630  ;;  function for justifying the comments.  ;;  function for justifying the comments.
4631  ;; -------------------------------------------------------  ;; -------------------------------------------------------
4632    
4633  (defadvice comment-region (before ada-uncomment-anywhere)  (defadvice comment-region (before ada-uncomment-anywhere disable)
4634    (if (and arg    (if (and arg
4635             (listp arg)  ;;  a prefix with \C-u is of the form '(4), whereas             (listp arg)  ;;  a prefix with \C-u is of the form '(4), whereas
4636                         ;;  \C-u 2  sets arg to '2'  (fixed by S.Leake)                         ;;  \C-u 2  sets arg to '2'  (fixed by S.Leake)
# Line 4553  can add its own items." Line 4653  can add its own items."
4653          (ad-activate 'comment-region)          (ad-activate 'comment-region)
4654          (comment-region beg end (- (or arg 2)))          (comment-region beg end (- (or arg 2)))
4655          (ad-deactivate 'comment-region))          (ad-deactivate 'comment-region))
4656      (comment-region beg end (list (- (or arg 2))))))      (comment-region beg end (list (- (or arg 2))))
4657        (ada-indent-region beg end)))
4658    
4659  (defun ada-fill-comment-paragraph-justify ()  (defun ada-fill-comment-paragraph-justify ()
4660    "Fills current comment paragraph and justifies each line as well."    "Fills current comment paragraph and justifies each line as well."
# Line 4579  The paragraph is indented on the first l Line 4680  The paragraph is indented on the first l
4680             (not (looking-at "[ \t]*--")))             (not (looking-at "[ \t]*--")))
4681        (error "not inside comment"))        (error "not inside comment"))
4682    
4683    (let* ((indent)    (let* (indent from to
4684           (from)           (opos (point-marker))
          (to)  
          (opos             (point-marker))  
4685    
4686           ;; Sets this variable to nil, otherwise it prevents           ;; Sets this variable to nil, otherwise it prevents
4687           ;; fill-region-as-paragraph to work on Emacs <= 20.2           ;; fill-region-as-paragraph to work on Emacs <= 20.2
# Line 4593  The paragraph is indented on the first l Line 4692  The paragraph is indented on the first l
4692    
4693      ;;  Find end of paragraph      ;;  Find end of paragraph
4694      (back-to-indentation)      (back-to-indentation)
4695      (while (and (not (eobp)) (looking-at "--[ \t]*[^ \t\n]"))      (while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
4696        (forward-line 1)        (forward-line 1)
4697    
4698        ;;  If we were at the last line in the buffer, create a dummy empty        ;;  If we were at the last line in the buffer, create a dummy empty
# Line 4607  The paragraph is indented on the first l Line 4706  The paragraph is indented on the first l
4706    
4707      ;;  Find beginning of paragraph      ;;  Find beginning of paragraph
4708      (back-to-indentation)      (back-to-indentation)
4709      (while (and (not (bobp)) (looking-at "--[ \t]*[^ \t\n]"))      (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
4710        (forward-line -1)        (forward-line -1)
4711        (back-to-indentation))        (back-to-indentation))
4712    
4713      ;;  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
4714      ;;  of the buffer      ;;  of the buffer
4715      (unless (bobp)      (unless (bobp)
4716        (forward-line 1))        (forward-line 1))
# Line 4629  The paragraph is indented on the first l Line 4728  The paragraph is indented on the first l
4728      (while (re-search-forward "--\n" to t)      (while (re-search-forward "--\n" to t)
4729        (replace-match "\n"))        (replace-match "\n"))
4730    
     ;;  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 " "))  
   
4731      (goto-char (1- to))      (goto-char (1- to))
4732      (setq to (point-marker))      (setq to (point-marker))
4733    
# Line 4739  otherwise." Line 4831  otherwise."
4831    
4832          ;;  If we are using project file, search for the other file in all          ;;  If we are using project file, search for the other file in all
4833          ;;  the possible src directories.          ;;  the possible src directories.
4834            
4835          (if (functionp 'ada-find-src-file-in-dir)          (if (functionp 'ada-find-src-file-in-dir)
4836              (let ((other              (let ((other
4837                     (ada-find-src-file-in-dir                     (ada-find-src-file-in-dir
# Line 4777  Redefines the function `ff-which-functio Line 4869  Redefines the function `ff-which-functio
4869  (defun ada-which-function ()  (defun ada-which-function ()
4870    "Returns the name of the function whose body the point is in.    "Returns the name of the function whose body the point is in.
4871  This function works even in the case of nested subprograms, whereas the  This function works even in the case of nested subprograms, whereas the
4872  standard Emacs function which-function does not.  standard Emacs function `which-function' does not.
4873  Since the search can be long, the results are cached."  Since the search can be long, the results are cached."
4874    
4875    (let ((line (count-lines (point-min) (point)))    (let ((line (count-lines 1 (point)))
4876          (pos (point))          (pos (point))
4877          end-pos          end-pos
4878          func-name indent          func-name indent
# Line 4796  Since the search can be long, the result Line 4888  Since the search can be long, the result
4888    
4889          ;;  Are we looking at "function Foo\n    (paramlist)"          ;;  Are we looking at "function Foo\n    (paramlist)"
4890          (skip-chars-forward " \t\n(")          (skip-chars-forward " \t\n(")
4891            
4892          (condition-case nil          (condition-case nil
4893              (up-list)              (up-list 1)
4894            (error nil))            (error nil))
4895    
4896          (skip-chars-forward " \t\n")          (skip-chars-forward " \t\n")
# Line 4807  Since the search can be long, the result Line 4899  Since the search can be long, the result
4899                (forward-word 1)                (forward-word 1)
4900                (skip-chars-forward " \t\n")                (skip-chars-forward " \t\n")
4901                (skip-chars-forward "a-zA-Z0-9_'")))                (skip-chars-forward "a-zA-Z0-9_'")))
4902                
4903          ;; Can't simply do forward-word, in case the "is" is not on the          ;; Can't simply do forward-word, in case the "is" is not on the
4904          ;; same line as the closing parenthesis          ;; same line as the closing parenthesis
4905          (skip-chars-forward "is \t\n")          (skip-chars-forward "is \t\n")
# Line 4996  Returns nil if no body was found." Line 5088  Returns nil if no body was found."
5088    
5089       ;; Ada unnamed numerical constants       ;; Ada unnamed numerical constants
5090       (list "\\W\\([-+]?[0-9._]+\\)\\>" '(1 font-lock-constant-face))       (list "\\W\\([-+]?[0-9._]+\\)\\>" '(1 font-lock-constant-face))
5091        
5092       ))       ))
5093    "Default expressions to highlight in Ada mode.")    "Default expressions to highlight in Ada mode.")
5094    

Legend:
Removed from v.1.50  
changed lines
  Added in v.1.50.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26