1 ;;; ada.el --- Ada editing support package in GNUlisp. v1.0
3 ; Author: Vincent Broman <broman@bugs.nosc.mil> May 1987.
4 ; (borrows heavily from Mick Jordan's Modula-2 package for GNU,
5 ; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
7 ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
9 ;; This file is part of GNU Emacs.
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 1, or (at your option)
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.
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.
25 (setq auto-mode-alist
(cons (cons "\\.ada$" 'ada-mode
) auto-mode-alist
))
27 (defvar ada-mode-syntax-table nil
28 "Syntax table in use in Ada-mode buffers.")
30 (let ((table (make-syntax-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 (modify-syntax-entry ?
\" "\"" table
)
55 (setq ada-mode-syntax-table table
))
57 (defvar ada-mode-map nil
58 "Keymap used in Ada mode.")
60 (let ((map (make-sparse-keymap)))
61 (define-key map
"\C-m" 'ada-newline
)
62 (define-key map
"\C-?" 'backward-delete-char-untabify
)
63 (define-key map
"\C-i" 'ada-tab
)
64 (define-key map
"\C-c\C-i" 'ada-untab
)
65 (define-key map
"\C-c<" 'ada-backward-to-same-indent
)
66 (define-key map
"\C-c>" 'ada-forward-to-same-indent
)
67 (define-key map
"\C-ch" 'ada-header
)
68 (define-key map
"\C-c(" 'ada-paired-parens
)
69 (define-key map
"\C-c-" 'ada-inline-comment
)
70 (define-key map
"\C-c\C-a" 'ada-array
)
71 (define-key map
"\C-cb" 'ada-exception-block
)
72 (define-key map
"\C-cd" 'ada-declare-block
)
73 (define-key map
"\C-c\C-e" 'ada-exception
)
74 (define-key map
"\C-cc" 'ada-case
)
75 (define-key map
"\C-c\C-k" 'ada-package-spec
)
76 (define-key map
"\C-ck" 'ada-package-body
)
77 (define-key map
"\C-c\C-p" 'ada-procedure-spec
)
78 (define-key map
"\C-cp" 'ada-subprogram-body
)
79 (define-key map
"\C-c\C-f" 'ada-function-spec
)
80 (define-key map
"\C-cf" 'ada-for-loop
)
81 (define-key map
"\C-cl" 'ada-loop
)
82 (define-key map
"\C-ci" 'ada-if
)
83 (define-key map
"\C-cI" 'ada-elsif
)
84 (define-key map
"\C-ce" 'ada-else
)
85 (define-key map
"\C-c\C-v" 'ada-private
)
86 (define-key map
"\C-c\C-r" 'ada-record
)
87 (define-key map
"\C-c\C-s" 'ada-subtype
)
88 (define-key map
"\C-cs" 'ada-separate
)
89 (define-key map
"\C-c\C-t" 'ada-type
)
90 (define-key map
"\C-ct" 'ada-tabsize
)
91 ;; (define-key map "\C-c\C-u" 'ada-use)
92 ;; (define-key map "\C-c\C-w" 'ada-with)
93 (define-key map
"\C-cw" 'ada-while-loop
)
94 (define-key map
"\C-c\C-w" 'ada-when
)
95 (define-key map
"\C-cx" 'ada-exit
)
96 (define-key map
"\C-cC" 'ada-compile
)
97 (define-key map
"\C-cB" 'ada-bind
)
98 (define-key map
"\C-cE" 'ada-find-listing
)
99 (define-key map
"\C-cL" 'ada-library-name
)
100 (define-key map
"\C-cO" 'ada-options-for-bind
)
101 (setq ada-mode-map map
))
103 (defvar ada-indent
4 "*Value is the number of columns to indent in Ada-Mode.")
106 "This is a mode intended to support program development in Ada.
107 Most control constructs and declarations of Ada can be inserted in the buffer
108 by typing Control-C followed by a character mnemonic for the construct.
110 \\<ada-mode-map>\\[ada-array] array \\[ada-exception-block] exception block
111 \\[ada-exception] exception \\[ada-declare-block] declare block
112 \\[ada-package-spec] package spec \\[ada-package-body] package body
113 \\[ada-procedure-spec] procedure spec \\[ada-subprogram-body] proc/func body
114 \\[ada-function-spec] func spec \\[ada-for-loop] for loop
118 \\[ada-private] private \\[ada-loop] loop
119 \\[ada-record] record \\[ada-case] case
120 \\[ada-subtype] subtype \\[ada-separate] separate
121 \\[ada-type] type \\[ada-tabsize] tab spacing for indents
122 \\[ada-when] when \\[ada-while] while
124 \\[ada-paired-parens] paired parens \\[ada-inline-comment] inline comment
125 \\[ada-header] header spec
126 \\[ada-compile] compile \\[ada-bind] bind
127 \\[ada-find-listing] find error list
128 \\[ada-library-name] name library \\[ada-options-for-bind] options for bind
130 \\[ada-backward-to-same-indent] and \\[ada-forward-to-same-indent] move backward and forward respectively to the next line
131 having the same (or lesser) level of indentation.
133 Variable `ada-indent' controls the number of spaces for indent/undent."
135 (kill-all-local-variables)
136 (use-local-map ada-mode-map
)
137 (setq major-mode
'ada-mode
)
138 (setq mode-name
"Ada")
139 (make-local-variable 'comment-column
)
140 (setq comment-column
41)
141 (make-local-variable 'end-comment-column
)
142 (setq end-comment-column
72)
143 (set-syntax-table ada-mode-syntax-table
)
144 (make-local-variable 'paragraph-start
)
145 (setq paragraph-start
(concat "^$\\|" page-delimiter
))
146 (make-local-variable 'paragraph-separate
)
147 (setq paragraph-separate paragraph-start
)
148 (make-local-variable 'paragraph-ignore-fill-prefix
)
149 (setq paragraph-ignore-fill-prefix t
)
150 ; (make-local-variable 'indent-line-function)
151 ; (setq indent-line-function 'c-indent-line)
152 (make-local-variable 'require-final-newline
)
153 (setq require-final-newline t
)
154 (make-local-variable 'comment-start
)
155 (setq comment-start
"--")
156 (make-local-variable 'comment-end
)
157 (setq comment-end
"")
158 (make-local-variable 'comment-column
)
159 (setq comment-column
41)
160 (make-local-variable 'comment-start-skip
)
161 (setq comment-start-skip
"--+ *")
162 (make-local-variable 'comment-indent-hook
)
163 (setq comment-indent-hook
'c-comment-indent
)
164 (make-local-variable 'parse-sexp-ignore-comments
)
165 (setq parse-sexp-ignore-comments t
)
166 (run-hooks 'ada-mode-hook
))
168 (defun ada-tabsize (s)
169 "Changes spacing used for indentation.
170 The prefix argument is used as the new spacing."
174 (defun ada-newline ()
175 "Start new line and indent to current tab stop."
177 (let ((ada-cc (current-indentation)))
182 "Indent to next tab stop."
184 (indent-to (* (1+ (/ (current-indentation) ada-indent
)) ada-indent
)))
187 "Delete backwards to previous tab stop."
189 (backward-delete-char-untabify ada-indent nil
))
191 (defun ada-go-to-this-indent (step indent-level
)
192 "Move point repeatedly by STEP lines until the current line has
193 given INDENT-LEVEL or less, or the start or end of the buffer is reached.
194 Ignore blank lines, statement labels and block or loop names."
196 (zerop (forward-line step
))
197 (or (looking-at "^[ ]*$")
198 (looking-at "^[ ]*--")
199 (looking-at "^<<[A-Za-z0-9_]+>>")
200 (looking-at "^[A-Za-z0-9_]+:")
201 (> (current-indentation) indent-level
)))
204 (defun ada-backward-to-same-indent ()
205 "Move point backwards to nearest line with same indentation or less.
206 If not found, point is left at the top of the buffer."
208 (ada-go-to-this-indent -
1 (current-indentation))
209 (back-to-indentation))
211 (defun ada-forward-to-same-indent ()
212 "Move point forwards to nearest line with same indentation or less.
213 If not found, point is left at the start of the last line in the buffer."
215 (ada-go-to-this-indent 1 (current-indentation))
216 (back-to-indentation))
219 "Insert array type definition. Uses the minibuffer to prompt
220 for component type and index subtypes."
224 (insert (read-string "index subtype[s]: "))
228 (insert (read-string "component-type: "))
232 "Build skeleton case statement.
233 Uses the minibuffer to prompt for the selector expression.
234 Also builds the first when clause."
237 (insert (read-string "selector expression: ") " is")
246 (defun ada-declare-block ()
247 "Insert a block with a declare part.
248 Indent for the first declaration."
250 (let ((ada-block-name (read-string "[block name]: ")))
253 ( (not (string-equal ada-block-name
""))
256 (insert ada-block-name
":")
264 (if (string-equal ada-block-name
"")
266 (insert "end " ada-block-name
";"))
271 (defun ada-exception-block ()
272 "Insert a block with an exception part.
273 Indent for the first line of code."
275 (let ((block-name (read-string "[block name]: ")))
278 ( (not (string-equal block-name
""))
281 (insert block-name
":")
290 ( (string-equal block-name
"")
293 (insert "end " block-name
";")))
298 (defun ada-exception ()
299 "Insert an indented exception part into a block."
307 "Add an else clause inside an if-then-end-if clause."
315 "Insert an exit statement, prompting for loop name and condition."
318 (let ((ada-loop-name (read-string "[name of loop to exit]: ")))
319 (if (not (string-equal ada-loop-name
"")) (insert " " ada-loop-name
)))
320 (let ((ada-exit-condition (read-string "[exit condition]: ")))
321 (if (not (string-equal ada-exit-condition
""))
322 (if (string-match "^ *[Ww][Hh][Ee][Nn] +" ada-exit-condition
)
323 (insert " " ada-exit-condition
)
324 (insert " when " ada-exit-condition
))))
328 "Start a case statement alternative with a when clause."
330 (ada-untab) ; we were indented in code for the last alternative.
332 (insert (read-string "'|'-delimited choice list: ") " =>")
336 (defun ada-for-loop ()
337 "Build a skeleton for-loop statement, prompting for the loop parameters."
340 (let* ((ada-loop-name (read-string "[loop name]: "))
341 (ada-loop-is-named (not (string-equal ada-loop-name
""))))
342 (if ada-loop-is-named
346 (insert ada-loop-name
":")
349 (insert (read-string "loop variable: ") " in ")
350 (insert (read-string "range: ") " loop")
354 (if ada-loop-is-named
(insert " " ada-loop-name
))
360 "Insert a comment block containing the module title, author, etc."
362 (insert "--\n-- Title: \t")
363 (insert (read-string "Title: "))
364 (insert "\n-- Created:\t" (current-time-string))
365 (insert "\n-- Author: \t" (user-full-name))
366 (insert "\n--\t\t<" (user-login-name) "@" (system-name) ">\n--\n"))
369 "Insert skeleton if statment, prompting for a boolean-expression."
372 (insert (read-string "condition: ") " then")
380 "Add an elsif clause to an if statement, prompting for the boolean-expression."
384 (insert (read-string "condition: ") " then")
389 "Insert a skeleton loop statement. exit statement added by hand."
392 (let* ((ada-loop-name (read-string "[loop name]: "))
393 (ada-loop-is-named (not (string-equal ada-loop-name
""))))
394 (if ada-loop-is-named
398 (insert ada-loop-name
":")
404 (if ada-loop-is-named
(insert " " ada-loop-name
))
409 (defun ada-package-spec ()
410 "Insert a skeleton package specification."
413 (let ((ada-package-name (read-string "package name: " )))
414 (insert ada-package-name
" is")
417 (insert "end " ada-package-name
";")
421 (defun ada-package-body ()
422 "Insert a skeleton package body -- includes a begin statement."
424 (insert "package body ")
425 (let ((ada-package-name (read-string "package name: " )))
426 (insert ada-package-name
" is")
431 (insert "end " ada-package-name
";")
435 (defun ada-private ()
436 "Undent and start a private section of a package spec. Reindent."
443 (defun ada-get-arg-list ()
444 "Read from the user a procedure or function argument list.
445 Add parens unless arguments absent, and insert into buffer.
446 Individual arguments are arranged vertically if entered one at a time.
447 Arguments ending with `;' are presumed single and stacked."
449 (let ((ada-arg-indent (current-column))
450 (ada-args (read-string "[arguments]: ")))
451 (if (string-equal ada-args
"")
452 (backward-delete-char 2)
454 (while (string-match ";$" ada-args
)
457 (indent-to ada-arg-indent
)
458 (setq ada-args
(read-string "next argument: ")))
459 (insert ada-args
")")))))
461 (defun ada-function-spec ()
462 "Insert a function specification. Prompts for name and arguments."
465 (insert (read-string "function name: "))
468 (insert (read-string "result type: ")))
470 (defun ada-procedure-spec ()
471 "Insert a procedure specification, prompting for its name and arguments."
473 (insert "procedure ")
474 (insert (read-string "procedure name: " ))
477 (defun get-ada-subprogram-name ()
478 "Return (without moving point or mark) a pair whose CAR is the name of
479 the function or procedure whose spec immediately precedes point, and whose
480 CDR is the column number where the procedure/function keyword was found."
482 (let ((ada-proc-indent 0))
483 (if (re-search-backward
484 ;;;; Unfortunately, comments are not ignored in this string search.
485 "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t
)
486 (if (or (looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>")
487 (looking-at "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>"))
489 (setq ada-proc-indent
(current-column))
493 (cons (buffer-substring (point) p2
) ada-proc-indent
)))
494 (get-ada-subprogram-name))
495 (cons "NAME?" ada-proc-indent
)))))
497 (defun ada-subprogram-body ()
498 "Insert frame for subprogram body.
499 Invoke right after `ada-function-spec' or `ada-procedure-spec'."
502 (let ((ada-subprogram-name-col (get-ada-subprogram-name)))
504 (indent-to (cdr ada-subprogram-name-col
))
509 (insert "end " (car ada-subprogram-name-col
) ";"))
513 (defun ada-separate ()
514 "Finish a body stub with `is separate'."
524 ; "Inserts a with clause, prompting for the list of units depended upon."
527 ; (insert (read-string "list of units depended upon: ") ";"))
530 ; "Inserts a use clause, prompting for the list of packages used."
533 ; (insert (read-string "list of packages to use: ") ";"))
536 "Insert a skeleton record type declaration."
541 (insert "end record;")
545 (defun ada-subtype ()
546 "Start insertion of a subtype declaration, prompting for the subtype name."
548 (insert "subtype " (read-string "subtype name: ") " is ;")
550 (message "insert subtype indication."))
553 "Start insertion of a type declaration, prompting for the type name."
555 (insert "type " (read-string "type name: "))
556 (let ((disc-part (read-string "discriminant specs: ")))
557 (if (not (string-equal disc-part
""))
558 (insert "(" disc-part
")")))
560 (message "insert type definition."))
562 (defun ada-while-loop ()
565 (let* ((ada-loop-name (read-string "loop name: "))
566 (ada-loop-is-named (not (string-equal ada-loop-name
""))))
567 (if ada-loop-is-named
571 (insert ada-loop-name
":")
574 (insert (read-string "entry condition: ") " loop")
578 (if ada-loop-is-named
(insert " " ada-loop-name
))
583 (defun ada-paired-parens ()
584 "Insert a pair of round parentheses, placing point between them."
589 (defun ada-inline-comment ()
590 "Start a comment after the end of the line, indented at least
591 `comment-column' spaces. If starting after `end-comment-column',
595 (if (> (current-column) end-comment-column
) (newline))
596 (if (< (current-column) comment-column
) (indent-to comment-column
))
599 (defun ada-display-comment ()
600 "Inserts three comment lines, making a display comment."
602 (insert "--\n-- \n--")
605 ;; Much of this is specific to Ada-Ed
607 (defvar ada-lib-dir-name
"lib" "*Current Ada program library directory.")
608 (defvar ada-bind-opts
"" "*Options to supply for binding.")
610 (defun ada-library-name (ada-lib-name)
611 "Specify name of Ada library directory for later compilations."
612 (interactive "DName of Ada library directory: ")
613 (setq ada-lib-dir-name ada-lib-name
))
615 (defun ada-options-for-bind ()
616 "Specify options, such as -m and -i, needed for `ada-bind'."
617 (setq ada-bind-opts
(read-string "-m and -i options for `ada-bind': ")))
619 (defun ada-compile (arg)
620 "Save the current buffer and compile it into the current program library.
621 Initialize the library if a prefix arg is given."
623 (let* ((ada-init (if (null arg
) "" "-n "))
624 (ada-source-file (buffer-name)))
626 (concat "adacomp " ada-init
"-l " ada-lib-dir-name
" " ada-source-file
))))
628 (defun ada-find-listing ()
629 "Find listing file for ada source in current buffer, using other window."
631 (find-file-other-window (concat (substring (buffer-name) 0 -
4) ".lis"))
632 (search-forward "*** ERROR"))
635 "Bind the current program library, using the current binding options."
637 (compile (concat "adabind " ada-bind-opts
" " ada-lib-dir-name
)))