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.)
6 ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
8 ;; This file is part of GNU Emacs.
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)
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.
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.
24 (setq auto-mode-alist (cons (cons "\\.ada$" 'ada-mode) auto-mode-alist))
26 (defvar ada-mode-syntax-table nil
27 "Syntax table in use in Ada-mode buffers.")
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))
56 (defvar ada-mode-map nil
57 "Keymap used in Ada mode.")
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))
102 (defvar ada-indent 4 "*Value is the number of columns to indent in 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.
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
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
123 C-c ( paired parens C-c - inline comment
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
129 C-c < and C-c > move backward and forward respectively to the next line
130 having the same (or lesser) level of indentation.
132 Variable ada-indent controls the number of spaces for indent/undent.
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))
170 (defun ada-tabsize (s)
171 "changes spacing used for indentation. Reads spacing from minibuffer."
172 (interactive "nnew indentation spacing: ")
175 (defun ada-newline ()
176 "Start new line and indent to current tab stop."
178 (let ((ada-cc (current-indentation)))
183 "Indent to next tab stop."
185 (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent)))
188 "Delete backwards to previous tab stop."
190 (backward-delete-char-untabify ada-indent nil))
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."
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)))
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."
209 (ada-go-to-this-indent -1 (current-indentation))
210 (back-to-indentation))
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."
216 (ada-go-to-this-indent 1 (current-indentation))
217 (back-to-indentation))
220 "Insert array type definition, prompting for component type,
221 leaving the user to type in the index subtypes."
225 (insert (read-string "index subtype[s]: "))
229 (insert (read-string "component-type: "))
233 "Build skeleton case statment, prompting for the selector expression.
234 starts up the first when clause, too."
237 (insert (read-string "selector expression: ") " is")
246 (defun ada-declare-block ()
247 "Insert a block with a declare part and indent for the 1st declaration."
249 (let ((ada-block-name (read-string "[block name]: ")))
252 ( (not (string-equal ada-block-name ""))
255 (insert ada-block-name ":")
263 (if (string-equal ada-block-name "")
265 (insert "end " ada-block-name ";"))
270 (defun ada-exception-block ()
271 "Insert a block with an exception part and indent for the 1st line of code."
273 (let ((block-name (read-string "[block name]: ")))
276 ( (not (string-equal block-name ""))
279 (insert block-name ":")
288 ( (string-equal block-name "")
291 (insert "end " block-name ";")))
296 (defun ada-exception ()
297 "Undent and insert an exception part into a block. Reindent."
305 "Add an else clause inside an if-then-end-if clause."
313 "Insert an exit statement, prompting for loop name and condition."
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))))
326 "Start a case statement alternative with a when clause."
328 (ada-untab) ; we were indented in code for the last alternative.
330 (insert (read-string "'|'-delimited choice list: ") " =>")
334 (defun ada-for-loop ()
335 "Build a skeleton for-loop statement, prompting for the loop parameters."
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
344 (insert ada-loop-name ":")
347 (insert (read-string "loop variable: ") " in ")
348 (insert (read-string "range: ") " loop")
352 (if ada-loop-is-named (insert " " ada-loop-name))
358 "Insert a comment block containing the module title, author, etc."
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"))
367 "Insert skeleton if statment, prompting for a boolean-expression."
370 (insert (read-string "condition: ") " then")
378 "Add an elsif clause to an if statement, prompting for the boolean-expression."
382 (insert (read-string "condition: ") " then")
387 "insert a skeleton loop statement. exit statement added by hand."
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
396 (insert ada-loop-name ":")
402 (if ada-loop-is-named (insert " " ada-loop-name))
407 (defun ada-package-spec ()
408 "Insert a skeleton package specification."
411 (let ((ada-package-name (read-string "package name: " )))
412 (insert ada-package-name " is")
415 (insert "end " ada-package-name ";")
419 (defun ada-package-body ()
420 "Insert a skeleton package body -- includes a begin statement."
422 (insert "package body ")
423 (let ((ada-package-name (read-string "package name: " )))
424 (insert ada-package-name " is")
429 (insert "end " ada-package-name ";")
433 (defun ada-private ()
434 "Undent and start a private section of a package spec. Reindent."
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."
447 (let ((ada-arg-indent (current-column))
448 (ada-args (read-string "[arguments]: ")))
449 (if (string-equal ada-args "")
450 (backward-delete-char 2)
452 (while (string-match ";$" ada-args)
455 (indent-to ada-arg-indent)
456 (setq ada-args (read-string "next argument: ")))
457 (insert ada-args ")")))))
459 (defun ada-function-spec ()
460 "Insert a function specification. Prompts for name and arguments."
463 (insert (read-string "function name: "))
466 (insert (read-string "result type: ")))
468 (defun ada-procedure-spec ()
469 "Insert a procedure specification, prompting for its name and arguments."
471 (insert "procedure ")
472 (insert (read-string "procedure name: " ))
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."
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]\\>"))
487 (setq ada-proc-indent (current-column))
491 (cons (buffer-substring (point) p2) ada-proc-indent)))
492 (get-ada-subprogram-name))
493 (cons "NAME?" ada-proc-indent)))))
495 (defun ada-subprogram-body ()
496 "Insert frame for subprogram body.
497 Invoke right after ada-function-spec or ada-procedure-spec."
500 (let ((ada-subprogram-name-col (get-ada-subprogram-name)))
502 (indent-to (cdr ada-subprogram-name-col))
507 (insert "end " (car ada-subprogram-name-col) ";"))
511 (defun ada-separate ()
512 "Finish a body stub with 'is separate'."
522 ; "Inserts a with clause, prompting for the list of units depended upon."
525 ; (insert (read-string "list of units depended upon: ") ";"))
528 ; "Inserts a use clause, prompting for the list of packages used."
531 ; (insert (read-string "list of packages to use: ") ";"))
534 "Insert a skeleton record type declaration."
539 (insert "end record;")
543 (defun ada-subtype ()
544 "Start insertion of a subtype declaration, prompting for the subtype name."
546 (insert "subtype " (read-string "subtype name: ") " is ;")
548 (message "insert subtype indication."))
551 "Start insertion of a type declaration, prompting for the type name."
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 ")")))
558 (message "insert type definition."))
560 (defun ada-while-loop ()
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
569 (insert ada-loop-name ":")
572 (insert (read-string "entry condition: ") " loop")
576 (if ada-loop-is-named (insert " " ada-loop-name))
581 (defun ada-paired-parens ()
582 "Insert a pair of round parentheses, placing point between them."
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."
592 (if (> (current-column) end-comment-column) (newline))
593 (if (< (current-column) comment-column) (indent-to comment-column))
596 (defun ada-display-comment ()
597 "Inserts 3 comment lines, making a display comment."
599 (insert "--\n-- \n--")
602 ;; Much of this is specific to Ada-Ed
604 (defvar ada-lib-dir-name "lib" "*Current ada program library directory.")
605 (defvar ada-bind-opts "" "*Options to supply for binding.")
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))
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: ")))
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."
620 (let* ((ada-init (if (null ada-prefix-arg) "" "-n "))
621 (ada-source-file (buffer-name)))
623 (concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file))))
625 (defun ada-find-listing ()
626 "Find listing file for ada source in current buffer, using other window."
628 (find-file-other-window (concat (substring (buffer-name) 0 -4) ".lis"))
629 (search-forward "*** ERROR"))
632 "Bind the current program library, using the current binding options."
634 (compile (concat "adabind " ada-bind-opts " " ada-lib-dir-name)))