Mercurial > emacs

comparison lisp/progmodes/ada-stmt.el @ 25902:92828b88cfcc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(ada-stmt-add-to-ada-menu): New function (ada-subprogram-body): Correctly find the name of the subprogram being created.
author Gerd Moellmann <gerd@gnu.org>
date Thu, 07 Oct 1999 14:32:32 +0000
parents 8d2bb5d1416a
children c9e91fc553e6
comparison
equal deleted inserted replaced
25901:9f327fa7ac10 25902:92828b88cfcc
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 Free Software Foundation, Inc. 3 ;; Copyright (C) 1987, 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
4 4
5 ;; Authors: Daniel Pfeiffer <occitan@esperanto.org>, Markus Heritsch, 5 ;; Ada Core Technologies's version: $Revision: 1.10 $
6 ;; Rolf Ebert <ebert@waporo.muc.de> 6
7 ;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de>
7 ;; Maintainer: Rolf Ebert <ebert@waporo.muc.de> 8 ;; Maintainer: Rolf Ebert <ebert@waporo.muc.de>
8 ;; Keywords: languages, ada 9 ;; Keywords: languages, ada
9 ;; Rolf Ebert's version: 2.26 10 ;; Rolf Ebert's version: 2.26
10 11
11 ;;; Commentary: 12 ;;; Commentary:
58 ;;;update of the package :-) 59 ;;;update of the package :-)
59 60
60 61
61 ;;; Code: 62 ;;; Code:
62 63
63 (require 'ada-mode) 64 (eval-when-compile
64 (require 'skeleton) 65 (condition-case nil (require 'skeleton)
66 (error nil)))
65 (require 'easymenu) 67 (require 'easymenu)
66 68
67 (defgroup ada-stmt nil 69 (defun ada-stmt-add-to-ada-menu ()
68 "Extension to Ada mode for inserting statement templates" 70 "Add a new submenu to the Ada menu"
69 :group 'ada) 71 (interactive)
70 72 (let ((menu '(["Header" ada-header t]
71 (defcustom ada-stmt-use-debug t 73 ["-" nil nil]
72 "*Toggle to insert ada debug code parts." 74 ["Package Body" ada-package-body t]
73 :type 'boolean 75 ["Package Spec" ada-package-spec t]
74 :group 'ada-stmt) 76 ["Function Spec" ada-function-spec t]
75 77 ["Procedure Spec" ada-procedure-spec t]
76 78 ["Proc/func Body" ada-subprogram-body t]
77 (defcustom ada-debug-call-str "pragma Debug (%s);" 79 ["Task Body" ada-task-body t]
78 "*Debug call code to insert." 80 ["Task Spec" ada-task-spec t]
79 :type 'string 81 ["Declare Block" ada-declare-block t]
80 :group 'ada-stmt) 82 ["Exception Block" ada-exception-block t]
81 83 ["--" nil nil]
82 84 ["Entry" ada-entry t]
83 (defcustom ada-debug-exception-str "pragma Debug (%s);" 85 ["Entry family" ada-entry-family t]
84 "*Debug exception code to insert." 86 ["Select" ada-select t]
85 :type 'string 87 ["Accept" ada-accept t]
86 :group 'ada-stmt) 88 ["Or accept" ada-or-accep t]
87 89 ["Or delay" ada-or-delay t]
88 90 ["Or terminate" ada-or-terminate t]
91 ["---" nil nil]
92 ["Type" ada-type t]
93 ["Private" ada-private t]
94 ["Subtype" ada-subtype t]
95 ["Record" ada-record t]
96 ["Array" ada-array t]
97 ["----" nil nil]
98 ["If" ada-if t]
99 ["Else" ada-else t]
100 ["Elsif" ada-elsif t]
101 ["Case" ada-case t]
102 ["-----" nil nil]
103 ["While Loop" ada-while-loop t]
104 ["For Loop" ada-for-loop t]
105 ["Loop" ada-loop t]
106 ["------" nil nil]
107 ["Exception" ada-exception t]
108 ["Exit" ada-exit t]
109 ["When" ada-when t])))
110 (if ada-xemacs
111 (progn
112 (add-to-list 'menu "Statements")
113 (add-submenu '("Ada") menu))
114
115 (define-key-after (lookup-key ada-mode-map [menu-bar Ada]) [Statements]
116 (cons "Statements" (easy-menu-create-menu "Statements" menu)) t))
117 ))
118
119
120
89 121
90 (defun ada-func-or-proc-name () 122 (defun ada-func-or-proc-name ()
91 ;; Get the name of the current function or procedure." 123 ;; Get the name of the current function or procedure."
92 (save-excursion 124 (save-excursion
93 (let ((case-fold-search t)) 125 (let ((case-fold-search t))
94 (if (re-search-backward ada-procedure-start-regexp nil t) 126 (if (re-search-backward ada-procedure-start-regexp nil t)
95 (buffer-substring (match-beginning 2) (match-end 2)) 127 (buffer-substring (match-beginning 2) (match-end 2))
96 "NAME?")))) 128 "NAME?"))))
97 129
98
99 (defun ada-toggle-debugging ()
100 "Toggles behaviour of `ada-debug-info-insertion'."
101 (interactive)
102 (setq ada-stmt-use-debug (not ada-stmt-use-debug))
103 (if ada-stmt-use-debug
104 (message "Debugging enabled")
105 (message "Debugging disabled")))
106
107
108 (defvar ada-template-map nil 130 (defvar ada-template-map nil
109 "Keymap used in Ada mode for smart template operations.") 131 "Keymap used in Ada mode for smart template operations.")
110 132
111 133 (define-key ada-mode-map "\C-cth" 'ada-header)
112 (let ((ada-mp (make-sparse-keymap))) 134 (define-key ada-mode-map "\C-ct\C-a" 'ada-array)
113 (define-key ada-mp "h" 'ada-header) 135 (define-key ada-mode-map "\C-ctb" 'ada-exception-block)
114 ; (define-key ada-mp "p" 'ada-toggle-prompt-pseudo) 136 (define-key ada-mode-map "\C-ctd" 'ada-declare-block)
115 (define-key ada-mp "(" 'insert-parentheses) 137 (define-key ada-mode-map "\C-ctc" 'ada-case)
116 (define-key ada-mp "\C-a" 'ada-array) 138 (define-key ada-mode-map "\C-ct\C-e" 'ada-elsif)
117 (define-key ada-mp "b" 'ada-exception-block) 139 (define-key ada-mode-map "\C-cte" 'ada-else)
118 (define-key ada-mp "d" 'ada-declare-block) 140 (define-key ada-mode-map "\C-ct\C-k" 'ada-package-spec)
119 (define-key ada-mp "c" 'ada-case) 141 (define-key ada-mode-map "\C-ctk" 'ada-package-body)
120 (define-key ada-mp "\C-e" 'ada-elsif) 142 (define-key ada-mode-map "\C-ct\C-p" 'ada-procedure-spec)
121 (define-key ada-mp "e" 'ada-else) 143 (define-key ada-mode-map "\C-ctp" 'ada-subprogram-body)
122 (define-key ada-mp "\C-k" 'ada-package-spec) 144 (define-key ada-mode-map "\C-ct\C-f" 'ada-function-spec)
123 (define-key ada-mp "k" 'ada-package-body) 145 (define-key ada-mode-map "\C-ctf" 'ada-for-loop)
124 (define-key ada-mp "\C-p" 'ada-procedure-spec) 146 (define-key ada-mode-map "\C-cti" 'ada-if)
125 (define-key ada-mp "\C-f" 'ada-function-spec) 147 (define-key ada-mode-map "\C-ctl" 'ada-loop)
126 (define-key ada-mp "p" 'ada-subprogram-body) 148 (define-key ada-mode-map "\C-ct\C-r" 'ada-record)
127 (define-key ada-mp "f" 'ada-for-loop) 149 (define-key ada-mode-map "\C-ct\C-s" 'ada-subtype)
128 (define-key ada-mp "i" 'ada-if) 150 (define-key ada-mode-map "\C-ctS" 'ada-tabsize)
129 (define-key ada-mp "l" 'ada-loop) 151 (define-key ada-mode-map "\C-ct\C-t" 'ada-task-spec)
130 (define-key ada-mp "\C-r" 'ada-record) 152 (define-key ada-mode-map "\C-ctt" 'ada-task-body)
131 (define-key ada-mp "\C-s" 'ada-subtype) 153 (define-key ada-mode-map "\C-ct\C-y" 'ada-type)
132 (define-key ada-mp "S" 'ada-tabsize) 154 (define-key ada-mode-map "\C-ct\C-v" 'ada-private)
133 (define-key ada-mp "\C-t" 'ada-task-spec) 155 (define-key ada-mode-map "\C-ctu" 'ada-use)
134 (define-key ada-mp "t" 'ada-task-body) 156 (define-key ada-mode-map "\C-ct\C-u" 'ada-with)
135 (define-key ada-mp "\C-y" 'ada-type) 157 (define-key ada-mode-map "\C-ct\C-w" 'ada-when)
136 (define-key ada-mp "\C-v" 'ada-private) 158 (define-key ada-mode-map "\C-ctw" 'ada-while-loop)
137 (define-key ada-mp "u" 'ada-use) 159 (define-key ada-mode-map "\C-ct\C-x" 'ada-exception)
138 (define-key ada-mp "\C-u" 'ada-with) 160 (define-key ada-mode-map "\C-ctx" 'ada-exit)
139 (define-key ada-mp "\C-w" 'ada-when)
140 (define-key ada-mp "w" 'ada-while-loop)
141 (define-key ada-mp "\C-x" 'ada-exception)
142 (define-key ada-mp "x" 'ada-exit)
143 (setq ada-template-map ada-mp))
144
145 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
146 ;; Place the templates into Ada Mode. They may be inserted under any key.
147 ;; C-c C-t will be the default. If you use templates alot, you
148 ;; may want to consider moving the binding to another key in your .emacs
149 ;; file. Be sure to (require 'ada-stmt) first.
150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
151 ;(define-key ada-mode-map "\C-ct" ada-template-map)
152 (define-key ada-mode-map "\C-c\C-t" ada-template-map)
153 161
154 ;;; ---- statement skeletons ------------------------------------------ 162 ;;; ---- statement skeletons ------------------------------------------
155 163
156 (define-skeleton ada-array 164 (define-skeleton ada-array
157 "Insert array type definition. Uses the minibuffer to prompt 165 "Insert array type definition. Uses the minibuffer to prompt
219 "[name of loop to exit]: " 227 "[name of loop to exit]: "
220 "exit " str & ?\ 228 "exit " str & ?\
221 (ada-exit-1) 229 (ada-exit-1)
222 | -1 ?\;) 230 | -1 ?\;)
223 231
224 232 ;;;###autoload
225 (defun ada-header () 233 (defun ada-header ()
226 "Insert a descriptive header at the top of the file." 234 "Insert a descriptive header at the top of the file."
227 (interactive "*") 235 (interactive "*")
228 (save-excursion 236 (save-excursion
229 (goto-char (point-min)) 237 (goto-char (point-min))
379 "Insert frame for subprogram body. 387 "Insert frame for subprogram body.
380 Invoke right after `ada-function-spec' or `ada-procedure-spec'." 388 Invoke right after `ada-function-spec' or `ada-procedure-spec'."
381 () 389 ()
382 ;; Remove `;' from subprogram decl 390 ;; Remove `;' from subprogram decl
383 (save-excursion 391 (save-excursion
384 (ada-search-ignore-string-comment ada-subprog-start-re t nil) 392 (let ((pos (1+ (point))))
385 (ada-search-ignore-string-comment "(" nil nil t) 393 (ada-search-ignore-string-comment ada-subprog-start-re t nil)
386 (backward-char 1) 394 (if (ada-search-ignore-string-comment "(" nil pos t 'search-forward)
387 (forward-sexp 1) 395 (progn
396 (backward-char 1)
397 (forward-sexp 1)))
398 )
388 (if (looking-at ";") 399 (if (looking-at ";")
389 (delete-char 1))) 400 (delete-char 1)))
390 < "is" \n 401 " is" \n
391 > _ \n 402 _ \n
392 < "begin" \n 403 < "begin" \n
393 > (if ada-stmt-use-debug 404 \n
394 (format ada-debug-call-str (ada-func-or-proc-name))) \n 405 < "exception" \n
395 > \n 406 "when others => null;" \n
396 < (if ada-stmt-use-debug 407 < < "end "
397 "exception") & \n
398 > (if ada-stmt-use-debug
399 "when others =>") & \n
400 > (if ada-stmt-use-debug
401 (format ada-debug-exception-str (ada-func-or-proc-name))) \n
402 < < "end "
403 (ada-func-or-proc-name) 408 (ada-func-or-proc-name)
404 ?\;) 409 ";" \n)
405 410
406 411
407 (define-skeleton ada-separate 412 (define-skeleton ada-separate
408 "Finish a body stub with `separate'." 413 "Finish a body stub with `separate'."
409 () 414 ()
569 (let ((aa-end (point))) 574 (let ((aa-end (point)))
570 (ada-adjust-case-region 575 (ada-adjust-case-region
571 (progn (goto-char beg) (forward-word -1) (point)) 576 (progn (goto-char beg) (forward-word -1) (point))
572 (goto-char aa-end)) 577 (goto-char aa-end))
573 ))) 578 )))
574
575
576 ;; ---- add menu 'Statements' in Ada mode (MH)
577 (defun ada-add-statement-menu ()
578 "Adds the menu 'Statements' to the menu bar in Ada mode."
579 (easy-menu-define ada-stmt-menu ada-mode-map
580 "Menu for statement templates in Ada."
581 '("Statements"
582 ; ["Toggle Prompt/Pseudo Code" toggle-skeleton-no-prompt t]
583 ["Toggle: Debugging" ada-toggle-debugging t]
584 ; ["-------" nil nil]
585 ["Header" (ada-header) t]
586 ["-------" nil nil]
587 ["package Body" (ada-package-body) t]
588 ["package Spec" (ada-package-spec) t]
589 ["function Spec" (ada-function-spec) t]
590 ["procedure Spec" (ada-procedure-spec) t]
591 ["proc/func Body" (ada-subprogram-body) t]
592 ["task Body" (ada-task-body) t]
593 ["task Spec" (ada-task-spec) t]
594 ["declare Block" (ada-declare-block) t]
595 ["exception Block" (ada-exception-block) t]
596 ["------" nil nil]
597 ["entry" (ada-entry) t]
598 ["entry family" (ada-entry-family) t]
599 ["select" (ada-select) t]
600 ["accept" (ada-accept) t]
601 ["or accept" (ada-or-accept) t]
602 ["or delay" (ada-or-delay) t]
603 ["or terminate" (ada-or-terminate) t]
604 ["-----" nil nil]
605 ["type" (ada-type) t]
606 ["private" (ada-private) t]
607 ["subtype" (ada-subtype) t]
608 ["record" (ada-record) t]
609 ["array" (ada-array) t]
610 ["------" nil nil]
611 ["if" (ada-if) t]
612 ["else" (ada-else) t]
613 ["elsif" (ada-elsif) t]
614 ["case" (ada-case) t]
615 ["-----" nil nil]
616 ["while Loop" (ada-while-loop) t]
617 ["for Loop" (ada-for-loop) t]
618 ["loop" (ada-loop) t]
619 ["---" nil nil]
620 ["exception" (ada-exception) t]
621 ["exit" (ada-exit) t]
622 ["when" (ada-when) t]
623 ))
624 (if (ada-xemacs)
625 (progn
626 (easy-menu-add ada-stmt-menu)
627 (setq mode-popup-menu (cons "Ada Mode" ada-stmt-menu)))))
628
629
630
631 (add-hook 'ada-mode-hook 'ada-add-statement-menu)
632 (add-hook 'ada-mode-hook '(lambda () 579 (add-hook 'ada-mode-hook '(lambda ()
633 (setq skeleton-further-elements 580 (setq skeleton-further-elements
634 '((< '(backward-delete-char-untabify 581 '((< '(backward-delete-char-untabify
635 (min ada-indent (current-column)))))) 582 (min ada-indent (current-column))))))
636 (add-hook 'skeleton-end-hook 583 (add-hook 'skeleton-end-hook
637 'ada-adjust-case-skeleton))) 584 'ada-adjust-case-skeleton)))
638 585
586 (add-hook 'ada-mode-hook 'ada-stmt-add-to-ada-menu)
587
639 (provide 'ada-stmt) 588 (provide 'ada-stmt)
640 589
641 ;;; ada-stmt.el ends here 590 ;;; ada-stmt.el ends here