code.delx.au - gnu-emacs/blob - lisp/progmodes/ada-mode.el

   1 ;;; ada-mode.el --- An Emacs major-mode for editing Ada source.
   2
   3 ;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc.
   4
   5 ;; Authors: Rolf Ebert      <re@waporo.muc.de>
   6 ;;          Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
   7 ;; Maintainer: Emmanual Briot <briot@gnat.com>
   8 ;; Keywords: languages oop ada
   9 ;; Rolf Ebert's version: 2.27
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; This mode is a complete rewrite of a major mode for editing Ada 83
  29 ;;; and Ada 95 source code under Emacs-19.  It contains completely new
  30 ;;; indenting code and support for code browsing (see ada-xref).
  31
  32
  33 ;;; USAGE
  34 ;;; =====
  35 ;;; Emacs should enter Ada mode when you load an Ada source (*.ad[abs]).
  36 ;;;
  37 ;;; When you have entered ada-mode, you may get more info by pressing
  38 ;;; C-h m. You may also get online help describing various functions by:
  39 ;;; C-h d <Name of function you want described>
  40
  41
  42 ;;; HISTORY
  43 ;;; =======
  44 ;;; The first Ada mode for GNU Emacs was written by V. Broman in
  45 ;;; 1985. He based his work on the already existing Modula-2 mode.
  46 ;;; This was distributed as ada.el in versions of Emacs prior to 19.29.
  47 ;;;
  48 ;;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of
  49 ;;; several files with support for dired commands and other nice
  50 ;;; things. It is currently available from the PAL
  51 ;;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z.
  52 ;;;
  53 ;;; The probably very first Ada mode (called electric-ada.el) was
  54 ;;; written by Steven D. Litvintchouk and Steven M. Rosen for the
  55 ;;; Gosling Emacs. L. Slater based his development on ada.el and
  56 ;;; electric-ada.el.
  57 ;;;
  58 ;;; The current Ada mode is a complete rewrite by M. Heritsch and
  59 ;;; R. Ebert.  Some ideas from the Ada mode mailing list have been
  60 ;;; added.  Some of the functionality of L. Slater's mode has not
  61 ;;; (yet) been recoded in this new mode.  Perhaps you prefer sticking
  62 ;;; to his version.
  63
  64
  65 ;;; KNOWN BUGS
  66 ;;; ==========
  67 ;;;
  68 ;;; In the presence of comments and/or incorrect syntax
  69 ;;; ada-format-paramlist produces weird results.
  70 ;;; -------------------
  71 ;;; Character constants with otherwise syntactic relevant characters
  72 ;;; like `(' or `"' throw indentation off the track.  Fontification
  73 ;;; should work now in Emacs-19.35
  74 ;;; C : constant Character := Character'('"');
  75 ;;; -------------------
  76
  77
  78 ;;; TODO
  79 ;;; ====
  80 ;;;
  81 ;;; o bodify-single-subprogram
  82 ;;; o make a function "separate" and put it in the corresponding file.
  83
  84
  85
  86 ;;; CREDITS
  87 ;;; =======
  88 ;;;
  89 ;;; Many thanks to
  90 ;;;    Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular,
  91 ;;;    woodruff@stc.llnl.gov (John Woodruff)
  92 ;;;    jj@ddci.dk (Jesper Joergensen)
  93 ;;;    gse@ocsystems.com (Scott Evans)
  94 ;;;    comar@LANG8.CS.NYU.EDU (Cyrille Comar)
  95 ;;;    and others for their valuable hints.
  96 \f
  97 ;;;--------------------
  98 ;;;    USER OPTIONS
  99 ;;;--------------------
 100
 101
 102 ;; ---- customize support
 103
 104 (defgroup ada nil
 105   "Major mode for editing Ada source in Emacs"
 106   :group 'languages)
 107
 108 ;; ---- configure indentation
 109
 110 (defcustom ada-indent 3
 111   "*Defines the size of Ada indentation."
 112   :type 'integer
 113   :group 'ada)
 114
 115 (defcustom ada-broken-indent 2
 116   "*# of columns to indent the continuation of a broken line."
 117   :type 'integer
 118   :group 'ada)
 119
 120 (defcustom ada-label-indent -4
 121   "*# of columns to indent a label."
 122   :type 'integer
 123   :group 'ada)
 124
 125 (defcustom ada-stmt-end-indent 0
 126   "*# of columns to indent a statement end keyword in a separate line.
 127 Examples are 'is', 'loop', 'record', ..."
 128   :type 'integer
 129   :group 'ada)
 130
 131 (defcustom ada-when-indent 3
 132   "*Defines the indentation for 'when' relative to 'exception' or 'case'."
 133   :type 'integer
 134   :group 'ada)
 135
 136 (defcustom ada-indent-record-rel-type 3
 137   "*Defines the indentation for 'record' relative to 'type' or 'use'."
 138   :type 'integer
 139   :group 'ada)
 140
 141 (defcustom ada-indent-comment-as-code t
 142   "*If non-nil, comment-lines get indented as Ada code."
 143   :type 'boolean
 144   :group 'ada)
 145
 146 (defcustom ada-indent-is-separate t
 147   "*If non-nil, 'is separate' or 'is abstract' on a single line are indented."
 148   :type 'boolean
 149   :group 'ada)
 150
 151 (defcustom ada-indent-to-open-paren t
 152   "*If non-nil, indent according to the innermost open parenthesis."
 153   :type 'boolean
 154   :group 'ada)
 155
 156 (defcustom ada-search-paren-char-count-limit 3000
 157   "*Search that many characters for an open parenthesis."
 158   :type 'integer
 159   :group 'ada)
 160
 161
 162 ;; ---- other user options
 163
 164 (defcustom ada-tab-policy 'indent-auto
 165   "*Control behaviour of the TAB key.
 166 Must be one of `indent-rigidly', `indent-auto', `gei', `indent-af'
 167 or `always-tab'.
 168
 169 `indent-rigidly' : always adds ada-indent blanks at the beginning of the line.
 170 `indent-auto'    : use indentation functions in this file.
 171 `gei'            : use David Kågedal's Generic Indentation Engine.
 172 `indent-af'      : use Gary E. Barnes' ada-format.el
 173 `always-tab'     : do indent-relative."
 174   :type '(choice (const indent-auto)
 175                  (const indent-rigidly)
 176                  (const gei)
 177                  (const indent-af)
 178                  (const always-tab))
 179   :group 'ada)
 180
 181 (defcustom ada-move-to-declaration nil
 182   "*If non-nil, `ada-move-to-start' moves point to the subprog declaration,
 183 not to 'begin'."
 184   :type 'boolean
 185   :group 'ada)
 186
 187 (defcustom ada-spec-suffix ".ads"
 188   "*Suffix of Ada specification files."
 189   :type 'string
 190   :group 'ada)
 191
 192 (defcustom ada-body-suffix ".adb"
 193   "*Suffix of Ada body files."
 194   :type 'string
 195   :group 'ada)
 196
 197 (defcustom ada-spec-suffix-as-regexp "\\.ads$"
 198   "*Regexp to find Ada specification files."
 199   :type 'string
 200   :group 'ada)
 201
 202 (defcustom ada-body-suffix-as-regexp "\\.adb$"
 203   "*Regexp to find Ada body files."
 204   :type 'string
 205   :group 'ada)
 206
 207 (defvar ada-other-file-alist
 208   (list
 209    (list ada-spec-suffix-as-regexp (list ada-body-suffix))
 210    (list ada-body-suffix-as-regexp (list ada-spec-suffix))
 211    )
 212   "*Alist of extensions to find given the current file's extension.
 213
 214 This list should contain the most used extensions before the others,
 215 since the search algorithm searches sequentially through each directory
 216 specified in `ada-search-directories'.  If a file is not found, a new one
 217 is created with the first matching extension (`.adb' yields `.ads').")
 218
 219 (defcustom ada-search-directories
 220   '("." "/usr/adainclude" "/usr/local/adainclude" "/opt/gnu/adainclude")
 221   "*List of directories to search for Ada files.
 222 See the description for the `ff-search-directories' variable."
 223   :type '(repeat (choice :tag "Directory"
 224                          (const :tag "default" nil)
 225                          (directory :format "%v")))
 226   :group 'ada)
 227
 228 (defcustom ada-language-version 'ada95
 229   "*Do we program in `ada83' or `ada95'?"
 230   :type '(choice (const ada83)
 231                  (const ada95))
 232   :group 'ada)
 233
 234 (defcustom ada-case-keyword 'downcase-word
 235   "*Function to call to adjust the case of Ada keywords.
 236 It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
 237 `capitalize-word'."
 238   :type '(choice (const downcase-word)
 239                  (const upcase-word)
 240                  (const capitalize-word)
 241                  (const ada-loose-case-word))
 242   :group 'ada)
 243
 244 (defcustom ada-case-identifier 'ada-loose-case-word
 245   "*Function to call to adjust the case of an Ada identifier.
 246 It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
 247 `capitalize-word'."
 248   :type '(choice (const downcase-word)
 249                  (const upcase-word)
 250                  (const capitalize-word)
 251                  (const ada-loose-case-word))
 252   :group 'ada)
 253
 254 (defcustom ada-case-attribute 'capitalize-word
 255   "*Function to call to adjust the case of Ada attributes.
 256 It may be `downcase-word', `upcase-word', `ada-loose-case-word' or
 257 `capitalize-word'."
 258   :type '(choice (const downcase-word)
 259                  (const upcase-word)
 260                  (const capitalize-word)
 261                  (const ada-loose-case-word))
 262   :group 'ada)
 263
 264 (defcustom ada-auto-case t
 265   "*Non-nil automatically changes case of preceding word while typing.
 266 Casing is done according to `ada-case-keyword', `ada-case-identifier'
 267 and `ada-case-attribute'."
 268   :type 'boolean
 269   :group 'ada)
 270
 271 (defcustom ada-clean-buffer-before-saving t
 272   "*If non-nil, `remove-trailing-spaces' and `untabify' buffer before saving."
 273   :type 'boolean
 274   :group 'ada)
 275
 276 (defvar ada-mode-hook nil
 277   "*List of functions to call when Ada mode is invoked.
 278 This is a good place to add Ada environment specific bindings.")
 279
 280 (defcustom ada-external-pretty-print-program "aimap"
 281   "*External pretty printer to call from within Ada mode."
 282   :type 'string
 283   :group 'ada)
 284
 285 (defcustom ada-tmp-directory "/tmp/"
 286   "*Directory to store the temporary file for the Ada pretty printer."
 287   :type 'string
 288   :group 'ada)
 289
 290 (defcustom ada-compile-options "-c"
 291   "*Buffer local options passed to the Ada compiler.
 292 These options are used when the compiler is invoked on the current buffer."
 293   :type 'string
 294   :group 'ada)
 295 (make-variable-buffer-local 'ada-compile-options)
 296
 297 (defcustom ada-make-options "-c"
 298   "*Buffer local options passed to `ada-compiler-make' (usually `gnatmake').
 299 These options are used when `gnatmake' is invoked on the current buffer."
 300   :type 'string
 301   :group 'ada)
 302 (make-variable-buffer-local 'ada-make-options)
 303
 304 (defcustom ada-compiler-syntax-check "gcc -c -gnats"
 305   "*Compiler command with options for syntax checking."
 306   :type 'string
 307   :group 'ada)
 308
 309 (defcustom ada-compiler-make "gnatmake"
 310   "*The `make' command for the given compiler."
 311   :type 'string
 312   :group 'ada)
 313
 314 (defcustom ada-fill-comment-prefix "-- "
 315   "*This is inserted in the first columns when filling a comment paragraph."
 316   :type 'string
 317   :group 'ada)
 318
 319 (defcustom ada-fill-comment-postfix " --"
 320   "*This is inserted at the end of each line when filling a comment paragraph.
 321 with `ada-fill-comment-paragraph-postfix'."
 322   :type 'string
 323   :group 'ada)
 324
 325 (defcustom ada-krunch-args "0"
 326   "*Argument of gnatkr, a string containing the max number of characters.
 327 Set to 0, if you don't use crunched filenames."
 328   :type 'string
 329   :group 'ada)
 330
 331 ;;; ---- end of user configurable variables
 332 \f
 333
 334 (defvar ada-mode-abbrev-table nil
 335   "Abbrev table used in Ada mode.")
 336 (define-abbrev-table 'ada-mode-abbrev-table ())
 337
 338 (defvar ada-mode-map ()
 339   "Local keymap used for Ada mode.")
 340
 341 (defvar ada-mode-syntax-table nil
 342   "Syntax table to be used for editing Ada source code.")
 343
 344 (defvar ada-mode-symbol-syntax-table nil
 345   "Syntax table for Ada, where `_' is a word constituent.")
 346
 347 (defconst ada-83-keywords
 348   "\\<\\(abort\\|abs\\|accept\\|access\\|all\\|and\\|array\\|\
 349 at\\|begin\\|body\\|case\\|constant\\|declare\\|delay\\|delta\\|\
 350 digits\\|do\\|else\\|elsif\\|end\\|entry\\|exception\\|exit\\|for\\|\
 351 function\\|generic\\|goto\\|if\\|in\\|is\\|limited\\|loop\\|mod\\|\
 352 new\\|not\\|null\\|of\\|or\\|others\\|out\\|package\\|pragma\\|\
 353 private\\|procedure\\|raise\\|range\\|record\\|rem\\|renames\\|\
 354 return\\|reverse\\|select\\|separate\\|subtype\\|task\\|terminate\\|\
 355 then\\|type\\|use\\|when\\|while\\|with\\|xor\\)\\>"
 356 ;  "\\<\\(a\\(b\\(ort\\|s\\)\\|cce\\(pt\\|ss\\)\\|ll\\|nd\\|rray\\|t\\)\\|\
 357 ;b\\(egin\\|ody\\)\\|c\\(ase\\|onstant\\)\\|\
 358 ;d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|\
 359 ;e\\(ls\\(e\\|if\\)\\|n\\(d\\|try\\)\\|x\\(ception\\|it\\)\\)\\|\
 360 ;f\\(or\\|unction\\)\\|g\\(eneric\\|oto\\)\\|i[fns]\\|l\\(imited\\|oop\\)\\|\
 361 ;mod\\|n\\(ew\\|ot\\|ull\\)\\|o\\([fr]\\|thers\\|ut\\)\\|\
 362 ;p\\(ackage\\|r\\(agma\\|ivate\\|ocedure\\)\\)\\|\
 363 ;r\\(a\\(ise\\|nge\\)\\|e\\(cord\\|m\\|names\\|turn\\|verse\\)\\)\\|\
 364 ;s\\(e\\(lect\\|parate\\)\\|ubtype\\)\\|use\\|
 365 ;t\\(ask\\|erminate\\|hen\\|ype\\)\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\|xor\\)\\>"
 366   "Regular expression for looking at Ada83 keywords.")
 367
 368 (defconst ada-95-keywords
 369   "\\<\\(abort\\|abs\\|abstract\\|accept\\|access\\|aliased\\|\
 370 all\\|and\\|array\\|at\\|begin\\|body\\|case\\|constant\\|declare\\|\
 371 delay\\|delta\\|digits\\|do\\|else\\|elsif\\|end\\|entry\\|\
 372 exception\\|exit\\|for\\|function\\|generic\\|goto\\|if\\|in\\|\
 373 is\\|limited\\|loop\\|mod\\|new\\|not\\|null\\|of\\|or\\|others\\|\
 374 out\\|package\\|pragma\\|private\\|procedure\\|protected\\|raise\\|\
 375 range\\|record\\|rem\\|renames\\|requeue\\|return\\|reverse\\|\
 376 select\\|separate\\|subtype\\|tagged\\|task\\|terminate\\|then\\|\
 377 type\\|until\\|use\\|when\\|while\\|with\\|xor\\)\\>"
 378   "Regular expression for looking at Ada95 keywords.")
 379
 380 (defvar ada-keywords ada-95-keywords
 381   "Regular expression for looking at Ada keywords.")
 382
 383 (defvar ada-ret-binding nil
 384   "Variable to save key binding of RET when casing is activated.")
 385
 386 (defvar ada-lfd-binding nil
 387   "Variable to save key binding of LFD when casing is activated.")
 388
 389 ;;; ---- Regexps to find procedures/functions/packages
 390
 391 (defconst ada-ident-re
 392   "[a-zA-Z0-9_\\.]+"
 393   "Regexp matching Ada (qualified) identifiers.")
 394
 395 (defvar ada-procedure-start-regexp
 396   "^[ \t]*\\(procedure\\|function\\|task\\)[ \t\n]+\\([a-zA-Z0-9_\\.]+\\)"
 397   "Regexp used to find Ada procedures/functions.")
 398
 399 (defvar ada-package-start-regexp
 400   "^[ \t]*\\(package\\)"
 401   "Regexp used to find Ada packages")
 402
 403
 404 ;;; ---- regexps for indentation functions
 405
 406 (defvar ada-block-start-re
 407   "\\<\\(begin\\|select\\|declare\\|private\\|or\\|generic\\|\
 408 exception\\|loop\\|else\\|\
 409 \\(\\(limited\\|abstract\\|tagged\\)[ \t]+\\)*record\\)\\>"
 410   "Regexp for keywords starting Ada blocks.")
 411
 412 (defvar ada-end-stmt-re
 413   "\\(;\\|=>\\|^[ \t]*separate[ \t]+([a-zA-Z0-9_\\.]+)\\|\
 414 \\<\\(begin\\|else\\|record\\|loop\\|select\\|do\\|then\\|\
 415 declare\\|generic\\|private\\)\\>\\|\
 416 ^[ \t]*\\(package\\|procedure\\|function\\)\\>[ \ta-zA-Z0-9_\\.]+\\<is\\>\\|\
 417 ^[ \t]*exception\\>\\)"
 418   "Regexp of possible ends for a non-broken statement.
 419 A new statement starts after these.")
 420
 421 (defvar ada-loop-start-re
 422   "\\<\\(for\\|while\\|loop\\)\\>"
 423   "Regexp for the start of a loop.")
 424
 425 (defvar ada-subprog-start-re
 426   "\\<\\(procedure\\|protected\\|package\\|function\\|\
 427 task\\|accept\\|entry\\)\\>"
 428   "Regexp for the start of a subprogram.")
 429
 430 (defvar ada-named-block-re
 431   "[ \t]*[a-zA-Z_0-9]+ *:[^=]"
 432   "Regexp of the name of a block or loop.")
 433
 434 \f
 435 ;; Written by Christian Egli <Christian.Egli@hcsd.hac.com>
 436 ;;
 437 (defvar ada-imenu-generic-expression
 438       '((nil "^\\s-*\\(procedure\\|function\\)\\s-+\\([A-Za-z0-9_]+\\)" 2)
 439         ("Type Defs" "^\\s-*\\(sub\\)?type\\s-+\\([A-Za-z0-9_]+\\)" 2))
 440
 441   "Imenu generic expression for Ada mode.  See `imenu-generic-expression'.")
 442 \f
 443 ;;;-------------
 444 ;;;  functions
 445 ;;;-------------
 446
 447 (defun ada-xemacs ()
 448   (or (string-match "Lucid"  emacs-version)
 449       (string-match "XEmacs" emacs-version)))
 450
 451 (defun ada-create-syntax-table ()
 452   "Create the syntax table for Ada mode."
 453   ;; There are two different syntax-tables.  The standard one declares
 454   ;; `_' as a symbol constituent, in the second one, it is a word
 455   ;; constituent.  For some search and replacing routines we
 456   ;; temporarily switch between the two.
 457   (setq ada-mode-syntax-table (make-syntax-table))
 458   (set-syntax-table  ada-mode-syntax-table)
 459
 460   ;; define string brackets (`%' is alternative string bracket, but
 461   ;; almost never used as such and throws font-lock and indentation
 462   ;; off the track.)
 463   (modify-syntax-entry ?%  "$" ada-mode-syntax-table)
 464   (modify-syntax-entry ?\" "\"" ada-mode-syntax-table)
 465
 466   (modify-syntax-entry ?\#  "$" ada-mode-syntax-table)
 467
 468   (modify-syntax-entry ?:  "." ada-mode-syntax-table)
 469   (modify-syntax-entry ?\; "." ada-mode-syntax-table)
 470   (modify-syntax-entry ?&  "." ada-mode-syntax-table)
 471   (modify-syntax-entry ?\|  "." ada-mode-syntax-table)
 472   (modify-syntax-entry ?+  "." ada-mode-syntax-table)
 473   (modify-syntax-entry ?*  "." ada-mode-syntax-table)
 474   (modify-syntax-entry ?/  "." ada-mode-syntax-table)
 475   (modify-syntax-entry ?=  "." ada-mode-syntax-table)
 476   (modify-syntax-entry ?<  "." ada-mode-syntax-table)
 477   (modify-syntax-entry ?>  "." ada-mode-syntax-table)
 478   (modify-syntax-entry ?$ "." ada-mode-syntax-table)
 479   (modify-syntax-entry ?\[ "." ada-mode-syntax-table)
 480   (modify-syntax-entry ?\] "." ada-mode-syntax-table)
 481   (modify-syntax-entry ?\{ "." ada-mode-syntax-table)
 482   (modify-syntax-entry ?\} "." ada-mode-syntax-table)
 483   (modify-syntax-entry ?. "." ada-mode-syntax-table)
 484   (modify-syntax-entry ?\\ "." ada-mode-syntax-table)
 485   (modify-syntax-entry ?\' "." ada-mode-syntax-table)
 486
 487   ;; a single hyphen is punctuation, but a double hyphen starts a comment
 488   (modify-syntax-entry ?-  ". 12" ada-mode-syntax-table)
 489
 490   ;; and \f and \n end a comment
 491   (modify-syntax-entry ?\f  ">   " ada-mode-syntax-table)
 492   (modify-syntax-entry ?\n  ">   " ada-mode-syntax-table)
 493
 494   ;; define what belongs in Ada symbols
 495   (modify-syntax-entry ?_ "_" ada-mode-syntax-table)
 496
 497   ;; define parentheses to match
 498   (modify-syntax-entry ?\( "()" ada-mode-syntax-table)
 499   (modify-syntax-entry ?\) ")(" ada-mode-syntax-table)
 500
 501   (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table))
 502   (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
 503   )
 504
 505
 506 ;;;###autoload
 507 (defun ada-mode ()
 508   "Ada mode is the major mode for editing Ada code.
 509
 510 Bindings are as follows: (Note: 'LFD' is control-j.)
 511
 512  Indent line                                          '\\[ada-tab]'
 513  Indent line, insert newline and indent the new line. '\\[newline-and-indent]'
 514
 515  Re-format the parameter-list point is in             '\\[ada-format-paramlist]'
 516  Indent all lines in region                           '\\[ada-indent-region]'
 517  Call external pretty printer program                 '\\[ada-call-pretty-printer]'
 518
 519  Adjust case of identifiers and keywords in region    '\\[ada-adjust-case-region]'
 520  Adjust case of identifiers and keywords in buffer    '\\[ada-adjust-case-buffer]'
 521
 522  Call EXTERNAL pretty printer (if you have one)       '\\[ada-call-pretty-printer]'
 523
 524  Fill comment paragraph                               '\\[ada-fill-comment-paragraph]'
 525  Fill comment paragraph and justify each line         '\\[ada-fill-comment-paragraph-justify]'
 526  Fill comment paragraph, justify and append postfix   '\\[ada-fill-comment-paragraph-postfix]'
 527
 528  Next func/proc/task '\\[ada-next-procedure]'  Previous func/proc/task '\\[ada-previous-procedure]'
 529  Next package        '\\[ada-next-package]'  Previous package        '\\[ada-previous-package]'
 530
 531  Goto matching start of current 'end ...;'            '\\[ada-move-to-start]'
 532  Goto end of current block                            '\\[ada-move-to-end]'
 533
 534 Comments are handled using standard GNU Emacs conventions, including:
 535  Start a comment                                      '\\[indent-for-comment]'
 536  Comment region                                       '\\[comment-region]'
 537  Uncomment region                                     '\\[ada-uncomment-region]'
 538  Continue comment on next line                        '\\[indent-new-comment-line]'
 539
 540 If you use imenu.el:
 541  Display index-menu of functions & procedures         '\\[imenu]'
 542
 543 If you use find-file.el:
 544  Switch to other file (Body <-> Spec)                 '\\[ff-find-other-file]'
 545                                                    or '\\[ff-mouse-find-other-file]
 546  Switch to other file in other window                 '\\[ada-ff-other-window]'
 547                                                    or '\\[ff-mouse-find-other-file-other-window]
 548  If you use this function in a spec and no body is available, it gets created
 549  with body stubs.
 550
 551 If you use ada-xref.el:
 552  Goto declaration:          '\\[ada-point-and-xref]' on the identifier
 553                          or '\\[ada-goto-declaration]' with point on the identifier
 554  Complete identifier:       '\\[ada-complete-identifier]'
 555  Execute Gnatf:             '\\[ada-gnatf-current]'"
 556
 557   (interactive)
 558   (kill-all-local-variables)
 559
 560   (make-local-variable 'require-final-newline)
 561   (setq require-final-newline t)
 562
 563   (make-local-variable 'comment-start)
 564   (setq comment-start "-- ")
 565
 566   ;; comment end must be set because it may hold a wrong value if
 567   ;; this buffer had been in another mode before. RE
 568   (make-local-variable 'comment-end)
 569   (setq comment-end "")
 570
 571   (make-local-variable 'comment-start-skip) ;; used by autofill
 572   (setq comment-start-skip "--+[ \t]*")
 573
 574   (make-local-variable 'indent-line-function)
 575   (setq indent-line-function 'ada-indent-current-function)
 576
 577   (make-local-variable 'fill-column)
 578   (setq fill-column 75)
 579
 580   (make-local-variable 'comment-column)
 581   (setq comment-column 40)
 582
 583   (make-local-variable 'parse-sexp-ignore-comments)
 584   (setq parse-sexp-ignore-comments t)
 585
 586   (make-local-variable 'case-fold-search)
 587   (setq case-fold-search t)
 588
 589   (make-local-variable 'outline-regexp)
 590   (setq outline-regexp "[^\n\^M]")
 591   (make-local-variable 'outline-level)
 592   (setq outline-level 'ada-outline-level)
 593
 594   (make-local-variable 'fill-paragraph-function)
 595   (setq fill-paragraph-function 'ada-fill-comment-paragraph)
 596   ;;(make-local-variable 'adaptive-fill-regexp)
 597
 598   (make-local-variable 'imenu-generic-expression)
 599   (setq imenu-generic-expression ada-imenu-generic-expression)
 600   (setq imenu-case-fold-search t)
 601
 602   (if (ada-xemacs) nil ; XEmacs uses properties
 603     (make-local-variable 'font-lock-defaults)
 604     (setq font-lock-defaults
 605           '((ada-font-lock-keywords
 606              ada-font-lock-keywords-1 ada-font-lock-keywords-2)
 607             nil t
 608             ((?\_ . "w")(?\. . "w"))
 609             beginning-of-line
 610             (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
 611
 612     ;; Set up support for find-file.el.
 613     (make-variable-buffer-local 'ff-other-file-alist)
 614     (make-variable-buffer-local 'ff-search-directories)
 615     (setq ff-other-file-alist   'ada-other-file-alist
 616           ff-search-directories 'ada-search-directories
 617           ff-pre-load-hooks     'ff-which-function-are-we-in
 618           ff-post-load-hooks    'ff-set-point-accordingly
 619           ff-file-created-hooks 'ada-make-body))
 620
 621   (setq major-mode 'ada-mode)
 622   (setq mode-name "Ada")
 623
 624   (use-local-map ada-mode-map)
 625
 626   (if ada-mode-syntax-table
 627       (set-syntax-table ada-mode-syntax-table)
 628     (ada-create-syntax-table))
 629
 630   (if ada-clean-buffer-before-saving
 631       (progn
 632         ;; remove all spaces at the end of lines in the whole buffer.
 633         (add-hook 'local-write-file-hooks 'ada-remove-trailing-spaces)
 634         ;; convert all tabs to the correct number of spaces.
 635         (add-hook 'local-write-file-hooks 'ada-untabify-buffer)))
 636
 637
 638   ;; add menu 'Ada' to the menu bar
 639   (ada-add-ada-menu)
 640
 641   (run-hooks 'ada-mode-hook)
 642
 643   ;; the following has to be done after running the ada-mode-hook
 644   ;; because users might want to set the values of these variable
 645   ;; inside the hook (MH)
 646
 647   (cond ((eq ada-language-version 'ada83)
 648          (setq ada-keywords ada-83-keywords))
 649         ((eq ada-language-version 'ada95)
 650          (setq ada-keywords ada-95-keywords)))
 651
 652   (if ada-auto-case
 653       (ada-activate-keys-for-case)))
 654
 655 \f
 656 ;;;--------------------------
 657 ;;;  Compile support
 658 ;;;--------------------------
 659
 660 (defun ada-check-syntax ()
 661   "Check syntax of the current buffer.
 662 Uses the function `compile' to execute `ada-compiler-syntax-check'."
 663   (interactive)
 664   (let ((old-compile-command compile-command))
 665     (setq compile-command (concat ada-compiler-syntax-check
 666                                   (if (eq ada-language-version 'ada83)
 667                                       "-gnat83 ")
 668                                   " " ada-compile-options " "
 669                                   (buffer-name)))
 670     (setq compile-command (read-from-minibuffer
 671                            "enter command for syntax check: "
 672                            compile-command))
 673     (compile compile-command)
 674     ;; restore old compile-command
 675     (setq compile-command old-compile-command)))
 676
 677 (defun ada-make-local ()
 678   "Bring current Ada unit up-to-date.
 679 Uses the function `compile' to execute `ada-compile-make'."
 680   (interactive)
 681   (let ((old-compile-command compile-command))
 682     (setq compile-command (concat ada-compiler-make
 683                                   " " ada-make-options " "
 684                                   (buffer-name)))
 685     (setq compile-command (read-from-minibuffer
 686                            "enter command for local make: "
 687                            compile-command))
 688     (compile compile-command)
 689     ;; restore old compile-command
 690     (setq compile-command old-compile-command)))
 691
 692
 693
 694 \f
 695 ;;;--------------------------
 696 ;;;  Fill Comment Paragraph
 697 ;;;--------------------------
 698
 699 (defun ada-fill-comment-paragraph-justify ()
 700   "Fills current comment paragraph and justifies each line as well."
 701   (interactive)
 702   (ada-fill-comment-paragraph t))
 703
 704
 705 (defun ada-fill-comment-paragraph-postfix ()
 706   "Fills current comment paragraph and justifies each line as well.
 707 Prompts for a postfix to be appended to each line."
 708   (interactive)
 709   (ada-fill-comment-paragraph t t))
 710
 711
 712 (defun ada-fill-comment-paragraph (&optional justify postfix)
 713   "Fills the current comment paragraph.
 714 If JUSTIFY is non-nil, each line is justified as well.
 715 If POSTFIX and JUSTIFY are  non-nil, `ada-fill-comment-postfix' is appended
 716 to each filled and justified line.
 717 If `ada-indent-comment-as-code' is non-nil, the paragraph is idented."
 718   (interactive "P")
 719   (let ((opos (point-marker))
 720         (begin nil)
 721         (end nil)
 722         (end-2 nil)
 723         (indent nil)
 724         (ada-fill-comment-old-postfix "")
 725         (fill-prefix nil))
 726
 727     ;; check if inside comment
 728     (if (not (ada-in-comment-p))
 729         (error "not inside comment"))
 730
 731     ;; prompt for postfix if wanted
 732     (if (and justify
 733              postfix)
 734         (setq ada-fill-comment-postfix
 735               (read-from-minibuffer "enter new postfix string: "
 736                                     ada-fill-comment-postfix)))
 737
 738     ;; prompt for old postfix to remove if necessary
 739     (if (and justify
 740              postfix)
 741         (setq ada-fill-comment-old-postfix
 742               (read-from-minibuffer "enter already existing postfix string: "
 743                                     ada-fill-comment-postfix)))
 744
 745     ;;
 746     ;; find limits of paragraph
 747     ;;
 748     (message "filling comment paragraph ...")
 749     (save-excursion
 750       (back-to-indentation)
 751       ;; find end of paragraph
 752       (while (and (looking-at "--.*$")
 753                   (not (looking-at "--[ \t]*$")))
 754         (forward-line 1)
 755         (back-to-indentation))
 756       (beginning-of-line)
 757       (setq end (point-marker))
 758       (goto-char opos)
 759       ;; find begin of paragraph
 760       (back-to-indentation)
 761       (while (and (looking-at "--.*$")
 762                   (not (looking-at "--[ \t]*$")))
 763         (forward-line -1)
 764         (back-to-indentation))
 765       (forward-line 1)
 766       ;; get indentation to calculate width for filling
 767       (ada-indent-current)
 768       (back-to-indentation)
 769       (setq indent (current-column))
 770       (setq begin (point-marker)))
 771
 772     ;; delete old postfix if necessary
 773     (if (and justify
 774              postfix)
 775         (save-excursion
 776           (goto-char begin)
 777           (while (re-search-forward (concat ada-fill-comment-old-postfix
 778                                             "\n")
 779                                     end t)
 780             (replace-match "\n"))))
 781
 782     ;; delete leading whitespace and uncomment
 783     (save-excursion
 784       (goto-char begin)
 785       (beginning-of-line)
 786       (while (re-search-forward "^[ \t]*--[ \t]*" end t)
 787         (replace-match "")))
 788
 789     ;; calculate fill width
 790     (setq fill-column (- fill-column indent
 791                          (length ada-fill-comment-prefix)
 792                          (if postfix
 793                              (length ada-fill-comment-postfix)
 794                            0)))
 795     ;; fill paragraph
 796     (fill-region begin (1- end) justify)
 797     (setq fill-column (+ fill-column indent
 798                          (length ada-fill-comment-prefix)
 799                          (if postfix
 800                              (length ada-fill-comment-postfix)
 801                            0)))
 802    ;; find end of second last line
 803     (save-excursion
 804       (goto-char end)
 805       (forward-line -2)
 806       (end-of-line)
 807       (setq end-2 (point-marker)))
 808
 809     ;; re-comment and re-indent region
 810     (save-excursion
 811       (goto-char begin)
 812       (indent-to indent)
 813       (insert ada-fill-comment-prefix)
 814       (while (re-search-forward "\n" (1- end-2) t)
 815         (replace-match (concat "\n" ada-fill-comment-prefix))
 816         (beginning-of-line)
 817         (indent-to indent)))
 818
 819     ;; append postfix if wanted
 820     (if (and justify
 821              postfix
 822              ada-fill-comment-postfix)
 823         (progn
 824           ;; append postfix up to there
 825           (save-excursion
 826             (goto-char begin)
 827             (while (re-search-forward "\n" (1- end-2) t)
 828               (replace-match (concat ada-fill-comment-postfix "\n")))
 829
 830             ;; fill last line and append postfix
 831             (end-of-line)
 832             (insert-char ?
 833                          (- fill-column
 834                             (current-column)
 835                             (length ada-fill-comment-postfix)))
 836             (insert ada-fill-comment-postfix))))
 837
 838     ;; delete the extra line that gets inserted somehow(??)
 839     (save-excursion
 840       (goto-char (1- end))
 841       (end-of-line)
 842       (delete-char 1))
 843
 844      (message "filling comment paragraph ... done")
 845     (goto-char opos))
 846   t)
 847
 848 \f
 849 ;;;--------------------------------;;;
 850 ;;;  Call External Pretty Printer  ;;;
 851 ;;;--------------------------------;;;
 852
 853 (defun ada-call-pretty-printer ()
 854   "Calls the external Pretty Printer.
 855 The name is specified in `ada-external-pretty-print-program'.  Saves the
 856 current buffer in a directory specified by `ada-tmp-directory',
 857 starts the pretty printer as external process on that file and then
 858 reloads the beautified program in the buffer and cleans up
 859 `ada-tmp-directory'."
 860   (interactive)
 861   (let ((filename-with-path buffer-file-name)
 862         (curbuf (current-buffer))
 863         (orgpos (point))
 864         (mesgbuf nil) ;; for byte-compiling
 865         (file-path (file-name-directory buffer-file-name))
 866         (filename-without-path (file-name-nondirectory buffer-file-name))
 867         (tmp-file-with-directory
 868          (concat ada-tmp-directory
 869                  (file-name-nondirectory buffer-file-name))))
 870     ;;
 871     ;; save buffer in temporary file
 872     ;;
 873     (message "saving current buffer to temporary file ...")
 874     (write-file tmp-file-with-directory)
 875     (auto-save-mode nil)
 876     (message "saving current buffer to temporary file ... done")
 877     ;;
 878     ;; call external pretty printer program
 879     ;;
 880
 881     (message "running external pretty printer ...")
 882     ;; create a temporary buffer for messages of pretty printer
 883     (setq mesgbuf (get-buffer-create "Pretty Printer Messages"))
 884     ;; execute pretty printer on temporary file
 885     (call-process ada-external-pretty-print-program
 886                   nil mesgbuf t
 887                   tmp-file-with-directory)
 888     ;; display messages if there are some
 889     (if (buffer-modified-p mesgbuf)
 890         ;; show the message buffer
 891         (display-buffer mesgbuf t)
 892       ;; kill the message buffer
 893       (kill-buffer mesgbuf))
 894     (message "running external pretty printer ... done")
 895     ;;
 896     ;; kill current buffer and load pretty printer output
 897     ;; or restore old buffer
 898     ;;
 899     (if (y-or-n-p
 900          "Really replace current buffer with pretty printer output ? ")
 901         (progn
 902           (set-buffer-modified-p nil)
 903           (kill-buffer curbuf)
 904           (find-file tmp-file-with-directory))
 905       (message "old buffer contents restored"))
 906     ;;
 907     ;; delete temporary file and restore information of current buffer
 908     ;;
 909     (delete-file tmp-file-with-directory)
 910     (set-visited-file-name filename-with-path)
 911     (auto-save-mode t)
 912     (goto-char orgpos)))
 913
 914 \f
 915 ;;;---------------
 916 ;;;  auto-casing
 917 ;;;---------------
 918
 919 ;; from Philippe Waroquiers <philippe@cfmu.eurocontrol.be>
 920 ;; modified by RE and MH
 921
 922 (defun ada-after-keyword-p ()
 923   ;; returns t if cursor is after a keyword.
 924   (save-excursion
 925     (forward-word -1)
 926     (and (save-excursion
 927            (or
 928             (= (point) (point-min))
 929             (backward-char 1))
 930            (not (looking-at "_")))     ; (MH)
 931          (looking-at (concat ada-keywords "[^_]")))))
 932
 933 (defun ada-in-char-const-p ()
 934   ;; Returns t if point is inside a character constant.
 935   ;; We assume to be in a constant if the previous and the next character
 936   ;; are "'".
 937   (save-excursion
 938     (if (> (point) 1)
 939         (and
 940          (progn
 941            (forward-char 1)
 942            (looking-at "'"))
 943          (progn
 944            (forward-char -2)
 945            (looking-at "'")))
 946       nil)))
 947
 948
 949 (defun ada-adjust-case (&optional force-identifier)
 950   "Adjust the case of the word before the just typed character.
 951 Respect options `ada-case-keyword', `ada-case-identifier', and
 952 `ada-case-attribute'.
 953 If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." ; (MH)
 954   (forward-char -1)
 955   (if (and (> (point) 1) (not (or (ada-in-string-p)
 956                                   (ada-in-comment-p)
 957                                   (ada-in-char-const-p))))
 958       (if (eq (char-syntax (char-after (1- (point)))) ?w)
 959           (if (save-excursion
 960                 (forward-word -1)
 961                 (or (= (point) (point-min))
 962                     (backward-char 1))
 963                 (looking-at "'"))
 964               (funcall ada-case-attribute -1)
 965             (if (and
 966                  (not force-identifier) ; (MH)
 967                  (ada-after-keyword-p))
 968                 (funcall ada-case-keyword -1)
 969               (funcall ada-case-identifier -1)))))
 970   (forward-char 1))
 971
 972
 973 (defun ada-adjust-case-interactive (arg)
 974   (interactive "P")
 975   (let ((lastk last-command-char))
 976     (cond ((or (eq lastk ?\n)
 977                (eq lastk ?\r))
 978            ;; horrible kludge
 979            (insert " ")
 980            (ada-adjust-case)
 981            ;; horrible dekludge
 982            (delete-backward-char 1)
 983            ;; some special keys and their bindings
 984            (cond
 985             ((eq lastk ?\n)
 986              (funcall ada-lfd-binding))
 987             ((eq lastk ?\r)
 988              (funcall ada-ret-binding))))
 989           ((eq lastk ?\C-i) (ada-tab))
 990           ((self-insert-command (prefix-numeric-value arg))))
 991     ;; if there is a keyword in front of the underscore
 992     ;; then it should be part of an identifier (MH)
 993     (if (eq lastk ?_)
 994         (ada-adjust-case t)
 995       (ada-adjust-case))))
 996
 997
 998 (defun ada-activate-keys-for-case ()
 999   ;; save original keybindings to allow swapping ret/lfd
1000   ;; when casing is activated
1001   ;; the 'or ...' is there to be sure that the value will not
1002   ;; be changed again when Ada mode is called more than once (MH)
1003   (or ada-ret-binding
1004       (setq ada-ret-binding (key-binding "\C-M")))
1005   (or ada-lfd-binding
1006       (setq ada-lfd-binding (key-binding "\C-j")))
1007   ;; call case modifying function after certain keys.
1008   (mapcar (function (lambda(key) (define-key
1009                                    ada-mode-map
1010                                    (char-to-string key)
1011                                    'ada-adjust-case-interactive)))
1012           '( ?` ?~ ?! ?@ ?# ?$ ?% ?^ ?& ?* ?( ?)  ?- ?= ?+ ?[ ?{ ?] ?}
1013                 ?_ ?\\ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?? ?/ ?\n 32 ?\r )))
1014 ;; deleted ?\t from above list
1015
1016 ;;
1017 ;; added by MH
1018 ;;
1019 (defun ada-loose-case-word (&optional arg)
1020   "Capitalizes the first letter and the letters following `_'.
1021 ARG is ignored, it's there to fit the standard casing functions' style."
1022   (let ((pos (point))
1023         (first t))
1024     (skip-chars-backward "a-zA-Z0-9_")
1025     (while (or first
1026                (search-forward "_" pos t))
1027       (and first
1028            (setq first nil))
1029       (insert-char (upcase (following-char)) 1)
1030       (delete-char 1))
1031     (goto-char pos)))
1032
1033
1034 ;;
1035 ;; added by MH
1036 ;; modified by JSH to handle attributes
1037 ;;
1038 (defun ada-adjust-case-region (from to)
1039   "Adjusts the case of all words in the region.
1040 Attention: This function might take very long for big regions !"
1041   (interactive "*r")
1042   (let ((begin nil)
1043         (end nil)
1044         (keywordp nil)
1045         (attribp nil))
1046     (unwind-protect
1047         (save-excursion
1048           (set-syntax-table ada-mode-symbol-syntax-table)
1049           (goto-char to)
1050           ;;
1051           ;; loop: look for all identifiers, keywords, and attributes
1052           ;;
1053           (while (re-search-backward
1054                   "[^a-zA-Z0-9_]\\([a-zA-Z0-9_]+\\)[^a-zA-Z0-9_]"
1055                   from
1056                   t)
1057             ;;
1058             ;; print status message
1059             ;;
1060             (message "adjusting case ... %5d characters left" (- (point) from))
1061             (setq attribp (looking-at "'[a-zA-Z0-9_]+[^']"))
1062             (forward-char 1)
1063             (or
1064              ;; do nothing if it is a string or comment
1065              (ada-in-string-or-comment-p)
1066              (progn
1067                ;;
1068                ;; get the identifier or keyword or attribute
1069                ;;
1070                (setq begin (point))
1071                (setq keywordp (looking-at (concat ada-keywords "[^_]")))
1072                (skip-chars-forward "a-zA-Z0-9_")
1073                ;;
1074                ;; casing according to user-option
1075                ;;
1076                (if keywordp
1077                    (funcall ada-case-keyword -1)
1078                  (if attribp
1079                      (funcall ada-case-attribute -1)
1080                    (funcall ada-case-identifier -1)))
1081                (goto-char begin))))
1082           (message "adjusting case ... done"))
1083       (set-syntax-table ada-mode-syntax-table))))
1084
1085
1086 ;;
1087 ;; added by MH
1088 ;;
1089 (defun ada-adjust-case-buffer ()
1090   "Adjusts the case of all words in the whole buffer.
1091 ATTENTION: This function might take very long for big buffers !"
1092   (interactive "*")
1093   (ada-adjust-case-region (point-min) (point-max)))
1094
1095 \f
1096 ;;;------------------------;;;
1097 ;;; Format Parameter Lists ;;;
1098 ;;;------------------------;;;
1099
1100 (defun ada-format-paramlist ()
1101   "Reformats a parameter list.
1102 ATTENTION:  1) Comments inside the list are killed !
1103             2) If the syntax is not correct (especially, if there are
1104                semicolons missing), it can get totally confused !
1105 In such a case, use `undo', correct the syntax and try again."
1106
1107   (interactive)
1108   (let ((begin nil)
1109         (end nil)
1110         (delend nil)
1111         (paramlist nil))
1112     (unwind-protect
1113         (progn
1114           (set-syntax-table ada-mode-symbol-syntax-table)
1115
1116           ;; check if really inside parameter list
1117           (or (ada-in-paramlist-p)
1118               (error "not in parameter list"))
1119           ;;
1120           ;; find start of current parameter-list
1121           ;;
1122           (ada-search-ignore-string-comment
1123            (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
1124           (ada-search-ignore-string-comment "(" nil nil t)
1125           (backward-char 1)
1126           (setq begin (point))
1127
1128           ;;
1129           ;; find end of parameter-list
1130           ;;
1131           (forward-sexp 1)
1132           (setq delend (point))
1133           (delete-char -1)
1134
1135           ;;
1136           ;; find end of last parameter-declaration
1137           ;;
1138           (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
1139           (forward-char 1)
1140           (setq end (point))
1141
1142           ;;
1143           ;; build a list of all elements of the parameter-list
1144           ;;
1145           (setq paramlist (ada-scan-paramlist (1+ begin) end))
1146
1147           ;;
1148           ;; delete the original parameter-list
1149           ;;
1150           (delete-region begin (1- delend))
1151
1152           ;;
1153           ;; insert the new parameter-list
1154           ;;
1155           (goto-char begin)
1156           (ada-insert-paramlist paramlist))
1157
1158       ;;
1159       ;; restore syntax-table
1160       ;;
1161       (set-syntax-table ada-mode-syntax-table)
1162       )))
1163
1164
1165 (defun ada-scan-paramlist (begin end)
1166   ;; Scans a parameter-list  between BEGIN and END and returns a list
1167   ;; of its contents.
1168   ;; The list has the following format:
1169   ;;
1170   ;;   Name of Param  in? out? access?  Name of Type   Default-Exp or nil
1171   ;;
1172   ;; ( ('Name_Param_1' t   nil    t      Type_Param_1   ':= expression')
1173   ;;   ('Name_Param_2' nil nil    t      Type_Param_2    nil) )
1174
1175   (let ((paramlist (list))
1176         (param (list))
1177         (notend t)
1178         (apos nil)
1179         (epos nil)
1180         (semipos nil)
1181         (match-cons nil))
1182
1183     (goto-char begin)
1184     ;;
1185     ;; loop until end of last parameter
1186     ;;
1187     (while notend
1188
1189       ;;
1190       ;; find first character of parameter-declaration
1191       ;;
1192       (ada-goto-next-non-ws)
1193       (setq apos (point))
1194
1195       ;;
1196       ;; find last character of parameter-declaration
1197       ;;
1198       (if (setq match-cons
1199                 (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
1200           (progn
1201             (setq epos (car match-cons))
1202             (setq semipos (cdr match-cons)))
1203         (setq epos end))
1204
1205       ;;
1206       ;; read name(s) of parameter(s)
1207       ;;
1208       (goto-char apos)
1209       (looking-at "\\([a-zA-Z0-9_, \t\n]*[a-zA-Z0-9_]\\)[ \t\n]*:[^=]")
1210
1211       (setq param (list (buffer-substring (match-beginning 1)
1212                                           (match-end 1))))
1213       (ada-search-ignore-string-comment ":" nil epos t)
1214
1215       ;;
1216       ;; look for 'in'
1217       ;;
1218       (setq apos (point))
1219       (setq param
1220             (append param
1221                     (list
1222                      (consp
1223                       (ada-search-ignore-string-comment "\\<in\\>"
1224                                                         nil
1225                                                         epos
1226                                                         t)))))
1227
1228       ;;
1229       ;; look for 'out'
1230       ;;
1231       (goto-char apos)
1232       (setq param
1233             (append param
1234                     (list
1235                      (consp
1236                       (ada-search-ignore-string-comment "\\<out\\>"
1237                                                         nil
1238                                                         epos
1239                                                         t)))))
1240
1241       ;;
1242       ;; look for 'access'
1243       ;;
1244       (goto-char apos)
1245       (setq param
1246             (append param
1247                     (list
1248                      (consp
1249                       (ada-search-ignore-string-comment "\\<access\\>"
1250                                                         nil
1251                                                         epos
1252                                                         t)))))
1253
1254       ;;
1255       ;; skip 'in'/'out'/'access'
1256       ;;
1257       (goto-char apos)
1258       (ada-goto-next-non-ws)
1259       (while (looking-at "\\<\\(in\\|out\\|access\\)\\>")
1260         (forward-word 1)
1261         (ada-goto-next-non-ws))
1262
1263       ;;
1264       ;; read type of parameter
1265       ;;
1266       (looking-at "\\<[a-zA-Z0-9_\\.\\']+\\>")
1267       (setq param
1268             (append param
1269                     (list
1270                      (buffer-substring (match-beginning 0)
1271                                        (match-end 0)))))
1272
1273       ;;
1274       ;; read default-expression, if there is one
1275       ;;
1276       (goto-char (setq apos (match-end 0)))
1277       (setq param
1278             (append param
1279                     (list
1280                      (if (setq match-cons
1281                                (ada-search-ignore-string-comment ":="
1282                                                                  nil
1283                                                                  epos
1284                                                                  t))
1285                          (buffer-substring (car match-cons)
1286                                            epos)
1287                        nil))))
1288       ;;
1289       ;; add this parameter-declaration to the list
1290       ;;
1291       (setq paramlist (append paramlist (list param)))
1292
1293       ;;
1294       ;; check if it was the last parameter
1295       ;;
1296       (if (eq epos end)
1297           (setq notend nil)
1298         (goto-char semipos))
1299
1300       ) ; end of loop
1301
1302     (reverse paramlist)))
1303
1304
1305 (defun ada-insert-paramlist (paramlist)
1306   ;; Inserts a formatted PARAMLIST in the buffer.
1307   ;; See doc of `ada-scan-paramlist' for the format.
1308   (let ((i (length paramlist))
1309         (parlen 0)
1310         (typlen 0)
1311         (temp 0)
1312         (inp nil)
1313         (outp nil)
1314         (accessp nil)
1315         (column nil)
1316         (orgpoint 0)
1317         (firstcol nil))
1318
1319     ;;
1320     ;; loop until last parameter
1321     ;;
1322     (while (not (zerop i))
1323       (setq i (1- i))
1324
1325       ;;
1326       ;; get max length of parameter-name
1327       ;;
1328       (setq parlen
1329             (if (<= parlen (setq temp
1330                               (length (nth 0 (nth i paramlist)))))
1331                 temp
1332               parlen))
1333
1334       ;;
1335       ;; get max length of type-name
1336       ;;
1337       (setq typlen
1338             (if (<= typlen (setq temp
1339                               (length (nth 4 (nth i paramlist)))))
1340                 temp
1341               typlen))
1342
1343       ;;
1344       ;; is there any 'in' ?
1345       ;;
1346       (setq inp
1347             (or inp
1348                 (nth 1 (nth i paramlist))))
1349
1350       ;;
1351       ;; is there any 'out' ?
1352       ;;
1353       (setq outp
1354             (or outp
1355                 (nth 2 (nth i paramlist))))
1356
1357       ;;
1358       ;; is there any 'access' ?
1359       ;;
1360       (setq accessp
1361             (or accessp
1362                 (nth 3 (nth i paramlist))))) ; end of loop
1363
1364     ;;
1365     ;; does paramlist already start on a separate line ?
1366     ;;
1367     (if (save-excursion
1368           (re-search-backward "^.\\|[^ \t]" nil t)
1369           (looking-at "^."))
1370         ;; yes => re-indent it
1371         (ada-indent-current)
1372       ;;
1373       ;; no => insert newline and indent it
1374       ;;
1375       (progn
1376         (ada-indent-current)
1377         (newline)
1378         (delete-horizontal-space)
1379         (setq orgpoint (point))
1380         (setq column (save-excursion
1381                        (funcall (ada-indent-function) orgpoint)))
1382         (indent-to column)
1383         ))
1384
1385     (insert "(")
1386
1387     (setq firstcol (current-column))
1388     (setq i (length paramlist))
1389
1390     ;;
1391     ;; loop until last parameter
1392     ;;
1393     (while (not (zerop i))
1394       (setq i (1- i))
1395       (setq column firstcol)
1396
1397       ;;
1398       ;; insert parameter-name, space and colon
1399       ;;
1400       (insert (nth 0 (nth i paramlist)))
1401       (indent-to (+ column parlen 1))
1402       (insert ": ")
1403       (setq column (current-column))
1404
1405       ;;
1406       ;; insert 'in' or space
1407       ;;
1408       (if (nth 1 (nth i paramlist))
1409           (insert "in ")
1410         (if (and
1411              (or inp
1412                  accessp)
1413              (not (nth 3 (nth i paramlist))))
1414             (insert "   ")))
1415
1416       ;;
1417       ;; insert 'out' or space
1418       ;;
1419       (if (nth 2 (nth i paramlist))
1420           (insert "out ")
1421         (if (and
1422              (or outp
1423                  accessp)
1424              (not (nth 3 (nth i paramlist))))
1425             (insert "    ")))
1426
1427       ;;
1428       ;; insert 'access'
1429       ;;
1430       (if (nth 3 (nth i paramlist))
1431           (insert "access "))
1432
1433       (setq column (current-column))
1434
1435       ;;
1436       ;; insert type-name and, if necessary, space and default-expression
1437       ;;
1438       (insert (nth 4 (nth i paramlist)))
1439       (if (nth 5 (nth i paramlist))
1440           (progn
1441             (indent-to (+ column typlen 1))
1442             (insert (nth 5 (nth i paramlist)))))
1443
1444       ;;
1445       ;; check if it was the last parameter
1446       ;;
1447       (if (not (zerop i))
1448           ;; no => insert ';' and newline and indent
1449           (progn
1450             (insert ";")
1451             (newline)
1452             (indent-to firstcol))
1453         ;; yes
1454         (insert ")"))
1455
1456       ) ; end of loop
1457
1458     ;;
1459     ;; if anything follows, except semicolon:
1460     ;; put it in a new line and indent it
1461     ;;
1462     (if (not (looking-at "[ \t]*[;\n]"))
1463         (ada-indent-newline-indent))
1464
1465     ))
1466
1467 \f
1468 ;;;----------------------------;;;
1469 ;;; Move To Matching Start/End ;;;
1470 ;;;----------------------------;;;
1471
1472 (defun ada-move-to-start ()
1473   "Moves point to the matching start of the current Ada structure."
1474   (interactive)
1475   (let ((pos (point)))
1476     (unwind-protect
1477         (progn
1478           (set-syntax-table ada-mode-symbol-syntax-table)
1479
1480           (message "searching for block start ...")
1481           (save-excursion
1482             ;;
1483             ;; do nothing if in string or comment or not on 'end ...;'
1484             ;;            or if an error occurs during processing
1485             ;;
1486             (or
1487              (ada-in-string-or-comment-p)
1488              (and (progn
1489                     (or (looking-at "[ \t]*\\<end\\>")
1490                         (backward-word 1))
1491                     (or (looking-at "[ \t]*\\<end\\>")
1492                         (backward-word 1))
1493                     (or (looking-at "[ \t]*\\<end\\>")
1494                         (error "not on end ...;")))
1495                   (ada-goto-matching-start 1)
1496                   (setq pos (point))
1497
1498                   ;;
1499                   ;; on 'begin' => go on, according to user option
1500                   ;;
1501                   ada-move-to-declaration
1502                   (looking-at "\\<begin\\>")
1503                   (ada-goto-matching-decl-start)
1504                   (setq pos (point))))
1505
1506             ) ; end of save-excursion
1507
1508           ;; now really move to the found position
1509           (goto-char pos)
1510           (message "searching for block start ... done"))
1511
1512       ;;
1513       ;; restore syntax-table
1514       ;;
1515       (set-syntax-table ada-mode-syntax-table))))
1516
1517
1518 (defun ada-move-to-end ()
1519   "Moves point to the matching end of the current block around point.
1520 Moves to 'begin' if in a declarative part."
1521   (interactive)
1522   (let ((pos (point))
1523         (decstart nil)
1524         (packdecl nil))
1525     (unwind-protect
1526         (progn
1527           (set-syntax-table ada-mode-symbol-syntax-table)
1528
1529           (message "searching for block end ...")
1530           (save-excursion
1531
1532             (forward-char 1)
1533             (cond
1534              ;; directly on 'begin'
1535              ((save-excursion
1536                 (ada-goto-previous-word)
1537                 (looking-at "\\<begin\\>"))
1538               (ada-goto-matching-end 1))
1539              ;; on first line of defun declaration
1540              ((save-excursion
1541                 (and (ada-goto-stmt-start)
1542                      (looking-at "\\<function\\>\\|\\<procedure\\>" )))
1543               (ada-search-ignore-string-comment "\\<begin\\>"))
1544              ;; on first line of task declaration
1545              ((save-excursion
1546                 (and (ada-goto-stmt-start)
1547                      (looking-at "\\<task\\>" )
1548                      (forward-word 1)
1549                      (ada-search-ignore-string-comment "[^ \n\t]")
1550                      (not (backward-char 1))
1551                      (looking-at "\\<body\\>")))
1552               (ada-search-ignore-string-comment "\\<begin\\>"))
1553              ;; accept block start
1554              ((save-excursion
1555                 (and (ada-goto-stmt-start)
1556                      (looking-at "\\<accept\\>" )))
1557               (ada-goto-matching-end 0))
1558              ;; package start
1559              ((save-excursion
1560                 (and (ada-goto-matching-decl-start t)
1561                      (looking-at "\\<package\\>")))
1562               (ada-goto-matching-end 1))
1563              ;; inside a 'begin' ... 'end' block
1564              ((save-excursion
1565                 (ada-goto-matching-decl-start t))
1566               (ada-search-ignore-string-comment "\\<begin\\>"))
1567              ;; (hopefully ;-) everything else
1568              (t
1569               (ada-goto-matching-end 1)))
1570             (setq pos (point))
1571
1572             ) ; end of save-excursion
1573
1574           ;; now really move to the found position
1575           (goto-char pos)
1576           (message "searching for block end ... done"))
1577
1578       ;;
1579       ;; restore syntax-table
1580       ;;
1581       (set-syntax-table ada-mode-syntax-table))))
1582
1583 \f
1584 ;;;-----------------------------;;;
1585 ;;;  Functions For Indentation  ;;;
1586 ;;;-----------------------------;;;
1587
1588 ;; ---- main functions for indentation
1589
1590 (defun ada-indent-region (beg end)
1591   "Indents the region using `ada-indent-current' on each line."
1592   (interactive "*r")
1593   (goto-char beg)
1594   (let ((block-done 0)
1595         (lines-remaining (count-lines beg end))
1596         (msg (format "indenting %4d lines %%4d lines remaining ..."
1597                      (count-lines beg end)))
1598         (endmark (copy-marker end)))
1599     ;; catch errors while indenting
1600     (condition-case err
1601         (while (< (point) endmark)
1602           (if (> block-done 9)
1603               (progn (message msg lines-remaining)
1604                      (setq block-done 0)))
1605           (if (looking-at "^$") nil
1606             (ada-indent-current))
1607           (forward-line 1)
1608           (setq block-done (1+ block-done))
1609           (setq lines-remaining (1- lines-remaining)))
1610       ;; show line number where the error occurred
1611       (error
1612        (error "line %d: %s" (1+ (count-lines (point-min) (point))) err) nil))
1613     (message "indenting ... done")))
1614
1615
1616 (defun ada-indent-newline-indent ()
1617   "Indents the current line, inserts a newline and then indents the new line."
1618   (interactive "*")
1619   (ada-indent-current)
1620   (newline)
1621   (ada-indent-current))
1622
1623
1624 (defun ada-indent-current ()
1625   "Indents current line as Ada code.
1626 This works by two steps:
1627  1) It moves point to the end of the previous code line.
1628     Then it calls the function to calculate the indentation for the
1629     following line as if a newline would be inserted there.
1630     The calculated column # is saved and the old position of point
1631     is restored.
1632  2) Then another function is called to calculate the indentation for
1633     the current line, based on the previously calculated column #."
1634
1635   (interactive)
1636
1637   (unwind-protect
1638       (progn
1639         (set-syntax-table ada-mode-symbol-syntax-table)
1640
1641         (let ((line-end)
1642               (orgpoint (point-marker))
1643               (cur-indent)
1644               (prev-indent)
1645               (prevline t))
1646
1647           ;;
1648           ;; first step
1649           ;;
1650           (save-excursion
1651             (if (ada-goto-prev-nonblank-line t)
1652                 ;;
1653                 ;; we are not in the first accessible line in the buffer
1654                 ;;
1655                 (progn
1656                   ;;(end-of-line)
1657                   ;;(forward-char 1)
1658                   ;; we are already at the BOL
1659                   (forward-line 1)
1660                   (setq line-end (point))
1661                   (setq prev-indent
1662                         (save-excursion
1663                           (funcall (ada-indent-function) line-end))))
1664               (progn                    ; first line of buffer -> set indent
1665                 (beginning-of-line)     ; to 0
1666                 (delete-horizontal-space)
1667                 (setq prevline nil))))
1668
1669           (if prevline
1670               ;;
1671               ;; we are not in the first accessible line in the buffer
1672               ;;
1673               (progn
1674                 ;;
1675                 ;; second step
1676                 ;;
1677                 (back-to-indentation)
1678                 (setq cur-indent (ada-get-current-indent prev-indent))
1679                 ;; only reindent if indentation is different then the current
1680                 (if (= (current-column) cur-indent)
1681                     nil
1682                   (delete-horizontal-space)
1683                   (indent-to cur-indent))
1684                 ;;
1685                 ;; restore position of point
1686                 ;;
1687                 (goto-char orgpoint)
1688                 (if (< (current-column) (current-indentation))
1689                     (back-to-indentation))))))
1690
1691     ;;
1692     ;; restore syntax-table
1693     ;;
1694     (set-syntax-table ada-mode-syntax-table)))
1695
1696
1697 (defun ada-get-current-indent (prev-indent)
1698   ;; Returns the column # to indent the current line to.
1699   ;; PREV-INDENT is the indentation resulting from the previous lines.
1700   (let ((column nil)
1701         (pos nil)
1702         (match-cons nil))
1703
1704     (cond
1705      ;;
1706      ;; in open parenthesis, but not in parameter-list
1707      ;;
1708      ((and
1709        ada-indent-to-open-paren
1710        (not (ada-in-paramlist-p))
1711        (setq column (ada-in-open-paren-p)))
1712       ;; check if we have something like this  (Table_Component_Type =>
1713       ;;                                          Source_File_Record,)
1714       (save-excursion
1715         (if (and (ada-search-ignore-string-comment "[^ \t]" t nil)
1716                  (looking-at "\n")
1717                  (ada-search-ignore-string-comment "[^ \t\n]" t nil)
1718                  (looking-at ">"))
1719             (setq column (+ ada-broken-indent column))))
1720       column)
1721
1722      ;;
1723      ;; end
1724      ;;
1725      ((looking-at "\\<end\\>")
1726       (let ((label 0))
1727         (save-excursion
1728           (ada-goto-matching-start 1)
1729
1730           ;;
1731           ;; found 'loop' => skip back to 'while' or 'for'
1732           ;;                 if 'loop' is not on a separate line
1733           ;;
1734           (if (and
1735                (looking-at "\\<loop\\>")
1736                (save-excursion
1737                  (back-to-indentation)
1738                  (not (looking-at "\\<loop\\>"))))
1739               (if (save-excursion
1740                     (and
1741                      (setq match-cons
1742                            (ada-search-ignore-string-comment
1743                             ada-loop-start-re t nil))
1744                      (not (looking-at "\\<loop\\>"))))
1745                   (progn
1746                     (goto-char (car match-cons))
1747                     (save-excursion
1748                       (beginning-of-line)
1749                       (if (looking-at ada-named-block-re)
1750                           (setq label (- ada-label-indent)))))))
1751
1752           (+ (current-indentation) label))))
1753      ;;
1754      ;; exception
1755      ;;
1756      ((looking-at "\\<exception\\>")
1757       (save-excursion
1758         (ada-goto-matching-start 1)
1759         (current-indentation)))
1760      ;;
1761      ;; when
1762      ;;
1763      ((looking-at "\\<when\\>")
1764       (save-excursion
1765         (ada-goto-matching-start 1)
1766         (+ (current-indentation) ada-when-indent)))
1767      ;;
1768      ;; else
1769      ;;
1770      ((looking-at "\\<else\\>")
1771       (if (save-excursion
1772             (ada-goto-previous-word)
1773             (looking-at "\\<or\\>"))
1774           prev-indent
1775         (save-excursion
1776           (ada-goto-matching-start 1 nil t)
1777           (current-indentation))))
1778      ;;
1779      ;; elsif
1780      ;;
1781      ((looking-at "\\<elsif\\>")
1782       (save-excursion
1783         (ada-goto-matching-start 1 nil t)
1784         (current-indentation)))
1785      ;;
1786      ;; then
1787      ;;
1788      ((looking-at "\\<then\\>")
1789       (if (save-excursion
1790             (ada-goto-previous-word)
1791             (looking-at "\\<and\\>"))
1792           prev-indent
1793         (save-excursion
1794           (ada-search-ignore-string-comment "\\<elsif\\>\\|\\<if\\>" t nil)
1795           (+ (current-indentation) ada-stmt-end-indent))))
1796      ;;
1797      ;; loop
1798      ;;
1799      ((looking-at "\\<loop\\>")
1800       (setq pos (point))
1801       (save-excursion
1802         (goto-char (match-end 0))
1803         (ada-goto-stmt-start)
1804         (if (looking-at "\\<loop\\>\\|\\<if\\>")
1805             prev-indent
1806           (progn
1807             (if (not (looking-at ada-loop-start-re))
1808                 (ada-search-ignore-string-comment ada-loop-start-re
1809                                                   nil pos))
1810             (if (looking-at "\\<loop\\>")
1811                 prev-indent
1812               (+ (current-indentation) ada-stmt-end-indent))))))
1813      ;;
1814      ;; begin
1815      ;;
1816      ((looking-at "\\<begin\\>")
1817       (save-excursion
1818         (if (ada-goto-matching-decl-start t)
1819             (current-indentation)
1820           prev-indent)))
1821      ;;
1822      ;; is
1823      ;;
1824      ((looking-at "\\<is\\>")
1825       (if (and
1826            ada-indent-is-separate
1827            (save-excursion
1828              (goto-char (match-end 0))
1829              (ada-goto-next-non-ws (save-excursion
1830                                      (end-of-line)
1831                                      (point)))
1832              (looking-at "\\<abstract\\>\\|\\<separate\\>")))
1833           (save-excursion
1834             (ada-goto-stmt-start)
1835             (+ (current-indentation) ada-indent))
1836         (save-excursion
1837           (ada-goto-stmt-start)
1838           (+ (current-indentation) ada-stmt-end-indent))))
1839      ;;
1840      ;; record
1841      ;;
1842      ((looking-at "\\<record\\>")
1843       (save-excursion
1844         (ada-search-ignore-string-comment
1845          "\\<\\(type\\|use\\)\\>" t nil)
1846         (if (looking-at "\\<use\\>")
1847             (ada-search-ignore-string-comment "\\<for\\>" t nil))
1848         (+ (current-indentation) ada-indent-record-rel-type)))
1849      ;;
1850      ;; or as statement-start
1851      ;;
1852      ((ada-looking-at-semi-or)
1853       (save-excursion
1854         (ada-goto-matching-start 1)
1855         (current-indentation)))
1856      ;;
1857      ;; private as statement-start
1858      ;;
1859      ((ada-looking-at-semi-private)
1860       (save-excursion
1861         (ada-goto-matching-decl-start)
1862         (current-indentation)))
1863      ;;
1864      ;; new/abstract/separate
1865      ;;
1866      ((looking-at "\\<\\(new\\|abstract\\|separate\\)\\>")
1867       (- prev-indent ada-indent (- ada-broken-indent)))
1868      ;;
1869      ;; return
1870      ;;
1871      ((looking-at "\\<return\\>")
1872       (save-excursion
1873         (forward-sexp -1)
1874         (if (and (looking-at "(")
1875                  (save-excursion
1876                    (backward-sexp 2)
1877                    (looking-at "\\<function\\>")))
1878             (1+ (current-column))
1879           prev-indent)))
1880      ;;
1881      ;; do
1882      ;;
1883      ((looking-at "\\<do\\>")
1884       (save-excursion
1885         (ada-goto-stmt-start)
1886         (+ (current-indentation) ada-stmt-end-indent)))
1887      ;;
1888      ;; package/function/procedure
1889      ;;
1890      ((and (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")
1891            (save-excursion
1892              (forward-char 1)
1893              (ada-goto-stmt-start)
1894              (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")))
1895       (save-excursion
1896         ;; look for 'generic'
1897         (if (and (ada-goto-matching-decl-start t)
1898                  (looking-at "generic"))
1899             (current-column)
1900           prev-indent)))
1901      ;;
1902      ;; label
1903      ;;
1904      ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*:[^=]")
1905       (if (ada-in-decl-p)
1906           prev-indent
1907         (+ prev-indent ada-label-indent)))
1908      ;;
1909      ;; identifier and other noindent-statements
1910      ;;
1911      ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*")
1912       prev-indent)
1913      ;;
1914      ;; beginning of a parameter list
1915      ;;
1916      ((looking-at "(")
1917       prev-indent)
1918      ;;
1919      ;; end of a parameter list
1920      ;;
1921      ((looking-at ")")
1922       (save-excursion
1923         (forward-char 1)
1924         (backward-sexp 1)
1925         (current-column)))
1926      ;;
1927      ;; comment
1928      ;;
1929      ((looking-at "--")
1930       (if ada-indent-comment-as-code
1931           prev-indent
1932         (current-indentation)))
1933      ;;
1934      ;; unknown syntax - maybe this should signal an error ?
1935      ;;
1936      (t
1937       prev-indent))))
1938
1939
1940 (defun ada-indent-function (&optional nomove)
1941   ;; Returns the function to calculate the indentation for the current
1942   ;; line according to the previous statement, ignoring the contents
1943   ;; of the current line after point.  Moves point to the beginning of
1944   ;; the current statement, if NOMOVE is nil.
1945
1946   (let ((orgpoint (point))
1947         (func nil))
1948     ;;
1949     ;; inside a parameter-list
1950     ;;
1951     (if (ada-in-paramlist-p)
1952         (setq func 'ada-get-indent-paramlist)
1953       (progn
1954         ;;
1955         ;; move to beginning of current statement
1956         ;;
1957         (if (not nomove)
1958             (ada-goto-stmt-start))
1959         ;;
1960         ;; no beginning found => don't change indentation
1961         ;;
1962         (if (and
1963              (eq orgpoint (point))
1964              (not nomove))
1965             (setq func 'ada-get-indent-nochange)
1966
1967           (cond
1968            ;;
1969            ((and
1970              ada-indent-to-open-paren
1971              (ada-in-open-paren-p))
1972             (setq func 'ada-get-indent-open-paren))
1973            ;;
1974            ((looking-at "\\<end\\>")
1975             (setq func 'ada-get-indent-end))
1976            ;;
1977            ((looking-at ada-loop-start-re)
1978             (setq func 'ada-get-indent-loop))
1979            ;;
1980            ((looking-at ada-subprog-start-re)
1981             (setq func 'ada-get-indent-subprog))
1982            ;;
1983            ((looking-at ada-block-start-re)
1984             (setq func 'ada-get-indent-block-start))
1985            ;;
1986            ((looking-at "\\<type\\>")
1987             (setq func 'ada-get-indent-type))
1988            ;;
1989            ((looking-at "\\<\\(els\\)?if\\>")
1990             (setq func 'ada-get-indent-if))
1991            ;;
1992            ((looking-at "\\<case\\>")
1993             (setq func 'ada-get-indent-case))
1994            ;;
1995            ((looking-at "\\<when\\>")
1996             (setq func 'ada-get-indent-when))
1997            ;;
1998            ((looking-at "--")
1999             (setq func 'ada-get-indent-comment))
2000            ;;
2001            ((looking-at "[a-zA-Z0-9_]+[ \t\n]*:[^=]")
2002             (setq func 'ada-get-indent-label))
2003            ;;
2004            ((looking-at "\\<separate\\>")
2005             (setq func 'ada-get-indent-nochange))
2006            (t
2007             (setq func 'ada-get-indent-noindent))))))
2008
2009     func))
2010
2011
2012 ;; ---- functions to return indentation for special cases
2013
2014 (defun ada-get-indent-open-paren (orgpoint)
2015   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2016   ;; Assumes point to be behind an open parenthesis not yet closed.
2017   (ada-in-open-paren-p))
2018
2019
2020 (defun ada-get-indent-nochange (orgpoint)
2021   ;; Returns the indentation (column #) of the current line.
2022   (save-excursion
2023     (forward-line -1)
2024     (current-indentation)))
2025
2026
2027 (defun ada-get-indent-paramlist (orgpoint)
2028   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2029   ;; Assumes point to be inside a parameter-list.
2030   (save-excursion
2031     (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
2032     (cond
2033      ;;
2034      ;; in front of the first parameter
2035      ;;
2036      ((looking-at "(")
2037       (goto-char (match-end 0))
2038       (current-column))
2039      ;;
2040      ;; in front of another parameter
2041      ;;
2042      ((looking-at ";")
2043       (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
2044       (ada-goto-next-non-ws)
2045       (current-column))
2046      ;;
2047      ;; inside a parameter declaration
2048      ;;
2049      (t
2050       (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
2051       (ada-goto-next-non-ws)
2052       (+ (current-column) ada-broken-indent)))))
2053
2054
2055 (defun ada-get-indent-end (orgpoint)
2056   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2057   ;; Assumes point to be at the beginning of an end-statement.
2058   ;; Therefore it has to find the corresponding start. This can be a little
2059   ;; slow, if it has to search through big files with many nested blocks.
2060   ;; Signals an error if the corresponding block-start doesn't match.
2061   (let ((defun-name nil)
2062         (label 0)
2063         (indent nil))
2064     ;;
2065     ;; is the line already terminated by ';' ?
2066     ;;
2067     (if (save-excursion
2068           (ada-search-ignore-string-comment ";" nil orgpoint))
2069         ;;
2070         ;; yes, look what's following 'end'
2071         ;;
2072         (progn
2073           (forward-word 1)
2074           (ada-goto-next-non-ws)
2075           (cond
2076            ;;
2077            ;; loop/select/if/case/record/select
2078            ;;
2079            ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|record\\)\\>")
2080             (save-excursion
2081               (ada-check-matching-start
2082                (buffer-substring (match-beginning 0)
2083                                  (match-end 0)))
2084               (if (looking-at "\\<\\(loop\\|record\\)\\>")
2085                   (progn
2086                     (forward-word 1)
2087                     (ada-goto-stmt-start)))
2088               ;; a label ? => skip it
2089               (if (looking-at ada-named-block-re)
2090                   (progn
2091                     (setq label (- ada-label-indent))
2092                     (goto-char (match-end 0))
2093                     (ada-goto-next-non-ws)))
2094               ;; really looking-at the right thing ?
2095               (or (looking-at (concat "\\<\\("
2096                                       "loop\\|select\\|if\\|case\\|"
2097                                       "record\\|while\\|type\\)\\>"))
2098                   (progn
2099                     (ada-search-ignore-string-comment
2100                      (concat "\\<\\("
2101                              "loop\\|select\\|if\\|case\\|"
2102                              "record\\|while\\|type\\)\\>")))
2103                   (backward-word 1))
2104               (+ (current-indentation) label)))
2105            ;;
2106            ;; a named block end
2107            ;;
2108            ((looking-at ada-ident-re)
2109             (setq defun-name (buffer-substring (match-beginning 0)
2110                                                (match-end 0)))
2111             (save-excursion
2112               (ada-goto-matching-start 0)
2113               (ada-check-defun-name defun-name)
2114               (current-indentation)))
2115            ;;
2116            ;; a block-end without name
2117            ;;
2118            ((looking-at ";")
2119             (save-excursion
2120               (ada-goto-matching-start 0)
2121               (if (looking-at "\\<begin\\>")
2122                   (progn
2123                     (setq indent (current-column))
2124                     (if (ada-goto-matching-decl-start t)
2125                         (current-indentation)
2126                       indent)))))
2127            ;;
2128            ;; anything else - should maybe signal an error ?
2129            ;;
2130            (t
2131             (+ (current-indentation) ada-broken-indent))))
2132
2133       (+ (current-indentation) ada-broken-indent))))
2134
2135
2136 (defun ada-get-indent-case (orgpoint)
2137   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2138   ;; Assumes point to be at the beginning of a case-statement.
2139   (let ((cur-indent (current-indentation))
2140         (match-cons nil)
2141         (opos (point)))
2142     (cond
2143      ;;
2144      ;; case..is..when..=>
2145      ;;
2146      ((save-excursion
2147         (setq match-cons (and
2148                           ;; the `=>' must be after the keyword `is'.
2149                           (ada-search-ignore-string-comment
2150                            "\\<is\\>" nil orgpoint)
2151                           (ada-search-ignore-string-comment
2152                            "[ \t\n]+=>" nil orgpoint))))
2153       (save-excursion
2154         (goto-char (car match-cons))
2155         (if (not (ada-search-ignore-string-comment "\\<when\\>" t opos))
2156             (error "missing 'when' between 'case' and '=>'"))
2157         (+ (current-indentation) ada-indent)))
2158      ;;
2159      ;; case..is..when
2160      ;;
2161      ((save-excursion
2162        (setq match-cons (ada-search-ignore-string-comment
2163                          "\\<when\\>" nil orgpoint)))
2164       (goto-char (cdr match-cons))
2165       (+ (current-indentation) ada-broken-indent))
2166      ;;
2167      ;; case..is
2168      ;;
2169      ((save-excursion
2170        (setq match-cons (ada-search-ignore-string-comment
2171                          "\\<is\\>" nil orgpoint)))
2172       (+ (current-indentation) ada-when-indent))
2173      ;;
2174      ;; incomplete case
2175      ;;
2176      (t
2177       (+ (current-indentation) ada-broken-indent)))))
2178
2179
2180 (defun ada-get-indent-when (orgpoint)
2181   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2182   ;; Assumes point to be at the beginning of an when-statement.
2183   (let ((cur-indent (current-indentation)))
2184     (if (ada-search-ignore-string-comment
2185          "[ \t\n]+=>" nil orgpoint)
2186         (+ cur-indent  ada-indent)
2187       (+ cur-indent ada-broken-indent))))
2188
2189
2190 (defun ada-get-indent-if (orgpoint)
2191   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2192   ;; Assumes point to be at the beginning of an if-statement.
2193   (let ((cur-indent (current-indentation))
2194         (match-cons nil))
2195     ;;
2196     ;; if..then ?
2197     ;;
2198     (if (ada-search-but-not
2199          "\\<then\\>" "\\<and\\>[ \t\n]+\\<then\\>" nil orgpoint)
2200
2201         (progn
2202           ;;
2203           ;; 'then' first in separate line ?
2204           ;; => indent according to 'then'
2205           ;;
2206           (if (save-excursion
2207                 (back-to-indentation)
2208                 (looking-at "\\<then\\>"))
2209               (setq cur-indent (current-indentation)))
2210           (forward-word 1)
2211           ;;
2212           ;; something follows 'then' ?
2213           ;;
2214           (if (setq match-cons
2215                     (ada-search-ignore-string-comment
2216                      "[^ \t\n]" nil orgpoint))
2217               (progn
2218                 (goto-char (car match-cons))
2219                 (+ ada-indent
2220                    (- cur-indent (current-indentation))
2221                    (funcall (ada-indent-function t) orgpoint)))
2222
2223             (+ cur-indent ada-indent)))
2224
2225       (+ cur-indent ada-broken-indent))))
2226
2227
2228 (defun ada-get-indent-block-start (orgpoint)
2229   ;; Returns the indentation (column #) for the new line after
2230   ;; ORGPOINT.  Assumes point to be at the beginning of a block start
2231   ;; keyword.
2232   (let ((cur-indent (current-indentation))
2233         (pos nil))
2234     (cond
2235      ((save-excursion
2236         (forward-word 1)
2237         (setq pos (car (ada-search-ignore-string-comment
2238                         "[^ \t\n]" nil orgpoint))))
2239       (goto-char pos)
2240       (save-excursion
2241         (funcall (ada-indent-function t) orgpoint)))
2242      ;;
2243      ;; nothing follows the block-start
2244      ;;
2245      (t
2246       (+ (current-indentation) ada-indent)))))
2247
2248
2249 (defun ada-get-indent-subprog (orgpoint)
2250   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2251   ;; Assumes point to be at the beginning of a subprog-/package-declaration.
2252   (let ((match-cons nil)
2253         (cur-indent (current-indentation))
2254         (foundis nil)
2255         (addind 0)
2256         (fstart (point)))
2257     ;;
2258     ;; is there an 'is' in front of point ?
2259     ;;
2260     (if (save-excursion
2261           (setq match-cons
2262                 (ada-search-ignore-string-comment
2263                  "\\<\\(is\\|do\\)\\>" nil orgpoint)))
2264         ;;
2265         ;; yes, then skip to its end
2266         ;;
2267         (progn
2268           (setq foundis t)
2269           (goto-char (cdr match-cons)))
2270       ;;
2271       ;; no, then goto next non-ws, if there is one in front of point
2272       ;;
2273       (progn
2274         (if (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)
2275             (ada-goto-next-non-ws)
2276           (goto-char orgpoint))))
2277
2278     (cond
2279      ;;
2280      ;; nothing follows 'is'
2281      ;;
2282      ((and
2283        foundis
2284        (save-excursion
2285          (not (ada-search-ignore-string-comment
2286                "[^ \t\n]" nil orgpoint t))))
2287       (+ cur-indent ada-indent))
2288      ;;
2289      ;; is abstract/separate/new ...
2290      ;;
2291      ((and
2292        foundis
2293        (save-excursion
2294          (setq match-cons
2295                (ada-search-ignore-string-comment
2296                 "\\<\\(separate\\|new\\|abstract\\)\\>"
2297                 nil orgpoint))))
2298       (goto-char (car match-cons))
2299       (ada-search-ignore-string-comment ada-subprog-start-re t)
2300       (ada-get-indent-noindent orgpoint))
2301      ;;
2302      ;; something follows 'is'
2303      ;;
2304      ((and
2305        foundis
2306        (save-excursion
2307          (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
2308        (ada-goto-next-non-ws)
2309       (funcall (ada-indent-function t) orgpoint)))
2310      ;;
2311      ;; no 'is' but ';'
2312      ;;
2313      ((save-excursion
2314         (ada-search-ignore-string-comment ";" nil orgpoint))
2315       cur-indent)
2316      ;;
2317      ;; no 'is' or ';'
2318      ;;
2319      (t
2320       (+ cur-indent ada-broken-indent)))))
2321
2322
2323 (defun ada-get-indent-noindent (orgpoint)
2324   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2325   ;; Assumes point to be at the beginning of a 'noindent statement'.
2326   (let ((label 0))
2327     (save-excursion
2328       (beginning-of-line)
2329       (if (looking-at ada-named-block-re)
2330           (setq label (- ada-label-indent))))
2331     (if (save-excursion
2332           (ada-search-ignore-string-comment ";" nil orgpoint))
2333         (+ (current-indentation) label)
2334       (+ (current-indentation) ada-broken-indent label))))
2335
2336
2337 (defun ada-get-indent-label (orgpoint)
2338   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2339   ;; Assumes point to be at the beginning of a label or variable declaration.
2340   ;; Checks the context to decide if it's a label or a variable declaration.
2341   ;; This check might be a bit slow.
2342   (let ((match-cons nil)
2343         (cur-indent (current-indentation)))
2344     (goto-char (cdr (ada-search-ignore-string-comment ":")))
2345     (cond
2346      ;;
2347      ;; loop label
2348      ;;
2349      ((save-excursion
2350         (setq match-cons (ada-search-ignore-string-comment
2351                           ada-loop-start-re nil orgpoint)))
2352       (goto-char (car match-cons))
2353       (ada-get-indent-loop orgpoint))
2354      ;;
2355      ;; declare label
2356      ;;
2357      ((save-excursion
2358         (setq match-cons (ada-search-ignore-string-comment
2359                           "\\<declare\\|begin\\>" nil orgpoint)))
2360       (save-excursion
2361         (goto-char (car match-cons))
2362         (+ (current-indentation) ada-indent)))
2363      ;;
2364      ;; complete statement following colon
2365      ;;
2366      ((save-excursion
2367         (ada-search-ignore-string-comment ";" nil orgpoint))
2368       (if (ada-in-decl-p)
2369           cur-indent                      ; variable-declaration
2370         (- cur-indent ada-label-indent))) ; label
2371      ;;
2372      ;; broken statement
2373      ;;
2374      ((save-excursion
2375         (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
2376       (if (ada-in-decl-p)
2377           (+ cur-indent ada-broken-indent)
2378         (+ cur-indent ada-broken-indent (- ada-label-indent))))
2379      ;;
2380      ;; nothing follows colon
2381      ;;
2382      (t
2383       (if (ada-in-decl-p)
2384           (+ cur-indent ada-broken-indent)   ; variable-declaration
2385         (- cur-indent ada-label-indent)))))) ; label
2386
2387
2388 (defun ada-get-indent-loop (orgpoint)
2389   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2390   ;; Assumes point to be at the beginning of a loop statement
2391   ;; or (unfortunately) also a for ... use statement.
2392   (let ((match-cons nil)
2393         (pos (point))
2394         (label (save-excursion
2395                  (beginning-of-line)
2396                  (if (looking-at ada-named-block-re)
2397                      (- ada-label-indent)
2398                    0))))
2399
2400     (cond
2401
2402      ;;
2403      ;; statement complete
2404      ;;
2405      ((save-excursion
2406         (ada-search-ignore-string-comment ";" nil orgpoint))
2407       (+ (current-indentation) label))
2408      ;;
2409      ;; simple loop
2410      ;;
2411      ((looking-at "loop\\>")
2412       (+ (ada-get-indent-block-start orgpoint) label))
2413
2414      ;;
2415      ;; 'for'- loop (or also a for ... use statement)
2416      ;;
2417      ((looking-at "for\\>")
2418       (cond
2419        ;;
2420        ;; for ... use
2421        ;;
2422        ((save-excursion
2423           (and
2424            (goto-char (match-end 0))
2425            (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
2426            (not (backward-char 1))
2427            (not (zerop (skip-chars-forward "_a-zA-Z0-9'")))
2428            (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
2429            (not (backward-char 1))
2430            (looking-at "\\<use\\>")
2431            ;;
2432            ;; check if there is a 'record' before point
2433            ;;
2434            (progn
2435              (setq match-cons (ada-search-ignore-string-comment
2436                                "\\<record\\>" nil orgpoint))
2437              t)))
2438         (if match-cons
2439             (goto-char (car match-cons)))
2440         (+ (current-indentation) ada-indent))
2441        ;;
2442        ;; for..loop
2443        ;;
2444        ((save-excursion
2445           (setq match-cons (ada-search-ignore-string-comment
2446                             "\\<loop\\>" nil orgpoint)))
2447         (goto-char (car match-cons))
2448         ;;
2449         ;; indent according to 'loop', if it's first in the line;
2450         ;; otherwise to 'for'
2451         ;;
2452         (if (not (save-excursion
2453                    (back-to-indentation)
2454                    (looking-at "\\<loop\\>")))
2455             (goto-char pos))
2456         (+ (current-indentation) ada-indent label))
2457        ;;
2458        ;; for-statement is broken
2459        ;;
2460        (t
2461         (+ (current-indentation) ada-broken-indent label))))
2462
2463      ;;
2464      ;; 'while'-loop
2465      ;;
2466      ((looking-at "while\\>")
2467       ;;
2468       ;; while..loop ?
2469       ;;
2470       (if (save-excursion
2471             (setq match-cons (ada-search-ignore-string-comment
2472                               "\\<loop\\>" nil orgpoint)))
2473
2474           (progn
2475             (goto-char (car match-cons))
2476             ;;
2477             ;; indent according to 'loop', if it's first in the line;
2478             ;; otherwise to 'while'.
2479             ;;
2480             (if (not (save-excursion
2481                        (back-to-indentation)
2482                        (looking-at "\\<loop\\>")))
2483                 (goto-char pos))
2484             (+ (current-indentation) ada-indent label))
2485
2486         (+ (current-indentation) ada-broken-indent label))))))
2487
2488
2489 (defun ada-get-indent-type (orgpoint)
2490   ;; Returns the indentation (column #) for the new line after ORGPOINT.
2491   ;; Assumes point to be at the beginning of a type statement.
2492   (let ((match-dat nil))
2493     (cond
2494      ;;
2495      ;; complete record declaration
2496      ;;
2497      ((save-excursion
2498         (and
2499          (setq match-dat (ada-search-ignore-string-comment "\\<end\\>"
2500                                                            nil
2501                                                            orgpoint))
2502          (ada-goto-next-non-ws)
2503          (looking-at "\\<record\\>")
2504          (forward-word 1)
2505          (ada-goto-next-non-ws)
2506          (looking-at ";")))
2507       (goto-char (car match-dat))
2508       (current-indentation))
2509      ;;
2510      ;; record type
2511      ;;
2512      ((save-excursion
2513         (setq match-dat (ada-search-ignore-string-comment "\\<record\\>"
2514                                                           nil
2515                                                           orgpoint)))
2516       (goto-char (car match-dat))
2517       (+ (current-indentation) ada-indent))
2518      ;;
2519      ;; complete type declaration
2520      ;;
2521      ((save-excursion
2522         (ada-search-ignore-string-comment ";" nil orgpoint))
2523       (current-indentation))
2524      ;;
2525      ;; "type ... is", but not "type ... is ...", which is broken
2526      ;;
2527      ((save-excursion
2528         (and
2529          (ada-search-ignore-string-comment "\\<is\\>" nil orgpoint)
2530          (not (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))))
2531       (+ (current-indentation) ada-indent))
2532      ;;
2533      ;; broken statement
2534      ;;
2535      (t
2536       (+ (current-indentation) ada-broken-indent)))))
2537
2538 \f
2539 ;;; ---- support-functions for indentation
2540
2541 ;;; ---- searching and matching
2542
2543 (defun ada-goto-stmt-start (&optional limit)
2544   ;; Moves point to the beginning of the statement that point is in or
2545   ;; after.  Returns the new position of point.  Beginnings are found
2546   ;; by searching for 'ada-end-stmt-re' and then moving to the
2547   ;; following non-ws that is not a comment.  LIMIT is actually not
2548   ;; used by the indentation functions.
2549   (let ((match-dat nil)
2550         (orgpoint (point)))
2551
2552     (setq match-dat (ada-search-prev-end-stmt limit))
2553     (if match-dat
2554         ;;
2555         ;; found a previous end-statement => check if anything follows
2556         ;;
2557         (progn
2558           (if (not
2559                (save-excursion
2560                  (goto-char (cdr match-dat))
2561                  (ada-search-ignore-string-comment
2562                   "[^ \t\n]" nil orgpoint)))
2563               ;;
2564               ;; nothing follows => it's the end-statement directly in
2565               ;;                    front of point => search again
2566               ;;
2567               (setq match-dat (ada-search-prev-end-stmt limit)))
2568           ;;
2569           ;; if found the correct end-statement => goto next non-ws
2570           ;;
2571           (if match-dat
2572               (goto-char (cdr match-dat)))
2573           (ada-goto-next-non-ws))
2574
2575       ;;
2576       ;; no previous end-statement => we are at the beginning of the
2577       ;;                              accessible part of the buffer
2578       ;;
2579       (progn
2580         (goto-char (point-min))
2581         ;;
2582         ;; skip to the very first statement, if there is one
2583         ;;
2584         (if (setq match-dat
2585                   (ada-search-ignore-string-comment
2586                    "[^ \t\n]" nil orgpoint))
2587             (goto-char (car match-dat))
2588           (goto-char orgpoint))))
2589
2590
2591     (point)))
2592
2593
2594 (defun ada-search-prev-end-stmt (&optional limit)
2595   ;; Moves point to previous end-statement.  Returns a cons cell whose
2596   ;; car is the beginning and whose cdr the end of the match.
2597   ;; End-statements are defined by 'ada-end-stmt-re'.  Checks for
2598   ;; certain keywords if they follow 'end', which means they are no
2599   ;; end-statement there.
2600   (let ((match-dat nil)
2601         (pos nil)
2602         (found nil))
2603     ;;
2604     ;; search until found or beginning-of-buffer
2605     ;;
2606     (while
2607         (and
2608          (not found)
2609          (setq match-dat (ada-search-ignore-string-comment ada-end-stmt-re
2610                                                            t
2611                                                            limit)))
2612
2613       (goto-char (car match-dat))
2614       (if (not (ada-in-open-paren-p))
2615           ;;
2616           ;; check if there is an 'end' in front of the match
2617           ;;
2618           (if (not (and
2619                     (looking-at
2620                      "\\<\\(record\\|loop\\|select\\|else\\|then\\)\\>")
2621                     (save-excursion
2622                       (ada-goto-previous-word)
2623                       (looking-at "\\<\\(end\\|or\\|and\\)\\>"))))
2624               (save-excursion
2625                 (goto-char (cdr match-dat))
2626                 (ada-goto-next-word)
2627                 (if (not (looking-at "\\<\\(separate\\|new\\)\\>"))
2628                     (setq found t)))
2629
2630             (forward-word -1)))) ; end of loop
2631
2632     (if found
2633         match-dat
2634       nil)))
2635
2636
2637 (defun ada-goto-next-non-ws (&optional limit)
2638   ;; Skips whitespaces, newlines and comments to next non-ws
2639   ;; character.  Signals an error if there is no more such character
2640   ;; and limit is nil.
2641   (let ((match-cons nil))
2642     (setq match-cons (ada-search-ignore-string-comment
2643                       "[^ \t\n]" nil limit t))
2644     (if match-cons
2645         (goto-char (car match-cons))
2646       (if (not limit)
2647           (error "no more non-ws")
2648         nil))))
2649
2650
2651 (defun ada-goto-stmt-end (&optional limit)
2652   ;; Moves point to the end of the statement that point is in or
2653   ;; before.  Returns the new position of point or nil if not found.
2654   (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
2655       (point)
2656     nil))
2657
2658
2659 (defun ada-goto-next-word (&optional backward)
2660   ;; Moves point to the beginning of the next word of Ada code.
2661   ;; If BACKWARD is non-nil, jump to the beginning of the previous word.
2662   ;; Returns the new position of point or nil if not found.
2663   (let ((match-cons nil)
2664         (orgpoint (point)))
2665     (if (not backward)
2666         (skip-chars-forward "_a-zA-Z0-9\\."))
2667     (if (setq match-cons
2668               (ada-search-ignore-string-comment "\\w" backward nil t))
2669         ;;
2670         ;; move to the beginning of the word found
2671         ;;
2672         (progn
2673           (goto-char (car match-cons))
2674           (skip-chars-backward "_a-zA-Z0-9")
2675           (point))
2676       ;;
2677       ;; if not found, restore old position of point
2678       ;;
2679       (progn
2680         (goto-char orgpoint)
2681         'nil))))
2682
2683
2684 (defun ada-goto-previous-word ()
2685   ;; Moves point to the beginning of the previous word of Ada code.
2686   ;; Returns the new position of point or nil if not found.
2687   (ada-goto-next-word t))
2688
2689
2690 (defun ada-check-matching-start (keyword)
2691   ;; Signals an error if matching block start is not KEYWORD.
2692   ;; Moves point to the matching block start.
2693   (ada-goto-matching-start 0)
2694   (if (not (looking-at (concat "\\<" keyword "\\>")))
2695       (error "matching start is not '%s'" keyword)))
2696
2697
2698 (defun ada-check-defun-name (defun-name)
2699   ;; Checks if the name of the matching defun really is DEFUN-NAME.
2700   ;; Assumes point to be already positioned by 'ada-goto-matching-start'.
2701   ;; Moves point to the beginning of the declaration.
2702
2703   ;;
2704   ;; named block without a `declare'
2705   ;;
2706   (if (save-excursion
2707         (ada-goto-previous-word)
2708         (looking-at (concat "\\<" defun-name "\\> *:")))
2709       t ; do nothing
2710     ;;
2711     ;; 'accept' or 'package' ?
2712     ;;
2713     (if (not (looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>"))
2714         (ada-goto-matching-decl-start))
2715     ;;
2716     ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
2717     ;;
2718     (save-excursion
2719       ;;
2720       ;; a named 'declare'-block ?
2721       ;;
2722       (if (looking-at "\\<declare\\>")
2723           (ada-goto-stmt-start)
2724         ;;
2725         ;; no, => 'procedure'/'function'/'task'/'protected'
2726         ;;
2727         (progn
2728           (forward-word 2)
2729           (backward-word 1)
2730           ;;
2731           ;; skip 'body' 'type'
2732           ;;
2733           (if (looking-at "\\<\\(body\\|type\\)\\>")
2734               (forward-word 1))
2735           (forward-sexp 1)
2736           (backward-sexp 1)))
2737       ;;
2738       ;; should be looking-at the correct name
2739       ;;
2740       (if (not (looking-at (concat "\\<" defun-name "\\>")))
2741           (error "matching defun has different name: %s"
2742                  (buffer-substring (point)
2743                                    (progn (forward-sexp 1) (point))))))))
2744
2745
2746 (defun ada-goto-matching-decl-start (&optional noerror nogeneric)
2747   ;; Moves point to the matching declaration start of the current 'begin'.
2748   ;; If NOERROR is non-nil, it only returns nil if no match was found.
2749   (let ((nest-count 1)
2750         (pos nil)
2751         (first t)
2752         (flag nil))
2753     ;;
2754     ;; search backward for interesting keywords
2755     ;;
2756     (while (and
2757             (not (zerop nest-count))
2758             (ada-search-ignore-string-comment
2759              (concat "\\<\\("
2760                      "is\\|separate\\|end\\|declare\\|new\\|begin\\|generic"
2761                      "\\)\\>") t))
2762       ;;
2763       ;; calculate nest-depth
2764       ;;
2765       (cond
2766        ;;
2767        ((looking-at "end")
2768         (ada-goto-matching-start 1 noerror)
2769         (if (looking-at "begin")
2770             (setq nest-count (1+ nest-count))))
2771        ;;
2772        ((looking-at "declare\\|generic")
2773         (setq nest-count (1- nest-count))
2774         (setq first nil))
2775        ;;
2776        ((looking-at "is")
2777         ;; check if it is only a type definition, but not a protected
2778         ;; type definition, which should be handled like a procedure.
2779         (if (or (looking-at "is +<>")
2780                 (save-excursion
2781                   (ada-goto-previous-word)
2782                   (skip-chars-backward "a-zA-Z0-9_.'")
2783                   (if (save-excursion
2784                         (backward-char 1)
2785                         (looking-at ")"))
2786                       (progn
2787                         (forward-char 1)
2788                         (backward-sexp 1)
2789                         (skip-chars-backward "a-zA-Z0-9_.'")
2790                         ))
2791                   (ada-goto-previous-word)
2792                   (and
2793                    (looking-at "\\<type\\>")
2794                    (save-match-data
2795                      (ada-goto-previous-word)
2796                      (not (looking-at "\\<protected\\>"))))
2797                   )); end of `or'
2798             (goto-char (match-beginning 0))
2799           (progn
2800             (setq nest-count (1- nest-count))
2801             (setq first nil))))
2802
2803        ;;
2804        ((looking-at "new")
2805         (if (save-excursion
2806               (ada-goto-previous-word)
2807               (looking-at "is"))
2808             (goto-char (match-beginning 0))))
2809        ;;
2810        ((and first
2811              (looking-at "begin"))
2812         (setq nest-count 0)
2813         (setq flag t))
2814        ;;
2815        (t
2816         (setq nest-count (1+ nest-count))
2817         (setq first nil)))
2818
2819       )  ;; end of loop
2820
2821     ;; check if declaration-start is really found
2822     (if (not
2823          (and
2824           (zerop nest-count)
2825           (not flag)
2826           (if (looking-at "is")
2827               (ada-search-ignore-string-comment ada-subprog-start-re t)
2828             (looking-at "declare\\|generic"))))
2829         (if noerror nil
2830           (error "no matching proc/func/task/declare/package/protected"))
2831       t)))
2832
2833
2834 (defun ada-goto-matching-start (&optional nest-level noerror gotothen)
2835   ;; Moves point to the beginning of a block-start.  Which block
2836   ;; depends on the value of NEST-LEVEL, which defaults to zero.  If
2837   ;; NOERROR is non-nil, it only returns nil if no matching start was
2838   ;; found.  If GOTOTHEN is non-nil, point moves to the 'then'
2839   ;; following 'if'.
2840   (let ((nest-count (if nest-level nest-level 0))
2841         (found nil)
2842         (pos nil))
2843
2844     ;;
2845     ;; search backward for interesting keywords
2846     ;;
2847     (while (and
2848             (not found)
2849             (ada-search-ignore-string-comment
2850              (concat "\\<\\("
2851                      "end\\|loop\\|select\\|begin\\|case\\|do\\|"
2852                      "if\\|task\\|package\\|record\\|protected\\)\\>")
2853              t))
2854
2855       ;;
2856       ;; calculate nest-depth
2857       ;;
2858       (cond
2859        ;; found block end => increase nest depth
2860        ((looking-at "end")
2861         (setq nest-count (1+ nest-count)))
2862        ;; found loop/select/record/case/if => check if it starts or
2863        ;; ends a block
2864        ((looking-at "loop\\|select\\|record\\|case\\|if")
2865         (setq pos (point))
2866         (save-excursion
2867           ;;
2868           ;; check if keyword follows 'end'
2869           ;;
2870           (ada-goto-previous-word)
2871           (if (looking-at "\\<end\\> *[^;]")
2872               ;; it ends a block => increase nest depth
2873               (progn
2874                 (setq nest-count (1+ nest-count))
2875                 (setq pos (point)))
2876             ;; it starts a block => decrease nest depth
2877             (setq nest-count (1- nest-count))))
2878         (goto-char pos))
2879        ;; found package start => check if it really is a block
2880        ((looking-at "package")
2881         (save-excursion
2882           (ada-search-ignore-string-comment "\\<is\\>")
2883           (ada-goto-next-non-ws)
2884           ;; ignore it if it is only a declaration with 'new'
2885           (if (not (looking-at "\\<new\\>"))
2886               (setq nest-count (1- nest-count)))))
2887        ;; found task start => check if it has a body
2888        ((looking-at "task")
2889         (save-excursion
2890           (forward-word 1)
2891           (ada-goto-next-non-ws)
2892           ;; ignore it if it has no body
2893           (if (not (looking-at "\\<body\\>"))
2894               (setq nest-count (1- nest-count)))))
2895        ;; all the other block starts
2896        (t
2897         (setq nest-count (1- nest-count)))) ; end of 'cond'
2898
2899       ;; match is found, if nest-depth is zero
2900       ;;
2901       (setq found (zerop nest-count))) ; end of loop
2902
2903     (if found
2904         ;;
2905         ;; match found => is there anything else to do ?
2906         ;;
2907         (progn
2908           (cond
2909            ;;
2910            ;; found 'if' => skip to 'then', if it's on a separate line
2911            ;;                               and GOTOTHEN is non-nil
2912            ;;
2913            ((and
2914              gotothen
2915              (looking-at "if")
2916              (save-excursion
2917                (ada-search-ignore-string-comment "\\<then\\>" nil nil)
2918                (back-to-indentation)
2919                (looking-at "\\<then\\>")))
2920             (goto-char (match-beginning 0)))
2921            ;;
2922            ;; found 'do' => skip back to 'accept'
2923            ;;
2924            ((looking-at "do")
2925             (if (not (ada-search-ignore-string-comment "\\<accept\\>" t nil))
2926                 (error "missing 'accept' in front of 'do'"))))
2927           (point))
2928
2929       (if noerror
2930           nil
2931         (error "no matching start")))))
2932
2933
2934 (defun ada-goto-matching-end (&optional nest-level noerror)
2935   ;; Moves point to the end of a block.  Which block depends on the
2936   ;; value of NEST-LEVEL, which defaults to zero.  If NOERROR is
2937   ;; non-nil, it only returns nil if found no matching start.
2938   (let ((nest-count (if nest-level nest-level 0))
2939         (found nil))
2940
2941     ;;
2942     ;; search forward for interesting keywords
2943     ;;
2944     (while (and
2945             (not found)
2946             (ada-search-ignore-string-comment
2947              (concat "\\<\\(end\\|loop\\|select\\|begin\\|case\\|"
2948                      "if\\|task\\|package\\|record\\|do\\)\\>")))
2949
2950       ;;
2951       ;; calculate nest-depth
2952       ;;
2953       (backward-word 1)
2954       (cond
2955        ;; found block end => decrease nest depth
2956        ((looking-at "\\<end\\>")
2957         (setq nest-count (1- nest-count))
2958         ;; skip the following keyword
2959         (if (progn
2960               (skip-chars-forward "end")
2961               (ada-goto-next-non-ws)
2962               (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
2963             (forward-word 1)))
2964        ;; found package start => check if it really starts a block
2965        ((looking-at "\\<package\\>")
2966         (ada-search-ignore-string-comment "\\<is\\>")
2967         (ada-goto-next-non-ws)
2968         ;; ignore and skip it if it is only a 'new' package
2969         (if (not (looking-at "\\<new\\>"))
2970             (setq nest-count (1+ nest-count))
2971           (skip-chars-forward "new")))
2972        ;; all the other block starts
2973        (t
2974         (setq nest-count (1+ nest-count))
2975         (forward-word 1))) ; end of 'cond'
2976
2977       ;; match is found, if nest-depth is zero
2978       ;;
2979       (setq found (zerop nest-count))) ; end of loop
2980
2981     (if (not found)
2982         (if noerror
2983             nil
2984           (error "no matching end"))
2985       t)))
2986
2987
2988 (defun ada-forward-sexp-ignore-comment ()
2989   ;; Skips one sexp forward, ignoring comments.
2990   (while (looking-at "[ \t\n]*--")
2991     (skip-chars-forward "[ \t\n]")
2992     (end-of-line))
2993   (forward-sexp 1))
2994
2995
2996 (defun ada-search-ignore-string-comment
2997   (search-re &optional backward limit paramlists)
2998   ;; Regexp-Search for SEARCH-RE, ignoring comments, strings and
2999   ;; parameter lists, if PARAMLISTS is nil. Returns a cons cell of
3000   ;; begin and end of match data or nil, if not found.
3001   (let ((found nil)
3002         (begin nil)
3003         (end nil)
3004         (pos nil)
3005         (search-func
3006          (if backward 're-search-backward
3007            're-search-forward)))
3008
3009     ;;
3010     ;; search until found or end-of-buffer
3011     ;;
3012     (while (and (not found)
3013                 (funcall search-func search-re limit 1))
3014       (setq begin (match-beginning 0))
3015       (setq end (match-end 0))
3016
3017       (cond
3018        ;;
3019        ;; found in comment => skip it
3020        ;;
3021        ((ada-in-comment-p)
3022         (if backward
3023             (progn
3024               (re-search-backward "--" nil 1)
3025               (goto-char (match-beginning 0)))
3026           (forward-line 1)
3027           ;; Used to have (beginning-of-line) here,
3028           ;; but that caused trouble at end of buffer with no newline.
3029           ))
3030        ;;
3031        ;; found in string => skip it
3032        ;;
3033        ((ada-in-string-p)
3034         (if backward
3035             (progn
3036               (re-search-backward "\"" nil 1) ; "\"\\|#" don't treat #
3037               (goto-char (match-beginning 0))))
3038         (re-search-forward "\"" nil 1))
3039        ;;
3040        ;; found character constant => ignore it
3041        ;;
3042        ((save-excursion
3043           (setq pos (- (point) (if backward 1 2)))
3044           (and (char-after pos)
3045                (= (char-after pos) ?')
3046                (= (char-after (+ pos 2)) ?')))
3047         ())
3048        ;;
3049        ;; found a parameter-list but should ignore it => skip it
3050        ;;
3051        ((and (not paramlists)
3052              (ada-in-paramlist-p))
3053         (if backward
3054             (ada-search-ignore-string-comment "(" t nil t)))
3055        ;;
3056        ;; directly in front of a comment => skip it, if searching forward
3057        ;;
3058        ((save-excursion
3059           (goto-char begin)
3060           (looking-at "--"))
3061         (if (not backward)
3062             (progn
3063               (forward-line 1)
3064               (beginning-of-line))))
3065        ;;
3066        ;; found what we were looking for
3067        ;;
3068        (t
3069         (setq found t)))) ; end of loop
3070
3071     (if found
3072         (cons begin end)
3073       nil)))
3074
3075
3076 (defun ada-search-but-not (search-re not-search-re &optional backward limit)
3077   ;; Searches SEARCH-RE, ignoring parts of NOT-SEARCH-RE, strings,
3078   ;; comments and parameter-lists.
3079   (let ((begin nil)
3080         (end nil)
3081         (begin-not nil)
3082         (begin-end nil)
3083         (end-not nil)
3084         (ret-cons nil)
3085         (found nil))
3086
3087     ;;
3088     ;; search until found or end-of-buffer
3089     ;;
3090     (while (and
3091             (not found)
3092             (save-excursion
3093               (setq ret-cons
3094                     (ada-search-ignore-string-comment search-re
3095                                                       backward limit))
3096               (if (consp ret-cons)
3097                   (progn
3098                     (setq begin (car ret-cons))
3099                     (setq end (cdr ret-cons))
3100                     t)
3101                 nil)))
3102
3103       (if (or
3104            ;;
3105            ;; if no NO-SEARCH-RE was found
3106            ;;
3107            (not
3108             (save-excursion
3109               (setq ret-cons
3110                     (ada-search-ignore-string-comment not-search-re
3111                                                       backward nil))
3112               (if (consp ret-cons)
3113                   (progn
3114                     (setq begin-not (car ret-cons))
3115                     (setq end-not (cdr ret-cons))
3116                     t)
3117                 nil)))
3118            ;;
3119            ;;  or this NO-SEARCH-RE is not a part of the SEARCH-RE
3120            ;;  found before.
3121            ;;
3122            (or
3123             (<= end-not begin)
3124             (>= begin-not end)))
3125
3126           (setq found t)
3127
3128         ;;
3129         ;; not found the correct match => skip this match
3130         ;;
3131         (goto-char (if backward
3132                        begin
3133                      end)))) ; end of loop
3134
3135     (if found
3136         (progn
3137           (goto-char begin)
3138           (cons begin end))
3139       nil)))
3140
3141
3142 (defun ada-goto-prev-nonblank-line ( &optional ignore-comment)
3143   ;; Moves point to the beginning of previous non-blank line,
3144   ;; ignoring comments if IGNORE-COMMENT is non-nil.
3145   ;; It returns t if a matching line was found.
3146   (let ((notfound t)
3147         (newpoint nil))
3148
3149     (save-excursion
3150       ;;
3151       ;; backward one line, if there is one
3152       ;;
3153       (if (zerop (forward-line -1))
3154           ;;
3155           ;; there is some kind of previous line
3156           ;;
3157           (progn
3158             (beginning-of-line)
3159             (setq newpoint (point))
3160
3161             ;;
3162             ;; search until found or beginning-of-buffer
3163             ;;
3164             (while (and (setq notfound
3165                               (or (looking-at "[ \t]*$")
3166                                   (and (looking-at "[ \t]*--")
3167                                        ignore-comment)))
3168                         (not (ada-in-limit-line-p)))
3169               (forward-line -1)
3170               ;;(beginning-of-line)
3171               (setq newpoint (point))) ; end of loop
3172
3173             )) ; end of if
3174
3175       ) ; end of save-excursion
3176
3177     (if notfound nil
3178       (progn
3179         (goto-char newpoint)
3180         t))))
3181
3182
3183 (defun ada-goto-next-nonblank-line ( &optional ignore-comment)
3184   ;; Moves point to next non-blank line,
3185   ;; ignoring comments if IGNORE-COMMENT is non-nil.
3186   ;; It returns t if a matching line was found.
3187   (let ((notfound t)
3188         (newpoint nil))
3189
3190     (save-excursion
3191     ;;
3192     ;; forward one line
3193     ;;
3194       (if (zerop (forward-line 1))
3195           ;;
3196           ;; there is some kind of previous line
3197           ;;
3198           (progn
3199             (beginning-of-line)
3200             (setq newpoint (point))
3201
3202             ;;
3203             ;; search until found or end-of-buffer
3204             ;;
3205             (while (and (setq notfound
3206                               (or (looking-at "[ \t]*$")
3207                                   (and (looking-at "[ \t]*--")
3208                                        ignore-comment)))
3209                         (not (ada-in-limit-line-p)))
3210               (forward-line 1)
3211               (beginning-of-line)
3212               (setq newpoint (point))) ; end of loop
3213
3214             )) ; end of if
3215
3216       ) ; end of save-excursion
3217
3218     (if notfound nil
3219       (progn
3220         (goto-char newpoint)
3221         t))))
3222
3223
3224 ;; ---- boolean functions for indentation
3225
3226 (defun ada-in-decl-p ()
3227   ;; Returns t if point is inside a declarative part.
3228   ;; Assumes point to be at the end of a statement.
3229   (or
3230    (ada-in-paramlist-p)
3231    (save-excursion
3232      (ada-goto-matching-decl-start t))))
3233
3234
3235 (defun ada-looking-at-semi-or ()
3236   ;; Returns t if looking-at an 'or' following a semicolon.
3237   (save-excursion
3238     (and (looking-at "\\<or\\>")
3239          (progn
3240            (forward-word 1)
3241            (ada-goto-stmt-start)
3242            (looking-at "\\<or\\>")))))
3243
3244
3245 (defun ada-looking-at-semi-private ()
3246   ;; Returns t if looking-at an 'private' following a semicolon.
3247   (save-excursion
3248     (and (looking-at "\\<private\\>")
3249          (progn
3250            (forward-word 1)
3251            (ada-goto-stmt-start)
3252            (looking-at "\\<private\\>")))))
3253
3254
3255 ;;; make a faster??? ada-in-limit-line-p not using count-lines
3256 (defun ada-in-limit-line-p ()
3257   ;; return t if point is in first or last accessible line.
3258   (or (save-excursion (beginning-of-line) (= (point-min) (point)))
3259       (save-excursion (end-of-line) (= (point-max) (point)))))
3260
3261
3262 (defun ada-in-comment-p ()
3263   ;; Returns t if inside a comment.
3264   (nth 4 (parse-partial-sexp
3265           (save-excursion (beginning-of-line) (point))
3266           (point))))
3267
3268
3269 (defun ada-in-string-p ()
3270   ;; Returns t if point is inside a string
3271   ;; (Taken from pascal-mode.el, modified by MH).
3272   (save-excursion
3273     (and
3274      (nth 3 (parse-partial-sexp
3275              (save-excursion
3276                (beginning-of-line)
3277                (point)) (point)))
3278      ;; check if 'string quote' is only a character constant
3279      (progn
3280        (re-search-backward "\"" nil t) ; `#' is not taken as a string delimiter
3281        (not (= (char-after (1- (point))) ?'))))))
3282
3283
3284 (defun ada-in-string-or-comment-p ()
3285   ;; Returns t if point is inside a string, a comment, or a character constant.
3286   (let ((parse-result (parse-partial-sexp
3287                        (save-excursion (beginning-of-line) (point)) (point))))
3288     (or ;; in-comment-p
3289      (nth 4 parse-result)
3290      ;; in-string-p
3291      (and
3292       (nth 3 parse-result)
3293       ;; check if 'string quote' is only a character constant
3294       (progn
3295         (re-search-backward "\"" nil t) ; `#' not regarded a string delimiter
3296         (not (= (char-after (1- (point))) ?'))))
3297      ;; in-char-const-p
3298      (ada-in-char-const-p))))
3299
3300
3301 (defun ada-in-paramlist-p ()
3302   ;; Returns t if point is inside a parameter-list
3303   ;; following 'function'/'procedure'/'package'.
3304   (save-excursion
3305     (and
3306      (re-search-backward "(\\|)" nil t)
3307      ;; inside parentheses ?
3308      (looking-at "(")
3309      (backward-word 2)
3310      ;; right keyword before parenthesis ?
3311      (looking-at (concat "\\<\\("
3312                          "procedure\\|function\\|body\\|package\\|"
3313                          "task\\|entry\\|accept\\)\\>"))
3314      (re-search-forward ")\\|:" nil t)
3315      ;; at least one ':' inside the parentheses ?
3316      (not (backward-char 1))
3317      (looking-at ":"))))
3318
3319
3320 ;; not really a boolean function ...
3321 (defun ada-in-open-paren-p ()
3322   ;; If point is somewhere behind an open parenthesis not yet closed,
3323   ;; it returns the column # of the first non-ws behind this open
3324   ;; parenthesis, otherwise nil."
3325   (let ((start (if (<= (point) ada-search-paren-char-count-limit)
3326                    (point-min)
3327                  (save-excursion
3328                    (goto-char (- (point) ada-search-paren-char-count-limit))
3329                    (beginning-of-line)
3330                    (point))))
3331         parse-result
3332         (col nil))
3333     (setq parse-result (parse-partial-sexp start (point)))
3334     (if (nth 1 parse-result)
3335         (save-excursion
3336           (goto-char (1+ (nth 1 parse-result)))
3337           (if (save-excursion
3338                 (re-search-forward "[^ \t]" nil 1)
3339                 (backward-char 1)
3340                 (and
3341                  (not (looking-at "\n"))
3342                  (setq col (current-column))))
3343               col
3344             (current-column)))
3345       nil)))
3346
3347
3348 \f
3349 ;;;----------------------;;;
3350 ;;; Behaviour Of TAB Key ;;;
3351 ;;;----------------------;;;
3352
3353 (defun ada-tab ()
3354   "Do indenting or tabbing according to `ada-tab-policy'."
3355   (interactive)
3356   (cond ((eq ada-tab-policy 'indent-and-tab) (error "not implemented"))
3357         ;; ada-indent-and-tab
3358         ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
3359         ((eq ada-tab-policy 'indent-auto) (ada-indent-current))
3360         ((eq ada-tab-policy 'gei) (ada-tab-gei))
3361         ((eq ada-tab-policy 'indent-af) (af-indent-line)) ; GEB
3362         ((eq ada-tab-policy 'always-tab) (error "not implemented"))
3363         ))
3364
3365
3366 (defun ada-untab (arg)
3367   "Delete leading indenting according to `ada-tab-policy'."
3368   (interactive "P")
3369   (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard))
3370         ((eq ada-tab-policy 'indent-af) (backward-delete-char-untabify ; GEB
3371                                          (prefix-numeric-value arg) ; GEB
3372                                          arg)) ; GEB
3373         ((eq ada-tab-policy 'indent-auto) (error "not implemented"))
3374         ((eq ada-tab-policy 'always-tab) (error "not implemented"))
3375         ))
3376
3377
3378 (defun ada-indent-current-function ()
3379   "Ada mode version of the indent-line-function."
3380   (interactive "*")
3381   (let ((starting-point (point-marker)))
3382     (ada-beginning-of-line)
3383     (ada-tab)
3384     (if (< (point) starting-point)
3385         (goto-char starting-point))
3386     (set-marker starting-point nil)
3387     ))
3388
3389
3390 (defun ada-tab-hard ()
3391   "Indent current line to next tab stop."
3392   (interactive)
3393   (save-excursion
3394     (beginning-of-line)
3395     (insert-char ?  ada-indent))
3396   (if (save-excursion (= (point) (progn (beginning-of-line) (point))))
3397       (forward-char ada-indent)))
3398
3399
3400 (defun ada-untab-hard ()
3401   "indent current line to previous tab stop."
3402   (interactive)
3403   (let  ((bol (save-excursion (progn (beginning-of-line) (point))))
3404         (eol (save-excursion (progn (end-of-line) (point)))))
3405     (indent-rigidly bol eol  (- 0 ada-indent))))
3406
3407
3408 \f
3409 ;;;---------------;;;
3410 ;;; Miscellaneous ;;;
3411 ;;;---------------;;;
3412
3413 (defun ada-remove-trailing-spaces  ()
3414  "remove trailing spaces in the whole buffer."
3415   (interactive)
3416   (save-match-data
3417     (save-excursion
3418       (save-restriction
3419         (widen)
3420         (goto-char (point-min))
3421         (while (re-search-forward "[ \t]+$" (point-max) t)
3422           (replace-match "" nil nil))))))
3423
3424
3425 (defun ada-untabify-buffer ()
3426 ;; change all tabs to spaces
3427   (save-excursion
3428     (untabify (point-min) (point-max))
3429     nil))
3430
3431
3432 (defun ada-uncomment-region (beg end)
3433   "delete `comment-start' at the beginning of a line in the region."
3434   (interactive "r")
3435   (comment-region beg end -1))
3436
3437
3438 ;; define a function to support find-file.el if loaded
3439 (defun ada-ff-other-window ()
3440   "Find other file in other window using `ff-find-other-file'."
3441   (interactive)
3442   (and (fboundp 'ff-find-other-file)
3443        (ff-find-other-file t)))
3444
3445 ;; inspired by Laurent.GUERBY@enst-bretagne.fr
3446 (defun ada-gnat-style ()
3447   "Clean up comments, `(' and `,' for GNAT style checking switch."
3448   (interactive)
3449   (save-excursion
3450     (goto-char (point-min))
3451     (while (re-search-forward "-- ?\\([^ -]\\)" nil t)
3452       (replace-match "--  \\1"))
3453     (goto-char (point-min))
3454     (while (re-search-forward "\\>(" nil t)
3455       (replace-match " ("))
3456     (goto-char (point-min))
3457     (while (re-search-forward ",\\<" nil t)
3458       (replace-match ", "))
3459     ))
3460
3461
3462 \f
3463 ;;;-------------------------------;;;
3464 ;;; Moving To Procedures/Packages ;;;
3465 ;;;-------------------------------;;;
3466
3467 (defun ada-next-procedure ()
3468   "Moves point to next procedure."
3469   (interactive)
3470   (end-of-line)
3471   (if (re-search-forward ada-procedure-start-regexp nil t)
3472       (goto-char (match-beginning 1))
3473     (error "No more functions/procedures/tasks")))
3474
3475 (defun ada-previous-procedure ()
3476   "Moves point to previous procedure."
3477   (interactive)
3478   (beginning-of-line)
3479   (if (re-search-backward ada-procedure-start-regexp nil t)
3480       (goto-char (match-beginning 1))
3481     (error "No more functions/procedures/tasks")))
3482
3483 (defun ada-next-package ()
3484   "Moves point to next package."
3485   (interactive)
3486   (end-of-line)
3487   (if (re-search-forward ada-package-start-regexp nil t)
3488       (goto-char (match-beginning 1))
3489     (error "No more packages")))
3490
3491 (defun ada-previous-package ()
3492   "Moves point to previous package."
3493   (interactive)
3494   (beginning-of-line)
3495   (if (re-search-backward ada-package-start-regexp nil t)
3496       (goto-char (match-beginning 1))
3497     (error "No more packages")))
3498
3499 \f
3500 ;;;-----------------------
3501 ;;; define keymap for Ada
3502 ;;;-----------------------
3503
3504 (if (not ada-mode-map)
3505     (progn
3506       (setq ada-mode-map (make-sparse-keymap))
3507
3508       ;; Indentation and Formatting
3509       (define-key ada-mode-map "\C-j"     'ada-indent-newline-indent)
3510       (define-key ada-mode-map "\t"       'ada-tab)
3511       (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region)
3512       (if (ada-xemacs)
3513           (define-key ada-mode-map '(shift tab)    'ada-untab)
3514         (define-key ada-mode-map [S-tab]    'ada-untab))
3515       (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist)
3516       (define-key ada-mode-map "\C-c\C-p" 'ada-call-pretty-printer)
3517 ;;; We don't want to make meta-characters case-specific.
3518 ;;;   (define-key ada-mode-map "\M-Q"     'ada-fill-comment-paragraph-justify)
3519       (define-key ada-mode-map "\M-\C-q"  'ada-fill-comment-paragraph-postfix)
3520
3521       ;; Movement
3522 ;;; It isn't good to redefine these.  What should be done instead?  -- rms.
3523 ;;;   (define-key ada-mode-map "\M-e"     'ada-next-package)
3524 ;;;   (define-key ada-mode-map "\M-a"     'ada-previous-package)
3525       (define-key ada-mode-map "\M-\C-e"  'ada-next-procedure)
3526       (define-key ada-mode-map "\M-\C-a"  'ada-previous-procedure)
3527       (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start)
3528       (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end)
3529
3530       ;; Compilation
3531       (define-key ada-mode-map "\C-c\C-c" 'compile)
3532       (define-key ada-mode-map "\C-c\C-v" 'ada-check-syntax)
3533       (define-key ada-mode-map "\C-c\C-m" 'ada-make-local)
3534
3535       ;; Casing
3536       (define-key ada-mode-map "\C-c\C-r" 'ada-adjust-case-region)
3537       (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer)
3538
3539       (define-key ada-mode-map "\177"     'backward-delete-char-untabify)
3540
3541       ;; Use predefined function of emacs19 for comments (RE)
3542       (define-key ada-mode-map "\C-c;"    'comment-region)
3543       (define-key ada-mode-map "\C-c:"    'ada-uncomment-region)
3544
3545       ;; Change basic functionality
3546
3547       ;; `substitute-key-definition' is not defined equally in Emacs
3548       ;; and XEmacs, you cannot put in an optional 4th parameter in
3549       ;; XEmacs.  I don't think it's necessary, so I leave it out for
3550       ;; Emacs as well.  If you encounter any problems with the
3551       ;; following three functions, please tell me. RE
3552       (mapcar (function (lambda (pair)
3553                           (substitute-key-definition (car pair) (cdr pair)
3554                                                      ada-mode-map)))
3555               '((beginning-of-line      . ada-beginning-of-line)
3556                 (end-of-line            . ada-end-of-line)
3557                 (forward-to-indentation . ada-forward-to-indentation)
3558                 ))
3559       ;; else Emacs
3560       ;;(mapcar (lambda (pair)
3561       ;;             (substitute-key-definition (car pair) (cdr pair)
3562       ;;                                   ada-mode-map global-map))
3563
3564       ))
3565
3566 \f
3567 ;;;-------------------
3568 ;;; define menu 'Ada'
3569 ;;;-------------------
3570
3571 (require 'easymenu)
3572
3573 (defun ada-add-ada-menu ()
3574   "Adds the menu 'Ada' to the menu bar in Ada mode."
3575   (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode."
3576                     '("Ada"
3577                       ["Next Package" ada-next-package t]
3578                       ["Previous Package" ada-previous-package t]
3579                       ["Next Procedure" ada-next-procedure t]
3580                       ["Previous Procedure" ada-previous-procedure t]
3581                       ["Goto Start" ada-move-to-start t]
3582                       ["Goto End" ada-move-to-end t]
3583                       ["------------------" nil nil]
3584                       ["Indent Current Line (TAB)"
3585                        ada-indent-current-function t]
3586                       ["Indent Lines in Region" ada-indent-region t]
3587                       ["Format Parameter List" ada-format-paramlist t]
3588                       ["Pretty Print Buffer" ada-call-pretty-printer t]
3589                       ["------------" nil nil]
3590                       ["Fill Comment Paragraph"
3591                        ada-fill-comment-paragraph t]
3592                       ["Justify Comment Paragraph"
3593                        ada-fill-comment-paragraph-justify t]
3594                       ["Postfix Comment Paragraph"
3595                        ada-fill-comment-paragraph-postfix t]
3596                       ["------------" nil nil]
3597                       ["Adjust Case Region" ada-adjust-case-region t]
3598                       ["Adjust Case Buffer" ada-adjust-case-buffer t]
3599                       ["----------" nil nil]
3600                       ["Comment   Region" comment-region t]
3601                       ["Uncomment Region" ada-uncomment-region t]
3602                       ["----------------" nil nil]
3603                       ["Global Make" compile (fboundp 'compile)]
3604                       ["Local Make" ada-make-local t]
3605                       ["Check Syntax" ada-check-syntax t]
3606                       ["Next Error" next-error (fboundp 'next-error)]
3607                       ["---------------" nil nil]
3608                       ["Index" imenu (fboundp 'imenu)]
3609                       ["--------------" nil nil]
3610                       ["Other File Other Window" ada-ff-other-window
3611                        (fboundp 'ff-find-other-file)]
3612                       ["Other File" ff-find-other-file
3613                        (fboundp 'ff-find-other-file)]))
3614   (if (ada-xemacs) (progn
3615                      (easy-menu-add ada-mode-menu)
3616                      (setq mode-popup-menu (cons "Ada mode" ada-mode-menu)))))
3617
3618
3619 \f
3620 ;;;-------------------------------
3621 ;;; Define Some Support Functions
3622 ;;;-------------------------------
3623
3624 (defun ada-beginning-of-line (&optional arg)
3625   (interactive "P")
3626   (cond
3627    ((eq ada-tab-policy 'indent-af) (af-beginning-of-line arg))
3628    (t (beginning-of-line arg))
3629    ))
3630
3631 (defun ada-end-of-line (&optional arg)
3632   (interactive "P")
3633   (cond
3634    ((eq ada-tab-policy 'indent-af) (af-end-of-line arg))
3635    (t (end-of-line arg))
3636    ))
3637
3638 (defun ada-current-column ()
3639   (cond
3640    ((eq ada-tab-policy 'indent-af) (af-current-column))
3641    (t (current-column))
3642    ))
3643
3644 (defun ada-forward-to-indentation (&optional arg)
3645   (interactive "P")
3646   (cond
3647    ((eq ada-tab-policy 'indent-af) (af-forward-to-indentation arg))
3648    (t (forward-to-indentation arg))
3649    ))
3650
3651 ;;;---------------------------------------------------
3652 ;;; support for find-file.el
3653 ;;;---------------------------------------------------
3654
3655
3656 ;;;###autoload
3657 (defun ada-make-filename-from-adaname (adaname)
3658   "Determine the filename of a package/procedure from its own Ada name."
3659   ;; this is done simply by calling `gnatkr', when we work with GNAT. It
3660   ;; must be a more complex function in other compiler environments.
3661   (interactive "s")
3662   (let (krunch-buf)
3663     (setq krunch-buf (generate-new-buffer "*gkrunch*"))
3664     (save-excursion
3665       (set-buffer krunch-buf)
3666       ;; send adaname to external process `gnatkr'.
3667       (call-process "gnatkr" nil krunch-buf nil
3668                     adaname ada-krunch-args)
3669       ;; fetch output of that process
3670       (setq adaname (buffer-substring
3671                      (point-min)
3672                      (progn
3673                        (goto-char (point-min))
3674                        (end-of-line)
3675                        (point))))
3676       (kill-buffer krunch-buf)))
3677   (setq adaname adaname) ;; can I avoid this statement?
3678   )
3679
3680
3681 ;;; functions for placing the cursor on the corresponding subprogram
3682 (defun ada-which-function-are-we-in ()
3683   "Determine whether we are on a function definition/declaration.
3684 If that is the case remember the name of that function."
3685
3686   (setq ff-function-name nil)
3687
3688   (save-excursion
3689     (if (re-search-backward ada-procedure-start-regexp nil t)
3690         (setq ff-function-name (buffer-substring (match-beginning 0)
3691                                                  (match-end 0)))
3692       ; we didn't find a procedure start, perhaps there is a package
3693       (if (re-search-backward ada-package-start-regexp nil t)
3694           (setq ff-function-name (buffer-substring (match-beginning 0)
3695                                                    (match-end 0)))
3696         ))))
3697
3698
3699 ;;;---------------------------------------------------
3700 ;;; support for font-lock
3701 ;;;---------------------------------------------------
3702
3703 ;; Strings are a real pain in Ada because a single quote character is
3704 ;; overloaded as a string quote and type/instance delimiter.  By default, a
3705 ;; single quote is given punctuation syntax in `ada-mode-syntax-table'.
3706 ;; So, for Font Lock mode purposes, we mark single quotes as having string
3707 ;; syntax when the gods that created Ada determine them to be.  sm.
3708
3709 (defconst ada-font-lock-syntactic-keywords
3710   ;; Mark single quotes as having string quote syntax in 'c' instances.
3711   '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\')))))
3712
3713 (defconst ada-font-lock-keywords-1
3714   (list
3715    ;;
3716    ;; handle "type T is access function return S;"
3717    ;;
3718    (list "\\<\\(function[ \t]+return\\)\\>" '(1 font-lock-keyword-face) )
3719    ;;
3720    ;; accept, entry, function, package (body), protected (body|type),
3721    ;; pragma, procedure, task (body) plus name.
3722    (list (concat
3723           "\\<\\("
3724           "accept\\|"
3725           "entry\\|"
3726           "function\\|"
3727           "package[ \t]+body\\|"
3728           "package\\|"
3729           "pragma\\|"
3730           "procedure\\|"
3731           "protected[ \t]+body\\|"
3732           "protected[ \t]+type\\|"
3733           "protected\\|"
3734 ;;        "p\\(\\(ackage\\|rotected\\)\\(\\|[ \t]+\\(body\\|type\\)\\)\
3735 ;;\\|r\\(agma\\|ocedure\\)\\)\\|"
3736           "task[ \t]+body\\|"
3737           "task[ \t]+type\\|"
3738           "task"
3739 ;;        "task\\(\\|[ \t]+body\\)"
3740           "\\)\\>[ \t]*"
3741           "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
3742     '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t)))
3743   "Subdued level highlighting for Ada mode.")
3744
3745 (defconst ada-font-lock-keywords-2
3746   (append ada-font-lock-keywords-1
3747    (list
3748     ;;
3749     ;; Main keywords, except those treated specially below.
3750     (concat "\\<\\("
3751 ;    ("abort" "abs" "abstract" "accept" "access" "aliased" "all"
3752 ;     "and" "array" "at" "begin" "case" "declare" "delay" "delta"
3753 ;     "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
3754 ;     "generic" "if" "in" "is" "limited" "loop" "mod" "not"
3755 ;     "null" "or" "others" "private" "protected"
3756 ;     "range" "record" "rem" "renames" "requeue" "return" "reverse"
3757 ;     "select" "separate" "tagged" "task" "terminate" "then" "until"
3758 ;     "while" "xor")
3759             "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|"
3760             "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|"
3761             "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|"
3762             "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|"
3763             "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|"
3764             "o\\(r\\|thers\\|ut\\)\\|pr\\(ivate\\|otected\\)\\|"
3765             "r\\(a\\(ise\\|nge\\)\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
3766             "se\\(lect\\|parate\\)\\|"
3767             "t\\(agged\\|erminate\\|hen\\)\\|until\\|" ; task removed
3768             "wh\\(ile\\|en\\)\\|xor" ; "when" added
3769             "\\)\\>")
3770     ;;
3771     ;; Anything following end and not already fontified is a body name.
3772     '("\\<\\(end\\)\\>\\([ \t]+\\)?\\([a-zA-Z0-9_\\.]+\\)?"
3773       (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
3774     ;;
3775     ;; Variable name plus optional keywords followed by a type name.  Slow.
3776 ;    (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:?[ \t]*"
3777 ;                 "\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*"
3778 ;                 "\\(\\sw+\\)?")
3779 ;         '(1 font-lock-variable-name-face)
3780 ;         '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t))
3781     ;;
3782     ;; Optional keywords followed by a type name.
3783     (list (concat ; ":[ \t]*"
3784                   "\\<\\(access\\|constant\\|in[ \t]+out\\|in\\|out\\)\\>"
3785                   "[ \t]*"
3786                   "\\(\\sw+\\)?")
3787           '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
3788     ;;
3789     ;; Keywords followed by a type or function name.
3790     (list (concat "\\<\\("
3791                   "new\\|of\\|subtype\\|type"
3792                   "\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*\\((\\)?")
3793           '(1 font-lock-keyword-face)
3794           '(2 (if (match-beginning 4)
3795                   font-lock-function-name-face
3796                 font-lock-type-face) nil t))
3797     ;;
3798     ;; Keywords followed by a (comma separated list of) reference.
3799     (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)\\>" ; "when" removed
3800                   ; "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?") ; RE
3801                   "[ \t]*\\([a-zA-Z0-9_\\.\\|, ]+\\)\\W")
3802           '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t))
3803     ;;
3804     ;; Goto tags.
3805     '("<<\\(\\sw+\\)>>" 1 font-lock-constant-face)
3806     ))
3807   "Gaudy level highlighting for Ada mode.")
3808
3809 (defvar ada-font-lock-keywords ada-font-lock-keywords-1
3810   "Default expressions to highlight in Ada mode.")
3811
3812
3813 ;; set font-lock properties for XEmacs
3814 (if (ada-xemacs)
3815     (put 'ada-mode 'font-lock-defaults
3816          '(ada-font-lock-keywords
3817            nil t ((?\_ . "w")(?\. . "w")) beginning-of-line)))
3818
3819 ;;;
3820 ;;; support for outline
3821 ;;;
3822
3823 ;; used by outline-minor-mode
3824 (defun ada-outline-level ()
3825   ;; This so that `current-column' DTRT in otherwise-hidden text.
3826   (let (buffer-invisibility-spec)
3827     (save-excursion
3828       (skip-chars-forward "\t ")
3829       (current-column))))
3830
3831 ;;;
3832 ;;; generate body
3833 ;;;
3834 (defun ada-gen-comment-until-proc ()
3835   ;; comment until spec of a procedure or a function.
3836   (forward-line 1)
3837   (set-mark-command (point))
3838   (if (re-search-forward ada-procedure-start-regexp nil t)
3839       (progn (goto-char (match-beginning 1))
3840              (comment-region (mark) (point)))
3841     (error "No more functions/procedures")))
3842
3843
3844 (defun ada-gen-treat-proc (match)
3845   ;; make dummy body of a procedure/function specification.
3846   ;; MATCH is a cons cell containing the start and end location of the
3847   ;; last search for ada-procedure-start-regexp.
3848   (goto-char (car match))
3849   (let (proc-found func-found procname functype)
3850     (cond
3851      ((or (setq proc-found (looking-at "^[ \t]*procedure"))
3852           (setq func-found (looking-at "^[ \t]*function")))
3853       ;; treat it as a proc/func
3854       (forward-word 2)
3855       (forward-word -1)
3856       (setq procname (buffer-substring (point) (cdr match))) ; store  proc name
3857
3858     ;; goto end of procname
3859     (goto-char (cdr match))
3860
3861     ;; skip over parameterlist
3862     (forward-sexp)
3863     ;; if function, skip over 'return' and result type.
3864     (if func-found
3865         (progn
3866           (forward-word 1)
3867           (skip-chars-forward " \t\n")
3868           (setq functype (buffer-substring (point)
3869                                            (progn
3870                                              (skip-chars-forward
3871                                               "a-zA-Z0-9_\.")
3872                                              (point))))))
3873     ;; look for next non WS
3874     (cond
3875      ((looking-at "[ \t]*;")
3876       (delete-region (match-beginning 0) (match-end 0)) ;; delete the ';'
3877       (ada-indent-newline-indent)
3878       (insert " is")
3879       (ada-indent-newline-indent)
3880       (if func-found
3881           (progn
3882             (insert "Result : ")
3883             (insert functype)
3884             (insert ";")
3885             (ada-indent-newline-indent)))
3886       (insert "begin -- ")
3887       (insert procname)
3888       (ada-indent-newline-indent)
3889       (insert "null;")
3890       (ada-indent-newline-indent)
3891       (if func-found
3892           (progn
3893             (insert "return Result;")
3894             (ada-indent-newline-indent)))
3895       (insert "end ")
3896       (insert procname)
3897       (insert ";")
3898       (ada-indent-newline-indent)
3899       )
3900       ;; else
3901      ((looking-at "[ \t\n]*is")
3902       ;; do nothing
3903       )
3904      ((looking-at "[ \t\n]*rename")
3905       ;; do nothing
3906       )
3907      (t
3908       (message "unknown syntax")))
3909     ))))
3910
3911
3912 (defun ada-make-body ()
3913   "Create an Ada package body in the current buffer.
3914 The potential old buffer contents is deleted first, then we copy the
3915 spec buffer in here and modify it to make it a body.
3916
3917 This function typically is to be hooked into `ff-file-created-hooks'."
3918   (interactive)
3919   (delete-region (point-min) (point-max))
3920   (insert-buffer (car (cdr (buffer-list))))
3921   (ada-mode)
3922
3923   (let (found)
3924     (if (setq found
3925               (ada-search-ignore-string-comment ada-package-start-regexp))
3926         (progn (goto-char (cdr found))
3927                (insert " body")
3928                ;; (forward-line -1)
3929                ;;(comment-region (point-min) (point))
3930                )
3931       (error "No package"))
3932
3933     ;; (comment-until-proc)
3934     ;;   does not work correctly
3935     ;;   must be done by hand
3936
3937     (while (setq found
3938                  (ada-search-ignore-string-comment ada-procedure-start-regexp))
3939       (ada-gen-treat-proc found))))
3940
3941
3942 ;;; provide ourself
3943
3944 (provide 'ada-mode)
3945
3946 ;;; ada-mode.el ends here