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