Mercurial > emacs
comparison lisp/progmodes/ada-stmt.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
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, 93, 94, 96, 97, 98, 99, 2000, 2001, 2002 | 3 ;; Copyright(C) 1987, 1993, 1994, 1996, 1997, 1998, 1999, 2000, 2001, 2002, |
4 ;; Free Software Foundation, Inc. | 4 ;; 2003, 2004, 2005 Free Software Foundation, Inc. |
5 | |
6 ;; Ada Core Technologies's version: Revision: 1.21 (GNAT 3.15) | |
7 | 5 |
8 ;; This file is part of GNU Emacs. | 6 ;; This file is part of GNU Emacs. |
9 | 7 |
10 ;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de> | 8 ;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de> |
11 ;; Maintainer: Emmanuel Briot <briot@gnat.com> | 9 ;; Maintainer: Emmanuel Briot <briot@gnat.com> |
59 ;;;update of the package :-) | 57 ;;;update of the package :-) |
60 | 58 |
61 | 59 |
62 ;;; Code: | 60 ;;; Code: |
63 | 61 |
64 (eval-when-compile | 62 (require 'skeleton nil t) |
65 (condition-case nil (require 'skeleton) | |
66 (error nil))) | |
67 | |
68 (require 'easymenu) | 63 (require 'easymenu) |
69 | 64 (require 'ada-mode) |
70 (defun ada-stmt-add-to-ada-menu () | 65 |
71 "Add a new submenu to the Ada menu." | |
72 (interactive) | |
73 (let ((menu '(["Header" ada-header t] | |
74 ["-" nil nil] | |
75 ["Package Body" ada-package-body t] | |
76 ["Package Spec" ada-package-spec t] | |
77 ["Function Spec" ada-function-spec t] | |
78 ["Procedure Spec" ada-procedure-spec t] | |
79 ["Proc/func Body" ada-subprogram-body t] | |
80 ["Task Body" ada-task-body t] | |
81 ["Task Spec" ada-task-spec t] | |
82 ["Declare Block" ada-declare-block t] | |
83 ["Exception Block" ada-exception-block t] | |
84 ["--" nil nil] | |
85 ["Entry" ada-entry t] | |
86 ["Entry family" ada-entry-family t] | |
87 ["Select" ada-select t] | |
88 ["Accept" ada-accept t] | |
89 ["Or accept" ada-or-accep t] | |
90 ["Or delay" ada-or-delay t] | |
91 ["Or terminate" ada-or-terminate t] | |
92 ["---" nil nil] | |
93 ["Type" ada-type t] | |
94 ["Private" ada-private t] | |
95 ["Subtype" ada-subtype t] | |
96 ["Record" ada-record t] | |
97 ["Array" ada-array t] | |
98 ["----" nil nil] | |
99 ["If" ada-if t] | |
100 ["Else" ada-else t] | |
101 ["Elsif" ada-elsif t] | |
102 ["Case" ada-case t] | |
103 ["-----" nil nil] | |
104 ["While Loop" ada-while-loop t] | |
105 ["For Loop" ada-for-loop t] | |
106 ["Loop" ada-loop t] | |
107 ["------" nil nil] | |
108 ["Exception" ada-exception t] | |
109 ["Exit" ada-exit t] | |
110 ["When" ada-when t]))) | |
111 (if ada-xemacs | |
112 (funcall (symbol-function 'add-submenu) | |
113 '("Ada") (append (list "Templates" | |
114 :included '(string= mode-name "Ada")) | |
115 menu)) | |
116 | |
117 (define-key-after (or | |
118 (lookup-key ada-mode-map [menu-bar Ada]) | |
119 (lookup-key ada-mode-map [menu-bar ada])) | |
120 [Templates] | |
121 (list 'menu-item | |
122 "Templates" | |
123 (easy-menu-create-menu "Templates" menu) | |
124 :visible '(string= mode-name "Ada")) | |
125 t)))) | |
126 | |
127 | |
128 | |
129 | |
130 (defun ada-func-or-proc-name () | 66 (defun ada-func-or-proc-name () |
131 ;; Get the name of the current function or procedure." | 67 ;; Get the name of the current function or procedure." |
132 (save-excursion | 68 (save-excursion |
133 (let ((case-fold-search t)) | 69 (let ((case-fold-search t)) |
134 (if (re-search-backward ada-procedure-start-regexp nil t) | 70 (if (re-search-backward ada-procedure-start-regexp nil t) |
135 (buffer-substring (match-beginning 3) (match-end 3)) | 71 (buffer-substring (match-beginning 3) (match-end 3)) |
136 "NAME?")))) | 72 "NAME?")))) |
137 | |
138 (defvar ada-template-map | |
139 (let ((map (make-sparse-keymap))) | |
140 (define-key map "h" 'ada-header) | |
141 (define-key map "\C-a" 'ada-array) | |
142 (define-key map "b" 'ada-exception-block) | |
143 (define-key map "d" 'ada-declare-block) | |
144 (define-key map "c" 'ada-case) | |
145 (define-key map "\C-e" 'ada-elsif) | |
146 (define-key map "e" 'ada-else) | |
147 (define-key map "\C-k" 'ada-package-spec) | |
148 (define-key map "k" 'ada-package-body) | |
149 (define-key map "\C-p" 'ada-procedure-spec) | |
150 (define-key map "p" 'ada-subprogram-body) | |
151 (define-key map "\C-f" 'ada-function-spec) | |
152 (define-key map "f" 'ada-for-loop) | |
153 (define-key map "i" 'ada-if) | |
154 (define-key map "l" 'ada-loop) | |
155 (define-key map "\C-r" 'ada-record) | |
156 (define-key map "\C-s" 'ada-subtype) | |
157 (define-key map "S" 'ada-tabsize) | |
158 (define-key map "\C-t" 'ada-task-spec) | |
159 (define-key map "t" 'ada-task-body) | |
160 (define-key map "\C-y" 'ada-type) | |
161 (define-key map "\C-v" 'ada-private) | |
162 (define-key map "u" 'ada-use) | |
163 (define-key map "\C-u" 'ada-with) | |
164 (define-key map "\C-w" 'ada-when) | |
165 (define-key map "w" 'ada-while-loop) | |
166 (define-key map "\C-x" 'ada-exception) | |
167 (define-key map "x" 'ada-exit) | |
168 map) | |
169 "Keymap used in Ada mode for smart template operations.") | |
170 | |
171 (define-key ada-mode-map "\C-ct" ada-template-map) | |
172 | 73 |
173 ;;; ---- statement skeletons ------------------------------------------ | 74 ;;; ---- statement skeletons ------------------------------------------ |
174 | 75 |
175 (define-skeleton ada-array | 76 (define-skeleton ada-array |
176 "Insert array type definition. | 77 "Insert array type definition. |
563 () | 464 () |
564 < "or\n" | 465 < "or\n" |
565 > "terminate;") | 466 > "terminate;") |
566 | 467 |
567 | 468 |
568 (defun ada-adjust-case-skeleton () | |
569 "Adjust the case of the text inserted by a skeleton." | |
570 (save-excursion | |
571 (let ((aa-end (point))) | |
572 (ada-adjust-case-region | |
573 (progn (goto-char (symbol-value 'beg)) (forward-word -1) (point)) | |
574 (goto-char aa-end))))) | |
575 | |
576 (defun ada-stmt-mode-hook () | |
577 (set (make-local-variable 'skeleton-further-elements) | |
578 '((< '(backward-delete-char-untabify | |
579 (min ada-indent (current-column)))))) | |
580 (add-hook 'skeleton-end-hook | |
581 'ada-adjust-case-skeleton nil t) | |
582 (ada-stmt-add-to-ada-menu)) | |
583 | |
584 (add-hook 'ada-mode-hook 'ada-stmt-mode-hook) | |
585 | |
586 (provide 'ada-stmt) | 469 (provide 'ada-stmt) |
587 | 470 |
471 ;;; arch-tag: 94f51555-cc0e-44e5-8865-8788aae8ecd3 | |
588 ;;; ada-stmt.el ends here | 472 ;;; ada-stmt.el ends here |