diff options
| author | Stefan Monnier | 2000-11-23 17:56:10 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2000-11-23 17:56:10 +0000 |
| commit | 9dd7cdcc1c723a2b7619d9b10157bb5371a5d850 (patch) | |
| tree | b3aab0ddb0f5cd2bb84a3800e0e1ff2b784befc3 | |
| parent | c0393b5e29561210b8079b8572cb3113fc85b744 (diff) | |
| download | emacs-9dd7cdcc1c723a2b7619d9b10157bb5371a5d850.tar.gz emacs-9dd7cdcc1c723a2b7619d9b10157bb5371a5d850.zip | |
(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.
| -rw-r--r-- | lisp/progmodes/ada-stmt.el | 158 |
1 files changed, 74 insertions, 84 deletions
diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el index 7d09c68a10e..fc420ec9ebc 100644 --- a/lisp/progmodes/ada-stmt.el +++ b/lisp/progmodes/ada-stmt.el | |||
| @@ -3,7 +3,7 @@ | |||
| 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> |
| @@ -69,7 +69,7 @@ | |||
| 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] |
| @@ -120,8 +120,7 @@ | |||
| 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 | ||
| @@ -134,37 +133,40 @@ | |||
| 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 | ||
| @@ -232,9 +234,7 @@ Indent for the first line of code." | |||
| 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 () |
| @@ -253,7 +253,7 @@ Indent for the first line of code." | |||
| 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: ." |
| @@ -277,7 +277,7 @@ Indent for the first line of code." | |||
| 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 |
| @@ -375,7 +375,7 @@ prompting for the boolean-expression." | |||
| 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) |
| @@ -385,7 +385,7 @@ prompting for the boolean-expression." | |||
| 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 | ||
| @@ -398,11 +398,9 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'." | |||
| 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 |
| @@ -471,7 +469,7 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'." | |||
| 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 ";" ) |
| @@ -480,26 +478,22 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'." | |||
| 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 |
| @@ -514,9 +508,7 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'." | |||
| 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 |
| @@ -529,16 +521,16 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'." | |||
| 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 ";" ) |
| @@ -548,21 +540,19 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'." | |||
| 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 | ||
| @@ -574,24 +564,24 @@ Invoke right after `ada-function-spec' or `ada-procedure-spec'." | |||
| 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 | ||