HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Sync to HEAD
[bpt/emacs.git] / lisp / progmodes / ada-mode.el
CommitLineData
3afbc435 1;;; ada-mode.el --- major-mode for editing Ada sources
972579f9 2
6b61353c 3;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001, 2002, 03, 2004
2be7dabc 4;; Free Software Foundation, Inc.
972579f9 5
7749c1a8
GM		 6;; Author: Rolf Ebert <ebert@inf.enst.fr>
7;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
8;; Emmanuel Briot <briot@gnat.com>
9;; Maintainer: Emmanuel Briot <briot@gnat.com>
f7a80909 10;; Ada Core Technologies's version: Revision: 1.188
7749c1a8 11;; Keywords: languages ada
d03b8a2d 12
3afbc435 13;; This file is part of GNU Emacs.
972579f9 14
2be7dabc 15;; GNU Emacs is free software; you can redistribute it and/or modify
972579f9
RS		 16;; it under the terms of the GNU General Public License as published by
17;; the Free Software Foundation; either version 2, or (at your option)
18;; any later version.
19
2be7dabc 20;; GNU Emacs is distributed in the hope that it will be useful,
972579f9
RS		 21;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23;; GNU General Public License for more details.
24
25;; You should have received a copy of the GNU General Public License
2be7dabc
GM		 26;; along with GNU Emacs; see the file COPYING. If not, write to the
27;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28;; Boston, MA 02111-1307, USA.
7749c1a8
GM		 29
30;;; Commentary:
31;;; This mode is a major mode for editing Ada83 and Ada95 source code.
4cc7e498 32;;; This is a major rewrite of the file packaged with Emacs-20. The
f7a80909 33;;; ada-mode is composed of four lisp files, ada-mode.el, ada-xref.el,
7749c1a8 34;;; ada-prj.el and ada-stmt.el. Only this file (ada-mode.el) is
655880d2 35;;; completely independent from the GNU Ada compiler Gnat, distributed
7749c1a8 36;;; by Ada Core Technologies. All the other files rely heavily on
5dab0769 37;;; features provided only by Gnat.
972579f9 38;;;
7749c1a8
GM		 39;;; Note: this mode will not work with Emacs 19. If you are on a VMS
40;;; system, where the latest version of Emacs is 19.28, you will need
41;;; another file, called ada-vms.el, that provides some required
42;;; functions.
43
44;;; Usage:
45;;; Emacs should enter Ada mode automatically when you load an Ada file.
46;;; By default, the valid extensions for Ada files are .ads, .adb or .ada
47;;; If the ada-mode does not start automatically, then simply type the
48;;; following command :
49;;; M-x ada-mode
50;;;
51;;; By default, ada-mode is configured to take full advantage of the GNAT
52;;; compiler (the menus will include the cross-referencing features,...).
53;;; If you are using another compiler, you might want to set the following
54;;; variable in your .emacs (Note: do not set this in the ada-mode-hook, it
55;;; won't work) :
56;;; (setq ada-which-compiler 'generic)
57;;;
58;;; This mode requires find-file.el to be present on your system.
972579f9 59
7749c1a8 60;;; History:
3ca7b46f
KH		 61;;; The first Ada mode for GNU Emacs was written by V. Broman in
62;;; 1985. He based his work on the already existing Modula-2 mode.
63;;; This was distributed as ada.el in versions of Emacs prior to 19.29.
972579f9
RS		 64;;;
65;;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of
66;;; several files with support for dired commands and other nice
67;;; things. It is currently available from the PAL
68;;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z.
69;;;
70;;; The probably very first Ada mode (called electric-ada.el) was
71;;; written by Steven D. Litvintchouk and Steven M. Rosen for the
72;;; Gosling Emacs. L. Slater based his development on ada.el and
73;;; electric-ada.el.
74;;;
7749c1a8
GM		 75;;; A complete rewrite by M. Heritsch and R. Ebert has been done.
76;;; Some ideas from the Ada mode mailing list have been
972579f9
RS		 77;;; added. Some of the functionality of L. Slater's mode has not
78;;; (yet) been recoded in this new mode. Perhaps you prefer sticking
79;;; to his version.
972579f9 80;;;
7749c1a8
GM		 81;;; A complete rewrite for Emacs-20 / Gnat-3.11 has been done by Ada Core
82;;; Technologies. Please send bugs to briot@gnat.com
83
84;;; Credits:
85;;; Many thanks to John McCabe <john@assen.demon.co.uk> for sending so
86;;; many patches included in this package.
87;;; Christian Egli <Christian.Egli@hcsd.hac.com>:
88;;; ada-imenu-generic-expression
89;;; Many thanks also to the following persons that have contributed one day
90;;; to the ada-mode
91;;; Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular,
92;;; woodruff@stc.llnl.gov (John Woodruff)
93;;; jj@ddci.dk (Jesper Joergensen)
94;;; gse@ocsystems.com (Scott Evans)
95;;; comar@gnat.com (Cyrille Comar)
96;;; stephen.leake@gsfc.nasa.gov (Stephen Leake)
4607c7f4 97;;; robin-reply@reagans.org
f139ce87 98;;; and others for their valuable hints.
972579f9 99
7749c1a8 100;;; Code:
4cc7e498 101;;; Note: Every function in this package is compiler-independent.
7749c1a8 102;;; The names start with ada-
655880d2 103;;; The variables that the user can edit can all be modified through
7749c1a8
GM		 104;;; the customize mode. They are sorted in alphabetical order in this
105;;; file.
106
4607c7f4
SM		 107;;; Supported packages.
108;;; This package supports a number of other Emacs modes. These other modes
109;;; should be loaded before the ada-mode, which will then setup some variables
110;;; to improve the support for Ada code.
111;;; Here is the list of these modes:
112;;; `which-function-mode': Display the name of the subprogram the cursor is
113;;; in in the mode line.
114;;; `outline-mode': Provides the capability to collapse or expand the code
115;;; for specific language constructs, for instance if you want to hide the
116;;; code corresponding to a subprogram
117;;; `align': This mode is now provided with Emacs 21, but can also be
118;;; installed manually for older versions of Emacs. It provides the
119;;; capability to automatically realign the selected region (for instance
120;;; all ':=', ':' and '--' will be aligned on top of each other.
121;;; `imenu': Provides a menu with the list of entities defined in the current
122;;; buffer, and an easy way to jump to any of them
123;;; `speedbar': Provides a separate file browser, and the capability for each
124;;; file to see the list of entities defined in it and to jump to them
125;;; easily
126;;; `abbrev-mode': Provides the capability to define abbreviations, which
127;;; are automatically expanded when you type them. See the Emacs manual.
128
6f9a2614
JB		 129(eval-when-compile
130 (require 'ispell nil t)
131 (require 'find-file nil t)
132 (require 'align nil t)
133 (require 'which-func nil t)
134 (require 'compile nil t))
7749c1a8
GM		 135
136;; this function is needed at compile time
137(eval-and-compile
655880d2
GM		 138 (defun ada-check-emacs-version (major minor &optional is-xemacs)
139 "Returns t if Emacs's version is greater or equal to MAJOR.MINOR.
140If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
141 (let ((xemacs-running (or (string-match "Lucid" emacs-version)
4cc7e498 142 (string-match "XEmacs" emacs-version))))
655880d2 143 (and (or (and is-xemacs xemacs-running)
4cc7e498
GM		 144 (not (or is-xemacs xemacs-running)))
145 (or (> emacs-major-version major)
146 (and (= emacs-major-version major)
147 (>= emacs-minor-version minor)))))))
148
7749c1a8 149
7749c1a8 150;; This call should not be made in the release that is done for the
7aeff5ab 151;; official Emacs, since it does nothing useful for the latest version
f7a80909
JB		 152;;(if (not (ada-check-emacs-version 21 1))
153;; (require 'ada-support))
52748d95 154
7749c1a8
GM		 155(defvar ada-mode-hook nil
156 "*List of functions to call when Ada mode is invoked.
f7a80909 157This hook is automatically executed after the `ada-mode' is
7749c1a8
GM		 158fully loaded.
159This is a good place to add Ada environment specific bindings.")
52748d95
RS		 160
161(defgroup ada nil
655880d2 162 "Major mode for editing Ada source in Emacs."
52748d95
RS		 163 :group 'languages)
164
7749c1a8
GM		 165(defcustom ada-auto-case t
166 "*Non-nil means automatically change case of preceding word while typing.
167Casing is done according to `ada-case-keyword', `ada-case-identifier'
168and `ada-case-attribute'."
169 :type 'boolean :group 'ada)
972579f9 170
7749c1a8
GM		 171(defcustom ada-broken-decl-indent 0
172 "*Number of columns to indent a broken declaration.
173
174An example is :
175 declare
176 A,
177 >>>>>B : Integer; -- from ada-broken-decl-indent"
178 :type 'integer :group 'ada)
972579f9 179
52748d95 180(defcustom ada-broken-indent 2
7749c1a8 181 "*Number of columns to indent the continuation of a broken line.
972579f9 182
7749c1a8
GM		 183An example is :
184 My_Var : My_Type := (Field1 =>
185 >>>>>>>>>Value); -- from ada-broken-indent"
186 :type 'integer :group 'ada)
972579f9 187
80d50f88
SM		 188(defcustom ada-continuation-indent ada-broken-indent
189 "*Number of columns to indent the continuation of broken lines in
190parenthesis.
191
192An example is :
193 Func (Param1,
194 >>>>>Param2);"
195 :type 'integer :group 'ada)
196
7749c1a8
GM		 197(defcustom ada-case-attribute 'ada-capitalize-word
198 "*Function to call to adjust the case of Ada attributes.
4cc7e498
GM		 199It may be `downcase-word', `upcase-word', `ada-loose-case-word',
200`ada-capitalize-word' or `ada-no-auto-case'."
7749c1a8
GM		 201 :type '(choice (const downcase-word)
202 (const upcase-word)
203 (const ada-capitalize-word)
4cc7e498
GM		 204 (const ada-loose-case-word)
205 (const ada-no-auto-case))
52748d95 206 :group 'ada)
972579f9 207
4607c7f4
SM		 208(defcustom ada-case-exception-file
209 (list (convert-standard-filename' "~/.emacs_case_exceptions"))
4cc7e498
GM		 210 "*List of special casing exceptions dictionaries for identifiers.
211The first file is the one where new exceptions will be saved by Emacs
212when you call `ada-create-case-exception'.
213
214These files should contain one word per line, that gives the casing
4607c7f4
SM		 215to be used for that word in Ada files. If the line starts with the
216character *, then the exception will be used for substrings that either
217start at the beginning of a word or after a _ character, and end either
218at the end of the word or at a _ character. Each line can be terminated by
4cc7e498
GM		 219a comment."
220 :type '(repeat (file))
221 :group 'ada)
972579f9 222
7749c1a8 223(defcustom ada-case-keyword 'downcase-word
655880d2 224 "*Function to call to adjust the case of an Ada keywords.
7749c1a8
GM		 225It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
226`ada-capitalize-word'."
227 :type '(choice (const downcase-word)
228 (const upcase-word)
229 (const ada-capitalize-word)
4cc7e498
GM		 230 (const ada-loose-case-word)
231 (const ada-no-auto-case))
52748d95 232 :group 'ada)
972579f9 233
7749c1a8
GM		 234(defcustom ada-case-identifier 'ada-loose-case-word
235 "*Function to call to adjust the case of an Ada identifier.
236It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
237`ada-capitalize-word'."
238 :type '(choice (const downcase-word)
239 (const upcase-word)
240 (const ada-capitalize-word)
4cc7e498
GM		 241 (const ada-loose-case-word)
242 (const ada-no-auto-case))
52748d95 243 :group 'ada)
972579f9 244
7749c1a8 245(defcustom ada-clean-buffer-before-saving t
655880d2 246 "*Non-nil means remove trailing spaces and untabify the buffer before saving."
7749c1a8 247 :type 'boolean :group 'ada)
972579f9 248
7749c1a8
GM		 249(defcustom ada-indent 3
250 "*Size of Ada indentation.
972579f9 251
7749c1a8
GM		 252An example is :
253procedure Foo is
254begin
255>>>>>>>>>>null; -- from ada-indent"
256 :type 'integer :group 'ada)
972579f9 257
7749c1a8
GM		 258(defcustom ada-indent-after-return t
259 "*Non-nil means automatically indent after RET or LFD."
260 :type 'boolean :group 'ada)
972579f9 261
4cc7e498
GM		 262(defcustom ada-indent-align-comments t
263 "*Non-nil means align comments on previous line comments, if any.
264If nil, indentation is calculated as usual.
265Note that indentation is calculated only if `ada-indent-comment-as-code' is t.
266
267For instance:
268 A := 1; -- A multi-line comment
269 -- aligned if ada-indent-align-comments is t"
270 :type 'boolean :group 'ada)
271
7749c1a8 272(defcustom ada-indent-comment-as-code t
4cc7e498 273 "*Non-nil means indent comment lines as code.
f0529b5b 274nil means do not auto-indent comments."
7749c1a8 275 :type 'boolean :group 'ada)
972579f9 276
4607c7f4
SM		 277(defcustom ada-indent-handle-comment-special nil
278 "*Non-nil if comment lines should be handled specially inside
279parenthesis.
280By default, if the line that contains the open parenthesis has some
281text following it, then the following lines will be indented in the
282same column as this text. This will not be true if the first line is
283a comment and `ada-indent-handle-comment-special' is t.
284
285type A is
286 ( Value_1, -- common behavior, when not a comment
287 Value_2);
288
289type A is
290 ( -- `ada-indent-handle-comment-special' is nil
291 Value_1,
292 Value_2);
293
294type A is
295 ( -- `ada-indent-handle-comment-special' is non-nil
296 Value_1,
297 Value_2);"
298 :type 'boolean :group 'ada)
a1506d29 299
7749c1a8
GM		 300(defcustom ada-indent-is-separate t
301 "*Non-nil means indent 'is separate' or 'is abstract' if on a single line."
302 :type 'boolean :group 'ada)
972579f9 303
7749c1a8
GM		 304(defcustom ada-indent-record-rel-type 3
305 "*Indentation for 'record' relative to 'type' or 'use'.
52748d95 306
7749c1a8
GM		 307An example is:
308 type A is
309 >>>>>>>>>>>record -- from ada-indent-record-rel-type"
310 :type 'integer :group 'ada)
52748d95 311
4cc7e498
GM		 312(defcustom ada-indent-renames ada-broken-indent
313 "*Indentation for renames relative to the matching function statement.
314If ada-indent-return is null or negative, the indentation is done relative to
315the open parenthesis (if there is no parenthesis, ada-broken-indent is used).
316
317An example is:
318 function A (B : Integer)
319 return C; -- from ada-indent-return
320 >>>renames Foo; -- from ada-indent-renames"
321 :type 'integer :group 'ada)
322
7749c1a8
GM		 323(defcustom ada-indent-return 0
324 "*Indentation for 'return' relative to the matching 'function' statement.
325If ada-indent-return is null or negative, the indentation is done relative to
655880d2 326the open parenthesis (if there is no parenthesis, ada-broken-indent is used).
52748d95 327
7749c1a8
GM		 328An example is:
329 function A (B : Integer)
330 >>>>>return C; -- from ada-indent-return"
331 :type 'integer :group 'ada)
52748d95 332
7749c1a8
GM		 333(defcustom ada-indent-to-open-paren t
334 "*Non-nil means indent according to the innermost open parenthesis."
335 :type 'boolean :group 'ada)
52748d95 336
5ebcaf36 337(defcustom ada-fill-comment-prefix "-- "
7749c1a8 338 "*Text inserted in the first columns when filling a comment paragraph.
10bcf543
RS		 339Note: if you modify this variable, you will have to invoke `ada-mode'
340again to take account of the new value."
7749c1a8 341 :type 'string :group 'ada)
52748d95 342
7749c1a8
GM		 343(defcustom ada-fill-comment-postfix " --"
344 "*Text inserted at the end of each line when filling a comment paragraph.
345with `ada-fill-comment-paragraph-postfix'."
346 :type 'string :group 'ada)
52748d95 347
7749c1a8
GM		 348(defcustom ada-label-indent -4
349 "*Number of columns to indent a label.
52748d95 350
7749c1a8
GM		 351An example is:
352procedure Foo is
353begin
80d50f88
SM		 354>>>>>>>>>>>>Label: -- from ada-label-indent
355
356This is also used for <<..>> labels"
7749c1a8 357 :type 'integer :group 'ada)
52748d95
RS		 358
359(defcustom ada-language-version 'ada95
360 "*Do we program in `ada83' or `ada95'?"
7749c1a8 361 :type '(choice (const ada83) (const ada95)) :group 'ada)
52748d95 362
7749c1a8 363(defcustom ada-move-to-declaration nil
655880d2 364 "*Non-nil means `ada-move-to-start' moves point to the subprogram declaration,
7749c1a8
GM		 365not to 'begin'."
366 :type 'boolean :group 'ada)
972579f9 367
7749c1a8
GM		 368(defcustom ada-popup-key '[down-mouse-3]
369 "*Key used for binding the contextual menu.
4cc7e498 370If nil, no contextual menu is available."
7c5fd355 371 :type '(restricted-sexp :match-alternatives (stringp vectorp))
50a8310e 372 :group 'ada)
cadd3658 373
7749c1a8 374(defcustom ada-search-directories
f7a80909
JB		 375 (append '(".")
376 (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
377 '("/usr/adainclude" "/usr/local/adainclude"
378 "/opt/gnu/adainclude"))
655880d2 379 "*List of directories to search for Ada files.
6f9a2614
JB		 380See the description for the `ff-search-directories' variable. This variable
381is the initial value of this variable, and is copied and modified in
382`ada-search-directories-internal'."
7749c1a8
GM		 383 :type '(repeat (choice :tag "Directory"
384 (const :tag "default" nil)
385 (directory :format "%v")))
52748d95 386 :group 'ada)
cadd3658 387
6f9a2614
JB		 388(defvar ada-search-directories-internal ada-search-directories
389 "Internal version of `ada-search-directories'.
390Its value is the concatenation of the search path as read in the project file
391and the standard runtime location, and the value of the user-defined
392ada-search-directories.")
393
7749c1a8 394(defcustom ada-stmt-end-indent 0
655880d2 395 "*Number of columns to indent the end of a statement on a separate line.
cadd3658 396
7749c1a8
GM		 397An example is:
398 if A = B
399 >>>>>>>>>>>then -- from ada-stmt-end-indent"
400 :type 'integer :group 'ada)
cadd3658 401
7749c1a8 402(defcustom ada-tab-policy 'indent-auto
655880d2 403 "*Control the behavior of the TAB key.
7749c1a8
GM		 404Must be one of :
405`indent-rigidly' : always adds ada-indent blanks at the beginning of the line.
406`indent-auto' : use indentation functions in this file.
407`always-tab' : do indent-relative."
408 :type '(choice (const indent-auto)
409 (const indent-rigidly)
410 (const always-tab))
52748d95 411 :group 'ada)
972579f9 412
4cc7e498
GM		 413(defcustom ada-use-indent ada-broken-indent
414 "*Indentation for the lines in a 'use' statement.
415
416An example is:
417 use Ada.Text_IO,
418 >>>>>Ada.Numerics; -- from ada-use-indent"
419 :type 'integer :group 'ada)
420
7749c1a8
GM		 421(defcustom ada-when-indent 3
422 "*Indentation for 'when' relative to 'exception' or 'case'.
423
424An example is:
425 case A is
655880d2 426 >>>>>>>>when B => -- from ada-when-indent"
7749c1a8
GM		 427 :type 'integer :group 'ada)
428
4cc7e498
GM		 429(defcustom ada-with-indent ada-broken-indent
430 "*Indentation for the lines in a 'with' statement.
431
432An example is:
433 with Ada.Text_IO,
434 >>>>>Ada.Numerics; -- from ada-with-indent"
435 :type 'integer :group 'ada)
436
7749c1a8 437(defcustom ada-which-compiler 'gnat
655880d2
GM		 438 "*Name of the compiler to use.
439This will determine what features are made available through the ada-mode.
440The possible choices are :
7749c1a8
GM		 441`gnat': Use Ada Core Technologies' Gnat compiler. Add some cross-referencing
442 features
443`generic': Use a generic compiler"
444 :type '(choice (const gnat)
445 (const generic))
52748d95 446 :group 'ada)
972579f9 447
972579f9
RS		 448
449;;; ---- end of user configurable variables
450\f
451
7749c1a8 452(defvar ada-body-suffixes '(".adb")
655880d2
GM		 453 "List of possible suffixes for Ada body files.
454The extensions should include a `.' if needed.")
7749c1a8
GM		 455
456(defvar ada-spec-suffixes '(".ads")
655880d2
GM		 457 "List of possible suffixes for Ada spec files.
458The extensions should include a `.' if needed.")
7749c1a8 459
88127f30 460(defvar ada-mode-menu (make-sparse-keymap "Ada")
655880d2 461 "Menu for ada-mode.")
972579f9 462
7749c1a8 463(defvar ada-mode-map (make-sparse-keymap)
cadd3658 464 "Local keymap used for Ada mode.")
972579f9 465
4cc7e498
GM		 466(defvar ada-mode-abbrev-table nil
467 "Local abbrev table for Ada mode.")
468
972579f9
RS		 469(defvar ada-mode-syntax-table nil
470 "Syntax table to be used for editing Ada source code.")
471
f139ce87
KH		 472(defvar ada-mode-symbol-syntax-table nil
473 "Syntax table for Ada, where `_' is a word constituent.")
474
7749c1a8
GM		 475(eval-when-compile
476 (defconst ada-83-string-keywords
477 '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin"
478 "body" "case" "constant" "declare" "delay" "delta" "digits" "do"
479 "else" "elsif" "end" "entry" "exception" "exit" "for" "function"
480 "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new"
481 "not" "null" "of" "or" "others" "out" "package" "pragma" "private"
482 "procedure" "raise" "range" "record" "rem" "renames" "return"
483 "reverse" "select" "separate" "subtype" "task" "terminate" "then"
484 "type" "use" "when" "while" "with" "xor")
655880d2
GM		 485 "List of Ada keywords.
486This variable is used to define `ada-83-keywords' and `ada-95-keywords'"))
7749c1a8
GM		 487
488(defvar ada-ret-binding nil
489 "Variable to save key binding of RET when casing is activated.")
490
491(defvar ada-case-exception '()
655880d2 492 "Alist of words (entities) that have special casing.")
7749c1a8 493
4607c7f4
SM		 494(defvar ada-case-exception-substring '()
495 "Alist of substrings (entities) that have special casing.
496The substrings are detected for word constituant when the word
497is not itself in ada-case-exception, and only for substrings that
498either are at the beginning or end of the word, or start after '_'.")
499
7749c1a8
GM		 500(defvar ada-lfd-binding nil
501 "Variable to save key binding of LFD when casing is activated.")
502
503(defvar ada-other-file-alist nil
504 "Variable used by find-file to find the name of the other package.
655880d2 505See `ff-other-file-alist'.")
7749c1a8 506
4607c7f4
SM		 507(defvar ada-align-list
508 '(("[^:]\\(\\s-*\\):[^:]" 1 t)
509 ("[^=]\\(\\s-+\\)=[^=]" 1 t)
510 ("\\(\\s-*\\)use\\s-" 1)
511 ("\\(\\s-*\\)--" 1))
512 "Ada support for align.el <= 2.2
513This variable provides regular expressions on which to align different lines.
514See `align-mode-alist' for more information.")
515
516(defvar ada-align-modes
517 '((ada-declaration
518 (regexp . "[^:]\\(\\s-*\\):[^:]")
519 (valid . (lambda() (not (ada-in-comment-p))))
520 (modes . '(ada-mode)))
521 (ada-assignment
522 (regexp . "[^=]\\(\\s-+\\)=[^=]")
523 (valid . (lambda() (not (ada-in-comment-p))))
524 (modes . '(ada-mode)))
525 (ada-comment
526 (regexp . "\\(\\s-*\\)--")
527 (modes . '(ada-mode)))
528 (ada-use
529 (regexp . "\\(\\s-*\\)use\\s-")
530 (valid . (lambda() (not (ada-in-comment-p))))
531 (modes . '(ada-mode)))
532 )
533 "Ada support for align.el >= 2.8
534This variable defines several rules to use to align different lines.")
535
536(defconst ada-align-region-separate
537 (concat
538 "^\\s-*\\($\\|\\("
539 "begin\\|"
540 "declare\\|"
541 "else\\|"
542 "end\\|"
543 "exception\\|"
544 "for\\|"
545 "function\\|"
546 "generic\\|"
547 "if\\|"
548 "is\\|"
549 "procedure\\|"
550 "record\\|"
551 "return\\|"
552 "type\\|"
553 "when"
554 "\\)\\>\\)")
555 "see the variable `align-region-separate' for more information.")
556
7749c1a8
GM		 557;;; ---- Below are the regexp used in this package for parsing
558
972579f9 559(defconst ada-83-keywords
7749c1a8
GM		 560 (eval-when-compile
561 (concat "\\<" (regexp-opt ada-83-string-keywords t) "\\>"))
cadd3658 562 "Regular expression for looking at Ada83 keywords.")
972579f9 563
f139ce87 564(defconst ada-95-keywords
7749c1a8
GM		 565 (eval-when-compile
566 (concat "\\<" (regexp-opt
567 (append
568 '("abstract" "aliased" "protected" "requeue"
569 "tagged" "until")
570 ada-83-string-keywords) t) "\\>"))
cadd3658 571 "Regular expression for looking at Ada95 keywords.")
972579f9 572
f139ce87 573(defvar ada-keywords ada-95-keywords
5e1cecee 574 "Regular expression for looking at Ada keywords.")
972579f9 575
7749c1a8
GM		 576(defconst ada-ident-re
577 "\\(\\sw\\|[_.]\\)+"
276c1210 578 "Regexp matching Ada (qualified) identifiers.")
f139ce87 579
4607c7f4
SM		 580;; "with" needs to be included in the regexp, so that we can insert new lines
581;; after the declaration of the parameter for a generic.
972579f9 582(defvar ada-procedure-start-regexp
4607c7f4
SM		 583 (concat
584 "^[ \t]*\\(with[ \t]+\\)?\\(procedure\\|function\\|task\\)[ \t\n]+"
585
586 ;; subprogram name: operator ("[+/=*]")
587 "\\("
588 "\\(\"[^\"]+\"\\)"
589
590 ;; subprogram name: name
591 "\\|"
592 "\\(\\(\\sw\\|[_.]\\)+\\)"
593 "\\)")
972579f9
RS		 594 "Regexp used to find Ada procedures/functions.")
595
596(defvar ada-package-start-regexp
597 "^[ \t]*\\(package\\)"
655880d2 598 "Regexp used to find Ada packages.")
972579f9
RS		 599
600
601;;; ---- regexps for indentation functions
602
603(defvar ada-block-start-re
7749c1a8
GM		 604 (eval-when-compile
605 (concat "\\<\\(" (regexp-opt '("begin" "declare" "else"
606 "exception" "generic" "loop" "or"
607 "private" "select" ))
608 "\\|\\(\\(limited\\|abstract\\|tagged\\)[ \t\n]+\\)*record\\)\\>"))
5e1cecee 609 "Regexp for keywords starting Ada blocks.")
972579f9
RS		 610
611(defvar ada-end-stmt-re
7749c1a8
GM		 612 (eval-when-compile
613 (concat "\\("
614 ";" "\\|"
615 "=>[ \t]*$" "\\|"
616 "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)" "\\|"
4cc7e498
GM		 617 "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
618 "loop" "private" "record" "select"
619 "then abort" "then") t) "\\>" "\\|"
7749c1a8
GM		 620 "^[ \t]*" (regexp-opt '("function" "package" "procedure")
621 t) "\\>\\(\\sw\\|[ \t_.]\\)+\\<is\\>" "\\|"
622 "^[ \t]*exception\\>"
623 "\\)") )
972579f9 624 "Regexp of possible ends for a non-broken statement.
5e1cecee 625A new statement starts after these.")
972579f9 626
7749c1a8
GM		 627(defvar ada-matching-start-re
628 (eval-when-compile
629 (concat "\\<"
630 (regexp-opt
631 '("end" "loop" "select" "begin" "case" "do"
632 "if" "task" "package" "record" "protected") t)
633 "\\>"))
655880d2 634 "Regexp used in ada-goto-matching-start.")
7749c1a8
GM		 635
636(defvar ada-matching-decl-start-re
637 (eval-when-compile
638 (concat "\\<"
639 (regexp-opt
4cc7e498 640 '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
7749c1a8 641 "\\>"))
655880d2 642 "Regexp used in ada-goto-matching-decl-start.")
7749c1a8 643
972579f9
RS		 644(defvar ada-loop-start-re
645 "\\<\\(for\\|while\\|loop\\)\\>"
646 "Regexp for the start of a loop.")
647
648(defvar ada-subprog-start-re
7749c1a8
GM		 649 (eval-when-compile
650 (concat "\\<" (regexp-opt '("accept" "entry" "function" "package" "procedure"
651 "protected" "task") t) "\\>"))
972579f9
RS		 652 "Regexp for the start of a subprogram.")
653
cadd3658 654(defvar ada-named-block-re
7749c1a8 655 "[ \t]*\\(\\sw\\|_\\)+[ \t]*:[^=]"
cadd3658
RS		 656 "Regexp of the name of a block or loop.")
657
655880d2
GM		 658(defvar ada-contextual-menu-on-identifier nil
659 "Set to true when the right mouse button was clicked on an identifier.")
660
4cc7e498
GM		 661(defvar ada-contextual-menu-last-point nil
662 "Position of point just before displaying the menu.
663This is a list (point buffer).
664Since `ada-popup-menu' moves the point where the user clicked, the region
665is modified. Therefore no command from the menu knows what the user selected
666before displaying the contextual menu.
667To get the original region, restore the point to this position before
668calling `region-end' and `region-beginning'.
669Modify this variable if you want to restore the point to another position.")
670
f7a80909
JB		 671(easy-menu-define ada-contextual-menu nil
672 "Menu to use when the user presses the right mouse button.
4cc7e498
GM		 673The variable `ada-contextual-menu-on-identifier' will be set to t before
674displaying the menu if point was on an identifier."
f7a80909
JB		 675 '("Ada"
676 ["Goto Declaration/Body" ada-point-and-xref
677 :included ada-contextual-menu-on-identifier]
678 ["Goto Body" ada-point-and-xref-body
679 :included ada-contextual-menu-on-identifier]
680 ["Goto Previous Reference" ada-xref-goto-previous-reference]
681 ["List References" ada-find-references
682 :included ada-contextual-menu-on-identifier]
683 ["List Local References" ada-find-local-references
684 :included ada-contextual-menu-on-identifier]
685 ["-" nil nil]
686 ["Other File" ff-find-other-file]
687 ["Goto Parent Unit" ada-goto-parent]))
7749c1a8 688
972579f9 689\f
7749c1a8
GM		 690;;------------------------------------------------------------------
691;; Support for imenu (see imenu.el)
692;;------------------------------------------------------------------
693
4607c7f4
SM		 694(defconst ada-imenu-comment-re "\\([ \t]*--.*\\)?")
695
4cc7e498 696(defconst ada-imenu-subprogram-menu-re
4607c7f4
SM		 697 (concat "^[ \t]*\\(procedure\\|function\\)[ \t\n]+"
698 "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)"
699 ada-imenu-comment-re
700 "\\)[ \t\n]*"
701 "\\(return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?is[ \t\n]"))
4cc7e498 702
74480345 703(defvar ada-imenu-generic-expression
7749c1a8 704 (list
4cc7e498 705 (list nil ada-imenu-subprogram-menu-re 2)
7749c1a8
GM		 706 (list "*Specs*"
707 (concat
708 "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
709 "\\("
4607c7f4
SM		 710 "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)"
711 ada-imenu-comment-re "\\)";; parameter list or simple space
7749c1a8
GM		 712 "\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?"
713 "\\)?;") 2)
4607c7f4 714 '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
7749c1a8 715 '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2)
4607c7f4
SM		 716 '("*Protected*"
717 "^[ \t]*protected[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
7749c1a8 718 '("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[ \t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1))
655880d2 719 "Imenu generic expression for Ada mode.
4607c7f4
SM		 720See `imenu-generic-expression'. This variable will create several submenus for
721each type of entity that can be found in an Ada file.")
4cc7e498 722
74480345 723\f
7749c1a8 724;;------------------------------------------------------------
655880d2 725;; Support for compile.el
7749c1a8
GM		 726;;------------------------------------------------------------
727
728(defun ada-compile-mouse-goto-error ()
4cc7e498 729 "Mouse interface for ada-compile-goto-error."
7749c1a8
GM		 730 (interactive)
731 (mouse-set-point last-input-event)
732 (ada-compile-goto-error (point))
733 )
734
735(defun ada-compile-goto-error (pos)
655880d2
GM		 736 "Replaces `compile-goto-error' from compile.el.
737If POS is on a file and line location, go to this position. It adds to
738compile.el the capacity to go to a reference in an error message.
7749c1a8 739For instance, on this line:
655880d2
GM		 740 foo.adb:61:11: [...] in call to size declared at foo.ads:11
741both file locations can be clicked on and jumped to."
7749c1a8
GM		 742 (interactive "d")
743 (goto-char pos)
744
745 (skip-chars-backward "-a-zA-Z0-9_:./\\")
746 (cond
747 ;; special case: looking at a filename:line not at the beginning of a line
748 ((and (not (bolp))
4cc7e498
GM		 749 (looking-at
750 "\\([-_.a-zA-Z0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?"))
751 (let ((line (match-string 2))
f7a80909 752 file
7749c1a8
GM		 753 (error-pos (point-marker))
754 source)
755 (save-excursion
756 (save-restriction
757 (widen)
4cc7e498 758 ;; Use funcall so as to prevent byte-compiler warnings
f7a80909
JB		 759 ;; `ada-find-file' is not defined if ada-xref wasn't loaded. But
760 ;; if we can find it, we should use it instead of
761 ;; `compilation-find-file', since the latter doesn't know anything
762 ;; about source path.
763
764 (if (functionp 'ada-find-file)
765 (setq file (funcall (symbol-function 'ada-find-file)
766 (match-string 1)))
767 (setq file (funcall (symbol-function 'compilation-find-file)
768 (point-marker) (match-string 1)
769 "./")))
770 (set-buffer file)
771
7749c1a8
GM		 772 (if (stringp line)
773 (goto-line (string-to-number line)))
36144b26 774 (setq source (point-marker))))
4cc7e498
GM		 775 (funcall (symbol-function 'compilation-goto-locus)
776 (cons source error-pos))
7749c1a8
GM		 777 ))
778
779 ;; otherwise, default behavior
780 (t
4cc7e498 781 (funcall (symbol-function 'compile-goto-error)))
7749c1a8
GM		 782 )
783 (recenter))
784
4cc7e498 785\f
655880d2
GM		 786;;-------------------------------------------------------------------------
787;; Grammar related function
788;; The functions below work with the syntax class of the characters in an Ada
789;; buffer. Two syntax tables are created, depending on whether we want '_'
790;; to be considered as part of a word or not.
791;; Some characters may have multiple meanings depending on the context:
792;; - ' is either the beginning of a constant character or an attribute
793;; - # is either part of a based litteral or a gnatprep statement.
794;; - " starts a string, but not if inside a constant character.
795;; - ( and ) should be ignored if inside a constant character.
796;; Thus their syntax property is changed automatically, and we can still use
797;; the standard Emacs functions for sexp (see `ada-in-string-p')
798;;
799;; On Emacs, this is done through the `syntax-table' text property. The
800;; modification is done automatically each time the user as typed a new
801;; character. This is already done in `font-lock-mode' (in
802;; `font-lock-syntactic-keywords', so we take advantage of the existing
803;; mechanism. If font-lock-mode is not activated, we do it by hand in
804;; `ada-after-change-function', thanks to `ada-deactivate-properties' and
805;; `ada-initialize-properties'.
806;;
807;; on XEmacs, the `syntax-table' property does not exist and we have to use a
808;; slow advice to `parse-partial-sexp' to do the same thing.
809;; When executing parse-partial-sexp, we simply modify the strings before and
810;; after, so that the special constants '"', '(' and ')' do not interact
811;; with parse-partial-sexp.
812;; Note: this code is slow and needs to be rewritten as soon as something
813;; better is available on XEmacs.
814;;-------------------------------------------------------------------------
972579f9
RS		 815
816(defun ada-create-syntax-table ()
655880d2
GM		 817 "Create the two syntax tables use in the Ada mode.
818The standard table declares `_' as a symbol constituent, the second one
819declares it as a word constituent."
7749c1a8 820 (interactive)
36144b26 821 (setq ada-mode-syntax-table (make-syntax-table))
972579f9
RS		 822 (set-syntax-table ada-mode-syntax-table)
823
cadd3658
RS		 824 ;; define string brackets (`%' is alternative string bracket, but
825 ;; almost never used as such and throws font-lock and indentation
826 ;; off the track.)
827 (modify-syntax-entry ?% "$" ada-mode-syntax-table)
972579f9
RS		 828 (modify-syntax-entry ?\" "\"" ada-mode-syntax-table)
829
972579f9
RS		 830 (modify-syntax-entry ?: "." ada-mode-syntax-table)
831 (modify-syntax-entry ?\; "." ada-mode-syntax-table)
832 (modify-syntax-entry ?& "." ada-mode-syntax-table)
833 (modify-syntax-entry ?\| "." ada-mode-syntax-table)
834 (modify-syntax-entry ?+ "." ada-mode-syntax-table)
835 (modify-syntax-entry ?* "." ada-mode-syntax-table)
836 (modify-syntax-entry ?/ "." ada-mode-syntax-table)
837 (modify-syntax-entry ?= "." ada-mode-syntax-table)
838 (modify-syntax-entry ?< "." ada-mode-syntax-table)
839 (modify-syntax-entry ?> "." ada-mode-syntax-table)
840 (modify-syntax-entry ?$ "." ada-mode-syntax-table)
841 (modify-syntax-entry ?\[ "." ada-mode-syntax-table)
842 (modify-syntax-entry ?\] "." ada-mode-syntax-table)
843 (modify-syntax-entry ?\{ "." ada-mode-syntax-table)
844 (modify-syntax-entry ?\} "." ada-mode-syntax-table)
845 (modify-syntax-entry ?. "." ada-mode-syntax-table)
846 (modify-syntax-entry ?\\ "." ada-mode-syntax-table)
847 (modify-syntax-entry ?\' "." ada-mode-syntax-table)
848
849 ;; a single hyphen is punctuation, but a double hyphen starts a comment
850 (modify-syntax-entry ?- ". 12" ada-mode-syntax-table)
851
655880d2
GM		 852 ;; See the comment above on grammar related function for the special
853 ;; setup for '#'.
6f9a2614 854 (if (featurep 'xemacs)
7749c1a8
GM		 855 (modify-syntax-entry ?# "<" ada-mode-syntax-table)
856 (modify-syntax-entry ?# "$" ada-mode-syntax-table))
857
972579f9
RS		 858 ;; and \f and \n end a comment
859 (modify-syntax-entry ?\f "> " ada-mode-syntax-table)
860 (modify-syntax-entry ?\n "> " ada-mode-syntax-table)
861
cadd3658 862 ;; define what belongs in Ada symbols
972579f9
RS		 863 (modify-syntax-entry ?_ "_" ada-mode-syntax-table)
864
865 ;; define parentheses to match
866 (modify-syntax-entry ?\( "()" ada-mode-syntax-table)
867 (modify-syntax-entry ?\) ")(" ada-mode-syntax-table)
f139ce87 868
36144b26 869 (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table))
f139ce87 870 (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
972579f9
RS		 871 )
872
655880d2
GM		 873;; Support of special characters in XEmacs (see the comments at the beginning
874;; of the section on Grammar related functions).
7749c1a8 875
6f9a2614 876(if (featurep 'xemacs)
7749c1a8 877 (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants)
655880d2 878 "Handles special character constants and gnatprep statements."
7749c1a8
GM		 879 (let (change)
880 (if (< to from)
881 (let ((tmp from))
882 (setq from to to tmp)))
883 (save-excursion
884 (goto-char from)
885 (while (re-search-forward "'\\([(\")#]\\)'" to t)
36144b26 886 (setq change (cons (list (match-beginning 1)
7749c1a8
GM		 887 1
888 (match-string 1))
889 change))
890 (replace-match "'A'"))
891 (goto-char from)
892 (while (re-search-forward "\\(#[0-9a-fA-F]*#\\)" to t)
36144b26 893 (setq change (cons (list (match-beginning 1)
7749c1a8
GM		 894 (length (match-string 1))
895 (match-string 1))
896 change))
4cc7e498 897 (replace-match (make-string (length (match-string 1)) ?@))))
7749c1a8
GM		 898 ad-do-it
899 (save-excursion
900 (while change
901 (goto-char (caar change))
902 (delete-char (cadar change))
903 (insert (caddar change))
36144b26 904 (setq change (cdr change)))))))
7749c1a8 905
7749c1a8 906(defun ada-deactivate-properties ()
655880d2
GM		 907 "Deactivate ada-mode's properties handling.
908This would be a duplicate of font-lock if both are used at the same time."
7749c1a8
GM		 909 (remove-hook 'after-change-functions 'ada-after-change-function t))
910
911(defun ada-initialize-properties ()
912 "Initialize some special text properties in the whole buffer.
655880d2
GM		 913In particular, character constants are said to be strings, #...# are treated
914as numbers instead of gnatprep comments."
7749c1a8
GM		 915 (save-excursion
916 (save-restriction
917 (widen)
918 (goto-char (point-min))
919 (while (re-search-forward "'.'" nil t)
920 (add-text-properties (match-beginning 0) (match-end 0)
921 '(syntax-table ("'" . ?\"))))
922 (goto-char (point-min))
923 (while (re-search-forward "^[ \t]*#" nil t)
924 (add-text-properties (match-beginning 0) (match-end 0)
925 '(syntax-table (11 . 10))))
926 (set-buffer-modified-p nil)
927
928 ;; Setting this only if font-lock is not set won't work
929 ;; if the user activates or deactivates font-lock-mode,
930 ;; but will make things faster most of the time
7749c1a8
GM		 931 (add-hook 'after-change-functions 'ada-after-change-function nil t)
932 )))
933
934(defun ada-after-change-function (beg end old-len)
655880d2
GM		 935 "Called when the region between BEG and END was changed in the buffer.
936OLD-LEN indicates what the length of the replaced text was."
7749c1a8
GM		 937 (let ((inhibit-point-motion-hooks t)
938 (eol (point)))
939 (save-excursion
940 (save-match-data
941 (beginning-of-line)
942 (remove-text-properties (point) eol '(syntax-table nil))
943 (while (re-search-forward "'.'" eol t)
944 (add-text-properties (match-beginning 0) (match-end 0)
945 '(syntax-table ("'" . ?\"))))
946 (beginning-of-line)
947 (if (looking-at "^[ \t]*#")
948 (add-text-properties (match-beginning 0) (match-end 0)
f7a80909 949 '(syntax-table (11 . 10))))))))
7749c1a8 950
4cc7e498
GM		 951;;------------------------------------------------------------------
952;; Testing the grammatical context
953;;------------------------------------------------------------------
954
955(defsubst ada-in-comment-p (&optional parse-result)
956 "Returns t if inside a comment."
957 (nth 4 (or parse-result
958 (parse-partial-sexp
f7a2f2c6 959 (line-beginning-position) (point)))))
4cc7e498
GM		 960
961(defsubst ada-in-string-p (&optional parse-result)
962 "Returns t if point is inside a string.
963If parse-result is non-nil, use is instead of calling parse-partial-sexp."
964 (nth 3 (or parse-result
965 (parse-partial-sexp
f7a2f2c6 966 (line-beginning-position) (point)))))
4cc7e498
GM		 967
968(defsubst ada-in-string-or-comment-p (&optional parse-result)
969 "Returns t if inside a comment or string."
36144b26 970 (setq parse-result (or parse-result
4cc7e498 971 (parse-partial-sexp
f7a2f2c6 972 (line-beginning-position) (point))))
4cc7e498
GM		 973 (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))
974
7749c1a8 975
655880d2
GM		 976;;------------------------------------------------------------------
977;; Contextual menus
4cc7e498
GM		 978;; The Ada-mode comes with contextual menus, bound by default to the right
979;; mouse button.
655880d2
GM		 980;; Add items to this menu by modifying `ada-contextual-menu'. Note that the
981;; variable `ada-contextual-menu-on-identifier' is set automatically to t
982;; if the mouse button was pressed on an identifier.
983;;------------------------------------------------------------------
7749c1a8 984
4cc7e498
GM		 985(defun ada-call-from-contextual-menu (function)
986 "Execute FUNCTION when called from the contextual menu.
987It forces Emacs to change the cursor position."
988 (interactive)
989 (funcall function)
990 (setq ada-contextual-menu-last-point
991 (list (point) (current-buffer))))
992
7749c1a8 993(defun ada-popup-menu (position)
655880d2 994 "Pops up a contextual menu, depending on where the user clicked.
4cc7e498
GM		 995POSITION is the location the mouse was clicked on.
996Sets `ada-contextual-menu-last-point' to the current position before
997displaying the menu. When a function from the menu is called, the point is
998where the mouse button was clicked."
7749c1a8 999 (interactive "e")
4cc7e498
GM		 1000
1001 ;; declare this as a local variable, so that the function called
1002 ;; in the contextual menu does not hide the region in
1003 ;; transient-mark-mode.
1004 (let ((deactivate-mark nil))
36144b26 1005 (setq ada-contextual-menu-last-point
4cc7e498 1006 (list (point) (current-buffer)))
655880d2 1007 (mouse-set-point last-input-event)
4cc7e498 1008
655880d2 1009 (setq ada-contextual-menu-on-identifier
4cc7e498
GM		 1010 (and (char-after)
1011 (or (= (char-syntax (char-after)) ?w)
1012 (= (char-after) ?_))
1013 (not (ada-in-string-or-comment-p))
1014 (save-excursion (skip-syntax-forward "w")
1015 (not (ada-after-keyword-p)))
1016 ))
f7a80909
JB		 1017 (if (fboundp 'popup-menu)
1018 (funcall (symbol-function 'popup-menu) ada-contextual-menu)
1019 (let (choice)
1020 (setq choice (x-popup-menu position ada-contextual-menu))
1021 (if choice
1022 (funcall (lookup-key ada-contextual-menu (vector (car choice)))))))
1023
4cc7e498
GM		 1024 (set-buffer (cadr ada-contextual-menu-last-point))
1025 (goto-char (car ada-contextual-menu-last-point))
1026 ))
1027
7749c1a8 1028
655880d2
GM		 1029;;------------------------------------------------------------------
1030;; Misc functions
1031;;------------------------------------------------------------------
7749c1a8
GM		 1032
1033;;;###autoload
1034(defun ada-add-extensions (spec body)
655880d2
GM		 1035 "Define SPEC and BODY as being valid extensions for Ada files.
1036Going from body to spec with `ff-find-other-file' used these
1037extensions.
1038SPEC and BODY are two regular expressions that must match against the file
1039name"
7749c1a8 1040 (let* ((reg (concat (regexp-quote body) "$"))
4cc7e498 1041 (tmp (assoc reg ada-other-file-alist)))
7749c1a8 1042 (if tmp
4cc7e498 1043 (setcdr tmp (list (cons spec (cadr tmp))))
7749c1a8 1044 (add-to-list 'ada-other-file-alist (list reg (list spec)))))
4cc7e498 1045
7749c1a8 1046 (let* ((reg (concat (regexp-quote spec) "$"))
4cc7e498 1047 (tmp (assoc reg ada-other-file-alist)))
7749c1a8 1048 (if tmp
4cc7e498 1049 (setcdr tmp (list (cons body (cadr tmp))))
7749c1a8
GM		 1050 (add-to-list 'ada-other-file-alist (list reg (list body)))))
1051
1997815f
AS		 1052 (add-to-list 'auto-mode-alist
1053 (cons (concat (regexp-quote spec) "\\'") 'ada-mode))
1054 (add-to-list 'auto-mode-alist
1055 (cons (concat (regexp-quote body) "\\'") 'ada-mode))
7749c1a8
GM		 1056
1057 (add-to-list 'ada-spec-suffixes spec)
1058 (add-to-list 'ada-body-suffixes body)
1059
1060 ;; Support for speedbar (Specifies that we want to see these files in
1061 ;; speedbar)
f7a80909 1062 (if (fboundp 'speedbar-add-supported-extension)
7749c1a8 1063 (progn
4cc7e498
GM		 1064 (funcall (symbol-function 'speedbar-add-supported-extension)
1065 spec)
1066 (funcall (symbol-function 'speedbar-add-supported-extension)
1067 body)))
7749c1a8
GM		 1068 )
1069
1070
a681b2a1 1071;;;###autoload
972579f9 1072(defun ada-mode ()
cadd3658 1073 "Ada mode is the major mode for editing Ada code.
972579f9
RS		 1074
1075Bindings are as follows: (Note: 'LFD' is control-j.)
4607c7f4 1076\\{ada-mode-map}
972579f9
RS		 1077
1078 Indent line '\\[ada-tab]'
1079 Indent line, insert newline and indent the new line. '\\[newline-and-indent]'
1080
1081 Re-format the parameter-list point is in '\\[ada-format-paramlist]'
1082 Indent all lines in region '\\[ada-indent-region]'
972579f9
RS		 1083
1084 Adjust case of identifiers and keywords in region '\\[ada-adjust-case-region]'
1085 Adjust case of identifiers and keywords in buffer '\\[ada-adjust-case-buffer]'
1086
7749c1a8 1087 Fill comment paragraph, justify and append postfix '\\[fill-paragraph]'
972579f9 1088
cadd3658 1089 Next func/proc/task '\\[ada-next-procedure]' Previous func/proc/task '\\[ada-previous-procedure]'
f139ce87 1090 Next package '\\[ada-next-package]' Previous package '\\[ada-previous-package]'
972579f9
RS		 1091
1092 Goto matching start of current 'end ...;' '\\[ada-move-to-start]'
1093 Goto end of current block '\\[ada-move-to-end]'
1094
1095Comments are handled using standard GNU Emacs conventions, including:
1096 Start a comment '\\[indent-for-comment]'
1097 Comment region '\\[comment-region]'
1098 Uncomment region '\\[ada-uncomment-region]'
1099 Continue comment on next line '\\[indent-new-comment-line]'
1100
1101If you use imenu.el:
1102 Display index-menu of functions & procedures '\\[imenu]'
1103
1104If you use find-file.el:
1105 Switch to other file (Body <-> Spec) '\\[ff-find-other-file]'
1106 or '\\[ff-mouse-find-other-file]
1107 Switch to other file in other window '\\[ada-ff-other-window]'
1108 or '\\[ff-mouse-find-other-file-other-window]
7749c1a8 1109 If you use this function in a spec and no body is available, it gets created with body stubs.
972579f9
RS		 1110
1111If you use ada-xref.el:
1112 Goto declaration: '\\[ada-point-and-xref]' on the identifier
1113 or '\\[ada-goto-declaration]' with point on the identifier
4cc7e498 1114 Complete identifier: '\\[ada-complete-identifier]'."
972579f9
RS		 1115
1116 (interactive)
1117 (kill-all-local-variables)
1118
7749c1a8 1119 (set (make-local-variable 'require-final-newline) t)
972579f9 1120
7749c1a8
GM		 1121 ;; Set the paragraph delimiters so that one can select a whole block
1122 ;; simply with M-h
1123 (set (make-local-variable 'paragraph-start) "[ \t\n\f]*$")
1124 (set (make-local-variable 'paragraph-separate) "[ \t\n\f]*$")
972579f9
RS		 1125
1126 ;; comment end must be set because it may hold a wrong value if
1127 ;; this buffer had been in another mode before. RE
7749c1a8
GM		 1128 (set (make-local-variable 'comment-end) "")
1129
1130 ;; used by autofill and indent-new-comment-line
1131 (set (make-local-variable 'comment-start-skip) "---*[ \t]*")
1132
1133 ;; used by autofill to break a comment line and continue it on another line.
1134 ;; The reason we need this one is that the default behavior does not work
1135 ;; correctly with the definition of paragraph-start above when the comment
655880d2 1136 ;; is right after a multi-line subprogram declaration (the comments are
7749c1a8
GM		 1137 ;; aligned under the latest parameter, not under the declaration start).
1138 (set (make-local-variable 'comment-line-break-function)
1139 (lambda (&optional soft) (let ((fill-prefix nil))
4cc7e498
GM		 1140 (indent-new-comment-line soft))))
1141
7749c1a8
GM		 1142 (set (make-local-variable 'indent-line-function)
1143 'ada-indent-current-function)
1144
1145 (set (make-local-variable 'comment-column) 40)
1146
1147 ;; Emacs 20.3 defines a comment-padding to insert spaces between
1148 ;; the comment and the text. We do not want any, this is already
1149 ;; included in comment-start
6f9a2614 1150 (unless (featurep 'xemacs)
4607c7f4
SM		 1151 (progn
1152 (if (ada-check-emacs-version 20 3)
1153 (progn
1154 (set (make-local-variable 'parse-sexp-ignore-comments) t)
1155 (set (make-local-variable 'comment-padding) 0)))
1156 (set (make-local-variable 'parse-sexp-lookup-properties) t)
1157 ))
7749c1a8 1158
4607c7f4
SM		 1159 (set 'case-fold-search t)
1160 (if (boundp 'imenu-case-fold-search)
1161 (set 'imenu-case-fold-search t))
7749c1a8
GM		 1162
1163 (set (make-local-variable 'fill-paragraph-function)
1164 'ada-fill-comment-paragraph)
1165
1166 (set (make-local-variable 'imenu-generic-expression)
1167 ada-imenu-generic-expression)
1168
1169 ;; Support for compile.el
1170 ;; We just substitute our own functions to go to the error.
1171 (add-hook 'compilation-mode-hook
db72f2a6 1172 (lambda()
5dab0769
SM		 1173 (set (make-local-variable 'compile-auto-highlight) 40)
1174 ;; FIXME: This has global impact! -stef
4cc7e498
GM		 1175 (define-key compilation-minor-mode-map [mouse-2]
1176 'ada-compile-mouse-goto-error)
1177 (define-key compilation-minor-mode-map "\C-c\C-c"
1178 'ada-compile-goto-error)
1179 (define-key compilation-minor-mode-map "\C-m"
5dab0769 1180 'ada-compile-goto-error)))
7749c1a8 1181
4607c7f4
SM		 1182 ;; font-lock support :
1183 ;; We need to set some properties for XEmacs, and define some variables
1184 ;; for Emacs
1185
6f9a2614 1186 (if (featurep 'xemacs)
4607c7f4
SM		 1187 ;; XEmacs
1188 (put 'ada-mode 'font-lock-defaults
1189 '(ada-font-lock-keywords
1190 nil t ((?\_ . "w") (?# . ".")) beginning-of-line))
1191 ;; Emacs
1192 (set (make-local-variable 'font-lock-defaults)
1193 '(ada-font-lock-keywords
1194 nil t
1195 ((?\_ . "w") (?# . "."))
1196 beginning-of-line
1197 (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
1198 )
4cc7e498 1199
7749c1a8 1200 ;; Set up support for find-file.el.
5dab0769 1201 (set (make-local-variable 'ff-other-file-alist)
7749c1a8 1202 'ada-other-file-alist)
5dab0769 1203 (set (make-local-variable 'ff-search-directories)
6f9a2614
JB		 1204 'ada-search-directories-internal)
1205 (setq ff-post-load-hook 'ada-set-point-accordingly
1206 ff-file-created-hook 'ada-make-body)
1207 (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in)
4cc7e498 1208
7749c1a8
GM		 1209 ;; Some special constructs for find-file.el
1210 ;; We do not need to add the construction for 'with', which is in the
1211 ;; standard find-file.el
7749c1a8 1212 (make-local-variable 'ff-special-constructs)
4cc7e498
GM		 1213
1214 ;; Go to the parent package :
7749c1a8 1215 (add-to-list 'ff-special-constructs
4cc7e498
GM		 1216 (cons (eval-when-compile
1217 (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
1218 "\\(body[ \t]+\\)?"
1219 "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
1220 (lambda ()
6f9a2614
JB		 1221 (if (fboundp 'ff-get-file)
1222 (if (boundp 'fname)
1223 (set 'fname (ff-get-file
1224 ada-search-directories-internal
1225 (ada-make-filename-from-adaname
1226 (match-string 3))
1227 ada-spec-suffixes)))))))
7749c1a8
GM		 1228 ;; Another special construct for find-file.el : when in a separate clause,
1229 ;; go to the correct package.
1230 (add-to-list 'ff-special-constructs
4cc7e498
GM		 1231 (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
1232 (lambda ()
6f9a2614
JB		 1233 (if (fboundp 'ff-get-file)
1234 (if (boundp 'fname)
1235 (setq fname (ff-get-file
1236 ada-search-directories-internal
1237 (ada-make-filename-from-adaname
1238 (match-string 1))
1239 ada-spec-suffixes)))))))
1240
7749c1a8
GM		 1241 ;; Another special construct, that redefines the one in find-file.el. The
1242 ;; old one can handle only one possible type of extension for Ada files
4cc7e498
GM		 1243 ;; remove from the list the standard "with..." that is put by find-file.el,
1244 ;; since it uses the old ada-spec-suffix variable
1245 ;; This one needs to replace the standard one defined in find-file.el (with
1246 ;; Emacs <= 20.4), since that one uses the old variable ada-spec-suffix
1247 (let ((old-construct
1248 (assoc "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" ff-special-constructs))
1249 (new-cdr
1250 (lambda ()
6f9a2614
JB		 1251 (if (fboundp 'ff-get-file)
1252 (if (boundp 'fname)
1253 (set 'fname (ff-get-file
1254 ada-search-directories-internal
1255 (ada-make-filename-from-adaname
1256 (match-string 1))
1257 ada-spec-suffixes)))))))
4cc7e498
GM		 1258 (if old-construct
1259 (setcdr old-construct new-cdr)
1260 (add-to-list 'ff-special-constructs
1261 (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
1262 new-cdr))))
1263
7749c1a8
GM		 1264 ;; Support for outline-minor-mode
1265 (set (make-local-variable 'outline-regexp)
4cc7e498 1266 "\\([ \t]*\\(procedure\\|function\\|package\\|if\\|while\\|for\\|declare\\|case\\|end\\|begin\\|loop\\)\\|--\\)")
7749c1a8
GM		 1267 (set (make-local-variable 'outline-level) 'ada-outline-level)
1268
1269 ;; Support for imenu : We want a sorted index
36144b26 1270 (setq imenu-sort-function 'imenu--sort-by-name)
7749c1a8 1271
4607c7f4
SM		 1272 ;; Support for ispell : Check only comments
1273 (set (make-local-variable 'ispell-check-comments) 'exclusive)
1274
1275 ;; Support for align.el <= 2.2, if present
1276 ;; align.el is distributed with Emacs 21, but not with earlier versions.
1277 (if (boundp 'align-mode-alist)
1278 (add-to-list 'align-mode-alist '(ada-mode . ada-align-list)))
1279
1280 ;; Support for align.el >= 2.8, if present
1281 (if (boundp 'align-dq-string-modes)
1282 (progn
1283 (add-to-list 'align-dq-string-modes 'ada-mode)
1284 (add-to-list 'align-open-comment-modes 'ada-mode)
4607c7f4
SM		 1285 (set (make-variable-buffer-local 'align-region-separate)
1286 ada-align-region-separate)
4607c7f4 1287
80d50f88
SM		 1288 ;; Exclude comments alone on line from alignment.
1289 (add-to-list 'align-exclude-rules-list
1290 '(ada-solo-comment
1291 (regexp . "^\\(\\s-*\\)--")
1292 (modes . '(ada-mode))))
1293 (add-to-list 'align-exclude-rules-list
1294 '(ada-solo-use
1295 (regexp . "^\\(\\s-*\\)\\<use\\>")
1296 (modes . '(ada-mode))))
1297
1298 (setq ada-align-modes nil)
a1506d29 1299
80d50f88
SM		 1300 (add-to-list 'ada-align-modes
1301 '(ada-declaration-assign
1302 (regexp . "[^:]\\(\\s-*\\):[^:]")
1303 (valid . (lambda() (not (ada-in-comment-p))))
1304 (repeat . t)
1305 (modes . '(ada-mode))))
1306 (add-to-list 'ada-align-modes
1307 '(ada-associate
1308 (regexp . "[^=]\\(\\s-*\\)=>")
1309 (valid . (lambda() (not (ada-in-comment-p))))
1310 (modes . '(ada-mode))))
1311 (add-to-list 'ada-align-modes
1312 '(ada-comment
1313 (regexp . "\\(\\s-*\\)--")
1314 (modes . '(ada-mode))))
1315 (add-to-list 'ada-align-modes
1316 '(ada-use
1317 (regexp . "\\(\\s-*\\)\\<use\\s-")
1318 (valid . (lambda() (not (ada-in-comment-p))))
1319 (modes . '(ada-mode))))
1320 (add-to-list 'ada-align-modes
1321 '(ada-at
1322 (regexp . "\\(\\s-+\\)at\\>")
1323 (modes . '(ada-mode))))
4cc7e498 1324
a1506d29 1325
80d50f88
SM		 1326 (setq align-mode-rules-list ada-align-modes)
1327 ))
a1506d29 1328
7749c1a8
GM		 1329 ;; Set up the contextual menu
1330 (if ada-popup-key
1331 (define-key ada-mode-map ada-popup-key 'ada-popup-menu))
1332
4cc7e498
GM		 1333 ;; Support for Abbreviations (the user still need to "M-x abbrev-mode"
1334 (define-abbrev-table 'ada-mode-abbrev-table ())
36144b26 1335 (setq local-abbrev-table ada-mode-abbrev-table)
4cc7e498 1336
80d50f88
SM		 1337 ;; Support for which-function mode
1338 ;; which-function-mode does not work with nested subprograms, since it is
1339 ;; based only on the regexps generated by imenu, and thus can only detect the
1340 ;; beginning of subprograms, not the end.
1341 ;; Fix is: redefine a new function ada-which-function, and call it when the
1342 ;; major-mode is ada-mode.
a1506d29 1343
6b61353c
KH		 1344 (make-local-variable 'which-func-functions)
1345 (setq which-func-functions '(ada-which-function))
80d50f88 1346
7749c1a8 1347 ;; Support for indent-new-comment-line (Especially for XEmacs)
36144b26 1348 (setq comment-multi-line nil)
7749c1a8 1349
4607c7f4
SM		 1350 (setq major-mode 'ada-mode
1351 mode-name "Ada")
972579f9 1352
972579f9
RS		 1353 (use-local-map ada-mode-map)
1354
5dab0769 1355 (easy-menu-add ada-mode-menu ada-mode-map)
4cc7e498 1356
7749c1a8 1357 (set-syntax-table ada-mode-syntax-table)
972579f9
RS		 1358
1359 (if ada-clean-buffer-before-saving
1360 (progn
7749c1a8 1361 ;; remove all spaces at the end of lines in the whole buffer.
80d50f88 1362 (add-hook 'local-write-file-hooks 'delete-trailing-whitespace)
7749c1a8
GM		 1363 ;; convert all tabs to the correct number of spaces.
1364 (add-hook 'local-write-file-hooks
db72f2a6 1365 (lambda () (untabify (point-min) (point-max))))))
972579f9 1366
7749c1a8 1367 (run-hooks 'ada-mode-hook)
972579f9 1368
4607c7f4
SM		 1369 ;; To be run after the hook, in case the user modified
1370 ;; ada-fill-comment-prefix
1371 (make-local-variable 'comment-start)
1372 (if ada-fill-comment-prefix
1373 (set 'comment-start ada-fill-comment-prefix)
1374 (set 'comment-start "-- "))
a1506d29 1375
7749c1a8
GM		 1376 ;; Run this after the hook to give the users a chance to activate
1377 ;; font-lock-mode
972579f9 1378
6f9a2614 1379 (unless (featurep 'xemacs)
4607c7f4
SM		 1380 (progn
1381 (ada-initialize-properties)
4607c7f4 1382 (add-hook 'font-lock-mode-hook 'ada-deactivate-properties nil t)))
972579f9
RS		 1383
1384 ;; the following has to be done after running the ada-mode-hook
1385 ;; because users might want to set the values of these variable
1386 ;; inside the hook (MH)
1387
1388 (cond ((eq ada-language-version 'ada83)
36144b26 1389 (setq ada-keywords ada-83-keywords))
f139ce87 1390 ((eq ada-language-version 'ada95)
36144b26 1391 (setq ada-keywords ada-95-keywords)))
972579f9
RS		 1392
1393 (if ada-auto-case
1394 (ada-activate-keys-for-case)))
1395
4607c7f4
SM		 1396
1397;; transient-mark-mode and mark-active are not defined in XEmacs
1398(defun ada-region-selected ()
1399 "t if a region has been selected by the user and is still active."
6f9a2614
JB		 1400 (or (and (featurep 'xemacs) (funcall (symbol-function 'region-active-p)))
1401 (and (not (featurep 'xemacs))
4607c7f4
SM		 1402 (symbol-value 'transient-mark-mode)
1403 (symbol-value 'mark-active))))
1404
972579f9 1405\f
655880d2
GM		 1406;;-----------------------------------------------------------------
1407;; auto-casing
1408;; Since Ada is case-insensitive, the Ada-mode provides an extensive set of
1409;; functions to auto-case identifiers, keywords, ...
1410;; The basic rules for autocasing are defined through the variables
1411;; `ada-case-attribute', `ada-case-keyword' and `ada-case-identifier'. These
1412;; are references to the functions that will do the actual casing.
1413;;
1414;; However, in most cases, the user will want to define some exceptions to
1415;; these casing rules. This is done through a list of files, that contain
1416;; one word per line. These files are stored in `ada-case-exception-file'.
4cc7e498 1417;; For backward compatibility, this variable can also be a string.
655880d2 1418;;-----------------------------------------------------------------
cadd3658 1419
4607c7f4
SM		 1420(defun ada-save-exceptions-to-file (file-name)
1421 "Save the exception lists `ada-case-exception' and
1422`ada-case-exception-substring' to the file FILE-NAME."
a1506d29 1423
4607c7f4
SM		 1424 ;; Save the list in the file
1425 (find-file (expand-file-name file-name))
1426 (erase-buffer)
1427 (mapcar (lambda (x) (insert (car x) "\n"))
1428 (sort (copy-sequence ada-case-exception)
1429 (lambda(a b) (string< (car a) (car b)))))
1430 (mapcar (lambda (x) (insert "*" (car x) "\n"))
1431 (sort (copy-sequence ada-case-exception-substring)
1432 (lambda(a b) (string< (car a) (car b)))))
1433 (save-buffer)
1434 (kill-buffer nil)
1435 )
a1506d29 1436
7749c1a8 1437(defun ada-create-case-exception (&optional word)
655880d2
GM		 1438 "Defines WORD as an exception for the casing system.
1439If WORD is not given, then the current word in the buffer is used instead.
1440The new words is added to the first file in `ada-case-exception-file'.
1441The standard casing rules will no longer apply to this word."
972579f9 1442 (interactive)
7749c1a8 1443 (let ((previous-syntax-table (syntax-table))
4cc7e498
GM		 1444 file-name
1445 )
1446
1447 (cond ((stringp ada-case-exception-file)
36144b26 1448 (setq file-name ada-case-exception-file))
4cc7e498 1449 ((listp ada-case-exception-file)
36144b26 1450 (setq file-name (car ada-case-exception-file)))
4cc7e498 1451 (t
4607c7f4
SM		 1452 (error (concat "No exception file specified. "
1453 "See variable ada-case-exception-file."))))
4cc7e498 1454
7749c1a8
GM		 1455 (set-syntax-table ada-mode-symbol-syntax-table)
1456 (unless word
1457 (save-excursion
4cc7e498 1458 (skip-syntax-backward "w")
36144b26 1459 (setq word (buffer-substring-no-properties
4cc7e498 1460 (point) (save-excursion (forward-word 1) (point))))))
4607c7f4 1461 (set-syntax-table previous-syntax-table)
7749c1a8
GM		 1462
1463 ;; Reread the exceptions file, in case it was modified by some other,
4607c7f4 1464 (ada-case-read-exceptions-from-file file-name)
4cc7e498 1465
7749c1a8
GM		 1466 ;; If the word is already in the list, even with a different casing
1467 ;; we simply want to replace it.
7749c1a8 1468 (if (and (not (equal ada-case-exception '()))
4cc7e498 1469 (assoc-ignore-case word ada-case-exception))
4607c7f4 1470 (setcar (assoc-ignore-case word ada-case-exception) word)
7749c1a8
GM		 1471 (add-to-list 'ada-case-exception (cons word t))
1472 )
972579f9 1473
4607c7f4 1474 (ada-save-exceptions-to-file file-name)
7749c1a8 1475 ))
4cc7e498 1476
4607c7f4
SM		 1477(defun ada-create-case-exception-substring (&optional word)
1478 "Defines the substring WORD as an exception for the casing system.
1479If WORD is not given, then the current word in the buffer is used instead,
1480or the selected region if any is active.
1481The new words is added to the first file in `ada-case-exception-file'.
1482When auto-casing a word, this substring will be special-cased, unless the
1483word itself has a special casing."
1484 (interactive)
1485 (let ((file-name
1486 (cond ((stringp ada-case-exception-file)
1487 ada-case-exception-file)
1488 ((listp ada-case-exception-file)
1489 (car ada-case-exception-file))
1490 (t
1491 (error (concat "No exception file specified. "
1492 "See variable ada-case-exception-file."))))))
1493
1494 ;; Find the substring to define as an exception. Order is: the parameter,
1495 ;; if any, or the selected region, or the word under the cursor
1496 (cond
1497 (word nil)
1498
1499 ((ada-region-selected)
1500 (setq word (buffer-substring-no-properties
1501 (region-beginning) (region-end))))
1502
1503 (t
1504 (let ((underscore-syntax (char-syntax ?_)))
1505 (unwind-protect
1506 (progn
1507 (modify-syntax-entry ?_ "." (syntax-table))
1508 (save-excursion
1509 (skip-syntax-backward "w")
1510 (set 'word (buffer-substring-no-properties
1511 (point)
1512 (save-excursion (forward-word 1) (point))))))
1513 (modify-syntax-entry ?_ (make-string 1 underscore-syntax)
1514 (syntax-table))))))
1515
1516 ;; Reread the exceptions file, in case it was modified by some other,
1517 (ada-case-read-exceptions-from-file file-name)
1518
1519 ;; If the word is already in the list, even with a different casing
1520 ;; we simply want to replace it.
1521 (if (and (not (equal ada-case-exception-substring '()))
1522 (assoc-ignore-case word ada-case-exception-substring))
1523 (setcar (assoc-ignore-case word ada-case-exception-substring) word)
1524 (add-to-list 'ada-case-exception-substring (cons word t))
1525 )
1526
1527 (ada-save-exceptions-to-file file-name)
1528
1529 (message (concat "Defining " word " as a casing exception"))))
1530
4cc7e498
GM		 1531(defun ada-case-read-exceptions-from-file (file-name)
1532 "Read the content of the casing exception file FILE-NAME."
1533 (if (file-readable-p (expand-file-name file-name))
7749c1a8 1534 (let ((buffer (current-buffer)))
4cc7e498
GM		 1535 (find-file (expand-file-name file-name))
1536 (set-syntax-table ada-mode-symbol-syntax-table)
7749c1a8
GM		 1537 (widen)
1538 (goto-char (point-min))
1539 (while (not (eobp))
4cc7e498
GM		 1540
1541 ;; If the item is already in the list, even with an other casing,
1542 ;; do not add it again. This way, the user can easily decide which
1543 ;; priority should be applied to each casing exception
1544 (let ((word (buffer-substring-no-properties
1545 (point) (save-excursion (forward-word 1) (point)))))
4607c7f4
SM		 1546
1547 ;; Handling a substring ?
1548 (if (char-equal (string-to-char word) ?*)
1549 (progn
1550 (setq word (substring word 1))
1551 (unless (assoc-ignore-case word ada-case-exception-substring)
1552 (add-to-list 'ada-case-exception-substring (cons word t))))
1553 (unless (assoc-ignore-case word ada-case-exception)
1554 (add-to-list 'ada-case-exception (cons word t)))))
4cc7e498 1555
7749c1a8
GM		 1556 (forward-line 1))
1557 (kill-buffer nil)
4cc7e498
GM		 1558 (set-buffer buffer)))
1559 )
1560
1561(defun ada-case-read-exceptions ()
1562 "Read all the casing exception files from `ada-case-exception-file'."
1563 (interactive)
1564
1565 ;; Reinitialize the casing exception list
4607c7f4
SM		 1566 (setq ada-case-exception '()
1567 ada-case-exception-substring '())
4cc7e498
GM		 1568
1569 (cond ((stringp ada-case-exception-file)
1570 (ada-case-read-exceptions-from-file ada-case-exception-file))
1571
1572 ((listp ada-case-exception-file)
1573 (mapcar 'ada-case-read-exceptions-from-file
1574 ada-case-exception-file))))
7749c1a8 1575
4607c7f4
SM		 1576(defun ada-adjust-case-substring ()
1577 "Adjust case of substrings in the previous word."
1578 (interactive)
1579 (let ((substrings ada-case-exception-substring)
1580 (max (point))
1581 (case-fold-search t)
1582 (underscore-syntax (char-syntax ?_))
1583 re)
1584
1585 (save-excursion
1586 (forward-word -1)
a1506d29 1587
4607c7f4
SM		 1588 (unwind-protect
1589 (progn
1590 (modify-syntax-entry ?_ "." (syntax-table))
a1506d29 1591
4607c7f4
SM		 1592 (while substrings
1593 (setq re (concat "\\b" (regexp-quote (caar substrings)) "\\b"))
a1506d29 1594
4607c7f4
SM		 1595 (save-excursion
1596 (while (re-search-forward re max t)
f7a80909 1597 (replace-match (caar substrings) t)))
4607c7f4
SM		 1598 (setq substrings (cdr substrings))
1599 )
1600 )
1601 (modify-syntax-entry ?_ (make-string 1 underscore-syntax) (syntax-table)))
1602 )))
1603
7749c1a8 1604(defun ada-adjust-case-identifier ()
655880d2
GM		 1605 "Adjust case of the previous identifier.
1606The auto-casing is done according to the value of `ada-case-identifier' and
1607the exceptions defined in `ada-case-exception-file'."
4cc7e498 1608 (interactive)
7749c1a8
GM		 1609 (if (or (equal ada-case-exception '())
1610 (equal (char-after) ?_))
4607c7f4
SM		 1611 (progn
1612 (funcall ada-case-identifier -1)
1613 (ada-adjust-case-substring))
972579f9 1614
7749c1a8
GM		 1615 (progn
1616 (let ((end (point))
1617 (start (save-excursion (skip-syntax-backward "w")
4cc7e498 1618 (point)))
7749c1a8
GM		 1619 match)
1620 ;; If we have an exception, replace the word by the correct casing
36144b26 1621 (if (setq match (assoc-ignore-case (buffer-substring start end)
7749c1a8 1622 ada-case-exception))
972579f9 1623
7749c1a8
GM		 1624 (progn
1625 (delete-region start end)
1626 (insert (car match)))
972579f9 1627
655880d2 1628 ;; Else simply re-case the word
4607c7f4
SM		 1629 (funcall ada-case-identifier -1)
1630 (ada-adjust-case-substring))))))
972579f9
RS		 1631
1632(defun ada-after-keyword-p ()
4cc7e498 1633 "Returns t if cursor is after a keyword that is not an attribute."
972579f9
RS		 1634 (save-excursion
1635 (forward-word -1)
4cc7e498
GM		 1636 (and (not (and (char-before)
1637 (or (= (char-before) ?_)
1638 (= (char-before) ?'))));; unless we have a _ or '
7749c1a8 1639 (looking-at (concat ada-keywords "[^_]")))))
972579f9
RS		 1640
1641(defun ada-adjust-case (&optional force-identifier)
5e1cecee 1642 "Adjust the case of the word before the just typed character.
655880d2 1643If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier."
4607c7f4
SM		 1644 (if (not (bobp))
1645 (progn
1646 (forward-char -1)
1647 (if (and (not (bobp))
1648 ;; or if at the end of a character constant
1649 (not (and (eq (following-char) ?')
1650 (eq (char-before (1- (point))) ?')))
1651 ;; or if the previous character was not part of a word
1652 (eq (char-syntax (char-before)) ?w)
1653 ;; if in a string or a comment
1654 (not (ada-in-string-or-comment-p))
1655 )
1656 (if (save-excursion
1657 (forward-word -1)
1658 (or (= (point) (point-min))
1659 (backward-char 1))
1660 (= (following-char) ?'))
1661 (funcall ada-case-attribute -1)
1662 (if (and
1663 (not force-identifier) ; (MH)
1664 (ada-after-keyword-p))
1665 (funcall ada-case-keyword -1)
1666 (ada-adjust-case-identifier))))
1667 (forward-char 1)
1668 ))
7749c1a8 1669 )
972579f9
RS		 1670
1671(defun ada-adjust-case-interactive (arg)
655880d2
GM		 1672 "Adjust the case of the previous word, and process the character just typed.
1673ARG is the prefix the user entered with \C-u."
972579f9 1674 (interactive "P")
972579f9 1675
4cc7e498
GM		 1676 (if ada-auto-case
1677 (let ((lastk last-command-char)
1678 (previous-syntax-table (syntax-table)))
1679
1680 (unwind-protect
1681 (progn
1682 (set-syntax-table ada-mode-symbol-syntax-table)
1683 (cond ((or (eq lastk ?\n)
1684 (eq lastk ?\r))
1685 ;; horrible kludge
1686 (insert " ")
1687 (ada-adjust-case)
1688 ;; horrible dekludge
1689 (delete-backward-char 1)
1690 ;; some special keys and their bindings
1691 (cond
1692 ((eq lastk ?\n)
1693 (funcall ada-lfd-binding))
1694 ((eq lastk ?\r)
1695 (funcall ada-ret-binding))))
1696 ((eq lastk ?\C-i) (ada-tab))
1697 ;; Else just insert the character
1698 ((self-insert-command (prefix-numeric-value arg))))
1699 ;; if there is a keyword in front of the underscore
1700 ;; then it should be part of an identifier (MH)
1701 (if (eq lastk ?_)
1702 (ada-adjust-case t)
1703 (ada-adjust-case))
1704 )
1705 ;; Restore the syntax table
1706 (set-syntax-table previous-syntax-table))
1707 )
1708
1709 ;; Else, no auto-casing
1710 (cond
1711 ((eq last-command-char ?\n)
1712 (funcall ada-lfd-binding))
1713 ((eq last-command-char ?\r)
1714 (funcall ada-ret-binding))
1715 (t
1716 (self-insert-command (prefix-numeric-value arg))))
1717 ))
972579f9
RS		 1718
1719(defun ada-activate-keys-for-case ()
655880d2 1720 "Modifies the key bindings for all the keys that should readjust the casing."
7749c1a8 1721 (interactive)
4cc7e498
GM		 1722 ;; Save original key-bindings to allow swapping ret/lfd
1723 ;; when casing is activated.
1724 ;; The 'or ...' is there to be sure that the value will not
1725 ;; be changed again when Ada mode is called more than once
36144b26
SM		 1726 (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M")))
1727 (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j")))
4cc7e498
GM		 1728
1729 ;; Call case modifying function after certain keys.
972579f9
RS		 1730 (mapcar (function (lambda(key) (define-key
1731 ada-mode-map
1732 (char-to-string key)
1733 'ada-adjust-case-interactive)))
4cc7e498
GM		 1734 '( ?` ?_ ?# ?% ?& ?* ?( ?) ?- ?= ?+
1735 ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r )))
972579f9 1736
972579f9 1737(defun ada-loose-case-word (&optional arg)
655880d2
GM		 1738 "Upcase first letter and letters following `_' in the following word.
1739No other letter is modified.
1740ARG is ignored, and is there for compatibility with `capitalize-word' only."
7749c1a8 1741 (interactive)
4cc7e498
GM		 1742 (save-excursion
1743 (let ((end (save-excursion (skip-syntax-forward "w") (point)))
1744 (first t))
1745 (skip-syntax-backward "w")
1746 (while (and (or first (search-forward "_" end t))
1747 (< (point) end))
1748 (and first
36144b26 1749 (setq first nil))
4cc7e498
GM		 1750 (insert-char (upcase (following-char)) 1)
1751 (delete-char 1)))))
1752
1753(defun ada-no-auto-case (&optional arg)
1754 "Does nothing.
1755This function can be used for the auto-casing variables in the ada-mode, to
1756adapt to unusal auto-casing schemes. Since it does nothing, you can for
1757instance use it for `ada-case-identifier' if you don't want any special
1758auto-casing for identifiers, whereas keywords have to be lower-cased.
1759See also `ada-auto-case' to disable auto casing altogether."
1760 )
972579f9 1761
7749c1a8 1762(defun ada-capitalize-word (&optional arg)
655880d2
GM		 1763 "Upcase first letter and letters following '_', lower case other letters.
1764ARG is ignored, and is there for compatibility with `capitalize-word' only."
7749c1a8 1765 (interactive)
4cc7e498
GM		 1766 (let ((end (save-excursion (skip-syntax-forward "w") (point)))
1767 (begin (save-excursion (skip-syntax-backward "w") (point))))
7749c1a8 1768 (modify-syntax-entry ?_ "_")
4cc7e498 1769 (capitalize-region begin end)
7749c1a8 1770 (modify-syntax-entry ?_ "w")))
972579f9 1771
972579f9 1772(defun ada-adjust-case-region (from to)
655880d2 1773 "Adjusts the case of all words in the region between FROM and TO.
5e1cecee 1774Attention: This function might take very long for big regions !"
972579f9
RS		 1775 (interactive "*r")
1776 (let ((begin nil)
1777 (end nil)
1778 (keywordp nil)
7749c1a8
GM		 1779 (attribp nil)
1780 (previous-syntax-table (syntax-table)))
1781 (message "Adjusting case ...")
f139ce87 1782 (unwind-protect
7749c1a8
GM		 1783 (save-excursion
1784 (set-syntax-table ada-mode-symbol-syntax-table)
1785 (goto-char to)
1786 ;;
1787 ;; loop: look for all identifiers, keywords, and attributes
1788 ;;
1789 (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
36144b26
SM		 1790 (setq end (match-end 1))
1791 (setq attribp
7749c1a8
GM		 1792 (and (> (point) from)
1793 (save-excursion
1794 (forward-char -1)
36144b26 1795 (setq attribp (looking-at "'.[^']")))))
7749c1a8
GM		 1796 (or
1797 ;; do nothing if it is a string or comment
1798 (ada-in-string-or-comment-p)
1799 (progn
1800 ;;
1801 ;; get the identifier or keyword or attribute
1802 ;;
36144b26
SM		 1803 (setq begin (point))
1804 (setq keywordp (looking-at ada-keywords))
7749c1a8
GM		 1805 (goto-char end)
1806 ;;
1807 ;; casing according to user-option
1808 ;;
1809 (if attribp
1810 (funcall ada-case-attribute -1)
1811 (if keywordp
1812 (funcall ada-case-keyword -1)
1813 (ada-adjust-case-identifier)))
1814 (goto-char begin))))
1815 (message "Adjusting case ... Done"))
1816 (set-syntax-table previous-syntax-table))))
972579f9 1817
972579f9 1818(defun ada-adjust-case-buffer ()
5e1cecee 1819 "Adjusts the case of all words in the whole buffer.
972579f9 1820ATTENTION: This function might take very long for big buffers !"
f139ce87 1821 (interactive "*")
972579f9
RS		 1822 (ada-adjust-case-region (point-min) (point-max)))
1823
1824\f
655880d2
GM		 1825;;--------------------------------------------------------------
1826;; Format Parameter Lists
1827;; Some special algorithms are provided to indent the parameter lists in
1828;; subprogram declarations. This is done in two steps:
1829;; - First parses the parameter list. The returned list has the following
1830;; format:
1831;; ( (<Param_Name> in? out? access? <Type_Name> <Default_Expression>)
1832;; ... )
1833;; This is done in `ada-scan-paramlist'.
1834;; - Delete and recreate the parameter list in function
4cc7e498
GM		 1835;; `ada-insert-paramlist'.
1836;; Both steps are called from `ada-format-paramlist'.
655880d2
GM		 1837;; Note: Comments inside the parameter list are lost.
1838;; The syntax has to be correct, or the reformating will fail.
1839;;--------------------------------------------------------------
972579f9 1840
655880d2
GM		 1841(defun ada-format-paramlist ()
1842 "Reformats the parameter list point is in."
972579f9
RS		 1843 (interactive)
1844 (let ((begin nil)
1845 (end nil)
1846 (delend nil)
7749c1a8
GM		 1847 (paramlist nil)
1848 (previous-syntax-table (syntax-table)))
f139ce87 1849 (unwind-protect
7749c1a8
GM		 1850 (progn
1851 (set-syntax-table ada-mode-symbol-syntax-table)
f139ce87 1852
7749c1a8
GM		 1853 ;; check if really inside parameter list
1854 (or (ada-in-paramlist-p)
1855 (error "not in parameter list"))
655880d2 1856
7749c1a8 1857 ;; find start of current parameter-list
7749c1a8 1858 (ada-search-ignore-string-comment
276c1210 1859 (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
7749c1a8
GM		 1860 (down-list 1)
1861 (backward-char 1)
36144b26 1862 (setq begin (point))
f139ce87 1863
7749c1a8 1864 ;; find end of parameter-list
7749c1a8 1865 (forward-sexp 1)
36144b26 1866 (setq delend (point))
7749c1a8 1867 (delete-char -1)
4cc7e498 1868 (insert "\n")
f139ce87 1869
7749c1a8 1870 ;; find end of last parameter-declaration
7749c1a8 1871 (forward-comment -1000)
36144b26 1872 (setq end (point))
f139ce87 1873
7749c1a8 1874 ;; build a list of all elements of the parameter-list
36144b26 1875 (setq paramlist (ada-scan-paramlist (1+ begin) end))
f139ce87 1876
7749c1a8 1877 ;; delete the original parameter-list
4cc7e498 1878 (delete-region begin delend)
f139ce87 1879
7749c1a8 1880 ;; insert the new parameter-list
7749c1a8
GM		 1881 (goto-char begin)
1882 (ada-insert-paramlist paramlist))
f139ce87 1883
f139ce87 1884 ;; restore syntax-table
7749c1a8 1885 (set-syntax-table previous-syntax-table)
f139ce87 1886 )))
972579f9 1887
972579f9 1888(defun ada-scan-paramlist (begin end)
655880d2
GM		 1889 "Scan the parameter list found in between BEGIN and END.
1890Returns the equivalent internal parameter list."
972579f9
RS		 1891 (let ((paramlist (list))
1892 (param (list))
1893 (notend t)
1894 (apos nil)
1895 (epos nil)
1896 (semipos nil)
1897 (match-cons nil))
1898
1899 (goto-char begin)
655880d2 1900
972579f9 1901 ;; loop until end of last parameter
972579f9
RS		 1902 (while notend
1903
972579f9 1904 ;; find first character of parameter-declaration
972579f9 1905 (ada-goto-next-non-ws)
36144b26 1906 (setq apos (point))
972579f9 1907
972579f9 1908 ;; find last character of parameter-declaration
36144b26 1909 (if (setq match-cons
7749c1a8 1910 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
972579f9 1911 (progn
36144b26
SM		 1912 (setq epos (car match-cons))
1913 (setq semipos (cdr match-cons)))
1914 (setq epos end))
972579f9 1915
972579f9 1916 ;; read name(s) of parameter(s)
972579f9 1917 (goto-char apos)
7749c1a8 1918 (looking-at "\\(\\(\\sw\\|[_, \t\n]\\)*\\(\\sw\\|_\\)\\)[ \t\n]*:[^=]")
972579f9 1919
36144b26 1920 (setq param (list (match-string 1)))
7749c1a8 1921 (ada-search-ignore-string-comment ":" nil epos t 'search-forward)
972579f9 1922
972579f9 1923 ;; look for 'in'
36144b26
SM		 1924 (setq apos (point))
1925 (setq param
7749c1a8
GM		 1926 (append param
1927 (list
1928 (consp
1929 (ada-search-ignore-string-comment
1930 "in" nil epos t 'word-search-forward)))))
972579f9 1931
972579f9 1932 ;; look for 'out'
972579f9 1933 (goto-char apos)
36144b26 1934 (setq param
7749c1a8
GM		 1935 (append param
1936 (list
1937 (consp
1938 (ada-search-ignore-string-comment
1939 "out" nil epos t 'word-search-forward)))))
972579f9 1940
5e1cecee 1941 ;; look for 'access'
972579f9 1942 (goto-char apos)
36144b26 1943 (setq param
7749c1a8
GM		 1944 (append param
1945 (list
1946 (consp
1947 (ada-search-ignore-string-comment
1948 "access" nil epos t 'word-search-forward)))))
972579f9 1949
5e1cecee 1950 ;; skip 'in'/'out'/'access'
972579f9
RS		 1951 (goto-char apos)
1952 (ada-goto-next-non-ws)
5e1cecee 1953 (while (looking-at "\\<\\(in\\|out\\|access\\)\\>")
972579f9
RS		 1954 (forward-word 1)
1955 (ada-goto-next-non-ws))
1956
7749c1a8 1957 ;; read type of parameter
4cc7e498
GM		 1958 ;; We accept spaces in the name, since some software like Rose
1959 ;; generates something like: "A : B 'Class"
1960 (looking-at "\\<\\(\\sw\\|[_.' \t]\\)+\\>")
36144b26 1961 (setq param
7749c1a8
GM		 1962 (append param
1963 (list (match-string 0))))
972579f9 1964
972579f9 1965 ;; read default-expression, if there is one
36144b26
SM		 1966 (goto-char (setq apos (match-end 0)))
1967 (setq param
7749c1a8
GM		 1968 (append param
1969 (list
36144b26 1970 (if (setq match-cons
7749c1a8
GM		 1971 (ada-search-ignore-string-comment
1972 ":=" nil epos t 'search-forward))
1973 (buffer-substring (car match-cons) epos)
1974 nil))))
655880d2 1975
972579f9 1976 ;; add this parameter-declaration to the list
36144b26 1977 (setq paramlist (append paramlist (list param)))
972579f9 1978
972579f9 1979 ;; check if it was the last parameter
972579f9 1980 (if (eq epos end)
36144b26 1981 (setq notend nil)
972579f9 1982 (goto-char semipos))
655880d2 1983 )
972579f9
RS		 1984 (reverse paramlist)))
1985
972579f9 1986(defun ada-insert-paramlist (paramlist)
655880d2 1987 "Inserts a formatted PARAMLIST in the buffer."
972579f9
RS		 1988 (let ((i (length paramlist))
1989 (parlen 0)
1990 (typlen 0)
972579f9
RS		 1991 (inp nil)
1992 (outp nil)
5e1cecee 1993 (accessp nil)
972579f9 1994 (column nil)
972579f9
RS		 1995 (firstcol nil))
1996
972579f9 1997 ;; loop until last parameter
972579f9 1998 (while (not (zerop i))
36144b26 1999 (setq i (1- i))
972579f9 2000
972579f9 2001 ;; get max length of parameter-name
36144b26 2002 (setq parlen (max parlen (length (nth 0 (nth i paramlist)))))
972579f9 2003
972579f9 2004 ;; get max length of type-name
36144b26 2005 (setq typlen (max typlen (length (nth 4 (nth i paramlist)))))
972579f9 2006
972579f9 2007 ;; is there any 'in' ?
36144b26 2008 (setq inp (or inp (nth 1 (nth i paramlist))))
972579f9 2009
972579f9 2010 ;; is there any 'out' ?
36144b26 2011 (setq outp (or outp (nth 2 (nth i paramlist))))
972579f9 2012
5e1cecee 2013 ;; is there any 'access' ?
36144b26 2014 (setq accessp (or accessp (nth 3 (nth i paramlist))))
655880d2 2015 )
972579f9 2016
972579f9 2017 ;; does paramlist already start on a separate line ?
972579f9
RS		 2018 (if (save-excursion
2019 (re-search-backward "^.\\|[^ \t]" nil t)
2020 (looking-at "^."))
2021 ;; yes => re-indent it
7749c1a8
GM		 2022 (progn
2023 (ada-indent-current)
2024 (save-excursion
2025 (if (looking-at "\\(is\\|return\\)")
2026 (replace-match " \\1"))))
655880d2 2027
7749c1a8 2028 ;; no => insert it where we are after removing any whitespace
7749c1a8
GM		 2029 (fixup-whitespace)
2030 (save-excursion
2031 (cond
2032 ((looking-at "[ \t]*\\(\n\\|;\\)")
2033 (replace-match "\\1"))
2034 ((looking-at "[ \t]*\\(is\\|return\\)")
2035 (replace-match " \\1"))))
2036 (insert " "))
972579f9
RS		 2037
2038 (insert "(")
7749c1a8 2039 (ada-indent-current)
972579f9 2040
36144b26
SM		 2041 (setq firstcol (current-column))
2042 (setq i (length paramlist))
972579f9 2043
972579f9 2044 ;; loop until last parameter
972579f9 2045 (while (not (zerop i))
36144b26
SM		 2046 (setq i (1- i))
2047 (setq column firstcol)
972579f9 2048
972579f9 2049 ;; insert parameter-name, space and colon
972579f9
RS		 2050 (insert (nth 0 (nth i paramlist)))
2051 (indent-to (+ column parlen 1))
2052 (insert ": ")
36144b26 2053 (setq column (current-column))
972579f9 2054
972579f9 2055 ;; insert 'in' or space
972579f9
RS		 2056 (if (nth 1 (nth i paramlist))
2057 (insert "in ")
2058 (if (and
2059 (or inp
5e1cecee 2060 accessp)
972579f9
RS		 2061 (not (nth 3 (nth i paramlist))))
2062 (insert " ")))
2063
972579f9 2064 ;; insert 'out' or space
972579f9
RS		 2065 (if (nth 2 (nth i paramlist))
2066 (insert "out ")
2067 (if (and
2068 (or outp
5e1cecee 2069 accessp)
972579f9
RS		 2070 (not (nth 3 (nth i paramlist))))
2071 (insert " ")))
2072
5e1cecee 2073 ;; insert 'access'
972579f9 2074 (if (nth 3 (nth i paramlist))
5e1cecee 2075 (insert "access "))
972579f9 2076
36144b26 2077 (setq column (current-column))
972579f9 2078
972579f9 2079 ;; insert type-name and, if necessary, space and default-expression
972579f9
RS		 2080 (insert (nth 4 (nth i paramlist)))
2081 (if (nth 5 (nth i paramlist))
2082 (progn
2083 (indent-to (+ column typlen 1))
2084 (insert (nth 5 (nth i paramlist)))))
2085
972579f9 2086 ;; check if it was the last parameter
7749c1a8
GM		 2087 (if (zerop i)
2088 (insert ")")
2089 ;; no => insert ';' and newline and indent
2090 (insert ";")
2091 (newline)
2092 (indent-to firstcol))
655880d2 2093 )
972579f9 2094
7749c1a8 2095 ;; if anything follows, except semicolon, newline, is or return
972579f9 2096 ;; put it in a new line and indent it
7749c1a8
GM		 2097 (unless (looking-at "[ \t]*\\(;\\|\n\\|is\\|return\\)")
2098 (ada-indent-newline-indent))
972579f9
RS		 2099 ))
2100
972579f9
RS		 2101
2102\f
655880d2
GM		 2103;;;----------------------------------------------------------------
2104;; Indentation Engine
2105;; All indentations are indicated as a two-element string:
2106;; - position of reference in the buffer
2107;; - offset to indent from this position (can also be a symbol or a list
2108;; that are evaluated)
2109;; Thus the total indentation for a line is the column number of the reference
2110;; position plus whatever value the evaluation of the second element provides.
2111;; This mechanism is used so that the ada-mode can "explain" how the
2112;; indentation was calculated, by showing which variables were used.
2113;;
2114;; The indentation itself is done in only one pass: first we try to guess in
2115;; what context we are by looking at the following keyword or punctuation
2116;; sign. If nothing remarkable is found, just try to guess the indentation
2117;; based on previous lines.
2118;;
2119;; The relevant functions for indentation are:
2120;; - `ada-indent-region': Re-indent a region of text
2121;; - `ada-justified-indent-current': Re-indent the current line and shows the
2122;; calculation that were done
2123;; - `ada-indent-current': Re-indent the current line
2124;; - `ada-get-current-indent': Calculate the indentation for the current line,
2125;; based on the context (see above).
2126;; - `ada-get-indent-*': Calculate the indentation in a specific context.
4cc7e498
GM		 2127;; For efficiency, these functions do not check they are in the correct
2128;; context.
655880d2 2129;;;----------------------------------------------------------------
972579f9 2130
972579f9 2131(defun ada-indent-region (beg end)
4cc7e498 2132 "Indent the region between BEG end END."
972579f9
RS		 2133 (interactive "*r")
2134 (goto-char beg)
f139ce87 2135 (let ((block-done 0)
7749c1a8 2136 (lines-remaining (count-lines beg end))
4cc7e498 2137 (msg (format "%%4d out of %4d lines remaining ..."
7749c1a8 2138 (count-lines beg end)))
f139ce87
KH		 2139 (endmark (copy-marker end)))
2140 ;; catch errors while indenting
7749c1a8
GM		 2141 (while (< (point) endmark)
2142 (if (> block-done 39)
4cc7e498
GM		 2143 (progn
2144 (setq lines-remaining (- lines-remaining block-done)
2145 block-done 0)
2146 (message msg lines-remaining)))
2147 (if (= (char-after) ?\n) nil
7749c1a8
GM		 2148 (ada-indent-current))
2149 (forward-line 1)
4cc7e498 2150 (setq block-done (1+ block-done)))
f139ce87 2151 (message "indenting ... done")))
972579f9 2152
972579f9
RS		 2153(defun ada-indent-newline-indent ()
2154 "Indents the current line, inserts a newline and then indents the new line."
2155 (interactive "*")
cadd3658
RS		 2156 (ada-indent-current)
2157 (newline)
2158 (ada-indent-current))
972579f9 2159
7749c1a8 2160(defun ada-indent-newline-indent-conditional ()
655880d2
GM		 2161 "Insert a newline and indent it.
2162The original line is indented first if `ada-indent-after-return' is non-nil.
2163This function is intended to be bound to the \C-m and \C-j keys."
7749c1a8
GM		 2164 (interactive "*")
2165 (if ada-indent-after-return (ada-indent-current))
2166 (newline)
2167 (ada-indent-current))
2168
2169(defun ada-justified-indent-current ()
655880d2 2170 "Indent the current line and explains how the calculation was done."
7749c1a8
GM		 2171 (interactive)
2172
2173 (let ((cur-indent (ada-indent-current)))
2174
4607c7f4
SM		 2175 (let ((line (save-excursion
2176 (goto-char (car cur-indent))
80d50f88 2177 (count-lines 1 (point)))))
4607c7f4
SM		 2178
2179 (if (equal (cdr cur-indent) '(0))
2180 (message (concat "same indentation as line " (number-to-string line)))
2181 (message (mapconcat (lambda(x)
2182 (cond
2183 ((symbolp x)
2184 (symbol-name x))
2185 ((numberp x)
2186 (number-to-string x))
2187 ((listp x)
2188 (concat "- " (symbol-name (cadr x))))
2189 ))
2190 (cdr cur-indent)
2191 " + "))))
7749c1a8
GM		 2192 (save-excursion
2193 (goto-char (car cur-indent))
2194 (sit-for 1))))
972579f9 2195
4cc7e498
GM		 2196(defun ada-batch-reformat ()
2197 "Re-indent and re-case all the files found on the command line.
2198This function should be used from the Unix/Windows command line, with a
2199command like:
2200 emacs -batch -l ada-mode -f ada-batch-reformat file1 file2 ..."
2201
2202 (while command-line-args-left
2203 (let ((source (car command-line-args-left)))
2204 (message (concat "formating " source))
2205 (find-file source)
2206 (ada-indent-region (point-min) (point-max))
2207 (ada-adjust-case-buffer)
2208 (write-file source))
36144b26 2209 (setq command-line-args-left (cdr command-line-args-left)))
4cc7e498
GM		 2210 (message "Done")
2211 (kill-emacs 0))
2212
2213(defsubst ada-goto-previous-word ()
2214 "Moves point to the beginning of the previous word of Ada code.
2215Returns the new position of point or nil if not found."
2216 (ada-goto-next-word t))
2217
972579f9 2218(defun ada-indent-current ()
655880d2
GM		 2219 "Indent current line as Ada code.
2220Returns the calculation that was done, including the reference point and the
2221offset."
972579f9 2222 (interactive)
7749c1a8 2223 (let ((previous-syntax-table (syntax-table))
4cc7e498
GM		 2224 (orgpoint (point-marker))
2225 cur-indent tmp-indent
2226 prev-indent)
972579f9 2227
7749c1a8
GM		 2228 (unwind-protect
2229 (progn
4cc7e498 2230 (set-syntax-table ada-mode-symbol-syntax-table)
f139ce87 2231
4cc7e498
GM		 2232 ;; This need to be done here so that the advice is not always
2233 ;; activated (this might interact badly with other modes)
6f9a2614 2234 (if (featurep 'xemacs)
4cc7e498
GM		 2235 (ad-activate 'parse-partial-sexp t))
2236
2237 (save-excursion
36144b26 2238 (setq cur-indent
4cc7e498
GM		 2239
2240 ;; Not First line in the buffer ?
2241 (if (save-excursion (zerop (forward-line -1)))
2242 (progn
2243 (back-to-indentation)
2244 (ada-get-current-indent))
2245
2246 ;; first line in the buffer
2247 (list (point-min) 0))))
2248
2249 ;; Evaluate the list to get the column to indent to
2250 ;; prev-indent contains the column to indent to
2251 (if cur-indent
2252 (setq prev-indent (save-excursion (goto-char (car cur-indent))
2253 (current-column))
2254 tmp-indent (cdr cur-indent))
2255 (setq prev-indent 0 tmp-indent '()))
eaae8106 2256
4cc7e498
GM		 2257 (while (not (null tmp-indent))
2258 (cond
2259 ((numberp (car tmp-indent))
36144b26 2260 (setq prev-indent (+ prev-indent (car tmp-indent))))
4cc7e498 2261 (t
36144b26 2262 (setq prev-indent (+ prev-indent (eval (car tmp-indent)))))
4cc7e498 2263 )
36144b26 2264 (setq tmp-indent (cdr tmp-indent)))
4cc7e498
GM		 2265
2266 ;; only re-indent if indentation is different then the current
2267 (if (= (save-excursion (back-to-indentation) (current-column)) prev-indent)
2268 nil
2269 (beginning-of-line)
2270 (delete-horizontal-space)
2271 (indent-to prev-indent))
2272 ;;
2273 ;; restore position of point
2274 ;;
2275 (goto-char orgpoint)
2276 (if (< (current-column) (current-indentation))
2277 (back-to-indentation)))
2278
2279 ;; restore syntax-table
2280 (set-syntax-table previous-syntax-table)
6f9a2614 2281 (if (featurep 'xemacs)
4cc7e498
GM		 2282 (ad-deactivate 'parse-partial-sexp))
2283 )
655880d2 2284
7749c1a8
GM		 2285 cur-indent
2286 ))
972579f9 2287
7749c1a8 2288(defun ada-get-current-indent ()
4cc7e498 2289 "Return the indentation to use for the current line."
7749c1a8 2290 (let (column
4cc7e498
GM		 2291 pos
2292 match-cons
2293 result
2294 (orgpoint (save-excursion
2295 (beginning-of-line)
2296 (forward-comment -10000)
2297 (forward-line 1)
2298 (point))))
2299
36144b26 2300 (setq result
972579f9 2301 (cond
7749c1a8 2302
4cc7e498 2303 ;;-----------------------------
972579f9 2304 ;; in open parenthesis, but not in parameter-list
4cc7e498 2305 ;;-----------------------------
eaae8106 2306
4cc7e498
GM		 2307 ((and ada-indent-to-open-paren
2308 (not (ada-in-paramlist-p))
36144b26 2309 (setq column (ada-in-open-paren-p)))
eaae8106 2310
972579f9 2311 ;; check if we have something like this (Table_Component_Type =>
7749c1a8 2312 ;; Source_File_Record)
972579f9 2313 (save-excursion
4607c7f4
SM		 2314
2315 ;; Align the closing parenthesis on the opening one
2316 (if (= (following-char) ?\))
2317 (save-excursion
2318 (goto-char column)
2319 (skip-chars-backward " \t")
2320 (list (1- (point)) 0))
a1506d29 2321
4607c7f4
SM		 2322 (if (and (skip-chars-backward " \t")
2323 (= (char-before) ?\n)
2324 (not (forward-comment -10000))
2325 (= (char-before) ?>))
2326 ;; ??? Could use a different variable
2327 (list column 'ada-broken-indent)
2328
80d50f88
SM		 2329 ;; We want all continuation lines to be indented the same
2330 ;; (ada-broken-line from the opening parenthesis. However, in
2331 ;; parameter list, each new parameter should be indented at the
2332 ;; column as the opening parenthesis.
2333
2334 ;; A special case to handle nested boolean expressions, as in
2335 ;; ((B
2336 ;; and then C) -- indented by ada-broken-indent
2337 ;; or else D) -- indenting this line.
2338 ;; ??? This is really a hack, we should have a proper way to go to
2339 ;; ??? the beginning of the statement
a1506d29 2340
80d50f88
SM		 2341 (if (= (char-before) ?\))
2342 (backward-sexp))
a1506d29 2343
80d50f88
SM		 2344 (if (memq (char-before) '(?, ?\; ?\( ?\)))
2345 (list column 0)
2346 (list column 'ada-continuation-indent)
2347 )))))
972579f9 2348
4cc7e498
GM		 2349 ;;---------------------------
2350 ;; at end of buffer
2351 ;;---------------------------
972579f9 2352
4cc7e498
GM		 2353 ((not (char-after))
2354 (ada-indent-on-previous-lines nil orgpoint orgpoint))
eaae8106 2355
4cc7e498
GM		 2356 ;;---------------------------
2357 ;; starting with e
2358 ;;---------------------------
eaae8106 2359
4607c7f4 2360 ((= (downcase (char-after)) ?e)
4cc7e498 2361 (cond
972579f9 2362
4cc7e498 2363 ;; ------- end ------
eaae8106 2364
4cc7e498
GM		 2365 ((looking-at "end\\>")
2366 (let ((label 0)
2367 limit)
2368 (save-excursion
2369 (ada-goto-matching-start 1)
eaae8106 2370
4cc7e498
GM		 2371 ;;
2372 ;; found 'loop' => skip back to 'while' or 'for'
2373 ;; if 'loop' is not on a separate line
2374 ;; Stop the search for 'while' and 'for' when a ';' is encountered.
2375 ;;
2376 (if (save-excursion
2377 (beginning-of-line)
2378 (looking-at ".+\\<loop\\>"))
2379 (progn
2380 (save-excursion
36144b26 2381 (setq limit (car (ada-search-ignore-string-comment ";" t))))
4cc7e498
GM		 2382 (if (save-excursion
2383 (and
36144b26 2384 (setq match-cons
4cc7e498
GM		 2385 (ada-search-ignore-string-comment ada-loop-start-re t limit))
2386 (not (looking-at "\\<loop\\>"))))
2387 (progn
2388 (goto-char (car match-cons))
2389 (save-excursion
2390 (beginning-of-line)
2391 (if (looking-at ada-named-block-re)
36144b26 2392 (setq label (- ada-label-indent))))))))
a1506d29 2393
4607c7f4
SM		 2394 ;; found 'record' =>
2395 ;; if the keyword is found at the beginning of a line (or just
2396 ;; after limited, we indent on it, otherwise we indent on the
2397 ;; beginning of the type declaration)
2398 ;; type A is (B : Integer;
2399 ;; C : Integer) is record
2400 ;; end record; -- This is badly indented otherwise
2401 (if (looking-at "record")
2402 (if (save-excursion
2403 (beginning-of-line)
2404 (looking-at "^[ \t]*\\(record\\|limited record\\)"))
2405 (list (save-excursion (back-to-indentation) (point)) 0)
2406 (list (save-excursion
2407 (car (ada-search-ignore-string-comment "\\<type\\>" t)))
2408 0))
2409
2410 ;; Else keep the same indentation as the beginning statement
2411 (list (+ (save-excursion (back-to-indentation) (point)) label) 0)))))
4cc7e498
GM		 2412
2413 ;; ------ exception ----
eaae8106 2414
4cc7e498
GM		 2415 ((looking-at "exception\\>")
2416 (save-excursion
2417 (ada-goto-matching-start 1)
2418 (list (save-excursion (back-to-indentation) (point)) 0)))
2419
2420 ;; else
eaae8106 2421
4cc7e498
GM		 2422 ((looking-at "else\\>")
2423 (if (save-excursion (ada-goto-previous-word)
2424 (looking-at "\\<or\\>"))
2425 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2426 (save-excursion
2427 (ada-goto-matching-start 1 nil t)
2428 (list (progn (back-to-indentation) (point)) 0))))
2429
2430 ;; elsif
a1506d29 2431
4cc7e498
GM		 2432 ((looking-at "elsif\\>")
2433 (save-excursion
2434 (ada-goto-matching-start 1 nil t)
2435 (list (progn (back-to-indentation) (point)) 0)))
2436
2437 ))
2438
2439 ;;---------------------------
2440 ;; starting with w (when)
2441 ;;---------------------------
a1506d29 2442
4607c7f4 2443 ((and (= (downcase (char-after)) ?w)
4cc7e498 2444 (looking-at "when\\>"))
972579f9 2445 (save-excursion
4cc7e498
GM		 2446 (ada-goto-matching-start 1)
2447 (list (save-excursion (back-to-indentation) (point))
2448 'ada-when-indent)))
2449
2450 ;;---------------------------
2451 ;; starting with t (then)
2452 ;;---------------------------
2453
4607c7f4 2454 ((and (= (downcase (char-after)) ?t)
4cc7e498 2455 (looking-at "then\\>"))
7749c1a8 2456 (if (save-excursion (ada-goto-previous-word)
4cc7e498 2457 (looking-at "and\\>"))
7749c1a8 2458 (ada-indent-on-previous-lines nil orgpoint orgpoint)
4cc7e498
GM		 2459 (save-excursion
2460 ;; Select has been added for the statement: "select ... then abort"
2461 (ada-search-ignore-string-comment
2462 "\\<\\(elsif\\|if\\|select\\)\\>" t nil)
2463 (list (progn (back-to-indentation) (point))
2464 'ada-stmt-end-indent))))
2465
2466 ;;---------------------------
2467 ;; starting with l (loop)
2468 ;;---------------------------
a1506d29 2469
4607c7f4 2470 ((and (= (downcase (char-after)) ?l)
4cc7e498 2471 (looking-at "loop\\>"))
36144b26 2472 (setq pos (point))
972579f9
RS		 2473 (save-excursion
2474 (goto-char (match-end 0))
2475 (ada-goto-stmt-start)
7749c1a8 2476 (if (looking-at "\\<\\(loop\\|if\\)\\>")
4cc7e498
GM		 2477 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2478 (unless (looking-at ada-loop-start-re)
2479 (ada-search-ignore-string-comment ada-loop-start-re
2480 nil pos))
2481 (if (looking-at "\\<loop\\>")
2482 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2483 (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))))
2484
4607c7f4
SM		 2485 ;;----------------------------
2486 ;; starting with l (limited) or r (record)
2487 ;;----------------------------
a1506d29 2488
4607c7f4
SM		 2489 ((or (and (= (downcase (char-after)) ?l)
2490 (looking-at "limited\\>"))
2491 (and (= (downcase (char-after)) ?r)
2492 (looking-at "record\\>")))
2493
2494 (save-excursion
2495 (ada-search-ignore-string-comment
2496 "\\<\\(type\\|use\\)\\>" t nil)
2497 (if (looking-at "\\<use\\>")
2498 (ada-search-ignore-string-comment "for" t nil nil
2499 'word-search-backward))
2500 (list (progn (back-to-indentation) (point))
2501 'ada-indent-record-rel-type)))
2502
4cc7e498
GM		 2503 ;;---------------------------
2504 ;; starting with b (begin)
2505 ;;---------------------------
2506
4607c7f4 2507 ((and (= (downcase (char-after)) ?b)
4cc7e498 2508 (looking-at "begin\\>"))
972579f9
RS		 2509 (save-excursion
2510 (if (ada-goto-matching-decl-start t)
4cc7e498
GM		 2511 (list (progn (back-to-indentation) (point)) 0)
2512 (ada-indent-on-previous-lines nil orgpoint orgpoint))))
2513
2514 ;;---------------------------
2515 ;; starting with i (is)
2516 ;;---------------------------
2517
4607c7f4 2518 ((and (= (downcase (char-after)) ?i)
4cc7e498 2519 (looking-at "is\\>"))
eaae8106 2520
7749c1a8 2521 (if (and ada-indent-is-separate
4cc7e498
GM		 2522 (save-excursion
2523 (goto-char (match-end 0))
2524 (ada-goto-next-non-ws (save-excursion (end-of-line)
2525 (point)))
2526 (looking-at "\\<abstract\\>\\|\\<separate\\>")))
972579f9
RS		 2527 (save-excursion
2528 (ada-goto-stmt-start)
4cc7e498 2529 (list (progn (back-to-indentation) (point)) 'ada-indent))
972579f9
RS		 2530 (save-excursion
2531 (ada-goto-stmt-start)
80d50f88
SM		 2532 (if (looking-at "\\<package\\|procedure\\|function\\>")
2533 (list (progn (back-to-indentation) (point)) 0)
2534 (list (progn (back-to-indentation) (point)) 'ada-indent)))))
4cc7e498
GM		 2535
2536 ;;---------------------------
4607c7f4 2537 ;; starting with r (return, renames)
4cc7e498
GM		 2538 ;;---------------------------
2539
4607c7f4
SM		 2540 ((and (= (downcase (char-after)) ?r)
2541 (looking-at "re\\(turn\\|names\\)\\>"))
a1506d29 2542
4607c7f4
SM		 2543 (save-excursion
2544 (let ((var 'ada-indent-return))
2545 ;; If looking at a renames, skip the 'return' statement too
2546 (if (looking-at "renames")
2547 (let (pos)
2548 (save-excursion
2549 (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
2550 (if (and pos
2551 (= (downcase (char-after (car pos))) ?r))
2552 (goto-char (car pos)))
2553 (set 'var 'ada-indent-renames)))
a1506d29 2554
4607c7f4
SM		 2555 (forward-comment -1000)
2556 (if (= (char-before) ?\))
2557 (forward-sexp -1)
2558 (forward-word -1))
a1506d29 2559
4607c7f4
SM		 2560 ;; If there is a parameter list, and we have a function declaration
2561 ;; or a access to subprogram declaration
2562 (let ((num-back 1))
2563 (if (and (= (following-char) ?\()
2564 (save-excursion
2565 (or (progn
2566 (backward-word 1)
2567 (looking-at "\\(function\\|procedure\\)\\>"))
2568 (progn
2569 (backward-word 1)
2570 (set 'num-back 2)
2571 (looking-at "\\(function\\|procedure\\)\\>")))))
a1506d29 2572
4607c7f4
SM		 2573 ;; The indentation depends of the value of ada-indent-return
2574 (if (<= (eval var) 0)
2575 (list (point) (list '- var))
2576 (list (progn (backward-word num-back) (point))
2577 var))
a1506d29 2578
4607c7f4
SM		 2579 ;; Else there is no parameter list, but we have a function
2580 ;; Only do something special if the user want to indent
2581 ;; relative to the "function" keyword
2582 (if (and (> (eval var) 0)
2583 (save-excursion (forward-word -1)
2584 (looking-at "function\\>")))
2585 (list (progn (forward-word -1) (point)) var)
a1506d29 2586
4607c7f4
SM		 2587 ;; Else...
2588 (ada-indent-on-previous-lines nil orgpoint orgpoint)))))))
a1506d29 2589
4cc7e498
GM		 2590 ;;--------------------------------
2591 ;; starting with 'o' or 'p'
2592 ;; 'or' as statement-start
2593 ;; 'private' as statement-start
2594 ;;--------------------------------
2595
4607c7f4
SM		 2596 ((and (or (= (downcase (char-after)) ?o)
2597 (= (downcase (char-after)) ?p))
4cc7e498
GM		 2598 (or (ada-looking-at-semi-or)
2599 (ada-looking-at-semi-private)))
972579f9 2600 (save-excursion
4607c7f4
SM		 2601 ;; ??? Wasn't this done already in ada-looking-at-semi-or ?
2602 (ada-goto-matching-start 1)
2603 (list (progn (back-to-indentation) (point)) 0)))
7749c1a8 2604
4cc7e498
GM		 2605 ;;--------------------------------
2606 ;; starting with 'd' (do)
2607 ;;--------------------------------
2608
4607c7f4 2609 ((and (= (downcase (char-after)) ?d)
4cc7e498 2610 (looking-at "do\\>"))
972579f9
RS		 2611 (save-excursion
2612 (ada-goto-stmt-start)
4cc7e498
GM		 2613 (list (progn (back-to-indentation) (point)) 'ada-stmt-end-indent)))
2614
2615 ;;--------------------------------
2616 ;; starting with '-' (comment)
2617 ;;--------------------------------
2618
2619 ((= (char-after) ?-)
2620 (if ada-indent-comment-as-code
2621
2622 ;; Indent comments on previous line comments if required
2623 ;; We must use a search-forward (even if the code is more complex),
2624 ;; since we want to find the beginning of the comment.
2625 (let (pos)
eaae8106 2626
4cc7e498
GM		 2627 (if (and ada-indent-align-comments
2628 (save-excursion
2629 (forward-line -1)
2630 (beginning-of-line)
2631 (while (and (not pos)
2632 (search-forward "--"
2633 (save-excursion
2634 (end-of-line) (point))
2635 t))
2636 (unless (ada-in-string-p)
36144b26 2637 (setq pos (point))))
4cc7e498
GM		 2638 pos))
2639 (list (- pos 2) 0)
eaae8106 2640
4cc7e498
GM		 2641 ;; Else always on previous line
2642 (ada-indent-on-previous-lines nil orgpoint orgpoint)))
2643
2644 ;; Else same indentation as the previous line
2645 (list (save-excursion (back-to-indentation) (point)) 0)))
2646
2647 ;;--------------------------------
2648 ;; starting with '#' (preprocessor line)
2649 ;;--------------------------------
2650
2651 ((and (= (char-after) ?#)
2652 (equal ada-which-compiler 'gnat)
2653 (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)"))
2654 (list (save-excursion (beginning-of-line) (point)) 0))
2655
2656 ;;--------------------------------
2657 ;; starting with ')' (end of a parameter list)
2658 ;;--------------------------------
2659
2660 ((and (not (eobp)) (= (char-after) ?\)))
2661 (save-excursion
2662 (forward-char 1)
2663 (backward-sexp 1)
2664 (list (point) 0)))
2665
2666 ;;---------------------------------
2667 ;; new/abstract/separate
2668 ;;---------------------------------
eaae8106 2669
4cc7e498
GM		 2670 ((looking-at "\\(new\\|abstract\\|separate\\)\\>")
2671 (ada-indent-on-previous-lines nil orgpoint orgpoint))
2672
2673 ;;---------------------------------
972579f9 2674 ;; package/function/procedure
4cc7e498
GM		 2675 ;;---------------------------------
2676
4607c7f4 2677 ((and (or (= (downcase (char-after)) ?p) (= (downcase (char-after)) ?f))
4cc7e498 2678 (looking-at "\\<\\(package\\|function\\|procedure\\)\\>"))
972579f9 2679 (save-excursion
4cc7e498
GM		 2680 ;; Go up until we find either a generic section, or the end of the
2681 ;; previous subprogram/package
2682 (let (found)
2683 (while (and (not found)
2684 (ada-search-ignore-string-comment
2685 "\\<\\(generic\\|end\\|begin\\|package\\|procedure\\|function\\)\\>" t))
eaae8106 2686
4cc7e498
GM		 2687 ;; avoid "with procedure"... in generic parts
2688 (save-excursion
2689 (forward-word -1)
36144b26 2690 (setq found (not (looking-at "with"))))))
eaae8106 2691
4cc7e498 2692 (if (looking-at "generic")
7749c1a8
GM		 2693 (list (progn (back-to-indentation) (point)) 0)
2694 (ada-indent-on-previous-lines nil orgpoint orgpoint))))
eaae8106 2695
4cc7e498 2696 ;;---------------------------------
972579f9 2697 ;; label
4cc7e498 2698 ;;---------------------------------
eaae8106 2699
4cc7e498 2700 ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
972579f9 2701 (if (ada-in-decl-p)
4cc7e498
GM		 2702 (ada-indent-on-previous-lines nil orgpoint orgpoint)
2703 (append (ada-indent-on-previous-lines nil orgpoint orgpoint)
2704 '(ada-label-indent))))
2705
2706 ))
2707
2708 ;;---------------------------------
2709 ;; Other syntaxes
2710 ;;---------------------------------
2711 (or result (ada-indent-on-previous-lines nil orgpoint orgpoint))))
7749c1a8
GM		 2712
2713(defun ada-indent-on-previous-lines (&optional nomove orgpoint initial-pos)
655880d2
GM		 2714 "Calculate the indentation for the new line after ORGPOINT.
2715The result list is based on the previous lines in the buffer.
2716If NOMOVE is nil, moves point to the beginning of the current statement.
2717if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
7749c1a8
GM		 2718 (if initial-pos
2719 (goto-char initial-pos))
4cc7e498
GM		 2720 (let ((oldpoint (point)))
2721
7749c1a8 2722 ;; Is inside a parameter-list ?
972579f9 2723 (if (ada-in-paramlist-p)
4cc7e498 2724 (ada-get-indent-paramlist)
972579f9 2725
7749c1a8 2726 ;; move to beginning of current statement
7749c1a8
GM		 2727 (unless nomove
2728 (ada-goto-stmt-start))
972579f9 2729
4cc7e498
GM		 2730 ;; no beginning found => don't change indentation
2731 (if (and (eq oldpoint (point))
2732 (not nomove))
2733 (ada-get-indent-nochange)
7749c1a8 2734
4cc7e498
GM		 2735 (cond
2736 ;;
2737 ((and
2738 ada-indent-to-open-paren
2739 (ada-in-open-paren-p))
2740 (ada-get-indent-open-paren))
2741 ;;
2742 ((looking-at "end\\>")
2743 (ada-get-indent-end orgpoint))
2744 ;;
2745 ((looking-at ada-loop-start-re)
2746 (ada-get-indent-loop orgpoint))
2747 ;;
2748 ((looking-at ada-subprog-start-re)
2749 (ada-get-indent-subprog orgpoint))
2750 ;;
2751 ((looking-at ada-block-start-re)
2752 (ada-get-indent-block-start orgpoint))
2753 ;;
2754 ((looking-at "\\(sub\\)?type\\>")
2755 (ada-get-indent-type orgpoint))
2756 ;;
2757 ;; "then" has to be included in the case of "select...then abort"
2758 ;; statements, since (goto-stmt-start) at the beginning of
2759 ;; the current function would leave the cursor on that position
2760 ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\\>")
2761 (ada-get-indent-if orgpoint))
2762 ;;
2763 ((looking-at "case\\>")
2764 (ada-get-indent-case orgpoint))
2765 ;;
2766 ((looking-at "when\\>")
2767 (ada-get-indent-when orgpoint))
2768 ;;
2769 ((looking-at "\\(\\sw\\|_\\)+[ \t\n]*:[^=]")
2770 (ada-get-indent-label orgpoint))
2771 ;;
2772 ((looking-at "separate\\>")
2773 (ada-get-indent-nochange))
80d50f88
SM		 2774
2775 ;; A label
2776 ((looking-at "<<")
2777 (list (+ (save-excursion (back-to-indentation) (point))
2778 (- ada-label-indent))))
a1506d29 2779
4cc7e498
GM		 2780 ;;
2781 ((looking-at "with\\>\\|use\\>")
2782 ;; Are we still in that statement, or are we in fact looking at
2783 ;; the previous one ?
2784 (if (save-excursion (search-forward ";" oldpoint t))
2785 (list (progn (back-to-indentation) (point)) 0)
2786 (list (point) (if (looking-at "with")
2787 'ada-with-indent
2788 'ada-use-indent))))
2789 ;;
2790 (t
2791 (ada-get-indent-noindent orgpoint)))))
2792 ))
972579f9 2793
655880d2
GM		 2794(defun ada-get-indent-open-paren ()
2795 "Calculates the indentation when point is behind an unclosed parenthesis."
7749c1a8 2796 (list (ada-in-open-paren-p) 0))
972579f9 2797
655880d2
GM		 2798(defun ada-get-indent-nochange ()
2799 "Return the current indentation of the previous line."
972579f9
RS		 2800 (save-excursion
2801 (forward-line -1)
655880d2
GM		 2802 (back-to-indentation)
2803 (list (point) 0)))
972579f9 2804
655880d2
GM		 2805(defun ada-get-indent-paramlist ()
2806 "Calculates the indentation when point is inside a parameter list."
972579f9
RS		 2807 (save-excursion
2808 (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
2809 (cond
972579f9 2810 ;; in front of the first parameter
7749c1a8 2811 ((= (char-after) ?\()
972579f9 2812 (goto-char (match-end 0))
7749c1a8 2813 (list (point) 0))
655880d2 2814
972579f9 2815 ;; in front of another parameter
7749c1a8 2816 ((= (char-after) ?\;)
972579f9
RS		 2817 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
2818 (ada-goto-next-non-ws)
7749c1a8 2819 (list (point) 0))
655880d2 2820
4607c7f4
SM		 2821 ;; After an affectation (default parameter value in subprogram
2822 ;; declaration)
2823 ((and (= (following-char) ?=) (= (preceding-char) ?:))
2824 (back-to-indentation)
2825 (list (point) 'ada-broken-indent))
2826
972579f9 2827 ;; inside a parameter declaration
972579f9
RS		 2828 (t
2829 (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
2830 (ada-goto-next-non-ws)
4607c7f4 2831 (list (point) 0)))))
972579f9 2832
655880d2
GM		 2833(defun ada-get-indent-end (orgpoint)
2834 "Calculates the indentation when point is just before an end_statement.
2835ORGPOINT is the limit position used in the calculation."
972579f9
RS		 2836 (let ((defun-name nil)
2837 (indent nil))
4cc7e498 2838
972579f9 2839 ;; is the line already terminated by ';' ?
972579f9 2840 (if (save-excursion
655880d2 2841 (ada-search-ignore-string-comment ";" nil orgpoint nil
4cc7e498
GM		 2842 'search-forward))
2843
972579f9 2844 ;; yes, look what's following 'end'
972579f9
RS		 2845 (progn
2846 (forward-word 1)
2847 (ada-goto-next-non-ws)
2848 (cond
4cc7e498
GM		 2849 ((looking-at "\\<\\(loop\\|select\\|if\\|case\\)\\>")
2850 (save-excursion (ada-check-matching-start (match-string 0)))
2851 (list (save-excursion (back-to-indentation) (point)) 0))
2852
972579f9
RS		 2853 ;;
2854 ;; loop/select/if/case/record/select
2855 ;;
7749c1a8 2856 ((looking-at "\\<record\\>")
972579f9 2857 (save-excursion
7749c1a8 2858 (ada-check-matching-start (match-string 0))
4cc7e498
GM		 2859 ;; we are now looking at the matching "record" statement
2860 (forward-word 1)
2861 (ada-goto-stmt-start)
2862 ;; now on the matching type declaration, or use clause
2863 (unless (looking-at "\\(for\\|type\\)\\>")
2864 (ada-search-ignore-string-comment "\\<type\\>" t))
2865 (list (progn (back-to-indentation) (point)) 0)))
972579f9
RS		 2866 ;;
2867 ;; a named block end
2868 ;;
f139ce87 2869 ((looking-at ada-ident-re)
36144b26 2870 (setq defun-name (match-string 0))
4cc7e498
GM		 2871 (save-excursion
2872 (ada-goto-matching-start 0)
2873 (ada-check-defun-name defun-name))
2874 (list (progn (back-to-indentation) (point)) 0))
972579f9
RS		 2875 ;;
2876 ;; a block-end without name
2877 ;;
7749c1a8 2878 ((= (char-after) ?\;)
4cc7e498
GM		 2879 (save-excursion
2880 (ada-goto-matching-start 0)
2881 (if (looking-at "\\<begin\\>")
2882 (progn
36144b26 2883 (setq indent (list (point) 0))
4cc7e498
GM		 2884 (if (ada-goto-matching-decl-start t)
2885 (list (progn (back-to-indentation) (point)) 0)
4607c7f4
SM		 2886 indent))
2887 (list (progn (back-to-indentation) (point)) 0)
2888 )))
972579f9
RS		 2889 ;;
2890 ;; anything else - should maybe signal an error ?
2891 ;;
2892 (t
4cc7e498
GM		 2893 (list (save-excursion (back-to-indentation) (point))
2894 'ada-broken-indent))))
972579f9 2895
655880d2 2896 (list (save-excursion (back-to-indentation) (point))
4cc7e498 2897 'ada-broken-indent))))
972579f9
RS		 2898
2899(defun ada-get-indent-case (orgpoint)
655880d2
GM		 2900 "Calculates the indentation when point is just before a case statement.
2901ORGPOINT is the limit position used in the calculation."
7749c1a8 2902 (let ((match-cons nil)
972579f9
RS		 2903 (opos (point)))
2904 (cond
2905 ;;
2906 ;; case..is..when..=>
2907 ;;
2908 ((save-excursion
36144b26 2909 (setq match-cons (and
cadd3658
RS		 2910 ;; the `=>' must be after the keyword `is'.
2911 (ada-search-ignore-string-comment
7749c1a8 2912 "is" nil orgpoint nil 'word-search-forward)
cadd3658
RS		 2913 (ada-search-ignore-string-comment
2914 "[ \t\n]+=>" nil orgpoint))))
972579f9
RS		 2915 (save-excursion
2916 (goto-char (car match-cons))
7749c1a8
GM		 2917 (unless (ada-search-ignore-string-comment "when" t opos)
2918 (error "missing 'when' between 'case' and '=>'"))
4cc7e498 2919 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))
972579f9
RS		 2920 ;;
2921 ;; case..is..when
2922 ;;
2923 ((save-excursion
36144b26 2924 (setq match-cons (ada-search-ignore-string-comment
7749c1a8 2925 "when" nil orgpoint nil 'word-search-forward)))
972579f9 2926 (goto-char (cdr match-cons))
7749c1a8 2927 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
972579f9
RS		 2928 ;;
2929 ;; case..is
2930 ;;
2931 ((save-excursion
36144b26 2932 (setq match-cons (ada-search-ignore-string-comment
7749c1a8
GM		 2933 "is" nil orgpoint nil 'word-search-forward)))
2934 (list (save-excursion (back-to-indentation) (point)) 'ada-when-indent))
972579f9
RS		 2935 ;;
2936 ;; incomplete case
2937 ;;
2938 (t
655880d2 2939 (list (save-excursion (back-to-indentation) (point))
4cc7e498 2940 'ada-broken-indent)))))
972579f9
RS		 2941
2942(defun ada-get-indent-when (orgpoint)
4cc7e498 2943 "Calculates the indentation when point is just before a when statement.
655880d2 2944ORGPOINT is the limit position used in the calculation."
7749c1a8 2945 (let ((cur-indent (save-excursion (back-to-indentation) (point))))
655880d2 2946 (if (ada-search-ignore-string-comment "[ \t\n]*=>" nil orgpoint)
4cc7e498 2947 (list cur-indent 'ada-indent)
7749c1a8 2948 (list cur-indent 'ada-broken-indent))))
972579f9 2949
972579f9 2950(defun ada-get-indent-if (orgpoint)
655880d2
GM		 2951 "Calculates the indentation when point is just before an if statement.
2952ORGPOINT is the limit position used in the calculation."
7749c1a8 2953 (let ((cur-indent (save-excursion (back-to-indentation) (point)))
972579f9
RS		 2954 (match-cons nil))
2955 ;;
7749c1a8 2956 ;; Move to the correct then (ignore all "and then")
972579f9 2957 ;;
36144b26 2958 (while (and (setq match-cons (ada-search-ignore-string-comment
7749c1a8
GM		 2959 "\\<\\(then\\|and[ \t]*then\\)\\>"
2960 nil orgpoint))
4607c7f4 2961 (= (downcase (char-after (car match-cons))) ?a)))
7749c1a8
GM		 2962 ;; If "then" was found (we are looking at it)
2963 (if match-cons
972579f9
RS		 2964 (progn
2965 ;;
2966 ;; 'then' first in separate line ?
7749c1a8 2967 ;; => indent according to 'then',
4cc7e498 2968 ;; => else indent according to 'if'
972579f9
RS		 2969 ;;
2970 (if (save-excursion
2971 (back-to-indentation)
2972 (looking-at "\\<then\\>"))
36144b26 2973 (setq cur-indent (save-excursion (back-to-indentation) (point))))
4cc7e498 2974 ;; skip 'then'
972579f9 2975 (forward-word 1)
4cc7e498 2976 (list cur-indent 'ada-indent))
972579f9 2977
7749c1a8 2978 (list cur-indent 'ada-broken-indent))))
972579f9 2979
972579f9 2980(defun ada-get-indent-block-start (orgpoint)
655880d2
GM		 2981 "Calculates the indentation when point is at the start of a block.
2982ORGPOINT is the limit position used in the calculation."
7749c1a8 2983 (let ((pos nil))
972579f9
RS		 2984 (cond
2985 ((save-excursion
2986 (forward-word 1)
36144b26 2987 (setq pos (ada-goto-next-non-ws orgpoint)))
972579f9
RS		 2988 (goto-char pos)
2989 (save-excursion
7749c1a8 2990 (ada-indent-on-previous-lines t orgpoint)))
655880d2 2991
4607c7f4
SM		 2992 ;; Special case for record types, for instance for:
2993 ;; type A is (B : Integer;
2994 ;; C : Integer) is record
2995 ;; null; -- This is badly indented otherwise
2996 ((looking-at "record")
2997
2998 ;; If record is at the beginning of the line, indent from there
2999 (if (save-excursion
3000 (beginning-of-line)
3001 (looking-at "^[ \t]*\\(record\\|limited record\\)"))
3002 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)
3003
3004 ;; else indent relative to the type command
3005 (list (save-excursion
3006 (car (ada-search-ignore-string-comment "\\<type\\>" t)))
3007 'ada-indent)))
3008
972579f9 3009 ;; nothing follows the block-start
972579f9 3010 (t
7749c1a8 3011 (list (save-excursion (back-to-indentation) (point)) 'ada-indent)))))
972579f9 3012
972579f9 3013(defun ada-get-indent-subprog (orgpoint)
655880d2
GM		 3014 "Calculates the indentation when point is just before a subprogram.
3015ORGPOINT is the limit position used in the calculation."
972579f9 3016 (let ((match-cons nil)
7749c1a8
GM		 3017 (cur-indent (save-excursion (back-to-indentation) (point)))
3018 (foundis nil))
972579f9
RS		 3019 ;;
3020 ;; is there an 'is' in front of point ?
3021 ;;
3022 (if (save-excursion
36144b26 3023 (setq match-cons
7749c1a8
GM		 3024 (ada-search-ignore-string-comment
3025 "\\<\\(is\\|do\\)\\>" nil orgpoint)))
972579f9
RS		 3026 ;;
3027 ;; yes, then skip to its end
3028 ;;
3029 (progn
36144b26 3030 (setq foundis t)
972579f9
RS		 3031 (goto-char (cdr match-cons)))
3032 ;;
3033 ;; no, then goto next non-ws, if there is one in front of point
3034 ;;
3035 (progn
7749c1a8 3036 (unless (ada-goto-next-non-ws orgpoint)
972579f9
RS		 3037 (goto-char orgpoint))))
3038
3039 (cond
3040 ;;
3041 ;; nothing follows 'is'
3042 ;;
3043 ((and
3044 foundis
3045 (save-excursion
3046 (not (ada-search-ignore-string-comment
3047 "[^ \t\n]" nil orgpoint t))))
7749c1a8 3048 (list cur-indent 'ada-indent))
972579f9
RS		 3049 ;;
3050 ;; is abstract/separate/new ...
3051 ;;
3052 ((and
3053 foundis
3054 (save-excursion
36144b26 3055 (setq match-cons
7749c1a8
GM		 3056 (ada-search-ignore-string-comment
3057 "\\<\\(separate\\|new\\|abstract\\)\\>"
3058 nil orgpoint))))
972579f9 3059 (goto-char (car match-cons))
276c1210 3060 (ada-search-ignore-string-comment ada-subprog-start-re t)
972579f9
RS		 3061 (ada-get-indent-noindent orgpoint))
3062 ;;
3063 ;; something follows 'is'
3064 ;;
3065 ((and
3066 foundis
36144b26 3067 (save-excursion (setq match-cons (ada-goto-next-non-ws orgpoint)))
7749c1a8
GM		 3068 (goto-char match-cons)
3069 (ada-indent-on-previous-lines t orgpoint)))
972579f9
RS		 3070 ;;
3071 ;; no 'is' but ';'
3072 ;;
3073 ((save-excursion
4cc7e498 3074 (ada-search-ignore-string-comment ";" nil orgpoint nil 'search-forward))
7749c1a8 3075 (list cur-indent 0))
972579f9
RS		 3076 ;;
3077 ;; no 'is' or ';'
3078 ;;
3079 (t
7749c1a8 3080 (list cur-indent 'ada-broken-indent)))))
972579f9 3081
972579f9 3082(defun ada-get-indent-noindent (orgpoint)
655880d2
GM		 3083 "Calculates the indentation when point is just before a 'noindent stmt'.
3084ORGPOINT is the limit position used in the calculation."
cadd3658
RS		 3085 (let ((label 0))
3086 (save-excursion
3087 (beginning-of-line)
972579f9 3088
7749c1a8
GM		 3089 (cond
3090
4cc7e498 3091 ;; This one is called when indenting a line preceded by a multi-line
7749c1a8
GM		 3092 ;; subprogram declaration (in that case, we are at this point inside
3093 ;; the parameter declaration list)
3094 ((ada-in-paramlist-p)
3095 (ada-previous-procedure)
4cc7e498 3096 (list (save-excursion (back-to-indentation) (point)) 0))
7749c1a8 3097
655880d2 3098 ;; This one is called when indenting the second line of a multi-line
7749c1a8
GM		 3099 ;; declaration section, in a declare block or a record declaration
3100 ((looking-at "[ \t]*\\(\\sw\\|_\\)*[ \t]*,[ \t]*$")
4cc7e498
GM		 3101 (list (save-excursion (back-to-indentation) (point))
3102 'ada-broken-decl-indent))
7749c1a8
GM		 3103
3104 ;; This one is called in every over case when indenting a line at the
3105 ;; top level
3106 (t
3107 (if (looking-at ada-named-block-re)
36144b26 3108 (setq label (- ada-label-indent))
7749c1a8 3109
4cc7e498
GM		 3110 (let (p)
3111
3112 ;; "with private" or "null record" cases
3113 (if (or (save-excursion
3114 (and (ada-search-ignore-string-comment "\\<private\\>" nil orgpoint)
36144b26 3115 (setq p (point))
4cc7e498
GM		 3116 (save-excursion (forward-char -7);; skip back "private"
3117 (ada-goto-previous-word)
3118 (looking-at "with"))))
3119 (save-excursion
3120 (and (ada-search-ignore-string-comment "\\<record\\>" nil orgpoint)
36144b26 3121 (setq p (point))
4cc7e498
GM		 3122 (save-excursion (forward-char -6);; skip back "record"
3123 (ada-goto-previous-word)
3124 (looking-at "null")))))
3125 (progn
3126 (goto-char p)
3127 (re-search-backward "\\<\\(type\\|subtype\\)\\>" nil t)
3128 (list (save-excursion (back-to-indentation) (point)) 0)))))
7749c1a8 3129 (if (save-excursion
4cc7e498
GM		 3130 (ada-search-ignore-string-comment ";" nil orgpoint nil
3131 'search-forward))
3132 (list (+ (save-excursion (back-to-indentation) (point)) label) 0)
3133 (list (+ (save-excursion (back-to-indentation) (point)) label)
3134 'ada-broken-indent)))))))
972579f9
RS		 3135
3136(defun ada-get-indent-label (orgpoint)
655880d2
GM		 3137 "Calculates the indentation when before a label or variable declaration.
3138ORGPOINT is the limit position used in the calculation."
972579f9 3139 (let ((match-cons nil)
7749c1a8
GM		 3140 (cur-indent (save-excursion (back-to-indentation) (point))))
3141 (ada-search-ignore-string-comment ":" nil)
972579f9 3142 (cond
972579f9 3143 ;; loop label
972579f9 3144 ((save-excursion
36144b26 3145 (setq match-cons (ada-search-ignore-string-comment
4cc7e498 3146 ada-loop-start-re nil orgpoint)))
972579f9
RS		 3147 (goto-char (car match-cons))
3148 (ada-get-indent-loop orgpoint))
7749c1a8 3149
972579f9 3150 ;; declare label
972579f9 3151 ((save-excursion
36144b26 3152 (setq match-cons (ada-search-ignore-string-comment
4cc7e498 3153 "\\<declare\\|begin\\>" nil orgpoint)))
7749c1a8
GM		 3154 (goto-char (car match-cons))
3155 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
3156
3157 ;; variable declaration
3158 ((ada-in-decl-p)
3159 (if (save-excursion
3160 (ada-search-ignore-string-comment ";" nil orgpoint))
3161 (list cur-indent 0)
4cc7e498 3162 (list cur-indent 'ada-broken-indent)))
7749c1a8 3163
972579f9 3164 ;; nothing follows colon
972579f9 3165 (t
7749c1a8 3166 (list cur-indent '(- ada-label-indent))))))
972579f9
RS		 3167
3168(defun ada-get-indent-loop (orgpoint)
655880d2
GM		 3169 "Calculates the indentation when just before a loop or a for ... use.
3170ORGPOINT is the limit position used in the calculation."
972579f9 3171 (let ((match-cons nil)
cadd3658 3172 (pos (point))
7749c1a8 3173
4cc7e498 3174 ;; If looking at a named block, skip the label
cadd3658
RS		 3175 (label (save-excursion
3176 (beginning-of-line)
3177 (if (looking-at ada-named-block-re)
3178 (- ada-label-indent)
3179 0))))
7749c1a8 3180
972579f9
RS		 3181 (cond
3182
3183 ;;
3184 ;; statement complete
3185 ;;
3186 ((save-excursion
655880d2 3187 (ada-search-ignore-string-comment ";" nil orgpoint nil
4cc7e498 3188 'search-forward))
7749c1a8 3189 (list (+ (save-excursion (back-to-indentation) (point)) label) 0))
972579f9
RS		 3190 ;;
3191 ;; simple loop
3192 ;;
3193 ((looking-at "loop\\>")
36144b26 3194 (setq pos (ada-get-indent-block-start orgpoint))
7749c1a8 3195 (if (equal label 0)
4cc7e498
GM		 3196 pos
3197 (list (+ (car pos) label) (cdr pos))))
972579f9
RS		 3198
3199 ;;
3200 ;; 'for'- loop (or also a for ... use statement)
3201 ;;
3202 ((looking-at "for\\>")
3203 (cond
3204 ;;
3205 ;; for ... use
3206 ;;
3207 ((save-excursion
3208 (and
3209 (goto-char (match-end 0))
7749c1a8
GM		 3210 (ada-goto-next-non-ws orgpoint)
3211 (forward-word 1)
3212 (if (= (char-after) ?') (forward-word 1) t)
3213 (ada-goto-next-non-ws orgpoint)
972579f9
RS		 3214 (looking-at "\\<use\\>")
3215 ;;
3216 ;; check if there is a 'record' before point
3217 ;;
3218 (progn
36144b26 3219 (setq match-cons (ada-search-ignore-string-comment
7749c1a8 3220 "record" nil orgpoint nil 'word-search-forward))
972579f9
RS		 3221 t)))
3222 (if match-cons
f7a80909
JB		 3223 (progn
3224 (goto-char (car match-cons))
3225 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
3226 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
3227 )
3228
972579f9
RS		 3229 ;;
3230 ;; for..loop
3231 ;;
3232 ((save-excursion
36144b26 3233 (setq match-cons (ada-search-ignore-string-comment
7749c1a8 3234 "loop" nil orgpoint nil 'word-search-forward)))
972579f9
RS		 3235 (goto-char (car match-cons))
3236 ;;
3237 ;; indent according to 'loop', if it's first in the line;
3238 ;; otherwise to 'for'
3239 ;;
7749c1a8
GM		 3240 (unless (save-excursion
3241 (back-to-indentation)
3242 (looking-at "\\<loop\\>"))
3243 (goto-char pos))
4cc7e498
GM		 3244 (list (+ (save-excursion (back-to-indentation) (point)) label)
3245 'ada-indent))
972579f9
RS		 3246 ;;
3247 ;; for-statement is broken
3248 ;;
3249 (t
4cc7e498
GM		 3250 (list (+ (save-excursion (back-to-indentation) (point)) label)
3251 'ada-broken-indent))))
972579f9
RS		 3252
3253 ;;
3254 ;; 'while'-loop
3255 ;;
3256 ((looking-at "while\\>")
3257 ;;
3258 ;; while..loop ?
3259 ;;
3260 (if (save-excursion
36144b26 3261 (setq match-cons (ada-search-ignore-string-comment
7749c1a8 3262 "loop" nil orgpoint nil 'word-search-forward)))
972579f9
RS		 3263
3264 (progn
3265 (goto-char (car match-cons))
3266 ;;
3267 ;; indent according to 'loop', if it's first in the line;
3268 ;; otherwise to 'while'.
3269 ;;
7749c1a8
GM		 3270 (unless (save-excursion
3271 (back-to-indentation)
3272 (looking-at "\\<loop\\>"))
3273 (goto-char pos))
4cc7e498
GM		 3274 (list (+ (save-excursion (back-to-indentation) (point)) label)
3275 'ada-indent))
972579f9 3276
4cc7e498
GM		 3277 (list (+ (save-excursion (back-to-indentation) (point)) label)
3278 'ada-broken-indent))))))
972579f9
RS		 3279
3280(defun ada-get-indent-type (orgpoint)
655880d2
GM		 3281 "Calculates the indentation when before a type statement.
3282ORGPOINT is the limit position used in the calculation."
972579f9
RS		 3283 (let ((match-dat nil))
3284 (cond
3285 ;;
3286 ;; complete record declaration
3287 ;;
3288 ((save-excursion
3289 (and
36144b26 3290 (setq match-dat (ada-search-ignore-string-comment
7749c1a8 3291 "end" nil orgpoint nil 'word-search-forward))
972579f9
RS		 3292 (ada-goto-next-non-ws)
3293 (looking-at "\\<record\\>")
3294 (forward-word 1)
3295 (ada-goto-next-non-ws)
7749c1a8 3296 (= (char-after) ?\;)))
972579f9 3297 (goto-char (car match-dat))
7749c1a8 3298 (list (save-excursion (back-to-indentation) (point)) 0))
972579f9
RS		 3299 ;;
3300 ;; record type
3301 ;;
3302 ((save-excursion
36144b26 3303 (setq match-dat (ada-search-ignore-string-comment
7749c1a8 3304 "record" nil orgpoint nil 'word-search-forward)))
972579f9 3305 (goto-char (car match-dat))
7749c1a8 3306 (list (save-excursion (back-to-indentation) (point)) 'ada-indent))
972579f9
RS		 3307 ;;
3308 ;; complete type declaration
3309 ;;
3310 ((save-excursion
655880d2 3311 (ada-search-ignore-string-comment ";" nil orgpoint nil
4cc7e498 3312 'search-forward))
7749c1a8 3313 (list (save-excursion (back-to-indentation) (point)) 0))
972579f9 3314 ;;
f139ce87 3315 ;; "type ... is", but not "type ... is ...", which is broken
972579f9
RS		 3316 ;;
3317 ((save-excursion
7749c1a8 3318 (and
655880d2 3319 (ada-search-ignore-string-comment "is" nil orgpoint nil
4cc7e498 3320 'word-search-forward)
7749c1a8
GM		 3321 (not (ada-goto-next-non-ws orgpoint))))
3322 (list (save-excursion (back-to-indentation) (point)) 'ada-broken-indent))
972579f9
RS		 3323 ;;
3324 ;; broken statement
3325 ;;
3326 (t
655880d2 3327 (list (save-excursion (back-to-indentation) (point))
4cc7e498 3328 'ada-broken-indent)))))
972579f9
RS		 3329
3330\f
655880d2
GM		 3331;; -----------------------------------------------------------
3332;; -- searching and matching
3333;; -----------------------------------------------------------
3334
3335(defun ada-goto-stmt-start ()
3336 "Moves point to the beginning of the statement that point is in or after.
3337Returns the new position of point.
3338As a special case, if we are looking at a closing parenthesis, skip to the
3339open parenthesis."
972579f9
RS		 3340 (let ((match-dat nil)
3341 (orgpoint (point)))
3342
36144b26 3343 (setq match-dat (ada-search-prev-end-stmt))
972579f9 3344 (if match-dat
eaae8106 3345
4cc7e498
GM		 3346 ;;
3347 ;; found a previous end-statement => check if anything follows
3348 ;;
3349 (unless (looking-at "declare")
3350 (progn
3351 (unless (save-excursion
3352 (goto-char (cdr match-dat))
3353 (ada-goto-next-non-ws orgpoint))
3354 ;;
3355 ;; nothing follows => it's the end-statement directly in
3356 ;; front of point => search again
3357 ;;
36144b26 3358 (setq match-dat (ada-search-prev-end-stmt)))
4cc7e498
GM		 3359 ;;
3360 ;; if found the correct end-statement => goto next non-ws
3361 ;;
3362 (if match-dat
3363 (goto-char (cdr match-dat)))
3364 (ada-goto-next-non-ws)
3365 ))
eaae8106 3366
972579f9
RS		 3367 ;;
3368 ;; no previous end-statement => we are at the beginning of the
3369 ;; accessible part of the buffer
3370 ;;
3371 (progn
4cc7e498
GM		 3372 (goto-char (point-min))
3373 ;;
3374 ;; skip to the very first statement, if there is one
3375 ;;
3376 (unless (ada-goto-next-non-ws orgpoint)
3377 (goto-char orgpoint))))
972579f9
RS		 3378 (point)))
3379
3380
655880d2
GM		 3381(defun ada-search-prev-end-stmt ()
3382 "Moves point to previous end-statement.
3383Returns a cons cell whose car is the beginning and whose cdr the end of the
3384match."
972579f9 3385 (let ((match-dat nil)
4cc7e498 3386 (found nil))
7749c1a8 3387
972579f9 3388 ;; search until found or beginning-of-buffer
972579f9
RS		 3389 (while
3390 (and
3391 (not found)
36144b26 3392 (setq match-dat (ada-search-ignore-string-comment
655880d2 3393 ada-end-stmt-re t)))
972579f9
RS		 3394
3395 (goto-char (car match-dat))
7749c1a8 3396 (unless (ada-in-open-paren-p)
80d50f88 3397 (cond
a1506d29 3398
80d50f88
SM		 3399 ((and (looking-at
3400 "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
3401 (save-excursion
3402 (ada-goto-previous-word)
3403 (looking-at "\\<\\(end\\|or\\|and\\)\\>[ \t]*[^;]")))
3404 (forward-word -1))
3405
3406 ((looking-at "is")
3407 (setq found
3408 (and (save-excursion (ada-goto-previous-word)
3409 (ada-goto-previous-word)
3410 (not (looking-at "subtype")))
a1506d29 3411
80d50f88
SM		 3412 (save-excursion (goto-char (cdr match-dat))
3413 (ada-goto-next-non-ws)
3414 ;; words that can go after an 'is'
3415 (not (looking-at
3416 (eval-when-compile
3417 (concat "\\<"
3418 (regexp-opt
3419 '("separate" "access" "array"
3420 "abstract" "new") t)
3421 "\\>\\|("))))))))
a1506d29 3422
80d50f88
SM		 3423 (t
3424 (setq found t))
3425 )))
972579f9
RS		 3426
3427 (if found
3428 match-dat
3429 nil)))
3430
3431
3432(defun ada-goto-next-non-ws (&optional limit)
655880d2
GM		 3433 "Skips white spaces, newlines and comments to next non-ws character.
3434Stop the search at LIMIT.
7749c1a8
GM		 3435Do not call this function from within a string."
3436 (unless limit
36144b26 3437 (setq limit (point-max)))
7749c1a8
GM		 3438 (while (and (<= (point) limit)
3439 (progn (forward-comment 10000)
3440 (if (and (not (eobp))
3441 (save-excursion (forward-char 1)
3442 (ada-in-string-p)))
3443 (progn (forward-sexp 1) t)))))
3444 (if (< (point) limit)
3445 (point)
3446 nil)
3447 )
972579f9
RS		 3448
3449
3450(defun ada-goto-stmt-end (&optional limit)
655880d2
GM		 3451 "Moves point to the end of the statement that point is in or before.
3452Returns the new position of point or nil if not found.
3453Stop the search at LIMIT."
972579f9
RS		 3454 (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
3455 (point)
3456 nil))
3457
3458
cadd3658 3459(defun ada-goto-next-word (&optional backward)
655880d2
GM		 3460 "Moves point to the beginning of the next word of Ada code.
3461If BACKWARD is non-nil, jump to the beginning of the previous word.
3462Returns the new position of point or nil if not found."
972579f9 3463 (let ((match-cons nil)
7749c1a8
GM		 3464 (orgpoint (point))
3465 (old-syntax (char-to-string (char-syntax ?_))))
3466 (modify-syntax-entry ?_ "w")
3467 (unless backward
4cc7e498 3468 (skip-syntax-forward "w"))
36144b26 3469 (if (setq match-cons
7749c1a8
GM		 3470 (if backward
3471 (ada-search-ignore-string-comment "\\w" t nil t)
3472 (ada-search-ignore-string-comment "\\w" nil nil t)))
972579f9
RS		 3473 ;;
3474 ;; move to the beginning of the word found
3475 ;;
3476 (progn
cadd3658 3477 (goto-char (car match-cons))
7749c1a8 3478 (skip-syntax-backward "w")
972579f9
RS		 3479 (point))
3480 ;;
3481 ;; if not found, restore old position of point
3482 ;;
7749c1a8
GM		 3483 (goto-char orgpoint)
3484 'nil)
3485 (modify-syntax-entry ?_ old-syntax))
3486 )
972579f9
RS		 3487
3488
3489(defun ada-check-matching-start (keyword)
655880d2
GM		 3490 "Signals an error if matching block start is not KEYWORD.
3491Moves point to the matching block start."
972579f9 3492 (ada-goto-matching-start 0)
7749c1a8
GM		 3493 (unless (looking-at (concat "\\<" keyword "\\>"))
3494 (error "matching start is not '%s'" keyword)))
972579f9
RS		 3495
3496
3497(defun ada-check-defun-name (defun-name)
655880d2
GM		 3498 "Checks if the name of the matching defun really is DEFUN-NAME.
3499Assumes point to be already positioned by 'ada-goto-matching-start'.
3500Moves point to the beginning of the declaration."
972579f9 3501
cadd3658 3502 ;; named block without a `declare'
cadd3658
RS		 3503 (if (save-excursion
3504 (ada-goto-previous-word)
3505 (looking-at (concat "\\<" defun-name "\\> *:")))
7749c1a8 3506 t ; do nothing
972579f9 3507 ;;
cadd3658 3508 ;; 'accept' or 'package' ?
972579f9 3509 ;;
4cc7e498 3510 (unless (looking-at ada-subprog-start-re)
7749c1a8 3511 (ada-goto-matching-decl-start))
cadd3658
RS		 3512 ;;
3513 ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
3514 ;;
3515 (save-excursion
972579f9 3516 ;;
cadd3658 3517 ;; a named 'declare'-block ?
972579f9 3518 ;;
cadd3658
RS		 3519 (if (looking-at "\\<declare\\>")
3520 (ada-goto-stmt-start)
972579f9 3521 ;;
cadd3658 3522 ;; no, => 'procedure'/'function'/'task'/'protected'
972579f9 3523 ;;
cadd3658
RS		 3524 (progn
3525 (forward-word 2)
3526 (backward-word 1)
3527 ;;
3528 ;; skip 'body' 'type'
3529 ;;
3530 (if (looking-at "\\<\\(body\\|type\\)\\>")
3531 (forward-word 1))
3532 (forward-sexp 1)
3533 (backward-sexp 1)))
3534 ;;
3535 ;; should be looking-at the correct name
3536 ;;
7749c1a8
GM		 3537 (unless (looking-at (concat "\\<" defun-name "\\>"))
3538 (error "matching defun has different name: %s"
3539 (buffer-substring (point)
3540 (progn (forward-sexp 1) (point))))))))
972579f9 3541
4cc7e498 3542(defun ada-goto-matching-decl-start (&optional noerror recursive)
655880d2
GM		 3543 "Moves point to the matching declaration start of the current 'begin'.
3544If NOERROR is non-nil, it only returns nil if no match was found."
972579f9 3545 (let ((nest-count 1)
4607c7f4
SM		 3546
3547 ;; first should be set to t if we should stop at the first
3548 ;; "begin" we encounter.
4cc7e498 3549 (first (not recursive))
7749c1a8 3550 (count-generic nil)
6f9a2614 3551 (stop-at-when nil)
7749c1a8
GM		 3552 )
3553
4cc7e498
GM		 3554 ;; Ignore "when" most of the time, except if we are looking at the
3555 ;; beginning of a block (structure: case .. is
3556 ;; when ... =>
3557 ;; begin ...
3558 ;; exception ... )
3559 (if (looking-at "begin")
36144b26 3560 (setq stop-at-when t))
4cc7e498 3561
7749c1a8
GM		 3562 (if (or
3563 (looking-at "\\<\\(package\\|procedure\\|function\\)\\>")
3564 (save-excursion
655880d2 3565 (ada-search-ignore-string-comment
4cc7e498 3566 "\\<\\(package\\|procedure\\|function\\|generic\\)\\>" t)
7749c1a8 3567 (looking-at "generic")))
36144b26 3568 (setq count-generic t))
7749c1a8 3569
972579f9 3570 ;; search backward for interesting keywords
972579f9
RS		 3571 (while (and
3572 (not (zerop nest-count))
7749c1a8 3573 (ada-search-ignore-string-comment ada-matching-decl-start-re t))
972579f9
RS		 3574 ;;
3575 ;; calculate nest-depth
3576 ;;
3577 (cond
3578 ;;
3579 ((looking-at "end")
3580 (ada-goto-matching-start 1 noerror)
7749c1a8 3581
4cc7e498
GM		 3582 ;; In some case, two begin..end block can follow each other closely,
3583 ;; which we have to detect, as in
3584 ;; procedure P is
3585 ;; procedure Q is
3586 ;; begin
3587 ;; end;
7749c1a8 3588 ;; begin -- here we should go to procedure, not begin
4cc7e498
GM		 3589 ;; end
3590
3591 (if (looking-at "begin")
3592 (let ((loop-again t))
3593 (save-excursion
3594 (while loop-again
3595 ;; If begin was just there as the beginning of a block
3596 ;; (with no declare) then do nothing, otherwise just
3597 ;; register that we have to find the statement that
3598 ;; required the begin
3599
3600 (ada-search-ignore-string-comment
3601 "\\<\\(declare\\|begin\\|end\\|procedure\\|function\\|task\\|package\\)\\>"
3602 t)
3603
3604 (if (looking-at "end")
4607c7f4
SM		 3605 (ada-goto-matching-start 1 noerror t)
3606 ;; (ada-goto-matching-decl-start noerror t)
4cc7e498 3607
36144b26 3608 (setq loop-again nil)
4cc7e498 3609 (unless (looking-at "begin")
36144b26 3610 (setq nest-count (1+ nest-count))))
4cc7e498
GM		 3611 ))
3612 )))
7749c1a8
GM		 3613 ;;
3614 ((looking-at "generic")
3615 (if count-generic
3616 (progn
36144b26
SM		 3617 (setq first nil)
3618 (setq nest-count (1- nest-count)))))
972579f9 3619 ;;
4cc7e498
GM		 3620 ((looking-at "if")
3621 (save-excursion
3622 (forward-word -1)
3623 (unless (looking-at "\\<end[ \t\n]*if\\>")
3624 (progn
36144b26
SM		 3625 (setq nest-count (1- nest-count))
3626 (setq first nil)))))
eaae8106 3627
4cc7e498
GM		 3628 ;;
3629 ((looking-at "declare\\|generic")
36144b26 3630 (setq nest-count (1- nest-count))
4607c7f4 3631 (setq first t))
972579f9
RS		 3632 ;;
3633 ((looking-at "is")
276c1210
RS		 3634 ;; check if it is only a type definition, but not a protected
3635 ;; type definition, which should be handled like a procedure.
7749c1a8 3636 (if (or (looking-at "is[ \t]+<>")
cadd3658 3637 (save-excursion
7749c1a8
GM		 3638 (forward-comment -10000)
3639 (forward-char -1)
3640
3641 ;; Detect if we have a closing parenthesis (Could be
3642 ;; either the end of subprogram parameters or (<>)
3643 ;; in a type definition
3644 (if (= (char-after) ?\))
cadd3658
RS		 3645 (progn
3646 (forward-char 1)
3647 (backward-sexp 1)
7749c1a8 3648 (forward-comment -10000)
cadd3658 3649 ))
7749c1a8 3650 (skip-chars-backward "a-zA-Z0-9_.'")
cadd3658 3651 (ada-goto-previous-word)
7749c1a8 3652 (and
f7a80909 3653 (looking-at "\\<\\(sub\\)?type\\|case\\>")
cadd3658
RS		 3654 (save-match-data
3655 (ada-goto-previous-word)
3656 (not (looking-at "\\<protected\\>"))))
7749c1a8 3657 )) ; end of `or'
972579f9
RS		 3658 (goto-char (match-beginning 0))
3659 (progn
36144b26
SM		 3660 (setq nest-count (1- nest-count))
3661 (setq first nil))))
972579f9
RS		 3662
3663 ;;
3664 ((looking-at "new")
3665 (if (save-excursion
3666 (ada-goto-previous-word)
3667 (looking-at "is"))
3668 (goto-char (match-beginning 0))))
3669 ;;
3670 ((and first
3671 (looking-at "begin"))
36144b26 3672 (setq nest-count 0))
4cc7e498
GM		 3673 ;;
3674 ((looking-at "when")
4607c7f4
SM		 3675 (save-excursion
3676 (forward-word -1)
3677 (unless (looking-at "\\<exit[ \t\n]*when\\>")
3678 (progn
3679 (if stop-at-when
3680 (setq nest-count (1- nest-count)))
f7a80909 3681 ))))
4607c7f4
SM		 3682 ;;
3683 ((looking-at "begin")
3684 (setq first nil))
972579f9
RS		 3685 ;;
3686 (t
36144b26
SM		 3687 (setq nest-count (1+ nest-count))
3688 (setq first nil)))
972579f9 3689
7749c1a8 3690 );; end of loop
972579f9
RS		 3691
3692 ;; check if declaration-start is really found
7749c1a8
GM		 3693 (if (and
3694 (zerop nest-count)
7749c1a8
GM		 3695 (if (looking-at "is")
3696 (ada-search-ignore-string-comment ada-subprog-start-re t)
3697 (looking-at "declare\\|generic")))
3698 t
3699 (if noerror nil
3700 (error "no matching proc/func/task/declare/package/protected")))
3701 ))
972579f9
RS		 3702
3703(defun ada-goto-matching-start (&optional nest-level noerror gotothen)
655880d2
GM		 3704 "Moves point to the beginning of a block-start.
3705Which block depends on the value of NEST-LEVEL, which defaults to zero. If
3706NOERROR is non-nil, it only returns nil if no matching start was found.
3707If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
972579f9
RS		 3708 (let ((nest-count (if nest-level nest-level 0))
3709 (found nil)
3710 (pos nil))
3711
3712 ;;
3713 ;; search backward for interesting keywords
3714 ;;
3715 (while (and
3716 (not found)
7749c1a8
GM		 3717 (ada-search-ignore-string-comment ada-matching-start-re t))
3718
3719 (unless (and (looking-at "\\<record\\>")
3720 (save-excursion
3721 (forward-word -1)
3722 (looking-at "\\<null\\>")))
3723 (progn
3724 ;;
3725 ;; calculate nest-depth
3726 ;;
3727 (cond
3728 ;; found block end => increase nest depth
3729 ((looking-at "end")
36144b26 3730 (setq nest-count (1+ nest-count)))
7749c1a8
GM		 3731
3732 ;; found loop/select/record/case/if => check if it starts or
3733 ;; ends a block
3734 ((looking-at "loop\\|select\\|record\\|case\\|if")
36144b26 3735 (setq pos (point))
7749c1a8
GM		 3736 (save-excursion
3737 ;;
3738 ;; check if keyword follows 'end'
3739 ;;
3740 (ada-goto-previous-word)
3741 (if (looking-at "\\<end\\>[ \t]*[^;]")
3742 ;; it ends a block => increase nest depth
4607c7f4
SM		 3743 (setq nest-count (1+ nest-count)
3744 pos (point))
a1506d29 3745
7749c1a8 3746 ;; it starts a block => decrease nest depth
36144b26 3747 (setq nest-count (1- nest-count))))
7749c1a8
GM		 3748 (goto-char pos))
3749
3750 ;; found package start => check if it really is a block
3751 ((looking-at "package")
3752 (save-excursion
3753 ;; ignore if this is just a renames statement
3754 (let ((current (point))
3755 (pos (ada-search-ignore-string-comment
3756 "\\<\\(is\\|renames\\|;\\)\\>" nil)))
3757 (if pos
3758 (goto-char (car pos))
3759 (error (concat
655880d2 3760 "No matching 'is' or 'renames' for 'package' at"
4cc7e498 3761 " line "
80d50f88 3762 (number-to-string (count-lines 1 (1+ current)))))))
7749c1a8
GM		 3763 (unless (looking-at "renames")
3764 (progn
3765 (forward-word 1)
3766 (ada-goto-next-non-ws)
3767 ;; ignore it if it is only a declaration with 'new'
4607c7f4
SM		 3768 ;; We could have package Foo is new ....
3769 ;; or package Foo is separate;
3770 ;; or package Foo is begin null; end Foo
3771 ;; for elaboration code (elaboration)
3772 (if (not (looking-at "\\<\\(new\\|separate\\|begin\\)\\>"))
36144b26 3773 (setq nest-count (1- nest-count)))))))
7749c1a8
GM		 3774 ;; found task start => check if it has a body
3775 ((looking-at "task")
3776 (save-excursion
3777 (forward-word 1)
3778 (ada-goto-next-non-ws)
3779 (cond
3780 ((looking-at "\\<body\\>"))
3781 ((looking-at "\\<type\\>")
3782 ;; In that case, do nothing if there is a "is"
3783 (forward-word 2);; skip "type"
3784 (ada-goto-next-non-ws);; skip type name
3785
4cc7e498
GM		 3786 ;; Do nothing if we are simply looking at a simple
3787 ;; "task type name;" statement with no block
3788 (unless (looking-at ";")
3789 (progn
3790 ;; Skip the parameters
3791 (if (looking-at "(")
3792 (ada-search-ignore-string-comment ")" nil))
3793 (let ((tmp (ada-search-ignore-string-comment
3794 "\\<\\(is\\|;\\)\\>" nil)))
3795 (if tmp
3796 (progn
3797 (goto-char (car tmp))
3798 (if (looking-at "is")
36144b26 3799 (setq nest-count (1- nest-count)))))))))
7749c1a8 3800 (t
4cc7e498
GM		 3801 ;; Check if that task declaration had a block attached to
3802 ;; it (i.e do nothing if we have just "task name;")
3803 (unless (progn (forward-word 1)
3804 (looking-at "[ \t]*;"))
36144b26 3805 (setq nest-count (1- nest-count)))))))
7749c1a8
GM		 3806 ;; all the other block starts
3807 (t
36144b26 3808 (setq nest-count (1- nest-count)))) ; end of 'cond'
972579f9 3809
7749c1a8 3810 ;; match is found, if nest-depth is zero
972579f9 3811 ;;
36144b26 3812 (setq found (zerop nest-count))))) ; end of loop
972579f9 3813
4607c7f4
SM		 3814 (if (bobp)
3815 (point)
3816 (if found
3817 ;;
3818 ;; match found => is there anything else to do ?
3819 ;;
3820 (progn
3821 (cond
3822 ;;
3823 ;; found 'if' => skip to 'then', if it's on a separate line
3824 ;; and GOTOTHEN is non-nil
3825 ;;
3826 ((and
3827 gotothen
3828 (looking-at "if")
3829 (save-excursion
3830 (ada-search-ignore-string-comment "then" nil nil nil
3831 'word-search-forward)
3832 (back-to-indentation)
3833 (looking-at "\\<then\\>")))
3834 (goto-char (match-beginning 0)))
a1506d29 3835
4607c7f4
SM		 3836 ;;
3837 ;; found 'do' => skip back to 'accept'
3838 ;;
3839 ((looking-at "do")
3840 (unless (ada-search-ignore-string-comment
3841 "accept" t nil nil
3842 'word-search-backward)
3843 (error "missing 'accept' in front of 'do'"))))
3844 (point))
a1506d29 3845
4607c7f4
SM		 3846 (if noerror
3847 nil
3848 (error "no matching start"))))))
972579f9
RS		 3849
3850
3851(defun ada-goto-matching-end (&optional nest-level noerror)
655880d2
GM		 3852 "Moves point to the end of a block.
3853Which block depends on the value of NEST-LEVEL, which defaults to zero.
3854If NOERROR is non-nil, it only returns nil if found no matching start."
4607c7f4
SM		 3855 (let ((nest-count (or nest-level 0))
3856 (regex (eval-when-compile
3857 (concat "\\<"
3858 (regexp-opt '("end" "loop" "select" "begin" "case"
3859 "if" "task" "package" "record" "do"
3860 "procedure" "function") t)
3861 "\\>")))
f7a80909
JB		 3862 found
3863 pos
4607c7f4
SM		 3864
3865 ;; First is used for subprograms: they are generally handled
3866 ;; recursively, but of course we do not want to do that the
3867 ;; first time (see comment below about subprograms)
3868 (first (not (looking-at "declare"))))
3869
3870 ;; If we are already looking at one of the keywords, this shouldn't count
3871 ;; in the nesting loop below, so we just make sure we don't count it.
3872 ;; "declare" is a special case because we need to look after the "begin"
3873 ;; keyword
f7a80909 3874 (if (looking-at "\\<if\\|loop\\|case\\|begin\\>")
4607c7f4 3875 (forward-char 1))
972579f9
RS		 3876
3877 ;;
3878 ;; search forward for interesting keywords
3879 ;;
3880 (while (and
3881 (not found)
4607c7f4 3882 (ada-search-ignore-string-comment regex nil))
972579f9
RS		 3883
3884 ;;
3885 ;; calculate nest-depth
3886 ;;
3887 (backward-word 1)
3888 (cond
4607c7f4
SM		 3889 ;; procedures and functions need to be processed recursively, in
3890 ;; case they are defined in a declare/begin block, as in:
3891 ;; declare -- NL 0 (nested level)
3892 ;; A : Boolean;
3893 ;; procedure B (C : D) is
3894 ;; begin -- NL 1
3895 ;; null;
3896 ;; end B; -- NL 0, and we would exit
3897 ;; begin
3898 ;; end; -- we should exit here
3899 ;; processing them recursively avoids the need for any special
3900 ;; handling.
3901 ;; Nothing should be done if we have only the specs or a
3902 ;; generic instantion.
a1506d29 3903
4607c7f4
SM		 3904 ((and (looking-at "\\<procedure\\|function\\>"))
3905 (if first
3906 (forward-word 1)
f7a80909
JB		 3907
3908 (setq pos (point))
4607c7f4 3909 (ada-search-ignore-string-comment "is\\|;")
f7a80909
JB		 3910 (if (= (char-before) ?s)
3911 (progn
3912 (ada-goto-next-non-ws)
3913 (unless (looking-at "\\<new\\>")
3914 (progn
3915 (goto-char pos)
3916 (ada-goto-matching-end 0 t)))))))
a1506d29 3917
972579f9
RS		 3918 ;; found block end => decrease nest depth
3919 ((looking-at "\\<end\\>")
4607c7f4
SM		 3920 (setq nest-count (1- nest-count)
3921 found (<= nest-count 0))
3922 ;; skip the following keyword
3923 (if (progn
3924 (skip-chars-forward "end")
3925 (ada-goto-next-non-ws)
3926 (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
3927 (forward-word 1)))
a1506d29 3928
4607c7f4
SM		 3929 ;; found package start => check if it really starts a block, and is not
3930 ;; in fact a generic instantiation for instance
972579f9 3931 ((looking-at "\\<package\\>")
655880d2 3932 (ada-search-ignore-string-comment "is" nil nil nil
4cc7e498 3933 'word-search-forward)
972579f9
RS		 3934 (ada-goto-next-non-ws)
3935 ;; ignore and skip it if it is only a 'new' package
7749c1a8
GM		 3936 (if (looking-at "\\<new\\>")
3937 (goto-char (match-end 0))
4607c7f4
SM		 3938 (setq nest-count (1+ nest-count)
3939 found (<= nest-count 0))))
a1506d29 3940
972579f9
RS		 3941 ;; all the other block starts
3942 (t
f7a80909
JB		 3943 (if (not first)
3944 (setq nest-count (1+ nest-count)))
3945 (setq found (<= nest-count 0))
7749c1a8 3946 (forward-word 1))) ; end of 'cond'
972579f9 3947
4607c7f4 3948 (setq first nil))
972579f9 3949
7749c1a8
GM		 3950 (if found
3951 t
3952 (if noerror
3953 nil
3954 (error "no matching end")))
3955 ))
972579f9
RS		 3956
3957
3958(defun ada-search-ignore-string-comment
4cc7e498 3959 (search-re &optional backward limit paramlists search-func)
655880d2
GM		 3960 "Regexp-search for SEARCH-RE, ignoring comments, strings.
3961If PARAMLISTS is nil, ignore parameter lists. Returns a cons cell of
3962begin and end of match data or nil, if not found.
3963The search is done using SEARCH-FUNC, which should search backward if
3964BACKWARD is non-nil, forward otherwise. SEARCH-FUNC can be optimized in case
3965we are searching for a constant string.
3966The search stops at pos LIMIT.
3967Point is moved at the beginning of the search-re."
7749c1a8
GM		 3968 (let (found
3969 begin
3970 end
3971 parse-result
3972 (previous-syntax-table (syntax-table)))
3973
3974 (unless search-func
36144b26 3975 (setq search-func (if backward 're-search-backward 're-search-forward)))
972579f9
RS		 3976
3977 ;;
3978 ;; search until found or end-of-buffer
7749c1a8 3979 ;; We have to test that we do not look further than limit
972579f9 3980 ;;
7749c1a8 3981 (set-syntax-table ada-mode-symbol-syntax-table)
972579f9 3982 (while (and (not found)
7749c1a8
GM		 3983 (or (not limit)
3984 (or (and backward (<= limit (point)))
3985 (>= limit (point))))
972579f9 3986 (funcall search-func search-re limit 1))
36144b26
SM		 3987 (setq begin (match-beginning 0))
3988 (setq end (match-end 0))
7749c1a8 3989
36144b26 3990 (setq parse-result (parse-partial-sexp
7749c1a8
GM		 3991 (save-excursion (beginning-of-line) (point))
3992 (point)))
972579f9
RS		 3993
3994 (cond
3995 ;;
7749c1a8 3996 ;; If inside a string, skip it (and the following comments)
972579f9 3997 ;;
7749c1a8 3998 ((ada-in-string-p parse-result)
6f9a2614 3999 (if (featurep 'xemacs)
7749c1a8
GM		 4000 (search-backward "\"" nil t)
4001 (goto-char (nth 8 parse-result)))
4002 (unless backward (forward-sexp 1)))
972579f9 4003 ;;
7749c1a8
GM		 4004 ;; If inside a comment, skip it (and the following comments)
4005 ;; There is a special code for comments at the end of the file
972579f9 4006 ;;
7749c1a8 4007 ((ada-in-comment-p parse-result)
6f9a2614 4008 (if (featurep 'xemacs)
4cc7e498
GM		 4009 (progn
4010 (forward-line 1)
4011 (beginning-of-line)
4012 (forward-comment -1))
7749c1a8
GM		 4013 (goto-char (nth 8 parse-result)))
4014 (unless backward
4015 ;; at the end of the file, it is not possible to skip a comment
4016 ;; so we just go at the end of the line
4017 (if (forward-comment 1)
4018 (progn
4019 (forward-comment 1000)
4020 (beginning-of-line))
4021 (end-of-line))))
972579f9 4022 ;;
7749c1a8 4023 ;; directly in front of a comment => skip it, if searching forward
972579f9 4024 ;;
7749c1a8
GM		 4025 ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
4026 (unless backward (progn (forward-char -1) (forward-comment 1000))))
4027
972579f9
RS		 4028 ;;
4029 ;; found a parameter-list but should ignore it => skip it
4030 ;;
7749c1a8 4031 ((and (not paramlists) (ada-in-paramlist-p))
972579f9 4032 (if backward
7749c1a8
GM		 4033 (search-backward "(" nil t)
4034 (search-forward ")" nil t)))
972579f9
RS		 4035 ;;
4036 ;; found what we were looking for
4037 ;;
4038 (t
36144b26 4039 (setq found t)))) ; end of loop
972579f9 4040
7749c1a8 4041 (set-syntax-table previous-syntax-table)
972579f9
RS		 4042
4043 (if found
7749c1a8 4044 (cons begin end)
972579f9
RS		 4045 nil)))
4046
655880d2
GM		 4047;; -------------------------------------------------------
4048;; -- Testing the position of the cursor
4049;; -------------------------------------------------------
972579f9
RS		 4050
4051(defun ada-in-decl-p ()
655880d2
GM		 4052 "Returns t if point is inside a declarative part.
4053Assumes point to be at the end of a statement."
4054 (or (ada-in-paramlist-p)
4055 (save-excursion
4cc7e498 4056 (ada-goto-matching-decl-start t))))
972579f9
RS		 4057
4058
4059(defun ada-looking-at-semi-or ()
655880d2 4060 "Returns t if looking-at an 'or' following a semicolon."
972579f9
RS		 4061 (save-excursion
4062 (and (looking-at "\\<or\\>")
4063 (progn
4064 (forward-word 1)
4065 (ada-goto-stmt-start)
4066 (looking-at "\\<or\\>")))))
4067
4068
4069(defun ada-looking-at-semi-private ()
4cc7e498 4070 "Returns t if looking at the start of a private section in a package.
7749c1a8 4071Returns nil if the private is part of the package name, as in
655880d2 4072'private package A is...' (this can only happen at top level)."
972579f9
RS		 4073 (save-excursion
4074 (and (looking-at "\\<private\\>")
7749c1a8 4075 (not (looking-at "\\<private[ \t]*\\(package\\|generic\\)"))
7749c1a8 4076
4cc7e498
GM		 4077 ;; Make sure this is the start of a private section (ie after
4078 ;; a semicolon or just after the package declaration, but not
4079 ;; after a 'type ... is private' or 'is new ... with private'
4607c7f4
SM		 4080 ;;
4081 ;; Note that a 'private' statement at the beginning of the buffer
4082 ;; does not indicate a private section, since this is instead a
4083 ;; 'private procedure ...'
eaae8106 4084 (progn (forward-comment -1000)
4607c7f4
SM		 4085 (and (not (bobp))
4086 (or (= (char-before) ?\;)
4087 (and (forward-word -3)
4088 (looking-at "\\<package\\>"))))))))
7749c1a8 4089
972579f9
RS		 4090
4091(defun ada-in-paramlist-p ()
655880d2 4092 "Returns t if point is inside a parameter-list."
972579f9
RS		 4093 (save-excursion
4094 (and
4cc7e498 4095 (ada-search-ignore-string-comment "(\\|)" t nil t)
972579f9 4096 ;; inside parentheses ?
7749c1a8 4097 (= (char-after) ?\()
4cc7e498
GM		 4098
4099 ;; We could be looking at two things here:
4100 ;; operator definition: function "." (
4101 ;; subprogram definition: procedure .... (
4102 ;; Let's skip back over the first one
4103 (progn
4607c7f4 4104 (skip-chars-backward " \t\n")
4cc7e498
GM		 4105 (if (= (char-before) ?\")
4106 (backward-char 3)
4107 (backward-word 1))
4108 t)
4109
4110 ;; and now over the second one
4111 (backward-word 1)
4112
7749c1a8
GM		 4113 ;; We should ignore the case when the reserved keyword is in a
4114 ;; comment (for instance, when we have:
4115 ;; -- .... package
4116 ;; Test (A)
4117 ;; we should return nil
4118
4119 (not (ada-in-string-or-comment-p))
4cc7e498 4120
7749c1a8
GM		 4121 ;; right keyword two words before parenthesis ?
4122 ;; Type is in this list because of discriminants
4123 (looking-at (eval-when-compile
4124 (concat "\\<\\("
4125 "procedure\\|function\\|body\\|"
4126 "task\\|entry\\|accept\\|"
4127 "access[ \t]+procedure\\|"
4128 "access[ \t]+function\\|"
4cc7e498 4129 "pragma\\|"
7749c1a8 4130 "type\\)\\>"))))))
972579f9 4131
4cc7e498
GM		 4132(defun ada-search-ignore-complex-boolean (regexp backwardp)
4133 "Like `ada-search-ignore-string-comment', except that it also ignores
4134boolean expressions 'and then' and 'or else'."
4135 (let (result)
36144b26 4136 (while (and (setq result (ada-search-ignore-string-comment regexp backwardp))
4cc7e498
GM		 4137 (save-excursion (forward-word -1)
4138 (looking-at "and then\\|or else"))))
4139 result))
4140
972579f9 4141(defun ada-in-open-paren-p ()
655880d2
GM		 4142 "Returns the position of the first non-ws behind the last unclosed
4143parenthesis, or nil."
7749c1a8
GM		 4144 (save-excursion
4145 (let ((parse (parse-partial-sexp
4cc7e498
GM		 4146 (point)
4147 (or (car (ada-search-ignore-complex-boolean
4148 "\\<\\(;\\|is\\|then\\|loop\\|begin\\|else\\)\\>"
4149 t))
4150 (point-min)))))
4151
7749c1a8
GM		 4152 (if (nth 1 parse)
4153 (progn
4154 (goto-char (1+ (nth 1 parse)))
4607c7f4
SM		 4155
4156 ;; Skip blanks, if they are not followed by a comment
4157 ;; See:
4158 ;; type A is ( Value_0,
4159 ;; Value_1);
4160 ;; type B is ( -- comment
4161 ;; Value_2);
a1506d29 4162
4607c7f4
SM		 4163 (if (or (not ada-indent-handle-comment-special)
4164 (not (looking-at "[ \t]+--")))
4165 (skip-chars-forward " \t"))
4166
4cc7e498 4167 (point))))))
972579f9
RS		 4168
4169\f
4cc7e498
GM		 4170;; -----------------------------------------------------------
4171;; -- Behavior Of TAB Key
4172;; -----------------------------------------------------------
655880d2 4173
972579f9 4174(defun ada-tab ()
7749c1a8 4175 "Do indenting or tabbing according to `ada-tab-policy'.
7749c1a8 4176In Transient Mark mode, if the mark is active, operate on the contents
655880d2 4177of the region. Otherwise, operates only on the current line."
972579f9 4178 (interactive)
7749c1a8
GM		 4179 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
4180 ((eq ada-tab-policy 'indent-auto)
4607c7f4 4181 (if (ada-region-selected)
7749c1a8
GM		 4182 (ada-indent-region (region-beginning) (region-end))
4183 (ada-indent-current)))
972579f9
RS		 4184 ((eq ada-tab-policy 'always-tab) (error "not implemented"))
4185 ))
4186
972579f9
RS		 4187(defun ada-untab (arg)
4188 "Delete leading indenting according to `ada-tab-policy'."
4189 (interactive "P")
4190 (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard))
972579f9
RS		 4191 ((eq ada-tab-policy 'indent-auto) (error "not implemented"))
4192 ((eq ada-tab-policy 'always-tab) (error "not implemented"))
4193 ))
4194
972579f9 4195(defun ada-indent-current-function ()
cadd3658 4196 "Ada mode version of the indent-line-function."
972579f9
RS		 4197 (interactive "*")
4198 (let ((starting-point (point-marker)))
7749c1a8 4199 (beginning-of-line)
972579f9
RS		 4200 (ada-tab)
4201 (if (< (point) starting-point)
4202 (goto-char starting-point))
4203 (set-marker starting-point nil)
4204 ))
4205
972579f9
RS		 4206(defun ada-tab-hard ()
4207 "Indent current line to next tab stop."
4208 (interactive)
4209 (save-excursion
4210 (beginning-of-line)
4211 (insert-char ? ada-indent))
4212 (if (save-excursion (= (point) (progn (beginning-of-line) (point))))
4213 (forward-char ada-indent)))
4214
972579f9
RS		 4215(defun ada-untab-hard ()
4216 "indent current line to previous tab stop."
4217 (interactive)
4218 (let ((bol (save-excursion (progn (beginning-of-line) (point))))
7749c1a8 4219 (eol (save-excursion (progn (end-of-line) (point)))))
972579f9
RS		 4220 (indent-rigidly bol eol (- 0 ada-indent))))
4221
4222
972579f9 4223\f
655880d2
GM		 4224;; ------------------------------------------------------------
4225;; -- Miscellaneous
4226;; ------------------------------------------------------------
972579f9 4227
4607c7f4
SM		 4228;; Not needed any more for Emacs 21.2, but still needed for backward
4229;; compatibility
4230(defun ada-remove-trailing-spaces ()
4231 "Remove trailing spaces in the whole buffer."
4232 (interactive)
4233 (save-match-data
4234 (save-excursion
4235 (save-restriction
4236 (widen)
4237 (goto-char (point-min))
4238 (while (re-search-forward "[ \t]+$" (point-max) t)
4239 (replace-match "" nil nil))))))
4240
cadd3658
RS		 4241(defun ada-gnat-style ()
4242 "Clean up comments, `(' and `,' for GNAT style checking switch."
4243 (interactive)
4244 (save-excursion
4607c7f4
SM		 4245
4246 ;; The \n is required, or the line after an empty comment line is
4247 ;; simply ignored.
cadd3658 4248 (goto-char (point-min))
4607c7f4
SM		 4249 (while (re-search-forward "--[ \t]*\\([^-\n]\\)" nil t)
4250 (replace-match "-- \\1")
4251 (forward-line 1)
4252 (beginning-of-line))
a1506d29 4253
cadd3658
RS		 4254 (goto-char (point-min))
4255 (while (re-search-forward "\\>(" nil t)
4607c7f4
SM		 4256 (if (not (ada-in-string-or-comment-p))
4257 (replace-match " (")))
4258 (goto-char (point-min))
4259 (while (re-search-forward ";--" nil t)
4260 (forward-char -1)
4261 (if (not (ada-in-string-or-comment-p))
4262 (replace-match "; --")))
cadd3658 4263 (goto-char (point-min))
4cc7e498 4264 (while (re-search-forward "([ \t]+" nil t)
4607c7f4
SM		 4265 (if (not (ada-in-string-or-comment-p))
4266 (replace-match "(")))
4cc7e498
GM		 4267 (goto-char (point-min))
4268 (while (re-search-forward ")[ \t]+)" nil t)
4607c7f4
SM		 4269 (if (not (ada-in-string-or-comment-p))
4270 (replace-match "))")))
4cc7e498
GM		 4271 (goto-char (point-min))
4272 (while (re-search-forward "\\>:" nil t)
4607c7f4
SM		 4273 (if (not (ada-in-string-or-comment-p))
4274 (replace-match " :")))
4275
4276 ;; Make sure there is a space after a ','.
4277 ;; Always go back to the beginning of the match, since otherwise
4278 ;; a statement like ('F','D','E') is incorrectly modified.
4cc7e498 4279 (goto-char (point-min))
4607c7f4
SM		 4280 (while (re-search-forward ",[ \t]*\\(.\\)" nil t)
4281 (if (not (save-excursion
4282 (goto-char (match-beginning 0))
4283 (ada-in-string-or-comment-p)))
4284 (replace-match ", \\1")))
4285
4286 ;; Operators should be surrounded by spaces.
4cc7e498 4287 (goto-char (point-min))
4607c7f4
SM		 4288 (while (re-search-forward
4289 "[ \t]*\\(/=\\|\\*\\*\\|:=\\|\\.\\.\\|[-:+*/]\\)[ \t]*"
4290 nil t)
4291 (goto-char (match-beginning 1))
4292 (if (or (looking-at "--")
4293 (ada-in-string-or-comment-p))
4cc7e498 4294 (progn
4607c7f4
SM		 4295 (forward-line 1)
4296 (beginning-of-line))
4297 (cond
4298 ((string= (match-string 1) "/=")
4299 (replace-match " /= "))
4300 ((string= (match-string 1) "..")
4301 (replace-match " .. "))
4302 ((string= (match-string 1) "**")
4303 (replace-match " ** "))
4304 ((string= (match-string 1) ":=")
4305 (replace-match " := "))
4306 (t
4307 (replace-match " \\1 ")))
4308 (forward-char 1)))
cadd3658
RS		 4309 ))
4310
4311
972579f9 4312\f
655880d2 4313;; -------------------------------------------------------------
4cc7e498 4314;; -- Moving To Procedures/Packages/Statements
655880d2
GM		 4315;; -------------------------------------------------------------
4316
4cc7e498
GM		 4317(defun ada-move-to-start ()
4318 "Moves point to the matching start of the current Ada structure."
4319 (interactive)
4320 (let ((pos (point))
4321 (previous-syntax-table (syntax-table)))
4322 (unwind-protect
4323 (progn
4324 (set-syntax-table ada-mode-symbol-syntax-table)
4325
4cc7e498
GM		 4326 (save-excursion
4327 ;;
4328 ;; do nothing if in string or comment or not on 'end ...;'
4329 ;; or if an error occurs during processing
4330 ;;
4331 (or
4332 (ada-in-string-or-comment-p)
4333 (and (progn
4334 (or (looking-at "[ \t]*\\<end\\>")
4335 (backward-word 1))
4336 (or (looking-at "[ \t]*\\<end\\>")
4337 (backward-word 1))
4338 (or (looking-at "[ \t]*\\<end\\>")
4339 (error "not on end ...;")))
4340 (ada-goto-matching-start 1)
36144b26 4341 (setq pos (point))
4cc7e498
GM		 4342
4343 ;;
4344 ;; on 'begin' => go on, according to user option
4345 ;;
4346 ada-move-to-declaration
4347 (looking-at "\\<begin\\>")
4348 (ada-goto-matching-decl-start)
36144b26 4349 (setq pos (point))))
4cc7e498
GM		 4350
4351 ) ; end of save-excursion
4352
4353 ;; now really move to the found position
4607c7f4 4354 (goto-char pos))
4cc7e498
GM		 4355
4356 ;; restore syntax-table
4357 (set-syntax-table previous-syntax-table))))
4358
4359(defun ada-move-to-end ()
4360 "Moves point to the matching end of the block around point.
4361Moves to 'begin' if in a declarative part."
4362 (interactive)
4363 (let ((pos (point))
4607c7f4 4364 decl-start
4cc7e498
GM		 4365 (previous-syntax-table (syntax-table)))
4366 (unwind-protect
4367 (progn
4368 (set-syntax-table ada-mode-symbol-syntax-table)
4369
4cc7e498
GM		 4370 (save-excursion
4371
4cc7e498 4372 (cond
80d50f88 4373 ;; Go to the beginning of the current word, and check if we are
4cc7e498 4374 ;; directly on 'begin'
4607c7f4 4375 ((save-excursion
80d50f88 4376 (skip-syntax-backward "w")
4607c7f4 4377 (looking-at "\\<begin\\>"))
f7a80909
JB		 4378 (ada-goto-matching-end 1)
4379 )
a1506d29 4380
4607c7f4
SM		 4381 ;; on first line of subprogram body
4382 ;; Do nothing for specs or generic instantion, since these are
4383 ;; handled as the general case (find the enclosing block)
4384 ;; We also need to make sure that we ignore nested subprograms
4385 ((save-excursion
4386 (and (skip-syntax-backward "w")
4387 (looking-at "\\<function\\>\\|\\<procedure\\>" )
4388 (ada-search-ignore-string-comment "is\\|;")
4389 (not (= (char-before) ?\;))
4390 ))
4391 (skip-syntax-backward "w")
4392 (ada-goto-matching-end 0 t))
a1506d29 4393
4cc7e498
GM		 4394 ;; on first line of task declaration
4395 ((save-excursion
4396 (and (ada-goto-stmt-start)
4397 (looking-at "\\<task\\>" )
4398 (forward-word 1)
4399 (ada-goto-next-non-ws)
4400 (looking-at "\\<body\\>")))
4401 (ada-search-ignore-string-comment "begin" nil nil nil
4402 'word-search-forward))
4403 ;; accept block start
4404 ((save-excursion
4405 (and (ada-goto-stmt-start)
4406 (looking-at "\\<accept\\>" )))
4407 (ada-goto-matching-end 0))
4408 ;; package start
4409 ((save-excursion
4607c7f4
SM		 4410 (setq decl-start (and (ada-goto-matching-decl-start t) (point)))
4411 (and decl-start (looking-at "\\<package\\>")))
4cc7e498 4412 (ada-goto-matching-end 1))
80d50f88
SM		 4413
4414 ;; On a "declare" keyword
4415 ((save-excursion
4416 (skip-syntax-backward "w")
4417 (looking-at "\\<declare\\>"))
4418 (ada-goto-matching-end 0 t))
a1506d29 4419
4cc7e498 4420 ;; inside a 'begin' ... 'end' block
4607c7f4
SM		 4421 (decl-start
4422 (goto-char decl-start)
4423 (ada-goto-matching-end 0 t))
a1506d29 4424
4cc7e498
GM		 4425 ;; (hopefully ;-) everything else
4426 (t
4427 (ada-goto-matching-end 1)))
36144b26 4428 (setq pos (point))
4cc7e498
GM		 4429 )
4430
4431 ;; now really move to the position found
4607c7f4 4432 (goto-char pos))
4cc7e498
GM		 4433
4434 ;; restore syntax-table
4435 (set-syntax-table previous-syntax-table))))
4436
972579f9
RS		 4437(defun ada-next-procedure ()
4438 "Moves point to next procedure."
4439 (interactive)
4440 (end-of-line)
4441 (if (re-search-forward ada-procedure-start-regexp nil t)
4607c7f4 4442 (goto-char (match-beginning 2))
972579f9
RS		 4443 (error "No more functions/procedures/tasks")))
4444
4445(defun ada-previous-procedure ()
4446 "Moves point to previous procedure."
4447 (interactive)
4448 (beginning-of-line)
4449 (if (re-search-backward ada-procedure-start-regexp nil t)
4607c7f4 4450 (goto-char (match-beginning 2))
972579f9
RS		 4451 (error "No more functions/procedures/tasks")))
4452
4453(defun ada-next-package ()
4454 "Moves point to next package."
4455 (interactive)
4456 (end-of-line)
4457 (if (re-search-forward ada-package-start-regexp nil t)
4458 (goto-char (match-beginning 1))
4459 (error "No more packages")))
4460
4461(defun ada-previous-package ()
4462 "Moves point to previous package."
4463 (interactive)
4464 (beginning-of-line)
4465 (if (re-search-backward ada-package-start-regexp nil t)
4466 (goto-char (match-beginning 1))
4467 (error "No more packages")))
4468
4469\f
655880d2
GM		 4470;; ------------------------------------------------------------
4471;; -- Define keymap and menus for Ada
4472;; -------------------------------------------------------------
972579f9 4473
7749c1a8 4474(defun ada-create-keymap ()
655880d2 4475 "Create the keymap associated with the Ada mode."
7749c1a8
GM		 4476
4477 ;; Indentation and Formatting
4478 (define-key ada-mode-map "\C-j" 'ada-indent-newline-indent-conditional)
4479 (define-key ada-mode-map "\C-m" 'ada-indent-newline-indent-conditional)
4480 (define-key ada-mode-map "\t" 'ada-tab)
4481 (define-key ada-mode-map "\C-c\t" 'ada-justified-indent-current)
4482 (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region)
6f9a2614 4483 (if (featurep 'xemacs)
4607c7f4
SM		 4484 (define-key ada-mode-map '(shift tab) 'ada-untab)
4485 (define-key ada-mode-map [(shift tab)] 'ada-untab))
7749c1a8
GM		 4486 (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist)
4487 ;; We don't want to make meta-characters case-specific.
4488
4489 ;; Movement
4490 (define-key ada-mode-map "\M-\C-e" 'ada-next-procedure)
4491 (define-key ada-mode-map "\M-\C-a" 'ada-previous-procedure)
4492 (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start)
4493 (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end)
4494
4495 ;; Compilation
4496 (unless (lookup-key ada-mode-map "\C-c\C-c")
4497 (define-key ada-mode-map "\C-c\C-c" 'compile))
4498
4499 ;; Casing
4500 (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer)
4501 (define-key ada-mode-map "\C-c\C-t" 'ada-case-read-exceptions)
4502 (define-key ada-mode-map "\C-c\C-y" 'ada-create-case-exception)
4607c7f4 4503 (define-key ada-mode-map "\C-c\C-\M-y" 'ada-create-case-exception-substring)
7749c1a8 4504
4cc7e498
GM		 4505 ;; On XEmacs, you can easily specify whether DEL should deletes
4506 ;; one character forward or one character backward. Take this into
4507 ;; account
4508 (if (boundp 'delete-key-deletes-forward)
4509 (define-key ada-mode-map [backspace] 'backward-delete-char-untabify)
4510 (define-key ada-mode-map "\177" 'backward-delete-char-untabify))
7749c1a8
GM		 4511
4512 ;; Make body
4513 (define-key ada-mode-map "\C-c\C-n" 'ada-make-subprogram-body)
4514
655880d2 4515 ;; Use predefined function of Emacs19 for comments (RE)
7749c1a8
GM		 4516 (define-key ada-mode-map "\C-c;" 'comment-region)
4517 (define-key ada-mode-map "\C-c:" 'ada-uncomment-region)
f7a80909
JB		 4518
4519 ;; The following keys are bound to functions defined in ada-xref.el or
4520 ;; ada-prj,el., However, RMS rightly thinks that the code should be shared,
4521 ;; and activated only if the right compiler is used
6f9a2614 4522 (if (featurep 'xemacs)
f7a80909
JB		 4523 (progn
4524 (define-key ada-mode-map '(shift button3) 'ada-point-and-xref)
4525 (define-key ada-mode-map '(control tab) 'ada-complete-identifier))
4526 (define-key ada-mode-map [C-tab] 'ada-complete-identifier)
4527 (define-key ada-mode-map [S-mouse-3] 'ada-point-and-xref))
4528
4529 (define-key ada-mode-map "\C-co" 'ff-find-other-file)
4530 (define-key ada-mode-map "\C-c5\C-d" 'ada-goto-declaration-other-frame)
4531 (define-key ada-mode-map "\C-c\C-d" 'ada-goto-declaration)
4532 (define-key ada-mode-map "\C-c\C-s" 'ada-xref-goto-previous-reference)
4533 (define-key ada-mode-map "\C-c\C-c" 'ada-compile-application)
4534 (define-key ada-mode-map "\C-cc" 'ada-change-prj)
4535 (define-key ada-mode-map "\C-cd" 'ada-set-default-project-file)
4536 (define-key ada-mode-map "\C-cg" 'ada-gdb-application)
4537 (define-key ada-mode-map "\C-cr" 'ada-run-application)
4538 (define-key ada-mode-map "\C-c\C-o" 'ada-goto-parent)
4539 (define-key ada-mode-map "\C-c\C-r" 'ada-find-references)
4540 (define-key ada-mode-map "\C-cl" 'ada-find-local-references)
4541 (define-key ada-mode-map "\C-c\C-v" 'ada-check-current)
4542 (define-key ada-mode-map "\C-cf" 'ada-find-file)
4543
4544 (define-key ada-mode-map "\C-cu" 'ada-prj-edit)
4545
4546 ;; The templates, defined in ada-stmt.el
4547
4548 (let ((map (make-sparse-keymap)))
4549 (define-key map "h" 'ada-header)
4550 (define-key map "\C-a" 'ada-array)
4551 (define-key map "b" 'ada-exception-block)
4552 (define-key map "d" 'ada-declare-block)
4553 (define-key map "c" 'ada-case)
4554 (define-key map "\C-e" 'ada-elsif)
4555 (define-key map "e" 'ada-else)
4556 (define-key map "\C-k" 'ada-package-spec)
4557 (define-key map "k" 'ada-package-body)
4558 (define-key map "\C-p" 'ada-procedure-spec)
4559 (define-key map "p" 'ada-subprogram-body)
4560 (define-key map "\C-f" 'ada-function-spec)
4561 (define-key map "f" 'ada-for-loop)
4562 (define-key map "i" 'ada-if)
4563 (define-key map "l" 'ada-loop)
4564 (define-key map "\C-r" 'ada-record)
4565 (define-key map "\C-s" 'ada-subtype)
4566 (define-key map "S" 'ada-tabsize)
4567 (define-key map "\C-t" 'ada-task-spec)
4568 (define-key map "t" 'ada-task-body)
4569 (define-key map "\C-y" 'ada-type)
4570 (define-key map "\C-v" 'ada-private)
4571 (define-key map "u" 'ada-use)
4572 (define-key map "\C-u" 'ada-with)
4573 (define-key map "\C-w" 'ada-when)
4574 (define-key map "w" 'ada-while-loop)
4575 (define-key map "\C-x" 'ada-exception)
4576 (define-key map "x" 'ada-exit)
4577 (define-key ada-mode-map "\C-ct" map))
7749c1a8 4578 )
972579f9 4579
655880d2 4580
7749c1a8 4581(defun ada-create-menu ()
f7a80909
JB		 4582 "Create the ada menu as shown in the menu bar."
4583 (let ((m '("Ada"
4584 ("Help"
4585 ["Ada Mode" (info "ada-mode") t]
4586 ["GNAT User's Guide" (info "gnat_ugn")
4587 (eq ada-which-compiler 'gnat)]
4588 ["GNAT Reference Manual" (info "gnat_rm")
4589 (eq ada-which-compiler 'gnat)]
4590 ["Gcc Documentation" (info "gcc")
4591 (eq ada-which-compiler 'gnat)]
4592 ["Gdb Documentation" (info "gdb")
4593 (eq ada-which-compiler 'gnat)]
4594 ["Ada95 Reference Manual" (info "arm95")
4595 (eq ada-which-compiler 'gnat)])
4596 ("Options" :included (eq major-mode 'ada-mode)
4597 ["Auto Casing" (setq ada-auto-case (not ada-auto-case))
4598 :style toggle :selected ada-auto-case]
4599 ["Auto Indent After Return"
4600 (setq ada-indent-after-return (not ada-indent-after-return))
4601 :style toggle :selected ada-indent-after-return]
4602 ["Automatically Recompile For Cross-references"
4603 (setq ada-xref-create-ali (not ada-xref-create-ali))
4604 :style toggle :selected ada-xref-create-ali
4605 :included (eq ada-which-compiler 'gnat)]
4606 ["Confirm Commands"
4607 (setq ada-xref-confirm-compile (not ada-xref-confirm-compile))
4608 :style toggle :selected ada-xref-confirm-compile
4609 :included (eq ada-which-compiler 'gnat)]
4610 ["Show Cross-references In Other Buffer"
4611 (setq ada-xref-other-buffer (not ada-xref-other-buffer))
4612 :style toggle :selected ada-xref-other-buffer
4613 :included (eq ada-which-compiler 'gnat)]
4614 ["Tight Integration With GNU Visual Debugger"
4615 (setq ada-tight-gvd-integration (not ada-tight-gvd-integration))
4616 :style toggle :selected ada-tight-gvd-integration
4617 :included (string-match "gvd" ada-prj-default-debugger)])
4618 ["Customize" (customize-group 'ada)
4619 :included (fboundp 'customize-group)]
4620 ["Check file" ada-check-current (eq ada-which-compiler 'gnat)]
4621 ["Compile file" ada-compile-current (eq ada-which-compiler 'gnat)]
4622 ["Build" ada-compile-application
4623 (eq ada-which-compiler 'gnat)]
4624 ["Run" ada-run-application t]
4625 ["Debug" ada-gdb-application (eq ada-which-compiler 'gnat)]
4626 ["------" nil nil]
4627 ("Project"
4628 :included (eq ada-which-compiler 'gnat)
4629 ["Load..." ada-set-default-project-file t]
4630 ["New..." ada-prj-new t]
4631 ["Edit..." ada-prj-edit t])
4632 ("Goto" :included (eq major-mode 'ada-mode)
4633 ["Goto Declaration/Body" ada-goto-declaration
4634 (eq ada-which-compiler 'gnat)]
4635 ["Goto Body" ada-goto-body
4636 (eq ada-which-compiler 'gnat)]
4637 ["Goto Declaration Other Frame"
4638 ada-goto-declaration-other-frame
4639 (eq ada-which-compiler 'gnat)]
4640 ["Goto Previous Reference" ada-xref-goto-previous-reference
4641 (eq ada-which-compiler 'gnat)]
4642 ["List Local References" ada-find-local-references
4643 (eq ada-which-compiler 'gnat)]
4644 ["List References" ada-find-references
4645 (eq ada-which-compiler 'gnat)]
4646 ["Goto Reference To Any Entity" ada-find-any-references
4647 (eq ada-which-compiler 'gnat)]
4648 ["Goto Parent Unit" ada-goto-parent
4649 (eq ada-which-compiler 'gnat)]
4650 ["--" nil nil]
4651 ["Next compilation error" next-error t]
4652 ["Previous Package" ada-previous-package t]
4653 ["Next Package" ada-next-package t]
4654 ["Previous Procedure" ada-previous-procedure t]
6f9a2614
JB		 4655 ["Next Procedure" ada-next-procedure t]
4656 ["Goto Start Of Statement" ada-move-to-start t]
f7a80909
JB		 4657 ["Goto End Of Statement" ada-move-to-end t]
4658 ["-" nil nil]
4659 ["Other File" ff-find-other-file t]
4660 ["Other File Other Window" ada-ff-other-window t])
4661 ("Edit" :included (eq major-mode 'ada-mode)
4662 ["Search File On Source Path" ada-find-file t]
4663 ["------" nil nil]
4664 ["Complete Identifier" ada-complete-identifier t]
4665 ["-----" nil nil]
4666 ["Indent Line" ada-indent-current-function t]
4667 ["Justify Current Indentation" ada-justified-indent-current t]
4668 ["Indent Lines in Selection" ada-indent-region t]
4669 ["Indent Lines in File"
4670 (ada-indent-region (point-min) (point-max)) t]
4671 ["Format Parameter List" ada-format-paramlist t]
4672 ["-" nil nil]
4673 ["Comment Selection" comment-region t]
4674 ["Uncomment Selection" ada-uncomment-region t]
4675 ["--" nil nil]
4676 ["Fill Comment Paragraph" fill-paragraph t]
4677 ["Fill Comment Paragraph Justify"
4678 ada-fill-comment-paragraph-justify t]
4679 ["Fill Comment Paragraph Postfix"
4680 ada-fill-comment-paragraph-postfix t]
4681 ["---" nil nil]
4682 ["Adjust Case Selection" ada-adjust-case-region t]
4683 ["Adjust Case in File" ada-adjust-case-buffer t]
6f9a2614
JB		 4684 ["Create Case Exception" ada-create-case-exception t]
4685 ["Create Case Exception Substring"
f7a80909
JB		 4686 ada-create-case-exception-substring t]
4687 ["Reload Case Exceptions" ada-case-read-exceptions t]
4688 ["----" nil nil]
4689 ["Make body for subprogram" ada-make-subprogram-body t]
4690 ["-----" nil nil]
4691 ["Narrow to subprogram" ada-narrow-to-defun t])
4692 ("Templates"
4693 :included (eq major-mode 'ada-mode)
4694 ["Header" ada-header t]
4695 ["-" nil nil]
4696 ["Package Body" ada-package-body t]
4697 ["Package Spec" ada-package-spec t]
4698 ["Function Spec" ada-function-spec t]
4699 ["Procedure Spec" ada-procedure-spec t]
4700 ["Proc/func Body" ada-subprogram-body t]
4701 ["Task Body" ada-task-body t]
4702 ["Task Spec" ada-task-spec t]
4703 ["Declare Block" ada-declare-block t]
4704 ["Exception Block" ada-exception-block t]
4705 ["--" nil nil]
4706 ["Entry" ada-entry t]
4707 ["Entry family" ada-entry-family t]
4708 ["Select" ada-select t]
4709 ["Accept" ada-accept t]
4710 ["Or accept" ada-or-accep t]
4711 ["Or delay" ada-or-delay t]
4712 ["Or terminate" ada-or-terminate t]
4713 ["---" nil nil]
4714 ["Type" ada-type t]
4715 ["Private" ada-private t]
4716 ["Subtype" ada-subtype t]
4717 ["Record" ada-record t]
4718 ["Array" ada-array t]
4719 ["----" nil nil]
4720 ["If" ada-if t]
4721 ["Else" ada-else t]
4722 ["Elsif" ada-elsif t]
4723 ["Case" ada-case t]
4724 ["-----" nil nil]
4725 ["While Loop" ada-while-loop t]
4726 ["For Loop" ada-for-loop t]
4727 ["Loop" ada-loop t]
4728 ["------" nil nil]
4729 ["Exception" ada-exception t]
4730 ["Exit" ada-exit t]
4731 ["When" ada-when t])
4732 )))
4733
4cc7e498 4734 (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode" m)
6f9a2614
JB		 4735 (if (featurep 'xemacs)
4736 (progn
4737 (define-key ada-mode-map [menu-bar] ada-mode-menu)
4738 (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
972579f9
RS		 4739
4740\f
655880d2
GM		 4741;; -------------------------------------------------------
4742;; Commenting/Uncommenting code
4cc7e498 4743;; The following two calls are provided to enhance the standard
7749c1a8 4744;; comment-region function, which only allows uncommenting if the
655880d2 4745;; comment is at the beginning of a line. If the line have been re-indented,
7749c1a8
GM		 4746;; we are unable to use comment-region, which makes no sense.
4747;;
655880d2
GM		 4748;; In addition, we provide an interface to the standard comment handling
4749;; function for justifying the comments.
4750;; -------------------------------------------------------
4751
80d50f88 4752(defadvice comment-region (before ada-uncomment-anywhere disable)
7749c1a8 4753 (if (and arg
4607c7f4
SM		 4754 (listp arg) ;; a prefix with \C-u is of the form '(4), whereas
4755 ;; \C-u 2 sets arg to '2' (fixed by S.Leake)
7749c1a8
GM		 4756 (string= mode-name "Ada"))
4757 (save-excursion
4758 (let ((cs (concat "^[ \t]*" (regexp-quote comment-start))))
4759 (goto-char beg)
4760 (while (re-search-forward cs end t)
4761 (replace-match comment-start))
4762 ))))
972579f9 4763
7749c1a8 4764(defun ada-uncomment-region (beg end &optional arg)
655880d2 4765 "Delete `comment-start' at the beginning of a line in the region."
7749c1a8 4766 (interactive "r\nP")
4cc7e498
GM		 4767
4768 ;; This advice is not needed anymore with Emacs21. However, for older
4769 ;; versions, as well as for XEmacs, we still need to enable it.
6f9a2614 4770 (if (or (<= emacs-major-version 20) (featurep 'xemacs))
4cc7e498
GM		 4771 (progn
4772 (ad-activate 'comment-region)
4607c7f4 4773 (comment-region beg end (- (or arg 2)))
4cc7e498 4774 (ad-deactivate 'comment-region))
80d50f88
SM		 4775 (comment-region beg end (list (- (or arg 2))))
4776 (ada-indent-region beg end)))
7749c1a8
GM		 4777
4778(defun ada-fill-comment-paragraph-justify ()
4779 "Fills current comment paragraph and justifies each line as well."
4780 (interactive)
4781 (ada-fill-comment-paragraph 'full))
4782
4783(defun ada-fill-comment-paragraph-postfix ()
4784 "Fills current comment paragraph and justifies each line as well.
655880d2 4785Adds `ada-fill-comment-postfix' at the end of each line."
7749c1a8
GM		 4786 (interactive)
4787 (ada-fill-comment-paragraph 'full t))
972579f9 4788
7749c1a8
GM		 4789(defun ada-fill-comment-paragraph (&optional justify postfix)
4790 "Fills the current comment paragraph.
4791If JUSTIFY is non-nil, each line is justified as well.
4792If POSTFIX and JUSTIFY are non-nil, `ada-fill-comment-postfix' is appended
4793to each filled and justified line.
4794The paragraph is indented on the first line."
972579f9 4795 (interactive "P")
7749c1a8
GM		 4796
4797 ;; check if inside comment or just in front a comment
4798 (if (and (not (ada-in-comment-p))
4799 (not (looking-at "[ \t]*--")))
4800 (error "not inside comment"))
4801
80d50f88
SM		 4802 (let* (indent from to
4803 (opos (point-marker))
7749c1a8 4804
4cc7e498
GM		 4805 ;; Sets this variable to nil, otherwise it prevents
4806 ;; fill-region-as-paragraph to work on Emacs <= 20.2
4807 (parse-sexp-lookup-properties nil)
4808
7749c1a8
GM		 4809 fill-prefix
4810 (fill-column (current-fill-column)))
4811
4812 ;; Find end of paragraph
4813 (back-to-indentation)
80d50f88 4814 (while (and (not (eobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
7749c1a8 4815 (forward-line 1)
4cc7e498
GM		 4816
4817 ;; If we were at the last line in the buffer, create a dummy empty
4818 ;; line at the end of the buffer.
4607c7f4 4819 (if (eobp)
4cc7e498
GM		 4820 (insert "\n")
4821 (back-to-indentation)))
7749c1a8 4822 (beginning-of-line)
36144b26 4823 (setq to (point-marker))
7749c1a8
GM		 4824 (goto-char opos)
4825
4826 ;; Find beginning of paragraph
4607c7f4 4827 (back-to-indentation)
80d50f88 4828 (while (and (not (bobp)) (looking-at ".*--[ \t]*[^ \t\n]"))
4607c7f4
SM		 4829 (forward-line -1)
4830 (back-to-indentation))
4831
80d50f88 4832 ;; We want one line above the first one, unless we are at the beginning
4607c7f4
SM		 4833 ;; of the buffer
4834 (unless (bobp)
10bcf543 4835 (forward-line 1))
4607c7f4 4836 (beginning-of-line)
36144b26 4837 (setq from (point-marker))
7749c1a8
GM		 4838
4839 ;; Calculate the indentation we will need for the paragraph
4840 (back-to-indentation)
36144b26 4841 (setq indent (current-column))
7749c1a8
GM		 4842 ;; unindent the first line of the paragraph
4843 (delete-region from (point))
4844
4845 ;; Remove the old postfixes
4846 (goto-char from)
4cc7e498 4847 (while (re-search-forward "--\n" to t)
7749c1a8
GM		 4848 (replace-match "\n"))
4849
4850 (goto-char (1- to))
36144b26 4851 (setq to (point-marker))
7749c1a8
GM		 4852
4853 ;; Indent and justify the paragraph
36144b26 4854 (setq fill-prefix ada-fill-comment-prefix)
7749c1a8
GM		 4855 (set-left-margin from to indent)
4856 (if postfix
36144b26 4857 (setq fill-column (- fill-column (length ada-fill-comment-postfix))))
7749c1a8
GM		 4858
4859 (fill-region-as-paragraph from to justify)
4860
4861 ;; Add the postfixes if required
4862 (if postfix
4863 (save-restriction
4864 (goto-char from)
4865 (narrow-to-region from to)
4866 (while (not (eobp))
4867 (end-of-line)
4868 (insert-char ? (- fill-column (current-column)))
4869 (insert ada-fill-comment-postfix)
4870 (forward-line))
4871 ))
4872
4873 ;; In Emacs <= 20.2 and XEmacs <=20.4, there is a bug, and a newline is
4874 ;; inserted at the end. Delete it
6f9a2614 4875 (if (or (featurep 'xemacs)
7749c1a8
GM		 4876 (<= emacs-major-version 19)
4877 (and (= emacs-major-version 20)
4878 (<= emacs-minor-version 2)))
4879 (progn
4880 (goto-char to)
4881 (end-of-line)
4882 (delete-char 1)))
4883
4884 (goto-char opos)))
972579f9 4885
4cc7e498 4886
655880d2
GM		 4887;; ---------------------------------------------------
4888;; support for find-file.el
4889;; These functions are used by find-file to guess the file names from
4890;; unit names, and to find the other file (spec or body) from the current
4891;; file (body or spec).
4892;; It is also used to find in which function we are, so as to put the
4893;; cursor at the correct position.
4894;; Standard Ada does not force any relation between unit names and file names,
4895;; so some of these functions can only be a good approximation. However, they
4896;; are also overriden in `ada-xref'.el when we know that the user is using
4897;; GNAT.
4898;; ---------------------------------------------------
4899
4900;; Overriden when we work with GNAT, to use gnatkrunch
972579f9 4901(defun ada-make-filename-from-adaname (adaname)
655880d2
GM		 4902 "Determine the filename in which ADANAME is found.
4903This is a generic function, independent from any compiler."
7749c1a8 4904 (while (string-match "\\." adaname)
36144b26 4905 (setq adaname (replace-match "-" t t adaname)))
4cc7e498 4906 (downcase adaname)
972579f9
RS		 4907 )
4908
7749c1a8 4909(defun ada-other-file-name ()
4cc7e498
GM		 4910 "Return the name of the other file.
4911The name returned is the body if current-buffer is the spec, or the spec
4912otherwise."
4913
4914 (let ((is-spec nil)
4915 (is-body nil)
4916 (suffixes ada-spec-suffixes)
4917 (name (buffer-file-name)))
4918
4919 ;; Guess whether we have a spec or a body, and get the basename of the
4920 ;; file. Since the extension may not start with '.', we can not use
4921 ;; file-name-extension
4922 (while (and (not is-spec)
4923 suffixes)
4924 (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
4925 (setq is-spec t
4926 name (match-string 1 name)))
36144b26 4927 (setq suffixes (cdr suffixes)))
4cc7e498
GM		 4928
4929 (if (not is-spec)
4930 (progn
36144b26 4931 (setq suffixes ada-body-suffixes)
4cc7e498
GM		 4932 (while (and (not is-body)
4933 suffixes)
4934 (if (string-match (concat "\\(.*\\)" (car suffixes) "$") name)
4935 (setq is-body t
4936 name (match-string 1 name)))
36144b26 4937 (setq suffixes (cdr suffixes)))))
eaae8106 4938
4cc7e498
GM		 4939 ;; If this wasn't in either list, return name itself
4940 (if (not (or is-spec is-body))
4941 name
eaae8106 4942
4cc7e498
GM		 4943 ;; Else find the other possible names
4944 (if is-spec
36144b26
SM		 4945 (setq suffixes ada-body-suffixes)
4946 (setq suffixes ada-spec-suffixes))
4947 (setq is-spec name)
4cc7e498
GM		 4948
4949 (while suffixes
4607c7f4
SM		 4950
4951 ;; If we are using project file, search for the other file in all
4952 ;; the possible src directories.
a1506d29 4953
6f9a2614 4954 (if (fboundp 'ada-find-src-file-in-dir)
4607c7f4
SM		 4955 (let ((other
4956 (ada-find-src-file-in-dir
4957 (file-name-nondirectory (concat name (car suffixes))))))
4958 (if other
4959 (set 'is-spec other)))
4960
4961 ;; Else search in the current directory
4962 (if (file-exists-p (concat name (car suffixes)))
4963 (setq is-spec (concat name (car suffixes)))))
36144b26 4964 (setq suffixes (cdr suffixes)))
4cc7e498
GM		 4965
4966 is-spec)))
f139ce87 4967
f139ce87 4968(defun ada-which-function-are-we-in ()
655880d2
GM		 4969 "Return the name of the function whose definition/declaration point is in.
4970Redefines the function `ff-which-function-are-we-in'."
36144b26 4971 (setq ff-function-name nil)
f139ce87 4972 (save-excursion
4cc7e498 4973 (end-of-line);; make sure we get the complete name
7749c1a8
GM		 4974 (if (or (re-search-backward ada-procedure-start-regexp nil t)
4975 (re-search-backward ada-package-start-regexp nil t))
36144b26 4976 (setq ff-function-name (match-string 0)))
7749c1a8 4977 ))
f139ce87 4978
4cc7e498
GM		 4979
4980(defvar ada-last-which-function-line -1
4981 "Last on which ada-which-function was called")
4982(defvar ada-last-which-function-subprog 0
4983 "Last subprogram name returned by ada-which-function")
4984(make-variable-buffer-local 'ada-last-which-function-subprog)
4985(make-variable-buffer-local 'ada-last-which-function-line)
4986
4987
4988(defun ada-which-function ()
4989 "Returns the name of the function whose body the point is in.
4990This function works even in the case of nested subprograms, whereas the
80d50f88 4991standard Emacs function `which-function' does not.
4cc7e498
GM		 4992Since the search can be long, the results are cached."
4993
80d50f88 4994 (let ((line (count-lines 1 (point)))
4cc7e498
GM		 4995 (pos (point))
4996 end-pos
4607c7f4 4997 func-name indent
4cc7e498
GM		 4998 found)
4999
5000 ;; If this is the same line as before, simply return the same result
5001 (if (= line ada-last-which-function-line)
5002 ada-last-which-function-subprog
5003
5004 (save-excursion
5005 ;; In case the current line is also the beginning of the body
5006 (end-of-line)
4cc7e498 5007
4607c7f4
SM		 5008 ;; Are we looking at "function Foo\n (paramlist)"
5009 (skip-chars-forward " \t\n(")
a1506d29 5010
4607c7f4 5011 (condition-case nil
80d50f88 5012 (up-list 1)
4607c7f4
SM		 5013 (error nil))
5014
5015 (skip-chars-forward " \t\n")
5016 (if (looking-at "return")
5017 (progn
5018 (forward-word 1)
5019 (skip-chars-forward " \t\n")
5020 (skip-chars-forward "a-zA-Z0-9_'")))
a1506d29 5021
4cc7e498
GM		 5022 ;; Can't simply do forward-word, in case the "is" is not on the
5023 ;; same line as the closing parenthesis
5024 (skip-chars-forward "is \t\n")
5025
5026 ;; No look for the closest subprogram body that has not ended yet.
4607c7f4
SM		 5027 ;; Not that we expect all the bodies to be finished by "end <name>",
5028 ;; or a simple "end;" indented in the same column as the start of
5029 ;; the subprogram. The goal is to be as efficient as possible.
4cc7e498
GM		 5030
5031 (while (and (not found)
5032 (re-search-backward ada-imenu-subprogram-menu-re nil t))
4607c7f4
SM		 5033
5034 ;; Get the function name, but not the properties, or this changes
5035 ;; the face in the modeline on Emacs 21
5036 (setq func-name (match-string-no-properties 2))
4cc7e498
GM		 5037 (if (and (not (ada-in-comment-p))
5038 (not (save-excursion
5039 (goto-char (match-end 0))
5040 (looking-at "[ \t\n]*new"))))
5041 (save-excursion
4607c7f4
SM		 5042 (back-to-indentation)
5043 (setq indent (current-column))
4cc7e498 5044 (if (ada-search-ignore-string-comment
4607c7f4
SM		 5045 (concat "end[ \t]+" func-name "[ \t]*;\\|^"
5046 (make-string indent ? ) "end;"))
36144b26
SM		 5047 (setq end-pos (point))
5048 (setq end-pos (point-max)))
4cc7e498 5049 (if (>= end-pos pos)
36144b26 5050 (setq found func-name))))
4cc7e498
GM		 5051 )
5052 (setq ada-last-which-function-line line
5053 ada-last-which-function-subprog found)
5054 found))))
5055
5056(defun ada-ff-other-window ()
5057 "Find other file in other window using `ff-find-other-file'."
5058 (interactive)
5059 (and (fboundp 'ff-find-other-file)
5060 (ff-find-other-file t)))
5061
7749c1a8 5062(defun ada-set-point-accordingly ()
655880d2
GM		 5063 "Move to the function declaration that was set by
5064`ff-which-function-are-we-in'."
7749c1a8
GM		 5065 (if ff-function-name
5066 (progn
5067 (goto-char (point-min))
655880d2 5068 (unless (ada-search-ignore-string-comment
4cc7e498 5069 (concat ff-function-name "\\b") nil)
7749c1a8 5070 (goto-char (point-min))))))
f139ce87 5071
4cc7e498
GM		 5072(defun ada-get-body-name (&optional spec-name)
5073 "Returns the file name for the body of SPEC-NAME.
5074If SPEC-NAME is nil, returns the body for the current package.
5075Returns nil if no body was found."
5076 (interactive)
5077
36144b26 5078 (unless spec-name (setq spec-name (buffer-file-name)))
4cc7e498 5079
4607c7f4
SM		 5080 ;; Remove the spec extension. We can not simply remove the file extension,
5081 ;; but we need to take into account the specific non-GNAT extensions that the
5082 ;; user might have specified.
5083
5084 (let ((suffixes ada-spec-suffixes)
5085 end)
5086 (while suffixes
5087 (setq end (- (length spec-name) (length (car suffixes))))
5088 (if (string-equal (car suffixes) (substring spec-name end))
5089 (setq spec-name (substring spec-name 0 end)))
5090 (setq suffixes (cdr suffixes))))
5091
4cc7e498 5092 ;; If find-file.el was available, use its functions
6f9a2614
JB		 5093 (if (fboundp 'ff-get-file-name)
5094 (ff-get-file-name ada-search-directories-internal
4cc7e498
GM		 5095 (ada-make-filename-from-adaname
5096 (file-name-nondirectory
5097 (file-name-sans-extension spec-name)))
5098 ada-body-suffixes)
5099 ;; Else emulate it very simply
5100 (concat (ada-make-filename-from-adaname
5101 (file-name-nondirectory
5102 (file-name-sans-extension spec-name)))
5103 ".adb")))
5104
655880d2
GM		 5105\f
5106;; ---------------------------------------------------
5107;; support for font-lock.el
cadd3658
RS		 5108;; Strings are a real pain in Ada because a single quote character is
5109;; overloaded as a string quote and type/instance delimiter. By default, a
5110;; single quote is given punctuation syntax in `ada-mode-syntax-table'.
5111;; So, for Font Lock mode purposes, we mark single quotes as having string
655880d2
GM		 5112;; syntax when the gods that created Ada determine them to be.
5113;;
5114;; This only works in Emacs. See the comments before the grammar functions
5115;; at the beginning of this file for how this is done with XEmacs.
5116;; ----------------------------------------------------
cadd3658
RS		 5117
5118(defconst ada-font-lock-syntactic-keywords
5119 ;; Mark single quotes as having string quote syntax in 'c' instances.
655880d2
GM		 5120 ;; As a special case, ''' will not be highlighted, but if we do not
5121 ;; set this special case, then the rest of the buffer is highlighted as
7749c1a8
GM		 5122 ;; a string
5123 ;; This sets the properties of the characters, so that ada-in-string-p
5124 ;; correctly handles '"' too...
4607c7f4 5125 '(("[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)" (1 (7 . ?')) (2 (7 . ?')))
7749c1a8 5126 ("^[ \t]*\\(#\\(if\\|else\\|elsif\\|end\\)\\)" (1 (11 . ?\n)))
972579f9 5127 ))
972579f9 5128
7749c1a8
GM		 5129(defvar ada-font-lock-keywords
5130 (eval-when-compile
5131 (list
5132 ;;
5133 ;; handle "type T is access function return S;"
5134 (list "\\<\\(function[ \t]+return\\)\\>" '(1 font-lock-keyword-face) )
cadd3658 5135
7749c1a8
GM		 5136 ;; preprocessor line
5137 (list "^[ \t]*\\(#.*\n\\)" '(1 font-lock-type-face t))
cadd3658 5138
7749c1a8
GM		 5139 ;;
5140 ;; accept, entry, function, package (body), protected (body|type),
5141 ;; pragma, procedure, task (body) plus name.
5142 (list (concat
5143 "\\<\\("
5144 "accept\\|"
5145 "entry\\|"
5146 "function\\|"
5147 "package[ \t]+body\\|"
5148 "package\\|"
5149 "pragma\\|"
5150 "procedure\\|"
5151 "protected[ \t]+body\\|"
5152 "protected[ \t]+type\\|"
5153 "protected\\|"
5154 "task[ \t]+body\\|"
5155 "task[ \t]+type\\|"
5156 "task"
5157 "\\)\\>[ \t]*"
5158 "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
5159 '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t))
5160 ;;
5161 ;; Optional keywords followed by a type name.
5162 (list (concat ; ":[ \t]*"
4607c7f4 5163 "\\<\\(access[ \t]+all\\|access[ \t]+constant\\|access\\|constant\\|in[ \t]+reverse\\|\\|in[ \t]+out\\|in\\|out\\)\\>"
7749c1a8
GM		 5164 "[ \t]*"
5165 "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
5166 '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
cadd3658 5167
7749c1a8
GM		 5168 ;;
5169 ;; Main keywords, except those treated specially below.
5170 (concat "\\<"
5171 (regexp-opt
5172 '("abort" "abs" "abstract" "accept" "access" "aliased" "all"
5173 "and" "array" "at" "begin" "case" "declare" "delay" "delta"
5174 "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
5175 "generic" "if" "in" "is" "limited" "loop" "mod" "not"
5176 "null" "or" "others" "private" "protected" "raise"
5177 "range" "record" "rem" "renames" "requeue" "return" "reverse"
5178 "select" "separate" "tagged" "task" "terminate" "then" "until"
f7a80909 5179 "when" "while" "with" "xor") t)
7749c1a8
GM		 5180 "\\>")
5181 ;;
5182 ;; Anything following end and not already fontified is a body name.
5183 '("\\<\\(end\\)\\>\\([ \t]+\\)?\\(\\(\\sw\\|[_.]\\)+\\)?"
5184 (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
5185 ;;
5186 ;; Keywords followed by a type or function name.
5187 (list (concat "\\<\\("
5188 "new\\|of\\|subtype\\|type"
5189 "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?")
5190 '(1 font-lock-keyword-face)
5191 '(2 (if (match-beginning 4)
5192 font-lock-function-name-face
5193 font-lock-type-face) nil t))
5194 ;;
5195 ;; Keywords followed by a (comma separated list of) reference.
4607c7f4
SM		 5196 ;; Note that font-lock only works on single lines, thus we can not
5197 ;; correctly highlight a with_clause that spans multiple lines.
5198 (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)"
5199 "[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W")
7749c1a8 5200 '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
f7a80909 5201
7749c1a8
GM		 5202 ;;
5203 ;; Goto tags.
5204 '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)
4607c7f4
SM		 5205
5206 ;; Highlight based-numbers (R. Reagan <robin-reply@reagans.org>)
5207 (list "\\([0-9]+#[0-9a-fA-F_]+#\\)" '(1 font-lock-constant-face t))
5208
5209 ;; Ada unnamed numerical constants
5210 (list "\\W\\([-+]?[0-9._]+\\)\\>" '(1 font-lock-constant-face))
a1506d29 5211
7749c1a8
GM		 5212 ))
5213 "Default expressions to highlight in Ada mode.")
5214
4cc7e498 5215
655880d2
GM		 5216;; ---------------------------------------------------------
5217;; Support for outline.el
5218;; ---------------------------------------------------------
cadd3658 5219
cadd3658 5220(defun ada-outline-level ()
655880d2 5221 "This is so that `current-column` DTRT in otherwise-hidden text"
7749c1a8 5222 ;; patch from Dave Love <fx@gnu.org>
b073b657
DL		 5223 (let (buffer-invisibility-spec)
5224 (save-excursion
7749c1a8 5225 (back-to-indentation)
b073b657 5226 (current-column))))
972579f9 5227
f7a80909
JB		 5228;; ---------------------------------------------------------
5229;; Support for narrow-to-region
5230;; ---------------------------------------------------------
5231
5232(defun ada-narrow-to-defun (&optional arg)
5233 "make text outside current subprogram invisible.
5234The subprogram visible is the one that contains or follow point.
5235Optional ARG is ignored.
5236Use `M-x widen' to go back to the full visibility for the buffer"
5237
5238 (interactive)
5239 (save-excursion
5240 (let (end)
5241 (widen)
5242 (forward-line 1)
5243 (ada-previous-procedure)
5244
5245 (save-excursion
5246 (beginning-of-line)
5247 (setq end (point)))
5248
5249 (ada-move-to-end)
5250 (end-of-line)
5251 (narrow-to-region end (point))
5252 (message
5253 "Use M-x widen to get back to full visibility in the buffer"))))
5254
655880d2
GM		 5255;; ---------------------------------------------------------
5256;; Automatic generation of code
5257;; The Ada-mode has a set of function to automatically generate a subprogram
5258;; or package body from its spec.
5259;; These function only use a primary and basic algorithm, this could use a
5260;; lot of improvement.
5261;; When the user is using GNAT, we rather use gnatstub to generate an accurate
5262;; body.
5263;; ----------------------------------------------------------
972579f9 5264
f139ce87 5265(defun ada-gen-treat-proc (match)
655880d2
GM		 5266 "Make dummy body of a procedure/function specification.
5267MATCH is a cons cell containing the start and end location of the last search
5268for ada-procedure-start-regexp."
f139ce87 5269 (goto-char (car match))
7749c1a8 5270 (let (func-found procname functype)
f139ce87 5271 (cond
7749c1a8 5272 ((or (looking-at "^[ \t]*procedure")
36144b26 5273 (setq func-found (looking-at "^[ \t]*function")))
f139ce87 5274 ;; treat it as a proc/func
7749c1a8 5275 (forward-word 2)
f139ce87 5276 (forward-word -1)
36144b26 5277 (setq procname (buffer-substring (point) (cdr match))) ; store proc name
7749c1a8
GM		 5278
5279 ;; goto end of procname
5280 (goto-char (cdr match))
5281
5282 ;; skip over parameterlist
5283 (unless (looking-at "[ \t\n]*\\(;\\|return\\)")
5284 (forward-sexp))
5285
5286 ;; if function, skip over 'return' and result type.
f139ce87 5287 (if func-found
7749c1a8
GM		 5288 (progn
5289 (forward-word 1)
5290 (skip-chars-forward " \t\n")
36144b26 5291 (setq functype (buffer-substring (point)
7749c1a8
GM		 5292 (progn
5293 (skip-chars-forward
5294 "a-zA-Z0-9_\.")
5295 (point))))))
5296 ;; look for next non WS
5297 (cond
5298 ((looking-at "[ \t]*;")
5299 (delete-region (match-beginning 0) (match-end 0));; delete the ';'
5300 (ada-indent-newline-indent)
5301 (insert "is")
5302 (ada-indent-newline-indent)
5303 (if func-found
5304 (progn
5305 (insert "Result : " functype ";")
5306 (ada-indent-newline-indent)))
5307 (insert "begin")
5308 (ada-indent-newline-indent)
5309 (if func-found
5310 (insert "return Result;")
5311 (insert "null;"))
5312 (ada-indent-newline-indent)
5313 (insert "end " procname ";")
5314 (ada-indent-newline-indent)
5315 )
5316 ;; else
5317 ((looking-at "[ \t\n]*is")
5318 ;; do nothing
5319 )
5320 ((looking-at "[ \t\n]*rename")
5321 ;; do nothing
5322 )
5323 (t
5324 (message "unknown syntax"))))
f139ce87 5325 (t
7749c1a8
GM		 5326 (if (looking-at "^[ \t]*task")
5327 (progn
5328 (message "Task conversion is not yet implemented")
5329 (forward-word 2)
5330 (if (looking-at "[ \t]*;")
5331 (forward-line)
5332 (ada-move-to-end))
5333 ))))))
f139ce87
KH		 5334
5335(defun ada-make-body ()
5336 "Create an Ada package body in the current buffer.
5337The potential old buffer contents is deleted first, then we copy the
5338spec buffer in here and modify it to make it a body.
f139ce87
KH		 5339This function typically is to be hooked into `ff-file-created-hooks'."
5340 (interactive)
5341 (delete-region (point-min) (point-max))
5342 (insert-buffer (car (cdr (buffer-list))))
5343 (ada-mode)
5344
7749c1a8 5345 (let (found ada-procedure-or-package-start-regexp)
36144b26 5346 (if (setq found
7749c1a8
GM		 5347 (ada-search-ignore-string-comment ada-package-start-regexp nil))
5348 (progn (goto-char (cdr found))
5349 (insert " body")
5350 )
972579f9 5351 (error "No package"))
f139ce87 5352
36144b26 5353 (setq ada-procedure-or-package-start-regexp
7749c1a8
GM		 5354 (concat ada-procedure-start-regexp
5355 "\\|"
5356 ada-package-start-regexp))
972579f9 5357
36144b26 5358 (while (setq found
7749c1a8
GM		 5359 (ada-search-ignore-string-comment
5360 ada-procedure-or-package-start-regexp nil))
5361 (progn
5362 (goto-char (car found))
5363 (if (looking-at ada-package-start-regexp)
5364 (progn (goto-char (cdr found))
5365 (insert " body"))
5366 (ada-gen-treat-proc found))))))
5367
4cc7e498 5368
7749c1a8 5369(defun ada-make-subprogram-body ()
655880d2 5370 "Make one dummy subprogram body from spec surrounding point."
7749c1a8
GM		 5371 (interactive)
5372 (let* ((found (re-search-backward ada-procedure-start-regexp nil t))
4cc7e498
GM		 5373 (spec (match-beginning 0))
5374 body-file)
7749c1a8
GM		 5375 (if found
5376 (progn
5377 (goto-char spec)
5378 (if (and (re-search-forward "(\\|;" nil t)
5379 (= (char-before) ?\())
5380 (progn
5381 (ada-search-ignore-string-comment ")" nil)
5382 (ada-search-ignore-string-comment ";" nil)))
36144b26 5383 (setq spec (buffer-substring spec (point)))
7749c1a8 5384
4cc7e498 5385 ;; If find-file.el was available, use its functions
36144b26 5386 (setq body-file (ada-get-body-name))
4cc7e498
GM		 5387 (if body-file
5388 (find-file body-file)
f7a80909 5389 (error "No body found for the package. Create it first."))
4cc7e498 5390
7749c1a8
GM		 5391 (save-restriction
5392 (widen)
5393 (goto-char (point-max))
5394 (forward-comment -10000)
5395 (re-search-backward "\\<end\\>" nil t)
5396 ;; Move to the beginning of the elaboration part, if any
5397 (re-search-backward "^begin" nil t)
5398 (newline)
5399 (forward-char -1)
5400 (insert spec)
5401 (re-search-backward ada-procedure-start-regexp nil t)
5402 (ada-gen-treat-proc (cons (match-beginning 0) (match-end 0)))
5403 ))
5404 (error "Not in subprogram spec"))))
5405
655880d2
GM		 5406;; --------------------------------------------------------
5407;; Global initializations
5408;; --------------------------------------------------------
5409
7749c1a8
GM		 5410;; Create the keymap once and for all. If we do that in ada-mode,
5411;; the keys changed in the user's .emacs have to be modified
5412;; every time
5413(ada-create-keymap)
5414(ada-create-menu)
5415
5416;; Create the syntax tables, but do not activate them
5417(ada-create-syntax-table)
5418
5419;; Add the default extensions (and set up speedbar)
5420(ada-add-extensions ".ads" ".adb")
5421;; This two files are generated by GNAT when running with -gnatD
5422(if (equal ada-which-compiler 'gnat)
5423 (ada-add-extensions ".ads.dg" ".adb.dg"))
5424
5425;; Read the special cases for exceptions
5426(ada-case-read-exceptions)
5427
f7a80909 5428;; Setup auto-loading of the other ada-mode files.
7749c1a8
GM		 5429(if (equal ada-which-compiler 'gnat)
5430 (progn
f7a80909
JB		 5431 (autoload 'ada-change-prj "ada-xref" nil t)
5432 (autoload 'ada-check-current "ada-xref" nil t)
5433 (autoload 'ada-compile-application "ada-xref" nil t)
5434 (autoload 'ada-compile-current "ada-xref" nil t)
5435 (autoload 'ada-complete-identifier "ada-xref" nil t)
5436 (autoload 'ada-find-file "ada-xref" nil t)
5437 (autoload 'ada-find-any-references "ada-xref" nil t)
5438 (autoload 'ada-find-src-file-in-dir "ada-xref" nil t)
5439 (autoload 'ada-find-local-references "ada-xref" nil t)
5440 (autoload 'ada-find-references "ada-xref" nil t)
5441 (autoload 'ada-gdb-application "ada-xref" nil t)
5442 (autoload 'ada-goto-declaration "ada-xref" nil t)
5443 (autoload 'ada-goto-declaration-other-frame "ada-xref" nil t)
5444 (autoload 'ada-goto-parent "ada-xref" nil t)
5445 (autoload 'ada-make-body-gnatstub "ada-xref" nil t)
5446 (autoload 'ada-point-and-xref "ada-xref" nil t)
5447 (autoload 'ada-reread-prj-file "ada-xref" nil t)
5448 (autoload 'ada-run-application "ada-xref" nil t)
5449 (autoload 'ada-set-default-project-file "ada-xref" nil nil)
5450 (autoload 'ada-set-default-project-file "ada-xref" nil t)
5451 (autoload 'ada-xref-goto-previous-reference "ada-xref" nil t)
5452
5453 (autoload 'ada-customize "ada-prj" nil t)
5454 (autoload 'ada-prj-edit "ada-prj" nil t)
5455 (autoload 'ada-prj-new "ada-prj" nil t)
5456 (autoload 'ada-prj-save "ada-prj" nil t)
7749c1a8 5457 ))
f7a80909
JB		 5458
5459(autoload 'ada-array "ada-stmt" nil t)
5460(autoload 'ada-case "ada-stmt" nil t)
5461(autoload 'ada-declare-block "ada-stmt" nil t)
5462(autoload 'ada-else "ada-stmt" nil t)
5463(autoload 'ada-elsif "ada-stmt" nil t)
5464(autoload 'ada-exception "ada-stmt" nil t)
5465(autoload 'ada-exception-block "ada-stmt" nil t)
5466(autoload 'ada-exit "ada-stmt" nil t)
5467(autoload 'ada-for-loop "ada-stmt" nil t)
5468(autoload 'ada-function-spec "ada-stmt" nil t)
5469(autoload 'ada-header "ada-stmt" nil t)
5470(autoload 'ada-if "ada-stmt" nil t)
5471(autoload 'ada-loop "ada-stmt" nil t)
5472(autoload 'ada-package-body "ada-stmt" nil t)
5473(autoload 'ada-package-spec "ada-stmt" nil t)
5474(autoload 'ada-private "ada-stmt" nil t)
5475(autoload 'ada-procedure-spec "ada-stmt" nil t)
5476(autoload 'ada-record "ada-stmt" nil t)
5477(autoload 'ada-subprogram-body "ada-stmt" nil t)
5478(autoload 'ada-subtype "ada-stmt" nil t)
5479(autoload 'ada-tabsize "ada-stmt" nil t)
5480(autoload 'ada-task-body "ada-stmt" nil t)
5481(autoload 'ada-task-spec "ada-stmt" nil t)
5482(autoload 'ada-type "ada-stmt" nil t)
5483(autoload 'ada-use "ada-stmt" nil t)
5484(autoload 'ada-when "ada-stmt" nil t)
5485(autoload 'ada-while-loop "ada-stmt" nil t)
5486(autoload 'ada-with "ada-stmt" nil t)
972579f9 5487
7749c1a8 5488;;; provide ourselves
972579f9
RS		 5489(provide 'ada-mode)
5490
6b61353c 5491;;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270
a681b2a1 5492;;; ada-mode.el ends here
Unnamed repository; edit this file 'description' to name the repository.