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

3
;; Copyright (C) 1994, 95, 97, 98, 99, 2000, 2001, 2002, 2003
Gerd Moellmann's avatar
Gerd Moellmann committed
4
;;  Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
5

6 7 8 9
;; Author: Rolf Ebert      <ebert@inf.enst.fr>
;;      Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
;;      Emmanuel Briot  <briot@gnat.com>
;; Maintainer: Emmanuel Briot <briot@gnat.com>
10
;; Ada Core Technologies's version:   Revision: 1.188
11
;; Keywords: languages ada
Richard M. Stallman's avatar
Richard M. Stallman committed
12

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

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

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

;; You should have received a copy of the GNU General Public License
Gerd Moellmann's avatar
Gerd Moellmann committed
26 27 28
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
29 30 31

;;; Commentary:
;;; This mode is a major mode for editing Ada83 and Ada95 source code.
32
;;; This is a major rewrite of the file packaged with Emacs-20.  The
33
;;; ada-mode is composed of four lisp files, ada-mode.el, ada-xref.el,
34
;;; ada-prj.el and ada-stmt.el. Only this file (ada-mode.el) is
35
;;; completely independent from the GNU Ada compiler Gnat, distributed
36
;;; by Ada Core Technologies. All the other files rely heavily on
37
;;; features provided only by Gnat.
Richard M. Stallman's avatar
Richard M. Stallman committed
38
;;;
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
;;; Note: this mode will not work with Emacs 19. If you are on a VMS
;;; system, where the latest version of Emacs is 19.28, you will need
;;; another file, called ada-vms.el, that provides some required
;;; functions.

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

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

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

100
;;; Code:
101
;;; Note: Every function in this package is compiler-independent.
102
;;; The names start with  ada-
103
;;; The variables that the user can edit can all be modified through
104 105 106
;;;   the customize mode. They are sorted in alphabetical order in this
;;;   file.

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

129 130 131 132 133 134
(eval-when-compile
  (require 'ispell nil t)
  (require 'find-file nil t)
  (require 'align nil t)
  (require 'which-func nil t)
  (require 'compile nil t))
135 136 137

;; this function is needed at compile time
(eval-and-compile
138 139 140 141
  (defun ada-check-emacs-version (major minor &optional is-xemacs)
    "Returns t if Emacs's version is greater or equal to MAJOR.MINOR.
If IS-XEMACS is non-nil, check for XEmacs instead of Emacs."
    (let ((xemacs-running (or (string-match "Lucid"  emacs-version)
142
                              (string-match "XEmacs" emacs-version))))
143
      (and (or (and is-xemacs xemacs-running)
144 145 146 147 148
               (not (or is-xemacs xemacs-running)))
           (or (> emacs-major-version major)
               (and (= emacs-major-version major)
                    (>= emacs-minor-version minor)))))))

149 150

;;  This call should not be made in the release that is done for the
Richard M. Stallman's avatar
Richard M. Stallman committed
151
;;  official Emacs, since it does nothing useful for the latest version
152 153
;;(if (not (ada-check-emacs-version 21 1))
;;    (require 'ada-support))
Richard M. Stallman's avatar
Richard M. Stallman committed
154

155 156
(defvar ada-mode-hook nil
  "*List of functions to call when Ada mode is invoked.
157
This hook is automatically executed after the `ada-mode' is
158 159
fully loaded.
This is a good place to add Ada environment specific bindings.")
Richard M. Stallman's avatar
Richard M. Stallman committed
160 161

(defgroup ada nil
162
  "Major mode for editing Ada source in Emacs."
Richard M. Stallman's avatar
Richard M. Stallman committed
163 164
  :group 'languages)

165 166 167 168 169
(defcustom ada-auto-case t
  "*Non-nil means automatically change case of preceding word while typing.
Casing is done according to `ada-case-keyword', `ada-case-identifier'
and `ada-case-attribute'."
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
170

171 172 173 174 175 176 177 178
(defcustom ada-broken-decl-indent 0
  "*Number of columns to indent a broken declaration.

An example is :
  declare
     A,
     >>>>>B : Integer;  --  from ada-broken-decl-indent"
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
179

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

183 184 185 186
An example is :
   My_Var : My_Type := (Field1 =>
                        >>>>>>>>>Value);  -- from ada-broken-indent"
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
187

188 189 190 191 192 193 194 195 196
(defcustom ada-continuation-indent ada-broken-indent
  "*Number of columns to indent the continuation of broken lines in
parenthesis.

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

197 198
(defcustom ada-case-attribute 'ada-capitalize-word
  "*Function to call to adjust the case of Ada attributes.
199 200
It may be `downcase-word', `upcase-word', `ada-loose-case-word',
`ada-capitalize-word' or `ada-no-auto-case'."
201 202 203
  :type '(choice (const downcase-word)
                 (const upcase-word)
                 (const ada-capitalize-word)
204 205
                 (const ada-loose-case-word)
                 (const ada-no-auto-case))
Richard M. Stallman's avatar
Richard M. Stallman committed
206
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
207

208 209
(defcustom ada-case-exception-file
  (list (convert-standard-filename' "~/.emacs_case_exceptions"))
210 211 212 213 214
  "*List of special casing exceptions dictionaries for identifiers.
The first file is the one where new exceptions will be saved by Emacs
when you call `ada-create-case-exception'.

These files should contain one word per line, that gives the casing
215 216 217 218
to be used for that word in Ada files. If the line starts with the
character *, then the exception will be used for substrings that either
start at the beginning of a word or after a _ character, and end either
at the end of the word or at a _ character. Each line can be terminated by
219 220 221
a comment."
  :type '(repeat (file))
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
222

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

234 235 236 237 238 239 240
(defcustom ada-case-identifier 'ada-loose-case-word
  "*Function to call to adjust the case of an Ada identifier.
It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
`ada-capitalize-word'."
  :type '(choice (const downcase-word)
                 (const upcase-word)
                 (const ada-capitalize-word)
241 242
                 (const ada-loose-case-word)
                 (const ada-no-auto-case))
Richard M. Stallman's avatar
Richard M. Stallman committed
243
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
244

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

249 250
(defcustom ada-indent 3
  "*Size of Ada indentation.
Richard M. Stallman's avatar
Richard M. Stallman committed
251

252 253 254 255 256
An example is :
procedure Foo is
begin
>>>>>>>>>>null;  --  from ada-indent"
  :type 'integer  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
257

258 259 260
(defcustom ada-indent-after-return t
  "*Non-nil means automatically indent after RET or LFD."
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
261

262 263 264 265 266 267 268 269 270 271
(defcustom ada-indent-align-comments t
  "*Non-nil means align comments on previous line comments, if any.
If nil, indentation is calculated as usual.
Note that indentation is calculated only if `ada-indent-comment-as-code' is t.

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

272
(defcustom ada-indent-comment-as-code t
273
  "*Non-nil means indent comment lines as code.
Pavel Janík's avatar
Pavel Janík committed
274
nil means do not auto-indent comments."
275
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
276

277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298
(defcustom ada-indent-handle-comment-special nil
  "*Non-nil if comment lines should be handled specially inside
parenthesis.
By default, if the line that contains the open parenthesis has some
text following it, then the following lines will be indented in the
same column as this text. This will not be true if the first line is
a comment and `ada-indent-handle-comment-special' is t.

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

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

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

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

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

307 308 309 310
An example is:
   type A is
   >>>>>>>>>>>record    --  from ada-indent-record-rel-type"
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
311

312 313 314 315 316 317 318 319 320 321 322
(defcustom ada-indent-renames ada-broken-indent
  "*Indentation for renames relative to the matching function statement.
If ada-indent-return is null or negative, the indentation is done relative to
the open parenthesis (if there is no parenthesis, ada-broken-indent is used).

An example is:
   function A (B : Integer)
       return C;      --  from ada-indent-return
   >>>renames Foo;    --  from ada-indent-renames"
  :type 'integer :group 'ada)

323 324 325
(defcustom ada-indent-return 0
  "*Indentation for 'return' relative to the matching 'function' statement.
If ada-indent-return is null or negative, the indentation is done relative to
326
the open parenthesis (if there is no parenthesis, ada-broken-indent is used).
Richard M. Stallman's avatar
Richard M. Stallman committed
327

328 329 330 331
An example is:
   function A (B : Integer)
   >>>>>return C;       --  from ada-indent-return"
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
332

333 334 335
(defcustom ada-indent-to-open-paren t
  "*Non-nil means indent according to the innermost open parenthesis."
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
336

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

343 344 345 346
(defcustom ada-fill-comment-postfix " --"
  "*Text inserted at the end of each line when filling a comment paragraph.
with `ada-fill-comment-paragraph-postfix'."
  :type 'string :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
347

348 349
(defcustom ada-label-indent -4
  "*Number of columns to indent a label.
Richard M. Stallman's avatar
Richard M. Stallman committed
350

351 352 353
An example is:
procedure Foo is
begin
354 355 356
>>>>>>>>>>>>Label:  --  from ada-label-indent

This is also used for <<..>> labels"
357
  :type 'integer :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
358 359 360

(defcustom ada-language-version 'ada95
  "*Do we program in `ada83' or `ada95'?"
361
  :type '(choice (const ada83) (const ada95)) :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
362

363
(defcustom ada-move-to-declaration nil
364
  "*Non-nil means `ada-move-to-start' moves point to the subprogram declaration,
365 366
not to 'begin'."
  :type 'boolean :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
367

368 369
(defcustom ada-popup-key '[down-mouse-3]
  "*Key used for binding the contextual menu.
370
If nil, no contextual menu is available."
Dave Love's avatar
Dave Love committed
371
  :type '(restricted-sexp :match-alternatives (stringp vectorp))
Dave Love's avatar
Dave Love committed
372
  :group 'ada)
373

374
(defcustom ada-search-directories
375 376 377 378
  (append '(".")
	  (split-string (or (getenv "ADA_INCLUDE_PATH") "") ":")
	  '("/usr/adainclude" "/usr/local/adainclude"
	    "/opt/gnu/adainclude"))
379
  "*List of directories to search for Ada files.
380 381 382
See the description for the `ff-search-directories' variable. This variable
is the initial value of this variable, and is copied and modified in
`ada-search-directories-internal'."
383 384 385
  :type '(repeat (choice :tag "Directory"
                         (const :tag "default" nil)
                         (directory :format "%v")))
Richard M. Stallman's avatar
Richard M. Stallman committed
386
  :group 'ada)
387

388 389 390 391 392 393
(defvar ada-search-directories-internal ada-search-directories
  "Internal version of `ada-search-directories'.
Its value is the concatenation of the search path as read in the project file
and the standard runtime location, and the value of the user-defined
ada-search-directories.")

394
(defcustom ada-stmt-end-indent 0
395
  "*Number of columns to indent the end of a statement on a separate line.
396

397 398 399 400
An example is:
   if A = B
   >>>>>>>>>>>then   --  from ada-stmt-end-indent"
  :type 'integer :group 'ada)
401

402
(defcustom ada-tab-policy 'indent-auto
403
  "*Control the behavior of the TAB key.
404 405 406 407 408 409 410
Must be one of :
`indent-rigidly' : always adds ada-indent blanks at the beginning of the line.
`indent-auto'    : use indentation functions in this file.
`always-tab'     : do indent-relative."
  :type '(choice (const indent-auto)
                 (const indent-rigidly)
                 (const always-tab))
Richard M. Stallman's avatar
Richard M. Stallman committed
411
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
412

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

An example is:
   use Ada.Text_IO,
   >>>>>Ada.Numerics;    --  from ada-use-indent"
  :type 'integer :group 'ada)

421 422 423 424 425
(defcustom ada-when-indent 3
  "*Indentation for 'when' relative to 'exception' or 'case'.

An example is:
   case A is
426
   >>>>>>>>when B =>     --  from ada-when-indent"
427 428
  :type 'integer :group 'ada)

429 430 431 432 433 434 435 436
(defcustom ada-with-indent ada-broken-indent
  "*Indentation for the lines in a 'with' statement.

An example is:
   with Ada.Text_IO,
   >>>>>Ada.Numerics;    --  from ada-with-indent"
  :type 'integer :group 'ada)

437
(defcustom ada-which-compiler 'gnat
438 439 440
  "*Name of the compiler to use.
This will determine what features are made available through the ada-mode.
The possible choices are :
441 442 443 444 445
`gnat': Use Ada Core Technologies' Gnat compiler. Add some cross-referencing
    features
`generic': Use a generic compiler"
  :type '(choice (const gnat)
                 (const generic))
Richard M. Stallman's avatar
Richard M. Stallman committed
446
  :group 'ada)
Richard M. Stallman's avatar
Richard M. Stallman committed
447 448 449 450 451


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

452
(defvar ada-body-suffixes '(".adb")
453 454
  "List of possible suffixes for Ada body files.
The extensions should include a `.' if needed.")
455 456

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

460
(defvar ada-mode-menu (make-sparse-keymap "Ada")
461
  "Menu for ada-mode.")
Richard M. Stallman's avatar
Richard M. Stallman committed
462

463
(defvar ada-mode-map (make-sparse-keymap)
464
  "Local keymap used for Ada mode.")
Richard M. Stallman's avatar
Richard M. Stallman committed
465

466 467 468
(defvar ada-mode-abbrev-table nil
  "Local abbrev table for Ada mode.")

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

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

475 476 477 478 479 480 481 482 483 484
(eval-when-compile
  (defconst ada-83-string-keywords
    '("abort" "abs" "accept" "access" "all" "and" "array" "at" "begin"
      "body" "case" "constant" "declare" "delay" "delta" "digits" "do"
      "else" "elsif" "end" "entry" "exception" "exit" "for" "function"
      "generic" "goto" "if" "in" "is" "limited" "loop" "mod" "new"
      "not" "null" "of" "or" "others" "out" "package" "pragma" "private"
      "procedure" "raise" "range" "record" "rem" "renames" "return"
      "reverse" "select" "separate" "subtype" "task" "terminate" "then"
      "type" "use" "when" "while" "with" "xor")
485 486
    "List of Ada keywords.
This variable is used to define `ada-83-keywords' and `ada-95-keywords'"))
487 488 489 490 491

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

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

494 495 496 497 498 499
(defvar ada-case-exception-substring '()
  "Alist of substrings (entities) that have special casing.
The substrings are detected for word constituant when the word
is not itself in ada-case-exception, and only for substrings that
either are at the beginning or end of the word, or start after '_'.")

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

(defvar ada-other-file-alist nil
  "Variable used by find-file to find the name of the other package.
505
See `ff-other-file-alist'.")
506

507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556
(defvar ada-align-list
    '(("[^:]\\(\\s-*\\):[^:]" 1 t)
      ("[^=]\\(\\s-+\\)=[^=]" 1 t)
      ("\\(\\s-*\\)use\\s-" 1)
      ("\\(\\s-*\\)--" 1))
    "Ada support for align.el <= 2.2
This variable provides regular expressions on which to align different lines.
See `align-mode-alist' for more information.")

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

(defconst ada-align-region-separate
  (concat
   "^\\s-*\\($\\|\\("
   "begin\\|"
   "declare\\|"
   "else\\|"
   "end\\|"
   "exception\\|"
   "for\\|"
   "function\\|"
   "generic\\|"
   "if\\|"
   "is\\|"
   "procedure\\|"
   "record\\|"
   "return\\|"
   "type\\|"
   "when"
   "\\)\\>\\)")
  "see the variable `align-region-separate' for more information.")

557 558
;;; ---- Below are the regexp used in this package for parsing

Richard M. Stallman's avatar
Richard M. Stallman committed
559
(defconst ada-83-keywords
560 561
  (eval-when-compile
    (concat "\\<" (regexp-opt ada-83-string-keywords t) "\\>"))
562
  "Regular expression for looking at Ada83 keywords.")
Richard M. Stallman's avatar
Richard M. Stallman committed
563

564
(defconst ada-95-keywords
565 566 567 568 569 570
  (eval-when-compile
    (concat "\\<" (regexp-opt
                   (append
                    '("abstract" "aliased" "protected" "requeue"
                      "tagged" "until")
                    ada-83-string-keywords) t) "\\>"))
571
  "Regular expression for looking at Ada95 keywords.")
Richard M. Stallman's avatar
Richard M. Stallman committed
572

573
(defvar ada-keywords ada-95-keywords
574
  "Regular expression for looking at Ada keywords.")
Richard M. Stallman's avatar
Richard M. Stallman committed
575

576 577
(defconst ada-ident-re
  "\\(\\sw\\|[_.]\\)+"
Richard M. Stallman's avatar
Richard M. Stallman committed
578
  "Regexp matching Ada (qualified) identifiers.")
579

580 581
;;  "with" needs to be included in the regexp, so that we can insert new lines
;;  after the declaration of the parameter for a generic.
Richard M. Stallman's avatar
Richard M. Stallman committed
582
(defvar ada-procedure-start-regexp
583 584 585 586 587 588 589 590 591 592 593
  (concat
   "^[ \t]*\\(with[ \t]+\\)?\\(procedure\\|function\\|task\\)[ \t\n]+"

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

   ;;  subprogram name: name
   "\\|"
   "\\(\\(\\sw\\|[_.]\\)+\\)"
   "\\)")
Richard M. Stallman's avatar
Richard M. Stallman committed
594 595 596 597
  "Regexp used to find Ada procedures/functions.")

(defvar ada-package-start-regexp
  "^[ \t]*\\(package\\)"
598
  "Regexp used to find Ada packages.")
Richard M. Stallman's avatar
Richard M. Stallman committed
599 600 601 602 603


;;; ---- regexps for indentation functions

(defvar ada-block-start-re
604 605 606 607 608
  (eval-when-compile
    (concat "\\<\\(" (regexp-opt '("begin" "declare" "else"
                                   "exception" "generic" "loop" "or"
                                   "private" "select" ))
            "\\|\\(\\(limited\\|abstract\\|tagged\\)[ \t\n]+\\)*record\\)\\>"))
609
  "Regexp for keywords starting Ada blocks.")
Richard M. Stallman's avatar
Richard M. Stallman committed
610 611

(defvar ada-end-stmt-re
612 613 614 615 616
  (eval-when-compile
    (concat "\\("
            ";"                                        "\\|"
            "=>[ \t]*$"                                "\\|"
            "^[ \t]*separate[ \t]*(\\(\\sw\\|[_.]\\)+)"  "\\|"
617 618 619
            "\\<" (regexp-opt '("begin" "declare" "is" "do" "else" "generic"
                                "loop" "private" "record" "select"
                                "then abort" "then") t) "\\>"  "\\|"
620 621 622 623
            "^[ \t]*" (regexp-opt '("function" "package" "procedure")
                                  t) "\\>\\(\\sw\\|[ \t_.]\\)+\\<is\\>"        "\\|"
            "^[ \t]*exception\\>"
            "\\)")                      )
Richard M. Stallman's avatar
Richard M. Stallman committed
624
  "Regexp of possible ends for a non-broken statement.
625
A new statement starts after these.")
Richard M. Stallman's avatar
Richard M. Stallman committed
626

627 628 629 630 631 632 633
(defvar ada-matching-start-re
  (eval-when-compile
    (concat "\\<"
            (regexp-opt
             '("end" "loop" "select" "begin" "case" "do"
               "if" "task" "package" "record" "protected") t)
            "\\>"))
634
  "Regexp used in ada-goto-matching-start.")
635 636 637 638 639

(defvar ada-matching-decl-start-re
  (eval-when-compile
    (concat "\\<"
            (regexp-opt
640
             '("is" "separate" "end" "declare" "if" "new" "begin" "generic" "when") t)
641
            "\\>"))
642
  "Regexp used in ada-goto-matching-decl-start.")
643

Richard M. Stallman's avatar
Richard M. Stallman committed
644 645 646 647 648
(defvar ada-loop-start-re
  "\\<\\(for\\|while\\|loop\\)\\>"
  "Regexp for the start of a loop.")

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

654
(defvar ada-named-block-re
655
  "[ \t]*\\(\\sw\\|_\\)+[ \t]*:[^=]"
656 657
  "Regexp of the name of a block or loop.")

658 659 660
(defvar ada-contextual-menu-on-identifier nil
  "Set to true when the right mouse button was clicked on an identifier.")

661 662 663 664 665 666 667 668 669 670
(defvar ada-contextual-menu-last-point nil
  "Position of point just before displaying the menu.
This is a list (point buffer).
Since `ada-popup-menu' moves the point where the user clicked, the region
is modified. Therefore no command from the menu knows what the user selected
before displaying the contextual menu.
To get the original region, restore the point to this position before
calling `region-end' and `region-beginning'.
Modify this variable if you want to restore the point to another position.")

671 672
(easy-menu-define ada-contextual-menu nil
  "Menu to use when the user presses the right mouse button.
673 674
The variable `ada-contextual-menu-on-identifier' will be set to t before
displaying the menu if point was on an identifier."
675 676 677 678 679 680 681 682 683 684 685 686 687
  '("Ada"
    ["Goto Declaration/Body" ada-point-and-xref
     :included ada-contextual-menu-on-identifier]
    ["Goto Body" ada-point-and-xref-body
     :included ada-contextual-menu-on-identifier]
    ["Goto Previous Reference" ada-xref-goto-previous-reference]
    ["List References" ada-find-references
     :included ada-contextual-menu-on-identifier]
    ["List Local References" ada-find-local-references
      :included ada-contextual-menu-on-identifier]
    ["-"                nil nil]
    ["Other File"       ff-find-other-file]
    ["Goto Parent Unit" ada-goto-parent]))
688

Richard M. Stallman's avatar
Richard M. Stallman committed
689

690 691 692 693
;;------------------------------------------------------------------
;; Support for imenu  (see imenu.el)
;;------------------------------------------------------------------

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

696
(defconst ada-imenu-subprogram-menu-re
697 698 699 700 701
  (concat "^[ \t]*\\(procedure\\|function\\)[ \t\n]+"
	  "\\(\\(\\sw\\|_\\)+\\)[ \t\n]*\\([ \t\n]\\|([^)]+)"
	  ada-imenu-comment-re
	  "\\)[ \t\n]*"
	  "\\(return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?is[ \t\n]"))
702

703
(defvar ada-imenu-generic-expression
704
  (list
705
   (list nil ada-imenu-subprogram-menu-re 2)
706 707 708 709
   (list "*Specs*"
         (concat
          "^[ \t]*\\(procedure\\|function\\)[ \t\n]+\\(\\(\\sw\\|_\\)+\\)"
          "\\("
710 711
          "\\(" ada-imenu-comment-re "[ \t\n]+\\|[ \t\n]*([^)]+)"
	  ada-imenu-comment-re "\\)";; parameter list or simple space
712 713
          "\\([ \t\n]*return[ \t\n]+\\(\\sw\\|[_.]\\)+[ \t\n]*\\)?"
          "\\)?;") 2)
714
   '("*Tasks*" "^[ \t]*task[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
715
   '("*Type Defs*" "^[ \t]*\\(sub\\)?type[ \t]+\\(\\(\\sw\\|_\\)+\\)" 2)
716 717
   '("*Protected*"
     "^[ \t]*protected[ \t]+\\(type[ \t]+\\)?\\(\\(body[ \t]+\\)?\\(\\sw\\|_\\)+\\)" 2)
718
   '("*Packages*" "^[ \t]*package[ \t]+\\(\\(body[ \t]+\\)?\\(\\sw\\|[_.]\\)+\\)" 1))
719
  "Imenu generic expression for Ada mode.
720 721
See `imenu-generic-expression'. This variable will create several submenus for
each type of entity that can be found in an Ada file.")
722

723

724
;;------------------------------------------------------------
725
;;  Support for compile.el
726 727 728
;;------------------------------------------------------------

(defun ada-compile-mouse-goto-error ()
729
  "Mouse interface for ada-compile-goto-error."
730 731 732 733 734 735
  (interactive)
  (mouse-set-point last-input-event)
  (ada-compile-goto-error (point))
  )

(defun ada-compile-goto-error (pos)
736 737 738
  "Replaces `compile-goto-error' from compile.el.
If POS is on a file and line location, go to this position. It adds to
compile.el the capacity to go to a reference in an error message.
739
For instance, on this line:
740 741
  foo.adb:61:11:  [...] in call to size declared at foo.ads:11
both file locations can be clicked on and jumped to."
742 743 744 745 746 747 748
  (interactive "d")
  (goto-char pos)

  (skip-chars-backward "-a-zA-Z0-9_:./\\")
  (cond
   ;;  special case: looking at a filename:line not at the beginning of a line
   ((and (not (bolp))
749 750 751
         (looking-at
          "\\([-_.a-zA-Z0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?"))
    (let ((line (match-string 2))
752
          file
753 754 755 756 757
          (error-pos (point-marker))
          source)
      (save-excursion
        (save-restriction
          (widen)
758
          ;;  Use funcall so as to prevent byte-compiler warnings
759 760 761 762 763 764 765 766 767 768 769 770 771
          ;;  `ada-find-file' is not defined if ada-xref wasn't loaded. But
          ;;  if we can find it, we should use it instead of
          ;;  `compilation-find-file', since the latter doesn't know anything
          ;;  about source path.

          (if (functionp 'ada-find-file)
              (setq file (funcall (symbol-function 'ada-find-file)
                                  (match-string 1)))
            (setq file (funcall (symbol-function 'compilation-find-file)
                                (point-marker) (match-string 1)
                                "./")))
          (set-buffer file)

772 773
          (if (stringp line)
              (goto-line (string-to-number line)))
774
          (setq source (point-marker))))
775 776
      (funcall (symbol-function 'compilation-goto-locus)
               (cons source error-pos))
777 778 779 780
      ))

   ;; otherwise, default behavior
   (t
781
    (funcall (symbol-function 'compile-goto-error)))
782 783 784
   )
  (recenter))

785

786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814
;;-------------------------------------------------------------------------
;; Grammar related function
;; The functions below work with the syntax class of the characters in an Ada
;; buffer. Two syntax tables are created, depending on whether we want '_'
;; to be considered as part of a word or not.
;; Some characters may have multiple meanings depending on the context:
;;  - ' is either the beginning of a constant character or an attribute
;;  - # is either part of a based litteral or a gnatprep statement.
;;  - " starts a string, but not if inside a constant character.
;;  - ( and ) should be ignored if inside a constant character.
;; Thus their syntax property is changed automatically, and we can still use
;; the standard Emacs functions for sexp (see `ada-in-string-p')
;;
;; On Emacs, this is done through the `syntax-table' text property. The
;; modification is done automatically each time the user as typed a new
;; character. This is already done in `font-lock-mode' (in
;; `font-lock-syntactic-keywords', so we take advantage of the existing
;; mechanism. If font-lock-mode is not activated, we do it by hand in
;; `ada-after-change-function', thanks to `ada-deactivate-properties' and
;; `ada-initialize-properties'.
;;
;; on XEmacs, the `syntax-table' property does not exist and we have to use a
;; slow advice to `parse-partial-sexp' to do the same thing.
;; When executing parse-partial-sexp, we simply modify the strings before and
;; after, so that the special constants '"', '(' and ')' do not interact
;; with parse-partial-sexp.
;; Note: this code is slow and needs to be rewritten as soon as something
;; better is available on XEmacs.
;;-------------------------------------------------------------------------
Richard M. Stallman's avatar
Richard M. Stallman committed
815 816

(defun ada-create-syntax-table ()
817 818 819
  "Create the two syntax tables use in the Ada mode.
The standard table declares `_' as a symbol constituent, the second one
declares it as a word constituent."
820
  (interactive)
821
  (setq ada-mode-syntax-table (make-syntax-table))
Richard M. Stallman's avatar
Richard M. Stallman committed
822 823
  (set-syntax-table  ada-mode-syntax-table)

824 825 826 827
  ;; define string brackets (`%' is alternative string bracket, but
  ;; almost never used as such and throws font-lock and indentation
  ;; off the track.)
  (modify-syntax-entry ?%  "$" ada-mode-syntax-table)
Richard M. Stallman's avatar
Richard M. Stallman committed
828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851
  (modify-syntax-entry ?\" "\"" ada-mode-syntax-table)

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

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

852 853
  ;; See the comment above on grammar related function for the special
  ;; setup for '#'.
854
  (if (featurep 'xemacs)
855 856 857
      (modify-syntax-entry ?#  "<" ada-mode-syntax-table)
    (modify-syntax-entry ?#  "$" ada-mode-syntax-table))

Richard M. Stallman's avatar
Richard M. Stallman committed
858 859 860 861
  ;; and \f and \n end a comment
  (modify-syntax-entry ?\f  ">   " ada-mode-syntax-table)
  (modify-syntax-entry ?\n  ">   " ada-mode-syntax-table)

862
  ;; define what belongs in Ada symbols
Richard M. Stallman's avatar
Richard M. Stallman committed
863 864 865 866 867
  (modify-syntax-entry ?_ "_" ada-mode-syntax-table)

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

869
  (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table))
870
  (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
Richard M. Stallman's avatar
Richard M. Stallman committed
871 872
  )

873 874
;;  Support of special characters in XEmacs (see the comments at the beginning
;;  of the section on Grammar related functions).
875

876
(if (featurep 'xemacs)
877
    (defadvice parse-partial-sexp (around parse-partial-sexp-protect-constants)
878
      "Handles special character constants and gnatprep statements."
879 880 881 882 883 884 885
      (let (change)
        (if (< to from)
            (let ((tmp from))
              (setq from to  to tmp)))
        (save-excursion
          (goto-char from)
          (while (re-search-forward "'\\([(\")#]\\)'" to t)
886
            (setq change (cons (list (match-beginning 1)
887 888 889 890 891 892
                                     1
                                     (match-string 1))
                               change))
            (replace-match "'A'"))
          (goto-char from)
          (while (re-search-forward "\\(#[0-9a-fA-F]*#\\)" to t)
893
            (setq change (cons (list (match-beginning 1)
894 895 896
                                     (length (match-string 1))
                                     (match-string 1))
                               change))
897
            (replace-match (make-string (length (match-string 1)) ?@))))
898 899 900 901 902 903
        ad-do-it
        (save-excursion
          (while change
            (goto-char (caar change))
            (delete-char (cadar change))
            (insert (caddar change))
904
            (setq change (cdr change)))))))
905 906

(defun ada-deactivate-properties ()
907 908
  "Deactivate ada-mode's properties handling.
This would be a duplicate of font-lock if both are used at the same time."
909 910 911 912
  (remove-hook 'after-change-functions 'ada-after-change-function t))

(defun ada-initialize-properties ()
  "Initialize some special text properties in the whole buffer.
913 914
In particular, character constants are said to be strings, #...# are treated
as numbers instead of gnatprep comments."
915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (while (re-search-forward "'.'" nil t)
        (add-text-properties (match-beginning 0) (match-end 0)
                             '(syntax-table ("'" . ?\"))))
      (goto-char (point-min))
      (while (re-search-forward "^[ \t]*#" nil t)
        (add-text-properties (match-beginning 0) (match-end 0)
                             '(syntax-table (11 . 10))))
      (set-buffer-modified-p nil)

      ;;  Setting this only if font-lock is not set won't work
      ;;  if the user activates or deactivates font-lock-mode,
      ;;  but will make things faster most of the time
      (add-hook 'after-change-functions 'ada-after-change-function nil t)
      )))

(defun ada-after-change-function (beg end old-len)
935 936
  "Called when the region between BEG and END was changed in the buffer.
OLD-LEN indicates what the length of the replaced text was."
937 938 939 940 941 942 943 944 945 946 947 948
  (let ((inhibit-point-motion-hooks t)
        (eol (point)))
    (save-excursion
      (save-match-data
        (beginning-of-line)
        (remove-text-properties (point) eol '(syntax-table nil))
        (while (re-search-forward "'.'" eol t)
          (add-text-properties (match-beginning 0) (match-end 0)
                               '(syntax-table ("'" . ?\"))))
        (beginning-of-line)
        (if (looking-at "^[ \t]*#")
            (add-text-properties (match-beginning 0) (match-end 0)
949
                                 '(syntax-table (11 . 10))))))))
950

951 952 953 954 955 956 957 958
;;------------------------------------------------------------------
;;  Testing the grammatical context
;;------------------------------------------------------------------

(defsubst ada-in-comment-p (&optional parse-result)
  "Returns t if inside a comment."
  (nth 4 (or parse-result
             (parse-partial-sexp
959
              (line-beginning-position) (point)))))
960 961 962 963 964 965

(defsubst ada-in-string-p (&optional parse-result)
  "Returns t if point is inside a string.
If parse-result is non-nil, use is instead of calling parse-partial-sexp."
  (nth 3 (or parse-result
             (parse-partial-sexp
966
              (line-beginning-position) (point)))))
967 968 969

(defsubst ada-in-string-or-comment-p (&optional parse-result)
  "Returns t if inside a comment or string."
970
  (setq parse-result (or parse-result
971
                         (parse-partial-sexp
972
                          (line-beginning-position) (point))))
973 974
  (or (ada-in-string-p parse-result) (ada-in-comment-p parse-result)))

975

976 977
;;------------------------------------------------------------------
;; Contextual menus
978 979
;; The Ada-mode comes with contextual menus, bound by default to the right
;; mouse button.
980 981 982 983
;; Add items to this menu by modifying `ada-contextual-menu'. Note that the
;; variable `ada-contextual-menu-on-identifier' is set automatically to t
;; if the mouse button was pressed on an identifier.
;;------------------------------------------------------------------
984

985 986 987 988 989 990 991 992
(defun ada-call-from-contextual-menu (function)
  "Execute FUNCTION when called from the contextual menu.
It forces Emacs to change the cursor position."
  (interactive)
  (funcall function)
  (setq ada-contextual-menu-last-point
        (list (point) (current-buffer))))

993
(defun ada-popup-menu (position)
994
  "Pops up a contextual menu, depending on where the user clicked.
995 996 997 998
POSITION is the location the mouse was clicked on.
Sets `ada-contextual-menu-last-point' to the current position before
displaying the menu. When a function from the menu is called, the point is
where the mouse button was clicked."
999
  (interactive "e")
1000 1001 1002 1003 1004

  ;;  declare this as a local variable, so that the function called
  ;;  in the contextual menu does not hide the region in
  ;;  transient-mark-mode.
  (let ((deactivate-mark nil))
1005
    (setq ada-contextual-menu-last-point
1006
         (list (point) (current-buffer)))
1007
    (mouse-set-point last-input-event)
1008

1009
    (setq ada-contextual-menu-on-identifier
1010 1011 1012 1013 1014 1015 1016
          (and (char-after)
               (or (= (char-syntax (char-after)) ?w)
                   (= (char-after) ?_))
               (not (ada-in-string-or-comment-p))
               (save-excursion (skip-syntax-forward "w")
                               (not (ada-after-keyword-p)))
               ))
1017 1018 1019 1020 1021 1022 1023
    (if (fboundp 'popup-menu)
	(funcall (symbol-function 'popup-menu) ada-contextual-menu)
      (let (choice)
	(setq choice (x-popup-menu position ada-contextual-menu))
 	(if choice
 	    (funcall (lookup-key ada-contextual-menu (vector (car choice)))))))

1024 1025 1026 1027
    (set-buffer (cadr ada-contextual-menu-last-point))
    (goto-char (car ada-contextual-menu-last-point))
    ))

1028

1029 1030 1031
;;------------------------------------------------------------------
;; Misc functions
;;------------------------------------------------------------------