Mercurial > emacs
comparison lisp/=ada.el @ 39:bd9c72156bbf
Initial revision
author | Joseph Arceneaux <jla@gnu.org> |
---|---|
date | Wed, 01 Nov 1989 16:01:13 +0000 |
parents | |
children | 6f1cd5f1d50f |
comparison
equal
deleted
inserted
replaced
38:056b931d312b | 39:bd9c72156bbf |
---|---|
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))) |