lisp/ada.el

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