aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2000-11-23 17:56:10 +0000
committerStefan Monnier2000-11-23 17:56:10 +0000
commit9dd7cdcc1c723a2b7619d9b10157bb5371a5d850 (patch)
treeb3aab0ddb0f5cd2bb84a3800e0e1ff2b784befc3
parentc0393b5e29561210b8079b8572cb3113fc85b744 (diff)
downloademacs-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.el158
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,
281prompting for the boolean-expression." 281prompting 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