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