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. |
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. |
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', |
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) |
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 |
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] |
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) |
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 |
|
|
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} |
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 |
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 |
|
|
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)))))) |
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 |
|
|
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) |
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. |
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)))) |
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))) |
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)) |
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 |
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 |
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) |
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 |
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)) |
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) |
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) |
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 |
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)) |
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 |
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 |
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 |
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 |
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)) |
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) |
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 |
;; |
;; |
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")))))) |
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 |
;; |
;; |
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) |
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) |
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\\>") |
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) |
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")) |
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)) |
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) |
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) |
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))) |
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) |
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." |
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 |
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 |
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)) |
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 |
|
|
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 |
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 |
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") |
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") |
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 |
|
|