lisp/ada.el

   1 ;;; ada.el --- Ada editing support package in GNUlisp.  v1.0
   2
   3 ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
   4
   5 ;; Author: Vincent Broman <broman@bugs.nosc.mil>
   6 ;; Keywords: languages
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; Created May 1987.
  27 ;; (borrows heavily from Mick Jordan's Modula-2 package for GNU,
  28 ;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
  29
  30 ;;; Code:
  31
  32 (defvar ada-mode-syntax-table nil
  33   "Syntax table in use in Ada-mode buffers.")
  34
  35 (let ((table (make-syntax-table)))
  36   (modify-syntax-entry ?_ "_" table)
  37   (modify-syntax-entry ?\# "_" table)
  38   (modify-syntax-entry ?\( "()" table)
  39   (modify-syntax-entry ?\) ")(" table)
  40   (modify-syntax-entry ?$ "." table)
  41   (modify-syntax-entry ?* "." table)
  42   (modify-syntax-entry ?/ "." table)
  43   (modify-syntax-entry ?+ "." table)
  44   (modify-syntax-entry ?- ". 12" table)
  45   (modify-syntax-entry ?= "." table)
  46   (modify-syntax-entry ?\& "." table)
  47   (modify-syntax-entry ?\| "." table)
  48   (modify-syntax-entry ?< "." table)
  49   (modify-syntax-entry ?> "." table)
  50   (modify-syntax-entry ?\[ "." table)
  51   (modify-syntax-entry ?\] "." table)
  52   (modify-syntax-entry ?\{ "." table)
  53   (modify-syntax-entry ?\} "." table)
  54   (modify-syntax-entry ?. "." table)
  55   (modify-syntax-entry ?\\ "." table)
  56   (modify-syntax-entry ?: "." table)
  57   (modify-syntax-entry ?\; "." table)
  58   (modify-syntax-entry ?\' "." table)
  59   (modify-syntax-entry ?\" "\"" table)
  60   (modify-syntax-entry ?\n ">" table)
  61   (setq ada-mode-syntax-table table))
  62
  63 ;; Strings are a real pain in Ada because both ' and " can appear in a
  64 ;; non-string quote context (the former as an operator, the latter as a
  65 ;; character string).  We follow the least losing solution, in which only " is
  66 ;; a string quote.  Therefore a character string of the form '"' will throw
  67 ;; fontification off on the wrong track.
  68
  69 (defconst ada-font-lock-keywords-1
  70   (list
  71    ;;
  72    ;; Function, package (body), pragma, procedure, task (body) plus name.
  73    (list (concat "\\<\\("
  74                  "function\\|"
  75                  "p\\(ackage\\(\\|[ \t]+body\\)\\|r\\(agma\\|ocedure\\)\\)\\|"
  76                  "task\\(\\|[ \t]+body\\)"
  77                  "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
  78          '(1 font-lock-keyword-face) '(6 font-lock-function-name-face nil t)))
  79   "For consideration as a value of `ada-font-lock-keywords'.
  80 This does fairly subdued highlighting.")
  81
  82 (defconst ada-font-lock-keywords-2
  83   (append ada-font-lock-keywords-1
  84    (list
  85     ;;
  86     ;; Main keywords, except those treated specially below.
  87     (concat "\\<\\("
  88 ;    ("abort" "abs" "abstract" "accept" "access" "aliased" "all"
  89 ;     "and" "array" "at" "begin" "case" "declare" "delay" "delta"
  90 ;     "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
  91 ;     "generic" "if" "in" "is" "limited" "loop" "mod" "not"
  92 ;     "null" "or" "others" "private" "protected"
  93 ;     "range" "record" "rem" "renames" "requeue" "return" "reverse"
  94 ;     "select" "separate" "tagged" "task" "terminate" "then" "until"
  95 ;     "while" "xor")
  96             "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|"
  97             "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|"
  98             "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|"
  99             "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|"
 100             "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|"
 101             "o\\(r\\|thers\\)\\|pr\\(ivate\\|otected\\)\\|"
 102             "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
 103             "se\\(lect\\|parate\\)\\|"
 104             "t\\(a\\(gged\\|sk\\)\\|erminate\\|hen\\)\\|until\\|while\\|xor"
 105             "\\)\\>")
 106     ;;
 107     ;; Anything following end and not already fontified is a body name.
 108     '("\\<\\(end\\)\\>[ \t]*\\(\\sw+\\)?"
 109       (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
 110 ;    ;;
 111 ;    ;; Variable name plus optional keywords followed by a type name.  Slow.
 112 ;    (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:"
 113 ;                 "[ \t]*\\(constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*"
 114 ;                 "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
 115 ;         '(1 font-lock-variable-name-face)
 116 ;         '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t))
 117     ;;
 118     ;; Optional keywords followed by a type name.
 119     (list (concat ":[ \t]*\\<\\(constant\\|in\\|in[ \t]+out\\|out\\)\\>?[ \t]*"
 120                   "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
 121           '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
 122     ;;
 123     ;; Keywords followed by a type or function name.
 124     (list (concat "\\<\\("
 125                   "new\\|of\\|subtype\\|type"
 126                   "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?")
 127           '(1 font-lock-keyword-face)
 128           '(2 (if (match-beginning 4)
 129                   font-lock-function-name-face
 130                 font-lock-type-face) nil t))
 131     ;;
 132     ;; Keywords followed by a reference.
 133     (list (concat "\\<\\(goto\\|raise\\|use\\|when\\|with\\)\\>"
 134                   "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
 135           '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
 136     ;;
 137     ;; Goto tags.
 138     '("<<\\(\\sw+\\(\\.\\sw*\\)*\\)>>" 1 font-lock-reference-face)
 139     ))
 140   "For consideration as a value of `ada-font-lock-keywords'.
 141 This does a lot more highlighting.")
 142
 143 (defvar ada-font-lock-keywords (if font-lock-maximum-decoration
 144                                    ada-font-lock-keywords-2
 145                                  ada-font-lock-keywords-1)
 146   "Additional expressions to highlight in Ada mode.")
 147
 148 (defvar ada-mode-map nil
 149   "Keymap used in Ada mode.")
 150
 151 (let ((map (make-sparse-keymap)))
 152   (define-key map "\C-m" 'ada-newline)
 153   (define-key map "\C-?" 'backward-delete-char-untabify)
 154   (define-key map "\C-i" 'ada-tab)
 155   (define-key map "\C-c\C-i" 'ada-untab)
 156   (define-key map "\C-c<" 'ada-backward-to-same-indent)
 157   (define-key map "\C-c>" 'ada-forward-to-same-indent)
 158   (define-key map "\C-ch" 'ada-header)
 159   (define-key map "\C-c(" 'ada-paired-parens)
 160   (define-key map "\C-c-" 'ada-inline-comment)
 161   (define-key map "\C-c\C-a" 'ada-array)
 162   (define-key map "\C-cb" 'ada-exception-block)
 163   (define-key map "\C-cd" 'ada-declare-block)
 164   (define-key map "\C-c\C-e" 'ada-exception)
 165   (define-key map "\C-cc" 'ada-case)
 166   (define-key map "\C-c\C-k" 'ada-package-spec)
 167   (define-key map "\C-ck" 'ada-package-body)
 168   (define-key map "\C-c\C-p" 'ada-procedure-spec)
 169   (define-key map "\C-cp" 'ada-subprogram-body)
 170   (define-key map "\C-c\C-f" 'ada-function-spec)
 171   (define-key map "\C-cf" 'ada-for-loop)
 172   (define-key map "\C-cl" 'ada-loop)
 173   (define-key map "\C-ci" 'ada-if)
 174   (define-key map "\C-cI" 'ada-elsif)
 175   (define-key map "\C-ce" 'ada-else)
 176   (define-key map "\C-c\C-v" 'ada-private)
 177   (define-key map "\C-c\C-r" 'ada-record)
 178   (define-key map "\C-c\C-s" 'ada-subtype)
 179   (define-key map "\C-cs" 'ada-separate)
 180   (define-key map "\C-c\C-t" 'ada-type)
 181   (define-key map "\C-ct" 'ada-tabsize)
 182 ;;    (define-key map "\C-c\C-u" 'ada-use)
 183 ;;    (define-key map "\C-c\C-w" 'ada-with)
 184   (define-key map "\C-cw" 'ada-while-loop)
 185   (define-key map "\C-c\C-w" 'ada-when)
 186   (define-key map "\C-cx" 'ada-exit)
 187   (define-key map "\C-cC" 'ada-compile)
 188   (define-key map "\C-cB" 'ada-bind)
 189   (define-key map "\C-cE" 'ada-find-listing)
 190   (define-key map "\C-cL" 'ada-library-name)
 191   (define-key map "\C-cO" 'ada-options-for-bind)
 192   (setq ada-mode-map map))
 193
 194 (defvar ada-indent 4 "*Value is the number of columns to indent in Ada-Mode.")
 195
 196 (defvar ada-comment-end-column)
 197
 198 (defun ada-mode ()
 199 "This is a mode intended to support program development in Ada.
 200 Most control constructs and declarations of Ada can be inserted in the buffer
 201 by typing Control-C followed by a character mnemonic for the construct.
 202
 203 \\<ada-mode-map>\\[ada-array] array             \\[ada-exception-block]    exception block
 204 \\[ada-exception]  exception      \\[ada-declare-block]    declare block
 205 \\[ada-package-spec]  package spec   \\[ada-package-body]    package body
 206 \\[ada-procedure-spec]  procedure spec \\[ada-subprogram-body]    proc/func body
 207 \\[ada-function-spec]  func spec      \\[ada-for-loop]    for loop
 208                         \\[ada-if]    if
 209                         \\[ada-elsif]    elsif
 210                         \\[ada-else]    else
 211 \\[ada-private]  private        \\[ada-loop]    loop
 212 \\[ada-record]  record         \\[ada-case]    case
 213 \\[ada-subtype]  subtype        \\[ada-separate]    separate
 214 \\[ada-type]  type           \\[ada-tabsize]    tab spacing for indents
 215 \\[ada-when]  when           \\[ada-while]    while
 216                         \\[ada-exit]    exit
 217 \\[ada-paired-parens]    paired parens  \\[ada-inline-comment]    inline comment
 218                         \\[ada-header]    header spec
 219 \\[ada-compile]    compile        \\[ada-bind]    bind
 220 \\[ada-find-listing]    find error list
 221 \\[ada-library-name]    name library   \\[ada-options-for-bind]    options for bind
 222
 223 \\[ada-backward-to-same-indent] and \\[ada-forward-to-same-indent] move backward and forward respectively to the next line
 224 having the same (or lesser) level of indentation.
 225
 226 Variable `ada-indent' controls the number of spaces for indent/undent."
 227   (interactive)
 228   (kill-all-local-variables)
 229   (use-local-map ada-mode-map)
 230   (setq major-mode 'ada-mode)
 231   (setq mode-name "Ada")
 232   (make-local-variable 'comment-column)
 233   (setq comment-column 41)
 234   (make-local-variable 'ada-comment-end-column)
 235   (setq ada-comment-end-column 72)
 236   (set-syntax-table ada-mode-syntax-table)
 237   (make-local-variable 'paragraph-start)
 238   (setq paragraph-start (concat "$\\|" page-delimiter))
 239   (make-local-variable 'paragraph-separate)
 240   (setq paragraph-separate paragraph-start)
 241   (make-local-variable 'paragraph-ignore-fill-prefix)
 242   (setq paragraph-ignore-fill-prefix t)
 243 ;  (make-local-variable 'indent-line-function)
 244 ;  (setq indent-line-function 'c-indent-line)
 245   (make-local-variable 'require-final-newline)
 246   (setq require-final-newline t)
 247   (make-local-variable 'comment-start)
 248   (setq comment-start "--")
 249   (make-local-variable 'comment-end)
 250   (setq comment-end "")
 251   (make-local-variable 'comment-column)
 252   (setq comment-column 41)
 253   (make-local-variable 'comment-start-skip)
 254   (setq comment-start-skip "--+ *")
 255   (make-local-variable 'comment-indent-function)
 256   (setq comment-indent-function 'c-comment-indent)
 257   (make-local-variable 'parse-sexp-ignore-comments)
 258   (setq parse-sexp-ignore-comments t)
 259   (make-local-variable 'font-lock-defaults)
 260   (setq font-lock-defaults '(ada-font-lock-keywords nil t ((?\_ . "w"))))
 261   (run-hooks 'ada-mode-hook))
 262
 263 (defun ada-tabsize (s)
 264   "Changes spacing used for indentation.
 265 The prefix argument is used as the new spacing."
 266   (interactive "p")
 267   (setq ada-indent s))
 268
 269 (defun ada-newline ()
 270   "Start new line and indent to current tab stop."
 271   (interactive)
 272   (let ((ada-cc (current-indentation)))
 273     (newline)
 274     (indent-to ada-cc)))
 275
 276 (defun ada-tab ()
 277   "Indent to next tab stop."
 278   (interactive)
 279   (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent)))
 280
 281 (defun ada-untab ()
 282   "Delete backwards to previous tab stop."
 283   (interactive)
 284   (backward-delete-char-untabify ada-indent nil))
 285
 286 (defun ada-go-to-this-indent (step indent-level)
 287   "Move point repeatedly by STEP lines until the current line has
 288 given INDENT-LEVEL or less, or the start or end of the buffer is reached.
 289 Ignore blank lines, statement labels and block or loop names."
 290   (while (and
 291           (zerop (forward-line step))
 292           (or (looking-at "^[   ]*$")
 293               (looking-at "^[   ]*--")
 294               (looking-at "^<<[A-Za-z0-9_]+>>")
 295               (looking-at "^[A-Za-z0-9_]+:")
 296               (> (current-indentation) indent-level)))
 297     nil))
 298
 299 (defun ada-backward-to-same-indent ()
 300   "Move point backwards to nearest line with same indentation or less.
 301 If not found, point is left at the top of the buffer."
 302   (interactive)
 303   (ada-go-to-this-indent -1 (current-indentation))
 304   (back-to-indentation))
 305
 306 (defun ada-forward-to-same-indent ()
 307   "Move point forwards to nearest line with same indentation or less.
 308 If not found, point is left at the start of the last line in the buffer."
 309   (interactive)
 310   (ada-go-to-this-indent 1 (current-indentation))
 311   (back-to-indentation))
 312
 313 (defun ada-array ()
 314   "Insert array type definition.  Uses the minibuffer to prompt
 315 for component type and index subtypes."
 316   (interactive)
 317   (insert "array ()")
 318   (backward-char)
 319   (insert (read-string "index subtype[s]: "))
 320   (end-of-line)
 321   (insert " of ;")
 322   (backward-char)
 323   (insert (read-string "component-type: "))
 324   (end-of-line))
 325
 326 (defun ada-case ()
 327   "Build skeleton case statement.
 328 Uses the minibuffer to prompt for the selector expression.
 329 Also builds the first when clause."
 330   (interactive)
 331   (insert "case ")
 332   (insert (read-string "selector expression: ") " is")
 333   (ada-newline)
 334   (ada-newline)
 335   (insert "end case;")
 336   (end-of-line 0)
 337   (ada-tab)
 338   (ada-tab)
 339   (ada-when))
 340
 341 (defun ada-declare-block ()
 342   "Insert a block with a declare part.
 343 Indent for the first declaration."
 344   (interactive)
 345   (let ((ada-block-name (read-string "[block name]: ")))
 346     (insert "declare")
 347     (cond
 348      ( (not (string-equal ada-block-name ""))
 349        (beginning-of-line)
 350        (open-line 1)
 351        (insert ada-block-name ":")
 352        (next-line 1)
 353        (end-of-line)))
 354     (ada-newline)
 355     (ada-newline)
 356     (insert "begin")
 357     (ada-newline)
 358     (ada-newline)
 359     (if (string-equal ada-block-name "")
 360         (insert "end;")
 361       (insert "end " ada-block-name ";"))
 362     )
 363   (end-of-line -2)
 364   (ada-tab))
 365
 366 (defun ada-exception-block ()
 367   "Insert a block with an exception part.
 368 Indent for the first line of code."
 369   (interactive)
 370   (let ((block-name (read-string "[block name]: ")))
 371     (insert "begin")
 372     (cond
 373      ( (not (string-equal block-name ""))
 374        (beginning-of-line)
 375        (open-line 1)
 376        (insert block-name ":")
 377        (next-line 1)
 378        (end-of-line)))
 379     (ada-newline)
 380     (ada-newline)
 381     (insert "exception")
 382     (ada-newline)
 383     (ada-newline)
 384     (cond
 385      ( (string-equal block-name "")
 386        (insert "end;"))
 387      ( t
 388        (insert "end " block-name ";")))
 389     )
 390   (end-of-line -2)
 391   (ada-tab))
 392
 393 (defun ada-exception ()
 394   "Insert an indented exception part into a block."
 395   (interactive)
 396   (ada-untab)
 397   (insert "exception")
 398   (ada-newline)
 399   (ada-tab))
 400
 401 (defun ada-else ()
 402   "Add an else clause inside an if-then-end-if clause."
 403   (interactive)
 404   (ada-untab)
 405   (insert "else")
 406   (ada-newline)
 407   (ada-tab))
 408
 409 (defun ada-exit ()
 410   "Insert an exit statement, prompting for loop name and condition."
 411   (interactive)
 412   (insert "exit")
 413   (let ((ada-loop-name (read-string "[name of loop to exit]: ")))
 414     (if (not (string-equal ada-loop-name "")) (insert " " ada-loop-name)))
 415   (let ((ada-exit-condition (read-string "[exit condition]: ")))
 416     (if (not (string-equal ada-exit-condition ""))
 417         (if (string-match "^ *[Ww][Hh][Ee][Nn] +" ada-exit-condition)
 418             (insert " " ada-exit-condition)
 419           (insert " when " ada-exit-condition))))
 420   (insert ";"))
 421
 422 (defun ada-when ()
 423   "Start a case statement alternative with a when clause."
 424   (interactive)
 425   (ada-untab)     ; we were indented in code for the last alternative.
 426   (insert "when ")
 427   (insert (read-string "'|'-delimited choice list: ") " =>")
 428   (ada-newline)
 429   (ada-tab))
 430
 431 (defun ada-for-loop ()
 432   "Build a skeleton for-loop statement, prompting for the loop parameters."
 433   (interactive)
 434   (insert "for ")
 435   (let* ((ada-loop-name (read-string "[loop name]: "))
 436          (ada-loop-is-named (not (string-equal ada-loop-name ""))))
 437     (if ada-loop-is-named
 438         (progn
 439           (beginning-of-line)
 440           (open-line 1)
 441           (insert ada-loop-name ":")
 442           (next-line 1)
 443           (end-of-line 1)))
 444     (insert (read-string "loop variable: ") " in ")
 445     (insert (read-string "range: ") " loop")
 446     (ada-newline)
 447     (ada-newline)
 448     (insert "end loop")
 449     (if ada-loop-is-named (insert " " ada-loop-name))
 450     (insert ";"))
 451   (end-of-line 0)
 452   (ada-tab))
 453
 454 (defun ada-header ()
 455   "Insert a comment block containing the module title, author, etc."
 456   (interactive)
 457   (insert "--\n--  Title: \t")
 458   (insert (read-string "Title: "))
 459   (insert "\n--  Created:\t" (current-time-string))
 460   (insert "\n--  Author: \t" (user-full-name))
 461   (insert "\n--\t\t<" (user-login-name) "@" (system-name) ">\n--\n"))
 462
 463 (defun ada-if ()
 464   "Insert skeleton if statment, prompting for a boolean-expression."
 465   (interactive)
 466   (insert "if ")
 467   (insert (read-string "condition: ") " then")
 468   (ada-newline)
 469   (ada-newline)
 470   (insert "end if;")
 471   (end-of-line 0)
 472   (ada-tab))
 473
 474 (defun ada-elsif ()
 475   "Add an elsif clause to an if statement, prompting for the boolean-expression."
 476   (interactive)
 477   (ada-untab)
 478   (insert "elsif ")
 479   (insert (read-string "condition: ") " then")
 480   (ada-newline)
 481   (ada-tab))
 482
 483 (defun ada-loop ()
 484   "Insert a skeleton loop statement.  The exit statement is added by hand."
 485   (interactive)
 486   (insert "loop ")
 487   (let* ((ada-loop-name (read-string "[loop name]: "))
 488          (ada-loop-is-named (not (string-equal ada-loop-name ""))))
 489     (if ada-loop-is-named
 490         (progn
 491           (beginning-of-line)
 492           (open-line 1)
 493           (insert ada-loop-name ":")
 494           (forward-line 1)
 495           (end-of-line 1)))
 496     (ada-newline)
 497     (ada-newline)
 498     (insert "end loop")
 499     (if ada-loop-is-named (insert " " ada-loop-name))
 500     (insert ";"))
 501   (end-of-line 0)
 502   (ada-tab))
 503
 504 (defun ada-package-spec ()
 505   "Insert a skeleton package specification."
 506   (interactive)
 507   (insert "package ")
 508   (let ((ada-package-name (read-string "package name: " )))
 509     (insert ada-package-name " is")
 510     (ada-newline)
 511     (ada-newline)
 512     (insert "end " ada-package-name ";")
 513     (end-of-line 0)
 514     (ada-tab)))
 515
 516 (defun ada-package-body ()
 517   "Insert a skeleton package body --  includes a begin statement."
 518   (interactive)
 519   (insert "package body ")
 520   (let ((ada-package-name (read-string "package name: " )))
 521     (insert ada-package-name " is")
 522     (ada-newline)
 523     (ada-newline)
 524     (insert "begin")
 525     (ada-newline)
 526     (insert "end " ada-package-name ";")
 527     (end-of-line -1)
 528     (ada-tab)))
 529
 530 (defun ada-private ()
 531   "Undent and start a private section of a package spec. Reindent."
 532   (interactive)
 533   (ada-untab)
 534   (insert "private")
 535   (ada-newline)
 536   (ada-tab))
 537
 538 (defun ada-get-arg-list ()
 539   "Read from the user a procedure or function argument list.
 540 Add parens unless arguments absent, and insert into buffer.
 541 Individual arguments are arranged vertically if entered one at a time.
 542 Arguments ending with `;' are presumed single and stacked."
 543   (insert " (")
 544   (let ((ada-arg-indent (current-column))
 545         (ada-args (read-string "[arguments]: ")))
 546     (if (string-equal ada-args "")
 547         (backward-delete-char 2)
 548       (progn
 549         (while (string-match ";$" ada-args)
 550           (insert ada-args)
 551           (newline)
 552           (indent-to ada-arg-indent)
 553           (setq ada-args (read-string "next argument: ")))
 554         (insert ada-args ")")))))
 555
 556 (defun ada-function-spec ()
 557   "Insert a function specification.  Prompts for name and arguments."
 558   (interactive)
 559   (insert "function ")
 560   (insert (read-string "function name: "))
 561   (ada-get-arg-list)
 562   (insert " return ")
 563   (insert (read-string "result type: ")))
 564
 565 (defun ada-procedure-spec ()
 566   "Insert a procedure specification, prompting for its name and arguments."
 567   (interactive)
 568   (insert "procedure ")
 569   (insert (read-string "procedure name: " ))
 570   (ada-get-arg-list))
 571
 572 (defun get-ada-subprogram-name ()
 573   "Return (without moving point or mark) a pair whose CAR is the name of
 574 the function or procedure whose spec immediately precedes point, and whose
 575 CDR is the column number where the procedure/function keyword was found."
 576   (save-excursion
 577     (let ((ada-proc-indent 0))
 578       (if (re-search-backward
 579   ;;;; Unfortunately, comments are not ignored in this string search.
 580              "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t)
 581           (if (or (looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>")
 582                   (looking-at "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>"))
 583               (progn
 584                 (setq ada-proc-indent (current-column))
 585                 (forward-word 2)
 586                 (let ((p2 (point)))
 587                   (forward-word -1)
 588                   (cons (buffer-substring (point) p2) ada-proc-indent)))
 589               (get-ada-subprogram-name))
 590            (cons "NAME?" ada-proc-indent)))))
 591
 592 (defun ada-subprogram-body ()
 593   "Insert frame for subprogram body.
 594 Invoke right after `ada-function-spec' or `ada-procedure-spec'."
 595   (interactive)
 596   (insert " is")
 597   (let ((ada-subprogram-name-col (get-ada-subprogram-name)))
 598     (newline)
 599     (indent-to (cdr ada-subprogram-name-col))
 600     (ada-newline)
 601     (insert "begin")
 602     (ada-newline)
 603     (ada-newline)
 604     (insert "end " (car ada-subprogram-name-col) ";"))
 605   (end-of-line -2)
 606   (ada-tab))
 607
 608 (defun ada-separate ()
 609   "Finish a body stub with `is separate'."
 610   (interactive)
 611   (insert " is")
 612   (ada-newline)
 613   (ada-tab)
 614   (insert "separate;")
 615   (ada-newline)
 616   (ada-untab))
 617
 618 ;(defun ada-with ()
 619 ;  "Inserts a with clause, prompting for the list of units depended upon."
 620 ;  (interactive)
 621 ;  (insert "with ")
 622 ;  (insert (read-string "list of units depended upon: ") ";"))
 623 ;
 624 ;(defun ada-use ()
 625 ;  "Inserts a use clause, prompting for the list of packages used."
 626 ;  (interactive)
 627 ;  (insert "use ")
 628 ;  (insert (read-string "list of packages to use: ") ";"))
 629
 630 (defun ada-record ()
 631   "Insert a skeleton record type declaration."
 632   (interactive)
 633   (insert "record")
 634   (ada-newline)
 635   (ada-newline)
 636   (insert "end record;")
 637   (end-of-line 0)
 638   (ada-tab))
 639
 640 (defun ada-subtype ()
 641   "Start insertion of a subtype declaration, prompting for the subtype name."
 642   (interactive)
 643   (insert "subtype " (read-string "subtype name: ") " is ;")
 644   (backward-char)
 645   (message "insert subtype indication."))
 646
 647 (defun ada-type ()
 648   "Start insertion of a type declaration, prompting for the type name."
 649   (interactive)
 650   (insert "type " (read-string "type name: "))
 651   (let ((disc-part (read-string "discriminant specs: ")))
 652     (if (not (string-equal disc-part ""))
 653         (insert "(" disc-part ")")))
 654   (insert " is ")
 655   (message "insert type definition."))
 656
 657 (defun ada-while-loop ()
 658   (interactive)
 659   (insert "while ")
 660   (let* ((ada-loop-name (read-string "loop name: "))
 661          (ada-loop-is-named (not (string-equal ada-loop-name ""))))
 662     (if ada-loop-is-named
 663         (progn
 664           (beginning-of-line)
 665           (open-line 1)
 666           (insert ada-loop-name ":")
 667           (next-line 1)
 668           (end-of-line 1)))
 669     (insert (read-string "entry condition: ") " loop")
 670     (ada-newline)
 671     (ada-newline)
 672     (insert "end loop")
 673     (if ada-loop-is-named (insert " " ada-loop-name))
 674     (insert ";"))
 675   (end-of-line 0)
 676   (ada-tab))
 677
 678 (defun ada-paired-parens ()
 679   "Insert a pair of round parentheses, placing point between them."
 680   (interactive)
 681   (insert "()")
 682   (backward-char))
 683
 684 (defun ada-inline-comment ()
 685   "Start a comment after the end of the line, indented at least
 686 `comment-column' spaces.  If starting after `end-comment-column',
 687 start a new line."
 688   (interactive)
 689   (end-of-line)
 690   (if (> (current-column) ada-comment-end-column) (newline))
 691   (if (< (current-column) comment-column) (indent-to comment-column))
 692   (insert " -- "))
 693
 694 (defun ada-display-comment ()
 695 "Inserts three comment lines, making a display comment."
 696   (interactive)
 697   (insert "--\n-- \n--")
 698   (end-of-line 0))
 699
 700 ;; Much of this is specific to Ada-Ed
 701
 702 (defvar ada-lib-dir-name "lib" "*Current Ada program library directory.")
 703 (defvar ada-bind-opts "" "*Options to supply for binding.")
 704
 705 (defun ada-library-name (ada-lib-name)
 706   "Specify name of Ada library directory for later compilations."
 707   (interactive "DName of Ada library directory: ")
 708   (setq ada-lib-dir-name ada-lib-name))
 709
 710 (defun ada-options-for-bind ()
 711   "Specify options, such as -m and -i, needed for `ada-bind'."
 712   (setq ada-bind-opts (read-string "-m and -i options for `ada-bind': ")))
 713
 714 (defun ada-compile (arg)
 715   "Save the current buffer and compile it into the current program library.
 716 Initialize the library if a prefix arg is given."
 717   (interactive "P")
 718   (let* ((ada-init (if (null arg) "" "-n "))
 719         (ada-source-file (buffer-name)))
 720     (compile
 721      (concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file))))
 722
 723 (defun ada-find-listing ()
 724   "Find listing file for ada source in current buffer, using other window."
 725   (interactive)
 726   (find-file-other-window (concat (substring (buffer-name) 0 -4) ".lis"))
 727   (search-forward "*** ERROR"))
 728
 729 (defun ada-bind ()
 730   "Bind the current program library, using the current binding options."
 731   (interactive)
 732   (compile (concat "adabind " ada-bind-opts " " ada-lib-dir-name)))
 733
 734 ;;; ada.el ends here