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

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