![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ada.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to ada.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 root 1: ; Ada editing support package in GNUlisp. v1.0
2: ; Author: Vincent Broman <[email protected]> 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:
7: (setq auto-mode-alist (cons (cons "\\.ada$" 'ada-mode) auto-mode-alist))
8:
9: (defvar ada-mode-syntax-table nil
10: "Syntax table in use in Ada-mode buffers.")
11:
12: (let ((table (make-syntax-table)))
13: (modify-syntax-entry ?_ "_" table)
14: (modify-syntax-entry ?\# "_" table)
15: (modify-syntax-entry ?\( "()" table)
16: (modify-syntax-entry ?\) ")(" table)
17: (modify-syntax-entry ?$ "." table)
18: (modify-syntax-entry ?* "." table)
19: (modify-syntax-entry ?/ "." table)
20: (modify-syntax-entry ?+ "." table)
21: (modify-syntax-entry ?- "." table)
22: (modify-syntax-entry ?= "." table)
23: (modify-syntax-entry ?\& "." table)
24: (modify-syntax-entry ?\| "." table)
25: (modify-syntax-entry ?< "." table)
26: (modify-syntax-entry ?> "." table)
27: (modify-syntax-entry ?\[ "." table)
28: (modify-syntax-entry ?\] "." table)
29: (modify-syntax-entry ?\{ "." 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: (setq ada-mode-syntax-table table))
38:
39: (defvar ada-mode-map nil
40: "Keymap used in Ada mode.")
41:
42: (let ((map (make-sparse-keymap)))
43: (define-key map "\C-m" 'ada-newline)
44: (define-key map "\C-?" 'backward-delete-char-untabify)
45: (define-key map "\C-i" 'ada-tab)
46: (define-key map "\C-c\C-i" 'ada-untab)
47: (define-key map "\C-c<" 'ada-backward-to-same-indent)
48: (define-key map "\C-c>" 'ada-forward-to-same-indent)
49: (define-key map "\C-ch" 'ada-header)
50: (define-key map "\C-c(" 'ada-paired-parens)
51: (define-key map "\C-c-" 'ada-inline-comment)
52: (define-key map "\C-c\C-a" 'ada-array)
53: (define-key map "\C-cb" 'ada-exception-block)
54: (define-key map "\C-cd" 'ada-declare-block)
55: (define-key map "\C-c\C-e" 'ada-exception)
56: (define-key map "\C-cc" 'ada-case)
57: (define-key map "\C-c\C-k" 'ada-package-spec)
58: (define-key map "\C-ck" 'ada-package-body)
59: (define-key map "\C-c\C-p" 'ada-procedure-spec)
60: (define-key map "\C-cp" 'ada-subprogram-body)
61: (define-key map "\C-c\C-f" 'ada-function-spec)
62: (define-key map "\C-cf" 'ada-for-loop)
63: (define-key map "\C-cl" 'ada-loop)
64: (define-key map "\C-ci" 'ada-if)
65: (define-key map "\C-cI" 'ada-elsif)
66: (define-key map "\C-ce" 'ada-else)
67: (define-key map "\C-c\C-v" 'ada-private)
68: (define-key map "\C-c\C-r" 'ada-record)
69: (define-key map "\C-c\C-s" 'ada-subtype)
70: (define-key map "\C-cs" 'ada-separate)
71: (define-key map "\C-c\C-t" 'ada-type)
72: (define-key map "\C-ct" 'ada-tabsize)
73: ;; (define-key map "\C-c\C-u" 'ada-use)
74: ;; (define-key map "\C-c\C-w" 'ada-with)
75: (define-key map "\C-cw" 'ada-while-loop)
76: (define-key map "\C-c\C-w" 'ada-when)
77: (define-key map "\C-cx" 'ada-exit)
78: (define-key map "\C-cC" 'ada-compile)
79: (define-key map "\C-cB" 'ada-bind)
80: (define-key map "\C-cE" 'ada-find-listing)
81: (define-key map "\C-cL" 'ada-library-name)
82: (define-key map "\C-cO" 'ada-options-for-bind)
83: (setq ada-mode-map map))
84:
85: (defvar ada-indent 4 "*Value is the number of columns to indent in Ada-Mode.")
86:
87: (defun ada-mode ()
88: "This is a mode intended to support program development in Ada.
89: Most control constructs and declarations of Ada can be inserted in the buffer
90: by typing Control-C followed by a character mnemonic for the construct.
91:
92: C-c C-a array C-c b exception block
93: C-c C-e exception C-c d declare block
94: C-c C-k package spec C-c k package body
95: C-c C-p procedure spec C-c p proc/func body
96: C-c C-f func spec C-c f for loop
97: C-c i if
98: C-c I elsif
99: C-c e else
100: C-c C-v private C-c l loop
101: C-c C-r record C-c c case
102: C-c C-s subtype C-c s separate
103: C-c C-t type C-c t tab spacing for indents
104: C-c C-w when C-c w while
105: C-c x exit
106: C-c ( paired parens C-c - inline comment
107: C-c h header sec
108: C-c C compile C-c B bind
109: C-c E find error list
110: C-c L name library C-c O options for bind
111:
112: C-c < and C-c > move backward and forward respectively to the next line
113: having the same (or lesser) level of indentation.
114:
115: Variable ada-indent controls the number of spaces for indent/undent.
116:
117: \\{ada-mode-map}
118: "
119: (interactive)
120: (kill-all-local-variables)
121: (use-local-map ada-mode-map)
122: (setq major-mode 'ada-mode)
123: (setq mode-name "Ada")
124: (make-local-variable 'comment-column)
125: (setq comment-column 41)
126: (make-local-variable 'end-comment-column)
127: (setq end-comment-column 72)
128: (set-syntax-table ada-mode-syntax-table)
129: (make-local-variable 'paragraph-start)
130: (setq paragraph-start (concat "^$\\|" page-delimiter))
131: (make-local-variable 'paragraph-separate)
132: (setq paragraph-separate paragraph-start)
133: (make-local-variable 'paragraph-ignore-fill-prefix)
134: (setq paragraph-ignore-fill-prefix t)
135: ; (make-local-variable 'indent-line-function)
136: ; (setq indent-line-function 'c-indent-line)
137: (make-local-variable 'require-final-newline)
138: (setq require-final-newline t)
139: (make-local-variable 'comment-start)
140: (setq comment-start "--")
141: (make-local-variable 'comment-end)
142: (setq comment-end "\n")
143: (make-local-variable 'comment-column)
144: (setq comment-column 41)
145: (make-local-variable 'comment-start-skip)
146: (setq comment-start-skip "--+ *")
147: (make-local-variable 'comment-indent-hook)
148: (setq comment-indent-hook 'c-comment-indent)
149: (make-local-variable 'parse-sexp-ignore-comments)
150: (setq parse-sexp-ignore-comments t)
151: (run-hooks 'ada-mode-hook))
152:
153: (defun ada-tabsize (s)
154: "changes spacing used for indentation. Reads spacing from minibuffer."
155: (interactive "nnew indentation spacing: ")
156: (setq ada-indent s))
157:
158: (defun ada-newline ()
159: "Start new line and indent to current tab stop."
160: (interactive)
161: (let ((ada-cc (current-indentation)))
162: (newline)
163: (indent-to ada-cc)))
164:
165: (defun ada-tab ()
166: "Indent to next tab stop."
167: (interactive)
168: (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent)))
169:
170: (defun ada-untab ()
171: "Delete backwards to previous tab stop."
172: (interactive)
173: (backward-delete-char-untabify ada-indent nil))
174:
175: (defun ada-go-to-this-indent (step indent-level)
176: "Move point repeatedly by <step> lines till the current line
177: has given indent-level or less, or the start/end of the buffer is hit.
178: Ignore blank lines, statement labels, block/loop names."
179: (while (and
180: (zerop (forward-line step))
181: (or (looking-at "^[ ]*$")
182: (looking-at "^[ ]*--")
183: (looking-at "^<<[A-Za-z0-9_]+>>")
184: (looking-at "^[A-Za-z0-9_]+:")
185: (> (current-indentation) indent-level)))
186: nil))
187:
188: (defun ada-backward-to-same-indent ()
189: "Move point backwards to nearest line with same indentation or less.
190: If not found, point is left at top of buffer."
191: (interactive)
192: (ada-go-to-this-indent -1 (current-indentation))
193: (back-to-indentation))
194:
195: (defun ada-forward-to-same-indent ()
196: "Move point forwards to nearest line with same indentation or less.
197: If not found, point is left at start of last line in buffer."
198: (interactive)
199: (ada-go-to-this-indent 1 (current-indentation))
200: (back-to-indentation))
201:
202: (defun ada-array ()
203: "Insert array type definition, prompting for component type,
204: leaving the user to type in the index subtypes."
205: (interactive)
206: (insert "array ()")
207: (backward-char)
208: (insert (read-string "index subtype[s]: "))
209: (end-of-line)
210: (insert " of ;")
211: (backward-char)
212: (insert (read-string "component-type: "))
213: (end-of-line))
214:
215: (defun ada-case ()
216: "Build skeleton case statment, prompting for the selector expression.
217: starts up the first when clause, too."
218: (interactive)
219: (insert "case ")
220: (insert (read-string "selector expression: ") " is")
221: (ada-newline)
222: (ada-newline)
223: (insert "end case;")
224: (end-of-line 0)
225: (ada-tab)
226: (ada-tab)
227: (ada-when))
228:
229: (defun ada-declare-block ()
230: "Insert a block with a declare part and indent for the 1st declaration."
231: (interactive)
232: (let ((ada-block-name (read-string "[block name]: ")))
233: (insert "declare")
234: (cond
235: ( (not (string-equal ada-block-name ""))
236: (beginning-of-line)
237: (open-line 1)
238: (insert ada-block-name ":")
239: (next-line 1)
240: (end-of-line)))
241: (ada-newline)
242: (ada-newline)
243: (insert "begin")
244: (ada-newline)
245: (ada-newline)
246: (if (string-equal ada-block-name "")
247: (insert "end;")
248: (insert "end " ada-block-name ";"))
249: )
250: (end-of-line -2)
251: (ada-tab))
252:
253: (defun ada-exception-block ()
254: "Insert a block with an exception part and indent for the 1st line of code."
255: (interactive)
256: (let ((block-name (read-string "[block name]: ")))
257: (insert "begin")
258: (cond
259: ( (not (string-equal block-name ""))
260: (beginning-of-line)
261: (open-line 1)
262: (insert block-name ":")
263: (next-line 1)
264: (end-of-line)))
265: (ada-newline)
266: (ada-newline)
267: (insert "exception")
268: (ada-newline)
269: (ada-newline)
270: (cond
271: ( (string-equal block-name "")
272: (insert "end;"))
273: ( t
274: (insert "end " block-name ";")))
275: )
276: (end-of-line -2)
277: (ada-tab))
278:
279: (defun ada-exception ()
280: "Undent and insert an exception part into a block. Reindent."
281: (interactive)
282: (ada-untab)
283: (insert "exception")
284: (ada-newline)
285: (ada-tab))
286:
287: (defun ada-else ()
288: "Add an else clause inside an if-then-end-if clause."
289: (interactive)
290: (ada-untab)
291: (insert "else")
292: (ada-newline)
293: (ada-tab))
294:
295: (defun ada-exit ()
296: "Insert an exit statement, prompting for loop name and condition."
297: (interactive)
298: (insert "exit")
299: (let ((ada-loop-name (read-string "[name of loop to exit]: ")))
300: (if (not (string-equal ada-loop-name "")) (insert " " ada-loop-name)))
301: (let ((ada-exit-condition (read-string "[exit condition]: ")))
302: (if (not (string-equal ada-exit-condition ""))
303: (if (string-match "^ *[Ww][Hh][Ee][Nn] +" ada-exit-condition)
304: (insert " " ada-exit-condition)
305: (insert " when " ada-exit-condition))))
306: (insert ";"))
307:
308: (defun ada-when ()
309: "Start a case statement alternative with a when clause."
310: (interactive)
311: (ada-untab) ; we were indented in code for the last alternative.
312: (insert "when ")
313: (insert (read-string "'|'-delimited choice list: ") " =>")
314: (ada-newline)
315: (ada-tab))
316:
317: (defun ada-for-loop ()
318: "Build a skeleton for-loop statement, prompting for the loop parameters."
319: (interactive)
320: (insert "for ")
321: (let* ((ada-loop-name (read-string "[loop name]: "))
322: (ada-loop-is-named (not (string-equal ada-loop-name ""))))
323: (if ada-loop-is-named
324: (progn
325: (beginning-of-line)
326: (open-line 1)
327: (insert ada-loop-name ":")
328: (next-line 1)
329: (end-of-line 1)))
330: (insert (read-string "loop variable: ") " in ")
331: (insert (read-string "range: ") " loop")
332: (ada-newline)
333: (ada-newline)
334: (insert "end loop")
335: (if ada-loop-is-named (insert " " ada-loop-name))
336: (insert ";"))
337: (end-of-line 0)
338: (ada-tab))
339:
340: (defun ada-header ()
341: "Insert a comment block containing the module title, author, etc."
342: (interactive)
343: (insert "--\n-- Title: \t")
344: (insert (read-string "Title: "))
345: (insert "\n-- Created:\t" (current-time-string))
346: (insert "\n-- Author: \t" (user-full-name))
347: (insert "\n--\t\t<" (user-login-name) "@" (system-name) ">\n--\n"))
348:
349: (defun ada-if ()
350: "Insert skeleton if statment, prompting for a boolean-expression."
351: (interactive)
352: (insert "if ")
353: (insert (read-string "condition: ") " then")
354: (ada-newline)
355: (ada-newline)
356: (insert "end if;")
357: (end-of-line 0)
358: (ada-tab))
359:
360: (defun ada-elsif ()
361: "Add an elsif clause to an if statement, prompting for the boolean-expression."
362: (interactive)
363: (ada-untab)
364: (insert "elsif ")
365: (insert (read-string "condition: ") " then")
366: (ada-newline)
367: (ada-tab))
368:
369: (defun ada-loop ()
370: "insert a skeleton loop statement. exit statement added by hand."
371: (interactive)
372: (insert "loop ")
373: (let* ((ada-loop-name (read-string "[loop name]: "))
374: (ada-loop-is-named (not (string-equal ada-loop-name ""))))
375: (if ada-loop-is-named
376: (progn
377: (beginning-of-line)
378: (open-line 1)
379: (insert ada-loop-name ":")
380: (forward-line 1)
381: (end-of-line 1)))
382: (ada-newline)
383: (ada-newline)
384: (insert "end loop")
385: (if ada-loop-is-named (insert " " ada-loop-name))
386: (insert ";"))
387: (end-of-line 0)
388: (ada-tab))
389:
390: (defun ada-package-spec ()
391: "Insert a skeleton package specification."
392: (interactive)
393: (insert "package ")
394: (let ((ada-package-name (read-string "package name: " )))
395: (insert ada-package-name " is")
396: (ada-newline)
397: (ada-newline)
398: (insert "end " ada-package-name ";")
399: (end-of-line 0)
400: (ada-tab)))
401:
402: (defun ada-package-body ()
403: "Insert a skeleton package body -- includes a begin statement."
404: (interactive)
405: (insert "package body ")
406: (let ((ada-package-name (read-string "package name: " )))
407: (insert ada-package-name " is")
408: (ada-newline)
409: (ada-newline)
410: (insert "begin")
411: (ada-newline)
412: (insert "end " ada-package-name ";")
413: (end-of-line -1)
414: (ada-tab)))
415:
416: (defun ada-private ()
417: "Undent and start a private section of a package spec. Reindent."
418: (interactive)
419: (ada-untab)
420: (insert "private")
421: (ada-newline)
422: (ada-tab))
423:
424: (defun ada-get-arg-list ()
425: "Read from user a procedure or function argument list.
426: Add parens unless arguments absent, and insert into buffer.
427: Individual arguments are arranged vertically if entered one-at-a-time.
428: Arguments ending with ';' are presumed single and stacked."
429: (insert " (")
430: (let ((ada-arg-indent (current-column))
431: (ada-args (read-string "[arguments]: ")))
432: (if (string-equal ada-args "")
433: (backward-delete-char 2)
434: (progn
435: (while (string-match ";$" ada-args)
436: (insert ada-args)
437: (newline)
438: (indent-to ada-arg-indent)
439: (setq ada-args (read-string "next argument: ")))
440: (insert ada-args ")")))))
441:
442: (defun ada-function-spec ()
443: "Insert a function specification. Prompts for name and arguments."
444: (interactive)
445: (insert "function ")
446: (insert (read-string "function name: "))
447: (ada-get-arg-list)
448: (insert " return ")
449: (insert (read-string "result type: ")))
450:
451: (defun ada-procedure-spec ()
452: "Insert a procedure specification, prompting for its name and arguments."
453: (interactive)
454: (insert "procedure ")
455: (insert (read-string "procedure name: " ))
456: (ada-get-arg-list))
457:
458: (defun get-ada-subprogram-name ()
459: "Return (without moving point or mark) a pair whose CAR is
460: the name of the function or procedure whose spec immediately precedes point,
461: and whose CDR is the column nbr the procedure/function keyword was found at."
462: (save-excursion
463: (let ((ada-proc-indent 0))
464: (if (re-search-backward
465: ;;;; Unfortunately, comments are not ignored in this string search.
466: "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t)
467: (if (or (looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>")
468: (looking-at "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>"))
469: (progn
470: (setq ada-proc-indent (current-column))
471: (forward-word 2)
472: (let ((p2 (point)))
473: (forward-word -1)
474: (cons (buffer-substring (point) p2) ada-proc-indent)))
475: (get-ada-subprogram-name))
476: (cons "NAME?" ada-proc-indent)))))
477:
478: (defun ada-subprogram-body ()
479: "Insert frame for subprogram body.
480: Invoke right after ada-function-spec or ada-procedure-spec."
481: (interactive)
482: (insert " is")
483: (let ((ada-subprogram-name-col (get-ada-subprogram-name)))
484: (newline)
485: (indent-to (cdr ada-subprogram-name-col))
486: (ada-newline)
487: (insert "begin")
488: (ada-newline)
489: (ada-newline)
490: (insert "end " (car ada-subprogram-name-col) ";"))
491: (end-of-line -2)
492: (ada-tab))
493:
494: (defun ada-separate ()
495: "Finish a body stub with 'is separate'."
496: (interactive)
497: (insert " is")
498: (ada-newline)
499: (ada-tab)
500: (insert "separate;")
501: (ada-newline)
502: (ada-untab))
503:
504: ;(defun ada-with ()
505: ; "Inserts a with clause, prompting for the list of units depended upon."
506: ; (interactive)
507: ; (insert "with ")
508: ; (insert (read-string "list of units depended upon: ") ";"))
509: ;
510: ;(defun ada-use ()
511: ; "Inserts a use clause, prompting for the list of packages used."
512: ; (interactive)
513: ; (insert "use ")
514: ; (insert (read-string "list of packages to use: ") ";"))
515:
516: (defun ada-record ()
517: "Insert a skeleton record type declaration."
518: (interactive)
519: (insert "record")
520: (ada-newline)
521: (ada-newline)
522: (insert "end record;")
523: (end-of-line 0)
524: (ada-tab))
525:
526: (defun ada-subtype ()
527: "Start insertion of a subtype declaration, prompting for the subtype name."
528: (interactive)
529: (insert "subtype " (read-string "subtype name: ") " is ;")
530: (backward-char)
531: (message "insert subtype indication."))
532:
533: (defun ada-type ()
534: "Start insertion of a type declaration, prompting for the type name."
535: (interactive)
536: (insert "type " (read-string "type name: "))
537: (let ((disc-part (read-string "discriminant specs: ")))
538: (if (not (string-equal disc-part ""))
539: (insert "(" disc-part ")")))
540: (insert " is ")
541: (message "insert type definition."))
542:
543: (defun ada-while-loop ()
544: (interactive)
545: (insert "while ")
546: (let* ((ada-loop-name (read-string "loop name: "))
547: (ada-loop-is-named (not (string-equal ada-loop-name ""))))
548: (if ada-loop-is-named
549: (progn
550: (beginning-of-line)
551: (open-line 1)
552: (insert ada-loop-name ":")
553: (next-line 1)
554: (end-of-line 1)))
555: (insert (read-string "entry condition: ") " loop")
556: (ada-newline)
557: (ada-newline)
558: (insert "end loop")
559: (if ada-loop-is-named (insert " " ada-loop-name))
560: (insert ";"))
561: (end-of-line 0)
562: (ada-tab))
563:
564: (defun ada-paired-parens ()
565: "Insert a pair of round parentheses, placing point between them."
566: (interactive)
567: (insert "()")
568: (backward-char))
569:
570: (defun ada-inline-comment ()
571: "Start a comment after the end of the line, indented at least COMMENT-COLUMN.
572: If starting after END-COMMENT-COLUMN, start a new line."
573: (interactive)
574: (end-of-line)
575: (if (> (current-column) end-comment-column) (newline))
576: (if (< (current-column) comment-column) (indent-to comment-column))
577: (insert " -- "))
578:
579: (defun ada-display-comment ()
580: "Inserts 3 comment lines, making a display comment."
581: (interactive)
582: (insert "--\n-- \n--")
583: (end-of-line 0))
584:
585: ;; Much of this is specific to Ada-Ed
586:
587: (defvar ada-lib-dir-name "lib" "*Current ada program library directory.")
588: (defvar ada-bind-opts "" "*Options to supply for binding.")
589:
590: (defun ada-library-name (ada-lib-name)
591: "Specify name of ada library directory for later compilations."
592: (interactive "Dname of ada library directory: ")
593: (setq ada-lib-dir-name ada-lib-name))
594:
595: (defun ada-options-for-bind ()
596: "Specify options, such as -m and -i, needed for adabind."
597: (setq ada-bind-opts (read-string "-m and -i options for adabind: ")))
598:
599: (defun ada-compile (ada-prefix-arg)
600: "Save the current buffer and compile it into the current program library.
601: Initialize the library if a prefix arg is given."
602: (interactive "P")
603: (let* ((ada-init (if (null ada-prefix-arg) "" "-n "))
604: (ada-source-file (buffer-name)))
605: (compile
606: (concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file))))
607:
608: (defun ada-find-listing ()
609: "Find listing file for ada source in current buffer, using other window."
610: (interactive)
611: (find-file-other-window (concat (substring (buffer-name) 0 -4) ".lis"))
612: (search-forward "*** ERROR"))
613:
614: (defun ada-bind ()
615: "Bind the current program library, using the current binding options."
616: (interactive)
617: (compile (concat "adabind " ada-bind-opts " " ada-lib-dir-name)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.