|
189
|
1 ;;; ada-stmt.el - An extension to Ada mode for inserting statement templates.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1987, 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de>
|
|
|
6 ;; Maintainer: Rolf Ebert <ebert@waporo.muc.de>
|
|
|
7 ;; Keywords: languages, ada
|
|
|
8 ;; Rolf Ebert's version: 2.26
|
|
|
9
|
|
|
10 ;;; Commentary:
|
|
|
11
|
|
|
12 ;;
|
|
|
13 ;; put the following statement in your .emacs:
|
|
|
14 ;; (require 'ada-stmt)
|
|
|
15 ;;
|
|
|
16
|
|
|
17 ;;; History:
|
|
|
18
|
|
|
19 ;; Created May 1987.
|
|
|
20 ;; Original version from V. Bowman as in ada.el of Emacs-18
|
|
|
21 ;; (borrowed heavily from Mick Jordan's Modula-2 package for GNU,
|
|
|
22 ;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
|
|
|
23 ;;
|
|
|
24 ;; Sep 1993. Daniel Pfeiffer <pfeiffer@cict.fr> (DP)
|
|
|
25 ;; Introduced statement.el for smaller code and user configurability.
|
|
|
26 ;;
|
|
|
27 ;; Nov 1993. Rolf Ebert <ebert@enpc.fr> (RE) Moved the
|
|
|
28 ;; skeleton generation into this separate file. The code still is
|
|
|
29 ;; essentially written by DP
|
|
|
30 ;;
|
|
|
31 ;; Adapted Jun 1994. Markus Heritsch
|
|
|
32 ;; <Markus.Heritsch@studbox.uni-stuttgart.de> (MH)
|
|
|
33 ;; added menu bar support for templates
|
|
|
34 ;;
|
|
|
35 ;; 1994/12/02 Christian Egli <cegli@hcsd.hac.com>
|
|
|
36 ;; General cleanup and bug fixes.
|
|
|
37 ;;
|
|
|
38 ;; 1995/12/20 John Hutchison <hutchiso@epi.syr.ge.com>
|
|
|
39 ;; made it work with skeleton.el from emacs-19.30. Several
|
|
|
40 ;; enhancements and bug fixes.
|
|
|
41
|
|
|
42 ;; BUGS:
|
|
|
43 ;;;> I have the following suggestions for the function template: 1) I
|
|
|
44 ;;;> don't want it automatically assigning it a name for the return variable. I
|
|
|
45 ;;;> never want it to be called "Result" because that is nondescriptive. If you
|
|
|
46 ;;;> must define a variable, give me the ability to specify its name.
|
|
|
47 ;;;>
|
|
|
48 ;;;> 2) You do not provide a type for variable 'Result'. Its type is the same
|
|
|
49 ;;;> as the function's return type, which the template knows, so why force me
|
|
|
50 ;;;> to type it in?
|
|
|
51 ;;;>
|
|
|
52
|
|
|
53 ;;;It would be nice if one could configure such layout details separately
|
|
|
54 ;;;without patching the LISP code. Maybe the metalanguage used in ada-stmt.el
|
|
|
55 ;;;could be taken even further, providing the user with some nice syntax
|
|
|
56 ;;;for describing layout. Then my own hacks would survive the next
|
|
|
57 ;;;update of the package :-)
|
|
|
58
|
|
|
59
|
|
|
60 ;;; Code:
|
|
|
61
|
|
|
62 (require 'ada-mode)
|
|
|
63 (load "skeleton") ;; bug in 19.28 through 19.30 skeleton.el, not provided.
|
|
|
64 (require 'easymenu)
|
|
|
65
|
|
|
66 (defvar ada-stmt-use-debug t
|
|
|
67 "*Toggle to insert ada debug code parts.")
|
|
|
68
|
|
|
69
|
|
|
70 (defvar ada-debug-call-str "pragma Debug (%s);"
|
|
|
71 "*Debug call code to insert.")
|
|
|
72
|
|
|
73
|
|
|
74 (defvar ada-debug-exception-str "pragma Debug (%s);"
|
|
|
75 "*Debug exception code to insert." )
|
|
|
76
|
|
|
77
|
|
|
78
|
|
|
79 (defun ada-func-or-proc-name ()
|
|
|
80 ;; Get the name of the current function or procedure."
|
|
|
81 (save-excursion
|
|
|
82 (let ((case-fold-search t))
|
|
|
83 (if (re-search-backward ada-procedure-start-regexp nil t)
|
|
|
84 (buffer-substring (match-beginning 2) (match-end 2))
|
|
|
85 "NAME?"))))
|
|
|
86
|
|
|
87
|
|
|
88 (defun ada-toggle-debugging ()
|
|
|
89 "Toggles behaviour of `ada-debug-info-insertion'."
|
|
|
90 (interactive)
|
|
|
91 (setq ada-stmt-use-debug (not ada-stmt-use-debug))
|
|
|
92 (if ada-stmt-use-debug
|
|
|
93 (message "Debugging enabled")
|
|
|
94 (message "Debugging disabled")))
|
|
|
95
|
|
|
96
|
|
|
97 (defvar ada-template-map nil
|
|
|
98 "Keymap used in Ada mode for smart template operations.")
|
|
|
99
|
|
|
100
|
|
|
101 (let ((ada-mp (make-sparse-keymap)))
|
|
|
102 (define-key ada-mp "h" 'ada-header)
|
|
|
103 ; (define-key ada-mp "p" 'ada-toggle-prompt-pseudo)
|
|
|
104 (define-key ada-mp "(" 'insert-parentheses)
|
|
|
105 (define-key ada-mp "\C-a" 'ada-array)
|
|
|
106 (define-key ada-mp "b" 'ada-exception-block)
|
|
|
107 (define-key ada-mp "d" 'ada-declare-block)
|
|
|
108 (define-key ada-mp "c" 'ada-case)
|
|
|
109 (define-key ada-mp "\C-e" 'ada-elsif)
|
|
|
110 (define-key ada-mp "e" 'ada-else)
|
|
|
111 (define-key ada-mp "\C-k" 'ada-package-spec)
|
|
|
112 (define-key ada-mp "k" 'ada-package-body)
|
|
|
113 (define-key ada-mp "\C-p" 'ada-procedure-spec)
|
|
|
114 (define-key ada-mp "\C-f" 'ada-function-spec)
|
|
|
115 (define-key ada-mp "p" 'ada-subprogram-body)
|
|
|
116 (define-key ada-mp "f" 'ada-for-loop)
|
|
|
117 (define-key ada-mp "i" 'ada-if)
|
|
|
118 (define-key ada-mp "l" 'ada-loop)
|
|
|
119 (define-key ada-mp "\C-r" 'ada-record)
|
|
|
120 (define-key ada-mp "\C-s" 'ada-subtype)
|
|
|
121 (define-key ada-mp "S" 'ada-tabsize)
|
|
|
122 (define-key ada-mp "\C-t" 'ada-task-spec)
|
|
|
123 (define-key ada-mp "t" 'ada-task-body)
|
|
|
124 (define-key ada-mp "\C-y" 'ada-type)
|
|
|
125 (define-key ada-mp "\C-v" 'ada-private)
|
|
|
126 (define-key ada-mp "u" 'ada-use)
|
|
|
127 (define-key ada-mp "\C-u" 'ada-with)
|
|
|
128 (define-key ada-mp "\C-w" 'ada-when)
|
|
|
129 (define-key ada-mp "w" 'ada-while-loop)
|
|
|
130 (define-key ada-mp "\C-x" 'ada-exception)
|
|
|
131 (define-key ada-mp "x" 'ada-exit)
|
|
|
132 (setq ada-template-map ada-mp))
|
|
|
133
|
|
|
134 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
135 ;; Place the templates into Ada Mode. They may be inserted under any key.
|
|
|
136 ;; C-c C-t will be the default. If you use templates alot, you
|
|
|
137 ;; may want to consider moving the binding to another key in your .emacs
|
|
|
138 ;; file. Be sure to (require 'ada-stmt) first.
|
|
|
139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
140 ;(define-key ada-mode-map "\C-ct" ada-template-map)
|
|
|
141 (define-key ada-mode-map "\C-c\C-t" ada-template-map)
|
|
|
142
|
|
|
143 ;;; ---- statement skeletons ------------------------------------------
|
|
|
144
|
|
|
145 (define-skeleton ada-array
|
|
|
146 "Insert array type definition. Uses the minibuffer to prompt
|
|
|
147 for component type and index subtypes."
|
|
|
148 ()
|
|
|
149 "array (" ("index definition: " str ", " ) -2 ") of " _ ?\;)
|
|
|
150
|
|
|
151
|
|
|
152 (define-skeleton ada-case
|
|
|
153 "Build skeleton case statement, prompting for the selector expression.
|
|
|
154 Also builds the first when clause."
|
|
|
155 "[selector expression]: "
|
|
|
156 "case " str " is" \n
|
|
|
157 > "when " ("discrete choice: " str " | ") -3 " =>" \n
|
|
|
158 > _ \n
|
|
|
159 < < "end case;")
|
|
|
160
|
|
|
161
|
|
|
162 (define-skeleton ada-when
|
|
|
163 "Start a case statement alternative with a when clause."
|
|
|
164 ()
|
|
|
165 < "when " ("discrete choice: " str " | ") -3 " =>" \n
|
|
|
166 >)
|
|
|
167
|
|
|
168
|
|
|
169 (define-skeleton ada-declare-block
|
|
|
170 "Insert a block with a declare part.
|
|
|
171 Indent for the first declaration."
|
|
|
172 "[block name]: "
|
|
|
173 < str & ?: & \n
|
|
|
174 > "declare" \n
|
|
|
175 > _ \n
|
|
|
176 < "begin" \n
|
|
|
177 > \n
|
|
|
178 < "end " str | -1 ?\;)
|
|
|
179
|
|
|
180
|
|
|
181 (define-skeleton ada-exception-block
|
|
|
182 "Insert a block with an exception part.
|
|
|
183 Indent for the first line of code."
|
|
|
184 "[block name]: "
|
|
|
185 < str & ?: & \n
|
|
|
186 > "begin" \n
|
|
|
187 > _ \n
|
|
|
188 < "exception" \n
|
|
|
189 > \n
|
|
|
190 < "end " str | -1 ?\;)
|
|
|
191
|
|
|
192
|
|
|
193 (define-skeleton ada-exception
|
|
|
194 "Insert an indented exception part into a block."
|
|
|
195 ()
|
|
|
196 < "exception" \n
|
|
|
197 >)
|
|
|
198
|
|
|
199
|
|
|
200 (define-skeleton ada-exit-1
|
|
|
201 "Insert then exit condition of the exit statement, prompting for condition."
|
|
|
202 "[exit condition]: "
|
|
|
203 "when " str | -5)
|
|
|
204
|
|
|
205
|
|
|
206 (define-skeleton ada-exit
|
|
|
207 "Insert an exit statement, prompting for loop name and condition."
|
|
|
208 "[name of loop to exit]: "
|
|
|
209 "exit " str & ?\
|
|
|
210 (ada-exit-1)
|
|
|
211 | -1 ?\;)
|
|
|
212
|
|
|
213
|
|
|
214 (defun ada-header ()
|
|
|
215 "Insert a descriptive header at the top of the file."
|
|
|
216 (interactive "*")
|
|
|
217 (save-excursion
|
|
|
218 (goto-char (point-min))
|
|
|
219 (if (fboundp 'make-header)
|
|
|
220 (make-header)
|
|
|
221 (ada-header-tmpl))))
|
|
|
222
|
|
|
223
|
|
|
224 (define-skeleton ada-header-tmpl
|
|
|
225 "Insert a comment block containing the module title, author, etc."
|
|
|
226 "[Description]: "
|
|
|
227 "-- -*- Mode: Ada -*-"
|
|
|
228 "\n-- Filename : " (buffer-name)
|
|
|
229 "\n-- Description : " str
|
|
|
230 "\n-- Author : " (user-full-name)
|
|
|
231 "\n-- Created On : " (current-time-string)
|
|
|
232 "\n-- Last Modified By: ."
|
|
|
233 "\n-- Last Modified On: ."
|
|
|
234 "\n-- Update Count : 0"
|
|
|
235 "\n-- Status : Unknown, Use with caution!"
|
|
|
236 "\n")
|
|
|
237
|
|
|
238
|
|
|
239 (define-skeleton ada-display-comment
|
|
|
240 "Inserts three comment lines, making a display comment."
|
|
|
241 ()
|
|
|
242 "--\n-- " _ "\n--")
|
|
|
243
|
|
|
244
|
|
|
245 (define-skeleton ada-if
|
|
|
246 "Insert skeleton if statment, prompting for a boolean-expression."
|
|
|
247 "[condition]: "
|
|
|
248 "if " str " then" \n
|
|
|
249 > _ \n
|
|
|
250 < "end if;")
|
|
|
251
|
|
|
252
|
|
|
253 (define-skeleton ada-elsif
|
|
|
254 "Add an elsif clause to an if statement,
|
|
|
255 prompting for the boolean-expression."
|
|
|
256 "[condition]: "
|
|
|
257 < "elsif " str " then" \n
|
|
|
258 >)
|
|
|
259
|
|
|
260
|
|
|
261 (define-skeleton ada-else
|
|
|
262 "Add an else clause inside an if-then-end-if clause."
|
|
|
263 ()
|
|
|
264 < "else" \n
|
|
|
265 >)
|
|
|
266
|
|
|
267
|
|
|
268 (define-skeleton ada-loop
|
|
|
269 "Insert a skeleton loop statement. The exit statement is added by hand."
|
|
|
270 "[loop name]: "
|
|
|
271 < str & ?: & \n
|
|
|
272 > "loop" \n
|
|
|
273 > _ \n
|
|
|
274 < "end loop " str | -1 ?\;)
|
|
|
275
|
|
|
276
|
|
|
277 (define-skeleton ada-for-loop-prompt-variable
|
|
|
278 "Prompt for the loop variable."
|
|
|
279 "[loop variable]: "
|
|
|
280 str)
|
|
|
281
|
|
|
282
|
|
|
283 (define-skeleton ada-for-loop-prompt-range
|
|
|
284 "Prompt for the loop range."
|
|
|
285 "[loop range]: "
|
|
|
286 str)
|
|
|
287
|
|
|
288
|
|
|
289 (define-skeleton ada-for-loop
|
|
|
290 "Build a skeleton for-loop statement, prompting for the loop parameters."
|
|
|
291 "[loop name]: "
|
|
|
292 < str & ?: & \n
|
|
|
293 > "for "
|
|
|
294 (ada-for-loop-prompt-variable)
|
|
|
295 " in "
|
|
|
296 (ada-for-loop-prompt-range)
|
|
|
297 " loop" \n
|
|
|
298 > _ \n
|
|
|
299 < "end loop " str | -1 ?\;)
|
|
|
300
|
|
|
301
|
|
|
302 (define-skeleton ada-while-loop-prompt-entry-condition
|
|
|
303 "Prompt for the loop entry condition."
|
|
|
304 "[entry condition]: "
|
|
|
305 str)
|
|
|
306
|
|
|
307
|
|
|
308 (define-skeleton ada-while-loop
|
|
|
309 "Insert a skeleton while loop statement."
|
|
|
310 "[loop name]: "
|
|
|
311 < str & ?: & \n
|
|
|
312 > "while "
|
|
|
313 (ada-while-loop-prompt-entry-condition)
|
|
|
314 " loop" \n
|
|
|
315 > _ \n
|
|
|
316 < "end loop " str | -1 ?\;)
|
|
|
317
|
|
|
318
|
|
|
319 (define-skeleton ada-package-spec
|
|
|
320 "Insert a skeleton package specification."
|
|
|
321 "[package name]: "
|
|
|
322 "package " str " is" \n
|
|
|
323 > _ \n
|
|
|
324 < "end " str ?\;)
|
|
|
325
|
|
|
326
|
|
|
327 (define-skeleton ada-package-body
|
|
|
328 "Insert a skeleton package body -- includes a begin statement."
|
|
|
329 "[package name]: "
|
|
|
330 "package body " str " is" \n
|
|
|
331 > _ \n
|
|
|
332 ; < "begin" \n
|
|
|
333 < "end " str ?\;)
|
|
|
334
|
|
|
335
|
|
|
336 (define-skeleton ada-private
|
|
|
337 "Undent and start a private section of a package spec. Reindent."
|
|
|
338 ()
|
|
|
339 < "private" \n
|
|
|
340 >)
|
|
|
341
|
|
|
342
|
|
|
343 (define-skeleton ada-function-spec-prompt-return
|
|
|
344 "Prompts for function result type."
|
|
|
345 "[result type]: "
|
|
|
346 str)
|
|
|
347
|
|
|
348
|
|
|
349 (define-skeleton ada-function-spec
|
|
|
350 "Insert a function specification. Prompts for name and arguments."
|
|
|
351 "[function name]: "
|
|
|
352 "function " str
|
|
|
353 " (" ("[parameter_specification]: " str "; " ) -2 ")"
|
|
|
354 " return "
|
|
|
355 (ada-function-spec-prompt-return)
|
|
|
356 ";" \n )
|
|
|
357
|
|
|
358
|
|
|
359 (define-skeleton ada-procedure-spec
|
|
|
360 "Insert a procedure specification, prompting for its name and arguments."
|
|
|
361 "[procedure name]: "
|
|
|
362 "procedure " str
|
|
|
363 " (" ("[parameter_specification]: " str "; " ) -2 ")"
|
|
|
364 ";" \n )
|
|
|
365
|
|
|
366
|
|
|
367 (define-skeleton ada-subprogram-body
|
|
|
368 "Insert frame for subprogram body.
|
|
|
369 Invoke right after `ada-function-spec' or `ada-procedure-spec'."
|
|
|
370 ()
|
|
|
371 ;; Remove `;' from subprogram decl
|
|
|
372 (save-excursion
|
|
|
373 (ada-search-ignore-string-comment ada-subprog-start-re t nil)
|
|
|
374 (ada-search-ignore-string-comment "(" nil nil t)
|
|
|
375 (backward-char 1)
|
|
|
376 (forward-sexp 1)
|
|
|
377 (if (looking-at ";")
|
|
|
378 (delete-char 1)))
|
|
|
379 < "is" \n
|
|
|
380 > _ \n
|
|
|
381 < "begin" \n
|
|
|
382 > (if ada-stmt-use-debug
|
|
|
383 (format ada-debug-call-str (ada-func-or-proc-name))) \n
|
|
|
384 > \n
|
|
|
385 < (if ada-stmt-use-debug
|
|
|
386 "exception") & \n
|
|
|
387 > (if ada-stmt-use-debug
|
|
|
388 "when others =>") & \n
|
|
|
389 > (if ada-stmt-use-debug
|
|
|
390 (format ada-debug-exception-str (ada-func-or-proc-name))) \n
|
|
|
391 < < "end "
|
|
|
392 (ada-func-or-proc-name)
|
|
|
393 ?\;)
|
|
|
394
|
|
|
395
|
|
|
396 (define-skeleton ada-separate
|
|
|
397 "Finish a body stub with `separate'."
|
|
|
398 ()
|
|
|
399 > "separate;" \n
|
|
|
400 <)
|
|
|
401
|
|
|
402
|
|
|
403 ;(define-skeleton ada-with
|
|
|
404 ; "Inserts a with clause, prompting for the list of units depended upon."
|
|
|
405 ; "[list of units depended upon]: "
|
|
|
406 ; "with " str ?\;)
|
|
|
407
|
|
|
408 ;(define-skeleton ada-use
|
|
|
409 ; "Inserts a use clause, prompting for the list of packages used."
|
|
|
410 ; "[list of packages used]: "
|
|
|
411 ; "use " str ?\;)
|
|
|
412
|
|
|
413
|
|
|
414 (define-skeleton ada-record
|
|
|
415 "Insert a skeleton record type declaration."
|
|
|
416 ()
|
|
|
417 "record" \n
|
|
|
418 > _ \n
|
|
|
419 < "end record;")
|
|
|
420
|
|
|
421
|
|
|
422 (define-skeleton ada-subtype
|
|
|
423 "Start insertion of a subtype declaration, prompting for the subtype name."
|
|
|
424 "[subtype name]: "
|
|
|
425 "subtype " str " is " _ ?\;
|
|
|
426 (not (message "insert subtype indication.")))
|
|
|
427
|
|
|
428
|
|
|
429 (define-skeleton ada-type
|
|
|
430 "Start insertion of a type declaration, prompting for the type name."
|
|
|
431 "[type name]: "
|
|
|
432 "type " str ?\(
|
|
|
433 ("[discriminant specs]: " str " ")
|
|
|
434 | (backward-delete-char 1) | ?\)
|
|
|
435 " is "
|
|
|
436 (not (message "insert type definition.")))
|
|
|
437
|
|
|
438
|
|
|
439 (define-skeleton ada-task-body
|
|
|
440 "Insert a task body, prompting for the task name."
|
|
|
441 "[task name]: "
|
|
|
442 "task body " str " is\n"
|
|
|
443 "begin\n"
|
|
|
444 > _ \n
|
|
|
445 < "end " str ";" )
|
|
|
446
|
|
|
447
|
|
|
448 (define-skeleton ada-task-spec
|
|
|
449 "Insert a task specification, prompting for the task name."
|
|
|
450 "[task name]: "
|
|
|
451 "task " str
|
|
|
452 " (" ("[discriminant]: " str "; ") ") is\n"
|
|
|
453 > "entry " _ \n
|
|
|
454 <"end " str ";" )
|
|
|
455
|
|
|
456
|
|
|
457 (define-skeleton ada-get-param1
|
|
|
458 "Prompt for arguments and if any enclose them in brackets."
|
|
|
459 ()
|
|
|
460 ("[parameter_specification]: " str "; " ) & -2 & ")"
|
|
|
461 )
|
|
|
462
|
|
|
463
|
|
|
464 (define-skeleton ada-get-param
|
|
|
465 "Prompt for arguments and if any enclose them in brackets."
|
|
|
466 ()
|
|
|
467 " ("
|
|
|
468 (ada-get-param1) | -2
|
|
|
469 )
|
|
|
470
|
|
|
471
|
|
|
472 (define-skeleton ada-entry
|
|
|
473 "Insert a task entry, prompting for the entry name."
|
|
|
474 "[entry name]: "
|
|
|
475 "entry " str
|
|
|
476 (ada-get-param)
|
|
|
477 ";" \n
|
|
|
478 ; (ada-indent-current)
|
|
|
479 )
|
|
|
480
|
|
|
481
|
|
|
482 (define-skeleton ada-entry-family-prompt-discriminant
|
|
|
483 "Insert a entry specification, prompting for the entry name."
|
|
|
484 "[discriminant name]: "
|
|
|
485 str)
|
|
|
486
|
|
|
487
|
|
|
488 (define-skeleton ada-entry-family
|
|
|
489 "Insert a entry specification, prompting for the entry name."
|
|
|
490 "[entry name]: "
|
|
|
491 "entry " str
|
|
|
492 " (" (ada-entry-family-prompt-discriminant) ")"
|
|
|
493 (ada-get-param)
|
|
|
494 ";" \n
|
|
|
495 ;(ada-indent-current)
|
|
|
496 )
|
|
|
497
|
|
|
498
|
|
|
499 (define-skeleton ada-select
|
|
|
500 "Insert a select block."
|
|
|
501 ()
|
|
|
502 "select\n"
|
|
|
503 > _ \n
|
|
|
504 < "end select;")
|
|
|
505
|
|
|
506
|
|
|
507 (define-skeleton ada-accept-1
|
|
|
508 "Insert a condition statement, prompting for the condition name."
|
|
|
509 "[condition]: "
|
|
|
510 "when " str | -5 )
|
|
|
511
|
|
|
512
|
|
|
513 (define-skeleton ada-accept-2
|
|
|
514 "Insert an accept statement, prompting for the name and arguments."
|
|
|
515 "[accept name]: "
|
|
|
516 > "accept " str
|
|
|
517 (ada-get-param)
|
|
|
518 ; " (" ("[parameter_specification]: " str "; ") -2 ")"
|
|
|
519 " do" \n
|
|
|
520 > _ \n
|
|
|
521 < "end " str ";" )
|
|
|
522
|
|
|
523
|
|
|
524 (define-skeleton ada-accept
|
|
|
525 "Insert an accept statement (prompt for condition, name and arguments)."
|
|
|
526 ()
|
|
|
527 > (ada-accept-1) & " =>\n"
|
|
|
528 (ada-accept-2)
|
|
|
529 )
|
|
|
530
|
|
|
531
|
|
|
532 (define-skeleton ada-or-accept
|
|
|
533 "Insert a or statement, prompting for the condition name."
|
|
|
534 ()
|
|
|
535 < "or\n"
|
|
|
536 (ada-accept)
|
|
|
537 )
|
|
|
538
|
|
|
539
|
|
|
540 (define-skeleton ada-or-delay
|
|
|
541 "Insert a delay statement, prompting for the delay value."
|
|
|
542 "[delay value]: "
|
|
|
543 < "or\n"
|
|
|
544 > "delay " str ";")
|
|
|
545
|
|
|
546
|
|
|
547 (define-skeleton ada-or-terminate
|
|
|
548 "Insert a terminate statement."
|
|
|
549 ()
|
|
|
550 < "or\n"
|
|
|
551 > "terminate;")
|
|
|
552
|
|
|
553
|
|
|
554 ;; ----
|
|
|
555 (defun ada-adjust-case-skeleton ()
|
|
|
556 "Adjusts the case of the text inserted by a skeleton."
|
|
|
557 (save-excursion
|
|
|
558 (let ((aa-end (point)))
|
|
|
559 (ada-adjust-case-region
|
|
|
560 (progn (goto-char beg) (forward-word -1) (point))
|
|
|
561 (goto-char aa-end))
|
|
|
562 )))
|
|
|
563
|
|
|
564
|
|
|
565 ;; ---- add menu 'Statements' in Ada mode (MH)
|
|
|
566 (defun ada-add-statement-menu ()
|
|
|
567 "Adds the menu 'Statements' to the menu bar in Ada mode."
|
|
|
568 (easy-menu-define ada-stmt-menu ada-mode-map
|
|
|
569 "Menu for statement templates in Ada."
|
|
|
570 '("Statements"
|
|
|
571 ; ["Toggle Prompt/Pseudo Code" toggle-skeleton-no-prompt t]
|
|
|
572 ["Toggle: Debugging" ada-toggle-debugging t]
|
|
|
573 ; ["-------" nil nil]
|
|
|
574 ["Header" (ada-header) t]
|
|
|
575 ["-------" nil nil]
|
|
|
576 ["package Body" (ada-package-body) t]
|
|
|
577 ["package Spec" (ada-package-spec) t]
|
|
|
578 ["function Spec" (ada-function-spec) t]
|
|
|
579 ["procedure Spec" (ada-procedure-spec) t]
|
|
|
580 ["proc/func Body" (ada-subprogram-body) t]
|
|
|
581 ["task Body" (ada-task-body) t]
|
|
|
582 ["task Spec" (ada-task-spec) t]
|
|
|
583 ["declare Block" (ada-declare-block) t]
|
|
|
584 ["exception Block" (ada-exception-block) t]
|
|
|
585 ["------" nil nil]
|
|
|
586 ["entry" (ada-entry) t]
|
|
|
587 ["entry family" (ada-entry-family) t]
|
|
|
588 ["select" (ada-select) t]
|
|
|
589 ["accept" (ada-accept) t]
|
|
|
590 ["or accept" (ada-or-accept) t]
|
|
|
591 ["or delay" (ada-or-delay) t]
|
|
|
592 ["or terminate" (ada-or-terminate) t]
|
|
|
593 ["-----" nil nil]
|
|
|
594 ["type" (ada-type) t]
|
|
|
595 ["private" (ada-private) t]
|
|
|
596 ["subtype" (ada-subtype) t]
|
|
|
597 ["record" (ada-record) t]
|
|
|
598 ["array" (ada-array) t]
|
|
|
599 ["------" nil nil]
|
|
|
600 ["if" (ada-if) t]
|
|
|
601 ["else" (ada-else) t]
|
|
|
602 ["elsif" (ada-elsif) t]
|
|
|
603 ["case" (ada-case) t]
|
|
|
604 ["-----" nil nil]
|
|
|
605 ["while Loop" (ada-while-loop) t]
|
|
|
606 ["for Loop" (ada-for-loop) t]
|
|
|
607 ["loop" (ada-loop) t]
|
|
|
608 ["---" nil nil]
|
|
|
609 ["exception" (ada-exception) t]
|
|
|
610 ["exit" (ada-exit) t]
|
|
|
611 ["when" (ada-when) t]
|
|
|
612 ))
|
|
|
613 (if (ada-xemacs)
|
|
|
614 (progn
|
|
|
615 (easy-menu-add ada-stmt-menu)
|
|
|
616 (setq mode-popup-menu (cons "Ada Mode" ada-stmt-menu)))))
|
|
|
617
|
|
|
618
|
|
|
619
|
|
|
620 (add-hook 'ada-mode-hook 'ada-add-statement-menu)
|
|
|
621 (add-hook 'ada-mode-hook '(lambda ()
|
|
|
622 (setq skeleton-further-elements
|
|
|
623 '((< '(backward-delete-char-untabify
|
|
|
624 (min ada-indent (current-column))))))
|
|
|
625 (add-hook 'skeleton-end-hook
|
|
|
626 'ada-adjust-case-skeleton)))
|
|
|
627
|
|
|
628 (provide 'ada-stmt)
|
|
|
629
|
|
|
630 ;;; ada-stmt.el ends here
|
