/[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.51 by monnier, Thu Jun 20 17:40:38 2002 UTC revision 1.52 by lektu, Tue Feb 4 13:24:33 2003 UTC
# Line 303  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 1322  If you use ada-xref.el: Line 1322  If you use ada-xref.el:
1322                         (modes   . '(ada-mode))))                         (modes   . '(ada-mode))))
1323    
1324          (setq ada-align-modes nil)          (setq ada-align-modes nil)
1325            
1326          (add-to-list 'ada-align-modes          (add-to-list 'ada-align-modes
1327                       '(ada-declaration-assign                       '(ada-declaration-assign
1328                         (regexp  . "[^:]\\(\\s-*\\):[^:]")                         (regexp  . "[^:]\\(\\s-*\\):[^:]")
# Line 1348  If you use ada-xref.el: Line 1348  If you use ada-xref.el:
1348                         (regexp . "\\(\\s-+\\)at\\>")                         (regexp . "\\(\\s-+\\)at\\>")
1349                         (modes . '(ada-mode))))                         (modes . '(ada-mode))))
1350    
1351            
1352          (setq align-mode-rules-list ada-align-modes)          (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
1357        (define-key ada-mode-map ada-popup-key 'ada-popup-menu))        (define-key ada-mode-map ada-popup-key 'ada-popup-menu))
# Line 1366  If you use ada-xref.el: Line 1366  If you use ada-xref.el:
1366    ;; beginning of subprograms, not the end.    ;; beginning of subprograms, not the end.
1367    ;; Fix is: redefine a new function ada-which-function, and call it when the    ;; Fix is: redefine a new function ada-which-function, and call it when the
1368    ;; major-mode is ada-mode.    ;; major-mode is ada-mode.
1369      
1370    (unless ada-xemacs    (unless ada-xemacs
1371      ;;  This function do not require that we load which-func now.      ;;  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      ;;  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)      (defadvice which-function (around ada-which-function activate)
1375        "In Ada buffers, should work with overloaded subprograms, and does not        "In Ada buffers, should work with overloaded subprograms, and does not
1376  use imenu."  use imenu."
# Line 1412  use imenu." Line 1412  use imenu."
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 1461  use imenu." Line 1461  use imenu."
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 1474  use imenu." Line 1474  use imenu."
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 1625  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 2359  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 2378  offset." Line 2378  offset."
2378              ;;     or else D)     --  indenting this line.              ;;     or else D)     --  indenting this line.
2379              ;;  ??? This is really a hack, we should have a proper way to go to              ;;  ??? This is really a hack, we should have a proper way to go to
2380              ;;  ??? the beginning of the statement              ;;  ??? the beginning of the statement
2381                
2382              (if (= (char-before) ?\))              (if (= (char-before) ?\))
2383                  (backward-sexp))                  (backward-sexp))
2384                
2385              (if (memq (char-before) '(?, ?\; ?\( ?\)))              (if (memq (char-before) '(?, ?\; ?\( ?\)))
2386                  (list column 0)                  (list column 0)
2387                (list column 'ada-continuation-indent)                (list column 'ada-continuation-indent)
# Line 2431  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 2469  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 2480  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 2507  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 2526  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 2580  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 2592  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 2610  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 2624  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 2817  if INITIAL-POS is non-nil, moves point t Line 2817  if INITIAL-POS is non-nil, moves point t
2817           ((looking-at "<<")           ((looking-at "<<")
2818            (list (+ (save-excursion (back-to-indentation) (point))            (list (+ (save-excursion (back-to-indentation) (point))
2819                     (- ada-label-indent))))                     (- 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 3432  match." Line 3432  match."
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          (cond          (cond
3435            
3436           ((and (looking-at           ((and (looking-at
3437                  "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")                  "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
3438                 (save-excursion                 (save-excursion
# Line 3445  match." Line 3445  match."
3445                  (and (save-excursion (ada-goto-previous-word)                  (and (save-excursion (ada-goto-previous-word)
3446                                       (ada-goto-previous-word)                                       (ada-goto-previous-word)
3447                                       (not (looking-at "subtype")))                                       (not (looking-at "subtype")))
3448                        
3449                      (save-excursion (goto-char (cdr match-dat))                      (save-excursion (goto-char (cdr match-dat))
3450                                      (ada-goto-next-non-ws)                                      (ada-goto-next-non-ws)
3451                                      ;;  words that can go after an 'is'                                      ;;  words that can go after an 'is'
# Line 3456  match." Line 3456  match."
3456                                                  '("separate" "access" "array"                                                  '("separate" "access" "array"
3457                                                    "abstract" "new") t)                                                    "abstract" "new") t)
3458                                                 "\\>\\|("))))))))                                                 "\\>\\|("))))))))
3459                  
3460           (t           (t
3461            (setq found t))            (setq found t))
3462          )))          )))
# Line 3779  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 3869  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 3879  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 3936  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 3944  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 3955  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 3967  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 4188  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 4279  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 4405  Moves to 'begin' if in a declarative par Line 4405  Moves to 'begin' if in a declarative par
4405                  (skip-syntax-backward "w")                  (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 4418  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 4444  Moves to 'begin' if in a declarative par Line 4444  Moves to 'begin' if in a declarative par
4444                  (skip-syntax-backward "w")                  (skip-syntax-backward "w")
4445                  (looking-at "\\<declare\\>"))                  (looking-at "\\<declare\\>"))
4446                (ada-goto-matching-end 0 t))                (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 4831  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 4888  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 1)              (up-list 1)
4894            (error nil))            (error nil))
# Line 4899  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 5088  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.51  
changed lines
  Added in v.1.52

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