Mercurial > emacs
comparison lisp/progmodes/ada-stmt.el @ 33823:d29063c1c480
(ada-template-map): Initialize and bind it to C-c t in ada-mode-map.
(ada-stmt-mode-hook): New function extracted from old code.
Only change the buffer-local side of skeleton-*.
(ada-mode-hook): Use it.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 23 Nov 2000 17:56:10 +0000 |
parents | 0f1f7e931493 |
children | a5fbe8c7b12d |
comparison
equal
deleted
inserted
replaced
33822:e5a166907bbd | 33823:d29063c1c480 |
---|---|
1 ;;; ada-stmt.el --- An extension to Ada mode for inserting statement templates. | 1 ;;; ada-stmt.el --- An extension to Ada mode for inserting statement templates. |
2 | 2 |
3 ;; Copyright(C) 1987, 1993, 1994, 1996, 1997, 1998, 1999 | 3 ;; Copyright(C) 1987, 1993, 1994, 1996, 1997, 1998, 1999 |
4 ;; Free Software Foundation, Inc. | 4 ;; Free Software Foundation, Inc. |
5 | 5 |
6 ;; Ada Core Technologies's version: $Revision: 1.6 $ | 6 ;; Ada Core Technologies's version: $Revision: 1.7 $ |
7 | 7 |
8 ;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de> | 8 ;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de> |
9 ;; Maintainer: Rolf Ebert <ebert@waporo.muc.de> | 9 ;; Maintainer: Rolf Ebert <ebert@waporo.muc.de> |
10 ;; Keywords: languages, ada | 10 ;; Keywords: languages, ada |
11 ;; Rolf Ebert's version: 2.26 | 11 ;; Rolf Ebert's version: 2.26 |
67 (error nil))) | 67 (error nil))) |
68 | 68 |
69 (require 'easymenu) | 69 (require 'easymenu) |
70 | 70 |
71 (defun ada-stmt-add-to-ada-menu () | 71 (defun ada-stmt-add-to-ada-menu () |
72 "Add a new submenu to the Ada menu" | 72 "Add a new submenu to the Ada menu." |
73 (interactive) | 73 (interactive) |
74 (let ((menu '(["Header" ada-header t] | 74 (let ((menu '(["Header" ada-header t] |
75 ["-" nil nil] | 75 ["-" nil nil] |
76 ["Package Body" ada-package-body t] | 76 ["Package Body" ada-package-body t] |
77 ["Package Spec" ada-package-spec t] | 77 ["Package Spec" ada-package-spec t] |
118 (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [Statements] | 118 (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [Statements] |
119 (list 'menu-item | 119 (list 'menu-item |
120 "Statements" | 120 "Statements" |
121 (easy-menu-create-menu "Statements" menu) | 121 (easy-menu-create-menu "Statements" menu) |
122 :visible '(string= mode-name "Ada")) | 122 :visible '(string= mode-name "Ada")) |
123 t)) | 123 t)))) |
124 )) | |
125 | 124 |
126 | 125 |
127 | 126 |
128 | 127 |
129 (defun ada-func-or-proc-name () | 128 (defun ada-func-or-proc-name () |
132 (let ((case-fold-search t)) | 131 (let ((case-fold-search t)) |
133 (if (re-search-backward ada-procedure-start-regexp nil t) | 132 (if (re-search-backward ada-procedure-start-regexp nil t) |
134 (buffer-substring (match-beginning 2) (match-end 2)) | 133 (buffer-substring (match-beginning 2) (match-end 2)) |
135 "NAME?")))) | 134 "NAME?")))) |
136 | 135 |
137 (defvar ada-template-map nil | 136 (defvar ada-template-map |
137 (let ((map (make-sparse-keymap))) | |
138 (define-key map "h" 'ada-header) | |
139 (define-key map "\C-a" 'ada-array) | |
140 (define-key map "b" 'ada-exception-block) | |
141 (define-key map "d" 'ada-declare-block) | |
142 (define-key map "c" 'ada-case) | |
143 (define-key map "\C-e" 'ada-elsif) | |
144 (define-key map "e" 'ada-else) | |
145 (define-key map "\C-k" 'ada-package-spec) | |
146 (define-key map "k" 'ada-package-body) | |
147 (define-key map "\C-p" 'ada-procedure-spec) | |
148 (define-key map "p" 'ada-subprogram-body) | |
149 (define-key map "\C-f" 'ada-function-spec) | |
150 (define-key map "f" 'ada-for-loop) | |
151 (define-key map "i" 'ada-if) | |
152 (define-key map "l" 'ada-loop) | |
153 (define-key map "\C-r" 'ada-record) | |
154 (define-key map "\C-s" 'ada-subtype) | |
155 (define-key map "S" 'ada-tabsize) | |
156 (define-key map "\C-t" 'ada-task-spec) | |
157 (define-key map "t" 'ada-task-body) | |
158 (define-key map "\C-y" 'ada-type) | |
159 (define-key map "\C-v" 'ada-private) | |
160 (define-key map "u" 'ada-use) | |
161 (define-key map "\C-u" 'ada-with) | |
162 (define-key map "\C-w" 'ada-when) | |
163 (define-key map "w" 'ada-while-loop) | |
164 (define-key map "\C-x" 'ada-exception) | |
165 (define-key map "x" 'ada-exit) | |
166 map) | |
138 "Keymap used in Ada mode for smart template operations.") | 167 "Keymap used in Ada mode for smart template operations.") |
139 | 168 |
140 (define-key ada-mode-map "\C-cth" 'ada-header) | 169 (define-key ada-mode-map "\C-ct" ada-template-map) |
141 (define-key ada-mode-map "\C-ct\C-a" 'ada-array) | |
142 (define-key ada-mode-map "\C-ctb" 'ada-exception-block) | |
143 (define-key ada-mode-map "\C-ctd" 'ada-declare-block) | |
144 (define-key ada-mode-map "\C-ctc" 'ada-case) | |
145 (define-key ada-mode-map "\C-ct\C-e" 'ada-elsif) | |
146 (define-key ada-mode-map "\C-cte" 'ada-else) | |
147 (define-key ada-mode-map "\C-ct\C-k" 'ada-package-spec) | |
148 (define-key ada-mode-map "\C-ctk" 'ada-package-body) | |
149 (define-key ada-mode-map "\C-ct\C-p" 'ada-procedure-spec) | |
150 (define-key ada-mode-map "\C-ctp" 'ada-subprogram-body) | |
151 (define-key ada-mode-map "\C-ct\C-f" 'ada-function-spec) | |
152 (define-key ada-mode-map "\C-ctf" 'ada-for-loop) | |
153 (define-key ada-mode-map "\C-cti" 'ada-if) | |
154 (define-key ada-mode-map "\C-ctl" 'ada-loop) | |
155 (define-key ada-mode-map "\C-ct\C-r" 'ada-record) | |
156 (define-key ada-mode-map "\C-ct\C-s" 'ada-subtype) | |
157 (define-key ada-mode-map "\C-ctS" 'ada-tabsize) | |
158 (define-key ada-mode-map "\C-ct\C-t" 'ada-task-spec) | |
159 (define-key ada-mode-map "\C-ctt" 'ada-task-body) | |
160 (define-key ada-mode-map "\C-ct\C-y" 'ada-type) | |
161 (define-key ada-mode-map "\C-ct\C-v" 'ada-private) | |
162 (define-key ada-mode-map "\C-ctu" 'ada-use) | |
163 (define-key ada-mode-map "\C-ct\C-u" 'ada-with) | |
164 (define-key ada-mode-map "\C-ct\C-w" 'ada-when) | |
165 (define-key ada-mode-map "\C-ctw" 'ada-while-loop) | |
166 (define-key ada-mode-map "\C-ct\C-x" 'ada-exception) | |
167 (define-key ada-mode-map "\C-ctx" 'ada-exit) | |
168 | 170 |
169 ;;; ---- statement skeletons ------------------------------------------ | 171 ;;; ---- statement skeletons ------------------------------------------ |
170 | 172 |
171 (define-skeleton ada-array | 173 (define-skeleton ada-array |
172 "Insert array type definition. | 174 "Insert array type definition. |
230 | 232 |
231 | 233 |
232 (define-skeleton ada-exit | 234 (define-skeleton ada-exit |
233 "Insert an exit statement, prompting for loop name and condition." | 235 "Insert an exit statement, prompting for loop name and condition." |
234 "[name of loop to exit]: " | 236 "[name of loop to exit]: " |
235 "exit " str & ?\ | 237 "exit " str & ?\ (ada-exit-1) | -1 ?\;) |
236 (ada-exit-1) | |
237 | -1 ?\;) | |
238 | 238 |
239 ;;;###autoload | 239 ;;;###autoload |
240 (defun ada-header () | 240 (defun ada-header () |
241 "Insert a descriptive header at the top of the file." | 241 "Insert a descriptive header at the top of the file." |
242 (interactive "*") | 242 (interactive "*") |
251 "Insert a comment block containing the module title, author, etc." | 251 "Insert a comment block containing the module title, author, etc." |
252 "[Description]: " | 252 "[Description]: " |
253 "-- -*- Mode: Ada -*-" | 253 "-- -*- Mode: Ada -*-" |
254 "\n" ada-fill-comment-prefix "Filename : " (buffer-name) | 254 "\n" ada-fill-comment-prefix "Filename : " (buffer-name) |
255 "\n" ada-fill-comment-prefix "Description : " str | 255 "\n" ada-fill-comment-prefix "Description : " str |
256 "\n" ada-fill-comment-prefix "Author : " (user-full-name) | 256 "\n" ada-fill-comment-prefix "Author : " (user-full-name) |
257 "\n" ada-fill-comment-prefix "Created On : " (current-time-string) | 257 "\n" ada-fill-comment-prefix "Created On : " (current-time-string) |
258 "\n" ada-fill-comment-prefix "Last Modified By: ." | 258 "\n" ada-fill-comment-prefix "Last Modified By: ." |
259 "\n" ada-fill-comment-prefix "Last Modified On: ." | 259 "\n" ada-fill-comment-prefix "Last Modified On: ." |
260 "\n" ada-fill-comment-prefix "Update Count : 0" | 260 "\n" ada-fill-comment-prefix "Update Count : 0" |
261 "\n" ada-fill-comment-prefix "Status : Unknown, Use with caution!" | 261 "\n" ada-fill-comment-prefix "Status : Unknown, Use with caution!" |
275 > _ \n | 275 > _ \n |
276 < "end if;") | 276 < "end if;") |
277 | 277 |
278 | 278 |
279 (define-skeleton ada-elsif | 279 (define-skeleton ada-elsif |
280 "Add an elsif clause to an if statement, | 280 "Add an elsif clause to an if statement, |
281 prompting for the boolean-expression." | 281 prompting for the boolean-expression." |
282 "[condition]: " | 282 "[condition]: " |
283 < "elsif " str " then" \n | 283 < "elsif " str " then" \n |
284 >) | 284 >) |
285 | 285 |
373 | 373 |
374 | 374 |
375 (define-skeleton ada-function-spec | 375 (define-skeleton ada-function-spec |
376 "Insert a function specification. Prompts for name and arguments." | 376 "Insert a function specification. Prompts for name and arguments." |
377 "[function name]: " | 377 "[function name]: " |
378 "function " str | 378 "function " str |
379 " (" ("[parameter_specification]: " str "; " ) -2 ")" | 379 " (" ("[parameter_specification]: " str "; " ) -2 ")" |
380 " return " | 380 " return " |
381 (ada-function-spec-prompt-return) | 381 (ada-function-spec-prompt-return) |
382 ";" \n ) | 382 ";" \n ) |
383 | 383 |
384 | 384 |
385 (define-skeleton ada-procedure-spec | 385 (define-skeleton ada-procedure-spec |
386 "Insert a procedure specification, prompting for its name and arguments." | 386 "Insert a procedure specification, prompting for its name and arguments." |
387 "[procedure name]: " | 387 "[procedure name]: " |
388 "procedure " str | 388 "procedure " str |
389 " (" ("[parameter_specification]: " str "; " ) -2 ")" | 389 " (" ("[parameter_specification]: " str "; " ) -2 ")" |
390 ";" \n ) | 390 ";" \n ) |
391 | 391 |
392 | 392 |
393 (define-skeleton ada-subprogram-body | 393 (define-skeleton ada-subprogram-body |
396 () | 396 () |
397 ;; Remove `;' from subprogram decl | 397 ;; Remove `;' from subprogram decl |
398 (save-excursion | 398 (save-excursion |
399 (let ((pos (1+ (point)))) | 399 (let ((pos (1+ (point)))) |
400 (ada-search-ignore-string-comment ada-subprog-start-re t nil) | 400 (ada-search-ignore-string-comment ada-subprog-start-re t nil) |
401 (if (ada-search-ignore-string-comment "(" nil pos t 'search-forward) | 401 (when (ada-search-ignore-string-comment "(" nil pos t 'search-forward) |
402 (progn | 402 (backward-char 1) |
403 (backward-char 1) | 403 (forward-sexp 1))) |
404 (forward-sexp 1))) | |
405 ) | |
406 (if (looking-at ";") | 404 (if (looking-at ";") |
407 (delete-char 1))) | 405 (delete-char 1))) |
408 " is" \n | 406 " is" \n |
409 _ \n | 407 _ \n |
410 < "begin" \n | 408 < "begin" \n |
469 | 467 |
470 | 468 |
471 (define-skeleton ada-task-spec | 469 (define-skeleton ada-task-spec |
472 "Insert a task specification, prompting for the task name." | 470 "Insert a task specification, prompting for the task name." |
473 "[task name]: " | 471 "[task name]: " |
474 "task " str | 472 "task " str |
475 " (" ("[discriminant]: " str "; ") ") is\n" | 473 " (" ("[discriminant]: " str "; ") ") is\n" |
476 > "entry " _ \n | 474 > "entry " _ \n |
477 <"end " str ";" ) | 475 <"end " str ";" ) |
478 | 476 |
479 | 477 |
480 (define-skeleton ada-get-param1 | 478 (define-skeleton ada-get-param1 |
481 "Prompt for arguments and if any enclose them in brackets." | 479 "Prompt for arguments and if any enclose them in brackets." |
482 () | 480 () |
483 ("[parameter_specification]: " str "; " ) & -2 & ")" | 481 ("[parameter_specification]: " str "; " ) & -2 & ")") |
484 ) | |
485 | 482 |
486 | 483 |
487 (define-skeleton ada-get-param | 484 (define-skeleton ada-get-param |
488 "Prompt for arguments and if any enclose them in brackets." | 485 "Prompt for arguments and if any enclose them in brackets." |
489 () | 486 () |
490 " (" | 487 " (" |
491 (ada-get-param1) | -2 | 488 (ada-get-param1) | -2) |
492 ) | |
493 | 489 |
494 | 490 |
495 (define-skeleton ada-entry | 491 (define-skeleton ada-entry |
496 "Insert a task entry, prompting for the entry name." | 492 "Insert a task entry, prompting for the entry name." |
497 "[entry name]: " | 493 "[entry name]: " |
498 "entry " str | 494 "entry " str |
499 (ada-get-param) | 495 (ada-get-param) |
500 ";" \n | 496 ";" \n) |
501 ; (ada-indent-current) | |
502 ) | |
503 | 497 |
504 | 498 |
505 (define-skeleton ada-entry-family-prompt-discriminant | 499 (define-skeleton ada-entry-family-prompt-discriminant |
506 "Insert a entry specification, prompting for the entry name." | 500 "Insert a entry specification, prompting for the entry name." |
507 "[discriminant name]: " | 501 "[discriminant name]: " |
512 "Insert a entry specification, prompting for the entry name." | 506 "Insert a entry specification, prompting for the entry name." |
513 "[entry name]: " | 507 "[entry name]: " |
514 "entry " str | 508 "entry " str |
515 " (" (ada-entry-family-prompt-discriminant) ")" | 509 " (" (ada-entry-family-prompt-discriminant) ")" |
516 (ada-get-param) | 510 (ada-get-param) |
517 ";" \n | 511 ";" \n) |
518 ;(ada-indent-current) | |
519 ) | |
520 | 512 |
521 | 513 |
522 (define-skeleton ada-select | 514 (define-skeleton ada-select |
523 "Insert a select block." | 515 "Insert a select block." |
524 () | 516 () |
527 < "end select;") | 519 < "end select;") |
528 | 520 |
529 | 521 |
530 (define-skeleton ada-accept-1 | 522 (define-skeleton ada-accept-1 |
531 "Insert a condition statement, prompting for the condition name." | 523 "Insert a condition statement, prompting for the condition name." |
532 "[condition]: " | 524 "[condition]: " |
533 "when " str | -5 ) | 525 "when " str | -5 ) |
534 | 526 |
535 | 527 |
536 (define-skeleton ada-accept-2 | 528 (define-skeleton ada-accept-2 |
537 "Insert an accept statement, prompting for the name and arguments." | 529 "Insert an accept statement, prompting for the name and arguments." |
538 "[accept name]: " | 530 "[accept name]: " |
539 > "accept " str | 531 > "accept " str |
540 (ada-get-param) | 532 (ada-get-param) |
541 ; " (" ("[parameter_specification]: " str "; ") -2 ")" | 533 ;;; " (" ("[parameter_specification]: " str "; ") -2 ")" |
542 " do" \n | 534 " do" \n |
543 > _ \n | 535 > _ \n |
544 < "end " str ";" ) | 536 < "end " str ";" ) |
545 | 537 |
546 | 538 |
547 (define-skeleton ada-accept | 539 (define-skeleton ada-accept |
548 "Insert an accept statement (prompt for condition, name and arguments)." | 540 "Insert an accept statement (prompt for condition, name and arguments)." |
549 () | 541 () |
550 > (ada-accept-1) & " =>\n" | 542 > (ada-accept-1) & " =>\n" |
551 (ada-accept-2) | 543 (ada-accept-2)) |
552 ) | |
553 | 544 |
554 | 545 |
555 (define-skeleton ada-or-accept | 546 (define-skeleton ada-or-accept |
556 "Insert a or statement, prompting for the condition name." | 547 "Insert an or statement, prompting for the condition name." |
557 () | 548 () |
558 < "or\n" | 549 < "or\n" |
559 (ada-accept) | 550 (ada-accept)) |
560 ) | |
561 | 551 |
562 | 552 |
563 (define-skeleton ada-or-delay | 553 (define-skeleton ada-or-delay |
564 "Insert a delay statement, prompting for the delay value." | 554 "Insert a delay statement, prompting for the delay value." |
565 "[delay value]: " | 555 "[delay value]: " |
566 < "or\n" | 556 < "or\n" |
567 > "delay " str ";") | 557 > "delay " str ";") |
568 | 558 |
569 | 559 |
570 (define-skeleton ada-or-terminate | 560 (define-skeleton ada-or-terminate |
572 () | 562 () |
573 < "or\n" | 563 < "or\n" |
574 > "terminate;") | 564 > "terminate;") |
575 | 565 |
576 | 566 |
577 ;; ---- | 567 ;; ---- |
578 (defun ada-adjust-case-skeleton () | 568 (defun ada-adjust-case-skeleton () |
579 "Adjusts the case of the text inserted by a skeleton." | 569 "Adjust the case of the text inserted by a skeleton." |
580 (save-excursion | 570 (save-excursion |
581 (let ((aa-end (point))) | 571 (let ((aa-end (point))) |
582 (ada-adjust-case-region | 572 (ada-adjust-case-region |
583 (progn (goto-char (symbol-value 'beg)) (forward-word -1) (point)) | 573 (progn (goto-char (symbol-value 'beg)) (forward-word -1) (point)) |
584 (goto-char aa-end)) | 574 (goto-char aa-end))))) |
585 ))) | 575 |
586 | 576 (defun ada-stmt-mode-hook () |
587 (add-hook 'ada-mode-hook '(lambda () | 577 (set (make-local-variable 'skeleton-further-elements) |
588 (setq skeleton-further-elements | 578 '((< '(backward-delete-char-untabify |
589 '((< '(backward-delete-char-untabify | 579 (min ada-indent (current-column)))))) |
590 (min ada-indent (current-column)))))) | 580 (add-hook 'skeleton-end-hook |
591 (add-hook 'skeleton-end-hook | 581 'ada-adjust-case-skeleton nil t) |
592 'ada-adjust-case-skeleton))) | 582 (ada-stmt-add-to-ada-menu)) |
593 | 583 |
594 (add-hook 'ada-mode-hook 'ada-stmt-add-to-ada-menu) | 584 (add-hook 'ada-mode-hook 'ada-stmt-mode-hook) |
595 | 585 |
596 (provide 'ada-stmt) | 586 (provide 'ada-stmt) |
597 | 587 |
598 ;;; ada-stmt.el ends here | 588 ;;; ada-stmt.el ends here |