(replace_buffer_in_all_windows):
[bpt/emacs.git] / lisp / ada.el
CommitLineData
c0274f38
ER
1;;; ada.el --- Ada editing support package in GNUlisp. v1.0
2
9750e079
ER
3;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
4
e5167999 5;; Author: Vincent Broman <broman@bugs.nosc.mil>
e5167999 6;; Keywords: languages
766b9408 7
766b9408
JA
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
e5167999 12;; the Free Software Foundation; either version 2, or (at your option)
766b9408
JA
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
e5167999
ER
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
766b9408
JA
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)
4cc58475 44 (modify-syntax-entry ?- ". 12" table)
766b9408
JA
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)
4cc58475 60 (modify-syntax-entry ?\n ">" table)
766b9408
JA
61 (setq ada-mode-syntax-table table))
62
4cc58475
SM
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'.
80This 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"
a2216d64 91; "generic" "if" "in" "is" "limited" "loop" "mod" "not"
4cc58475
SM
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\\|"
a2216d64 100 "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|"
4cc58475
SM
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'.
141This does a lot more highlighting.")
142
352e62b7
SM
143(defvar ada-font-lock-keywords (if font-lock-maximum-decoration
144 ada-font-lock-keywords-2
145 ada-font-lock-keywords-1)
4cc58475
SM
146 "Additional expressions to highlight in Ada mode.")
147
766b9408
JA
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.")
4cc58475 195
716c3024
RS
196(defvar ada-comment-end-column)
197
766b9408
JA
198(defun ada-mode ()
199"This is a mode intended to support program development in Ada.
200Most control constructs and declarations of Ada can be inserted in the buffer
201by typing Control-C followed by a character mnemonic for the construct.
202
349a1abc
JB
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
766b9408
JA
224having the same (or lesser) level of indentation.
225
349a1abc 226Variable `ada-indent' controls the number of spaces for indent/undent."
766b9408
JA
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)
716c3024
RS
234 (make-local-variable 'ada-comment-end-column)
235 (setq ada-comment-end-column 72)
766b9408
JA
236 (set-syntax-table ada-mode-syntax-table)
237 (make-local-variable 'paragraph-start)
e2e71c32 238 (setq paragraph-start (concat "$\\|" page-delimiter))
766b9408
JA
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 "--+ *")
e41b2db1
ER
255 (make-local-variable 'comment-indent-function)
256 (setq comment-indent-function 'c-comment-indent)
766b9408
JA
257 (make-local-variable 'parse-sexp-ignore-comments)
258 (setq parse-sexp-ignore-comments t)
4cc58475
SM
259 (make-local-variable 'font-lock-defaults)
260 (setq font-lock-defaults '(ada-font-lock-keywords nil t ((?\_ . "w"))))
766b9408
JA
261 (run-hooks 'ada-mode-hook))
262
263(defun ada-tabsize (s)
c8a62896 264 "Changes spacing used for indentation.
349a1abc
JB
265The prefix argument is used as the new spacing."
266 (interactive "p")
766b9408
JA
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)
c8a62896
RS
287 "Move point repeatedly by STEP lines until the current line has
288given INDENT-LEVEL or less, or the start or end of the buffer is reached.
289Ignore blank lines, statement labels and block or loop names."
766b9408
JA
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.
c8a62896 301If not found, point is left at the top of the buffer."
766b9408
JA
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.
c8a62896 308If not found, point is left at the start of the last line in the buffer."
766b9408
JA
309 (interactive)
310 (ada-go-to-this-indent 1 (current-indentation))
311 (back-to-indentation))
312
313(defun ada-array ()
c8a62896
RS
314 "Insert array type definition. Uses the minibuffer to prompt
315for component type and index subtypes."
766b9408
JA
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 ()
c8a62896
RS
327 "Build skeleton case statement.
328Uses the minibuffer to prompt for the selector expression.
329Also builds the first when clause."
766b9408
JA
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 ()
c8a62896
RS
342 "Insert a block with a declare part.
343Indent for the first declaration."
766b9408
JA
344 (interactive)
345 (let ((ada-block-name (read-string "[block name]: ")))
346 (insert "declare")
347 (cond
c8a62896
RS
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)))
766b9408
JA
354 (ada-newline)
355 (ada-newline)
356 (insert "begin")
357 (ada-newline)
358 (ada-newline)
359 (if (string-equal ada-block-name "")
c8a62896 360 (insert "end;")
766b9408 361 (insert "end " ada-block-name ";"))
c8a62896 362 )
766b9408
JA
363 (end-of-line -2)
364 (ada-tab))
365
366(defun ada-exception-block ()
c8a62896
RS
367 "Insert a block with an exception part.
368Indent for the first line of code."
766b9408
JA
369 (interactive)
370 (let ((block-name (read-string "[block name]: ")))
371 (insert "begin")
372 (cond
c8a62896
RS
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)))
766b9408
JA
379 (ada-newline)
380 (ada-newline)
381 (insert "exception")
382 (ada-newline)
383 (ada-newline)
384 (cond
c8a62896
RS
385 ( (string-equal block-name "")
386 (insert "end;"))
387 ( t
388 (insert "end " block-name ";")))
389 )
766b9408
JA
390 (end-of-line -2)
391 (ada-tab))
392
393(defun ada-exception ()
c8a62896 394 "Insert an indented exception part into a block."
766b9408
JA
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 ()
c8fa98cc 484 "Insert a skeleton loop statement. The exit statement is added by hand."
766b9408
JA
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 ()
c8a62896 539 "Read from the user a procedure or function argument list.
766b9408 540Add parens unless arguments absent, and insert into buffer.
c8a62896
RS
541Individual arguments are arranged vertically if entered one at a time.
542Arguments ending with `;' are presumed single and stacked."
766b9408
JA
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 ()
c8a62896
RS
573 "Return (without moving point or mark) a pair whose CAR is the name of
574the function or procedure whose spec immediately precedes point, and whose
575CDR is the column number where the procedure/function keyword was found."
766b9408
JA
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.
c8a62896 594Invoke right after `ada-function-spec' or `ada-procedure-spec'."
766b9408
JA
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 ()
c8a62896 609 "Finish a body stub with `is separate'."
766b9408
JA
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 ()
c8a62896
RS
685 "Start a comment after the end of the line, indented at least
686`comment-column' spaces. If starting after `end-comment-column',
687start a new line."
766b9408
JA
688 (interactive)
689 (end-of-line)
716c3024 690 (if (> (current-column) ada-comment-end-column) (newline))
766b9408
JA
691 (if (< (current-column) comment-column) (indent-to comment-column))
692 (insert " -- "))
693
694(defun ada-display-comment ()
c8a62896 695"Inserts three comment lines, making a display comment."
766b9408
JA
696 (interactive)
697 (insert "--\n-- \n--")
698 (end-of-line 0))
699
700;; Much of this is specific to Ada-Ed
701
c8a62896 702(defvar ada-lib-dir-name "lib" "*Current Ada program library directory.")
766b9408
JA
703(defvar ada-bind-opts "" "*Options to supply for binding.")
704
705(defun ada-library-name (ada-lib-name)
c8a62896
RS
706 "Specify name of Ada library directory for later compilations."
707 (interactive "DName of Ada library directory: ")
766b9408
JA
708 (setq ada-lib-dir-name ada-lib-name))
709
710(defun ada-options-for-bind ()
c8a62896
RS
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': ")))
766b9408 713
c8a62896 714(defun ada-compile (arg)
766b9408
JA
715 "Save the current buffer and compile it into the current program library.
716Initialize the library if a prefix arg is given."
717 (interactive "P")
c8a62896 718 (let* ((ada-init (if (null arg) "" "-n "))
766b9408
JA
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)))
c0274f38
ER
733
734;;; ada.el ends here