Lines Matching +defs:ada +defs:if
0 ;;; ada-mode.el --- major-mode for editing Ada sources
10 ;; Keywords: languages ada
32 ;;; composed of four Lisp files: ada-mode.el, ada-xref.el, ada-prj.el
33 ;;; and ada-stmt.el. Only this file (ada-mode.el) is completely
40 ;;; another file, called ada-vms.el, that provides some required
45 ;;; By default, the valid extensions for Ada files are .ads, .adb or .ada
46 ;;; If the ada-mode does not start automatically, then simply type the
48 ;;; M-x ada-mode
50 ;;; By default, ada-mode is configured to take full advantage of the GNAT
53 ;;; variable in your .emacs (Note: do not set this in the ada-mode-hook, it
55 ;;; (setq ada-which-compiler 'generic)
62 ;;; This was distributed as ada.el in versions of Emacs prior to 19.29.
67 ;;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z.
69 ;;; The probably very first Ada mode (called electric-ada.el) was
71 ;;; Gosling Emacs. L. Slater based his development on ada.el and
72 ;;; electric-ada.el.
87 ;;; ada-imenu-generic-expression
89 ;;; to the ada-mode
101 ;;; The names start with ada-
108 ;;; should be loaded before the ada-mode, which will then setup some variables
114 ;;; for specific language constructs, for instance if you want to hide the
138 (defun ada-check-emacs-version (major minor &optional is-xemacs)
139 "Return t if Emacs's version is greater or equal to MAJOR.MINOR.
149 (defun ada-mode-version ()
153 (if (interactive-p)
157 (defvar ada-mode-hook nil
159 This hook is automatically executed after the `ada-mode' is
163 (defgroup ada nil
168 (defcustom ada-auto-case t
170 Casing is done according to `ada-case-keyword', `ada-case-identifier'
171 and `ada-case-attribute'."
172 :type 'boolean :group 'ada)
174 (defcustom ada-broken-decl-indent 0
181 :type 'integer :group 'ada)
183 (defcustom ada-broken-indent 2
189 :type 'integer :group 'ada)
191 (defcustom ada-continuation-indent ada-broken-indent
197 :type 'integer :group 'ada)
199 (defcustom ada-case-attribute 'ada-capitalize-word
201 It may be `downcase-word', `upcase-word', `ada-loose-case-word',
202 `ada-capitalize-word' or `ada-no-auto-case'."
205 (const ada-capitalize-word)
206 (const ada-loose-case-word)
207 (const ada-no-auto-case))
208 :group 'ada)
210 (defcustom ada-case-exception-file
214 when you call `ada-create-case-exception'.
223 :group 'ada)
225 (defcustom ada-case-keyword 'downcase-word
227 It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
228 `ada-capitalize-word'."
231 (const ada-capitalize-word)
232 (const ada-loose-case-word)
233 (const ada-no-auto-case))
234 :group 'ada)
236 (defcustom ada-case-identifier 'ada-loose-case-word
238 It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
239 `ada-capitalize-word'."
242 (const ada-capitalize-word)
243 (const ada-loose-case-word)
244 (const ada-no-auto-case))
245 :group 'ada)
247 (defcustom ada-clean-buffer-before-saving t
249 :type 'boolean :group 'ada)
251 (defcustom ada-indent 3
258 :type 'integer :group 'ada)
260 (defcustom ada-indent-after-return t
262 :type 'boolean :group 'ada)
264 (defcustom ada-indent-align-comments t
265 "*Non-nil means align comments on previous line comments, if any.
267 Note that indentation is calculated only if `ada-indent-comment-as-code' is t.
271 -- aligned if ada-indent-align-comments is t"
272 :type 'boolean :group 'ada)
274 (defcustom ada-indent-comment-as-code t
277 :type 'boolean :group 'ada)
279 (defcustom ada-indent-handle-comment-special nil
280 "*Non-nil if comment lines should be handled specially inside parenthesis.
281 By default, if the line that contains the open parenthesis has some
283 same column as this text. This will not be true if the first line is
284 a comment and `ada-indent-handle-comment-special' is t.
291 ( -- `ada-indent-handle-comment-special' is nil
296 ( -- `ada-indent-handle-comment-special' is non-nil
299 :type 'boolean :group 'ada)
301 (defcustom ada-indent-is-separate t
302 "*Non-nil means indent 'is separate' or 'is abstract' if on a single line."
303 :type 'boolean :group 'ada)
305 (defcustom ada-indent-record-rel-type 3
311 :type 'integer :group 'ada)
313 (defcustom ada-indent-renames ada-broken-indent
315 If `ada-indent-return' is null or negative, the indentation is done relative to
316 the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
322 :type 'integer :group 'ada)
324 (defcustom ada-indent-return 0
326 If `ada-indent-return' is null or negative, the indentation is done relative to
327 the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
332 :type 'integer :group 'ada)
334 (defcustom ada-indent-to-open-paren t
336 :type 'boolean :group 'ada)
338 (defcustom ada-fill-comment-prefix "-- "
340 Note: if you modify this variable, you will have to invoke `ada-mode'
342 :type 'string :group 'ada)
344 (defcustom ada-fill-comment-postfix " --"
346 Used by `ada-fill-comment-paragraph-postfix'."
347 :type 'string :group 'ada)
349 (defcustom ada-label-indent -4
358 :type 'integer :group 'ada)
360 (defcustom ada-language-version 'ada95
362 :type '(choice (const ada83) (const ada95) (const ada2005)) :group 'ada)
364 (defcustom ada-move-to-declaration nil
365 "*Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to 'begin'."
366 :type 'boolean :group 'ada)
368 (defcustom ada-popup-key '[down-mouse-3]
372 :group 'ada)
374 (defcustom ada-search-directories
381 is the initial value of `ada-search-directories-internal'."
385 :group 'ada)
387 (defvar ada-search-directories-internal ada-search-directories
388 "Internal version of `ada-search-directories'.
391 `ada-search-directories'.")
393 (defcustom ada-stmt-end-indent 0
397 if A = B
399 :type 'integer :group 'ada)
401 (defcustom ada-tab-policy 'indent-auto
404 `indent-rigidly' : always adds `ada-indent' blanks at the beginning of the line.
410 :group 'ada)
412 (defcustom ada-use-indent ada-broken-indent
418 :type 'integer :group 'ada)
420 (defcustom ada-when-indent 3
426 :type 'integer :group 'ada)
428 (defcustom ada-with-indent ada-broken-indent
434 :type 'integer :group 'ada)
436 (defcustom ada-which-compiler 'gnat
445 :group 'ada)
452 (defvar ada-body-suffixes '(".adb")
454 The extensions should include a `.' if needed.")
456 (defvar ada-spec-suffixes '(".ads")
458 The extensions should include a `.' if needed.")
460 (defvar ada-mode-menu (make-sparse-keymap "Ada")
463 (defvar ada-mode-map (make-sparse-keymap)
466 (defvar ada-mode-abbrev-table nil
469 (defvar ada-mode-syntax-table nil
472 (defvar ada-mode-symbol-syntax-table nil
477 (defconst ada-83-string-keywords
481 "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new"
487 Used to define `ada-*-keywords'.")
489 (defconst ada-95-string-keywords
492 Used to define `ada-*-keywords'.")
494 (defconst ada-2005-string-keywords
497 Used to define `ada-*-keywords.'"))
499 (defvar ada-ret-binding nil
502 (defvar ada-case-exception '()
505 (defvar ada-case-exception-substring '()
508 is not itself in `ada-case-exception', and only for substrings that
511 (defvar ada-lfd-binding nil
514 (defvar ada-other-file-alist nil
518 (defvar ada-align-list
527 (defvar ada-align-modes
528 '((ada-declaration
530 (valid . (lambda() (not (ada-in-comment-p))))
531 (modes . '(ada-mode)))
532 (ada-assignment
534 (valid . (lambda() (not (ada-in-comment-p))))
535 (modes . '(ada-mode)))
536 (ada-comment
538 (modes . '(ada-mode)))
539 (ada-use
541 (valid . (lambda() (not (ada-in-comment-p))))
542 (modes . '(ada-mode)))
547 (defconst ada-align-region-separate
559 "if\\|"
571 (defconst ada-83-keywords
573 (concat "\\<" (regexp-opt ada-83-string-keywords t) "\\>"))
576 (defconst ada-95-keywords
580 ada-95-string-keywords
581 ada-83-string-keywords) t) "\\>"))
584 (defconst ada-2005-keywords
588 ada-2005-string-keywords
589 ada-83-string-keywords
590 ada-95-string-keywords) t) "\\>"))
593 (defvar ada-keywords ada-2005-keywords
597 (defconst ada-ident-re
603 (defvar ada-procedure-start-regexp
618 (defconst ada-name-regexp
622 (defconst ada-package-start-regexp
623 (concat "^[ \t]*\\(private[ \t]+\\)?\\(package\\)[ \t\n]+\\(body[ \t]*\\)?" ada-name-regexp)
627 (defconst ada-compile-goto-error-file-linenr-re
634 (defvar ada-block-start-re
642 (defvar ada-end-stmt-re
658 (defvar ada-matching-start-re
663 "if" "task" "package" "procedure" "function" "record" "protected") t)
665 "Regexp used in `ada-goto-matching-start'.")
667 (defvar ada-matching-decl-start-re
671 '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
673 "Regexp used in `ada-goto-matching-decl-start'.")
675 (defvar ada-loop-start-re
679 (defvar ada-subprog-start-re
685 (defvar ada-named-block-re
689 (defvar ada-contextual-menu-on-identifier nil
692 (defvar ada-contextual-menu-last-point nil
695 Since `ada-popup-menu' moves the point where the user clicked, the region
700 Modify this variable if you want to restore the point to another position.")
702 (easy-menu-define ada-contextual-menu nil
704 The variable `ada-contextual-menu-on-identifier' will be set to t before
705 displaying the menu if point was on an identifier."
707 ["Goto Declaration/Body" ada-point-and-xref
708 :included ada-contextual-menu-on-identifier]
709 ["Goto Body" ada-point-and-xref-body
710 :included ada-contextual-menu-on-identifier]
711 ["Goto Previous Reference" ada-xref-goto-previous-reference]
712 ["List References" ada-find-references
713 :included ada-contextual-menu-on-identifier]
714 ["List Local References" ada-find-local-references
715 :included ada-contextual-menu-on-identifier]
718 ["Goto Parent Unit" ada-goto-parent]))
726 (defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")
728 (defconst ada-imenu-subprogram-menu-re
731 ada-imenu-comment-re
735 (defvar ada-imenu-generic-expression
737 (list nil ada-imenu-subprogram-menu-re 2)
742 "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)"
743 ada-imenu-comment-re "\\)";; parameter list or simple space
761 (defun ada-compile-mouse-goto-error ()
762 "Mouse interface for `ada-compile-goto-error'."
765 (ada-compile-goto-error (point))
768 (defun ada-compile-goto-error (pos)
784 (or (looking-at ada-compile-goto-error-file-linenr-re)
788 (looking-at ada-compile-goto-error-file-linenr-re))
790 (if (looking-at "\\([0-9]+\\)") (backward-word 1))
793 (let ((line (if (match-beginning 2) (match-string 2) (match-string 1)))
794 (file (if (match-beginning 2) (match-string 1)
796 (looking-at ada-compile-goto-error-file-linenr-re)
806 (if (stringp line)
831 ;; - " starts a string, but not if inside a constant character.
832 ;; - ( and ) should be ignored if inside a constant character.
834 ;; the standard Emacs functions for sexp (see `ada-in-string-p')
841 ;; `ada-after-change-function', thanks to `ada-deactivate-properties' and
842 ;; `ada-initialize-properties'.
853 (defun ada-create-syntax-table ()
858 (setq ada-mode-syntax-table (make-syntax-table))
859 (set-syntax-table ada-mode-syntax-table)
864 (modify-syntax-entry ?% "$" ada-mode-syntax-table)
865 (modify-syntax-entry ?\" "\"" ada-mode-syntax-table)
867 (modify-syntax-entry ?: "." ada-mode-syntax-table)
868 (modify-syntax-entry ?\; "." ada-mode-syntax-table)
869 (modify-syntax-entry ?& "." ada-mode-syntax-table)
870 (modify-syntax-entry ?\| "." ada-mode-syntax-table)
871 (modify-syntax-entry ?+ "." ada-mode-syntax-table)
872 (modify-syntax-entry ?* "." ada-mode-syntax-table)
873 (modify-syntax-entry ?/ "." ada-mode-syntax-table)
874 (modify-syntax-entry ?= "." ada-mode-syntax-table)
875 (modify-syntax-entry ?< "." ada-mode-syntax-table)
876 (modify-syntax-entry ?> "." ada-mode-syntax-table)
877 (modify-syntax-entry ?$ "." ada-mode-syntax-table)
878 (modify-syntax-entry ?\[ "." ada-mode-syntax-table)
879 (modify-syntax-entry ?\] "." ada-mode-syntax-table)
880 (modify-syntax-entry ?\{ "." ada-mode-syntax-table)
881 (modify-syntax-entry ?\} "." ada-mode-syntax-table)
882 (modify-syntax-entry ?. "." ada-mode-syntax-table)
883 (modify-syntax-entry ?\\ "." ada-mode-syntax-table)
884 (modify-syntax-entry ?\' "." ada-mode-syntax-table)
887 (modify-syntax-entry ?- ". 12" ada-mode-syntax-table)
891 (if (featurep 'xemacs)
892 (modify-syntax-entry ?# "<" ada-mode-syntax-table)
893 (modify-syntax-entry ?# "$" ada-mode-syntax-table))
896 (modify-syntax-entry ?\f "> " ada-mode-syntax-table)
897 (modify-syntax-entry ?\n "> " ada-mode-syntax-table)
900 (modify-syntax-entry ?_ "_" ada-mode-syntax-table)
903 (modify-syntax-entry ?\( "()" ada-mode-syntax-table)
904 (modify-syntax-entry ?\) ")(" ada-mode-syntax-table)
906 (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table))
907 (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
913 (if (featurep 'xemacs)
917 (if (< to from)
943 (defun ada-deactivate-properties ()
945 This would be a duplicate of font-lock if both are used at the same time."
946 (remove-hook 'after-change-functions 'ada-after-change-function t))
948 (defun ada-initialize-properties ()
965 ;; Setting this only if font-lock is not set won't work
966 ;; if the user activates or deactivates font-lock-mode,
968 (add-hook 'after-change-functions 'ada-after-change-function nil t)
971 (defun ada-after-change-function (beg end old-len)
984 (if (looking-at "^[ \t]*#")
992 (defsubst ada-in-comment-p (&optional parse-result)
993 "Return t if inside a comment.
999 (defsubst ada-in-string-p (&optional parse-result)
1000 "Return t if point is inside a string.
1006 (defsubst ada-in-string-or-comment-p (&optional parse-result)
1007 "Return t if inside a comment or string.
1012 (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
1019 ;; Add items to this menu by modifying `ada-contextual-menu'. Note that the
1020 ;; variable `ada-contextual-menu-on-identifier' is set automatically to t
1021 ;; if the mouse button was pressed on an identifier.
1024 (defun ada-call-from-contextual-menu (function)
1029 (setq ada-contextual-menu-last-point
1032 (defun ada-popup-menu (position)
1035 Sets `ada-contextual-menu-last-point' to the current position before
1044 (setq ada-contextual-menu-last-point
1048 (setq ada-contextual-menu-on-identifier
1052 (not (ada-in-string-or-comment-p))
1054 (not (ada-after-keyword-p)))
1056 (if (fboundp 'popup-menu)
1057 (funcall (symbol-function 'popup-menu) ada-contextual-menu)
1059 (setq choice (x-popup-menu position ada-contextual-menu))
1060 (if choice
1061 (funcall (lookup-key ada-contextual-menu (vector (car choice)))))))
1063 (set-buffer (cadr ada-contextual-menu-last-point))
1064 (goto-char (car ada-contextual-menu-last-point))
1073 (defun ada-add-extensions (spec body)
1080 (tmp (assoc reg ada-other-file-alist)))
1081 (if tmp
1083 (add-to-list 'ada-other-file-alist (list reg (list spec)))))
1086 (tmp (assoc reg ada-other-file-alist)))
1087 (if tmp
1089 (add-to-list 'ada-other-file-alist (list reg (list body)))))
1092 (cons (concat (regexp-quote spec) "\\'") 'ada-mode))
1094 (cons (concat (regexp-quote body) "\\'") 'ada-mode))
1096 (add-to-list 'ada-spec-suffixes spec)
1097 (add-to-list 'ada-body-suffixes body)
1101 (if (fboundp 'speedbar-add-supported-extension)
1111 (defun ada-mode ()
1115 \\{ada-mode-map}
1117 Indent line '\\[ada-tab]'
1120 Re-format the parameter-list point is in '\\[ada-format-paramlist]'
1121 Indent all lines in region '\\[ada-indent-region]'
1123 Adjust case of identifiers and keywords in region '\\[ada-adjust-case-region]'
1124 Adjust case of identifiers and keywords in buffer '\\[ada-adjust-case-buffer]'
1128 Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]'
1129 Next package '\\[ada-next-package]' Previous package '\\[ada-previous-package]'
1131 Goto matching start of current 'end ...;' '\\[ada-move-to-start]'
1132 Goto end of current block '\\[ada-move-to-end]'
1137 Uncomment region '\\[ada-uncomment-region]'
1146 Switch to other file in other window '\\[ada-ff-other-window]'
1150 If you use ada-xref.el:
1151 Goto declaration: '\\[ada-point-and-xref]' on the identifier
1152 or '\\[ada-goto-declaration]' with point on the identifier
1153 Complete identifier: '\\[ada-complete-identifier]'."
1165 ;; comment end must be set because it may hold a wrong value if
1182 'ada-indent-current-function)
1191 (if (ada-check-emacs-version 20 3)
1199 (if (boundp 'imenu-case-fold-search)
1203 'ada-fill-comment-paragraph)
1206 ada-imenu-generic-expression)
1215 'ada-compile-mouse-goto-error)
1217 'ada-compile-goto-error)
1219 'ada-compile-goto-error)))
1225 (if (featurep 'xemacs)
1227 (put 'ada-mode 'font-lock-defaults
1228 '(ada-font-lock-keywords
1232 '(ada-font-lock-keywords
1236 (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
1241 'ada-other-file-alist)
1243 'ada-search-directories-internal)
1244 (setq ff-post-load-hook 'ada-set-point-accordingly
1245 ff-file-created-hook 'ada-make-body)
1246 (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in)
1258 ada-search-directories-internal
1259 (ada-make-filename-from-adaname (match-string 3))
1260 ada-spec-suffixes)))
1266 ada-search-directories-internal
1267 (ada-make-filename-from-adaname (match-string 1))
1268 ada-spec-suffixes)))
1274 ada-search-directories-internal
1275 (ada-make-filename-from-adaname (match-string 1))
1276 ada-spec-suffixes)))
1281 "\\([ \t]*\\(procedure\\|function\\|package\\|if\\|while\\|for\\|declare\\|case\\|end\\|begin\\|loop\\)\\|--\\)")
1282 (set (make-local-variable 'outline-level) 'ada-outline-level)
1291 (add-to-list 'align-dq-string-modes 'ada-mode)
1292 (add-to-list 'align-open-comment-modes 'ada-mode)
1293 (set (make-local-variable 'align-region-separate) ada-align-region-separate)
1297 '(ada-solo-comment
1299 (modes . '(ada-mode))))
1301 '(ada-solo-use
1303 (modes . '(ada-mode))))
1305 (setq ada-align-modes nil)
1307 (add-to-list 'ada-align-modes
1308 '(ada-declaration-assign
1310 (valid . (lambda() (not (ada-in-comment-p))))
1312 (modes . '(ada-mode))))
1313 (add-to-list 'ada-align-modes
1314 '(ada-associate
1316 (valid . (lambda() (not (ada-in-comment-p))))
1317 (modes . '(ada-mode))))
1318 (add-to-list 'ada-align-modes
1319 '(ada-comment
1321 (modes . '(ada-mode))))
1322 (add-to-list 'ada-align-modes
1323 '(ada-use
1325 (valid . (lambda() (not (ada-in-comment-p))))
1326 (modes . '(ada-mode))))
1327 (add-to-list 'ada-align-modes
1328 '(ada-at
1330 (modes . '(ada-mode))))
1332 (setq align-mode-rules-list ada-align-modes)
1335 (if ada-popup-key
1336 (define-key ada-mode-map ada-popup-key 'ada-popup-menu))
1339 (define-abbrev-table 'ada-mode-abbrev-table ())
1340 (setq local-abbrev-table ada-mode-abbrev-table)
1344 (setq which-func-functions '(ada-which-function))
1349 (setq major-mode 'ada-mode
1352 (use-local-map ada-mode-map)
1354 (easy-menu-add ada-mode-menu ada-mode-map)
1356 (set-syntax-table ada-mode-syntax-table)
1358 (if ada-clean-buffer-before-saving
1368 (min ada-indent (current-column))))))
1369 (add-hook 'skeleton-end-hook 'ada-adjust-case-skeleton nil t)
1371 (run-mode-hooks 'ada-mode-hook)
1374 ;; ada-fill-comment-prefix
1376 (if ada-fill-comment-prefix
1377 (set 'comment-start ada-fill-comment-prefix)
1385 (ada-initialize-properties)
1386 (add-hook 'font-lock-mode-hook 'ada-deactivate-properties nil t)))
1388 ;; the following has to be done after running the ada-mode-hook
1392 (cond ((eq ada-language-version 'ada83)
1393 (setq ada-keywords ada-83-keywords))
1394 ((eq ada-language-version 'ada95)
1395 (setq ada-keywords ada-95-keywords))
1396 ((eq ada-language-version 'ada2005)
1397 (setq ada-keywords ada-2005-keywords)))
1399 (if ada-auto-case
1400 (ada-activate-keys-for-case)))
1402 (defun ada-adjust-case-skeleton ()
1406 (ada-adjust-case-region
1411 (defun ada-region-selected ()
1412 "Return t if a region has been selected by the user and is still active."
1425 ;; `ada-case-attribute', `ada-case-keyword' and `ada-case-identifier'. These
1430 ;; one word per line. These files are stored in `ada-case-exception-file'.
1434 (defun ada-save-exceptions-to-file (file-name)
1436 Casing exception lists are `ada-case-exception' and `ada-case-exception-substring'."
1440 (sort (copy-sequence ada-case-exception)
1443 (sort (copy-sequence ada-case-exception-substring)
1449 (defun ada-create-case-exception (&optional word)
1452 The new words is added to the first file in `ada-case-exception-file'.
1459 (cond ((stringp ada-case-exception-file)
1460 (setq file-name ada-case-exception-file))
1461 ((listp ada-case-exception-file)
1462 (setq file-name (car ada-case-exception-file)))
1465 "See variable ada-case-exception-file"))))
1467 (set-syntax-table ada-mode-symbol-syntax-table)
1476 (ada-case-read-exceptions-from-file file-name)
1480 (if (and (not (equal ada-case-exception '()))
1481 (assoc-string word ada-case-exception t))
1482 (setcar (assoc-string word ada-case-exception t) word)
1483 (add-to-list 'ada-case-exception (cons word t))
1486 (ada-save-exceptions-to-file file-name)
1489 (defun ada-create-case-exception-substring (&optional word)
1492 or the selected region if any is active.
1493 The new word is added to the first file in `ada-case-exception-file'.
1498 (cond ((stringp ada-case-exception-file)
1499 ada-case-exception-file)
1500 ((listp ada-case-exception-file)
1501 (car ada-case-exception-file))
1504 "See variable ada-case-exception-file"))))))
1507 ;; if any, or the selected region, or the word under the cursor
1511 ((ada-region-selected)
1529 (ada-case-read-exceptions-from-file file-name)
1533 (if (and (not (equal ada-case-exception-substring '()))
1534 (assoc-string word ada-case-exception-substring t))
1535 (setcar (assoc-string word ada-case-exception-substring t) word)
1536 (add-to-list 'ada-case-exception-substring (cons word t))
1539 (ada-save-exceptions-to-file file-name)
1543 (defun ada-case-read-exceptions-from-file (file-name)
1545 (if (file-readable-p (expand-file-name file-name))
1548 (set-syntax-table ada-mode-symbol-syntax-table)
1560 (if (char-equal (string-to-char word) ?*)
1563 (unless (assoc-string word ada-case-exception-substring t)
1564 (add-to-list 'ada-case-exception-substring (cons word t))))
1565 (unless (assoc-string word ada-case-exception t)
1566 (add-to-list 'ada-case-exception (cons word t)))))
1573 (defun ada-case-read-exceptions ()
1574 "Read all the casing exception files from `ada-case-exception-file'."
1578 (setq ada-case-exception '()
1579 ada-case-exception-substring '())
1581 (cond ((stringp ada-case-exception-file)
1582 (ada-case-read-exceptions-from-file ada-case-exception-file))
1584 ((listp ada-case-exception-file)
1585 (mapcar 'ada-case-read-exceptions-from-file
1586 ada-case-exception-file))))
1588 (defun ada-adjust-case-substring ()
1591 (let ((substrings ada-case-exception-substring)
1616 (defun ada-adjust-case-identifier ()
1618 The auto-casing is done according to the value of `ada-case-identifier'
1619 and the exceptions defined in `ada-case-exception-file'."
1621 (if (or (equal ada-case-exception '())
1624 (funcall ada-case-identifier -1)
1625 (ada-adjust-case-substring))
1633 (if (setq match (assoc-string (buffer-substring start end)
1634 ada-case-exception t))
1641 (funcall ada-case-identifier -1)
1642 (ada-adjust-case-substring))))))
1644 (defun ada-after-keyword-p ()
1645 "Return t if cursor is after a keyword that is not an attribute."
1651 (looking-at (concat ada-keywords "[^_]")))))
1653 (defun ada-adjust-case (&optional force-identifier)
1656 (if (not (bobp))
1659 (if (and (not (bobp))
1660 ;; or if at the end of a character constant
1663 ;; or if the previous character was not part of a word
1665 ;; if in a string or a comment
1666 (not (ada-in-string-or-comment-p))
1668 (if (save-excursion
1673 (funcall ada-case-attribute -1)
1674 (if (and
1676 (ada-after-keyword-p))
1677 (funcall ada-case-keyword -1)
1678 (ada-adjust-case-identifier))))
1683 (defun ada-adjust-case-interactive (arg)
1688 (if ada-auto-case
1694 (set-syntax-table ada-mode-symbol-syntax-table)
1699 (ada-adjust-case)
1705 (funcall ada-lfd-binding))
1707 (funcall ada-ret-binding))))
1708 ((eq lastk ?\C-i) (ada-tab))
1711 ;; if there is a keyword in front of the underscore
1713 (if (eq lastk ?_)
1714 (ada-adjust-case t)
1715 (ada-adjust-case))
1724 (funcall ada-lfd-binding))
1726 (funcall ada-ret-binding))
1731 (defun ada-activate-keys-for-case ()
1738 (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M")))
1739 (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j")))
1743 ada-mode-map
1745 'ada-adjust-case-interactive)))
1749 (defun ada-loose-case-word (&optional arg)
1765 (defun ada-no-auto-case (&optional arg)
1769 instance use it for `ada-case-identifier' if you don't want any special
1771 See also `ada-auto-case' to disable auto casing altogether."
1774 (defun ada-capitalize-word (&optional arg)
1784 (defun ada-adjust-case-region (from to)
1796 (set-syntax-table ada-mode-symbol-syntax-table)
1809 ;; do nothing if it is a string or comment
1810 (ada-in-string-or-comment-p)
1816 (setq keywordp (looking-at ada-keywords))
1821 (if attribp
1822 (funcall ada-case-attribute -1)
1823 (if keywordp
1824 (funcall ada-case-keyword -1)
1825 (ada-adjust-case-identifier)))
1830 (defun ada-adjust-case-buffer ()
1834 (ada-adjust-case-region (point-min) (point-max)))
1846 ;; This is done in `ada-scan-paramlist'.
1848 ;; `ada-insert-paramlist'.
1849 ;; Both steps are called from `ada-format-paramlist'.
1854 (defun ada-format-paramlist ()
1864 (set-syntax-table ada-mode-symbol-syntax-table)
1866 ;; check if really inside parameter list
1867 (or (ada-in-paramlist-p)
1871 (ada-search-ignore-string-comment
1872 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
1888 (setq paramlist (ada-scan-paramlist (1+ begin) end))
1895 (ada-insert-paramlist paramlist))
1901 (defun ada-scan-paramlist (begin end)
1918 (ada-goto-next-non-ws)
1922 (if (setq match-cons
1923 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
1934 (ada-search-ignore-string-comment ":" nil epos t 'search-forward)
1942 (ada-search-ignore-string-comment
1951 (ada-search-ignore-string-comment
1960 (ada-search-ignore-string-comment
1965 (ada-goto-next-non-ws)
1968 (ada-goto-next-non-ws))
1978 ;; read default-expression, if there is one
1983 (if (setq match-cons
1984 (ada-search-ignore-string-comment
1992 ;; check if it was the last parameter
1993 (if (eq epos end)
1999 (defun ada-insert-paramlist (paramlist)
2031 (if (save-excursion
2036 (ada-indent-current)
2038 (if (looking-at "\\(is\\|return\\)")
2052 (ada-indent-current)
2069 (if (nth 1 (nth i paramlist))
2071 (if (and
2078 (if (nth 2 (nth i paramlist))
2080 (if (and
2087 (if (nth 3 (nth i paramlist))
2092 ;; insert type-name and, if necessary, space and default-expression
2094 (if (nth 5 (nth i paramlist))
2099 ;; check if it was the last parameter
2100 (if (zerop i)
2108 ;; if anything follows, except semicolon, newline, is or return
2111 (ada-indent-newline-indent))
2134 ;; - `ada-indent-region': Re-indent a region of text
2135 ;; - `ada-justified-indent-current': Re-indent the current line and shows the
2137 ;; - `ada-indent-current': Re-indent the current line
2138 ;; - `ada-get-current-indent': Calculate the indentation for the current line,
2140 ;; - `ada-get-indent-*': Calculate the indentation in a specific context.
2145 (defun ada-indent-region (beg end)
2156 (if (> block-done 39)
2161 (if (= (char-after) ?\n) nil
2162 (ada-indent-current))
2167 (defun ada-indent-newline-indent ()
2170 (ada-indent-current)
2172 (ada-indent-current))
2174 (defun ada-indent-newline-indent-conditional ()
2176 The original line is indented first if `ada-indent-after-return' is non-nil."
2178 (if ada-indent-after-return (ada-indent-current))
2180 (ada-indent-current))
2182 (defun ada-justified-indent-current ()
2186 (let ((cur-indent (ada-indent-current)))
2192 (if (equal (cdr cur-indent) '(0))
2209 (defun ada-batch-reformat ()
2213 emacs -batch -l ada-mode -f ada-batch-reformat file1 file2 ..."
2219 (ada-indent-region (point-min) (point-max))
2220 (ada-adjust-case-buffer)
2226 (defsubst ada-goto-previous-word ()
2228 Return the new position of point or nil if not found."
2229 (ada-goto-next-word t))
2231 (defun ada-indent-current ()
2243 (set-syntax-table ada-mode-symbol-syntax-table)
2247 (if (featurep 'xemacs)
2254 (if (save-excursion (zerop (forward-line -1)))
2257 (ada-get-current-indent))
2264 (if cur-indent
2279 ;; only re-indent if indentation is different then the current
2280 (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent)
2289 (if (< (current-column) (current-indentation))
2294 (if (featurep 'xemacs)
2301 (defun ada-get-current-indent ()
2320 ((and ada-indent-to-open-paren
2321 (not (ada-in-paramlist-p))
2322 (setq column (ada-in-open-paren-p)))
2324 ;; check if we have something like this (Table_Component_Type =>
2329 (if (= (following-char) ?\))
2335 (if (and (skip-chars-backward " \t")
2340 (list column 'ada-broken-indent)
2343 ;; (ada-broken-line from the opening parenthesis. However, in
2349 ;; and then C) -- indented by ada-broken-indent
2354 (if (= (char-before) ?\))
2357 (if (memq (char-before) '(?, ?\; ?\( ?\)))
2359 (list column 'ada-continuation-indent)
2367 (ada-indent-on-previous-lines nil orgpoint orgpoint))
2382 (ada-goto-matching-start 1)
2386 ;; if 'loop' is not on a separate line
2389 (if (save-excursion
2394 (setq limit (car (ada-search-ignore-string-comment ";" t))))
2395 (if (save-excursion
2398 (ada-search-ignore-string-comment ada-loop-start-re t limit))
2404 (if (looking-at ada-named-block-re)
2405 (setq label (- ada-label-indent))))))))
2408 ;; if the keyword is found at the beginning of a line (or just
2414 (if (looking-at "record")
2415 (if (save-excursion
2420 (car (ada-search-ignore-string-comment "\\<type\\>" t)))
2430 (ada-goto-matching-start 1)
2436 (if (save-excursion (ada-goto-previous-word)
2438 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2440 (ada-goto-matching-start 1 nil t)
2447 (ada-goto-matching-start 1 nil t)
2459 (ada-goto-matching-start 1)
2461 'ada-when-indent)))
2469 (if (save-excursion (ada-goto-previous-word)
2471 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2474 (ada-search-ignore-string-comment
2475 "\\<\\(elsif\\|if\\|select\\)\\>" t nil)
2477 'ada-stmt-end-indent))))
2488 (ada-goto-stmt-start)
2489 (if (looking-at "\\<\\(loop\\|if\\)\\>")
2490 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2491 (unless (looking-at ada-loop-start-re)
2492 (ada-search-ignore-string-comment ada-loop-start-re
2494 (if (looking-at "\\<loop\\>")
2495 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2496 (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))))
2508 (ada-search-ignore-string-comment
2510 (if (looking-at "\\<use\\>")
2511 (ada-search-ignore-string-comment "for" t nil nil
2514 'ada-indent-record-rel-type)))
2523 (if (ada-goto-matching-decl-start t)
2525 (ada-indent-on-previous-lines nil orgpoint orgpoint))))
2534 (if (and ada-indent-is-separate
2537 (ada-goto-next-non-ws (save-excursion (end-of-line)
2541 (ada-goto-stmt-start)
2542 (list (progn (back-to-indentation) (point)) 'ada-indent))
2544 (ada-goto-stmt-start)
2545 (if (looking-at "\\<package\\|procedure\\|function\\>")
2547 (list (progn (back-to-indentation) (point)) 'ada-indent)))))
2557 (let ((var 'ada-indent-return))
2559 (if (looking-at "renames")
2562 (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
2563 (if (and pos
2566 (set 'var 'ada-indent-renames)))
2569 (if (= (char-before) ?\))
2576 (if (and (= (following-char) ?\()
2586 ;; The indentation depends of the value of ada-indent-return
2587 (if (<= (eval var) 0)
2593 ;; Only do something special if the user want to indent
2595 (if (and (> (eval var) 0)
2601 (ada-indent-on-previous-lines nil orgpoint orgpoint)))))))
2611 (or (ada-looking-at-semi-or)
2612 (ada-looking-at-semi-private)))
2614 ;; ??? Wasn't this done already in ada-looking-at-semi-or ?
2615 (ada-goto-matching-start 1)
2625 (ada-goto-stmt-start)
2626 (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))
2633 (if ada-indent-comment-as-code
2635 ;; Indent comments on previous line comments if required
2636 ;; We must use a search-forward (even if the code is more complex),
2640 (if (and ada-indent-align-comments
2649 (unless (ada-in-string-p)
2655 (ada-indent-on-previous-lines nil orgpoint orgpoint)))
2665 (equal ada-which-compiler 'gnat)
2666 (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)"))
2684 (ada-indent-on-previous-lines nil orgpoint orgpoint))
2697 (ada-search-ignore-string-comment
2705 (if (looking-at "generic")
2707 (ada-indent-on-previous-lines nil orgpoint orgpoint))))
2714 (if (ada-in-decl-p)
2715 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2716 (append (ada-indent-on-previous-lines nil orgpoint orgpoint)
2717 '(ada-label-indent))))
2724 (or result (ada-indent-on-previous-lines nil orgpoint orgpoint))))
2726 (defun ada-indent-on-previous-lines (&optional nomove orgpoint initial-pos)
2730 if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
2731 (if initial-pos
2736 (if (ada-in-paramlist-p)
2737 (ada-get-indent-paramlist)
2741 (ada-goto-stmt-start))
2744 (if (and (eq oldpoint (point))
2746 (ada-get-indent-nochange)
2751 ada-indent-to-open-paren
2752 (ada-in-open-paren-p))
2753 (ada-get-indent-open-paren))
2756 (ada-get-indent-end orgpoint))
2758 ((looking-at ada-loop-start-re)
2759 (ada-get-indent-loop orgpoint))
2761 ((looking-at ada-subprog-start-re)
2762 (ada-get-indent-subprog orgpoint))
2764 ((looking-at ada-block-start-re)
2765 (ada-get-indent-block-start orgpoint))
2768 (ada-get-indent-type orgpoint))
2773 ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\\>")
2774 (ada-get-indent-if orgpoint))
2777 (ada-get-indent-case orgpoint))
2780 (ada-get-indent-when orgpoint))
2783 (ada-get-indent-label orgpoint))
2786 (ada-get-indent-nochange))
2791 (- ada-label-indent))))
2797 (if (save-excursion (search-forward ";" oldpoint t))
2799 (list (point) (if (looking-at "with")
2800 'ada-with-indent
2801 'ada-use-indent))))
2804 (ada-get-indent-noindent orgpoint)))))
2807 (defun ada-get-indent-open-paren ()
2809 (list (ada-in-open-paren-p) 0))
2811 (defun ada-get-indent-nochange ()
2818 (defun ada-get-indent-paramlist ()
2821 (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
2830 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
2831 (ada-goto-next-non-ws)
2838 (list (point) 'ada-broken-indent))
2842 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
2843 (ada-goto-next-non-ws)
2846 (defun ada-get-indent-end (orgpoint)
2853 (if (save-excursion
2854 (ada-search-ignore-string-comment ";" nil orgpoint nil
2860 (ada-goto-next-non-ws)
2862 ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>")
2863 (save-excursion (ada-check-matching-start (match-string 0)))
2867 ;; loop/select/if/case/record/select
2871 (ada-check-matching-start (match-string 0))
2874 (ada-goto-stmt-start)
2877 (ada-search-ignore-string-comment "\\<type\\>" t))
2882 ((looking-at ada-ident-re)
2885 (ada-goto-matching-start 0)
2886 (ada-check-defun-name defun-name))
2893 (ada-goto-matching-start 0)
2894 (if (looking-at "\\<begin\\>")
2897 (if (ada-goto-matching-decl-start t)
2907 'ada-broken-indent))))
2910 'ada-broken-indent))))
2912 (defun ada-get-indent-case (orgpoint)
2924 (ada-search-ignore-string-comment
2926 (ada-search-ignore-string-comment
2930 (unless (ada-search-ignore-string-comment "when" t opos)
2932 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))
2937 (setq match-cons (ada-search-ignore-string-comment
2940 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
2945 (setq match-cons (ada-search-ignore-string-comment
2947 (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent))
2953 'ada-broken-indent)))))
2955 (defun ada-get-indent-when (orgpoint)
2959 (if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint)
2960 (list cur-indent 'ada-indent)
2961 (list cur-indent 'ada-broken-indent))))
2963 (defun ada-get-indent-if (orgpoint)
2964 "Calculate the indentation when point is just before an if statement.
2971 (while (and (setq match-cons (ada-search-ignore-string-comment
2976 (if match-cons
2981 ;; => else indent according to 'if'
2983 (if (save-excursion
2989 (list cur-indent 'ada-indent))
2991 (list cur-indent 'ada-broken-indent))))
2993 (defun ada-get-indent-block-start (orgpoint)
3000 (setq pos (ada-goto-next-non-ws orgpoint)))
3003 (ada-indent-on-previous-lines t orgpoint)))
3012 (if (save-excursion
3015 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)
3019 (car (ada-search-ignore-string-comment "\\<type\\>" t)))
3020 'ada-indent)))
3024 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
3026 (defun ada-get-indent-subprog (orgpoint)
3035 (if (save-excursion
3037 (ada-search-ignore-string-comment
3046 ;; no, then goto next non-ws, if there is one in front of point
3049 (unless (ada-goto-next-non-ws orgpoint)
3059 (not (ada-search-ignore-string-comment
3061 (list cur-indent 'ada-indent))
3069 (ada-search-ignore-string-comment
3073 (ada-search-ignore-string-comment ada-subprog-start-re t)
3074 (ada-get-indent-noindent orgpoint))
3080 (save-excursion (setq match-cons (ada-goto-next-non-ws orgpoint)))
3082 (ada-indent-on-previous-lines t orgpoint)))
3087 (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward))
3093 (list cur-indent 'ada-broken-indent)))))
3095 (defun ada-get-indent-noindent (orgpoint)
3107 ((ada-in-paramlist-p)
3108 (ada-previous-procedure)
3115 'ada-broken-decl-indent))
3120 (if (looking-at ada-named-block-re)
3121 (setq label (- ada-label-indent))
3126 (if (or (save-excursion
3127 (and (ada-search-ignore-string-comment "\\<private\\>" nil orgpoint)
3130 (ada-goto-previous-word)
3133 (and (ada-search-ignore-string-comment "\\<record\\>" nil orgpoint)
3136 (ada-goto-previous-word)
3142 (if (save-excursion
3143 (ada-search-ignore-string-comment ";" nil orgpoint nil
3147 'ada-broken-indent)))))))
3149 (defun ada-get-indent-label (orgpoint)
3154 (ada-search-ignore-string-comment ":" nil)
3158 (setq match-cons (ada-search-ignore-string-comment
3159 ada-loop-start-re nil orgpoint)))
3161 (ada-get-indent-loop orgpoint))
3165 (setq match-cons (ada-search-ignore-string-comment
3168 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
3171 ((ada-in-decl-p)
3172 (if (save-excursion
3173 (ada-search-ignore-string-comment ";" nil orgpoint))
3175 (list cur-indent 'ada-broken-indent)))
3179 (list cur-indent '(- ada-label-indent))))))
3181 (defun ada-get-indent-loop (orgpoint)
3190 (if (looking-at ada-named-block-re)
3191 (- ada-label-indent)
3200 (ada-search-ignore-string-comment ";" nil orgpoint nil
3207 (setq pos (ada-get-indent-block-start orgpoint))
3208 (if (equal label 0)
3223 (ada-goto-next-non-ws orgpoint)
3225 (if (= (char-after) ?') (forward-word 1) t)
3226 (ada-goto-next-non-ws orgpoint)
3229 ;; check if there is a 'record' before point
3232 (setq match-cons (ada-search-ignore-string-comment
3235 (if match-cons
3238 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
3239 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
3246 (setq match-cons (ada-search-ignore-string-comment
3250 ;; indent according to 'loop', if it's first in the line;
3258 'ada-indent))
3264 'ada-broken-indent))))
3273 (if (save-excursion
3274 (setq match-cons (ada-search-ignore-string-comment
3280 ;; indent according to 'loop', if it's first in the line;
3288 'ada-indent))
3291 'ada-broken-indent))))))
3293 (defun ada-get-indent-type (orgpoint)
3303 (setq match-dat (ada-search-ignore-string-comment
3305 (ada-goto-next-non-ws)
3308 (ada-goto-next-non-ws)
3316 (setq match-dat (ada-search-ignore-string-comment
3319 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
3324 (ada-search-ignore-string-comment ";" nil orgpoint nil
3332 (ada-search-ignore-string-comment "is" nil orgpoint nil
3334 (not (ada-goto-next-non-ws orgpoint))))
3335 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
3341 'ada-broken-indent)))))
3349 (defun ada-goto-stmt-start ()
3352 As a special case, if we are looking at a closing parenthesis, skip to the
3357 (setq match-dat (ada-search-prev-end-stmt))
3358 (if match-dat
3361 ;; found a previous end-statement => check if anything follows
3367 (ada-goto-next-non-ws orgpoint))
3372 (setq match-dat (ada-search-prev-end-stmt)))
3374 ;; if found the correct end-statement => goto next non-ws
3376 (if match-dat
3378 (ada-goto-next-non-ws)
3388 ;; skip to the very first statement, if there is one
3390 (unless (ada-goto-next-non-ws orgpoint)
3395 (defun ada-search-prev-end-stmt ()
3406 (setq match-dat (ada-search-ignore-string-comment
3407 ada-end-stmt-re t)))
3410 (unless (ada-in-open-paren-p)
3416 (ada-goto-previous-word)
3422 (and (save-excursion (ada-goto-previous-word)
3423 (ada-goto-previous-word)
3427 (ada-goto-next-non-ws)
3446 (if found
3451 (defun ada-goto-next-non-ws (&optional limit)
3459 (if (and (not (eobp))
3461 (ada-in-string-p)))
3463 (if (< (point) limit)
3469 (defun ada-goto-stmt-end (&optional limit)
3471 Return the new position of point or nil if not found.
3473 (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
3478 (defun ada-goto-next-word (&optional backward)
3481 Return the new position of point or nil if not found."
3488 (if (setq match-cons
3489 (if backward
3490 (ada-search-ignore-string-comment "\\w" t nil t)
3491 (ada-search-ignore-string-comment "\\w" nil nil t)))
3500 ;; if not found, restore old position of point
3508 (defun ada-check-matching-start (keyword)
3509 "Signal an error if matching block start is not KEYWORD.
3511 (ada-goto-matching-start 0)
3516 (defun ada-check-defun-name (defun-name)
3517 "Check if the name of the matching defun really is DEFUN-NAME.
3518 Assumes point to be already positioned by `ada-goto-matching-start'.
3522 (if (save-excursion
3523 (ada-goto-previous-word)
3529 (unless (looking-at ada-subprog-start-re)
3530 (ada-goto-matching-decl-start))
3538 (if (looking-at "\\<declare\\>")
3549 (if (looking-at "\\<\\(body\\|type\\)\\>")
3561 (defun ada-goto-matching-decl-start (&optional noerror recursive)
3563 If NOERROR is non-nil, it only returns nil if no match was found."
3566 ;; first should be set to t if we should stop at the first
3573 ;; Ignore "when" most of the time, except if we are looking at the
3578 (if (looking-at "begin")
3581 (if (or
3584 (ada-search-ignore-string-comment
3592 (ada-search-ignore-string-comment ada-matching-decl-start-re t))
3599 (ada-goto-matching-start 1 noerror)
3610 (if (looking-at "begin")
3619 (ada-search-ignore-string-comment
3623 (if (looking-at "end")
3624 (ada-goto-matching-start 1 noerror t)
3625 ;; (ada-goto-matching-decl-start noerror t)
3634 (if count-generic
3639 ((looking-at "if")
3642 (unless (looking-at "\\<end[ \t\n]*if\\>")
3653 ;; check if it is only a type definition, but not a protected
3655 (if (or (looking-at "is[ \t]+<>")
3660 ;; Detect if we have a closing parenthesis (Could be
3663 (if (= (char-after) ?\))
3670 (ada-goto-previous-word)
3674 (ada-goto-previous-word)
3684 (if (save-excursion
3685 (ada-goto-previous-word)
3698 (if stop-at-when
3711 ;; check if declaration-start is really found
3712 (if (and
3714 (if (looking-at "is")
3715 (ada-search-ignore-string-comment ada-subprog-start-re t)
3718 (if noerror nil
3722 (defun ada-goto-matching-start (&optional nest-level noerror gotothen)
3725 If NOERROR is non-nil, it only returns nil if no matching start was found.
3726 If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
3727 (let ((nest-count (if nest-level nest-level 0))
3742 (ada-search-ignore-string-comment ada-matching-start-re t))
3756 ;; found loop/select/record/case/if => check if it starts or
3758 ((looking-at "loop\\|select\\|record\\|case\\|if")
3761 ;; check if keyword follows 'end'
3762 (ada-goto-previous-word)
3763 (if (looking-at "\\<end\\>[ \t]*[^;]")
3783 ;; found package start => check if it really is a block
3786 ;; ignore if this is just a renames statement
3788 (pos (ada-search-ignore-string-comment
3790 (if pos
3799 (ada-goto-next-non-ws)
3800 ;; ignore it if it is only a declaration with 'new'
3805 (if (and (not (looking-at "\\<\\(new\\|separate\\|begin\\)\\>"))
3811 ;; found task start => check if it has a body
3815 (ada-goto-next-non-ws)
3819 ;; In that case, do nothing if there is a "is"
3821 (ada-goto-next-non-ws);; skip type name
3823 ;; Do nothing if we are simply looking at a simple
3828 (if (looking-at "(")
3829 (ada-search-ignore-string-comment ")" nil))
3830 (let ((tmp (ada-search-ignore-string-comment
3832 (if tmp
3835 (if (looking-at "is")
3838 ;; Check if that task declaration had a block attached to
3839 ;; it (i.e do nothing if we have just "task name;")
3852 (if (equal (car last-was-begin) t)
3859 ;; Ignore if this is just a declaration
3861 (let ((pos (ada-search-ignore-string-comment
3863 (if pos
3865 (if (looking-at "is")
3872 ;; Ignore if this is just a declaration
3874 (let ((pos (ada-search-ignore-string-comment
3876 (if pos
3878 (if (looking-at "is")
3890 ;; match is found, if nest-depth is zero
3893 (if (bobp)
3895 (if found
3902 ;; found 'if' => skip to 'then', if it's on a separate line
3907 (looking-at "if")
3909 (ada-search-ignore-string-comment "then" nil nil nil
3919 (unless (ada-search-ignore-string-comment
3925 (if noerror
3930 (defun ada-goto-matching-end (&optional nest-level noerror)
3933 If NOERROR is non-nil, it only returns nil if no matching start found."
3938 "if" "task" "package" "record" "do"
3953 (if (looking-at "\\<if\\|loop\\|case\\|begin\\>")
3961 (ada-search-ignore-string-comment regex nil))
3980 ;; Nothing should be done if we have only the specs or a
3984 (if first
3988 (ada-search-ignore-string-comment "is\\|;")
3989 (if (= (char-before) ?s)
3991 (ada-goto-next-non-ws)
3995 (ada-goto-matching-end 0 t)))))))
4002 (if (progn
4004 (ada-goto-next-non-ws)
4005 (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
4008 ;; found package start => check if it really starts a block, and is not
4011 (ada-search-ignore-string-comment "is" nil nil nil
4013 (ada-goto-next-non-ws)
4014 ;; ignore and skip it if it is only a 'new' package
4015 (if (looking-at "\\<new\\>")
4022 (if (not first)
4029 (if found
4031 (if noerror
4037 (defun ada-search-ignore-string-comment
4040 Returns a cons cell of begin and end of match data or nil, if not found.
4055 (setq search-func (if backward 're-search-backward 're-search-forward)))
4061 (set-syntax-table ada-mode-symbol-syntax-table)
4078 ((ada-in-string-p parse-result)
4079 (if (featurep 'xemacs)
4087 ((ada-in-comment-p parse-result)
4088 (if (featurep 'xemacs)
4097 (if (forward-comment 1)
4103 ;; directly in front of a comment => skip it, if searching forward
4111 ((and (not paramlists) (ada-in-paramlist-p))
4112 (if backward
4123 (if found
4131 (defun ada-in-decl-p ()
4132 "Return t if point is inside a declarative part.
4134 (or (ada-in-paramlist-p)
4136 (ada-goto-matching-decl-start t))))
4139 (defun ada-looking-at-semi-or ()
4140 "Return t if looking at an 'or' following a semicolon."
4145 (ada-goto-stmt-start)
4149 (defun ada-looking-at-semi-private ()
4150 "Return t if looking at the start of a private section in a package.
4151 Return nil if the private is part of the package name, as in
4171 (defun ada-in-paramlist-p ()
4172 "Return t if point is inside a parameter-list."
4175 (ada-search-ignore-string-comment "(\\|)" t nil t)
4185 (if (= (char-before) ?\")
4199 (not (ada-in-string-or-comment-p))
4212 (defun ada-search-ignore-complex-boolean (regexp backwardp)
4216 (while (and (setq result (ada-search-ignore-string-comment regexp backwardp))
4221 (defun ada-in-open-paren-p ()
4222 "Non-nil if in an open parenthesis.
4228 (or (car (ada-search-ignore-complex-boolean
4233 (if (nth 1 parse)
4237 ;; Skip blanks, if they are not followed by a comment
4244 (if (or (not ada-indent-handle-comment-special)
4256 (defun ada-tab ()
4257 "Do indenting or tabbing according to `ada-tab-policy'.
4258 In Transient Mark mode, if the mark is active, operate on the contents
4261 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
4262 ((eq ada-tab-policy 'indent-auto)
4263 (if (ada-region-selected)
4264 (ada-indent-region (region-beginning) (region-end))
4265 (ada-indent-current)))
4266 ((eq ada-tab-policy 'always-tab) (error "Not implemented"))
4269 (defun ada-untab (arg)
4270 "Delete leading indenting according to `ada-tab-policy'."
4273 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard))
4274 ((eq ada-tab-policy 'indent-auto) (error "Not implemented"))
4275 ((eq ada-tab-policy 'always-tab) (error "Not implemented"))
4278 (defun ada-indent-current-function ()
4283 (ada-tab)
4284 (if (< (point) starting-point)
4289 (defun ada-tab-hard ()
4294 (insert-char ? ada-indent))
4295 (if (save-excursion (= (point) (progn (beginning-of-line) (point))))
4296 (forward-char ada-indent)))
4298 (defun ada-untab-hard ()
4303 (indent-rigidly bol eol (- 0 ada-indent))))
4314 (defun ada-remove-trailing-spaces ()
4325 (defun ada-gnat-style ()
4340 (if (not (ada-in-string-or-comment-p))
4345 (if (not (ada-in-string-or-comment-p))
4349 (if (not (ada-in-string-or-comment-p))
4353 (if (not (ada-in-string-or-comment-p))
4357 (if (not (ada-in-string-or-comment-p))
4365 (if (not (save-excursion
4367 (ada-in-string-or-comment-p)))
4376 (if (or (looking-at "--")
4377 (ada-in-string-or-comment-p))
4402 (defun ada-move-to-start ()
4409 (set-syntax-table ada-mode-symbol-syntax-table)
4413 ;; do nothing if in string or comment or not on 'end ...;'
4414 ;; or if an error occurs during processing
4417 (ada-in-string-or-comment-p)
4425 (ada-goto-matching-start 1)
4431 ada-move-to-declaration
4433 (ada-goto-matching-decl-start)
4444 (defun ada-move-to-end ()
4446 Moves to 'begin' if in a declarative part."
4453 (set-syntax-table ada-mode-symbol-syntax-table)
4458 ;; Go to the beginning of the current word, and check if we are
4463 (ada-goto-matching-end 1)
4473 (ada-search-ignore-string-comment "is\\|;")
4477 (ada-goto-matching-end 0 t))
4481 (and (ada-goto-stmt-start)
4484 (ada-goto-next-non-ws)
4486 (ada-search-ignore-string-comment "begin" nil nil nil
4490 (and (ada-goto-stmt-start)
4492 (ada-goto-matching-end 0))
4495 (setq decl-start (and (ada-goto-matching-decl-start t) (point)))
4497 (ada-goto-matching-end 1))
4503 (ada-goto-matching-end 0 t))
4508 (ada-goto-matching-end 0 t))
4512 (ada-goto-matching-end 1)))
4522 (defun ada-next-procedure ()
4526 (if (re-search-forward ada-procedure-start-regexp nil t)
4530 (defun ada-previous-procedure ()
4534 (if (re-search-backward ada-procedure-start-regexp nil t)
4538 (defun ada-next-package ()
4542 (if (re-search-forward ada-package-start-regexp nil t)
4546 (defun ada-previous-package ()
4550 (if (re-search-backward ada-package-start-regexp nil t)
4560 (defun ada-create-keymap ()
4564 (define-key ada-mode-map "\C-j" 'ada-indent-newline-indent-conditional)
4565 (define-key ada-mode-map "\C-m" 'ada-indent-newline-indent-conditional)
4566 (define-key ada-mode-map "\t" 'ada-tab)
4567 (define-key ada-mode-map "\C-c\t" 'ada-justified-indent-current)
4568 (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region)
4569 (if (featurep 'xemacs)
4570 (define-key ada-mode-map '(shift tab) 'ada-untab)
4571 (define-key ada-mode-map [(shift tab)] 'ada-untab))
4572 (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist)
4576 (define-key ada-mode-map "\M-\C-e" 'ada-next-procedure)
4577 (define-key ada-mode-map "\M-\C-a" 'ada-previous-procedure)
4578 (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start)
4579 (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end)
4582 (unless (lookup-key ada-mode-map "\C-c\C-c")
4583 (define-key ada-mode-map "\C-c\C-c" 'compile))
4586 (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer)
4587 (define-key ada-mode-map "\C-c\C-t" 'ada-case-read-exceptions)
4588 (define-key ada-mode-map "\C-c\C-y" 'ada-create-case-exception)
4589 (define-key ada-mode-map "\C-c\C-\M-y" 'ada-create-case-exception-substring)
4594 (if (boundp 'delete-key-deletes-forward)
4595 (define-key ada-mode-map [backspace] 'backward-delete-char-untabify)
4596 (define-key ada-mode-map "\177" 'backward-delete-char-untabify))
4599 (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body)
4602 (define-key ada-mode-map "\C-c;" 'comment-region)
4603 (define-key ada-mode-map "\C-c:" 'ada-uncomment-region)
4605 ;; The following keys are bound to functions defined in ada-xref.el or
4606 ;; ada-prj,el., However, RMS rightly thinks that the code should be shared,
4607 ;; and activated only if the right compiler is used
4608 (if (featurep 'xemacs)
4610 (define-key ada-mode-map '(shift button3) 'ada-point-and-xref)
4611 (define-key ada-mode-map '(control tab) 'ada-complete-identifier))
4612 (define-key ada-mode-map [C-tab] 'ada-complete-identifier)
4613 (define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref))
4615 (define-key ada-mode-map "\C-co" 'ff-find-other-file)
4616 (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame)
4617 (define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration)
4618 (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference)
4619 (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)
4620 (define-key ada-mode-map "\C-cc" 'ada-change-prj)
4621 (define-key ada-mode-map "\C-cd" 'ada-set-default-project-file)
4622 (define-key ada-mode-map "\C-cg" 'ada-gdb-application)
4623 (define-key ada-mode-map "\C-c\C-m" 'ada-set-main-compile-application)
4624 (define-key ada-mode-map "\C-cr" 'ada-run-application)
4625 (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)
4626 (define-key ada-mode-map "\C-c\C-r" 'ada-find-references)
4627 (define-key ada-mode-map "\C-cl" 'ada-find-local-references)
4628 (define-key ada-mode-map "\C-c\C-v" 'ada-check-current)
4629 (define-key ada-mode-map "\C-cf" 'ada-find-file)
4631 (define-key ada-mode-map "\C-cu" 'ada-prj-edit)
4633 ;; The templates, defined in ada-stmt.el
4636 (define-key map "h" 'ada-header)
4637 (define-key map "\C-a" 'ada-array)
4638 (define-key map "b" 'ada-exception-block)
4639 (define-key map "d" 'ada-declare-block)
4640 (define-key map "c" 'ada-case)
4641 (define-key map "\C-e" 'ada-elsif)
4642 (define-key map "e" 'ada-else)
4643 (define-key map "\C-k" 'ada-package-spec)
4644 (define-key map "k" 'ada-package-body)
4645 (define-key map "\C-p" 'ada-procedure-spec)
4646 (define-key map "p" 'ada-subprogram-body)
4647 (define-key map "\C-f" 'ada-function-spec)
4648 (define-key map "f" 'ada-for-loop)
4649 (define-key map "i" 'ada-if)
4650 (define-key map "l" 'ada-loop)
4651 (define-key map "\C-r" 'ada-record)
4652 (define-key map "\C-s" 'ada-subtype)
4653 (define-key map "S" 'ada-tabsize)
4654 (define-key map "\C-t" 'ada-task-spec)
4655 (define-key map "t" 'ada-task-body)
4656 (define-key map "\C-y" 'ada-type)
4657 (define-key map "\C-v" 'ada-private)
4658 (define-key map "u" 'ada-use)
4659 (define-key map "\C-u" 'ada-with)
4660 (define-key map "\C-w" 'ada-when)
4661 (define-key map "w" 'ada-while-loop)
4662 (define-key map "\C-x" 'ada-exception)
4663 (define-key map "x" 'ada-exit)
4664 (define-key ada-mode-map "\C-ct" map))
4668 (defun ada-create-menu ()
4672 ["Ada Mode" (info "ada-mode") t]
4674 (eq ada-which-compiler 'gnat)]
4676 (eq ada-which-compiler 'gnat)]
4678 (eq ada-which-compiler 'gnat)]
4680 (eq ada-which-compiler 'gnat)]
4682 ("Options" :included (eq major-mode 'ada-mode)
4683 ["Auto Casing" (setq ada-auto-case (not ada-auto-case))
4684 :style toggle :selected ada-auto-case]
4686 (setq ada-indent-after-return (not ada-indent-after-return))
4687 :style toggle :selected ada-indent-after-return]
4689 (setq ada-xref-create-ali (not ada-xref-create-ali))
4690 :style toggle :selected ada-xref-create-ali
4691 :included (eq ada-which-compiler 'gnat)]
4693 (setq ada-xref-confirm-compile (not ada-xref-confirm-compile))
4694 :style toggle :selected ada-xref-confirm-compile
4695 :included (eq ada-which-compiler 'gnat)]
4697 (setq ada-xref-other-buffer (not ada-xref-other-buffer))
4698 :style toggle :selected ada-xref-other-buffer
4699 :included (eq ada-which-compiler 'gnat)]
4701 (setq ada-tight-gvd-integration (not ada-tight-gvd-integration))
4702 :style toggle :selected ada-tight-gvd-integration
4703 :included (string-match "gvd" ada-prj-default-debugger)])
4704 ["Customize" (customize-group 'ada)
4706 ["Check file" ada-check-current t]
4707 ["Compile file" ada-compile-current t]
4708 ["Set main and Build" ada-set-main-compile-application t]
4709 ["Show main" ada-show-current-main t]
4710 ["Build" ada-compile-application t]
4711 ["Run" ada-run-application t]
4712 ["Debug" ada-gdb-application (eq ada-which-compiler 'gnat)]
4715 ["Show project" ada-show-current-project t]
4716 ["Load..." ada-set-default-project-file t]
4717 ["New..." ada-prj-new t]
4718 ["Edit..." ada-prj-edit t])
4719 ("Goto" :included (eq major-mode 'ada-mode)
4720 ["Goto Declaration/Body" ada-goto-declaration
4721 (eq ada-which-compiler 'gnat)]
4722 ["Goto Body" ada-goto-body
4723 (eq ada-which-compiler 'gnat)]
4725 ada-goto-declaration-other-frame
4726 (eq ada-which-compiler 'gnat)]
4727 ["Goto Previous Reference" ada-xref-goto-previous-reference
4728 (eq ada-which-compiler 'gnat)]
4729 ["List Local References" ada-find-local-references
4730 (eq ada-which-compiler 'gnat)]
4731 ["List References" ada-find-references
4732 (eq ada-which-compiler 'gnat)]
4733 ["Goto Reference To Any Entity" ada-find-any-references
4734 (eq ada-which-compiler 'gnat)]
4735 ["Goto Parent Unit" ada-goto-parent
4736 (eq ada-which-compiler 'gnat)]
4739 ["Previous Package" ada-previous-package t]
4740 ["Next Package" ada-next-package t]
4741 ["Previous Procedure" ada-previous-procedure t]
4742 ["Next Procedure" ada-next-procedure t]
4743 ["Goto Start Of Statement" ada-move-to-start t]
4744 ["Goto End Of Statement" ada-move-to-end t]
4747 ["Other File Other Window" ada-ff-other-window t])
4748 ("Edit" :included (eq major-mode 'ada-mode)
4749 ["Search File On Source Path" ada-find-file t]
4751 ["Complete Identifier" ada-complete-identifier t]
4753 ["Indent Line" ada-indent-current-function t]
4754 ["Justify Current Indentation" ada-justified-indent-current t]
4755 ["Indent Lines in Selection" ada-indent-region t]
4757 (ada-indent-region (point-min) (point-max)) t]
4758 ["Format Parameter List" ada-format-paramlist t]
4761 ["Uncomment Selection" ada-uncomment-region t]
4765 ada-fill-comment-paragraph-justify t]
4767 ada-fill-comment-paragraph-postfix t]
4769 ["Adjust Case Selection" ada-adjust-case-region t]
4770 ["Adjust Case in File" ada-adjust-case-buffer t]
4771 ["Create Case Exception" ada-create-case-exception t]
4773 ada-create-case-exception-substring t]
4774 ["Reload Case Exceptions" ada-case-read-exceptions t]
4776 ["Make body for subprogram" ada-make-subprogram-body t]
4778 ["Narrow to subprogram" ada-narrow-to-defun t])
4780 :included (eq major-mode 'ada-mode)
4781 ["Header" ada-header t]
4783 ["Package Body" ada-package-body t]
4784 ["Package Spec" ada-package-spec t]
4785 ["Function Spec" ada-function-spec t]
4786 ["Procedure Spec" ada-procedure-spec t]
4787 ["Proc/func Body" ada-subprogram-body t]
4788 ["Task Body" ada-task-body t]
4789 ["Task Spec" ada-task-spec t]
4790 ["Declare Block" ada-declare-block t]
4791 ["Exception Block" ada-exception-block t]
4793 ["Entry" ada-entry t]
4794 ["Entry family" ada-entry-family t]
4795 ["Select" ada-select t]
4796 ["Accept" ada-accept t]
4797 ["Or accept" ada-or-accep t]
4798 ["Or delay" ada-or-delay t]
4799 ["Or terminate" ada-or-terminate t]
4801 ["Type" ada-type t]
4802 ["Private" ada-private t]
4803 ["Subtype" ada-subtype t]
4804 ["Record" ada-record t]
4805 ["Array" ada-array t]
4807 ["If" ada-if t]
4808 ["Else" ada-else t]
4809 ["Elsif" ada-elsif t]
4810 ["Case" ada-case t]
4812 ["While Loop" ada-while-loop t]
4813 ["For Loop" ada-for-loop t]
4814 ["Loop" ada-loop t]
4816 ["Exception" ada-exception t]
4817 ["Exit" ada-exit t]
4818 ["When" ada-when t])
4821 (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode" m)
4822 (if (featurep 'xemacs)
4824 (define-key ada-mode-map [menu-bar] ada-mode-menu)
4825 (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
4832 ;; comment-region function, which only allows uncommenting if the
4840 (defadvice comment-region (before ada-uncomment-anywhere disable)
4841 (if (and arg
4852 (defun ada-uncomment-region (beg end &optional arg)
4859 (if (or (<= emacs-major-version 20) (featurep 'xemacs))
4865 (ada-indent-region beg end)))
4867 (defun ada-fill-comment-paragraph-justify ()
4870 (ada-fill-comment-paragraph 'full))
4872 (defun ada-fill-comment-paragraph-postfix ()
4874 Adds `ada-fill-comment-postfix' at the end of each line."
4876 (ada-fill-comment-paragraph 'full t))
4878 (defun ada-fill-comment-paragraph (&optional justify postfix)
4881 If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended
4886 ;; check if inside comment or just in front a comment
4887 (if (and (not (ada-in-comment-p))
4908 (if (eobp)
4943 (setq fill-prefix ada-fill-comment-prefix)
4945 (if postfix
4946 (setq fill-column (- fill-column (length ada-fill-comment-postfix))))
4950 ;; Add the postfixes if required
4951 (if postfix
4958 (insert ada-fill-comment-postfix)
4964 (if (or (featurep 'xemacs)
4985 ;; are also overriden in `ada-xref'.el when we know that the user is using
4990 (defun ada-make-filename-from-adaname (adaname)
4999 (defun ada-other-file-name ()
5001 The name returned is the body if `current-buffer' is the spec,
5006 (suffixes ada-spec-suffixes)
5014 (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
5019 (if (not is-spec)
5021 (setq suffixes ada-body-suffixes)
5024 (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
5030 (if (not (or is-spec is-body))
5034 (if is-spec
5035 (setq suffixes ada-body-suffixes)
5036 (setq suffixes ada-spec-suffixes))
5044 (if (fboundp 'ada-find-src-file-in-dir)
5046 (ada-find-src-file-in-dir
5048 (if other
5052 (if (file-exists-p (concat name (car suffixes)))
5058 (defun ada-which-function-are-we-in ()
5064 (or (if (re-search-backward ada-procedure-start-regexp nil t)
5066 (if (re-search-backward ada-package-start-regexp nil t)
5071 (defvar ada-last-which-function-line -1
5072 "Last line on which `ada-which-function' was called.")
5073 (defvar ada-last-which-function-subprog 0
5074 "Last subprogram name returned by `ada-which-function'.")
5075 (make-variable-buffer-local 'ada-last-which-function-subprog)
5076 (make-variable-buffer-local 'ada-last-which-function-line)
5079 (defun ada-which-function ()
5092 (if (= line ada-last-which-function-line)
5093 ada-last-which-function-subprog
5107 (if (looking-at "return")
5123 (re-search-backward ada-imenu-subprogram-menu-re nil t))
5128 (if (and (not (ada-in-comment-p))
5135 (if (ada-search-ignore-string-comment
5140 (if (>= end-pos pos)
5143 (setq ada-last-which-function-line line
5144 ada-last-which-function-subprog found)
5147 (defun ada-ff-other-window ()
5153 (defun ada-set-point-accordingly ()
5155 (if ff-function-name
5158 (unless (ada-search-ignore-string-comment
5162 (defun ada-get-body-name (&optional spec-name)
5165 Return nil if no body was found."
5174 (let ((suffixes ada-spec-suffixes)
5178 (if (string-equal (car suffixes) (substring spec-name end))
5183 (if (fboundp 'ff-get-file-name)
5184 (ff-get-file-name ada-search-directories-internal
5185 (ada-make-filename-from-adaname
5188 ada-body-suffixes)
5190 (concat (ada-make-filename-from-adaname
5201 ;; single quote is given punctuation syntax in `ada-mode-syntax-table'.
5209 (defconst ada-font-lock-syntactic-keywords
5211 ;; As a special case, ''' will not be highlighted, but if we do not
5214 ;; This sets the properties of the characters, so that ada-in-string-p
5217 ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))
5220 (defvar ada-font-lock-keywords
5266 "generic" "if" "in" "interface" "is" "limited" "loop" "mod" "not"
5282 '(2 (if (match-beginning 4)
5311 (defun ada-outline-level ()
5323 (defun ada-narrow-to-defun (&optional arg)
5334 (ada-previous-procedure)
5340 (ada-move-to-end)
5356 (defun ada-gen-treat-proc (match)
5359 for `ada-procedure-start-regexp'."
5377 ;; if function, skip over 'return' and result type.
5378 (if func-found
5391 (ada-indent-newline-indent)
5393 (ada-indent-newline-indent)
5394 (if func-found
5397 (ada-indent-newline-indent)))
5399 (ada-indent-newline-indent)
5400 (if func-found
5403 (ada-indent-newline-indent)
5405 (ada-indent-newline-indent)
5417 (if (looking-at "^[ \t]*task")
5421 (if (looking-at "[ \t]*;")
5423 (ada-move-to-end))
5426 (defun ada-make-body ()
5433 (ada-mode)
5435 (let (found ada-procedure-or-package-start-regexp)
5436 (if (setq found
5437 (ada-search-ignore-string-comment ada-package-start-regexp nil))
5443 (setq ada-procedure-or-package-start-regexp
5444 (concat ada-procedure-start-regexp
5446 ada-package-start-regexp))
5449 (ada-search-ignore-string-comment
5450 ada-procedure-or-package-start-regexp nil))
5453 (if (looking-at ada-package-start-regexp)
5456 (ada-gen-treat-proc found))))))
5459 (defun ada-make-subprogram-body ()
5462 (let* ((found (re-search-backward ada-procedure-start-regexp nil t))
5465 (if found
5468 (if (and (re-search-forward "(\\|;" nil t)
5471 (ada-search-ignore-string-comment ")" nil)
5472 (ada-search-ignore-string-comment ";" nil)))
5476 (setq body-file (ada-get-body-name))
5477 (if body-file
5486 ;; Move to the beginning of the elaboration part, if any
5491 (re-search-backward ada-procedure-start-regexp nil t)
5492 (ada-gen-treat-proc (cons (match-beginning 0) (match-end 0)))
5500 ;; Create the keymap once and for all. If we do that in ada-mode,
5503 (ada-create-keymap)
5504 (ada-create-menu)
5507 (ada-create-syntax-table)
5510 (ada-add-extensions ".ads" ".adb")
5512 (if (equal ada-which-compiler 'gnat)
5513 (ada-add-extensions ".ads.dg" ".adb.dg"))
5516 (ada-case-read-exceptions)
5519 (autoload 'ada-change-prj "ada-xref" nil t)
5520 (autoload 'ada-check-current "ada-xref" nil t)
5521 (autoload 'ada-compile-application "ada-xref" nil t)
5522 (autoload 'ada-compile-current "ada-xref" nil t)
5523 (autoload 'ada-complete-identifier "ada-xref" nil t)
5524 (autoload 'ada-find-file "ada-xref" nil t)
5525 (autoload 'ada-find-any-references "ada-xref" nil t)
5526 (autoload 'ada-find-src-file-in-dir "ada-xref" nil t)
5527 (autoload 'ada-find-local-references "ada-xref" nil t)
5528 (autoload 'ada-find-references "ada-xref" nil t)
5529 (autoload 'ada-gdb-application "ada-xref" nil t)
5530 (autoload 'ada-goto-declaration "ada-xref" nil t)
5531 (autoload 'ada-goto-declaration-other-frame "ada-xref" nil t)
5532 (autoload 'ada-goto-parent "ada-xref" nil t)
5533 (autoload 'ada-make-body-gnatstub "ada-xref" nil t)
5534 (autoload 'ada-point-and-xref "ada-xref" nil t)
5535 (autoload 'ada-reread-prj-file "ada-xref" nil t)
5536 (autoload 'ada-run-application "ada-xref" nil t)
5537 (autoload 'ada-set-default-project-file "ada-xref" nil nil)
5538 (autoload 'ada-set-default-project-file "ada-xref" nil t)
5539 (autoload 'ada-xref-goto-previous-reference "ada-xref" nil t)
5540 (autoload 'ada-set-main-compile-application "ada-xref" nil t)
5541 (autoload 'ada-show-current-main "ada-xref" nil t)
5543 (autoload 'ada-customize "ada-prj" nil t)
5544 (autoload 'ada-prj-edit "ada-prj" nil t)
5545 (autoload 'ada-prj-new "ada-prj" nil t)
5546 (autoload 'ada-prj-save "ada-prj" nil t)
5548 (autoload 'ada-array "ada-stmt" nil t)
5549 (autoload 'ada-case "ada-stmt" nil t)
5550 (autoload 'ada-declare-block "ada-stmt" nil t)
5551 (autoload 'ada-else "ada-stmt" nil t)
5552 (autoload 'ada-elsif "ada-stmt" nil t)
5553 (autoload 'ada-exception "ada-stmt" nil t)
5554 (autoload 'ada-exception-block "ada-stmt" nil t)
5555 (autoload 'ada-exit "ada-stmt" nil t)
5556 (autoload 'ada-for-loop "ada-stmt" nil t)
5557 (autoload 'ada-function-spec "ada-stmt" nil t)
5558 (autoload 'ada-header "ada-stmt" nil t)
5559 (autoload 'ada-if "ada-stmt" nil t)
5560 (autoload 'ada-loop "ada-stmt" nil t)
5561 (autoload 'ada-package-body "ada-stmt" nil t)
5562 (autoload 'ada-package-spec "ada-stmt" nil t)
5563 (autoload 'ada-private "ada-stmt" nil t)
5564 (autoload 'ada-procedure-spec "ada-stmt" nil t)
5565 (autoload 'ada-record "ada-stmt" nil t)
5566 (autoload 'ada-subprogram-body "ada-stmt" nil t)
5567 (autoload 'ada-subtype "ada-stmt" nil t)
5568 (autoload 'ada-tabsize "ada-stmt" nil t)
5569 (autoload 'ada-task-body "ada-stmt" nil t)
5570 (autoload 'ada-task-spec "ada-stmt" nil t)
5571 (autoload 'ada-type "ada-stmt" nil t)
5572 (autoload 'ada-use "ada-stmt" nil t)
5573 (autoload 'ada-when "ada-stmt" nil t)
5574 (autoload 'ada-while-loop "ada-stmt" nil t)
5575 (autoload 'ada-with "ada-stmt" nil t)
5578 (provide 'ada-mode)
5581 ;;; ada-mode.el ends here