ada-mode.el 180 KB
Newer Older
1
;;; ada-mode.el --- major-mode for editing Ada sources
Richard M. Stallman's avatar
Richard M. Stallman committed
2

3
;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4
;;               2005, 2006, 2007, 2008, 2009  Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
5

6 7 8
;; Author: Rolf Ebert      <ebert@inf.enst.fr>
;;      Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
;;      Emmanuel Briot  <briot@gnat.com>
9
;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
10
;; Keywords: languages ada
Richard M. Stallman's avatar
Richard M. Stallman committed
11

12
;; This file is part of GNU Emacs.
Richard M. Stallman's avatar
Richard M. Stallman committed
13

14
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
15
;; it under the terms of the GNU General Public License as published by
16 17
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
18

Gerd Moellmann's avatar
Gerd Moellmann committed
19
;; GNU Emacs is distributed in the hope that it will be useful,
Richard M. Stallman's avatar
Richard M. Stallman committed
20 21 22 23 24
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
25
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
26 27

;;; Commentary:
28 29 30 31 32 33 34 35 36 37 38 39
;; This mode is a major mode for editing Ada code.  This is a major
;; rewrite of the file packaged with Emacs-20.  The Ada mode is
;; composed of four Lisp files: ada-mode.el, ada-xref.el, ada-prj.el
;; and ada-stmt.el.  Only this file (ada-mode.el) is completely
;; independent from the GNU Ada compiler GNAT, distributed by Ada
;; Core Technologies.  All the other files rely heavily on features
;; provided only by GNAT.
;;
;; Note: this mode will not work with Emacs 19. If you are on a VMS
;; system, where the latest version of Emacs is 19.28, you will need
;; another file, called ada-vms.el, that provides some required
;; functions.
40 41

;;; Usage:
42 43 44 45 46 47 48 49 50 51 52 53 54 55
;; Emacs should enter Ada mode automatically when you load an Ada file.
;; By default, the valid extensions for Ada files are .ads, .adb or .ada
;; If the ada-mode does not start automatically, then simply type the
;; following command :
;;     M-x ada-mode
;;
;; By default, ada-mode is configured to take full advantage of the GNAT
;; compiler (the menus will include the cross-referencing features,...).
;; If you are using another compiler, you might want to set the following
;; variable in your .emacs (Note: do not set this in the ada-mode-hook, it
;; won't work) :
;;    (setq ada-which-compiler 'generic)
;;
;; This mode requires find-file.el to be present on your system.
Richard M. Stallman's avatar
Richard M. Stallman committed
56

57
;;; History:
58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
;; The first Ada mode for GNU Emacs was written by V. Broman in
;; 1985. He based his work on the already existing Modula-2 mode.
;; This was distributed as ada.el in versions of Emacs prior to 19.29.
;;
;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of
;; several files with support for dired commands and other nice
;; things. It is currently available from the PAL
;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z.
;;
;; The probably very first Ada mode (called electric-ada.el) was
;; written by Steven D. Litvintchouk and Steven M. Rosen for the
;; Gosling Emacs. L. Slater based his development on ada.el and
;; electric-ada.el.
;;
;; A complete rewrite by M. Heritsch and R. Ebert has been done.
;; Some ideas from the Ada mode mailing list have been
;; added.  Some of the functionality of L. Slater's mode has not
;; (yet) been recoded in this new mode.  Perhaps you prefer sticking
;; to his version.
;;
;; A complete rewrite for Emacs-20 / GNAT-3.11 has been done by Ada Core
;; Technologies.
80 81

;;; Credits:
82 83 84 85 86 87 88 89 90 91 92 93 94 95
;;   Many thanks to John McCabe <john@assen.demon.co.uk> for sending so
;;     many patches included in this package.
;;   Christian Egli <Christian.Egli@hcsd.hac.com>:
;;     ada-imenu-generic-expression
;;   Many thanks also to the following persons that have contributed
;;   to the ada-mode
;;     Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular,
;;     woodruff@stc.llnl.gov (John Woodruff)
;;     jj@ddci.dk (Jesper Joergensen)
;;     gse@ocsystems.com (Scott Evans)
;;     comar@gnat.com (Cyrille Comar)
;;     stephen.leake@gsfc.nasa.gov (Stephen Leake)
;;     robin-reply@reagans.org
;;    and others for their valuable hints.
Richard M. Stallman's avatar
Richard M. Stallman committed
96

97
;;; Code:
98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124
;; Note: Every function in this package is compiler-independent.
;; The names start with  ada-
;; The variables that the user can edit can all be modified through
;;   the customize mode. They are sorted in alphabetical order in this
;;   file.

;; Supported packages.
;; This package supports a number of other Emacs modes. These other modes
;; should be loaded before the ada-mode, which will then setup some variables
;; to improve the support for Ada code.
;; Here is the list of these modes:
;;   `which-function-mode': Display the name of the subprogram the cursor is
;;      in in the mode line.
;;   `outline-mode': Provides the capability to collapse or expand the code
;;      for specific language constructs, for instance if you want to hide the
;;      code corresponding to a subprogram
;;   `align': This mode is now provided with Emacs 21, but can also be
;;      installed manually for older versions of Emacs. It provides the
;;      capability to automatically realign the selected region (for instance
;;      all ':=', ':' and '--' will be aligned on top of each other.
;;   `imenu': Provides a menu with the list of entities defined in the current
;;      buffer, and an easy way to jump to any of them
;;   `speedbar': Provides a separate file browser, and the capability for each
;;      file to see the list of entities defined in it and to jump to them
;;      easily
;;   `abbrev-mode': Provides the capability to define abbreviations, which
;;      are automatically expanded when you type them. See the Emacs manual.
125

126 127 128 129
(require 'find-file nil t)
(require 'align nil t)
(require 'which-func nil t)
(require 'compile nil t)
130

131
(defvar compile-auto-highlight)
132
(defvar ispell-check-comments)
133 134
(defvar skeleton-further-elements)

135 136 137
(defun ada-mode-version ()
  "Return Ada mode version."
  (interactive)
138
  (let ((version-string "4.00"))
139 140 141 142
    (if (interactive-p)
	(message version-string)
      version-string)))

143 144
(defvar ada-mode-hook nil
  "*List of functions to call when Ada mode is invoked.
145
This hook is automatically executed after the `ada-mode' is
146 147
fully loaded.
This is a good place to add Ada environment specific bindings.")
Richard M. Stallman's avatar
Richard M. Stallman committed
148 149

(defgroup ada nil
150
  "Major mode for editing and compiling Ada source in Emacs."
151
  :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
Richard M. Stallman's avatar
Richard M. Stallman committed
152 153
  :group 'languages)

154 155 156 157 158
(defcustom ada-auto-case t
  "*Non-nil means automatically change case of preceding word while typing.
Casing is done according to `ada-case-keyword', `ada-case-identifier'
and `ada-case-attribute'."
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
159

160 161 162 163 164 165
(defcustom ada-broken-decl-indent 0
  "*Number of columns to indent a broken declaration.

An example is :
  declare
     A,
166
     >>>>>B : Integer;"
167
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
168

Richard M. Stallman's avatar
Richard M. Stallman committed
169
(defcustom ada-broken-indent 2
170
  "*Number of columns to indent the continuation of a broken line.
Richard M. Stallman's avatar
Richard M. Stallman committed
171

172 173
An example is :
   My_Var : My_Type := (Field1 =>
174
			>>>>>>>>>Value);"
175
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
176

177
(defcustom ada-continuation-indent ada-broken-indent
Juanma Barranquero's avatar
Juanma Barranquero committed
178
  "*Number of columns to indent the continuation of broken lines in parenthesis.
179 180 181

An example is :
   Func (Param1,
182
	 >>>>>Param2);"
183 184
  :type 'integer :group 'ada)

185 186
(defcustom ada-case-attribute 'ada-capitalize-word
  "*Function to call to adjust the case of Ada attributes.
187 188
It may be `downcase-word', `upcase-word', `ada-loose-case-word',
`ada-capitalize-word' or `ada-no-auto-case'."
189
  :type '(choice (const downcase-word)
190 191 192 193
		 (const upcase-word)
		 (const ada-capitalize-word)
		 (const ada-loose-case-word)
		 (const ada-no-auto-case))
Richard M. Stallman's avatar
Richard M. Stallman committed
194
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
195

196 197
(defcustom ada-case-exception-file
  (list (convert-standard-filename' "~/.emacs_case_exceptions"))
198 199 200 201 202
  "*List of special casing exceptions dictionaries for identifiers.
The first file is the one where new exceptions will be saved by Emacs
when you call `ada-create-case-exception'.

These files should contain one word per line, that gives the casing
Juanma Barranquero's avatar
Juanma Barranquero committed
203
to be used for that word in Ada files.  If the line starts with the
204 205
character *, then the exception will be used for substrings that either
start at the beginning of a word or after a _ character, and end either
206 207
at the end of the word or at a _ character.  Each line can be terminated
by a comment."
208 209
  :type '(repeat (file))
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
210

211
(defcustom ada-case-keyword 'downcase-word
212
  "*Function to call to adjust the case of an Ada keywords.
213 214 215
It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
`ada-capitalize-word'."
  :type '(choice (const downcase-word)
216 217 218 219
		 (const upcase-word)
		 (const ada-capitalize-word)
		 (const ada-loose-case-word)
		 (const ada-no-auto-case))
Richard M. Stallman's avatar
Richard M. Stallman committed
220
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
221

222 223 224 225 226
(defcustom ada-case-identifier 'ada-loose-case-word
  "*Function to call to adjust the case of an Ada identifier.
It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
`ada-capitalize-word'."
  :type '(choice (const downcase-word)
227 228 229 230
		 (const upcase-word)
		 (const ada-capitalize-word)
		 (const ada-loose-case-word)
		 (const ada-no-auto-case))
Richard M. Stallman's avatar
Richard M. Stallman committed
231
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
232

233
(defcustom ada-clean-buffer-before-saving t
234
  "*Non-nil means remove trailing spaces and untabify the buffer before saving."
235
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
236

237 238
(defcustom ada-indent 3
  "*Size of Ada indentation.
Richard M. Stallman's avatar
Richard M. Stallman committed
239

240 241 242
An example is :
procedure Foo is
begin
243
>>>>>>>>>>null;"
244
  :type 'integer  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
245

246 247 248
(defcustom ada-indent-after-return t
  "*Non-nil means automatically indent after RET or LFD."
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
249

250 251 252 253 254 255 256
(defcustom ada-indent-align-comments t
  "*Non-nil means align comments on previous line comments, if any.
If nil, indentation is calculated as usual.
Note that indentation is calculated only if `ada-indent-comment-as-code' is t.

For instance:
    A := 1;   --  A multi-line comment
257
	      --  aligned if ada-indent-align-comments is t"
258 259
  :type 'boolean :group 'ada)

260
(defcustom ada-indent-comment-as-code t
261
  "*Non-nil means indent comment lines as code.
Juanma Barranquero's avatar
Juanma Barranquero committed
262
A nil value means do not auto-indent comments."
263
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
264

265
(defcustom ada-indent-handle-comment-special nil
Juanma Barranquero's avatar
Juanma Barranquero committed
266
  "*Non-nil if comment lines should be handled specially inside parenthesis.
267 268
By default, if the line that contains the open parenthesis has some
text following it, then the following lines will be indented in the
Juanma Barranquero's avatar
Juanma Barranquero committed
269
same column as this text.  This will not be true if the first line is
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285
a comment and `ada-indent-handle-comment-special' is t.

type A is
  (   Value_1,    --  common behavior, when not a comment
      Value_2);

type A is
  (   --  `ada-indent-handle-comment-special' is nil
      Value_1,
      Value_2);

type A is
  (   --  `ada-indent-handle-comment-special' is non-nil
   Value_1,
   Value_2);"
  :type 'boolean :group 'ada)
286

287 288 289
(defcustom ada-indent-is-separate t
  "*Non-nil means indent 'is separate' or 'is abstract' if on a single line."
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
290

291 292
(defcustom ada-indent-record-rel-type 3
  "*Indentation for 'record' relative to 'type' or 'use'.
Richard M. Stallman's avatar
Richard M. Stallman committed
293

294 295
An example is:
   type A is
296
   >>>>>>>>>>>record"
297
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
298

299 300
(defcustom ada-indent-renames ada-broken-indent
  "*Indentation for renames relative to the matching function statement.
Juanma Barranquero's avatar
Juanma Barranquero committed
301 302
If `ada-indent-return' is null or negative, the indentation is done relative to
the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
303 304 305

An example is:
   function A (B : Integer)
306 307
       return C;
   >>>renames Foo;"
308 309
  :type 'integer :group 'ada)

310 311
(defcustom ada-indent-return 0
  "*Indentation for 'return' relative to the matching 'function' statement.
Juanma Barranquero's avatar
Juanma Barranquero committed
312 313
If `ada-indent-return' is null or negative, the indentation is done relative to
the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
Richard M. Stallman's avatar
Richard M. Stallman committed
314

315 316
An example is:
   function A (B : Integer)
317
   >>>>>return C;"
318
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
319

320 321 322
(defcustom ada-indent-to-open-paren t
  "*Non-nil means indent according to the innermost open parenthesis."
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
323

324
(defcustom ada-fill-comment-prefix "--  "
325
  "*Text inserted in the first columns when filling a comment paragraph.
326 327
Note: if you modify this variable, you will have to invoke `ada-mode'
again to take account of the new value."
328
  :type 'string :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
329

330 331
(defcustom ada-fill-comment-postfix " --"
  "*Text inserted at the end of each line when filling a comment paragraph.
Juanma Barranquero's avatar
Juanma Barranquero committed
332
Used by `ada-fill-comment-paragraph-postfix'."
333
  :type 'string :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
334

335 336
(defcustom ada-label-indent -4
  "*Number of columns to indent a label.
Richard M. Stallman's avatar
Richard M. Stallman committed
337

338 339 340
An example is:
procedure Foo is
begin
341
>>>>Label:
342 343

This is also used for <<..>> labels"
344
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
345 346

(defcustom ada-language-version 'ada95
347 348
  "*Ada language version; one of `ada83', `ada95', `ada2005'."
  :type '(choice (const ada83) (const ada95) (const ada2005)) :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
349

350
(defcustom ada-move-to-declaration nil
351
  "*Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to 'begin'."
352
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
353

354 355
(defcustom ada-popup-key '[down-mouse-3]
  "*Key used for binding the contextual menu.
356
If nil, no contextual menu is available."
Dave Love's avatar
Dave Love committed
357
  :type '(restricted-sexp :match-alternatives (stringp vectorp))
Dave Love's avatar
Dave Love committed
358
  :group 'ada)
359

360
(defcustom ada-search-directories
361 362 363 364
  (append '(".")
	  (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
	  '("/usr/adainclude" "/usr/local/adainclude"
	    "/opt/gnu/adainclude"))
365
  "*Default list of directories to search for Ada files.
Juanma Barranquero's avatar
Juanma Barranquero committed
366
See the description for the `ff-search-directories' variable.  This variable
367
is the initial value of `ada-search-directories-internal'."
368
  :type '(repeat (choice :tag "Directory"
369 370
			 (const :tag "default" nil)
			 (directory :format "%v")))
Richard M. Stallman's avatar
Richard M. Stallman committed
371
  :group 'ada)
372

373 374 375 376
(defvar ada-search-directories-internal ada-search-directories
  "Internal version of `ada-search-directories'.
Its value is the concatenation of the search path as read in the project file
and the standard runtime location, and the value of the user-defined
Juanma Barranquero's avatar
Juanma Barranquero committed
377
`ada-search-directories'.")
378

379
(defcustom ada-stmt-end-indent 0
380
  "*Number of columns to indent the end of a statement on a separate line.
381

382 383
An example is:
   if A = B
384
   >>>>then"
385
  :type 'integer :group 'ada)
386

387
(defcustom ada-tab-policy 'indent-auto
388
  "*Control the behavior of the TAB key.
389
Must be one of :
Juanma Barranquero's avatar
Juanma Barranquero committed
390
`indent-rigidly' : always adds `ada-indent' blanks at the beginning of the line.
391
`indent-auto'    : use indentation functions in this file.
392
`always-tab'     : do `indent-relative'."
393
  :type '(choice (const indent-auto)
394 395
		 (const indent-rigidly)
		 (const always-tab))
Richard M. Stallman's avatar
Richard M. Stallman committed
396
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
397

398 399 400 401 402
(defcustom ada-use-indent ada-broken-indent
  "*Indentation for the lines in a 'use' statement.

An example is:
   use Ada.Text_IO,
403
   >>>>Ada.Numerics;"
404 405
  :type 'integer :group 'ada)

406 407 408 409 410
(defcustom ada-when-indent 3
  "*Indentation for 'when' relative to 'exception' or 'case'.

An example is:
   case A is
411
   >>>>when B =>"
412 413
  :type 'integer :group 'ada)

414 415 416 417 418
(defcustom ada-with-indent ada-broken-indent
  "*Indentation for the lines in a 'with' statement.

An example is:
   with Ada.Text_IO,
419
   >>>>Ada.Numerics;"
420 421
  :type 'integer :group 'ada)

422
(defcustom ada-which-compiler 'gnat
423
  "*Name of the compiler to use.
424
This will determine what features are made available through the Ada mode.
425
The possible choices are:
426
`gnat': Use Ada Core Technologies' GNAT compiler.  Add some cross-referencing
427 428
    features.
`generic': Use a generic compiler."
429
  :type '(choice (const gnat)
430
		 (const generic))
Richard M. Stallman's avatar
Richard M. Stallman committed
431
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
432 433 434 435 436


;;; ---- end of user configurable variables


437
(defvar ada-body-suffixes '(".adb")
438 439
  "List of possible suffixes for Ada body files.
The extensions should include a `.' if needed.")
440 441

(defvar ada-spec-suffixes '(".ads")
442 443
  "List of possible suffixes for Ada spec files.
The extensions should include a `.' if needed.")
444

445
(defvar ada-mode-menu (make-sparse-keymap "Ada")
446
  "Menu for Ada mode.")
Richard M. Stallman's avatar
Richard M. Stallman committed
447

448
(defvar ada-mode-map (make-sparse-keymap)
449
  "Local keymap used for Ada mode.")
Richard M. Stallman's avatar
Richard M. Stallman committed
450

451 452 453 454 455 456 457
(defvar ada-mode-extra-map (make-sparse-keymap)
  "Keymap used for non-standard keybindings.")

;; default is C-c C-q because it's free in ada-mode-map
(defvar ada-mode-extra-prefix "\C-c\C-q"
  "Prefix key to access `ada-mode-extra-map' functions.")

458 459 460
(defvar ada-mode-abbrev-table nil
  "Local abbrev table for Ada mode.")

Richard M. Stallman's avatar
Richard M. Stallman committed
461 462 463
(defvar ada-mode-syntax-table nil
  "Syntax table to be used for editing Ada source code.")

464 465 466
(defvar ada-mode-symbol-syntax-table nil
  "Syntax table for Ada, where `_' is a word constituent.")

467
(eval-when-compile
468
  ;; These values are used in eval-when-compile expressions.
469 470 471 472 473 474 475 476 477 478
  (defconst ada-83-string-keywords
    '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin"
      "body" "case" "constant" "declare" "delay" "delta" "digits" "do"
      "else" "elsif" "end" "entry" "exception" "exit" "for" "function"
      "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new"
      "not" "null" "of" "or" "others" "out" "package" "pragma" "private"
      "procedure" "raise" "range" "record" "rem" "renames" "return"
      "reverse" "select" "separate" "subtype" "task" "terminate" "then"
      "type" "use" "when" "while" "with" "xor")
    "List of Ada 83 keywords.
479 480
Used to define `ada-*-keywords'.")

481 482 483
  (defconst ada-95-string-keywords
    '("abstract" "aliased" "protected" "requeue" "tagged" "until")
    "List of keywords new in Ada 95.
484 485
Used to define `ada-*-keywords'.")

486 487 488 489
  (defconst ada-2005-string-keywords
    '("interface" "overriding" "synchronized")
    "List of keywords new in Ada 2005.
Used to define `ada-*-keywords.'"))
490 491 492 493 494

(defvar ada-ret-binding nil
  "Variable to save key binding of RET when casing is activated.")

(defvar ada-case-exception '()
495
  "Alist of words (entities) that have special casing.")
496

497 498 499
(defvar ada-case-exception-substring '()
  "Alist of substrings (entities) that have special casing.
The substrings are detected for word constituant when the word
Juanma Barranquero's avatar
Juanma Barranquero committed
500
is not itself in `ada-case-exception', and only for substrings that
501 502
either are at the beginning or end of the word, or start after '_'.")

503 504 505 506
(defvar ada-lfd-binding nil
  "Variable to save key binding of LFD when casing is activated.")

(defvar ada-other-file-alist nil
Juanma Barranquero's avatar
Juanma Barranquero committed
507
  "Variable used by `find-file' to find the name of the other package.
508
See `ff-other-file-alist'.")
509

510 511 512 513 514
(defvar ada-align-list
    '(("[^:]\\(\\s-*\\):[^:]" 1 t)
      ("[^=]\\(\\s-+\\)=[^=]" 1 t)
      ("\\(\\s-*\\)use\\s-" 1)
      ("\\(\\s-*\\)--" 1))
515
    "Ada support for align.el <= 2.2.
516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535
This variable provides regular expressions on which to align different lines.
See `align-mode-alist' for more information.")

(defvar ada-align-modes
  '((ada-declaration
     (regexp  . "[^:]\\(\\s-*\\):[^:]")
     (valid   . (lambda() (not (ada-in-comment-p))))
     (modes   . '(ada-mode)))
    (ada-assignment
     (regexp  . "[^=]\\(\\s-+\\)=[^=]")
     (valid   . (lambda() (not (ada-in-comment-p))))
     (modes   . '(ada-mode)))
    (ada-comment
     (regexp  . "\\(\\s-*\\)--")
     (modes   . '(ada-mode)))
    (ada-use
     (regexp  . "\\(\\s-*\\)use\\s-")
     (valid   . (lambda() (not (ada-in-comment-p))))
     (modes   . '(ada-mode)))
    )
536
  "Ada support for align.el >= 2.8.
537 538 539
This variable defines several rules to use to align different lines.")

(defconst ada-align-region-separate
540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558
  (eval-when-compile
    (concat
     "^\\s-*\\($\\|\\("
     "begin\\|"
     "declare\\|"
     "else\\|"
     "end\\|"
     "exception\\|"
     "for\\|"
     "function\\|"
     "generic\\|"
     "if\\|"
     "is\\|"
     "procedure\\|"
     "record\\|"
     "return\\|"
     "type\\|"
     "when"
     "\\)\\>\\)"))
Juanma Barranquero's avatar
Juanma Barranquero committed
559
  "See the variable `align-region-separate' for more information.")
560

561 562
;;; ---- Below are the regexp used in this package for parsing

Richard M. Stallman's avatar
Richard M. Stallman committed
563
(defconst ada-83-keywords
564 565
  (eval-when-compile
    (concat "\\<" (regexp-opt ada-83-string-keywords t) "\\>"))
566
  "Regular expression matching Ada83 keywords.")
Richard M. Stallman's avatar
Richard M. Stallman committed
567

568
(defconst ada-95-keywords
569 570
  (eval-when-compile
    (concat "\\<" (regexp-opt
571
		   (append
572
		    ada-95-string-keywords
573
		    ada-83-string-keywords) t) "\\>"))
574
  "Regular expression matching Ada95 keywords.")
Richard M. Stallman's avatar
Richard M. Stallman committed
575

576 577 578 579 580 581 582 583 584 585 586 587
(defconst ada-2005-keywords
  (eval-when-compile
    (concat "\\<" (regexp-opt
		   (append
		    ada-2005-string-keywords
		    ada-83-string-keywords
		    ada-95-string-keywords) t) "\\>"))
  "Regular expression matching Ada2005 keywords.")

(defvar ada-keywords ada-2005-keywords
  "Regular expression matching Ada keywords.")
;; FIXME: make this customizable
Richard M. Stallman's avatar
Richard M. Stallman committed
588

589 590
(defconst ada-ident-re
  "\\(\\sw\\|[_.]\\)+"
Richard M. Stallman's avatar
Richard M. Stallman committed
591
  "Regexp matching Ada (qualified) identifiers.")
592

593 594
;;  "with" needs to be included in the regexp, to match generic subprogram parameters
;;  Similarly, we put '[not] overriding' on the same line with 'procedure' etc.
Richard M. Stallman's avatar
Richard M. Stallman committed
595
(defvar ada-procedure-start-regexp
596
  (concat
597
   "^[ \t]*\\(with[ \t]+\\)?\\(\\(not[ \t]+\\)?overriding[ \t]+\\)?\\(procedure\\|function\\|task\\)[ \t\n]+"
598 599 600 601 602 603 604 605 606

   ;;  subprogram name: operator ("[+/=*]")
   "\\("
   "\\(\"[^\"]+\"\\)"

   ;;  subprogram name: name
   "\\|"
   "\\(\\(\\sw\\|[_.]\\)+\\)"
   "\\)")
607
  "Regexp matching Ada subprogram start.
608
The actual start is at (match-beginning 4).  The name is in (match-string 5).")
Richard M. Stallman's avatar
Richard M. Stallman committed
609

610
(defconst ada-name-regexp
611
  "\\([a-zA-Z][a-zA-Z0-9_.']*[a-zA-Z0-9]\\)"
612
  "Regexp matching a fully qualified name (including attribute).")
Richard M. Stallman's avatar
Richard M. Stallman committed
613

614 615 616 617
(defconst ada-package-start-regexp
  (concat "^[ \t]*\\(private[ \t]+\\)?\\(package\\)[ \t\n]+\\(body[ \t]*\\)?" ada-name-regexp)
  "Regexp matching start of package.
The package name is in (match-string 4).")
Richard M. Stallman's avatar
Richard M. Stallman committed
618

619 620 621 622 623
(defconst ada-compile-goto-error-file-linenr-re
  "\\([-_.a-zA-Z0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?"
  "Regexp matching filename:linenr[:column].")


Richard M. Stallman's avatar
Richard M. Stallman committed
624 625 626
;;; ---- regexps for indentation functions

(defvar ada-block-start-re
627 628
  (eval-when-compile
    (concat "\\<\\(" (regexp-opt '("begin" "declare" "else"
629 630 631
				   "exception" "generic" "loop" "or"
				   "private" "select" ))
	    "\\|\\(\\(limited\\|abstract\\|tagged\\)[ \t\n]+\\)*record\\)\\>"))
632
  "Regexp for keywords starting Ada blocks.")
Richard M. Stallman's avatar
Richard M. Stallman committed
633 634

(defvar ada-end-stmt-re
635 636
  (eval-when-compile
    (concat "\\("
637 638
	    ";"                                        "\\|"
	    "=>[ \t]*$"                                "\\|"
639
	    "=>[ \t]*--.*$"                            "\\|"
640 641 642 643 644 645 646 647
	    "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)"  "\\|"
	    "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
				"loop" "private" "record" "select"
				"then abort" "then") t) "\\>"  "\\|"
	    "^[ \t]*" (regexp-opt '("function" "package" "procedure")
				  t) "\\>\\(\\sw\\|[ \t_.]\\)+\\<is\\>"        "\\|"
	    "^[ \t]*exception\\>"
	    "\\)")                      )
Richard M. Stallman's avatar
Richard M. Stallman committed
648
  "Regexp of possible ends for a non-broken statement.
649
A new statement starts after these.")
Richard M. Stallman's avatar
Richard M. Stallman committed
650

651 652 653
(defvar ada-matching-start-re
  (eval-when-compile
    (concat "\\<"
654
	    (regexp-opt
655 656
	     '("end" "loop" "select" "begin" "case" "do" "declare"
	       "if" "task" "package" "procedure" "function" "record" "protected") t)
657
	    "\\>"))
Juanma Barranquero's avatar
Juanma Barranquero committed
658
  "Regexp used in `ada-goto-matching-start'.")
659 660 661 662

(defvar ada-matching-decl-start-re
  (eval-when-compile
    (concat "\\<"
663 664 665
	    (regexp-opt
	     '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
	    "\\>"))
Juanma Barranquero's avatar
Juanma Barranquero committed
666
  "Regexp used in `ada-goto-matching-decl-start'.")
667

Richard M. Stallman's avatar
Richard M. Stallman committed
668 669 670 671 672
(defvar ada-loop-start-re
  "\\<\\(for\\|while\\|loop\\)\\>"
  "Regexp for the start of a loop.")

(defvar ada-subprog-start-re
673 674
  (eval-when-compile
    (concat "\\<" (regexp-opt '("accept" "entry" "function" "package" "procedure"
675
				"protected" "task") t) "\\>"))
Richard M. Stallman's avatar
Richard M. Stallman committed
676 677
  "Regexp for the start of a subprogram.")

678
(defvar ada-named-block-re
679
  "[ \t]*\\(\\sw\\|_\\)+[ \t]*:[^=]"
680 681
  "Regexp of the name of a block or loop.")

682 683 684
(defvar ada-contextual-menu-on-identifier nil
  "Set to true when the right mouse button was clicked on an identifier.")

685 686 687 688
(defvar ada-contextual-menu-last-point nil
  "Position of point just before displaying the menu.
This is a list (point buffer).
Since `ada-popup-menu' moves the point where the user clicked, the region
Juanma Barranquero's avatar
Juanma Barranquero committed
689
is modified.  Therefore no command from the menu knows what the user selected
690 691 692 693 694
before displaying the contextual menu.
To get the original region, restore the point to this position before
calling `region-end' and `region-beginning'.
Modify this variable if you want to restore the point to another position.")

695 696
(easy-menu-define ada-contextual-menu nil
  "Menu to use when the user presses the right mouse button.
697 698
The variable `ada-contextual-menu-on-identifier' will be set to t before
displaying the menu if point was on an identifier."
699 700 701 702 703 704 705 706 707 708 709 710 711
  '("Ada"
    ["Goto Declaration/Body" ada-point-and-xref
     :included ada-contextual-menu-on-identifier]
    ["Goto Body" ada-point-and-xref-body
     :included ada-contextual-menu-on-identifier]
    ["Goto Previous Reference" ada-xref-goto-previous-reference]
    ["List References" ada-find-references
     :included ada-contextual-menu-on-identifier]
    ["List Local References" ada-find-local-references
      :included ada-contextual-menu-on-identifier]
    ["-"                nil nil]
    ["Other File"       ff-find-other-file]
    ["Goto Parent Unit" ada-goto-parent]))
712

Richard M. Stallman's avatar
Richard M. Stallman committed
713

714 715 716 717
;;------------------------------------------------------------------
;; Support for imenu  (see imenu.el)
;;------------------------------------------------------------------

718 719
(defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")

720
(defconst ada-imenu-subprogram-menu-re
721 722 723 724 725
  (concat "^[ \t]*\\(procedure\\|function\\)[ \t\n]+"
	  "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)"
	  ada-imenu-comment-re
	  "\\)[ \t\n]*"
	  "\\(return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?is[ \t\n]"))
726

727
(defvar ada-imenu-generic-expression
728
  (list
729
   (list nil ada-imenu-subprogram-menu-re 2)
730
   (list "*Specs*"
731 732 733 734
	 (concat
	  "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
	  "\\("
	  "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)"
735
	  ada-imenu-comment-re "\\)";; parameter list or simple space
736 737
	  "\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?"
	  "\\)?;") 2)
738
   '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
739
   '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2)
740 741
   '("*Protected*"
     "^[ \t]*protected[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
742
   '("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[ \t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1))
743
  "Imenu generic expression for Ada mode.
Juanma Barranquero's avatar
Juanma Barranquero committed
744
See `imenu-generic-expression'.  This variable will create several submenus for
745
each type of entity that can be found in an Ada file.")
746

747

748
;;------------------------------------------------------------
749
;;  Support for compile.el
750 751 752
;;------------------------------------------------------------

(defun ada-compile-mouse-goto-error ()
753
  "Mouse interface for `ada-compile-goto-error'."
754 755 756 757 758 759
  (interactive)
  (mouse-set-point last-input-event)
  (ada-compile-goto-error (point))
  )

(defun ada-compile-goto-error (pos)
Juanma Barranquero's avatar
Juanma Barranquero committed
760 761 762
  "Replace `compile-goto-error' from compile.el.
If POS is on a file and line location, go to this position.  It adds
to compile.el the capacity to go to a reference in an error message.
763
For instance, on these lines:
764
  foo.adb:61:11:  [...] in call to size declared at foo.ads:11
765 766
  foo.adb:61:11:  [...] in call to local declared at line 20
the 4 file locations can be clicked on and jumped to."
767 768 769 770 771 772
  (interactive "d")
  (goto-char pos)

  (skip-chars-backward "-a-zA-Z0-9_:./\\")
  (cond
   ;;  special case: looking at a filename:line not at the beginning of a line
773
   ;;  or a simple line reference "at line ..."
774
   ((and (not (bolp))
775 776 777 778 779 780 781 782 783 784 785 786 787 788
	 (or (looking-at ada-compile-goto-error-file-linenr-re)
	     (and
	      (save-excursion
		(beginning-of-line)
		(looking-at ada-compile-goto-error-file-linenr-re))
	      (save-excursion
		(if (looking-at "\\([0-9]+\\)") (backward-word 1))
		(looking-at "line \\([0-9]+\\)"))))
	     )
    (let ((line (if (match-beginning 2) (match-string 2) (match-string 1)))
	  (file (if (match-beginning 2) (match-string 1)
		  (save-excursion (beginning-of-line)
				  (looking-at ada-compile-goto-error-file-linenr-re)
				  (match-string 1))))
789 790
	  (error-pos (point-marker))
	  source)
791 792

      ;; set source marker
793
      (save-excursion
794 795
	(compilation-find-file (point-marker) (match-string 1) "./")
	(set-buffer file)
796

797 798
	(if (stringp line)
	    (goto-line (string-to-number line)))
799

800
	(setq source (point-marker)))
801 802 803

      (compilation-goto-locus error-pos source nil)

804 805 806 807
      ))

   ;; otherwise, default behavior
   (t
808
    (compile-goto-error))
809 810 811
   )
  (recenter))

812

813 814 815 816 817 818 819 820 821 822 823 824 825
;;-------------------------------------------------------------------------
;; Grammar related function
;; The functions below work with the syntax class of the characters in an Ada
;; buffer. Two syntax tables are created, depending on whether we want '_'
;; to be considered as part of a word or not.
;; Some characters may have multiple meanings depending on the context:
;;  - ' is either the beginning of a constant character or an attribute
;;  - # is either part of a based litteral or a gnatprep statement.
;;  - " starts a string, but not if inside a constant character.
;;  - ( and ) should be ignored if inside a constant character.
;; Thus their syntax property is changed automatically, and we can still use
;; the standard Emacs functions for sexp (see `ada-in-string-p')
;;
826 827 828 829 830 831
;; On Emacs, this is done through the `syntax-table' text property.  The
;; corresponding action is applied automatically each time the buffer
;; changes.  If `font-lock-mode' is enabled (the default) the action is
;; set up by `font-lock-syntactic-keywords'.  Otherwise, we do it
;; manually in `ada-after-change-function'.  The proper method is
;; installed by `ada-handle-syntax-table-properties'.
832 833 834 835 836 837 838 839 840
;;
;; on XEmacs, the `syntax-table' property does not exist and we have to use a
;; slow advice to `parse-partial-sexp' to do the same thing.
;; When executing parse-partial-sexp, we simply modify the strings before and
;; after, so that the special constants '"', '(' and ')' do not interact
;; with parse-partial-sexp.
;; Note: this code is slow and needs to be rewritten as soon as something
;; better is available on XEmacs.
;;-------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
841 842

(defun ada-create-syntax-table ()
843 844 845
  "Create the two syntax tables use in the Ada mode.
The standard table declares `_' as a symbol constituent, the second one
declares it as a word constituent."
846
  (interactive)
847
  (setq ada-mode-syntax-table (make-syntax-table))
Richard M. Stallman's avatar
Richard M. Stallman committed
848

849 850 851 852
  ;; define string brackets (`%' is alternative string bracket, but
  ;; almost never used as such and throws font-lock and indentation
  ;; off the track.)
  (modify-syntax-entry ?%  "$" ada-mode-syntax-table)
Richard M. Stallman's avatar
Richard M. Stallman committed
853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876
  (modify-syntax-entry ?\" "\"" ada-mode-syntax-table)

  (modify-syntax-entry ?:  "." ada-mode-syntax-table)
  (modify-syntax-entry ?\; "." ada-mode-syntax-table)
  (modify-syntax-entry ?&  "." ada-mode-syntax-table)
  (modify-syntax-entry ?\|  "." ada-mode-syntax-table)
  (modify-syntax-entry ?+  "." ada-mode-syntax-table)
  (modify-syntax-entry ?*  "." ada-mode-syntax-table)
  (modify-syntax-entry ?/  "." ada-mode-syntax-table)
  (modify-syntax-entry ?=  "." ada-mode-syntax-table)
  (modify-syntax-entry ?<  "." ada-mode-syntax-table)
  (modify-syntax-entry ?>  "." ada-mode-syntax-table)
  (modify-syntax-entry ?$ "." ada-mode-syntax-table)
  (modify-syntax-entry ?\[ "." ada-mode-syntax-table)
  (modify-syntax-entry ?\] "." ada-mode-syntax-table)
  (modify-syntax-entry ?\{ "." ada-mode-syntax-table)
  (modify-syntax-entry ?\} "." ada-mode-syntax-table)
  (modify-syntax-entry ?. "." ada-mode-syntax-table)
  (modify-syntax-entry ?\\ "." ada-mode-syntax-table)
  (modify-syntax-entry ?\' "." ada-mode-syntax-table)

  ;; a single hyphen is punctuation, but a double hyphen starts a comment
  (modify-syntax-entry ?-  ". 12" ada-mode-syntax-table)

877 878
  ;; See the comment above on grammar related function for the special
  ;; setup for '#'.
879
  (if (featurep 'xemacs)
880 881 882
      (modify-syntax-entry ?#  "<" ada-mode-syntax-table)
    (modify-syntax-entry ?#  "$" ada-mode-syntax-table))

Richard M. Stallman's avatar
Richard M. Stallman committed
883 884 885 886
  ;; and \f and \n end a comment
  (modify-syntax-entry ?\f  ">   " ada-mode-syntax-table)
  (modify-syntax-entry ?\n  ">   " ada-mode-syntax-table)

887
  ;; define what belongs in Ada symbols
Richard M. Stallman's avatar
Richard M. Stallman committed
888 889 890 891 892
  (modify-syntax-entry ?_ "_" ada-mode-syntax-table)

  ;; define parentheses to match
  (modify-syntax-entry ?\( "()" ada-mode-syntax-table)
  (modify-syntax-entry ?\) ")(" ada-mode-syntax-table)
893

894
  (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table))
895
  (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
Richard M. Stallman's avatar
Richard M. Stallman committed
896 897
  )

898 899
;;  Support of special characters in XEmacs (see the comments at the beginning
;;  of the section on Grammar related functions).
900

901
(if (featurep 'xemacs)
902
    (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants)
903
      "Handles special character constants and gnatprep statements."
904
      (let (change)
905 906 907 908 909 910 911 912 913 914 915 916 917