1 ;;; ada-mode.el --- major-mode for editing Ada sources -*- lexical-binding:t -*-
3 ;; Copyright (C) 1994, 1995, 1997 - 2016 Free Software Foundation, Inc.
5 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
6 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
10 ;; package-requires: ((wisi "1.1.2") (cl-lib "0.4") (emacs "24.2"))
11 ;; url: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html
13 ;; (Gnu ELPA requires single digits between dots in versions)
15 ;; This file is part of GNU Emacs.
17 ;; GNU Emacs is free software: you can redistribute it and/or modify
18 ;; it under the terms of the GNU General Public License as published by
19 ;; the Free Software Foundation, either version 3 of the License, or
20 ;; (at your option) any later version.
22 ;; GNU Emacs is distributed in the hope that it will be useful,
23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 ;; GNU General Public License for more details.
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
32 ;; Emacs should enter Ada mode automatically when you load an Ada
33 ;; file, based on the file extension. The default extensions for Ada
34 ;; files are .ads, .adb; use ada-add-extensions to add other
37 ;; By default, ada-mode is configured to take full advantage of the
38 ;; GNAT compiler. If you are using another compiler, you
39 ;; should load that compiler's ada-* file first; that will define
40 ;; ada-compiler as a feature, so ada-gnat.el will not be loaded.
42 ;; See the user guide (info "ada-mode"), built from ada-mode.texi.
46 ;; In order to support multiple compilers, we use indirect function
47 ;; calls for all operations that depend on the compiler.
49 ;; We also support a cross reference tool (also called xref tool) that
50 ;; is different from the compiler. For example, you can use a local
51 ;; GNAT compiler to generate and access cross-reference information,
52 ;; while using a cross-compiler for compiling the final executable.
54 ;; Other functions are lumped with the choice of xref tool; mapping
55 ;; Ada names to file names, creating package bodies; any tool function
56 ;; that does not create executable code.
58 ;; The indentation engine and skeleton tools are also called
59 ;; indirectly, to allow parallel development of new versions of these
60 ;; tools (inspired by experience with ada-smie and ada-wisi).
62 ;; We also support using different compilers for different projects;
63 ;; `ada-compiler' can be set in Ada mode project files. Note that
64 ;; there is only one project active at a time; the most recently
65 ;; selected one. All Ada files are assumed to belong to this project
66 ;; (which is not correct, but works well in practice; the user is
67 ;; typically only concerned about files that belong to the current
70 ;; There are several styles of indirect calls:
72 ;; - scalar global variable set during load
74 ;; Appropriate when the choice of implementation is fixed at load
75 ;; time; it does not depend on the current Ada project. Used for
76 ;; indentation and skeleton functions.
78 ;; - scalar global variable set during project select
80 ;; Appropriate when the choice of implementation is determined by
81 ;; the choice of compiler or xref tool, which is per-project. The
82 ;; user sets the compiler choice in the project file, but not the
83 ;; lower-level redirect choice.
85 ;; For example, `ada-file-name-from-ada-name' depends on the naming
86 ;; convention used by the compiler. If the project file sets
87 ;; ada_compiler to 'gnat (either directly or by default),
88 ;; ada-gnat-select-prj sets `ada-file-name-from-ada-name' to
89 ;; `ada-gnat-file-name-from-ada-name'.
91 ;; - scalar buffer-local variable set during project select or file open
93 ;; Appropriate when choice of implementation is normally
94 ;; per-project, but can be per-buffer.
96 ;; For example, `ada-case-strict' will normally be set by the
97 ;; project, but some files may deviate from the project standard (if
98 ;; they are generated by -fdumpspec, for example). Those files set
99 ;; `ada-case-strict' in a file local variable comment.
101 ;; - scalar buffer-local variable set by ada-mode or ada-mode-hook
104 ;; Appropriate when the variable is a non-Ada mode variable, also
105 ;; used by other modes, and choice should not affect those modes.
107 ;; `indent-line-function', `comment-indent-function' use this style
109 ;; - alist global variable indexed by ada-compiler
111 ;; Appropriate when the choice of implementation is determined by
112 ;; the compiler, but the function is invoked during project parse,
113 ;; so we can't depend on a value set by project select.
115 ;; alist entries are set during load by the implementation elisp files.
117 ;; `ada-prj-default-compiler-alist' uses this style.
121 ;; The first Ada mode for GNU Emacs was written by V. Broman in
122 ;; 1985. He based his work on the already existing Modula-2 mode.
123 ;; This was distributed as ada.el in versions of Emacs prior to 19.29.
125 ;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of
126 ;; several files with support for dired commands and other nice
129 ;; The probably very first Ada mode (called electric-ada.el) was
130 ;; written by Steven D. Litvintchouk and Steven M. Rosen for the
131 ;; Gosling Emacs. L. Slater based his development on ada.el and
134 ;; A complete rewrite by Rolf Ebert <ebert@inf.enst.fr> and Markus
135 ;; Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de> was done at
136 ;; some point. Some ideas from the Ada mode mailing list have been
137 ;; added. Some of the functionality of L. Slater's mode has not (yet)
138 ;; been recoded in this new mode.
140 ;; A complete rewrite for Emacs-20 / GNAT-3.11 was done by Emmanuel
141 ;; Briot <briot@gnat.com> at Ada Core Technologies.
143 ;; A complete rewrite, to restructure the code more orthogonally, and
144 ;; to use wisi for the indentation engine, was done in 2012 - 2013 by
145 ;; Stephen Leake <stephen_leake@stephe-leake.org>.
149 ;; Many thanks to John McCabe <john@assen.demon.co.uk> for sending so
150 ;; many patches included in this package.
151 ;; Christian Egli <Christian.Egli@hcsd.hac.com>:
152 ;; ada-imenu-generic-expression
153 ;; Many thanks also to the following persons that have contributed
155 ;; Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular,
156 ;; woodruff@stc.llnl.gov (John Woodruff)
157 ;; jj@ddci.dk (Jesper Joergensen)
158 ;; gse@ocsystems.com (Scott Evans)
159 ;; comar@gnat.com (Cyrille Comar)
160 ;; robin-reply@reagans.org
161 ;; and others for their valuable hints.
168 (defun ada-mode-version ()
169 "Return Ada mode version."
171 (let ((version-string "5.1.9"))
176 (if (called-interactively-p 'interactive)
177 (message version-string)
182 (defvar ada-mode-hook nil
183 "List of functions to call when Ada mode is invoked.
184 This hook is executed after `ada-mode' is fully loaded, but
185 before file local variables are processed.")
188 "Major mode for editing Ada source code in Emacs."
191 (defcustom ada-auto-case t
193 "Buffer-local value that may override project variable `auto_case'.
194 Global value is default for project variable `auto_case'.
195 Non-nil means automatically change case of preceding word while typing.
196 Casing of Ada keywords is done according to `ada-case-keyword',
197 identifiers are Mixed_Case."
200 (make-variable-buffer-local 'ada-auto-case)
202 (defcustom ada-case-exception-file nil
203 "Default list of special casing exceptions dictionaries for identifiers.
204 Override with 'casing' project variable.
206 New exceptions may be added interactively via `ada-case-create-exception'.
207 If an exception is defined in multiple files, the first occurence is used.
209 The file format is one word per line, that gives the casing to be
210 used for that word in Ada source code. If the line starts with
211 the character *, then the exception will be used for partial
212 words that either start at the beginning of a word or after a _
213 character, and end either at the end of the word or at a _
214 character. Characters after the first word are ignored, and not
215 preserved when the list is written back to the file."
216 :type '(repeat (file))
219 (defcustom ada-case-keyword 'lower-case
220 "Buffer-local value that may override project variable `case_keyword'.
221 Global value is default for project variable `case_keyword'.
222 Function to call to adjust the case of Ada keywords."
223 :type '(choice (const lower-case)
225 ;; We'd like to specify that the value must be a function that takes
226 ;; one arg, but custom doesn't support that. ':safe' is supposed
227 ;; to be used to prevent user-provided functions from compromising
228 ;; security, so ":safe #'functionp" is not appropriate. So we
229 ;; use a symbol, and a cl-ecase in ada-case-keyword.
230 :safe (lambda (val) (memq val '(lower-case upper-case)))
232 (make-variable-buffer-local 'ada-case-keyword)
234 (defcustom ada-case-identifier 'mixed-case
235 "Buffer-local value that may override project variable `case_keyword'.
236 Global value is default for project variable `case_keyword'.
237 Function to call to adjust the case of Ada keywords.
238 Called with three args;
239 start - buffer pos of start of identifier
240 end - end of identifier
241 force-case - if t, treat `ada-case-strict' as t"
242 :type '(choice (const mixed-case)
245 ;; see comment on :safe at ada-case-keyword
246 :safe (lambda (val) (memq val '(mixed-case lower-case upper-case)))
248 ;; we'd like to check that there are 3 args, since the previous
249 ;; release required 2 here. But there doesn't seem to be a way to
250 ;; access the arg count, which is only available for byte-compiled
252 (make-variable-buffer-local 'ada-case-identifier)
254 (defcustom ada-case-strict t
255 "Buffer-local value that may override project variable `case_strict'.
256 Global value is default for project variable `case_strict'.
257 If non-nil, force Mixed_Case for identifiers.
258 Otherwise, allow UPPERCASE for identifiers."
261 (make-variable-buffer-local 'ada-case-strict)
263 (defcustom ada-language-version 'ada2012
264 "Ada language version; one of `ada83', `ada95', `ada2005', `ada2012'.
265 Only affects the keywords to highlight, not which version the
266 indentation parser accepts."
267 :type '(choice (const ada83)
272 (make-variable-buffer-local 'ada-language-version)
274 (defcustom ada-fill-comment-prefix "-- "
275 "Comment fill prefix."
277 (make-variable-buffer-local 'ada-language-version)
279 (defcustom ada-fill-comment-postfix " --"
280 "Comment fill postfix."
282 (make-variable-buffer-local 'ada-language-version)
284 (defcustom ada-prj-file-extensions '("adp" "prj")
285 "List of Emacs Ada mode project file extensions.
286 Used when searching for a project file.
287 Any file with one of these extensions will be parsed by `ada-prj-parse-file-1'."
290 (defcustom ada-prj-file-ext-extra nil
291 "List of secondary project file extensions.
292 Used when searching for a project file that can be a primary or
293 secondary project file (referenced from a primary). The user
294 must provide a parser for a file with one of these extensions."
297 (defcustom ada-prj-parse-hook nil
298 "Hook run at start of `ada-parse-prj-file'.
299 Useful for setting `ada-xref-tool' and similar vars."
303 ;;;;; end of user variables
305 (defconst ada-symbol-end
306 ;; we can't just add \> here; that might match _ in a user modified ada-mode-syntax-table
308 "Regexp to add to symbol name in `ada-which-function'.")
310 (defvar ada-compiler nil
311 "Default Ada compiler; can be overridden in project files.
312 Values defined by compiler packages.")
314 (defvar ada-xref-tool nil
315 "Default Ada cross reference tool; can be overridden in project files.
316 Values defined by cross reference packages.")
318 ;;;; keymap and menus
320 (defvar ada-ret-binding 'ada-indent-newline-indent)
321 (defvar ada-lfd-binding 'newline-and-indent)
323 (defun ada-case-activate-keys (map)
324 "Modify the key bindings for all the keys that should adjust casing."
325 ;; we could just put these in the keymap below, but this is easier.
331 'ada-case-adjust-interactive)))
332 '( ?_ ?% ?& ?* ?( ?) ?- ?= ?+
333 ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))
337 (let ((map (make-sparse-keymap)))
338 ;; C-c <letter> are reserved for users
340 ;; global-map has C-x ` 'next-error
341 (define-key map [return] 'ada-case-adjust-interactive)
342 (define-key map "\C-c`" 'ada-show-secondary-error)
343 (define-key map "\C-c;" (lambda () (error "use M-; instead"))) ; comment-dwim
344 (define-key map "\C-c<" 'ada-goto-declaration-start)
345 (define-key map "\C-c>" 'ada-goto-declaration-end)
346 (define-key map "\C-c\M-`" 'ada-fix-compiler-error)
347 (define-key map "\C-c\C-a" 'ada-align)
348 (define-key map "\C-c\C-b" 'ada-make-subprogram-body)
349 (define-key map "\C-c\C-c" 'ada-build-make)
350 (define-key map "\C-c\C-d" 'ada-goto-declaration)
351 (define-key map "\C-c\M-d" 'ada-show-declaration-parents)
352 (define-key map "\C-c\C-e" 'ada-expand)
353 (define-key map "\C-c\C-f" 'ada-show-parse-error)
354 (define-key map "\C-c\C-i" 'ada-indent-statement)
355 (define-key map "\C-c\C-m" 'ada-build-set-make)
356 (define-key map "\C-c\C-n" 'ada-next-statement-keyword)
357 (define-key map "\C-c\M-n" 'ada-next-placeholder)
358 (define-key map "\C-c\C-o" 'ada-find-other-file)
359 (define-key map "\C-c\M-o" 'ada-find-other-file-noset)
360 (define-key map "\C-c\C-p" 'ada-prev-statement-keyword)
361 (define-key map "\C-c\M-p" 'ada-prev-placeholder)
362 (define-key map "\C-c\C-q" 'ada-xref-refresh)
363 (define-key map "\C-c\C-r" 'ada-show-references)
364 (define-key map "\C-c\M-r" 'ada-build-run)
365 (define-key map "\C-c\C-s" 'ada-goto-previous-pos)
366 (define-key map "\C-c\C-v" 'ada-build-check)
367 (define-key map "\C-c\C-w" 'ada-case-adjust-at-point)
368 (define-key map "\C-c\C-x" 'ada-show-overriding)
369 (define-key map "\C-c\M-x" 'ada-show-overridden)
370 (define-key map "\C-c\C-y" 'ada-case-create-exception)
371 (define-key map "\C-c\C-\M-y" 'ada-case-create-partial-exception)
372 (define-key map [C-down-mouse-3] 'ada-popup-menu)
374 (ada-case-activate-keys map)
377 ) "Local keymap used for Ada mode.")
379 (defvar ada-mode-menu (make-sparse-keymap "Ada"))
380 (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode"
383 ["Ada Mode" (info "ada-mode") t]
384 ["Ada Reference Manual" (info "arm2012") t]
385 ["Key bindings" describe-bindings t]
387 ["Customize" (customize-group 'ada) t]
389 ["Find and select project ..." ada-build-prompt-select-prj-file t]
390 ["Select project ..." ada-prj-select t]
391 ["Show project" ada-prj-show t]
392 ["Show project file search path" ada-prj-show-prj-path t]
393 ["Show source file search path" ada-prj-show-src-path t]
396 ["Next compilation error" next-error t]
397 ["Show secondary error" ada-show-secondary-error t]
398 ["Fix compilation error" ada-fix-compiler-error t]
399 ["Show last parse error" ada-show-parse-error t]
400 ["Check syntax" ada-build-check t]
401 ["Show main" ada-build-show-main t]
402 ["Build" ada-build-make t]
403 ["Set main and Build" ada-build-set-make t]
404 ["Run" ada-build-run t]
407 ["Other file" ada-find-other-file t]
408 ["Other file don't find decl" ada-find-other-file-noset t]
409 ["Find file in project" ada-find-file t]
410 ["Goto declaration/body" ada-goto-declaration t]
411 ["Goto next statement keyword" ada-next-statement-keyword t]
412 ["Goto declaration start" ada-goto-declaration-start t]
413 ["Goto declaration end" ada-goto-declaration-end t]
414 ["Show parent declarations" ada-show-declaration-parents t]
415 ["Show references" ada-show-references t]
416 ["Show overriding" ada-show-overriding t]
417 ["Show overridden" ada-show-overridden t]
418 ["Goto prev position" ada-goto-previous-pos t]
419 ["Next placeholder" ada-next-placeholder t]
420 ["Previous placeholder" ada-prev-placeholder t]
423 ["Expand skeleton" ada-expand t]
424 ["Indent line or selection" indent-for-tab-command t]
425 ["Indent current statement" ada-indent-statement t]
426 ["Indent lines in file" (indent-region (point-min) (point-max)) t]
427 ["Align" ada-align t]
428 ["Comment/uncomment selection" comment-dwim t]
429 ["Fill comment paragraph" ada-fill-comment-paragraph t]
430 ["Fill comment paragraph justify" (ada-fill-comment-paragraph 'full) t]
431 ["Fill comment paragraph postfix" (ada-fill-comment-paragraph 'full t) t]
432 ["Make body for subprogram" ada-make-subprogram-body t]
435 ["Create full exception" ada-case-create-exception t]
436 ["Create partial exception" ada-case-create-partial-exception t]
437 ["Adjust case at point" ada-case-adjust-at-point t]
438 ["Adjust case region" ada-case-adjust-region t]
439 ["Adjust case buffer" ada-case-adjust-buffer t]
440 ["Show casing files list" ada-case-show-files t]
443 ["Show last parse error" ada-show-parse-error t]
444 ["Show xref tool buffer" ada-show-xref-tool-buffer t]
445 ["Refresh cross reference cache" ada-xref-refresh t]
446 ["Reset parser" ada-reset-parser t]
449 ;; This doesn't need to be buffer-local because there can be only one
450 ;; popup menu at a time.
451 (defvar ada-context-menu-on-identifier nil)
453 (easy-menu-define ada-context-menu nil
454 "Context menu keymap for Ada mode"
456 ["Make body for subprogram" ada-make-subprogram-body t]
457 ["Goto declaration/body" ada-goto-declaration :included ada-context-menu-on-identifier]
458 ["Show parent declarations" ada-show-declaration-parents :included ada-context-menu-on-identifier]
459 ["Show references" ada-show-references :included ada-context-menu-on-identifier]
460 ["Show overriding" ada-show-overriding :included ada-context-menu-on-identifier]
461 ["Show overridden" ada-show-overridden :included ada-context-menu-on-identifier]
462 ["Expand skeleton" ada-expand t]
463 ["Create full case exception" ada-case-create-exception t]
464 ["Create partial case exception" ada-case-create-partial-exception t]
467 ["Align" ada-align t]
468 ["Adjust case at point" ada-case-adjust-at-point (not (use-region-p))]
469 ["Adjust case region" ada-case-adjust-region (use-region-p)]
470 ["Indent current statement" ada-indent-statement t]
471 ["Goto next statement keyword" ada-next-statement-keyword t]
472 ["Goto prev statement keyword" ada-next-statement-keyword t]
473 ["Other File" ada-find-other-file t]))
475 (defun ada-popup-menu ()
476 "Pops up `ada-context-menu'.
477 When a function from the menu is called, point is where the mouse
481 (mouse-set-point last-input-event)
482 (popup-menu ada-context-menu)
485 (defun ada-indent-newline-indent ()
486 "insert a newline, indent the old and new lines."
488 ;; point may be in the middle of a word, so insert newline first,
489 ;; then go back and indent.
492 (funcall indent-line-function)
494 (funcall indent-line-function))
496 (defvar ada-indent-statement nil
497 ;; indentation function
498 "Function to indent the statement/declaration point is in or after.
499 Function is called with no arguments.")
501 (defun ada-indent-statement ()
502 "Indent current statement."
504 (when ada-indent-statement
505 (funcall ada-indent-statement)))
507 (defvar ada-expand nil
509 "Function to call to expand tokens (ie insert skeletons).")
512 "Expand previous word into a statement skeleton."
515 (funcall ada-expand)))
517 (defvar ada-next-placeholder nil
519 "Function to call to goto next placeholder.")
521 (defun ada-next-placeholder ()
522 "Goto next placeholder.
523 Placeholders are defined by the skeleton backend."
525 (when ada-next-placeholder
526 (funcall ada-next-placeholder)))
528 (defvar ada-prev-placeholder nil
530 "Function to call to goto previous placeholder.")
532 (defun ada-prev-placeholder ()
533 "Goto previous placeholder.
534 Placeholders are defined by the skeleton backend."
536 (when ada-prev-placeholder
537 (funcall ada-prev-placeholder)))
541 (defvar ada-mode-abbrev-table nil
542 "Local abbrev table for Ada mode.")
544 (defvar ada-align-rules
545 '((ada-declaration-assign
546 (regexp . "[^:]\\(\\s-*\\)\\(:\\)[^:]")
547 (valid . (lambda () (ada-align-valid)))
549 (modes . '(ada-mode)))
551 (regexp . "[^=]\\(\\s-*\\)\\(=>\\)")
552 (valid . (lambda () (ada-align-valid)))
553 (modes . '(ada-mode)))
555 (regexp . "\\(\\s-*\\)--")
556 (valid . (lambda () (ada-align-valid)))
557 (modes . '(ada-mode)))
559 (regexp . "\\(\\s-*\\)\\<\\(use\\s-\\)")
560 (valid . (lambda () (ada-align-valid)))
561 (modes . '(ada-mode)))
563 (regexp . "\\(\\s-+\\)\\(at\\)\\>")
564 (valid . (lambda () (ada-align-valid)))
565 (modes . '(ada-mode))))
566 "Rules to use to align different lines.")
568 (defun ada-align-valid ()
569 "See use in `ada-align-rules'."
571 ;; we don't put "when (match-beginning n)" here; missing a match
572 ;; is a bug in the regexp.
573 (goto-char (or (match-beginning 2) (match-beginning 1)))
574 (not (ada-in-string-or-comment-p))))
576 (defconst ada-align-region-separate
596 "\\)\\>[^_]\\)")) ;; in case "_" has punctuation syntax
597 "See the variable `align-region-separate' for more information.")
600 "If region is active, apply 'align'. If not, attempt to align
605 (align (region-beginning) (region-end))
608 ;; else see if we are in a construct we know how to align
609 (let ((parse-result (syntax-ppss)))
611 ((ada-in-paramlist-p parse-result)
612 (ada-format-paramlist))
615 (ada-in-paren-p parse-result)
616 (ada-in-case-expression))
618 (let ((begin (nth 1 parse-result))
619 (end (scan-lists (point) 1 1)))
620 (align begin end 'entire)))
626 (defvar ada-in-paramlist-p nil
627 ;; Supplied by indentation engine parser
628 "Function to return t if point is inside the parameter-list of a subprogram declaration.
629 Function is called with one optional argument; syntax-ppss result.")
631 (defun ada-in-paramlist-p (&optional parse-result)
632 "Return t if point is inside the parameter-list of a subprogram declaration."
633 (when ada-in-paramlist-p
634 (funcall ada-in-paramlist-p parse-result)))
636 (defun ada-format-paramlist ()
637 "Reformat the parameter list point is in."
639 (ada-goto-open-paren)
640 (funcall indent-line-function); so new list is indented properly
642 (let* ((begin (point))
643 (delend (progn (forward-sexp) (point))); just after matching closing paren
644 (end (progn (backward-char) (forward-comment (- (point))) (point))); end of last parameter-declaration
645 (multi-line (> end (save-excursion (goto-char begin) (line-end-position))))
646 (paramlist (ada-scan-paramlist (1+ begin) end)))
649 ;; delete the original parameter-list
650 (delete-region begin delend)
652 ;; insert the new parameter-list
655 (ada-insert-paramlist-multi-line paramlist)
656 (ada-insert-paramlist-single-line paramlist)))
659 (defvar ada-scan-paramlist nil
660 ;; Supplied by indentation engine parser
661 "Function to scan a region, return a list of subprogram parameter declarations (in inverse declaration order).
662 Function is called with two args BEGIN END (the region).
663 Each parameter declaration is represented by a list
664 '((identifier ...) aliased-p in-p out-p not-null-p access-p constant-p protected-p type default)."
665 ;; Summary of Ada syntax for a parameter specification:
666 ;; ... : [aliased] {[in] | out | in out | [null_exclusion] access [constant | protected]} ...
669 (defun ada-scan-paramlist (begin end)
670 (when ada-scan-paramlist
671 (funcall ada-scan-paramlist begin end)))
673 (defun ada-insert-paramlist-multi-line (paramlist)
674 "Insert a multi-line formatted PARAMLIST in the buffer."
675 (let ((i (length paramlist))
693 ;; accumulate info across all params
694 (while (not (zerop i))
696 (setq param (nth i paramlist))
701 (mapc (lambda (ident)
703 (setq len (+ len (length ident))))
705 (setq len (+ len (* 2 (1- j)))); space for commas
706 (setq ident-len (max ident-len len))
708 ;; we align the defaults after the types that have defaults, not after all types.
709 ;; "constant", "protected" are treated as part of 'type'
713 (+ (length (nth 8 param))
714 (if (nth 6 param) 10 0); "constant "
715 (if (nth 7 param) 10 0); protected
718 (setq aliased-p (or aliased-p (nth 1 param)))
719 (setq in-p (or in-p (nth 2 param)))
720 (setq out-p (or out-p (nth 3 param)))
721 (setq not-null-p (or not-null-p (nth 4 param)))
722 (setq access-p (or access-p (nth 5 param)))
725 (let ((space-before-p (save-excursion (skip-chars-backward " \t") (not (bolp))))
726 (space-after-p (save-excursion (skip-chars-forward " \t") (not (or (= (char-after) ?\;) (eolp))))))
728 ;; paramlist starts on same line as subprogram identifier; clean
729 ;; up whitespace. Allow for code on same line as closing paren
730 ;; ('return' or ';').
731 (skip-syntax-forward " ")
732 (delete-char (- (skip-syntax-backward " ")))
743 (setq ident-col (current-column))
744 (setq colon-col (+ ident-col ident-len 1))
746 (+ colon-col (if aliased-p 10 2))); ": aliased ..."
747 (setq out-col (+ in-col (if in-p 3 0))); ": [aliased] in "
751 ;; 'not null' without access is part of the type
752 ((and not-null-p access-p) 16); ": [aliased] not null access "
753 (access-p 7); ": [aliased] access "
754 ((and in-p out-p) 7); ": [aliased] in out "
755 (in-p 3); ": [aliased] in "
756 (out-p 4); ": [aliased] out "
757 (t 0)))); ": [aliased] "
759 (setq default-col (+ 1 type-col type-len))
761 (setq i (length paramlist))
762 (while (not (zerop i))
764 (setq param (nth i paramlist))
766 ;; insert identifiers, space and colon
767 (mapc (lambda (ident)
771 (delete-char -2); last ", "
772 (indent-to colon-col)
786 (when (and (nth 4 param) ;; not null
787 (nth 5 param)) ;; access
788 (insert "not null access"))
790 (when (and (not (nth 4 param)) ;; not null
791 (nth 5 param)) ;; access
796 (when (and (nth 4 param) ;; not null
797 (not (nth 5 param))) ;; access
798 (insert "not null "))
801 (insert "constant "))
804 (insert "protected "))
806 (insert (nth 8 param)); type
808 (when (nth 9 param); default
809 (indent-to default-col)
811 (insert (nth 9 param)))
817 (indent-to ident-col))
821 (defun ada-insert-paramlist-single-line (paramlist)
822 "Insert a single-line formatted PARAMLIST in the buffer."
823 ;; point is properly indented
824 (let ((i (length paramlist))
827 ;; clean up whitespace
828 (delete-char (- (skip-syntax-forward " ")))
831 (setq i (length paramlist))
832 (while (not (zerop i))
834 (setq param (nth i paramlist))
836 ;; insert identifiers, space and colon
837 (mapc (lambda (ident)
841 (delete-char -2); last ", "
855 (insert "not null "))
861 (insert "constant "))
863 (insert "protected "))
864 (insert (nth 8 param)); type
866 (when (nth 9 param); default
868 (insert (nth 9 param)))
871 (if (= (char-after) ?\;)
878 (defvar ada-reset-parser nil
879 ;; Supplied by indentation engine parser
880 "Function to reset parser, to clear confused state."
883 (defun ada-reset-parser ()
885 (when ada-reset-parser
886 (funcall ada-reset-parser)))
888 (defvar ada-show-parse-error nil
889 ;; Supplied by indentation engine parser
890 "Function to show last error reported by indentation parser."
893 (defun ada-show-parse-error ()
895 (when ada-show-parse-error
896 (funcall ada-show-parse-error)))
900 (defvar ada-case-full-exceptions '()
901 "Alist of words (entities) that have special casing, built from
902 project file casing file list full word exceptions. Indexed by
903 properly cased word; value is t.")
905 (defvar ada-case-partial-exceptions '()
906 "Alist of partial words that have special casing, built from
907 project casing files list partial word exceptions. Indexed by
908 properly cased word; value is t.")
910 (defun ada-case-show-files ()
911 "Show current casing files list."
913 (if (ada-prj-get 'casing)
915 (pop-to-buffer (get-buffer-create "*casing files*"))
917 (dolist (file (ada-prj-get 'casing))
918 (insert (format "%s\n" file))))
919 (message "no casing files")
922 (defun ada-case-save-exceptions (full-exceptions partial-exceptions file-name)
923 "Save FULL-EXCEPTIONS, PARTIAL-EXCEPTIONS to the file FILE-NAME."
924 (with-temp-file (expand-file-name file-name)
925 (mapc (lambda (x) (insert (car x) "\n"))
926 (sort (copy-sequence full-exceptions)
927 (lambda(a b) (string< (car a) (car b)))))
928 (mapc (lambda (x) (insert "*" (car x) "\n"))
929 (sort (copy-sequence partial-exceptions)
930 (lambda(a b) (string< (car a) (car b)))))
933 (defun ada-case-read-exceptions (file-name)
934 "Read the content of the casing exception file FILE-NAME.
935 Return (cons full-exceptions partial-exceptions)."
936 (setq file-name (expand-file-name (substitute-in-file-name file-name)))
937 (if (file-readable-p file-name)
938 (let (full-exceptions partial-exceptions word)
940 (insert-file-contents file-name)
943 (setq word (buffer-substring-no-properties
944 (point) (save-excursion (skip-syntax-forward "w_") (point))))
946 (if (char-equal (string-to-char word) ?*)
947 ;; partial word exception
949 (setq word (substring word 1))
950 (unless (assoc-string word partial-exceptions t)
951 (push (cons word t) partial-exceptions)))
953 ;; full word exception
954 (unless (assoc-string word full-exceptions t)
955 (push (cons word t) full-exceptions)))
959 (cons full-exceptions partial-exceptions))
961 ;; else file not readable; might be a new project with no
962 ;; exceptions yet, so just return empty pair
963 (message "'%s' is not a readable file." file-name)
967 (defun ada-case-merge-exceptions (result new)
968 "Merge NEW exeptions into RESULT.
969 An item in both lists has the RESULT value."
971 (unless (assoc-string (car item) result t)
975 (defun ada-case-merge-all-exceptions (exceptions)
976 "Merge EXCEPTIONS into `ada-case-full-exceptions', `ada-case-partial-exceptions'."
977 (setq ada-case-full-exceptions (ada-case-merge-exceptions ada-case-full-exceptions (car exceptions)))
978 (setq ada-case-partial-exceptions (ada-case-merge-exceptions ada-case-partial-exceptions (cdr exceptions))))
980 (defun ada-case-read-all-exceptions ()
981 "Read case exceptions from all files in project casing files,
982 replacing current values of `ada-case-full-exceptions', `ada-case-partial-exceptions'."
984 (setq ada-case-full-exceptions '()
985 ada-case-partial-exceptions '())
987 (when (ada-prj-get 'casing)
988 (dolist (file (ada-prj-get 'casing))
989 (ada-case-merge-all-exceptions (ada-case-read-exceptions file))))
992 (defun ada-case-add-exception (word exceptions)
993 "Add case exception WORD to EXCEPTIONS, replacing current entry, if any."
994 (if (assoc-string word exceptions t)
995 (setcar (assoc-string word exceptions t) word)
996 (push (cons word t) exceptions))
999 (defun ada-case-create-exception (&optional word file-name partial)
1000 "Define WORD as an exception for the casing system, save it in FILE-NAME.
1001 If PARTIAL is non-nil, create a partial word exception. WORD
1002 defaults to the active region, or the word at point. User is
1003 prompted to choose a file from project variable casing if it is a
1006 (let ((casing (ada-prj-get 'casing)))
1009 (file-name file-name)
1011 ((< 1 (length casing))
1012 (completing-read "case exception file: " casing
1015 nil ;; initial-input
1017 (car casing) ;; default
1019 ((= 1 (length casing))
1023 (if ada-prj-current-file
1024 (error "No exception file specified; set `casing' in project file.")
1025 ;; IMPROVEME: could prompt, but then need to write to actual project file
1028 ;; "No exception file specified; adding to project. file: ")))
1029 ;; (message "remember to add %s to project file" temp)
1030 ;; (ada-prj-put 'casing temp)
1032 (error "No exception file specified, and no project active. See variable `ada-case-exception-file'.")))
1038 (setq word (buffer-substring-no-properties (region-beginning) (region-end)))
1041 (let ((syntax (if partial "w" "w_")))
1042 (skip-syntax-backward syntax)
1044 (buffer-substring-no-properties
1046 (progn (skip-syntax-forward syntax) (point))
1049 (let* ((exceptions (ada-case-read-exceptions file-name))
1050 (full-exceptions (car exceptions))
1051 (partial-exceptions (cdr exceptions)))
1055 (setq ada-case-full-exceptions (ada-case-add-exception word ada-case-full-exceptions))
1056 (setq full-exceptions (ada-case-add-exception word full-exceptions)))
1059 (setq ada-case-partial-exceptions (ada-case-add-exception word ada-case-partial-exceptions))
1060 (setq partial-exceptions (ada-case-add-exception word partial-exceptions)))
1062 (ada-case-save-exceptions full-exceptions partial-exceptions file-name)
1063 (message "created %s case exception '%s' in file '%s'"
1064 (if partial "partial" "full")
1069 (defun ada-case-create-partial-exception ()
1070 "Define active region or word at point as a partial word exception.
1071 User is prompted to choose a file from project variable casing if it is a list."
1073 (ada-case-create-exception nil nil t))
1075 (defun ada-in-based-numeric-literal-p ()
1076 "Return t if point is after a prefix of a based numeric literal."
1077 (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)" (line-beginning-position)))
1079 (defvar ada-keywords nil
1080 "List of Ada keywords for current `ada-language-version'.")
1082 (defun ada-after-keyword-p ()
1083 "Return non-nil if point is after an element of `ada-keywords'."
1084 (let ((word (buffer-substring-no-properties
1085 (save-excursion (skip-syntax-backward "w_") (point))
1087 (member (downcase word) ada-keywords)))
1089 (defun ada-case-keyword (beg end)
1090 (cl-ecase ada-case-keyword
1091 (lower-case (downcase-region beg end))
1092 (upper-case (upcase-region beg end))
1095 (defun ada-case-identifier (start end force-case-strict)
1096 (cl-ecase ada-case-identifier
1097 (mixed-case (ada-mixed-case start end force-case-strict))
1098 (lower-case (downcase-region start end))
1099 (upper-case (upcase-region start end))
1102 (defun ada-mixed-case (start end force-case-strict)
1103 "Adjust case of region START END to Mixed_Case."
1106 (if (or force-case-strict ada-case-strict)
1107 (downcase-region start end))
1112 (save-excursion (when (search-forward "_" end t) (point-marker)))
1113 (copy-marker (1+ end))))
1115 ;; upcase first char
1116 (upcase-region (point) (1+ (point)))
1120 (setq start (point))
1124 (defun ada-case-adjust-identifier (&optional force-case)
1125 "Adjust case of the previous word as an identifier.
1126 Uses `ada-case-identifier', with exceptions defined in
1127 `ada-case-full-exceptions', `ada-case-partial-exceptions'."
1130 (let ((end (point-marker))
1131 (start (progn (skip-syntax-backward "w_") (point)))
1136 (if (setq match (assoc-string (buffer-substring-no-properties start end) ada-case-full-exceptions t))
1137 ;; full word exception
1139 ;; 'save-excursion' puts a marker at 'end'; if we do
1140 ;; 'delete-region' first, it moves that marker to 'start',
1141 ;; then 'insert' inserts replacement text after the
1142 ;; marker, defeating 'save-excursion'. So we do 'insert' first.
1143 (insert (car match))
1144 (delete-region (point) end))
1146 ;; else apply ada-case-identifier
1147 (ada-case-identifier start end force-case)
1149 ;; apply partial-exceptions
1154 (save-excursion (when (search-forward "_" end t) (point-marker)))
1155 (copy-marker (1+ end))))
1157 (when (setq match (assoc-string (buffer-substring-no-properties start (1- next))
1158 ada-case-partial-exceptions t))
1159 ;; see comment above at 'full word exception' for why
1160 ;; we do insert first.
1161 (insert (car match))
1162 (delete-region (point) (1- next)))
1166 (setq start (point))
1170 (defun ada-case-adjust-keyword ()
1171 "Adjust the case of the previous word as a keyword.
1172 'word' here is allowed to be underscore-separated (GPR external_as_list)."
1174 (let ((end (point-marker))
1175 (start (progn (skip-syntax-backward "w_") (point))))
1176 (ada-case-keyword start end)
1179 (defun ada-case-adjust (&optional typed-char in-comment)
1180 "Adjust the case of the word before point.
1181 When invoked interactively, TYPED-CHAR must be
1182 `last-command-event', and it must not have been inserted yet.
1183 If IN-COMMENT is non-nil, adjust case of words in comments and strings as code,
1184 and treat `ada-case-strict' as t in code.."
1186 (when (save-excursion
1187 (forward-char -1); back to last character in word
1189 (eq (char-syntax (char-after)) ?w); it can be capitalized
1191 (not (and (eq typed-char ?')
1192 (eq (char-before (point)) ?'))); character literal
1195 (not (ada-in-string-or-comment-p)))
1196 ;; we sometimes want to capitialize an Ada identifier
1197 ;; referenced in a comment, via
1198 ;; ada-case-adjust-at-point.
1200 (not (ada-in-based-numeric-literal-p))
1201 ;; don't adjust case on hex digits
1204 ;; The indentation engine may trigger a reparse on
1205 ;; non-whitespace changes, but we know we don't need to reparse
1206 ;; for this change (assuming the user has not abused case
1208 (let ((inhibit-modification-hooks t))
1210 ;; Some attributes are also keywords, but captialized as
1211 ;; attributes. So check for attribute first.
1215 (skip-syntax-backward "w_")
1216 (eq (char-before) ?')))
1217 (ada-case-adjust-identifier in-comment))
1221 (not (eq typed-char ?_))
1222 (ada-after-keyword-p))
1223 (ada-case-adjust-keyword))
1225 (t (ada-case-adjust-identifier in-comment))
1229 (defun ada-case-adjust-at-point (&optional in-comment)
1230 "Adjust case of word at point, move to end of word.
1231 With prefix arg, adjust case as code even if in comment;
1232 otherwise, capitalize words in comments."
1235 ((and (not in-comment)
1236 (ada-in-string-or-comment-p))
1237 (skip-syntax-backward "w_")
1238 (capitalize-word 1))
1243 ;; we use '(syntax-after (point))' here, not '(char-syntax
1244 ;; (char-after))', because the latter does not respect
1245 ;; ada-syntax-propertize.
1246 (memq (syntax-class (syntax-after (point))) '(2 3)))
1247 (skip-syntax-forward "w_"))
1248 (ada-case-adjust nil in-comment))
1251 (defun ada-case-adjust-region (begin end)
1252 "Adjust case of all words in region BEGIN END."
1254 (narrow-to-region begin end)
1258 (forward-comment (point-max))
1259 (skip-syntax-forward "^w_")
1260 (skip-syntax-forward "w_")
1264 (defun ada-case-adjust-buffer ()
1265 "Adjust case of current buffer."
1267 (ada-case-adjust-region (point-min) (point-max)))
1269 (defun ada-case-adjust-interactive (arg)
1270 "If `ada-auto-case' is non-nil, adjust the case of the previous word, and process the character just typed.
1271 To be bound to keys that should cause auto-casing.
1272 ARG is the prefix the user entered with \\[universal-argument]."
1275 ;; character typed has not been inserted yet
1276 (let ((lastk last-command-event))
1281 (ada-case-adjust lastk))
1282 (funcall ada-lfd-binding))
1284 ((memq lastk '(?\r return))
1286 (ada-case-adjust lastk))
1287 (funcall ada-ret-binding))
1291 (ada-case-adjust lastk))
1292 (self-insert-command (prefix-numeric-value arg)))
1297 ;; An Emacs Ada mode project file can specify several things:
1299 ;; - a compiler-specific project file
1301 ;; - compiler-specific environment variables
1303 ;; - other compiler-specific things (see the compiler support elisp code)
1305 ;; - a list of source directories (in addition to those specified in the compiler project file)
1307 ;; - a casing exception file
1309 ;; All of the data used by Emacs Ada mode functions specified in a
1310 ;; project file is stored in a property list. The property list is
1311 ;; stored in an alist indexed by the project file name, so multiple
1312 ;; project files can be selected without re-parsing them (some
1313 ;; compiler project files can take a long time to parse).
1315 (defvar ada-prj-alist nil
1316 "Alist holding currently parsed Emacs Ada project files. Indexed by absolute project file name.")
1318 (defvar ada-prj-current-file nil
1319 "Current Emacs Ada project file.")
1321 (defvar ada-prj-current-project nil
1322 "Current Emacs Ada mode project; a plist.")
1324 (defun ada-prj-get (prop &optional plist)
1325 "Return value of PROP in PLIST.
1326 Optional PLIST defaults to `ada-prj-current-project'."
1327 (let ((prj (or plist ada-prj-current-project)))
1329 (plist-get prj prop)
1331 ;; no project, just use default vars
1332 ;; must match code in ada-prj-default, except for src_dir.
1334 (ada_compiler ada-compiler)
1335 (auto_case ada-auto-case)
1336 (case_keyword ada-case-keyword)
1337 (case_identifier ada-case-identifier)
1338 (case_strict ada-case-strict)
1339 (casing (if (listp ada-case-exception-file)
1340 ada-case-exception-file
1341 (list ada-case-exception-file)))
1342 (path_sep path-separator)
1343 (proc_env process-environment)
1344 (src_dir (list (directory-file-name default-directory)))
1345 (xref_tool ada-xref-tool)
1348 (defun ada-prj-put (prop val &optional plist)
1349 "Set value of PROP in PLIST to VAL.
1350 Optional PLIST defaults to `ada-prj-current-project'."
1351 (plist-put (or plist ada-prj-current-project) prop val))
1353 (defun ada-require-project-file ()
1354 (unless ada-prj-current-file
1355 (error "no Emacs Ada project file specified")))
1357 (defvar ada-prj-default-list nil
1358 ;; project file parse
1359 "List of functions to add default project variables. Called
1360 with one argument; the default project properties list. Function
1361 should add to the properties list and return it.")
1363 (defvar ada-prj-default-compiler-alist nil
1364 ;; project file parse
1365 "Compiler-specific function to set default project variables.
1366 Indexed by ada-compiler. Called with one argument; the default
1367 project properties list. Function should add to the properties
1368 list and return it.")
1370 (defvar ada-prj-default-xref-alist nil
1371 ;; project file parse
1372 "Xref-tool-specific function to set default project variables.
1373 Indexed by ada-xref-tool. Called with one argument; the default
1374 project properties list. Function should add to the properties
1375 list and return it.")
1377 (defun ada-prj-default (&optional src-dir)
1378 "Return the default project properties list.
1379 If SRC-DIR is non-nil, use it as the default for src_dir.
1380 Include properties set via `ada-prj-default-compiler-alist',
1381 `ada-prj-default-xref-alist'."
1387 ;; variable name alphabetical order
1388 'ada_compiler ada-compiler
1389 'auto_case ada-auto-case
1390 'case_keyword ada-case-keyword
1391 'case_identifier ada-case-identifier
1392 'case_strict ada-case-strict
1393 'casing (if (listp ada-case-exception-file)
1394 ada-case-exception-file
1395 (list ada-case-exception-file))
1396 'path_sep path-separator;; prj variable so users can override it for their compiler
1397 'proc_env process-environment
1398 'src_dir (if src-dir (list src-dir) nil)
1399 'xref_tool ada-xref-tool
1402 (cl-dolist (func ada-prj-default-list)
1403 (setq project (funcall func project)))
1405 (setq func (cdr (assq ada-compiler ada-prj-default-compiler-alist)))
1406 (when func (setq project (funcall func project)))
1407 (setq func (cdr (assq ada-xref-tool ada-prj-default-xref-alist)))
1408 (when func (setq project (funcall func project)))
1411 (defvar ada-prj-parser-alist
1413 (lambda (ext) (cons ext 'ada-prj-parse-file-1))
1414 ada-prj-file-extensions)
1415 ;; project file parse
1416 "Alist of parsers for project files, indexed by file extension.
1417 Default provides the minimal Ada mode parser; compiler support
1418 code may add other parsers. Parser is called with two arguments;
1419 the project file name and the current project property
1420 list. Parser must modify or add to the property list and return it.")
1422 ;; This autoloaded because it is often used in Makefiles, and thus
1423 ;; will be the first ada-mode function executed.
1425 (defun ada-parse-prj-file (prj-file)
1426 "Read Emacs Ada or compiler-specific project file PRJ-FILE, set project properties in `ada-prj-alist'."
1427 ;; Not called ada-prj-parse-file for Ada mode 4.01 compatibility
1428 ;; FIXME: need to kill gpr-query session if .gpr file has changed (like from non-agg to agg!)
1429 (run-hooks `ada-prj-parse-hook)
1430 (let ((project (ada-prj-default))
1431 (parser (cdr (assoc (file-name-extension prj-file) ada-prj-parser-alist))))
1433 (setq prj-file (expand-file-name prj-file))
1435 (unless (file-readable-p prj-file)
1436 (error "Project file '%s' is not readable" prj-file))
1439 ;; parser may reference the "current project", so bind that now.
1440 (let ((ada-prj-current-project project)
1441 (ada-prj-current-file prj-file))
1442 (setq project (funcall parser prj-file project)))
1443 (error "no project file parser defined for '%s'" prj-file))
1445 ;; Store the project properties
1446 (if (assoc prj-file ada-prj-alist)
1447 (setcdr (assoc prj-file ada-prj-alist) project)
1448 (add-to-list 'ada-prj-alist (cons prj-file project)))
1450 ;; return t for interactive use
1453 (defun ada-prj-reparse-select-current ()
1454 "Reparse the current project file, re-select it.
1455 Useful when the project file has been edited."
1456 (ada-parse-prj-file ada-prj-current-file)
1457 (ada-select-prj-file ada-prj-current-file))
1459 (defvar ada-prj-parse-one-compiler nil
1460 ;; project file parse
1461 "Compiler-specific function to process one Ada project property.
1462 Indexed by project variable ada_compiler.
1463 Called with three arguments; the property name, property value,
1464 and project properties list. Function should add to or modify the
1465 properties list and return it, or return nil if the name is not
1468 (defvar ada-prj-parse-one-xref nil
1469 ;; project file parse
1470 "Xref-tool-specific function to process one Ada project property.
1471 Indexed by project variable xref_tool.
1472 Called with three arguments; the property name, property value,
1473 and project properties list. Function should add to or modify the
1474 properties list and return it, or return nil if the name is not
1477 (defvar ada-prj-parse-final-compiler nil
1478 ;; project file parse
1479 "Alist of compiler-specific functions to finish processing Ada project properties.
1480 Indexed by project variable ada_compiler.
1481 Called with one argument; the project properties list. Function
1482 should add to or modify the list and return it.")
1484 (defvar ada-prj-parse-final-xref nil
1485 ;; project file parse
1486 "Alist of xref-tool-specific functions to finish processing Ada project properties.
1487 Indexed by project variable xref_tool.
1488 Called with one argument; the project properties list. Function
1489 should add to or modify the list and return it.")
1491 (defun ada-prj-parse-file-1 (prj-file project)
1492 "Parse the Ada mode project file PRJ-FILE, set project properties in PROJECT.
1493 Return new value of PROJECT."
1494 (let (;; fields that are lists or that otherwise require special processing
1497 (parse-one-compiler (cdr (assoc ada-compiler ada-prj-parse-one-compiler)))
1498 (parse-final-compiler (cdr (assoc ada-compiler ada-prj-parse-final-compiler)))
1499 (parse-one-xref (cdr (assoc ada-xref-tool ada-prj-parse-one-xref)))
1500 (parse-final-xref (cdr (assoc ada-xref-tool ada-prj-parse-final-xref))))
1502 (with-current-buffer (find-file-noselect prj-file)
1503 (goto-char (point-min))
1505 ;; process each line
1508 ;; ignore lines that don't have the format "name=value", put
1509 ;; 'name', 'value' in match-string.
1510 (when (looking-at "^\\([^=\n]+\\)=\\(.*\\)")
1512 ;; variable name alphabetical order
1514 ((string= (match-string 1) "ada_compiler")
1515 (let ((comp (intern (match-string 2))))
1516 (setq project (plist-put project 'ada_compiler comp))
1517 (setq parse-one-compiler (cdr (assq comp ada-prj-parse-one-compiler)))
1518 (setq parse-final-compiler (cdr (assq comp ada-prj-parse-final-compiler)))))
1520 ((string= (match-string 1) "auto_case")
1521 (setq project (plist-put project 'auto_case (intern (match-string 2)))))
1523 ((string= (match-string 1) "case_keyword")
1524 (setq project (plist-put project 'case_keyword (intern (match-string 2)))))
1526 ((string= (match-string 1) "case_identifier")
1527 (setq project (plist-put project 'case_identifier (intern (match-string 2)))))
1529 ((string= (match-string 1) "case_strict")
1530 (setq project (plist-put project 'case_strict (intern (match-string 2)))))
1532 ((string= (match-string 1) "casing")
1533 (cl-pushnew (expand-file-name
1534 (substitute-in-file-name (match-string 2)))
1535 casing :test #'equal))
1537 ((string= (match-string 1) "el_file")
1538 (let ((file (expand-file-name (substitute-in-file-name (match-string 2)))))
1539 (setq project (plist-put project 'el_file file))
1540 ;; eval now as well as in select, since it might affect parsing
1543 ((string= (match-string 1) "src_dir")
1544 (cl-pushnew (file-name-as-directory
1545 (expand-file-name (match-string 2)))
1546 src_dir :test #'equal))
1548 ((string= (match-string 1) "xref_tool")
1549 (let ((xref (intern (match-string 2))))
1550 (setq project (plist-put project 'xref_tool xref))
1551 (setq parse-one-xref (cdr (assq xref ada-prj-parse-one-xref)))
1552 (setq parse-final-xref (cdr (assq xref ada-prj-parse-final-xref)))))
1556 (and parse-one-compiler
1557 (setq tmp-prj (funcall parse-one-compiler (match-string 1) (match-string 2) project)))
1559 (setq tmp-prj (funcall parse-one-xref (match-string 1) (match-string 2) project))))
1561 (setq project tmp-prj)
1563 ;; Any other field in the file is set as an environment
1564 ;; variable or a project file.
1565 (if (= ?$ (elt (match-string 1) 0))
1566 ;; process env var. We don't do expand-file-name
1567 ;; here because the application may be expecting a
1569 (let ((process-environment (plist-get project 'proc_env)))
1570 (setenv (substring (match-string 1) 1)
1571 (substitute-in-file-name (match-string 2)))
1573 (plist-put project 'proc_env process-environment)))
1575 ;; not recognized; assume it is a user-defined variable like "comp_opt"
1576 (setq project (plist-put project (intern (match-string 1)) (match-string 2)))
1582 );; done reading file
1584 ;; process accumulated lists
1585 (if casing (setq project (plist-put project 'casing (reverse casing))))
1586 (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir))))
1588 (when parse-final-compiler
1589 ;; parse-final-compiler may reference the "current project", so
1590 ;; bind that now, to include the properties set above.
1591 (let ((ada-prj-current-project project)
1592 (ada-prj-current-file prj-file))
1593 (setq project (funcall parse-final-compiler project))))
1595 (when parse-final-xref
1596 (let ((ada-prj-current-project project)
1597 (ada-prj-current-file prj-file))
1598 (setq project (funcall parse-final-xref project))))
1603 (defvar ada-select-prj-compiler nil
1604 "Alist of functions to call for compiler specific project file selection.
1605 Indexed by project variable ada_compiler.")
1607 (defvar ada-deselect-prj-compiler nil
1608 "Alist of functions to call for compiler specific project file deselection.
1609 Indexed by project variable ada_compiler.")
1611 (defvar ada-select-prj-xref-tool nil
1612 "Alist of functions to call for xref-tool specific project file selection.
1613 Indexed by project variable xref_tool.")
1615 (defvar ada-deselect-prj-xref-tool nil
1616 "Alist of functions to call for xref-tool specific project file deselection.
1617 Indexed by project variable xref_tool.")
1619 (defun ada-select-prj-file (prj-file)
1620 "Select PRJ-FILE as the current project file."
1622 (setq prj-file (expand-file-name prj-file))
1624 (setq ada-prj-current-project (cdr (assoc prj-file ada-prj-alist)))
1626 (when (null ada-prj-current-project)
1627 (setq ada-prj-current-file nil)
1628 (error "Project file '%s' was not previously parsed." prj-file))
1630 (let ((func (cdr (assq (ada-prj-get 'ada_compiler) ada-deselect-prj-compiler))))
1631 (when func (funcall func)))
1633 (let ((func (cdr (assq (ada-prj-get 'xref_tool) ada-deselect-prj-xref-tool))))
1634 (when func (funcall func)))
1636 (setq ada-prj-current-file prj-file)
1638 ;; Project file should fully specify what compilers are used,
1639 ;; including what compilation filters they need. There may be more
1640 ;; than just an Ada compiler.
1641 (setq compilation-error-regexp-alist nil)
1642 (setq compilation-filter-hook nil)
1644 (when (ada-prj-get 'el_file)
1645 (load-file (ada-prj-get 'el_file)))
1647 (ada-case-read-all-exceptions)
1649 (setq compilation-search-path (ada-prj-get 'src_dir))
1651 (let ((func (cdr (assq (ada-prj-get 'ada_compiler) ada-select-prj-compiler))))
1652 (when func (funcall func)))
1654 (let ((func (cdr (assq (ada-prj-get 'xref_tool) ada-select-prj-xref-tool))))
1655 (when func (funcall func)))
1657 ;; return 't', for decent display in message buffer when called interactively
1660 (defun ada-create-select-default-prj (&optional directory)
1661 "Create a default project with src_dir set to DIRECTORY (default current directory), select it."
1662 (let* ((dir (or directory default-directory))
1663 (prj-file (expand-file-name "default_.adp" dir))
1664 (project (ada-prj-default dir)))
1666 (if (assoc prj-file ada-prj-alist)
1667 (setcdr (assoc prj-file ada-prj-alist) project)
1668 (add-to-list 'ada-prj-alist (cons prj-file project)))
1670 (ada-select-prj-file prj-file)
1673 (defun ada-prj-select ()
1674 "Select the current project file from the list of currently available project files."
1676 (ada-select-prj-file (completing-read "project: " ada-prj-alist nil t))
1679 (defun ada-prj-show ()
1680 "Show current Emacs Ada mode project file."
1682 (message "current Emacs Ada mode project file: %s" ada-prj-current-file))
1684 (defvar ada-prj-show-prj-path nil
1685 ;; Supplied by compiler
1686 "Function to show project file search path used by compiler (and possibly xref tool)."
1689 (defun ada-prj-show-prj-path ()
1691 (when ada-prj-show-prj-path
1692 (funcall ada-prj-show-prj-path)))
1694 (defun ada-prj-show-src-path ()
1695 "Show the project source file search path."
1697 (if compilation-search-path
1699 (pop-to-buffer (get-buffer-create "*Ada project source file search path*"))
1701 (dolist (file compilation-search-path)
1702 (insert (format "%s\n" file))))
1703 (message "no project source file search path set")
1706 (defvar ada-show-xref-tool-buffer nil
1707 ;; Supplied by xref tool
1708 "Function to show process buffer used by xref tool."
1711 (defun ada-show-xref-tool-buffer ()
1713 (when ada-show-xref-tool-buffer
1714 (funcall ada-show-xref-tool-buffer)))
1716 ;;;; syntax properties
1718 (defvar ada-mode-syntax-table
1719 (let ((table (make-syntax-table)))
1720 ;; (info "(elisp)Syntax Class Table" "*info syntax class table*")
1721 ;; make-syntax-table sets all alphanumeric to w, etc; so we only
1722 ;; have to add ada-specific things.
1724 ;; string brackets. `%' is the obsolete alternative string
1725 ;; bracket (arm J.2); if we make it syntax class ", it throws
1726 ;; font-lock and indentation off the track, so we use syntax class
1728 (modify-syntax-entry ?% "$" table)
1729 (modify-syntax-entry ?\" "\"" table)
1731 ;; punctuation; operators etc
1732 (modify-syntax-entry ?# "." table); based number - ada-wisi-number-literal-p requires this syntax
1733 (modify-syntax-entry ?& "." table)
1734 (modify-syntax-entry ?* "." table)
1735 (modify-syntax-entry ?+ "." table)
1736 (modify-syntax-entry ?- ". 12" table); operator; see ada-syntax-propertize for double hyphen as comment
1737 (modify-syntax-entry ?. "." table)
1738 (modify-syntax-entry ?/ "." table)
1739 (modify-syntax-entry ?: "." table)
1740 (modify-syntax-entry ?< "." table)
1741 (modify-syntax-entry ?= "." table)
1742 (modify-syntax-entry ?> "." table)
1743 (modify-syntax-entry ?\' "." table); attribute; see ada-syntax-propertize for character literal
1744 (modify-syntax-entry ?\; "." table)
1745 (modify-syntax-entry ?\\ "." table); default is escape; not correct for Ada strings
1746 (modify-syntax-entry ?\| "." table)
1748 ;; and \f and \n end a comment
1749 (modify-syntax-entry ?\f ">" table)
1750 (modify-syntax-entry ?\n ">" table)
1752 (modify-syntax-entry ?_ "_" table); symbol constituents, not word.
1754 (modify-syntax-entry ?\( "()" table)
1755 (modify-syntax-entry ?\) ")(" table)
1757 ;; skeleton placeholder delimiters; see ada-skel.el. We use generic
1758 ;; comment delimiter class, not comment starter/comment ender, so
1759 ;; these can be distinguished from line end.
1760 (modify-syntax-entry ?{ "!" table)
1761 (modify-syntax-entry ?} "!" table)
1765 "Syntax table to be used for editing Ada source code.")
1767 (defvar ada-syntax-propertize-hook nil
1768 ;; provided by preprocessor, lumped with xref-tool
1769 "Hook run from `ada-syntax-propertize'.
1770 Called by `syntax-propertize', which is called by font-lock in
1771 `after-change-functions'. Therefore, care must be taken to avoid
1772 race conditions with the grammar parser.")
1774 (defun ada-syntax-propertize (start end)
1775 "Assign `syntax-table' properties in accessible part of buffer.
1776 In particular, character constants are set to have string syntax."
1777 ;; (info "(elisp)Syntax Properties")
1779 ;; called from `syntax-propertize', inside save-excursion with-silent-modifications
1780 (let ((inhibit-read-only t)
1781 (inhibit-point-motion-hooks t))
1784 (while (re-search-forward
1786 "[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)"; 1, 2: character literal, not attribute
1787 "\\|[^a-zA-Z0-9)]\\('''\\)"; 3: character literal '''
1788 "\\|\\(--\\)"; 4: comment start
1791 ;; syntax-propertize-extend-region-functions is set to
1792 ;; syntax-propertize-wholelines by default. We assume no
1793 ;; coding standard will permit a character literal at the
1794 ;; start of a line (not preceded by whitespace).
1796 ((match-beginning 1)
1798 (match-beginning 1) (match-end 1) 'syntax-table '(7 . ?'))
1800 (match-beginning 2) (match-end 2) 'syntax-table '(7 . ?')))
1801 ((match-beginning 3)
1803 (match-beginning 3) (1+ (match-beginning 3)) 'syntax-table '(7 . ?'))
1805 (1- (match-end 3)) (match-end 3) 'syntax-table '(7 . ?')))
1806 ((match-beginning 4)
1808 (match-beginning 4) (match-end 4) 'syntax-table '(11 . nil)))
1810 (run-hook-with-args 'ada-syntax-propertize-hook start end))
1813 (defun ada-in-comment-p (&optional parse-result)
1814 "Return t if inside a comment.
1815 If PARSE-RESULT is non-nil, use it instead of calling `syntax-ppss'."
1816 (nth 4 (or parse-result (syntax-ppss))))
1818 (defun ada-in-string-p (&optional parse-result)
1819 "Return t if point is inside a string.
1820 If PARSE-RESULT is non-nil, use it instead of calling `syntax-ppss'."
1821 (nth 3 (or parse-result (syntax-ppss))))
1823 (defun ada-in-string-or-comment-p (&optional parse-result)
1824 "Return t if inside a comment or string.
1825 If PARSE-RESULT is non-nil, use it instead of calling `syntax-ppss'."
1826 (setq parse-result (or parse-result (syntax-ppss)))
1827 (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
1829 (defun ada-in-paren-p (&optional parse-result)
1830 "Return t if point is inside a pair of parentheses.
1831 If PARSE-RESULT is non-nil, use it instead of calling `syntax-ppss'."
1832 (> (nth 0 (or parse-result (syntax-ppss))) 0))
1834 (defun ada-goto-open-paren (&optional offset parse-result)
1835 "Move point to innermost opening paren surrounding current point, plus OFFSET.
1836 Throw error if not in paren. If PARSE-RESULT is non-nil, use it
1837 instead of calling `syntax-ppss'."
1838 (goto-char (+ (or offset 0) (nth 1 (or parse-result (syntax-ppss))))))
1840 ;;;; navigation within and between files
1842 (defvar ada-body-suffixes '(".adb")
1843 "List of possible suffixes for Ada body files.
1844 The extensions should include a `.' if needed.")
1846 (defvar ada-spec-suffixes '(".ads")
1847 "List of possible suffixes for Ada spec files.
1848 The extensions should include a `.' if needed.")
1850 (defvar ada-other-file-alist
1851 '(("\\.ads$" (".adb"))
1852 ("\\.adb$" (".ads")))
1853 "Alist used by `find-file' to find the name of the other package.
1854 See `ff-other-file-alist'.")
1856 (defconst ada-name-regexp
1857 "\\(\\(?:\\sw\\|[_.]\\)+\\)")
1859 (defconst ada-parent-name-regexp
1860 "\\([a-zA-Z0-9_\\.]+\\)\\.[a-zA-Z0-9_]+"
1861 "Regexp for extracting the parent name from fully-qualified name.")
1863 (defvar ada-file-name-from-ada-name nil
1864 ;; determined by ada-xref-tool, set by *-select-prj
1865 "Function called with one parameter ADA-NAME, which is a library
1866 unit name; it should return the filename in which ADA-NAME is
1869 (defun ada-file-name-from-ada-name (ada-name)
1870 "Return the filename in which ADA-NAME is found."
1871 (ada-require-project-file)
1872 (funcall ada-file-name-from-ada-name ada-name))
1874 (defvar ada-ada-name-from-file-name nil
1875 ;; supplied by compiler
1876 "Function called with one parameter FILE-NAME, which is a library
1877 unit name; it should return the Ada name that should be found in FILE-NAME.")
1879 (defun ada-ada-name-from-file-name (file-name)
1880 "Return the ada-name that should be found in FILE-NAME."
1881 (ada-require-project-file)
1882 (funcall ada-ada-name-from-file-name file-name))
1884 (defun ada-ff-special-extract-parent ()
1885 (setq ff-function-name (match-string 1))
1886 (file-name-nondirectory
1889 compilation-search-path
1890 (ada-file-name-from-ada-name ff-function-name)
1892 (error "parent '%s' not found; set project file?" ff-function-name))))
1894 (defun ada-ff-special-with ()
1895 (let ((package-name (match-string 1)))
1896 (setq ff-function-name (concat "^package\\s-+" package-name "\\([^_]\\|$\\)"))
1897 (file-name-nondirectory
1900 compilation-search-path
1901 (ada-file-name-from-ada-name package-name)
1902 (append ada-spec-suffixes ada-body-suffixes))
1903 (error "package '%s' not found; set project file?" package-name)))
1906 (defun ada-set-ff-special-constructs ()
1907 "Add Ada-specific pairs to `ff-special-constructs'."
1908 (set (make-local-variable 'ff-special-constructs) nil)
1909 (mapc (lambda (pair) (add-to-list 'ff-special-constructs pair))
1910 ;; Each car is a regexp; if it matches at point, the cdr is invoked.
1911 ;; Each cdr should set ff-function-name to a string or regexp
1912 ;; for ada-set-point-accordingly, and return the file name
1913 ;; (sans directory, must include suffix) to go to.
1915 ;; Top level child package declaration (not body), or child
1916 ;; subprogram declaration or body; go to the parent package.
1917 (cons (concat "^\\(?:private[ \t]+\\)?\\(?:package\\|procedure\\|function\\)[ \t]+"
1918 ada-parent-name-regexp "\\(?:;\\|[ \t]+\\|$\\)")
1919 'ada-ff-special-extract-parent)
1921 ;; A "with" clause. Note that it may refer to a procedure body, as well as a spec
1922 (cons (concat "^\\(?:limited[ \t]+\\)?\\(?:private[ \t]+\\)?with[ \t]+" ada-name-regexp)
1923 'ada-ff-special-with)
1926 (defvar ada-which-function nil
1927 ;; supplied by indentation engine
1929 ;; This is run from ff-pre-load-hook, so ff-function-name may have
1930 ;; been set by ff-treat-special; don't reset it.
1931 "Function called with no parameters; it should return the name
1932 of the package, protected type, subprogram, or task type whose
1933 definition/declaration point is in or just after, or nil. In
1934 addition, if ff-function-name is non-nil, store in
1935 ff-function-name a regexp that will find the function in the
1938 (defun ada-which-function ()
1939 "See `ada-which-function' variable."
1941 (when ada-which-function
1942 (funcall ada-which-function)))
1944 (defvar ada-on-context-clause nil
1945 ;; supplied by indentation engine
1946 "Function called with no parameters; it should return non-nil
1947 if point is on a context clause.")
1949 (defun ada-on-context-clause ()
1950 "See `ada-on-context-clause' variable."
1952 (when ada-on-context-clause
1953 (funcall ada-on-context-clause)))
1955 (defvar ada-in-case-expression nil
1956 ;; supplied by indentation engine
1957 "Function called with no parameters; it should return non-nil
1958 if point is in a case expression.")
1960 (defun ada-in-case-expression ()
1961 "See `ada-in-case-expression' variable."
1963 (when ada-in-case-expression
1964 (funcall ada-in-case-expression)))
1966 (defvar ada-goto-subunit-name nil
1967 ;; supplied by indentation engine
1968 "Function called with no parameters; if the current buffer
1969 contains a subunit, move point to the subunit name (for
1970 `ada-goto-declaration'), return t; otherwise leave point alone,
1973 (defun ada-goto-subunit-name ()
1974 "See `ada-goto-subunit-name' variable."
1976 (when ada-goto-subunit-name
1977 (funcall ada-goto-subunit-name)))
1979 (defun ada-add-log-current-function ()
1980 "For `add-log-current-defun-function'; uses `ada-which-function'."
1981 ;; add-log-current-defun is typically called with point at the start
1982 ;; of an ediff change section, which is before the start of the
1983 ;; declaration of a new item. So go to the end of the current line
1984 ;; first, then call `ada-which-function'
1987 (ada-which-function)))
1989 (defun ada-set-point-accordingly ()
1990 "Move to the string specified in `ff-function-name', which may be a regexp,
1991 previously set by a file navigation command."
1992 (when ff-function-name
1995 (goto-char (point-min))
1996 ;; We are looking for an Ada declaration, so don't stop for strings or comments
1998 ;; This will still be confused by multiple references; we need
1999 ;; to use compiler cross reference info for more precision.
2001 (if (search-forward-regexp ff-function-name nil t)
2002 (setq found (match-beginning 0))
2003 ;; not in remainder of buffer
2005 (if (ada-in-string-or-comment-p)
2010 ;; different parsers find different points on the line; normalize here
2011 (back-to-indentation))
2012 (setq ff-function-name nil))))
2014 (defun ada-check-current-project (file-name)
2015 "Throw error if FILE-NAME (must be absolute) is not found in
2016 the current project source directories, or if no project has been
2018 (when (null (car compilation-search-path))
2019 (error "no file search path defined; set project file?"))
2021 ;; file-truename handles symbolic links
2022 (let* ((visited-file (file-truename file-name))
2023 (found-file (locate-file (file-name-nondirectory visited-file)
2024 compilation-search-path)))
2026 (error "current file not part of current project; wrong project?"))
2028 (setq found-file (file-truename found-file))
2030 ;; (nth 10 (file-attributes ...)) is the inode; required when hard
2031 ;; links are present.
2032 (let* ((visited-file-inode (nth 10 (file-attributes visited-file)))
2033 (found-file-inode (nth 10 (file-attributes found-file))))
2034 (unless (equal visited-file-inode found-file-inode)
2035 (error "%s (opened) and %s (found in project) are two different files"
2036 file-name found-file)))))
2038 (defun ada-find-other-file (other-window)
2039 "Move to the corresponding declaration in another file.
2041 - If region is active, assume it contains a package name;
2042 position point on that package declaration.
2044 - If point is in the start line of a non-nested child package or
2045 subprogram declaration, position point on the corresponding
2046 parent package specification.
2048 - If point is in a context clause line, position point on the
2049 first package declaration that is mentioned.
2051 - If point is in a separate body, position point on the
2052 corresponding specification.
2054 - If point is in a subprogram body or specification, position point
2055 on the corresponding specification or body.
2057 If OTHER-WINDOW (set by interactive prefix) is non-nil, show the
2058 buffer in another window."
2060 ;; ff-get-file, ff-find-other file first process
2061 ;; ff-special-constructs, then run the following hooks:
2063 ;; ff-pre-load-hook set to ada-which-function
2064 ;; ff-file-created-hook set to ada-ff-create-body
2065 ;; ff-post-load-hook set to ada-set-point-accordingly,
2066 ;; or to a compiler-specific function that
2067 ;; uses compiler-generated cross reference
2071 (ada-check-current-project (buffer-file-name))
2073 ;; clear ff-function-name, so it either ff-special-constructs or
2074 ;; ada-which-function will set it.
2075 (setq ff-function-name nil)
2079 (setq ff-function-name (buffer-substring-no-properties (point) (mark)))
2081 compilation-search-path
2082 (ada-file-name-from-ada-name ff-function-name)
2087 ((and (not (ada-on-context-clause))
2088 (ada-goto-subunit-name))
2089 (ada-goto-declaration other-window))
2092 (ff-find-other-file other-window)))
2095 (defun ada-find-file (filename)
2096 ;; we assume compliation-search-path is set, either by an
2097 ;; ada-mode project, or by some other means.
2098 ;; FIXME: option to filter with ada-*-suffixes?
2099 (interactive (list (completing-read "File: "
2101 'locate-file-completion-table
2102 compilation-search-path nil))))
2103 (find-file (locate-file filename compilation-search-path))
2106 (defvar ada-operator-re
2107 "\\+\\|-\\|/\\|\\*\\*\\|\\*\\|=\\|&\\|abs\\|mod\\|rem\\|and\\|not\\|or\\|xor\\|<=\\|<\\|>=\\|>"
2108 "Regexp matching Ada operator_symbol.")
2110 (defun ada-identifier-at-point ()
2111 "Return the identifier around point, move point to start of
2112 identifier. May be an Ada identifier or operator."
2114 (when (ada-in-comment-p)
2115 (error "Inside comment"))
2117 (skip-chars-backward "a-zA-Z0-9_<>=+\\-\\*/&")
2119 ;; Just in front of, or inside, a string => we could have an
2120 ;; operator function declaration.
2125 ((and (= (char-before) ?\")
2128 (looking-at (concat "\"\\(" ada-operator-re "\\)\""))))
2129 (concat "\"" (match-string-no-properties 1) "\""))
2132 (error "Inside string or character constant"))
2135 ((and (= (char-after) ?\")
2136 (looking-at (concat "\"\\(" ada-operator-re "\\)\"")))
2137 (concat "\"" (match-string-no-properties 1) "\""))
2139 ((looking-at "[a-zA-Z0-9_]+\\|[+\\-*/&=<>]")
2140 (match-string-no-properties 0))
2143 (error "No identifier around"))
2146 ;; FIXME (for emacs 25): use find-tag-marker-ring, ring-insert, pop-tag-mark (see xref.el)
2147 (defvar ada-goto-pos-ring '()
2148 "List of positions selected by navigation functions. Used
2149 to go back to these positions.")
2151 (defconst ada-goto-pos-ring-max 16
2152 "Number of positions kept in the list `ada-goto-pos-ring'.")
2154 (defun ada-goto-push-pos ()
2155 "Push current filename, position on `ada-goto-pos-ring'. See `ada-goto-previous-pos'."
2156 (setq ada-goto-pos-ring (cons (list (point) (buffer-file-name)) ada-goto-pos-ring))
2157 (if (> (length ada-goto-pos-ring) ada-goto-pos-ring-max)
2158 (setcdr (nthcdr (1- ada-goto-pos-ring-max) ada-goto-pos-ring) nil)))
2160 (defun ada-goto-previous-pos ()
2161 "Go to the first position in `ada-goto-pos-ring', pop `ada-goto-pos-ring'."
2163 (when ada-goto-pos-ring
2164 (let ((pos (pop ada-goto-pos-ring)))
2165 (find-file (cadr pos))
2166 (goto-char (car pos)))))
2168 (defun ada-goto-source (file line column other-window)
2169 "Find and select FILE, at LINE and COLUMN.
2170 FILE may be absolute, or on `compilation-search-path'.
2171 LINE, COLUMN are Emacs origin.
2173 If OTHER-WINDOW is non-nil, show the buffer in another window."
2175 (if (file-name-absolute-p file) file
2176 (ff-get-file-name compilation-search-path file))))
2179 (error "File %s not found; installed library, or set project?" file))
2184 (let ((buffer (get-file-buffer file)))
2188 ((null other-window)
2189 (switch-to-buffer buffer))
2191 (t (switch-to-buffer-other-window buffer))
2194 ((file-exists-p file)
2196 ((null other-window)
2200 (find-file-other-window file))
2204 (error "'%s' not found" file))))
2207 ;; move the cursor to the correct position
2209 (goto-char (point-min))
2210 (forward-line (1- line))
2211 (forward-char column)
2214 (defvar ada-xref-refresh-function nil
2215 ;; determined by xref_tool, set by *-select-prj-xref
2216 "Function that refreshes cross reference information cache.")
2218 (defun ada-xref-refresh ()
2219 "Refresh cross reference information cache, if any."
2222 (when (null ada-xref-refresh-function)
2223 (error "no cross reference information available"))
2225 (funcall ada-xref-refresh-function)
2228 (defvar ada-xref-other-function nil
2229 ;; determined by xref_tool, set by *-select-prj-xref
2230 "Function that returns cross reference information.
2231 Function is called with four arguments:
2232 - an Ada identifier or operator_symbol
2233 - filename containing the identifier (full path)
2234 - line number containing the identifier
2235 - column of the start of the identifier
2236 Returns a list '(file line column) giving the corresponding location.
2237 'file' may be absolute, or on `compilation-search-path'. If point is
2238 at the specification, the corresponding location is the body, and vice
2241 (defun ada-goto-declaration (other-window)
2242 "Move to the declaration or body of the identifier around point.
2243 If at the declaration, go to the body, and vice versa.
2245 If OTHER-WINDOW (set by interactive prefix) is non-nil, show the
2246 buffer in another window."
2248 (ada-check-current-project (buffer-file-name))
2250 (when (null ada-xref-other-function)
2251 (error "no cross reference information available"))
2254 (funcall ada-xref-other-function
2255 (ada-identifier-at-point)
2257 (line-number-at-pos)
2258 (1+ (current-column))
2261 (ada-goto-source (nth 0 target)
2267 (defvar ada-xref-parent-function nil
2268 ;; determined by xref_tool, set by *-select-prj-xref
2269 "Function that returns cross reference information.
2270 Function is called with four arguments:
2271 - an Ada identifier or operator_symbol
2272 - filename containing the identifier
2273 - line number containing the identifier
2274 - column of the start of the identifier
2275 Displays a buffer in compilation-mode giving locations of the parent type declarations.")
2277 (defun ada-show-declaration-parents ()
2278 "Display the locations of the parent type declarations of the type identifier around point."
2280 (ada-check-current-project (buffer-file-name))
2282 (when (null ada-xref-parent-function)
2283 (error "no cross reference information available"))
2285 (funcall ada-xref-parent-function
2286 (ada-identifier-at-point)
2287 (file-name-nondirectory (buffer-file-name))
2288 (line-number-at-pos)
2289 (1+ (current-column)))
2292 (defvar ada-xref-all-function nil
2293 ;; determined by xref_tool, set by *-select-prj-xref
2294 "Function that displays cross reference information.
2295 Called with four arguments:
2296 - an Ada identifier or operator_symbol
2297 - filename containing the identifier
2298 - line number containing the identifier
2299 - column of the start of the identifier
2300 Displays a buffer in compilation-mode giving locations where the
2301 identifier is declared or referenced.")
2303 (defun ada-show-references ()
2304 "Show all references of identifier at point."
2306 (ada-check-current-project (buffer-file-name))
2308 (when (null ada-xref-all-function)
2309 (error "no cross reference information available"))
2311 (funcall ada-xref-all-function
2312 (ada-identifier-at-point)
2313 (file-name-nondirectory (buffer-file-name))
2314 (line-number-at-pos)
2315 (1+ (current-column)))
2318 (defvar ada-xref-overriding-function nil
2319 ;; determined by ada-xref-tool, set by *-select-prj
2320 "Function that displays cross reference information for overriding subprograms.
2321 Called with four arguments:
2322 - an Ada identifier or operator_symbol
2323 - filename containing the identifier
2324 - line number containing the identifier
2325 - column of the start of the identifier
2326 Displays a buffer in compilation-mode giving locations of the overriding declarations.")
2328 (defun ada-show-overriding ()
2329 "Show all overridings of identifier at point."
2331 (ada-check-current-project (buffer-file-name))
2333 (when (null ada-xref-overriding-function)
2334 (error "no cross reference information available"))
2336 (funcall ada-xref-overriding-function
2337 (ada-identifier-at-point)
2338 (file-name-nondirectory (buffer-file-name))
2339 (line-number-at-pos)
2340 (1+ (current-column)))
2343 (defvar ada-xref-overridden-function nil
2344 ;; determined by ada-xref-tool, set by *-select-prj
2345 "Function that displays cross reference information for overridden subprogram.
2346 Called with four arguments:
2347 - an Ada identifier or operator_symbol
2348 - filename containing the identifier
2349 - line number containing the identifier
2350 - column of the start of the identifier
2351 Returns a list '(file line column) giving the corresponding location.
2352 'file' may be absolute, or on `compilation-search-path'.")
2354 (defun ada-show-overridden (other-window)
2355 "Show the overridden declaration of identifier at point."
2357 (ada-check-current-project (buffer-file-name))
2359 (when (null ada-xref-overridden-function)
2360 (error "'show overridden' not supported, or no cross reference information available"))
2363 (funcall ada-xref-overridden-function
2364 (ada-identifier-at-point)
2365 (file-name-nondirectory (buffer-file-name))
2366 (line-number-at-pos)
2367 (1+ (current-column)))))
2369 (ada-goto-source (nth 0 target)
2376 ;; This is autoloaded because it may be used in ~/.emacs
2378 (defun ada-add-extensions (spec body)
2379 "Define SPEC and BODY as being valid extensions for Ada files.
2380 SPEC and BODY are two regular expressions that must match against
2382 (let* ((reg (concat (regexp-quote body) "$"))
2383 (tmp (assoc reg ada-other-file-alist)))
2385 (setcdr tmp (list (cons spec (cadr tmp))))
2386 (add-to-list 'ada-other-file-alist (list reg (list spec)))))
2388 (let* ((reg (concat (regexp-quote spec) "$"))
2389 (tmp (assoc reg ada-other-file-alist)))
2391 (setcdr tmp (list (cons body (cadr tmp))))
2392 (add-to-list 'ada-other-file-alist (list reg (list body)))))
2394 (add-to-list 'auto-mode-alist
2395 (cons (concat (regexp-quote spec) "\\'") 'ada-mode))
2396 (add-to-list 'auto-mode-alist
2397 (cons (concat (regexp-quote body) "\\'") 'ada-mode))
2399 (add-to-list 'ada-spec-suffixes spec)
2400 (add-to-list 'ada-body-suffixes body)
2402 (when (fboundp 'speedbar-add-supported-extension)
2403 (speedbar-add-supported-extension spec)
2404 (speedbar-add-supported-extension body))
2407 (defun ada-show-secondary-error (other-window)
2408 "Show the next secondary file reference in the compilation buffer.
2409 A secondary file reference is defined by text having text
2410 property `ada-secondary-error'. These can be set by
2411 compiler-specific compilation filters.
2413 If OTHER-WINDOW (set by interactive prefix) is non-nil, show the
2414 buffer in another window."
2417 ;; preserving the current window works only if the frame
2418 ;; doesn't change, at least on Windows.
2419 (let ((start-buffer (current-buffer))
2420 (start-window (selected-window))
2422 (set-buffer compilation-last-buffer)
2423 (setq pos (next-single-property-change (point) 'ada-secondary-error))
2425 (setq item (get-text-property pos 'ada-secondary-error))
2426 ;; file-relative-name handles absolute Windows paths from
2427 ;; g++. Do this in compilation buffer to get correct
2428 ;; default-directory.
2429 (setq file (file-relative-name (nth 0 item)))
2431 ;; Set point in compilation buffer past this secondary error, so
2432 ;; user can easily go to the next one. For some reason, this
2433 ;; doesn't change the visible point!?
2436 (set-buffer start-buffer);; for windowing history
2441 (nth 2 item); column
2443 (select-window start-window)
2447 (defvar ada-goto-declaration-start nil
2448 ;; Supplied by indentation engine.
2450 ;; This is run from ff-pre-load-hook, so ff-function-name may have
2451 ;; been set by ff-treat-special; don't reset it.
2452 "For `beginning-of-defun-function'. Function to move point to
2453 start of the generic, package, protected, subprogram, or task
2454 declaration point is currently in or just after. Called with no
2457 (defun ada-goto-declaration-start ()
2458 "Call `ada-goto-declaration-start'."
2460 (when ada-goto-declaration-start
2461 (funcall ada-goto-declaration-start)))
2463 (defvar ada-goto-declaration-end nil
2464 ;; supplied by indentation engine
2465 "For `end-of-defun-function'. Function to move point to end of
2466 current declaration.")
2468 (defun ada-goto-declaration-end ()
2469 "See `ada-goto-declaration-end' variable."
2471 (when ada-goto-declaration-end
2472 (funcall ada-goto-declaration-end)))
2474 (defvar ada-goto-declarative-region-start nil
2475 ;; Supplied by indentation engine
2476 "Function to move point to start of the declarative region of
2477 the subprogram, package, task, or declare block point
2478 is currently in. Called with no parameters.")
2480 (defun ada-goto-declarative-region-start ()
2481 "Call `ada-goto-declarative-region-start'."
2482 (when ada-goto-declarative-region-start
2483 (funcall ada-goto-declarative-region-start)))
2485 (defvar ada-next-statement-keyword nil
2486 ;; Supplied by indentation engine
2487 "Function called with no parameters; it should move forward to
2488 the next keyword in the statement following the one point is
2489 in (ie from 'if' to 'then'). If not in a keyword, move forward to
2490 the next keyword in the current statement. If at the last
2491 keyword, move forward to the first keyword in the next statement
2492 or next keyword in the containing statement.")
2494 (defvar ada-goto-end nil
2495 ;; Supplied by indentation engine
2496 "Function to move point to end of the declaration or statement point is in or before.
2497 Called with no parameters.")
2499 (defun ada-goto-end ()
2500 "Call `ada-goto-end'."
2502 (funcall ada-goto-end)))
2504 (defun ada-next-statement-keyword ()
2505 ;; Supplied by indentation engine
2506 "See `ada-next-statement-keyword' variable. In addition,
2507 if on open parenthesis move to matching closing parenthesis."
2509 (if (= (syntax-class (syntax-after (point))) 4)
2513 ;; else move by keyword
2514 (when ada-next-statement-keyword
2515 (unless (region-active-p)
2517 (funcall ada-next-statement-keyword))))
2519 (defvar ada-prev-statement-keyword nil
2520 ;; Supplied by indentation engine
2521 "Function called with no parameters; it should move to the previous
2522 keyword in the statement following the one point is in (ie from
2523 'then' to 'if'). If at the first keyword, move to the previous
2524 keyword in the previous statement or containing statement.")
2526 (defun ada-prev-statement-keyword ()
2527 "See `ada-prev-statement-keyword' variable. In addition,
2528 if on close parenthesis move to matching open parenthesis."
2530 (if (= (syntax-class (syntax-after (1- (point)))) 5)
2534 ;; else move by keyword
2535 (when ada-prev-statement-keyword
2536 (unless (region-active-p)
2538 (funcall ada-prev-statement-keyword))))
2542 (defvar ada-make-subprogram-body nil
2543 ;; Supplied by indentation engine
2544 "Function to convert subprogram specification after point into a subprogram body stub.
2545 Called with no args, point at declaration start. Leave point in
2546 subprogram body, for user to add code.")
2548 (defun ada-make-subprogram-body ()
2549 "If point is in or after a subprogram specification, convert it
2550 into a subprogram body stub, by calling `ada-make-subprogram-body'."
2552 (ada-goto-declaration-start)
2553 (if ada-make-subprogram-body
2554 (funcall ada-make-subprogram-body)
2555 (error "`ada-make-subprogram-body' not set")))
2557 (defvar ada-make-package-body nil
2558 ;; Supplied by xref tool
2559 "Function to create a package body from a package spec.
2560 Called with one argument; the absolute path to the body
2561 file. Current buffer is the package spec. Should create the
2562 package body file, containing skeleton code that will compile.")
2564 (defun ada-make-package-body (body-file-name)
2565 ;; no error if not set; let ada-skel do its thing.
2566 (when ada-make-package-body
2567 (funcall ada-make-package-body body-file-name)))
2569 (defun ada-ff-create-body ()
2570 ;; no error if not set; let ada-skel do its thing.
2571 (when ada-make-package-body
2572 ;; ff-find-other-file calls us with point in an empty buffer for
2573 ;; the body file; ada-make-package-body expects to be in the
2574 ;; spec. So go back to the spec, and delete the body buffer so it
2575 ;; does not get written to disk.
2576 (let ((body-buffer (current-buffer))
2577 (body-file-name (buffer-file-name)))
2579 (set-buffer-modified-p nil);; may have a skeleton; allow silent delete
2581 (ff-find-the-other-file);; back to spec
2583 (kill-buffer body-buffer)
2585 (ada-make-package-body body-file-name)
2587 ;; back to the new body file, read in from the disk.
2588 (ff-find-the-other-file)
2589 (revert-buffer t t))
2594 (defun ada-fill-comment-paragraph (&optional justify postfix)
2595 "Fill the current comment paragraph.
2596 If JUSTIFY is non-nil, each line is justified as well.
2597 If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended
2598 to each line filled and justified.
2599 The paragraph is indented on the first line."
2601 (if (not (or (ada-in-comment-p)
2602 (looking-at "[ \t]*--")))
2603 (error "Not inside comment"))
2605 ;; fill-region-as-paragraph leaves comment text exposed (without
2606 ;; comment prefix) when inserting a newline; don't trigger a parse
2607 ;; because of that (in particular, jit-lock requires a parse; other
2608 ;; hooks may as well). In general, we don't need to trigger a parse
2609 ;; for comment changes.
2611 ;; FIXME: add ada-inibit-parse instead; let other change hooks run.
2612 ;; FIXME: wisi-after-change still needs to adjust wisi-cache-max
2613 ;; FIXME: even better, consider patch suggested by Stefan Monnier to
2614 ;; move almost all code out of the change hooks (see email).
2615 (let* ((inhibit-modification-hooks t)
2617 (opos (point-marker))
2618 ;; we bind `fill-prefix' here rather than in ada-mode because
2619 ;; setting it in ada-mode causes indent-region to use it for
2621 (fill-prefix ada-fill-comment-prefix)
2622 (fill-column (current-fill-column)))
2624 ;; We should run before-change-functions here, but we don't know from/to yet.
2626 ;; Find end of comment paragraph
2627 (back-to-indentation)
2628 (while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
2631 ;; If we were at the last line in the buffer, create a dummy empty
2632 ;; line at the end of the buffer.
2635 (back-to-indentation)))
2637 (setq to (point-marker))
2640 ;; Find beginning of paragraph
2641 (back-to-indentation)
2642 (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
2644 (back-to-indentation))
2649 (setq from (point-marker))
2651 ;; Calculate the indentation we will need for the paragraph
2652 (back-to-indentation)
2653 (setq indent (current-column))
2654 ;; unindent the first line of the paragraph
2655 (delete-region from (point))
2657 ;; Remove the old postfixes
2659 (while (re-search-forward (concat "\\(" ada-fill-comment-postfix "\\)" "\n") to t)
2660 (delete-region (match-beginning 1) (match-end 1)))
2663 (setq to (point-marker))
2665 ;; Indent and justify the paragraph
2666 (set-left-margin from to indent)
2668 (setq fill-column (- fill-column (length ada-fill-comment-postfix))))
2670 (fill-region-as-paragraph from to justify)
2672 ;; Add the postfixes if required
2676 (narrow-to-region from to)
2679 (insert-char ? (- fill-column (current-column)))
2680 (insert ada-fill-comment-postfix)
2686 ;; we disabled modification hooks, so font-lock will not run to
2687 ;; re-fontify the comment prefix; do that here.
2688 ;; FIXME: Use actual original size instead of 0!
2689 (run-hook-with-args 'after-change-functions from to 0)))
2691 ;;;; support for font-lock.el
2693 (defconst ada-83-keywords
2694 '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin"
2695 "body" "case" "constant" "declare" "delay" "delta" "digits" "do"
2696 "else" "elsif" "end" "entry" "exception" "exit" "for" "function"
2697 "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new"
2698 "not" "null" "of" "or" "others" "out" "package" "pragma" "private"
2699 "procedure" "raise" "range" "record" "rem" "renames" "return"
2700 "reverse" "select" "separate" "subtype" "task" "terminate" "then"
2701 "type" "use" "when" "while" "with" "xor")
2702 "List of Ada 83 keywords.")
2704 (defconst ada-95-keywords
2705 '("abstract" "aliased" "protected" "requeue" "tagged" "until")
2706 "List of keywords new in Ada 95.")
2708 (defconst ada-2005-keywords
2709 '("interface" "overriding" "synchronized")
2710 "List of keywords new in Ada 2005.")
2712 (defconst ada-2012-keywords
2714 "List of keywords new in Ada 2012.")
2716 (defun ada-font-lock-keywords ()
2717 "Return Ada mode value for `font-lock-keywords', depending on `ada-language-version'."
2718 ;; Grammar actions set `font-lock-face' property for all
2719 ;; non-keyword tokens that need it.
2721 (list (concat "\\<" (regexp-opt ada-keywords t) "\\>") '(0 font-lock-keyword-face))
2726 ;; ada-mode does not derive from prog-mode, because we need to call
2727 ;; ada-mode-post-local-vars, and prog-mode does not provide a way to
2730 ;; autoload required by automatic mode setting
2733 "The major mode for editing Ada code."
2734 ;; the other ada-*.el files add to ada-mode-hook for their setup
2737 (kill-all-local-variables)
2738 (setq major-mode 'ada-mode)
2739 (setq mode-name "Ada")
2740 (use-local-map ada-mode-map)
2741 (set-syntax-table ada-mode-syntax-table)
2742 (define-abbrev-table 'ada-mode-abbrev-table ())
2743 (setq local-abbrev-table ada-mode-abbrev-table)
2745 (set (make-local-variable 'syntax-propertize-function) 'ada-syntax-propertize)
2746 (when (boundp 'syntax-begin-function)
2747 ;; obsolete in emacs-25.1
2748 (set (make-local-variable 'syntax-begin-function) nil))
2749 (set (make-local-variable 'parse-sexp-ignore-comments) t)
2750 (set (make-local-variable 'parse-sexp-lookup-properties) t)
2751 (set 'case-fold-search t); Ada is case insensitive; the syntax parsing requires this setting
2752 (set (make-local-variable 'comment-start) "--")
2753 (set (make-local-variable 'comment-end) "")
2754 (set (make-local-variable 'comment-start-skip) "---*[ \t]*")
2755 (set (make-local-variable 'comment-multi-line) nil)
2757 ;; we _don't_ set `fill-prefix' here because that causes
2758 ;; indent-region to use it for all indentation. See
2759 ;; ada-fill-comment-paragraph.
2761 ;; AdaCore standard style (enforced by -gnaty) requires two spaces
2762 ;; after '--' in comments; this makes it easier to distinguish
2763 ;; special comments that have something else after '--'
2764 (set (make-local-variable 'comment-padding) " ")
2766 (set (make-local-variable 'require-final-newline) t)
2768 ;; 'font-lock-defaults' is a confusing name; it's buffer local
2769 (setq font-lock-defaults
2770 '(ada-font-lock-keywords
2772 ((?\_ . "w")))); treat underscore as a word component
2774 (set (make-local-variable 'ff-other-file-alist)
2775 'ada-other-file-alist)
2776 (setq ff-post-load-hook 'ada-set-point-accordingly
2777 ff-file-created-hook 'ada-ff-create-body)
2778 (add-hook 'ff-pre-load-hook 'ada-goto-push-pos)
2779 (add-hook 'ff-pre-load-hook 'ada-which-function)
2780 (setq ff-search-directories 'compilation-search-path)
2781 (when (null (car compilation-search-path))
2782 ;; find-file doesn't handle nil in search path
2783 (setq compilation-search-path (list (file-name-directory (buffer-file-name)))))
2784 (ada-set-ff-special-constructs)
2786 (set (make-local-variable 'add-log-current-defun-function)
2787 'ada-add-log-current-function)
2789 (when (boundp 'which-func-functions)
2790 (add-hook 'which-func-functions 'ada-which-function nil t))
2792 ;; Support for align
2793 (add-to-list 'align-dq-string-modes 'ada-mode)
2794 (add-to-list 'align-open-comment-modes 'ada-mode)
2795 (set (make-local-variable 'align-region-separate) ada-align-region-separate)
2796 (set (make-local-variable 'align-indent-before-aligning) t)
2798 ;; Exclude comments alone on line from alignment.
2799 (add-to-list 'align-exclude-rules-list
2801 (regexp . "^\\(\\s-*\\)--")
2802 (modes . '(ada-mode))))
2803 (add-to-list 'align-exclude-rules-list
2805 (regexp . "^\\(\\s-*\\)\\<use\\>")
2806 (modes . '(ada-mode))))
2808 (setq align-mode-rules-list ada-align-rules)
2810 (easy-menu-add ada-mode-menu ada-mode-map)
2812 (setq ada-case-strict (ada-prj-get 'case_strict))
2814 (run-mode-hooks 'ada-mode-hook)
2816 ;; If global-font-lock is not enabled, ada-syntax-propertize is
2817 ;; not run when the text is first loaded into the buffer. Recover
2819 (syntax-ppss-flush-cache (point-min))
2820 (syntax-propertize (point-max))
2822 (add-hook 'hack-local-variables-hook 'ada-mode-post-local-vars nil t)
2825 (defun ada-mode-post-local-vars ()
2826 ;; These are run after ada-mode-hook and file local variables
2827 ;; because users or other ada-* files might set the relevant
2828 ;; variable inside the hook or file local variables (file local
2829 ;; variables are processed after the mode is set, and thus after
2830 ;; ada-mode is run).
2832 ;; This means to fully set ada-mode interactively, user must
2833 ;; do M-x ada-mode M-; (hack-local-variables)
2835 ;; fill-region-as-paragraph in ada-fill-comment-paragraph does not
2836 ;; call syntax-propertize, so set comment syntax on
2837 ;; ada-fill-comment-prefix. In post-local because user may want to
2839 (put-text-property 0 2 'syntax-table '(11 . nil) ada-fill-comment-prefix)
2841 (cl-case ada-language-version
2843 (setq ada-keywords ada-83-keywords))
2847 (append ada-83-keywords
2852 (append ada-83-keywords
2854 ada-2005-keywords)))
2857 (append ada-83-keywords
2860 ada-2012-keywords))))
2862 (when global-font-lock-mode
2863 ;; This calls ada-font-lock-keywords, which depends on
2865 (font-lock-refresh-defaults))
2867 (when ada-goto-declaration-start
2868 (set (make-local-variable 'beginning-of-defun-function) ada-goto-declaration-start))
2870 (when ada-goto-declaration-end
2871 (set (make-local-variable 'end-of-defun-function) ada-goto-declaration-end))
2874 (put 'ada-mode 'custom-mode-group 'ada)
2878 ;;;;; Global initializations
2880 (require 'ada-build)
2882 (unless (featurep 'ada-indent-engine)
2883 (require 'ada-wisi))
2885 (unless (featurep 'ada-xref-tool)
2886 (cl-case ada-xref-tool
2887 ((nil gnat) (require 'ada-gnat-xref))
2888 (gpr_query (require 'gpr-query))
2891 (unless (featurep 'ada-compiler)
2892 (require 'ada-gnat-compile))
2894 (unless (featurep 'ada-skeletons)
2895 (require 'ada-skel))
2897 (when (featurep 'imenu)
2898 (require 'ada-imenu))